diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 369 | ||||
-rw-r--r-- | src/ChangeLog.unicode | 4 | ||||
-rw-r--r-- | src/Makefile.in | 6 | ||||
-rw-r--r-- | src/alloc.c | 15 | ||||
-rw-r--r-- | src/buffer.c | 8 | ||||
-rw-r--r-- | src/buffer.h | 2 | ||||
-rw-r--r-- | src/bytecode.c | 69 | ||||
-rw-r--r-- | src/callint.c | 14 | ||||
-rw-r--r-- | src/casetab.c | 7 | ||||
-rw-r--r-- | src/category.c | 4 | ||||
-rw-r--r-- | src/category.h | 12 | ||||
-rw-r--r-- | src/character.h | 6 | ||||
-rw-r--r-- | src/cmds.c | 8 | ||||
-rw-r--r-- | src/coding.c | 3 | ||||
-rw-r--r-- | src/data.c | 146 | ||||
-rw-r--r-- | src/dired.c | 3 | ||||
-rw-r--r-- | src/dispextern.h | 1 | ||||
-rw-r--r-- | src/dispnew.c | 121 | ||||
-rw-r--r-- | src/doc.c | 4 | ||||
-rw-r--r-- | src/editfns.c | 27 | ||||
-rw-r--r-- | src/eval.c | 170 | ||||
-rw-r--r-- | src/fileio.c | 68 | ||||
-rw-r--r-- | src/floatfns.c | 30 | ||||
-rw-r--r-- | src/fns.c | 163 | ||||
-rw-r--r-- | src/frame.c | 6 | ||||
-rw-r--r-- | src/frame.h | 17 | ||||
-rw-r--r-- | src/fringe.c | 4 | ||||
-rw-r--r-- | src/keyboard.c | 129 | ||||
-rw-r--r-- | src/keymap.c | 8 | ||||
-rw-r--r-- | src/lisp.h | 119 | ||||
-rw-r--r-- | src/lread.c | 93 | ||||
-rw-r--r-- | src/mac.c | 3 | ||||
-rw-r--r-- | src/macros.c | 5 | ||||
-rw-r--r-- | src/macselect.c | 8 | ||||
-rw-r--r-- | src/macterm.c | 218 | ||||
-rw-r--r-- | src/marker.c | 3 | ||||
-rw-r--r-- | src/minibuf.c | 2 | ||||
-rw-r--r-- | src/msdos.c | 6 | ||||
-rw-r--r-- | src/print.c | 4 | ||||
-rw-r--r-- | src/process.c | 4 | ||||
-rw-r--r-- | src/puresize.h | 2 | ||||
-rw-r--r-- | src/search.c | 21 | ||||
-rw-r--r-- | src/sound.c | 10 | ||||
-rw-r--r-- | src/sunfns.c | 2 | ||||
-rw-r--r-- | src/syntax.c | 69 | ||||
-rw-r--r-- | src/textprop.c | 7 | ||||
-rw-r--r-- | src/unexsol.c | 2 | ||||
-rw-r--r-- | src/w32.c | 54 | ||||
-rw-r--r-- | src/w32.h | 4 | ||||
-rw-r--r-- | src/w32proc.c | 7 | ||||
-rw-r--r-- | src/w32term.c | 44 | ||||
-rw-r--r-- | src/window.c | 24 | ||||
-rw-r--r-- | src/xdisp.c | 26 | ||||
-rw-r--r-- | src/xfaces.c | 19 | ||||
-rw-r--r-- | src/xfns.c | 4 | ||||
-rw-r--r-- | src/xselect.c | 82 | ||||
-rw-r--r-- | src/xterm.c | 4 |
57 files changed, 1310 insertions, 960 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 4b817c11eae..1ea2005e0c4 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,372 @@ +2006-07-18 Francis Litterio <franl@world.std.com> + + * w32term.c (x_calc_absolute_position): Fix frame positioning + with negative X/Y coordinates. + +2006-07-18 Dan Nicolaescu <dann@ics.uci.edu> + + * xterm.c (x_connection_closed, x_error_quitter): Mark as NO_RETURN. + + * textprop.c (text_read_only): Likewise. + + * lread.c (end_of_file_error): Likewise. + + * lisp.h (circular_list_error, memory_full, buffer_memory_full): + Likewise. + + * eval.c (unwind_to_catch): Likewise. + + * buffer.h (buffer_slot_type_mismatch): Likewise. + +2006-07-18 Kim F. Storm <storm@cua.dk> + + Cleanup Fsignal calls that never returns; now only use it for Qquit. + + * eval.c (xsignal): New func. Like Fsignal, but marked no-return. + (xsignal0, xsignal1, xsignal2, xsignal3): New no-return functions. + (signal_error): New no-return function (from xfaces.c). + (Fthrow): Use xsignal2 instead of Fsignal + abort. + (error): Use xsignal1 instead of Fsignal + abort. + (FletX, Flet, grow_specpdl): Use signal_error. + (Feval, Ffuncall, funcall_lambda): Use xsignal1, xsignal2. + + * alloc.c (buffer_memory_full, memory_full): Use xsignal. Remove loop. + (list1): New function. + + * lisp.h (list1): Add EXFUN. + (xsignal, xsignal0, xsignal1, xsignal2, xsignal3, signal_error): + Add prototypes. Mark them as no-return. + + * buffer.c (Fbuffer_local_value, Fbarf_if_buffer_read_only): + Use xsignal1. + + * callint.c (check_mark): Use xsignal0. + + * casefiddle.c (casify_object): wrong_type_argument is no-return. + + * cmds.c (Fforward_char, Fdelete_char): Use xsignal0. + + * coding.c (Fcheck_coding_system): Use xsignal1. Remove loop. + (Fdefine_coding_system_internal): Use xsignal1. + + * data.c (circular_list_error): Use xsignal. + (wrong_type_argument): Use xsignal2. Don't care about return value. + (args_out_of_range, args_out_of_range_3): Use xsignal2, xsignal3. + Remove loop around Fsignal. + (indirect_variable, Fsymbol_value, set_internal, Fdefault_value) + (indirect_function, Findirect_function, Fstring_to_number) + (Fmakunbound, Ffmakunbound, Fsymbol_function, Ffset): Use xsignal1. + (arith_driver, float_arith_driver, Frem, Fmod, arith_error): + Use xsignal0. + + * doc.c (Fdocumentation): Use xsignal1. + + * editfns.c (region_limit, Fget_internal_run_time): Use xsignal0. + + * fileio.c (report_file_error): Use xsignal. + (barf_or_query_if_file_exists, Fcopy_file, Fdelete_file) + (Finsert_file_contents): Use xsignal2. + (syms_of_fileio): Use list2, list3. + + * floatfns.c (arith_error, range_error, domain_error): Use xsignal2. + (range_error2, domain_error2): Use xsignal3. + (rounding_driver, fmod_float): Use xsignal0. + (float_error): Use xsignal1. + (matherr): Use xsignal. + + * fns.c (Flength): wrong_type_argument is no-return. + (hashfn_user_defined, Fmake_hash_table): Use signal_error. + (Fmd5): Use xsignal1. + + * frame.c (x_set_line_spacing, x_set_screen_gamma): Use signal_error. + + * keyboard.c (recursive_edit_1): Use xsignal1. + + * keymap.c (Fmap_keymap): Use xsignal1. + + * lread.c (Fload): Use xsignal2, signal_error. + (end_of_file_error): Use xsignal0, xsignal1. + (read0): Use xsignal1. + (invalid_syntax): New error function marked no-return. + (read_integer, read1, read_list): Use it. + + * macselect.c (x_get_local_selection): Use signal_error. + + * msdos.c (Fmsdos_set_mouse_buttons): Use xsignal2. + + * search.c (compile_pattern_1): Use xsignal1. + (signal_failure): Remove (was only called once). + (search_command): Use xsignal1 instead of signal_failure. + + * syntax.c (scan_lists): Use xsignal3. + + * textprop.c (text_read_only): Use xsignal0, xsignal1. + + * unexsol.c (unexec): Use xsignal. + + * window.c (window_scroll_pixel_based, window_scroll_line_based): + Use xsignal0. + + * xfaces.c (signal_error): Move to eval.c. + (resolve_face_name): Use xsignal1. + + * xfns.c (x_decode_color): Use signal_error. + + * xselect.c (x_get_local_selection, copy_multiple_data) + (x_get_window_property_as_lisp_data) + (lisp_data_to_selection_data, CHECK_CUT_BUFFER) + (Fx_get_cut_buffer_internal): Use signal_error. + +2006-07-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (XTread_socket): Undo previous change. + +2006-07-18 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (keycode_to_xkeysym): Remove function. All uses now + directly lookup keycode_to_xkeysym_table. + [USE_MAC_TSM] (mac_handle_text_input_event): Don't construct + ASCII_KEYSTROKE_EVENT for non-zero keycode_to_xkeysym_table entries. + (XTread_socket): Use character codes to construct keypad key events. + (mac_initialize_display_info) [MAC_OSX]: Use CGDisplaySamplesPerPixel. + (x_delete_display): Apply 2006-07-04 change for xterm.c. + +2006-07-17 Kim F. Storm <storm@cua.dk> + + * xdisp.c (handle_single_display_spec): Ensure the right value of + it->position is saved by push_it. + (pop_it): Restore it->object for GET_FROM_BUFFER and GET_FROM_STRING. + (reseat_1): Don't setup it->object twice. + (set_iterator_to_next): No need to set it->object after pop_it. + (move_it_to): Explicitly check to see if last move reached to_charpos. + +2006-07-17 Thien-Thi Nguyen <ttn@gnu.org> + + * xdisp.c (display_mode_line): Preserve match data. + +2006-07-14 Kim F. Storm <storm@cua.dk> + + * w32.c (pfn_WSACreateEvent, pfn_WSACloseEvent): New func ptrs. + (init_winsock): Load them. Use ws2_32.dll. + (sys_listen): Undo last change. Just set FILE_LISTEN flag. + (sys_accept): Undo last change. Instead, set child status to + STATUS_READ_ACKNOWLEDGED and reset char_avail event so next + sys_select will wakeup the reader thread. + (_sys_wait_accept): New function used by reader thread to wait for + an incoming connection on a server socket. + + * w32.h (_sys_read_ahead, _sys_wait_accept): Add prototypes. + + * w32proc.c (reader_thread): Use _sys_wait_accept to wait on a + server socket (FILE_LISTEN flag). + +2006-07-14 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * sound.c (alsa_init): Call snd_pcm_close after successful snd_pcm_open. + +2006-07-14 Kim F. Storm <storm@cua.dk> + + * w32.c: Fix high cpu load for server sockets. + (pfn_WSAEventSelect): New function ptr. + (init_winsock): Load it. + (sys_listen): Set FILE_LISTEN flag. Set event mask for socket's + char_avail event object to FD_ACCEPT. + (sys_accept): Check FILE_LISTEN flag. Set event mask on new + socket's char_avail event object to FD_READ|FD_CLOSE. + + * w32.h (FILE_LISTEN): New filedesc flag value. + +2006-07-13 Kim F. Storm <storm@cua.dk> + + * bytecode.c (Fbyte_code): Use CAR, CDR for Bcar, Bcdr. + Use CAR_SAFE, CDR_SAFE for Bcar_safe, Bcdr_safe. + Simplify loops and use CAR for Bnth and Belt. + + * data.c (Findirect_function): Optimize for no indirection. + + * eval.c (Fthrow): Remove loop around Fsignal. + (Feval, Fapply, Ffuncall): Optimize for no function indirection. + Use original function name in all signaled errors. + Simplify Fsignal calls (no return). + (funcall_lambda): Simplify Fsignal calls (no return). + +2006-07-13 Andreas Schwab <schwab@suse.de> + + * syntax.c (scan_sexps_forward): Use EMACS_INT for out_bytepos and + out_charpos. + +2006-07-13 Kenichi Handa <handa@m17n.org> + + * editfns.c (Fformat): Fix calculation of text property positions + of format string. + +2006-07-12 Kim F. Storm <storm@cua.dk> + + * lisp.h (CHECK_TYPE): New macro for generic type checking. + (CAR_SAFE, CDR_SAFE): New macros. + (ARRAYP, CHECK_ARRAY): New macros. + (CHECK_VECTOR_OR_STRING, CHECK_SUBR): New macros. + (CHECK_WINDOW_CONFIGURATION): New macro. + (CHECK_LIST_CONS, CHECK_LIST_END): New checks for list traversal. + (CHECK_STRING_OR_BUFFER, CHECK_HASH_TABLE, CHECK_LIST) + (CHECK_STRING, CHECK_STRING_CAR, CHECK_CONS, CHECK_SYMBOL) + (CHECK_CHAR_TABLE, CHECK_VECTOR, CHECK_VECTOR_OR_CHAR_TABLE) + (CHECK_BUFFER, CHECK_WINDOW, CHECK_LIVE_WINDOW, CHECK_PROCESS) + (CHECK_NUMBER, CHECK_NATNUM, CHECK_MARKER, CHECK_OVERLAY) + (CHECK_NUMBER_COERCE_MARKER, CHECK_FLOAT, CHECK_NUMBER_OR_FLOAT) + (CHECK_NUMBER_OR_FLOAT_COERCE_MARKER): Use CHECK_TYPE. + + * category.h (CHECK_CATEGORY, CHECK_CATEGORY_SET): + * frame.h (CHECK_FRAME, CHECK_LIVE_FRAME): Use CHECK_TYPE. + + * callint.c (Fcall_interactively): + * casefiddle.c (casify_object): + * editfns.c (general_insert_function): + * fns.c (Flength, Felt, Ffillarray): + * data.c (Fcar, Fcdr): Remove loop around wrong_type_argument. + + * data.c (wrong_type_argument): Remove loop around Fsignal. + (Farrayp, Fsequencep): Use ARRAYP. + (Fcar): Use CAR. + (Fcar_safe): Use CAR_SAFE. + (Fcdr): Use CDR. + (Fcdr_safe): Use CDR_SAFE. + (Fsetcar, Fsetcdr): Use CHECK_CONS. + (Fsubr_arity, Fsubr_name): Use CHECK_SUBR. + (Faset): Use CHECK_ARRAY. + + * fns.c (Felt): Use CHECK_ARRAY. + (concat): Use CHECK_NUMBER. + (Fsubstring, substring_both): Use CHECK_VECTOR_OR_STRING. + (Fmemq): Use CHECK_LIST. + (Fassq, Fassoc, Frassq, Frassoc): Use CAR. + (assq_no_quit): Use CAR_SAFE. + (Fnthcdr, Fmember, Fdelq, Fdelete, Fnreverse, Fnconc): + Use CHECK_LIST_CONS. + (Freverse, Fplist_get, Flax_plist_get): Use CHECK_LIST_END. + + * bytecode.c (Fbyte_code): Use CHECK_VECTOR. + + * casetab.c (check_case_table): + * category.c (check_category_table): + * marker.c (Fcopy_marker): + * syntax.c (check_syntax_table): + * xfaces.c (load_pixmap): Use CHECK_TYPE. + + * fns.c (Fcopy_sequence, concat): + * fringe.c (Fdefine_fringe_bitmap): + * lread.c (check_obarray): Cleanup wrong_type_argument use. + + * keyboard.c (access_keymap_keyremap): Use ARRAYP. + + * keymap.c (Fdefine_key, Flookup_key): + * macros.c (Fstart_kbd_macro): Use CHECK_VECTOR_OR_STRING. + + * mac.c (Fmac_get_preference): Use CHECK_LIST_END. + + * search.c (Fset_match_data): Use CHECK_LIST. + + * sunfns.c (sun_item_create): Use CHECK_LIST_CONS. + + * window.c (Fwindow_configuration_frame, Fset_window_configuration): + (compare_window_configurations): Use CHECK_WINDOW_CONFIGURATION. + +2006-07-12 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * Makefile.in (dired.o, editfns.o, fileio.o): Depend on blockinput.h. + + * dired.c: Include blockinput.h. + (Ffile_attributes): Add BLOCK_INPUT around getpwuid/getgrgid. + + * editfns.c: Include blockinput.h. + (Fuser_login_name, Fuser_full_name): Add BLOCK_INPUT around + getpwuid/getpwnam. + + * fileio.c: Include blockinput.h. + (Fexpand_file_name, search_embedded_absfilename): Add BLOCK_INPUT + around getpwnam. + (search_embedded_absfilename): Remove spurious xfree. + +2006-07-11 Kim F. Storm <storm@cua.dk> + + * dispnew.c (sit_for): Reduce number of args from 5 to 3. + Now just one TIMEOUT arg that can be a Lisp float or Lisp int. + Combine args DISPLAY and INITIAL_DISPLAY into one arg DO_DISPLAY. + Signal error if TIMEOUT is not a number. + Undo 2006-06-14 change for non-preemptive display if TIMEOUT < 0. + The rework of sit_for args also fixes several incorrect Qt args + which should have been 1. + (Fredisplay): Pass 1 instead of Qt to swallow_events and + detect_input_pending_run_timers. + + * lisp.h (sit_for): Update prototype. + (Fredisplay): Add EXFUN. + + * dispextern.h (sit_for): Remove prototype. + + * callint.c (Fcall_interactively): + * minibuf.c (temp_echo_area_glyphs): + * keyboard.c (command_loop_1, read_char, Fexecute_extended_command): + * fileio.c (Fdo_auto_save): Update/simplify sit_for calls. + +2006-07-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.c (forw_comment): Also use EMACS_INT for buffer positions. + +2006-07-11 Kim F. Storm <storm@cua.dk> + + * dispnew.c (Fredisplay): Add FORCE argument to force redisplay when + input is available. Fix test for redisplay_dont_pause non-nil. + Specbind redisplay-dont-pause to t if FORCE non-nil. + +2006-07-10 Chong Yidong <cyd@stupidchicken.com> + + * puresize.h (BASE_PURESIZE): Increment to 1211000. + + * dispnew.c (Fredisplay): New function, equivalent to (sit-for 0). + (Fsit_for): Function deleted. + + * keyboard.c (command_loop_1, Fexecute_extended_command): + Call sit_for instead of Fsit_for. + + * minibuf.c (temp_echo_area_glyphs): Likewise. + +2006-07-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.c (Fforward_comment): Revert the reversion. + (back_comment, scan_lists): Also use EMACS_INT for buffer positions. + +2006-07-09 John Paul Wallington <jpw@pobox.com> + + * syntax.c (Fforward_comment): Revert previous change. + +2006-07-09 Kim F. Storm <storm@cua.dk> + + * window.c (Fforce_window_update): Doc fix. + +2006-07-08 Stephen Gildea <gildea@stop.mail-abuse.org> + + * fileio.c (do_auto_save_make_dir): Make the auto-save-list-file + directory unreadable for better user privacy. + +2006-07-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.c (Fforward_comment): Fix int-32 vs EMACS_INT-64 mixup. + + * lread.c (read_filtered_event): Remove `register' qualifier because it + causes compilation problem with gcc-4.0.2-20051125 on amd64. + (readevalloop): Remove unused var `bpos'. + Yet another int/Lisp_Object mixup (YAILOM). + +2006-07-07 Eli Zaretskii <eliz@gnu.org> + + * keyboard.c (Fexecute_extended_command): Mention the argument + PREFIXARG in the doc string. + +2006-07-07 Kim F. Storm <storm@cua.dk> + + * fringe.c (Fdefine_fringe_bitmap): Doc fix. + 2006-07-05 Chong Yidong <cyd@stupidchicken.com> * insdel.c (prepare_to_modify_buffer): For an indirect buffer, do diff --git a/src/ChangeLog.unicode b/src/ChangeLog.unicode index fcfc9d31657..7af2aa0784c 100644 --- a/src/ChangeLog.unicode +++ b/src/ChangeLog.unicode @@ -1,3 +1,7 @@ +2006-07-18 Miles Bader <miles@gnu.org> + + * character.h (CHECK_CHARACTER): Redefine in terms of CHECK_TYPE. + 2006-07-14 Kenichi Handa <handa@m17n.org> * font.h (LGLYPH_XOFF, LGLYPH_YOFF, LGLYPH_WIDTH, LGLYPH_WADJUST) diff --git a/src/Makefile.in b/src/Makefile.in index 342540df7be..beee481d611 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -1129,7 +1129,7 @@ pre-crt0.o: pre-crt0.c ecrt0.o: ecrt0.c $(config_h) CRT0_COMPILE ${srcdir}/ecrt0.c dired.o: dired.c commands.h buffer.h $(config_h) character.h charset.h \ - coding.h regex.h systime.h + coding.h regex.h systime.h blockinput.h dispnew.o: dispnew.c systty.h systime.h commands.h process.h frame.h \ window.h buffer.h dispextern.h termchar.h termopts.h termhooks.h cm.h \ disptab.h indent.h intervals.h \ @@ -1140,12 +1140,12 @@ doprnt.o: doprnt.c character.h $(config_h) dosfns.o: buffer.h termchar.h termhooks.h frame.h blockinput.h window.h \ msdos.h dosfns.h dispextern.h charset.h coding.h $(config_h) editfns.o: editfns.c window.h buffer.h systime.h $(INTERVAL_SRC) character.h \ - coding.h dispextern.h frame.h $(config_h) + coding.h dispextern.h frame.h blockinput.h $(config_h) emacs.o: emacs.c commands.h systty.h syssignal.h blockinput.h process.h \ termhooks.h buffer.h atimer.h systime.h $(INTERVAL_SRC) $(config_h) \ window.h dispextern.h keyboard.h keymap.h fileio.o: fileio.c window.h buffer.h systime.h $(INTERVAL_SRC) character.h \ - coding.h msdos.h dispextern.h $(config_h) + coding.h msdos.h dispextern.h blockinput.h $(config_h) filelock.o: filelock.c buffer.h character.h charset.h coding.h systime.h \ epaths.h $(config_h) filemode.o: filemode.c $(config_h) diff --git a/src/alloc.c b/src/alloc.c index 7fd1560708a..2cf3ff40e3b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -559,8 +559,7 @@ buffer_memory_full () /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ - while (1) - Fsignal (Qnil, Vmemory_signal_data); + xsignal (Qnil, Vmemory_signal_data); } @@ -2777,7 +2776,14 @@ check_cons_list () #endif } -/* Make a list of 2, 3, 4 or 5 specified objects. */ +/* Make a list of 1, 2, 3, 4 or 5 specified objects. */ + +Lisp_Object +list1 (arg1) + Lisp_Object arg1; +{ + return Fcons (arg1, Qnil); +} Lisp_Object list2 (arg1, arg2) @@ -3450,8 +3456,7 @@ memory_full () /* This used to call error, but if we've run out of memory, we could get infinite recursion trying to build the string. */ - while (1) - Fsignal (Qnil, Vmemory_signal_data); + xsignal (Qnil, Vmemory_signal_data); } /* If we released our reserve (due to running out of memory), diff --git a/src/buffer.c b/src/buffer.c index 5bdfe737767..6115f727deb 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -939,10 +939,10 @@ is the default binding of the variable. */) result = XCDR (result); } - if (EQ (result, Qunbound)) - return Fsignal (Qvoid_variable, Fcons (variable, Qnil)); + if (!EQ (result, Qunbound)) + return result; - return result; + xsignal1 (Qvoid_variable, variable); } /* Return an alist of the Lisp-level buffer-local bindings of @@ -1962,7 +1962,7 @@ DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, { if (!NILP (current_buffer->read_only) && NILP (Vinhibit_read_only)) - Fsignal (Qbuffer_read_only, (Fcons (Fcurrent_buffer (), Qnil))); + xsignal1 (Qbuffer_read_only, Fcurrent_buffer ()); return Qnil; } diff --git a/src/buffer.h b/src/buffer.h index 8015b2be15c..9d3ca6ea463 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -837,7 +837,7 @@ extern void set_buffer_internal P_ ((struct buffer *)); extern void set_buffer_internal_1 P_ ((struct buffer *)); extern void set_buffer_temp P_ ((struct buffer *)); extern void record_buffer P_ ((Lisp_Object)); -extern void buffer_slot_type_mismatch P_ ((int)); +extern void buffer_slot_type_mismatch P_ ((int)) NO_RETURN; extern void fix_overlays_before P_ ((struct buffer *, EMACS_INT, EMACS_INT)); extern void mmap_set_vars P_ ((int)); diff --git a/src/bytecode.c b/src/bytecode.c index e6f84cc6c2b..3ee9b5576b4 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -433,8 +433,7 @@ If the third argument is incorrect, Emacs may crash. */) #endif CHECK_STRING (bytestr); - if (!VECTORP (vector)) - vector = wrong_type_argument (Qvectorp, vector); + CHECK_VECTOR (vector); CHECK_NUMBER (maxdepth); if (STRING_MULTIBYTE (bytestr)) @@ -542,14 +541,7 @@ If the third argument is incorrect, Emacs may crash. */) { Lisp_Object v1; v1 = TOP; - if (CONSP (v1)) - TOP = XCAR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - { - wrong_type_argument (Qlistp, v1); - } + TOP = CAR (v1); break; } @@ -575,14 +567,7 @@ If the third argument is incorrect, Emacs may crash. */) { Lisp_Object v1; v1 = TOP; - if (CONSP (v1)) - TOP = XCDR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - { - wrong_type_argument (Qlistp, v1); - } + TOP = CDR (v1); break; } @@ -917,23 +902,10 @@ If the third argument is incorrect, Emacs may crash. */) AFTER_POTENTIAL_GC (); op = XINT (v2); immediate_quit = 1; - while (--op >= 0) - { - if (CONSP (v1)) - v1 = XCDR (v1); - else if (!NILP (v1)) - { - immediate_quit = 0; - wrong_type_argument (Qlistp, v1); - } - } + while (--op >= 0 && CONSP (v1)) + v1 = XCDR (v1); immediate_quit = 0; - if (CONSP (v1)) - TOP = XCAR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - wrong_type_argument (Qlistp, v1); + TOP = CAR (v1); break; } @@ -1563,23 +1535,10 @@ If the third argument is incorrect, Emacs may crash. */) AFTER_POTENTIAL_GC (); op = XINT (v2); immediate_quit = 1; - while (--op >= 0) - { - if (CONSP (v1)) - v1 = XCDR (v1); - else if (!NILP (v1)) - { - immediate_quit = 0; - wrong_type_argument (Qlistp, v1); - } - } + while (--op >= 0 && CONSP (v1)) + v1 = XCDR (v1); immediate_quit = 0; - if (CONSP (v1)) - TOP = XCAR (v1); - else if (NILP (v1)) - TOP = Qnil; - else - wrong_type_argument (Qlistp, v1); + TOP = CAR (v1); } else { @@ -1641,10 +1600,7 @@ If the third argument is incorrect, Emacs may crash. */) { Lisp_Object v1; v1 = TOP; - if (CONSP (v1)) - TOP = XCAR (v1); - else - TOP = Qnil; + TOP = CAR_SAFE (v1); break; } @@ -1652,10 +1608,7 @@ If the third argument is incorrect, Emacs may crash. */) { Lisp_Object v1; v1 = TOP; - if (CONSP (v1)) - TOP = XCDR (v1); - else - TOP = Qnil; + TOP = CDR_SAFE (v1); break; } diff --git a/src/callint.c b/src/callint.c index ae10e64e1de..475042abbe1 100644 --- a/src/callint.c +++ b/src/callint.c @@ -174,7 +174,7 @@ check_mark (for_region) : "The mark is not set now"); if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) && NILP (current_buffer->mark_active)) - Fsignal (Qmark_inactive, Qnil); + xsignal0 (Qmark_inactive); } /* If the list of args INPUT was produced with an explicit call to @@ -314,8 +314,6 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) /* Save this now, since use of minibuffer will clobber it. */ prefix_arg = Vcurrent_prefix_arg; - retry: - if (SYMBOLP (function)) enable = Fget (function, Qenable_recursive_minibuffers); else @@ -334,8 +332,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) up_event = Qnil; /* Decode the kind of function. Either handle it and return, - or go to `lose' if not interactive, or go to `retry' - to specify a different function, or set either STRING or SPECS. */ + or go to `lose' if not interactive, or set either STRING or SPECS. */ if (SUBRP (fun)) { @@ -343,8 +340,7 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) if (!string) { lose: - function = wrong_type_argument (Qcommandp, function); - goto retry; + wrong_type_argument (Qcommandp, function); } } else if (COMPILEDP (fun)) @@ -721,10 +717,10 @@ If KEYS is omitted or nil, the return value of `this-command-keys' is used. */) do { Lisp_Object tem; - if (! first) + if (! first) { message ("Please enter a number."); - sit_for (1, 0, 0, 0, 0); + sit_for (make_number (1), 0, 0); } first = 0; diff --git a/src/casetab.c b/src/casetab.c index 89f9287c75f..15bf133a869 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -1,5 +1,5 @@ /* GNU Emacs routines to deal with case tables. - Copyright (C) 1993, 1994, 2002, 2003, 2004, + Copyright (C) 1993, 1994, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -67,10 +67,7 @@ static Lisp_Object check_case_table (obj) Lisp_Object obj; { - register Lisp_Object tem; - - while (tem = Fcase_table_p (obj), NILP (tem)) - obj = wrong_type_argument (Qcase_table_p, obj); + CHECK_TYPE (!NILP (Fcase_table_p (obj)), Qcase_table_p, obj); return (obj); } diff --git a/src/category.c b/src/category.c index 9b47e6c00e9..b9f80982ee7 100644 --- a/src/category.c +++ b/src/category.c @@ -168,11 +168,9 @@ Lisp_Object check_category_table (table) Lisp_Object table; { - register Lisp_Object tem; if (NILP (table)) return current_buffer->category_table; - while (tem = Fcategory_table_p (table), NILP (tem)) - table = wrong_type_argument (Qcategory_table_p, table); + CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table); return table; } diff --git a/src/category.h b/src/category.h index fc755ed7d86..4799b7a5e3d 100644 --- a/src/category.h +++ b/src/category.h @@ -57,10 +57,8 @@ Boston, MA 02110-1301, USA. */ #define CATEGORYP(x) \ (INTEGERP ((x)) && XFASTINT ((x)) >= 0x20 && XFASTINT ((x)) <= 0x7E) -#define CHECK_CATEGORY(x) \ - do { \ - if (!CATEGORYP ((x))) x = wrong_type_argument (Qcategoryp, (x)); \ - } while (0) +#define CHECK_CATEGORY(x) \ + CHECK_TYPE (CATEGORYP (x), Qcategoryp, x) #define XCATEGORY_SET XBOOL_VECTOR @@ -75,10 +73,8 @@ Boston, MA 02110-1301, USA. */ #define SET_CATEGORY_SET(category_set, category, val) \ (Faset (category_set, category, val)) -#define CHECK_CATEGORY_SET(x) \ - do { \ - if (!CATEGORY_SET_P ((x))) x = wrong_type_argument (Qcategorysetp, (x)); \ - } while (0) +#define CHECK_CATEGORY_SET(x) \ + CHECK_TYPE (CATEGORY_SET_P (x), Qcategorysetp, x) /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. The faster version of `!NILP (Faref (category_set, category))'. */ diff --git a/src/character.h b/src/character.h index d02fdfb8b79..72823752d96 100644 --- a/src/character.h +++ b/src/character.h @@ -112,10 +112,8 @@ extern char unibyte_has_multibyte_table[256]; #define CHAR_VALID_P(c, genericp) ((unsigned) (c) <= MAX_CHAR) /* Check if Lisp object X is a character or not. */ -#define CHECK_CHARACTER(x) \ - do { \ - if (! CHARACTERP(x)) x = wrong_type_argument (Qcharacterp, (x)); \ - } while (0) +#define CHECK_CHARACTER(x) \ + CHECK_TYPE (CHARACTERP (x), Qcharacterp, x) #define CHECK_CHARACTER_CAR(x) \ do { \ diff --git a/src/cmds.c b/src/cmds.c index 72d35b8cefd..096b63dd453 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -77,12 +77,12 @@ On reaching end of buffer, stop and signal error. */) if (new_point < BEGV) { SET_PT (BEGV); - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); } if (new_point > ZV) { SET_PT (ZV); - Fsignal (Qend_of_buffer, Qnil); + xsignal0 (Qend_of_buffer); } SET_PT (new_point); @@ -245,14 +245,14 @@ N was explicitly specified. */) if (XINT (n) < 0) { if (pos < BEGV) - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); else del_range (pos, PT); } else { if (pos > ZV) - Fsignal (Qend_of_buffer, Qnil); + xsignal0 (Qend_of_buffer); else del_range (PT, pos); } diff --git a/src/coding.c b/src/coding.c index 023dc95c35e..cb6df79fca0 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7170,8 +7170,7 @@ function `define-coding-system'. */) } if (!NILP (Fcoding_system_p (coding_system))) return coding_system; - while (1) - Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); + xsignal1 (Qcoding_system_error, coding_system); } diff --git a/src/data.c b/src/data.c index ec9a176f078..4a846207073 100644 --- a/src/data.c +++ b/src/data.c @@ -105,7 +105,7 @@ void circular_list_error (list) Lisp_Object list; { - Fsignal (Qcircular_list, list); + xsignal (Qcircular_list, list); } @@ -113,26 +113,12 @@ Lisp_Object wrong_type_argument (predicate, value) register Lisp_Object predicate, value; { - register Lisp_Object tem; - do - { - /* If VALUE is not even a valid Lisp object, abort here - where we can get a backtrace showing where it came from. */ - if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) - abort (); + /* If VALUE is not even a valid Lisp object, abort here + where we can get a backtrace showing where it came from. */ + if ((unsigned int) XGCTYPE (value) >= Lisp_Type_Limit) + abort (); - value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil))); - tem = call1 (predicate, value); - } - while (NILP (tem)); - /* This function is marked as NO_RETURN, gcc would warn if it has a - return statement or if falls off the function. Other compilers - warn if no return statement is present. */ -#ifndef __GNUC__ - return value; -#else - abort (); -#endif + xsignal2 (Qwrong_type_argument, predicate, value); } void @@ -145,16 +131,14 @@ void args_out_of_range (a1, a2) Lisp_Object a1, a2; { - while (1) - Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil))); + xsignal2 (Qargs_out_of_range, a1, a2); } void args_out_of_range_3 (a1, a2, a3) Lisp_Object a1, a2, a3; { - while (1) - Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil)))); + xsignal3 (Qargs_out_of_range, a1, a2, a3); } /* On some machines, XINT needs a temporary location. @@ -394,8 +378,7 @@ DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, (object) Lisp_Object object; { - if (VECTORP (object) || STRINGP (object) - || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) + if (ARRAYP (object)) return Qt; return Qnil; } @@ -405,8 +388,7 @@ DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0, (object) register Lisp_Object object; { - if (CONSP (object) || NILP (object) || VECTORP (object) || STRINGP (object) - || CHAR_TABLE_P (object) || BOOL_VECTOR_P (object)) + if (CONSP (object) || NILP (object) || ARRAYP (object)) return Qt; return Qnil; } @@ -536,15 +518,7 @@ Lisp concepts such as car, cdr, cons cell and list. */) (list) register Lisp_Object list; { - while (1) - { - if (CONSP (list)) - return XCAR (list); - else if (EQ (list, Qnil)) - return Qnil; - else - list = wrong_type_argument (Qlistp, list); - } + return CAR (list); } DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, @@ -552,10 +526,7 @@ DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0, (object) Lisp_Object object; { - if (CONSP (object)) - return XCAR (object); - else - return Qnil; + return CAR_SAFE (object); } DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0, @@ -567,15 +538,7 @@ Lisp concepts such as cdr, car, cons cell and list. */) (list) register Lisp_Object list; { - while (1) - { - if (CONSP (list)) - return XCDR (list); - else if (EQ (list, Qnil)) - return Qnil; - else - list = wrong_type_argument (Qlistp, list); - } + return CDR (list); } DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, @@ -583,10 +546,7 @@ DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0, (object) Lisp_Object object; { - if (CONSP (object)) - return XCDR (object); - else - return Qnil; + return CDR_SAFE (object); } DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, @@ -594,9 +554,7 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, (cell, newcar) register Lisp_Object cell, newcar; { - if (!CONSP (cell)) - cell = wrong_type_argument (Qconsp, cell); - + CHECK_CONS (cell); CHECK_IMPURE (cell); XSETCAR (cell, newcar); return newcar; @@ -607,9 +565,7 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, (cell, newcdr) register Lisp_Object cell, newcdr; { - if (!CONSP (cell)) - cell = wrong_type_argument (Qconsp, cell); - + CHECK_CONS (cell); CHECK_IMPURE (cell); XSETCDR (cell, newcdr); return newcdr; @@ -651,7 +607,7 @@ Return SYMBOL. */) { CHECK_SYMBOL (symbol); if (XSYMBOL (symbol)->constant) - return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); + xsignal1 (Qsetting_constant, symbol); Fset (symbol, Qunbound); return symbol; } @@ -664,7 +620,7 @@ Return SYMBOL. */) { CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) - return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); + xsignal1 (Qsetting_constant, symbol); XSYMBOL (symbol)->function = Qunbound; return symbol; } @@ -675,9 +631,9 @@ DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, register Lisp_Object symbol; { CHECK_SYMBOL (symbol); - if (EQ (XSYMBOL (symbol)->function, Qunbound)) - return Fsignal (Qvoid_function, Fcons (symbol, Qnil)); - return XSYMBOL (symbol)->function; + if (!EQ (XSYMBOL (symbol)->function, Qunbound)) + return XSYMBOL (symbol)->function; + xsignal1 (Qvoid_function, symbol); } DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, @@ -708,7 +664,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, { CHECK_SYMBOL (symbol); if (NILP (symbol) || EQ (symbol, Qt)) - return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); + xsignal1 (Qsetting_constant, symbol); if (!NILP (Vautoload_queue) && !EQ (XSYMBOL (symbol)->function, Qunbound)) Vautoload_queue = Fcons (Fcons (symbol, XSYMBOL (symbol)->function), Vautoload_queue); @@ -764,8 +720,7 @@ function with `&rest' args, or `unevalled' for a special form. */) Lisp_Object subr; { short minargs, maxargs; - if (!SUBRP (subr)) - wrong_type_argument (Qsubrp, subr); + CHECK_SUBR (subr); minargs = XSUBR (subr)->min_args; maxargs = XSUBR (subr)->max_args; if (maxargs == MANY) @@ -783,8 +738,7 @@ SUBR must be a built-in function. */) Lisp_Object subr; { const char *name; - if (!SUBRP (subr)) - wrong_type_argument (Qsubrp, subr); + CHECK_SUBR (subr); name = XSUBR (subr)->symbol_name; return make_string (name, strlen (name)); } @@ -852,7 +806,7 @@ indirect_variable (symbol) tortoise = XSYMBOL (tortoise)->value; if (EQ (hare, tortoise)) - Fsignal (Qcyclic_variable_indirection, Fcons (symbol, Qnil)); + xsignal1 (Qcyclic_variable_indirection, symbol); } return hare; @@ -1153,10 +1107,10 @@ DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, Lisp_Object val; val = find_symbol_value (symbol); - if (EQ (val, Qunbound)) - return Fsignal (Qvoid_variable, Fcons (symbol, Qnil)); - else + if (!EQ (val, Qunbound)) return val; + + xsignal1 (Qvoid_variable, symbol); } DEFUN ("set", Fset, Sset, 2, 2, 0, @@ -1220,7 +1174,7 @@ set_internal (symbol, newval, buf, bindflag) if (SYMBOL_CONSTANT_P (symbol) && (NILP (Fkeywordp (symbol)) || !EQ (newval, SYMBOL_VALUE (symbol)))) - return Fsignal (Qsetting_constant, Fcons (symbol, Qnil)); + xsignal1 (Qsetting_constant, symbol); innercontents = valcontents = SYMBOL_VALUE (symbol); @@ -1414,9 +1368,10 @@ local bindings in certain buffers. */) register Lisp_Object value; value = default_value (symbol); - if (EQ (value, Qunbound)) - return Fsignal (Qvoid_variable, Fcons (symbol, Qnil)); - return value; + if (!EQ (value, Qunbound)) + return value; + + xsignal1 (Qvoid_variable, symbol); } DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, @@ -1928,7 +1883,7 @@ indirect_function (object) tortoise = XSYMBOL (tortoise)->function; if (EQ (hare, tortoise)) - Fsignal (Qcyclic_function_indirection, Fcons (object, Qnil)); + xsignal1 (Qcyclic_function_indirection, object); } return hare; @@ -1948,13 +1903,18 @@ function chain of symbols. */) { Lisp_Object result; - result = indirect_function (object); + /* Optimize for no indirection. */ + result = object; + if (SYMBOLP (result) && !EQ (result, Qunbound) + && (result = XSYMBOL (result)->function, SYMBOLP (result))) + result = indirect_function (result); + if (!EQ (result, Qunbound)) + return result; + + if (NILP (noerror)) + xsignal1 (Qvoid_function, object); - if (EQ (result, Qunbound)) - return (NILP (noerror) - ? Fsignal (Qvoid_function, Fcons (object, Qnil)) - : Qnil); - return result; + return Qnil; } /* Extract and set vector and string elements */ @@ -2028,9 +1988,7 @@ bool-vector. IDX starts at 0. */) CHECK_NUMBER (idx); idxval = XINT (idx); - if (!VECTORP (array) && !STRINGP (array) && !BOOL_VECTOR_P (array) - && ! CHAR_TABLE_P (array)) - array = wrong_type_argument (Qarrayp, array); + CHECK_ARRAY (array, Qarrayp); CHECK_IMPURE (array); if (VECTORP (array)) @@ -2340,7 +2298,7 @@ If the base used is not 10, floating point is not recognized. */) CHECK_NUMBER (base); b = XINT (base); if (b < 2 || b > 16) - Fsignal (Qargs_out_of_range, Fcons (base, Qnil)); + xsignal1 (Qargs_out_of_range, base); } /* Skip any whitespace at the front of the number. Some versions of @@ -2452,7 +2410,7 @@ arith_driver (code, nargs, args) else { if (next == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); accum /= next; } break; @@ -2525,7 +2483,7 @@ float_arith_driver (accum, argnum, code, nargs, args) else { if (! IEEE_FLOATING_POINT && next == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); accum /= next; } break; @@ -2607,7 +2565,7 @@ Both must be integers or markers. */) CHECK_NUMBER_COERCE_MARKER (y); if (XFASTINT (y) == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); XSETINT (val, XINT (x) % XINT (y)); return val; @@ -2656,7 +2614,7 @@ Both X and Y must be numbers or markers. */) i2 = XINT (y); if (i2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); i1 %= i2; @@ -3260,7 +3218,7 @@ arith_error (signo) #endif /* not BSD4_1 */ SIGNAL_THREAD_CHECK (signo); - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); } void diff --git a/src/dired.c b/src/dired.c index fe3382fd7a7..1aea81c2a21 100644 --- a/src/dired.c +++ b/src/dired.c @@ -100,6 +100,7 @@ extern struct direct *readdir (); #include "charset.h" #include "coding.h" #include "regex.h" +#include "blockinput.h" /* Returns a search buffer, with a fastmap allocated and ready to go. */ extern struct re_pattern_buffer *compile_pattern (); @@ -952,10 +953,12 @@ Elements of the attribute list are: } else { + BLOCK_INPUT; pw = (struct passwd *) getpwuid (s.st_uid); values[2] = (pw ? build_string (pw->pw_name) : make_number (s.st_uid)); gr = (struct group *) getgrgid (s.st_gid); values[3] = (gr ? build_string (gr->gr_name) : make_number (s.st_gid)); + UNBLOCK_INPUT; } values[4] = make_time (s.st_atime); values[5] = make_time (s.st_mtime); diff --git a/src/dispextern.h b/src/dispextern.h index 0acaf6b38ec..3cd9eb6052a 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -2982,7 +2982,6 @@ int scrolling P_ ((struct frame *)); void do_pending_window_change P_ ((int)); void change_frame_size P_ ((struct frame *, int, int, int, int, int)); void bitch_at_user P_ ((void)); -Lisp_Object sit_for P_ ((int, int, int, int, int)); void init_display P_ ((void)); void syms_of_display P_ ((void)); extern Lisp_Object Qredisplay_dont_pause; diff --git a/src/dispnew.c b/src/dispnew.c index bf0d0044491..f621aef273a 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6481,31 +6481,43 @@ Emacs was built without floating point support. /* This is just like wait_reading_process_output, except that - it does the redisplay. + it does redisplay. - It's also much like Fsit_for, except that it can be used for - waiting for input as well. */ + TIMEOUT is number of seconds to wait (float or integer). + READING is 1 if reading input. + If DO_DISPLAY is >0 display process output while waiting. + If DO_DISPLAY is >1 perform an initial redisplay before waiting. +*/ Lisp_Object -sit_for (sec, usec, reading, display, initial_display) - int sec, usec, reading, display, initial_display; +sit_for (timeout, reading, do_display) + Lisp_Object timeout; + int reading, do_display; { - int preempt = (sec > 0) || (sec == 0 && usec >= 0); + int sec, usec; - swallow_events (display); + swallow_events (do_display); - if ((detect_input_pending_run_timers (display) && preempt) + if ((detect_input_pending_run_timers (do_display)) || !NILP (Vexecuting_kbd_macro)) return Qnil; - if (initial_display) + if (do_display >= 2) + redisplay_preserve_echo_area (2); + + if (INTEGERP (timeout)) { - int count = SPECPDL_INDEX (); - if (!preempt) - specbind (Qredisplay_dont_pause, Qt); - redisplay_preserve_echo_area (2); - unbind_to (count, Qnil); + sec = XINT (timeout); + usec = 0; } + else if (FLOATP (timeout)) + { + double seconds = XFLOAT_DATA (timeout); + sec = (int) seconds; + usec = (int) ((seconds - sec) * 1000000); + } + else + wrong_type_argument (Qnumberp, timeout); if (sec == 0 && usec == 0) return Qt; @@ -6514,63 +6526,34 @@ sit_for (sec, usec, reading, display, initial_display) gobble_input (0); #endif - wait_reading_process_output (sec, usec, reading ? -1 : 1, display, + wait_reading_process_output (sec, usec, reading ? -1 : 1, do_display, Qnil, NULL, 0); return detect_input_pending () ? Qnil : Qt; } -DEFUN ("sit-for", Fsit_for, Ssit_for, 1, 3, 0, - doc: /* Perform redisplay, then wait for SECONDS seconds or until input is available. -SECONDS may be a floating-point value, meaning that you can wait for a -fraction of a second. -\(Not all operating systems support waiting for a fraction of a second.) -Optional arg NODISP non-nil means don't redisplay, just wait for input. -Redisplay is preempted as always if input arrives, and does not happen -if input is available before it starts. -Value is t if waited the full time with no input arriving. - -Redisplay will occur even when input is available if SECONDS is negative. - -An obsolete but still supported form is -\(sit-for SECONDS &optional MILLISECONDS NODISP) -Where the optional arg MILLISECONDS specifies an additional wait period, -in milliseconds; this was useful when Emacs was built without -floating point support. -usage: (sit-for SECONDS &optional NODISP OLD-NODISP) */) - -/* The `old-nodisp' stuff is there so that the arglist has the correct - length. Otherwise, `defdvice' will redefine it with fewer args. */ - (seconds, milliseconds, nodisp) - Lisp_Object seconds, milliseconds, nodisp; +DEFUN ("redisplay", Fredisplay, Sredisplay, 0, 1, 0, + doc: /* Perform redisplay if no input is available. +If optional arg FORCE is non-nil or `redisplay-dont-pause' is non-nil, +perform a full redisplay even if input is available. */) + (force) + Lisp_Object force; { - int sec, usec; - - if (NILP (nodisp) && !NUMBERP (milliseconds)) - { /* New style. */ - nodisp = milliseconds; - milliseconds = Qnil; - } + int count; - if (NILP (milliseconds)) - XSETINT (milliseconds, 0); - else - CHECK_NUMBER (milliseconds); - usec = XINT (milliseconds) * 1000; - - { - double duration = extract_float (seconds); - sec = (int) duration; - usec += (duration - sec) * 1000000; - } - -#ifndef EMACS_HAS_USECS - if (usec != 0 && sec == 0) - error ("Millisecond `sit-for' not supported on %s", SYSTEM_TYPE); -#endif + swallow_events (1); + if ((detect_input_pending_run_timers (1) + && NILP (force) && !redisplay_dont_pause) + || !NILP (Vexecuting_kbd_macro)) + return Qnil; - return sit_for (sec, usec, 0, NILP (nodisp), NILP (nodisp)); + count = SPECPDL_INDEX (); + if (!NILP (force) && !redisplay_dont_pause) + specbind (Qredisplay_dont_pause, Qt); + redisplay_preserve_echo_area (2); + unbind_to (count, Qnil); + return Qt; } @@ -6828,9 +6811,15 @@ init_display () For types defined in VMS, use set term /device=TYPE.\n\ For types not defined in VMS, use define emacs_term \"TYPE\".\n\ \(The quotation marks are necessary since terminal types are lower case.)\n"); -#else - fprintf (stderr, "Please set the environment variable TERM; see tset(1).\n"); -#endif +#else /* not VMS */ + +#ifdef HAVE_WINDOW_SYSTEM + if (! inhibit_window_system) + fprintf (stderr, "Please set the environment variable DISPLAY or TERM (see `tset').\n"); + else +#endif /* HAVE_WINDOW_SYSTEM */ + fprintf (stderr, "Please set the environment variable TERM; see `tset'.\n"); +#endif /* not VMS */ exit (1); } @@ -6960,7 +6949,7 @@ syms_of_display () defsubr (&Sframe_or_buffer_changed_p); defsubr (&Sopen_termscript); defsubr (&Sding); - defsubr (&Ssit_for); + defsubr (&Sredisplay); defsubr (&Ssleep_for); defsubr (&Ssend_string_to_terminal); defsubr (&Sinternal_show_cursor); diff --git a/src/doc.c b/src/doc.c index a69c3cf4382..ecb0197b3ca 100644 --- a/src/doc.c +++ b/src/doc.c @@ -416,7 +416,7 @@ string is passed through `substitute-command-keys'. */) { funcar = Fcar (fun); if (!SYMBOLP (funcar)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); else if (EQ (funcar, Qkeymap)) return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); else if (EQ (funcar, Qlambda) @@ -443,7 +443,7 @@ string is passed through `substitute-command-keys'. */) else { oops: - Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); } /* If DOC is 0, it's typically because of a dumped file missing diff --git a/src/editfns.c b/src/editfns.c index d758e82bbb0..46d661452b2 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -56,6 +56,7 @@ Boston, MA 02110-1301, USA. */ #include "coding.h" #include "frame.h" #include "window.h" +#include "blockinput.h" #ifdef STDC_HEADERS #include <float.h> @@ -313,7 +314,7 @@ region_limit (beginningp) if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) && NILP (current_buffer->mark_active)) - Fsignal (Qmark_inactive, Qnil); + xsignal0 (Qmark_inactive); m = Fmarker_position (current_buffer->mark); if (NILP (m)) @@ -1300,7 +1301,9 @@ with that uid, or nil if there is no such user. */) return Vuser_login_name; CHECK_NUMBER (uid); + BLOCK_INPUT; pw = (struct passwd *) getpwuid (XINT (uid)); + UNBLOCK_INPUT; return (pw ? build_string (pw->pw_name) : Qnil); } @@ -1354,9 +1357,17 @@ name, or nil if there is no such user. */) if (NILP (uid)) return Vuser_full_name; else if (NUMBERP (uid)) - pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); + { + BLOCK_INPUT; + pw = (struct passwd *) getpwuid ((uid_t) XFLOATINT (uid)); + UNBLOCK_INPUT; + } else if (STRINGP (uid)) - pw = (struct passwd *) getpwnam (SDATA (uid)); + { + BLOCK_INPUT; + pw = (struct passwd *) getpwnam (SDATA (uid)); + UNBLOCK_INPUT; + } else error ("Invalid UID specification"); @@ -1467,7 +1478,7 @@ systems that do not provide resolution finer than a second. */) if (getrusage (RUSAGE_SELF, &usage) < 0) /* This shouldn't happen. What action is appropriate? */ - Fsignal (Qerror, Qnil); + xsignal0 (Qerror); /* Sum up user time and system time. */ secs = usage.ru_utime.tv_sec + usage.ru_stime.tv_sec; @@ -2127,7 +2138,6 @@ general_insert_function (insert_func, insert_from_string_func, for (argnum = 0; argnum < nargs; argnum++) { val = args[argnum]; - retry: if (INTEGERP (val)) { unsigned char str[MAX_MULTIBYTE_LENGTH]; @@ -2152,10 +2162,7 @@ general_insert_function (insert_func, insert_from_string_func, inherit); } else - { - val = wrong_type_argument (Qchar_or_string_p, val); - goto retry; - } + wrong_type_argument (Qchar_or_string_p, val); } } @@ -4011,7 +4018,7 @@ usage: (format STRING &rest OBJECTS) */) /* Likewise adjust the property end position. */ pos = XINT (XCAR (XCDR (item))); - for (; bytepos < pos; bytepos++) + for (; position < pos; bytepos++) { if (! discarded[bytepos]) position++, translated++; diff --git a/src/eval.c b/src/eval.c index 30df5f8ea36..0d7a6a31038 100644 --- a/src/eval.c +++ b/src/eval.c @@ -198,6 +198,7 @@ Lisp_Object Vmacro_declaration_function; extern Lisp_Object Qrisky_local_variable; static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*)); +static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN; void init_eval_once () @@ -983,9 +984,7 @@ usage: (let* VARLIST BODY...) */) if (SYMBOLP (elt)) specbind (elt, Qnil); else if (! NILP (Fcdr (Fcdr (elt)))) - Fsignal (Qerror, - Fcons (build_string ("`let' bindings can have only one value-form"), - elt)); + signal_error ("`let' bindings can have only one value-form", elt); else { val = Feval (Fcar (Fcdr (elt))); @@ -1032,9 +1031,7 @@ usage: (let VARLIST BODY...) */) if (SYMBOLP (elt)) temps [argnum++] = Qnil; else if (! NILP (Fcdr (Fcdr (elt)))) - Fsignal (Qerror, - Fcons (build_string ("`let' bindings can have only one value-form"), - elt)); + signal_error ("`let' bindings can have only one value-form", elt); else temps [argnum++] = Feval (Fcar (Fcdr (elt))); gcpro2.nvars = argnum; @@ -1289,16 +1286,13 @@ Both TAG and VALUE are evalled. */) { register struct catchtag *c; - while (1) - { - if (!NILP (tag)) - for (c = catchlist; c; c = c->next) - { - if (EQ (c->tag, tag)) - unwind_to_catch (c, value); - } - tag = Fsignal (Qno_catch, Fcons (tag, Fcons (value, Qnil))); - } + if (!NILP (tag)) + for (c = catchlist; c; c = c->next) + { + if (EQ (c->tag, tag)) + unwind_to_catch (c, value); + } + xsignal2 (Qno_catch, tag, value); } @@ -1706,6 +1700,78 @@ See also the function `condition-case'. */) fatal ("%s", SDATA (string), 0); } +/* Internal version of Fsignal that never returns. + Used for anything but Qquit (which can return from Fsignal). */ + +void +xsignal (error_symbol, data) + Lisp_Object error_symbol, data; +{ + Fsignal (error_symbol, data); + abort (); +} + +/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */ + +void +xsignal0 (error_symbol) + Lisp_Object error_symbol; +{ + xsignal (error_symbol, Qnil); +} + +void +xsignal1 (error_symbol, arg) + Lisp_Object error_symbol, arg; +{ + xsignal (error_symbol, list1 (arg)); +} + +void +xsignal2 (error_symbol, arg1, arg2) + Lisp_Object error_symbol, arg1, arg2; +{ + xsignal (error_symbol, list2 (arg1, arg2)); +} + +void +xsignal3 (error_symbol, arg1, arg2, arg3) + Lisp_Object error_symbol, arg1, arg2, arg3; +{ + xsignal (error_symbol, list3 (arg1, arg2, arg3)); +} + +/* Signal `error' with message S, and additional arg ARG. + If ARG is not a genuine list, make it a one-element list. */ + +void +signal_error (s, arg) + char *s; + Lisp_Object arg; +{ + Lisp_Object tortoise, hare; + + hare = tortoise = arg; + while (CONSP (hare)) + { + hare = XCDR (hare); + if (!CONSP (hare)) + break; + + hare = XCDR (hare); + tortoise = XCDR (tortoise); + + if (EQ (hare, tortoise)) + break; + } + + if (!NILP (hare)) + arg = Fcons (arg, Qnil); /* Make it a list. */ + + xsignal (Qerror, Fcons (build_string (s), arg)); +} + + /* Return nonzero iff LIST is a non-nil atom or a list containing one of CONDITIONS. */ @@ -1920,8 +1986,7 @@ error (m, a1, a2, a3) if (allocated) xfree (buffer); - Fsignal (Qerror, Fcons (string, Qnil)); - abort (); + xsignal1 (Qerror, string); } DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0, @@ -2166,7 +2231,12 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, /* At this point, only original_fun and original_args have values that will be used below */ retry: - fun = Findirect_function (original_fun, Qnil); + + /* Optimize for no indirection. */ + fun = original_fun; + if (SYMBOLP (fun) && !EQ (fun, Qunbound) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + fun = indirect_function (fun); if (SUBRP (fun)) { @@ -2182,7 +2252,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, if (XINT (numargs) < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs))) - return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil))); + xsignal2 (Qwrong_number_of_arguments, original_fun, numargs); if (XSUBR (fun)->max_args == UNEVALLED) { @@ -2285,11 +2355,13 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, val = apply_lambda (fun, original_args, 1); else { + if (EQ (fun, Qunbound)) + xsignal1 (Qvoid_function, original_fun); if (!CONSP (fun)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); - funcar = Fcar (fun); + xsignal1 (Qinvalid_function, original_fun); + funcar = XCAR (fun); if (!SYMBOLP (funcar)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); if (EQ (funcar, Qautoload)) { do_autoload (fun, original_fun); @@ -2300,7 +2372,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, else if (EQ (funcar, Qlambda)) val = apply_lambda (fun, original_args, 1); else - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); } done: CHECK_CONS_LIST (); @@ -2345,7 +2417,10 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) numargs += nargs - 2; - fun = indirect_function (fun); + /* Optimize for no indirection. */ + if (SYMBOLP (fun) && !EQ (fun, Qunbound) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + fun = indirect_function (fun); if (EQ (fun, Qunbound)) { /* Let funcall get the error */ @@ -2824,7 +2899,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) int nargs; Lisp_Object *args; { - Lisp_Object fun; + Lisp_Object fun, original_fun; Lisp_Object funcar; int numargs = nargs - 1; Lisp_Object lisp_numargs; @@ -2861,11 +2936,15 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) CHECK_CONS_LIST (); - retry: + original_fun = args[0]; - fun = args[0]; + retry: - fun = Findirect_function (fun, Qnil); + /* Optimize for no indirection. */ + fun = original_fun; + if (SYMBOLP (fun) && !EQ (fun, Qunbound) + && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + fun = indirect_function (fun); if (SUBRP (fun)) { @@ -2873,11 +2952,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) { XSETFASTINT (lisp_numargs, numargs); - return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil))); + xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs); } if (XSUBR (fun)->max_args == UNEVALLED) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); if (XSUBR (fun)->max_args == MANY) { @@ -2949,21 +3028,23 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) val = funcall_lambda (fun, numargs, args + 1); else { + if (EQ (fun, Qunbound)) + xsignal1 (Qvoid_function, original_fun); if (!CONSP (fun)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); - funcar = Fcar (fun); + xsignal1 (Qinvalid_function, original_fun); + funcar = XCAR (fun); if (!SYMBOLP (funcar)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); if (EQ (funcar, Qlambda)) val = funcall_lambda (fun, numargs, args + 1); else if (EQ (funcar, Qautoload)) { - do_autoload (fun, args[0]); + do_autoload (fun, original_fun); CHECK_CONS_LIST (); goto retry; } else - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, original_fun); } done: CHECK_CONS_LIST (); @@ -3039,7 +3120,7 @@ funcall_lambda (fun, nargs, arg_vector) if (CONSP (syms_left)) syms_left = XCAR (syms_left); else - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); } else if (COMPILEDP (fun)) syms_left = AREF (fun, COMPILED_ARGLIST); @@ -3052,8 +3133,8 @@ funcall_lambda (fun, nargs, arg_vector) QUIT; next = XCAR (syms_left); - while (!SYMBOLP (next)) - next = Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + if (!SYMBOLP (next)) + xsignal1 (Qinvalid_function, fun); if (EQ (next, Qand_rest)) rest = 1; @@ -3067,17 +3148,15 @@ funcall_lambda (fun, nargs, arg_vector) else if (i < nargs) specbind (next, arg_vector[i++]); else if (!optional) - return Fsignal (Qwrong_number_of_arguments, - Fcons (fun, Fcons (make_number (nargs), Qnil))); + xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); else specbind (next, Qnil); } if (!NILP (syms_left)) - return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); + xsignal1 (Qinvalid_function, fun); else if (i < nargs) - return Fsignal (Qwrong_number_of_arguments, - Fcons (fun, Fcons (make_number (nargs), Qnil))); + xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); if (CONSP (fun)) val = Fprogn (XCDR (XCDR (fun))); @@ -3129,8 +3208,7 @@ grow_specpdl () if (max_specpdl_size < 400) max_specpdl_size = 400; if (specpdl_size >= max_specpdl_size) - Fsignal (Qerror, - Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil)); + signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil); } specpdl_size *= 2; if (specpdl_size > max_specpdl_size) diff --git a/src/fileio.c b/src/fileio.c index 82af5cf6cf9..a8408927f5c 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -77,6 +77,7 @@ extern int errno; #include "character.h" #include "coding.h" #include "window.h" +#include "blockinput.h" #ifdef WINDOWSNT #define NOMINMAX 1 @@ -282,7 +283,7 @@ report_file_error (string, data) switch (errorno) { case EEXIST: - Fsignal (Qfile_already_exists, Fcons (errstring, data)); + xsignal (Qfile_already_exists, Fcons (errstring, data)); break; default: /* System error messages are capitalized. Downcase the initial @@ -290,7 +291,7 @@ report_file_error (string, data) if (SREF (errstring, 1) != '/') SSET (errstring, 0, DOWNCASE (SREF (errstring, 0))); - Fsignal (Qfile_error, + xsignal (Qfile_error, Fcons (build_string (string), Fcons (errstring, data))); } } @@ -1390,7 +1391,9 @@ See also the function `substitute-in-file-name'. */) bcopy ((char *) nm, o, p - nm); o [p - nm] = 0; + BLOCK_INPUT; pw = (struct passwd *) getpwnam (o + 1); + UNBLOCK_INPUT; if (pw) { newdir = (unsigned char *) pw -> pw_dir; @@ -1921,7 +1924,9 @@ See also the function `substitute-in-file-name'.") o[len] = 0; /* Look up the user name. */ + BLOCK_INPUT; pw = (struct passwd *) getpwnam (o + 1); + UNBLOCK_INPUT; if (!pw) error ("\"%s\" isn't a registered user", o + 1); @@ -2115,10 +2120,11 @@ search_embedded_absfilename (nm, endp) /* If we have ~user and `user' exists, discard everything up to ~. But if `user' does not exist, leave ~user alone, it might be a literal file name. */ - if ((pw = getpwnam (o + 1))) + BLOCK_INPUT; + pw = getpwnam (o + 1); + UNBLOCK_INPUT; + if (pw) return p; - else - xfree (pw); } else return p; @@ -2383,9 +2389,8 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) if (lstat (SDATA (encoded_filename), &statbuf) >= 0) { if (! interactive) - Fsignal (Qfile_already_exists, - Fcons (build_string ("File already exists"), - Fcons (absname, Qnil))); + xsignal2 (Qfile_already_exists, + build_string ("File already exists"), absname); GCPRO1 (absname); tem = format2 ("File %s already exists; %s anyway? ", absname, build_string (querystring)); @@ -2395,9 +2400,8 @@ barf_or_query_if_file_exists (absname, querystring, interactive, statptr, quick) tem = do_yes_or_no_p (tem); UNGCPRO; if (NILP (tem)) - Fsignal (Qfile_already_exists, - Fcons (build_string ("File already exists"), - Fcons (absname, Qnil))); + xsignal2 (Qfile_already_exists, + build_string ("File already exists"), absname); if (statptr) *statptr = statbuf; } @@ -2499,9 +2503,8 @@ uid and gid of FILE to NEWNAME. */) { /* Restore original attributes. */ SetFileAttributes (filename, attributes); - Fsignal (Qfile_date_error, - Fcons (build_string ("Cannot set file date"), - Fcons (newname, Qnil))); + xsignal2 (Qfile_date_error, + build_string ("Cannot set file date"), newname); } /* Restore original attributes. */ SetFileAttributes (filename, attributes); @@ -2597,9 +2600,8 @@ uid and gid of FILE to NEWNAME. */) EMACS_SET_SECS_USECS (mtime, st.st_mtime, 0); if (set_file_times (SDATA (encoded_newname), atime, mtime)) - Fsignal (Qfile_date_error, - Fcons (build_string ("Cannot set file date"), - Fcons (newname, Qnil))); + xsignal2 (Qfile_date_error, + build_string ("Cannot set file date"), newname); } } @@ -2695,9 +2697,9 @@ If file has multiple names, it continues to exist with the other names. */) GCPRO1 (filename); if (!NILP (Ffile_directory_p (filename)) && NILP (Ffile_symlink_p (filename))) - Fsignal (Qfile_error, - Fcons (build_string ("Removing old name: is a directory"), - Fcons (filename, Qnil))); + xsignal2 (Qfile_error, + build_string ("Removing old name: is a directory"), + filename); UNGCPRO; filename = Fexpand_file_name (filename, Qnil); @@ -3851,9 +3853,8 @@ actually used. */) goto notfound; if (! NILP (replace) || ! NILP (beg) || ! NILP (end)) - Fsignal (Qfile_error, - Fcons (build_string ("not a regular file"), - Fcons (orig_filename, Qnil))); + xsignal2 (Qfile_error, + build_string ("not a regular file"), orig_filename); } #endif @@ -4690,9 +4691,8 @@ actually used. */) } #endif /* CLASH_DETECTION */ if (not_regular) - Fsignal (Qfile_error, - Fcons (build_string ("not a regular file"), - Fcons (orig_filename, Qnil))); + xsignal2 (Qfile_error, + build_string ("not a regular file"), orig_filename); } if (set_coding_system) @@ -5763,7 +5763,11 @@ static Lisp_Object do_auto_save_make_dir (dir) Lisp_Object dir; { - return call2 (Qmake_directory, dir, Qt); + Lisp_Object mode; + + call2 (Qmake_directory, dir, Qt); + XSETFASTINT (mode, 0700); + return Fset_file_modes (dir, mode); } static Lisp_Object @@ -5961,7 +5965,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) { /* If we are going to restore an old message, give time to read ours. */ - sit_for (1, 0, 0, 0, 0); + sit_for (make_number (1), 0, 0); restore_message (); } else @@ -6530,19 +6534,17 @@ of file names regardless of the current language environment. */); staticpro (&Qcar_less_than_car); Fput (Qfile_error, Qerror_conditions, - Fcons (Qfile_error, Fcons (Qerror, Qnil))); + list2 (Qfile_error, Qerror)); Fput (Qfile_error, Qerror_message, build_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, - Fcons (Qfile_already_exists, - Fcons (Qfile_error, Fcons (Qerror, Qnil)))); + list3 (Qfile_already_exists, Qfile_error, Qerror)); Fput (Qfile_already_exists, Qerror_message, build_string ("File already exists")); Fput (Qfile_date_error, Qerror_conditions, - Fcons (Qfile_date_error, - Fcons (Qfile_error, Fcons (Qerror, Qnil)))); + list3 (Qfile_date_error, Qfile_error, Qerror)); Fput (Qfile_date_error, Qerror_message, build_string ("Cannot set file date")); diff --git a/src/floatfns.c b/src/floatfns.c index d5ca50f9165..dd879de7eb8 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -201,17 +201,15 @@ static char *float_error_fn_name; while (0) #define arith_error(op,arg) \ - Fsignal (Qarith_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) + xsignal2 (Qarith_error, build_string ((op)), (arg)) #define range_error(op,arg) \ - Fsignal (Qrange_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) + xsignal2 (Qrange_error, build_string ((op)), (arg)) #define range_error2(op,a1,a2) \ - Fsignal (Qrange_error, Fcons (build_string ((op)), \ - Fcons ((a1), Fcons ((a2), Qnil)))) + xsignal3 (Qrange_error, build_string ((op)), (a1), (a2)) #define domain_error(op,arg) \ - Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) + xsignal2 (Qdomain_error, build_string ((op)), (arg)) #define domain_error2(op,a1,a2) \ - Fsignal (Qdomain_error, Fcons (build_string ((op)), \ - Fcons ((a1), Fcons ((a2), Qnil)))) + xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2)) /* Extract a Lisp number as a `double', or signal an error. */ @@ -756,7 +754,7 @@ rounding_driver (arg, divisor, double_round, int_round2, name) f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor)); if (! IEEE_FLOATING_POINT && f2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor); FLOAT_TO_INT2 (f1, arg, name, arg, divisor); @@ -767,7 +765,7 @@ rounding_driver (arg, divisor, double_round, int_round2, name) i2 = XINT (divisor); if (i2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); XSETINT (arg, (*int_round2) (i1, i2)); return arg; @@ -907,7 +905,7 @@ fmod_float (x, y) f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); if (! IEEE_FLOATING_POINT && f2 == 0) - Fsignal (Qarith_error, Qnil); + xsignal0 (Qarith_error); /* If the "remainder" comes out with the wrong sign, fix it. */ IN_FLOAT2 ((f1 = fmod (f1, f2), @@ -986,7 +984,7 @@ float_error (signo) SIGNAL_THREAD_CHECK (signo); in_float = 0; - Fsignal (Qarith_error, Fcons (float_error_arg, Qnil)); + xsignal1 (Qarith_error, float_error_arg); } /* Another idea was to replace the library function `infnan' @@ -1014,11 +1012,11 @@ matherr (x) : Qnil))); switch (x->type) { - case DOMAIN: Fsignal (Qdomain_error, args); break; - case SING: Fsignal (Qsingularity_error, args); break; - case OVERFLOW: Fsignal (Qoverflow_error, args); break; - case UNDERFLOW: Fsignal (Qunderflow_error, args); break; - default: Fsignal (Qarith_error, args); break; + case DOMAIN: xsignal (Qdomain_error, args); break; + case SING: xsignal (Qsingularity_error, args); break; + case OVERFLOW: xsignal (Qoverflow_error, args); break; + case UNDERFLOW: xsignal (Qunderflow_error, args); break; + default: xsignal (Qarith_error, args); break; } return (1); /* don't set errno or print a message */ } diff --git a/src/fns.c b/src/fns.c index 3b4b3e5149b..4c1e5b79ae2 100644 --- a/src/fns.c +++ b/src/fns.c @@ -147,7 +147,6 @@ To get the number of bytes, use `string-bytes'. */) register Lisp_Object val; register int i; - retry: if (STRINGP (sequence)) XSETFASTINT (val, SCHARS (sequence)); else if (VECTORP (sequence)) @@ -174,18 +173,15 @@ To get the number of bytes, use `string-bytes'. */) QUIT; } - if (!NILP (sequence)) - wrong_type_argument (Qlistp, sequence); + CHECK_LIST_END (sequence, sequence); val = make_number (i); } else if (NILP (sequence)) XSETFASTINT (val, 0); else - { - sequence = wrong_type_argument (Qsequencep, sequence); - goto retry; - } + wrong_type_argument (Qsequencep, sequence); + return val; } @@ -488,7 +484,8 @@ with the original. */) } if (!CONSP (arg) && !VECTORP (arg) && !STRINGP (arg)) - arg = wrong_type_argument (Qsequencep, arg); + wrong_type_argument (Qsequencep, arg); + return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0); } @@ -540,15 +537,13 @@ concat (nargs, args, target_type, last_special) else last_tail = Qnil; - /* Canonicalize each argument. */ + /* Check each argument. */ for (argnum = 0; argnum < nargs; argnum++) { this = args[argnum]; if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this) || COMPILEDP (this) || BOOL_VECTOR_P (this))) - { - args[argnum] = wrong_type_argument (Qsequencep, this); - } + wrong_type_argument (Qsequencep, this); } /* Compute total length in chars of arguments in RESULT_LEN. @@ -575,8 +570,7 @@ concat (nargs, args, target_type, last_special) for (i = 0; i < len; i++) { ch = XVECTOR (this)->contents[i]; - if (! CHARACTERP (ch)) - wrong_type_argument (Qcharacterp, ch); + CHECK_CHARACTER (ch); this_len_byte = CHAR_BYTES (XINT (ch)); result_len_byte += this_len_byte; if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch))) @@ -588,8 +582,7 @@ concat (nargs, args, target_type, last_special) for (; CONSP (this); this = XCDR (this)) { ch = XCAR (this); - if (! CHARACTERP (ch)) - wrong_type_argument (Qcharacterp, ch); + CHECK_CHARACTER (ch); this_len_byte = CHAR_BYTES (XINT (ch)); result_len_byte += this_len_byte; if (! ASCII_CHAR_P (XINT (ch)) && ! CHAR_BYTE8_P (XINT (ch))) @@ -1171,9 +1164,7 @@ This function allows vectors as well as strings. */) int from_char, to_char; int from_byte = 0, to_byte = 0; - if (! (STRINGP (string) || VECTORP (string))) - wrong_type_argument (Qarrayp, string); - + CHECK_VECTOR_OR_STRING (string); CHECK_NUMBER (from); if (STRINGP (string)) @@ -1297,8 +1288,7 @@ substring_both (string, from, from_byte, to, to_byte) int size; int size_byte; - if (! (STRINGP (string) || VECTORP (string))) - wrong_type_argument (Qarrayp, string); + CHECK_VECTOR_OR_STRING (string); if (STRINGP (string)) { @@ -1338,8 +1328,7 @@ DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0, for (i = 0; i < num && !NILP (list); i++) { QUIT; - if (! CONSP (list)) - wrong_type_argument (Qlistp, list); + CHECK_LIST_CONS (list, list); list = XCDR (list); } return list; @@ -1360,16 +1349,12 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, register Lisp_Object sequence, n; { CHECK_NUMBER (n); - while (1) - { - if (CONSP (sequence) || NILP (sequence)) - return Fcar (Fnthcdr (n, sequence)); - else if (STRINGP (sequence) || VECTORP (sequence) - || BOOL_VECTOR_P (sequence) || CHAR_TABLE_P (sequence)) - return Faref (sequence, n); - else - sequence = wrong_type_argument (Qsequencep, sequence); - } + if (CONSP (sequence) || NILP (sequence)) + return Fcar (Fnthcdr (n, sequence)); + + /* Faref signals a "not array" error, so check here. */ + CHECK_ARRAY (sequence, Qsequencep); + return Faref (sequence, n); } DEFUN ("member", Fmember, Smember, 2, 2, 0, @@ -1383,8 +1368,7 @@ The value is actually the tail of LIST whose car is ELT. */) for (tail = list; !NILP (tail); tail = XCDR (tail)) { register Lisp_Object tem; - if (! CONSP (tail)) - wrong_type_argument (Qlistp, list); + CHECK_LIST_CONS (tail, list); tem = XCAR (tail); if (! NILP (Fequal (elt, tem))) return tail; @@ -1417,9 +1401,7 @@ whose car is ELT. */) QUIT; } - if (!CONSP (list) && !NILP (list)) - list = wrong_type_argument (Qlistp, list); - + CHECK_LIST (list); return list; } @@ -1430,8 +1412,6 @@ Elements of LIST that are not conses are ignored. */) (key, list) Lisp_Object key, list; { - Lisp_Object result; - while (1) { if (!CONSP (list) @@ -1455,14 +1435,7 @@ Elements of LIST that are not conses are ignored. */) QUIT; } - if (CONSP (list)) - result = XCAR (list); - else if (NILP (list)) - result = Qnil; - else - result = wrong_type_argument (Qlistp, list); - - return result; + return CAR (list); } /* Like Fassq but never report an error and do not allow quits. @@ -1477,7 +1450,7 @@ assq_no_quit (key, list) || !EQ (XCAR (XCAR (list)), key))) list = XCDR (list); - return CONSP (list) ? XCAR (list) : Qnil; + return CAR_SAFE (list); } DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, @@ -1486,7 +1459,7 @@ The value is actually the first element of LIST whose car equals KEY. */) (key, list) Lisp_Object key, list; { - Lisp_Object result, car; + Lisp_Object car; while (1) { @@ -1514,14 +1487,7 @@ The value is actually the first element of LIST whose car equals KEY. */) QUIT; } - if (CONSP (list)) - result = XCAR (list); - else if (NILP (list)) - result = Qnil; - else - result = wrong_type_argument (Qlistp, list); - - return result; + return CAR (list); } /* Like Fassoc but never report an error and do not allow quits. @@ -1547,8 +1513,6 @@ The value is actually the first element of LIST whose cdr is KEY. */) register Lisp_Object key; Lisp_Object list; { - Lisp_Object result; - while (1) { if (!CONSP (list) @@ -1572,14 +1536,7 @@ The value is actually the first element of LIST whose cdr is KEY. */) QUIT; } - if (NILP (list)) - result = Qnil; - else if (CONSP (list)) - result = XCAR (list); - else - result = wrong_type_argument (Qlistp, list); - - return result; + return CAR (list); } DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, @@ -1588,7 +1545,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */) (key, list) Lisp_Object key, list; { - Lisp_Object result, cdr; + Lisp_Object cdr; while (1) { @@ -1616,14 +1573,7 @@ The value is actually the first element of LIST whose cdr equals KEY. */) QUIT; } - if (CONSP (list)) - result = XCAR (list); - else if (NILP (list)) - result = Qnil; - else - result = wrong_type_argument (Qlistp, list); - - return result; + return CAR (list); } DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0, @@ -1643,8 +1593,7 @@ to be sure of changing the value of `foo'. */) prev = Qnil; while (!NILP (tail)) { - if (! CONSP (tail)) - wrong_type_argument (Qlistp, list); + CHECK_LIST_CONS (tail, list); tem = XCAR (tail); if (EQ (elt, tem)) { @@ -1766,8 +1715,7 @@ to be sure of changing the value of `foo'. */) for (tail = seq, prev = Qnil; !NILP (tail); tail = XCDR (tail)) { - if (!CONSP (tail)) - wrong_type_argument (Qlistp, seq); + CHECK_LIST_CONS (tail, seq); if (!NILP (Fequal (elt, XCAR (tail)))) { @@ -1799,8 +1747,7 @@ Return the reversed list. */) while (!NILP (tail)) { QUIT; - if (! CONSP (tail)) - wrong_type_argument (Qlistp, list); + CHECK_LIST_CONS (tail, list); next = XCDR (tail); Fsetcdr (tail, prev); prev = tail; @@ -1822,8 +1769,7 @@ See also the function `nreverse', which is used more often. */) QUIT; new = Fcons (XCAR (list), new); } - if (!NILP (list)) - wrong_type_argument (Qconsp, list); + CHECK_LIST_END (list, list); return new; } @@ -1947,8 +1893,7 @@ one of the properties on the list. */) QUIT; } - if (!NILP (tail)) - wrong_type_argument (Qlistp, prop); + CHECK_LIST_END (tail, prop); return Qnil; } @@ -2064,8 +2009,7 @@ one of the properties on the list. */) QUIT; } - if (!NILP (tail)) - wrong_type_argument (Qlistp, prop); + CHECK_LIST_END (tail, prop); return Qnil; } @@ -2280,7 +2224,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */) Lisp_Object array, item; { register int size, index, charval; - retry: if (VECTORP (array)) { register Lisp_Object *p = XVECTOR (array)->contents; @@ -2344,10 +2287,7 @@ ARRAY is a vector, string, char-table, or bool-vector. */) } } else - { - array = wrong_type_argument (Qarrayp, array); - goto retry; - } + wrong_type_argument (Qarrayp, array); return array; } @@ -2405,8 +2345,7 @@ usage: (nconc &rest LISTS) */) if (argnum + 1 == nargs) break; - if (!CONSP (tem)) - tem = wrong_type_argument (Qlistp, tem); + CHECK_LIST_CONS (tem, tem); while (CONSP (tem)) { @@ -3923,10 +3862,7 @@ hashfn_user_defined (h, key) args[1] = key; hash = Ffuncall (2, args); if (!INTEGERP (hash)) - Fsignal (Qerror, - list2 (build_string ("Invalid hash code returned from \ -user-supplied hash function"), - hash)); + signal_error ("Invalid hash code returned from user-supplied hash function", hash); return XUINT (hash); } @@ -4682,8 +4618,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) prop = Fget (test, Qhash_table_test); if (!CONSP (prop) || !CONSP (XCDR (prop))) - Fsignal (Qerror, list2 (build_string ("Invalid hash table test"), - test)); + signal_error ("Invalid hash table test", test); user_test = XCAR (prop); user_hash = XCAR (XCDR (prop)); } @@ -4696,9 +4631,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) if (NILP (size)) size = make_number (DEFAULT_HASH_SIZE); else if (!INTEGERP (size) || XINT (size) < 0) - Fsignal (Qerror, - list2 (build_string ("Invalid hash table size"), - size)); + signal_error ("Invalid hash table size", size); /* Look for `:rehash-size SIZE'. */ i = get_key_arg (QCrehash_size, nargs, args, used); @@ -4706,9 +4639,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) if (!NUMBERP (rehash_size) || (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) || XFLOATINT (rehash_size) <= 1.0) - Fsignal (Qerror, - list2 (build_string ("Invalid hash table rehash size"), - rehash_size)); + signal_error ("Invalid hash table rehash size", rehash_size); /* Look for `:rehash-threshold THRESHOLD'. */ i = get_key_arg (QCrehash_threshold, nargs, args, used); @@ -4716,9 +4647,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) if (!FLOATP (rehash_threshold) || XFLOATINT (rehash_threshold) <= 0.0 || XFLOATINT (rehash_threshold) > 1.0) - Fsignal (Qerror, - list2 (build_string ("Invalid hash table rehash threshold"), - rehash_threshold)); + signal_error ("Invalid hash table rehash threshold", rehash_threshold); /* Look for `:weakness WEAK'. */ i = get_key_arg (QCweakness, nargs, args, used); @@ -4730,14 +4659,12 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) && !EQ (weak, Qvalue) && !EQ (weak, Qkey_or_value) && !EQ (weak, Qkey_and_value)) - Fsignal (Qerror, list2 (build_string ("Invalid hash table weakness"), - weak)); + signal_error ("Invalid hash table weakness", weak); /* Now, all args should have been used up, or there's a problem. */ for (i = 0; i < nargs; ++i) if (!used[i]) - Fsignal (Qerror, - list2 (build_string ("Invalid argument list"), args[i])); + signal_error ("Invalid argument list", args[i]); return make_hash_table (test, size, rehash_size, rehash_threshold, weak, user_test, user_hash); @@ -4987,8 +4914,7 @@ guesswork fails. Normally, an error is signaled in such case. */) if (!NILP (noerror)) coding_system = Qraw_text; else - while (1) - Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); + xsignal1 (Qcoding_system_error, coding_system); } if (STRING_MULTIBYTE (object)) @@ -5122,8 +5048,7 @@ guesswork fails. Normally, an error is signaled in such case. */) if (!NILP (noerror)) coding_system = Qraw_text; else - while (1) - Fsignal (Qcoding_system_error, Fcons (coding_system, Qnil)); + xsignal1 (Qcoding_system_error, coding_system); } } diff --git a/src/frame.c b/src/frame.c index 0eaab69e961..1f8c173b9db 100644 --- a/src/frame.c +++ b/src/frame.c @@ -3037,8 +3037,7 @@ x_set_line_spacing (f, new_value, old_value) else if (NATNUMP (new_value)) f->extra_line_spacing = XFASTINT (new_value); else - Fsignal (Qerror, Fcons (build_string ("Invalid line-spacing"), - Fcons (new_value, Qnil))); + signal_error ("Invalid line-spacing", new_value); if (FRAME_VISIBLE_P (f)) redraw_frame (f); } @@ -3058,8 +3057,7 @@ x_set_screen_gamma (f, new_value, old_value) /* The value 0.4545 is the normal viewing gamma. */ f->gamma = 1.0 / (0.4545 * XFLOATINT (new_value)); else - Fsignal (Qerror, Fcons (build_string ("Invalid screen-gamma"), - Fcons (new_value, Qnil))); + signal_error ("Invalid screen-gamma", new_value); clear_face_cache (0); } diff --git a/src/frame.h b/src/frame.h index 06976875759..bbf0c45d79b 100644 --- a/src/frame.h +++ b/src/frame.h @@ -772,18 +772,11 @@ typedef struct frame *FRAME_PTR; (f)->visible = (f)->async_visible, \ (f)->iconified = (f)->async_iconified) -#define CHECK_FRAME(x) \ - do { \ - if (! FRAMEP (x)) \ - x = wrong_type_argument (Qframep, (x)); \ - } while (0) - -#define CHECK_LIVE_FRAME(x) \ - do { \ - if (! FRAMEP (x) \ - || ! FRAME_LIVE_P (XFRAME (x))) \ - x = wrong_type_argument (Qframe_live_p, (x)); \ - } while (0) +#define CHECK_FRAME(x) \ + CHECK_TYPE (FRAMEP (x), Qframep, x) + +#define CHECK_LIVE_FRAME(x) \ + CHECK_TYPE (FRAMEP (x) && FRAME_LIVE_P (XFRAME (x)), Qframe_live_p, x) /* FOR_EACH_FRAME (LIST_VAR, FRAME_VAR) followed by a statement is a `for' loop which iterates over the elements of Vframe_list. The diff --git a/src/fringe.c b/src/fringe.c index ab55775189f..a42c2d70439 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -1398,7 +1398,7 @@ init_fringe_bitmap (which, fb, once_p) DEFUN ("define-fringe-bitmap", Fdefine_fringe_bitmap, Sdefine_fringe_bitmap, 2, 5, 0, doc: /* Define fringe bitmap BITMAP from BITS of size HEIGHT x WIDTH. -BITMAP is a symbol or string naming the new fringe bitmap. +BITMAP is a symbol identifying the new fringe bitmap. BITS is either a string or a vector of integers. HEIGHT is height of bitmap. If HEIGHT is nil, use length of BITS. WIDTH must be an integer between 1 and 16, or nil which defaults to 8. @@ -1423,7 +1423,7 @@ If BITMAP already exists, the existing definition is replaced. */) else if (VECTORP (bits)) h = XVECTOR (bits)->size; else - bits = wrong_type_argument (Qsequencep, bits); + wrong_type_argument (Qsequencep, bits); if (NILP (height)) fb.height = h; diff --git a/src/keyboard.c b/src/keyboard.c index b47df2bec7a..e58c78c84ac 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -242,6 +242,9 @@ static int inhibit_local_menu_bar_menus; /* Nonzero means C-g should cause immediate error-signal. */ int immediate_quit; +/* The user's hook function for outputting an error message. */ +Lisp_Object Vcommand_error_function; + /* The user's ERASE setting. */ Lisp_Object Vtty_erase_char; @@ -1003,7 +1006,7 @@ recursive_edit_1 () /* Handle throw from read_minibuf when using minibuffer while it's active but we're in another window. */ if (STRINGP (val)) - Fsignal (Qerror, Fcons (val, Qnil)); + xsignal1 (Qerror, val); return unbind_to (count, Qnil); } @@ -1230,52 +1233,47 @@ cmd_error_internal (data, context) Lisp_Object data; char *context; { - Lisp_Object stream; - int kill_emacs_p = 0; struct frame *sf = SELECTED_FRAME (); + /* The immediate context is not interesting for Quits, + since they are asyncronous. */ + if (EQ (XCAR (data), Qquit)) + Vsignaling_function = Qnil; + Vquit_flag = Qnil; Vinhibit_quit = Qt; - clear_message (1, 0); + /* Use user's specified output function if any. */ + if (!NILP (Vcommand_error_function)) + call3 (Vcommand_error_function, data, + build_string (context ? context : ""), + Vsignaling_function); /* If the window system or terminal frame hasn't been initialized - yet, or we're not interactive, it's best to dump this message out - to stderr and exit. */ - if (!sf->glyphs_initialized_p - /* This is the case of the frame dumped with Emacs, when we're - running under a window system. */ - || (!NILP (Vwindow_system) - && !inhibit_window_system - && FRAME_TERMCAP_P (sf)) - || noninteractive) - { - stream = Qexternal_debugging_output; - kill_emacs_p = 1; + yet, or we're not interactive, write the message to stderr and exit. */ + else if (!sf->glyphs_initialized_p + /* This is the case of the frame dumped with Emacs, when we're + running under a window system. */ + || (!NILP (Vwindow_system) + && !inhibit_window_system + && FRAME_TERMCAP_P (sf)) + || noninteractive) + { + print_error_message (data, Qexternal_debugging_output, + context, Vsignaling_function); + Fterpri (Qexternal_debugging_output); + Fkill_emacs (make_number (-1)); } else { + clear_message (1, 0); Fdiscard_input (); message_log_maybe_newline (); bitch_at_user (); - stream = Qt; - } - - /* The immediate context is not interesting for Quits, - since they are asyncronous. */ - if (EQ (XCAR (data), Qquit)) - Vsignaling_function = Qnil; - print_error_message (data, stream, context, Vsignaling_function); + print_error_message (data, Qt, context, Vsignaling_function); + } Vsignaling_function = Qnil; - - /* If the window system or terminal frame hasn't been initialized - yet, or we're in -batch mode, this error should cause Emacs to exit. */ - if (kill_emacs_p) - { - Fterpri (stream); - Fkill_emacs (make_number (-1)); - } } Lisp_Object command_loop_1 (); @@ -1490,7 +1488,8 @@ command_loop_1 () int count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); - Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil); + sit_for (Vminibuffer_message_timeout, 0, 2); + /* Clear the echo area. */ message2 (0, 0, 0); safe_run_hooks (Qecho_area_clear_hook); @@ -2689,8 +2688,6 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* Or not echoing before and echoing allowed. */ || (!echo_kboard && ok_to_echo_at_next_pause))) { - Lisp_Object tem0; - /* After a mouse event, start echoing right away. This is because we are probably about to display a menu, and we don't want to delay before doing so. */ @@ -2698,13 +2695,11 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) echo_now (); else { - int sec, usec; - double duration = extract_float (Vecho_keystrokes); - sec = (int) duration; - usec = (duration - sec) * 1000000; + Lisp_Object tem0; + save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); - tem0 = sit_for (sec, usec, 1, 1, 0); + tem0 = sit_for (Vecho_keystrokes, 1, 1); restore_getcjmp (save_jump); if (EQ (tem0, Qt) && ! CONSP (Vunread_command_events)) @@ -2771,11 +2766,11 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) && XINT (Vauto_save_timeout) > 0) { Lisp_Object tem0; + int timeout = delay_level * XFASTINT (Vauto_save_timeout) / 4; save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); - tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4, - 0, 1, 1, 0); + tem0 = sit_for (make_number (timeout), 1, 1); restore_getcjmp (save_jump); if (EQ (tem0, Qt) @@ -8387,7 +8382,7 @@ access_keymap_keyremap (map, key, prompt, do_funcall) /* Handle a symbol whose function definition is a keymap or an array. */ if (SYMBOLP (next) && !NILP (Ffboundp (next)) - && (!NILP (Farrayp (XSYMBOL (next)->function)) + && (ARRAYP (XSYMBOL (next)->function) || KEYMAPP (XSYMBOL (next)->function))) next = XSYMBOL (next)->function; @@ -9767,7 +9762,13 @@ a special event, so ignore the prefix argument and don't clear it. */) DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command, 1, 1, "P", - doc: /* Read function name, then read its arguments and call it. */) + doc: /* Read function name, then read its arguments and call it. + +To pass a numeric argument to the command you are invoking with, specify +the numeric argument to this command. + +Noninteractively, the argument PREFIXARG is the prefix argument to +give to the command you invoke, if it asks for an argument. */) (prefixarg) Lisp_Object prefixarg; { @@ -9873,19 +9874,18 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ Qmouse_movement))) { /* But first wait, and skip the message if there is input. */ - int delay_time; - if (!NILP (echo_area_buffer[0])) - /* This command displayed something in the echo area; - so wait a few seconds, then display our suggestion message. */ - delay_time = (NUMBERP (Vsuggest_key_bindings) - ? XINT (Vsuggest_key_bindings) : 2); + Lisp_Object waited; + + /* If this command displayed something in the echo area; + wait a few seconds, then display our suggestion message. */ + if (NILP (echo_area_buffer[0])) + waited = sit_for (make_number (0), 0, 2); + else if (NUMBERP (Vsuggest_key_bindings)) + waited = sit_for (Vminibuffer_message_timeout, 0, 2); else - /* This command left the echo area empty, - so display our message immediately. */ - delay_time = 0; + waited = sit_for (make_number (2), 0, 2); - if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil)) - && ! CONSP (Vunread_command_events)) + if (!NILP (waited) && ! CONSP (Vunread_command_events)) { Lisp_Object binding; char *newmessage; @@ -9905,10 +9905,12 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ message2_nolog (newmessage, strlen (newmessage), STRING_MULTIBYTE (binding)); - if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings) - ? Vsuggest_key_bindings : make_number (2)), - Qnil, Qnil)) - && message_p) + if (NUMBERP (Vsuggest_key_bindings)) + waited = sit_for (Vsuggest_key_bindings, 0, 2); + else + waited = sit_for (make_number (2), 0, 2); + + if (!NILP (waited) && message_p) restore_message (); unbind_to (count, Qnil); @@ -11479,6 +11481,15 @@ The value of that variable is passed to `quit-flag' and later causes a peculiar kind of quitting. */); Vthrow_on_input = Qnil; + DEFVAR_LISP ("command-error-function", &Vcommand_error_function, + doc: /* If non-nil, function to output error messages. +The arguments are the error data, a list of the form + (SIGNALED-CONDITIONS . SIGNAL-DATA) +such as just as `condition-case' would bind its variable to, +the context (a string which normally goes at the start of the message), +and the Lisp function within which the error was signaled. */); + Vcommand_error_function = Qnil; + DEFVAR_LISP ("enable-disabled-menus-and-buttons", &Venable_disabled_menus_and_buttons, doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar. diff --git a/src/keymap.c b/src/keymap.c index c763ee71831..af9d817a1eb 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -733,7 +733,7 @@ usage: (map-keymap FUNCTION KEYMAP) */) if (INTEGERP (function)) /* We have to stop integers early since map_keymap gives them special significance. */ - Fsignal (Qinvalid_function, Fcons (function, Qnil)); + xsignal1 (Qinvalid_function, function); if (! NILP (sort_first)) return call3 (intern ("map-keymap-internal"), function, keymap, Qt); @@ -1161,8 +1161,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) GCPRO3 (keymap, key, def); keymap = get_keymap (keymap, 1, 1); - if (!VECTORP (key) && !STRINGP (key)) - key = wrong_type_argument (Qarrayp, key); + CHECK_VECTOR_OR_STRING (key); length = XFASTINT (Flength (key)); if (length == 0) @@ -1282,8 +1281,7 @@ recognize the default bindings, just as `read-key-sequence' does. */) GCPRO2 (keymap, key); keymap = get_keymap (keymap, 1, 1); - if (!VECTORP (key) && !STRINGP (key)) - key = wrong_type_argument (Qarrayp, key); + CHECK_VECTOR_OR_STRING (key); length = XFASTINT (Flength (key)); if (length == 0) diff --git a/src/lisp.h b/src/lisp.h index af7fae52eaf..8224117241c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -594,6 +594,12 @@ extern size_t pure_size; #define STRING_COPYIN(string, index, new, count) \ bcopy (new, XSTRING (string)->data + index, count) +/* Type checking. */ + +#define CHECK_TYPE(ok, Qxxxp, x) \ + do { if (!(ok)) wrong_type_argument (Qxxxp, (x)); } while (0) + + /* See the macros in intervals.h. */ @@ -601,8 +607,8 @@ typedef struct interval *INTERVAL; /* Complain if object is not string or buffer type */ #define CHECK_STRING_OR_BUFFER(x) \ - { if (!STRINGP ((x)) && !BUFFERP ((x))) \ - x = wrong_type_argument (Qbuffer_or_string_p, (x)); } + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x) + /* In a cons, the markbit of the car is the gc mark bit */ @@ -671,6 +677,13 @@ struct Lisp_Cons : NILP ((c)) ? Qnil \ : wrong_type_argument (Qlistp, (c))) +/* Take the car or cdr of something whose type is not known. */ +#define CAR_SAFE(c) \ + (CONSP ((c)) ? XCAR ((c)) : Qnil) + +#define CDR_SAFE(c) \ + (CONSP ((c)) ? XCDR ((c)) : Qnil) + /* Nonzero if STR is a multibyte string. */ #define STRING_MULTIBYTE(STR) \ (XSTRING (STR)->size_byte >= 0) @@ -1049,13 +1062,8 @@ struct Lisp_Hash_Table #define HASH_TABLE_P(OBJ) PSEUDOVECTORP (OBJ, PVEC_HASH_TABLE) #define GC_HASH_TABLE_P(x) GC_PSEUDOVECTORP (x, PVEC_HASH_TABLE) -#define CHECK_HASH_TABLE(x) \ - do \ - { \ - if (!HASH_TABLE_P ((x))) \ - x = wrong_type_argument (Qhash_table_p, (x)); \ - } \ - while (0) +#define CHECK_HASH_TABLE(x) \ + CHECK_TYPE (HASH_TABLE_P (x), Qhash_table_p, x) /* Value is the key part of entry IDX in hash table H. */ @@ -1520,41 +1528,57 @@ typedef unsigned char UCHAR; /* Test for image (image . spec) */ #define IMAGEP(x) (CONSP (x) && EQ (XCAR (x), Qimage)) +/* Array types. */ + +#define ARRAYP(x) \ + (VECTORP (x) || STRINGP (x) || CHAR_TABLE_P (x) || BOOL_VECTOR_P (x)) #define GC_EQ(x, y) EQ (x, y) #define CHECK_LIST(x) \ - do { if (!CONSP ((x)) && !NILP (x)) x = wrong_type_argument (Qlistp, (x)); } while (0) + CHECK_TYPE (CONSP (x) || NILP (x), Qlistp, x) + +#define CHECK_LIST_CONS(x, y) \ + CHECK_TYPE (CONSP (x), Qlistp, y) + +#define CHECK_LIST_END(x, y) \ + CHECK_TYPE (NILP (x), Qlistp, y) #define CHECK_STRING(x) \ - do { if (!STRINGP ((x))) x = wrong_type_argument (Qstringp, (x)); } while (0) + CHECK_TYPE (STRINGP (x), Qstringp, x) #define CHECK_STRING_CAR(x) \ - do { if (!STRINGP (XCAR (x))) XSETCAR (x, wrong_type_argument (Qstringp, XCAR (x))); } while (0) + CHECK_TYPE (STRINGP (XCAR (x)), Qstringp, XCAR (x)) #define CHECK_CONS(x) \ - do { if (!CONSP ((x))) x = wrong_type_argument (Qconsp, (x)); } while (0) + CHECK_TYPE (CONSP (x), Qconsp, x) #define CHECK_SYMBOL(x) \ - do { if (!SYMBOLP ((x))) x = wrong_type_argument (Qsymbolp, (x)); } while (0) + CHECK_TYPE (SYMBOLP (x), Qsymbolp, x) #define CHECK_CHAR_TABLE(x) \ - do { if (!CHAR_TABLE_P ((x))) \ - x = wrong_type_argument (Qchar_table_p, (x)); } while (0) + CHECK_TYPE (CHAR_TABLE_P (x), Qchar_table_p, x) #define CHECK_VECTOR(x) \ - do { if (!VECTORP ((x))) x = wrong_type_argument (Qvectorp, (x)); } while (0) + CHECK_TYPE (VECTORP (x), Qvectorp, x) -#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ - do { if (!VECTORP ((x)) && !CHAR_TABLE_P ((x))) \ - x = wrong_type_argument (Qvector_or_char_table_p, (x)); \ - } while (0) +#define CHECK_VECTOR_OR_STRING(x) \ + CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x) + +#define CHECK_ARRAY(x, Qxxxp) \ + CHECK_TYPE (ARRAYP (x), Qxxxp, x) + +#define CHECK_VECTOR_OR_CHAR_TABLE(x) \ + CHECK_TYPE (VECTORP (x) || CHAR_TABLE_P (x), Qvector_or_char_table_p, x) #define CHECK_BUFFER(x) \ - do { if (!BUFFERP ((x))) x = wrong_type_argument (Qbufferp, (x)); } while (0) + CHECK_TYPE (BUFFERP (x), Qbufferp, x) #define CHECK_WINDOW(x) \ - do { if (!WINDOWP ((x))) x = wrong_type_argument (Qwindowp, (x)); } while (0) + CHECK_TYPE (WINDOWP (x), Qwindowp, x) + +#define CHECK_WINDOW_CONFIGURATION(x) \ + CHECK_TYPE (WINDOW_CONFIGURATIONP (x), Qwindow_configuration_p, x) /* This macro rejects windows on the interior of the window tree as "dead", which is what we want; this is an argument-checking macro, and @@ -1563,46 +1587,42 @@ typedef unsigned char UCHAR; A window of any sort, leaf or interior, is dead iff the buffer, vchild, and hchild members are all nil. */ -#define CHECK_LIVE_WINDOW(x) \ - do { \ - if (!WINDOWP ((x)) \ - || NILP (XWINDOW ((x))->buffer)) \ - x = wrong_type_argument (Qwindow_live_p, (x)); \ - } while (0) +#define CHECK_LIVE_WINDOW(x) \ + CHECK_TYPE (WINDOWP (x) && !NILP (XWINDOW (x)->buffer), Qwindow_live_p, x) #define CHECK_PROCESS(x) \ - do { if (!PROCESSP ((x))) x = wrong_type_argument (Qprocessp, (x)); } while (0) + CHECK_TYPE (PROCESSP (x), Qprocessp, x) + +#define CHECK_SUBR(x) \ + CHECK_TYPE (SUBRP (x), Qsubrp, x) #define CHECK_NUMBER(x) \ - do { if (!INTEGERP ((x))) x = wrong_type_argument (Qintegerp, (x)); } while (0) + CHECK_TYPE (INTEGERP (x), Qintegerp, x) #define CHECK_NATNUM(x) \ - do { if (!NATNUMP (x)) x = wrong_type_argument (Qwholenump, (x)); } while (0) + CHECK_TYPE (NATNUMP (x), Qwholenump, x) #define CHECK_MARKER(x) \ - do { if (!MARKERP ((x))) x = wrong_type_argument (Qmarkerp, (x)); } while (0) + CHECK_TYPE (MARKERP (x), Qmarkerp, x) #define CHECK_NUMBER_COERCE_MARKER(x) \ do { if (MARKERP ((x))) XSETFASTINT (x, marker_position (x)); \ - else if (!INTEGERP ((x))) x = wrong_type_argument (Qinteger_or_marker_p, (x)); } while (0) + else CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x); } while (0) #define XFLOATINT(n) extract_float((n)) #define CHECK_FLOAT(x) \ - do { if (!FLOATP (x)) \ - x = wrong_type_argument (Qfloatp, (x)); } while (0) + CHECK_TYPE (FLOATP (x), Qfloatp, x) #define CHECK_NUMBER_OR_FLOAT(x) \ - do { if (!FLOATP (x) && !INTEGERP (x)) \ - x = wrong_type_argument (Qnumberp, (x)); } while (0) + CHECK_TYPE (FLOATP (x) || INTEGERP (x), Qnumberp, x) #define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x) \ do { if (MARKERP (x)) XSETFASTINT (x, marker_position (x)); \ - else if (!INTEGERP (x) && !FLOATP (x)) \ - x = wrong_type_argument (Qnumber_or_marker_p, (x)); } while (0) + else CHECK_TYPE (INTEGERP (x) || FLOATP (x), Qnumber_or_marker_p, x); } while (0) #define CHECK_OVERLAY(x) \ - do { if (!OVERLAYP ((x))) x = wrong_type_argument (Qoverlayp, (x));} while (0) + CHECK_TYPE (OVERLAYP (x), Qoverlayp, x) /* Since we can't assign directly to the CAR or CDR fields of a cons cell, use these when checking that those fields contain numbers. */ @@ -2164,7 +2184,7 @@ extern Lisp_Object Qnumberp, Qnumber_or_marker_p; extern Lisp_Object Qinteger; -extern void circular_list_error P_ ((Lisp_Object)); +extern void circular_list_error P_ ((Lisp_Object)) NO_RETURN; EXFUN (Finteractive_form, 1); /* Defined in frame.c */ @@ -2482,8 +2502,8 @@ EXFUN (Fding, 1); EXFUN (Fredraw_frame, 1); EXFUN (Fredraw_display, 0); EXFUN (Fsleep_for, 2); -EXFUN (Fsit_for, 3); -extern Lisp_Object sit_for P_ ((int, int, int, int, int)); +EXFUN (Fredisplay, 1); +extern Lisp_Object sit_for P_ ((Lisp_Object, int, int)); extern void init_display P_ ((void)); extern void syms_of_display P_ ((void)); extern void safe_bcopy P_ ((const char *, char *, int)); @@ -2542,13 +2562,14 @@ extern void allocate_string_data P_ ((struct Lisp_String *, int, int)); extern void reset_malloc_hooks P_ ((void)); extern void uninterrupt_malloc P_ ((void)); extern void malloc_warning P_ ((char *)); -extern void memory_full P_ ((void)); -extern void buffer_memory_full P_ ((void)); +extern void memory_full P_ ((void)) NO_RETURN; +extern void buffer_memory_full P_ ((void)) NO_RETURN; extern int survives_gc_p P_ ((Lisp_Object)); extern void mark_object P_ ((Lisp_Object)); extern Lisp_Object Vpurify_flag; extern Lisp_Object Vmemory_full; EXFUN (Fcons, 2); +EXFUN (list1, 1); EXFUN (list2, 2); EXFUN (list3, 3); EXFUN (list4, 4); @@ -2724,6 +2745,12 @@ EXFUN (Fthrow, 2) NO_RETURN; EXFUN (Funwind_protect, UNEVALLED); EXFUN (Fcondition_case, UNEVALLED); EXFUN (Fsignal, 2); +extern void xsignal P_ ((Lisp_Object, Lisp_Object)) NO_RETURN; +extern void xsignal0 P_ ((Lisp_Object)) NO_RETURN; +extern void xsignal1 P_ ((Lisp_Object, Lisp_Object)) NO_RETURN; +extern void xsignal2 P_ ((Lisp_Object, Lisp_Object, Lisp_Object)) NO_RETURN; +extern void xsignal3 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)) NO_RETURN; +extern void signal_error P_ ((char *, Lisp_Object)) NO_RETURN; EXFUN (Fautoload, 5); EXFUN (Fcommandp, 2); EXFUN (Feval, 1); diff --git a/src/lread.c b/src/lread.c index 5d8e39d7fb1..08ba5123fcb 100644 --- a/src/lread.c +++ b/src/lread.c @@ -226,6 +226,9 @@ static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, static Lisp_Object load_unwind P_ ((Lisp_Object)); static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); +static void invalid_syntax P_ ((const char *, int)) NO_RETURN; +static void end_of_file_error P_ (()) NO_RETURN; + /* Functions that read one byte from the current source READCHARFUN or unreads one byte. If the integer argument C is -1, it returns @@ -634,7 +637,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, input_method) int no_switch_frame, ascii_required, error_nonascii, input_method; { - register Lisp_Object val, delayed_switch_frame; + Lisp_Object val, delayed_switch_frame; #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -978,10 +981,8 @@ Return t if the file exists and loads successfully. */) if (fd == -1) { if (NILP (noerror)) - Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"), - Fcons (file, Qnil))); - else - return Qnil; + xsignal2 (Qfile_error, build_string ("Cannot open load file"), file); + return Qnil; } /* Tell startup.el whether or not we found the user's init file. */ @@ -1022,8 +1023,7 @@ Return t if the file exists and loads successfully. */) { if (fd >= 0) emacs_close (fd); - Fsignal (Qerror, Fcons (build_string ("Recursive load"), - Fcons (found, Vloads_in_progress))); + signal_error ("Recursive load", Fcons (found, Vloads_in_progress)); } record_unwind_protect (record_load_unwind, Vloads_in_progress); Vloads_in_progress = Fcons (found, Vloads_in_progress); @@ -1532,11 +1532,9 @@ end_of_file_error () Lisp_Object data; if (STRINGP (Vload_file_name)) - data = Fcons (Vload_file_name, Qnil); - else - data = Qnil; + xsignal1 (Qend_of_file, Vload_file_name); - Fsignal (Qend_of_file, data); + xsignal0 (Qend_of_file); } /* UNIBYTE specifies how to set load_convert_to_unibyte @@ -1562,7 +1560,6 @@ readevalloop (readcharfun, stream, sourcename, evalfun, int count = SPECPDL_INDEX (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *b = 0; - int bpos; int continue_reading_p; /* Nonzero if reading an entire buffer. */ int whole_buffer = 0; @@ -1572,7 +1569,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, if (MARKERP (readcharfun)) { if (NILP (start)) - start = readcharfun; + start = readcharfun; } if (BUFFERP (readcharfun)) @@ -1593,8 +1590,8 @@ readevalloop (readcharfun, stream, sourcename, evalfun, /* Try to ensure sourcename is a truename, except whilst preloading. */ if (NILP (Vpurify_flag) - && !NILP (sourcename) && Ffile_name_absolute_p (sourcename) - && (!NILP (Ffboundp (Qfile_truename)))) + && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)) + && !NILP (Ffboundp (Qfile_truename))) sourcename = call1 (Qfile_truename, sourcename) ; LOADHIST_ATTACH (sourcename); @@ -1703,7 +1700,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun, first_sexp = 0; } - build_load_history (sourcename, + build_load_history (sourcename, stream || whole_buffer); UNGCPRO; @@ -1893,6 +1890,21 @@ read_internal_start (stream, start, end) return retval; } + +/* Signal Qinvalid_read_syntax error. + S is error string of length N (if > 0) */ + +static void +invalid_syntax (s, n) + const char *s; + int n; +{ + if (!n) + n = strlen (s); + xsignal1 (Qinvalid_read_syntax, make_string (s, n)); +} + + /* Use this for recursive reads, in contexts where internal tokens are not allowed. */ @@ -1904,12 +1916,11 @@ read0 (readcharfun) int c; val = read1 (readcharfun, &c, 0); - if (c) - Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1), - make_number (c)), - Qnil)); + if (!c) + return val; - return val; + xsignal1 (Qinvalid_read_syntax, + Fmake_string (make_number (1), make_number (c))); } static int read_buffer_size; @@ -2127,7 +2138,6 @@ read_escape (readcharfun, stringp) } } - /* Read an integer in radix RADIX using READCHARFUN to read characters. RADIX must be in the interval [2..36]; if it isn't, a read error is signaled . Value is the integer read. Signals an @@ -2187,7 +2197,7 @@ read_integer (readcharfun, radix) { char buf[50]; sprintf (buf, "integer, radix %d", radix); - Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil)); + invalid_syntax (buf, 0); } return make_number (sign * number); @@ -2267,10 +2277,9 @@ read1 (readcharfun, pch, first_in_list) XSETSUB_CHAR_TABLE (tmp, XSUB_CHAR_TABLE (tmp)); return tmp; } - Fsignal (Qinvalid_read_syntax, - Fcons (make_string ("#^^", 3), Qnil)); + invalid_syntax ("#^^", 3); } - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil)); + invalid_syntax ("#^", 2); } if (c == '&') { @@ -2294,8 +2303,7 @@ read1 (readcharfun, pch, first_in_list) version. */ && ! (XFASTINT (length) == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))) - Fsignal (Qinvalid_read_syntax, - Fcons (make_string ("#&...", 5), Qnil)); + invalid_syntax ("#&...", 5); val = Fmake_bool_vector (length, Qnil); bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, @@ -2306,8 +2314,7 @@ read1 (readcharfun, pch, first_in_list) &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), - Qnil)); + invalid_syntax ("#&...", 5); } if (c == '[') { @@ -2327,7 +2334,7 @@ read1 (readcharfun, pch, first_in_list) /* Read the string itself. */ tmp = read1 (readcharfun, &ch, 0); if (ch != 0 || !STRINGP (tmp)) - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); + invalid_syntax ("#", 1); GCPRO1 (tmp); /* Read the intervals and their properties. */ while (1) @@ -2343,9 +2350,7 @@ read1 (readcharfun, pch, first_in_list) if (ch == 0) plist = read1 (readcharfun, &ch, 0); if (ch) - Fsignal (Qinvalid_read_syntax, - Fcons (build_string ("invalid string property list"), - Qnil)); + invalid_syntax ("Invalid string property list", 0); Fset_text_properties (beg, end, plist, tmp); } UNGCPRO; @@ -2502,7 +2507,7 @@ read1 (readcharfun, pch, first_in_list) return read_integer (readcharfun, 2); UNREAD (c); - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); + invalid_syntax ("#", 1); case ';': while ((c = READCHAR) >= 0 && c != '\n'); @@ -2599,10 +2604,10 @@ read1 (readcharfun, pch, first_in_list) || (new_backquote_flag && next_char == ',')))); } UNREAD (next_char); - if (!ok) - Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil)); + if (ok) + return make_number (c); - return make_number (c); + invalid_syntax ("?", 1); } case '"': @@ -3238,8 +3243,7 @@ read_list (flag, readcharfun) { if (ch == ']') return val; - Fsignal (Qinvalid_read_syntax, - Fcons (make_string (") or . in a vector", 18), Qnil)); + invalid_syntax (") or . in a vector", 18); } if (ch == ')') return val; @@ -3341,9 +3345,9 @@ read_list (flag, readcharfun) return val; } - return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil)); + invalid_syntax (". in wrong context", 18); } - return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil)); + invalid_syntax ("] in a list", 11); } tem = (read_pure && flag <= 0 ? pure_cons (elt, Qnil) @@ -3376,12 +3380,11 @@ Lisp_Object check_obarray (obarray) Lisp_Object obarray; { - while (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) + if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) { /* If Vobarray is now invalid, force it to be valid. */ if (EQ (Vobarray, obarray)) Vobarray = initial_obarray; - - obarray = wrong_type_argument (Qvectorp, obarray); + wrong_type_argument (Qvectorp, obarray); } return obarray; } diff --git a/src/mac.c b/src/mac.c index e25ed435342..4652757fab3 100644 --- a/src/mac.c +++ b/src/mac.c @@ -4625,8 +4625,7 @@ otherwise. */) CHECK_CONS (key); for (tmp = key; CONSP (tmp); tmp = XCDR (tmp)) CHECK_STRING_CAR (tmp); - if (!NILP (tmp)) - wrong_type_argument (Qlistp, key); + CHECK_LIST_END (tmp, key); } if (!NILP (application)) CHECK_STRING (application); diff --git a/src/macros.c b/src/macros.c index ef3ff8c0523..fb452e4e318 100644 --- a/src/macros.c +++ b/src/macros.c @@ -97,10 +97,7 @@ macro before appending to it. */) int cvt; /* Check the type of last-kbd-macro in case Lisp code changed it. */ - if (!STRINGP (current_kboard->Vlast_kbd_macro) - && !VECTORP (current_kboard->Vlast_kbd_macro)) - current_kboard->Vlast_kbd_macro - = wrong_type_argument (Qarrayp, current_kboard->Vlast_kbd_macro); + CHECK_VECTOR_OR_STRING (current_kboard->Vlast_kbd_macro); len = XINT (Flength (current_kboard->Vlast_kbd_macro)); diff --git a/src/macselect.c b/src/macselect.c index 3afea1e9813..67a28cf9e64 100644 --- a/src/macselect.c +++ b/src/macselect.c @@ -594,11 +594,9 @@ x_get_local_selection (selection_symbol, target_type, local_request) && INTEGERP (XCAR (XCDR (check))) && NILP (XCDR (XCDR (check)))))) return value; - else - return - Fsignal (Qerror, - Fcons (build_string ("invalid data returned by selection-conversion function"), - Fcons (handler_fn, Fcons (value, Qnil)))); + + signal_error ("Invalid data returned by selection-conversion function", + list2 (handler_fn, value)); } diff --git a/src/macterm.c b/src/macterm.c index a6fc6b1a497..e98fc7729c0 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -8608,6 +8608,81 @@ extern int emacs_main (int, char **, char **); extern void initialize_applescript(); extern void terminate_applescript(); +/* Table for translating Mac keycode to X keysym values. Contributed + by Sudhir Shenoy. + Mapping for special keys is now identical to that in Apple X11 + except `clear' (-> <clear>) on the KeyPad, `enter' (-> <kp-enter>) + on the right of the Cmd key on laptops, and fn + `enter' (-> + <linefeed>). */ +static unsigned char keycode_to_xkeysym_table[] = { + /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x20*/ 0, 0, 0, 0, 0x0d /*return*/, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + + /*0x30*/ 0x09 /*tab*/, 0 /*0x0020 space*/, 0, 0x08 /*backspace*/, + /*0x34*/ 0x8d /*enter on laptops*/, 0x1b /*escape*/, 0, 0, + /*0x38*/ 0, 0, 0, 0, + /*0x3C*/ 0, 0, 0, 0, + + /*0x40*/ 0, 0xae /*kp-decimal*/, 0, 0xaa /*kp-multiply*/, + /*0x44*/ 0, 0xab /*kp-add*/, 0, 0x0b /*clear*/, + /*0x48*/ 0, 0, 0, 0xaf /*kp-divide*/, + /*0x4C*/ 0x8d /*kp-enter*/, 0, 0xad /*kp-subtract*/, 0, + + /*0x50*/ 0, 0xbd /*kp-equal*/, 0xb0 /*kp-0*/, 0xb1 /*kp-1*/, + /*0x54*/ 0xb2 /*kp-2*/, 0xb3 /*kp-3*/, 0xb4 /*kp-4*/, 0xb5 /*kp-5*/, + /*0x58*/ 0xb6 /*kp-6*/, 0xb7 /*kp-7*/, 0, 0xb8 /*kp-8*/, + /*0x5C*/ 0xb9 /*kp-9*/, 0, 0, 0, + + /*0x60*/ 0xc2 /*f5*/, 0xc3 /*f6*/, 0xc4 /*f7*/, 0xc0 /*f3*/, + /*0x64*/ 0xc5 /*f8*/, 0xc6 /*f9*/, 0, 0xc8 /*f11*/, + /*0x68*/ 0, 0xca /*f13*/, 0xcd /*f16*/, 0xcb /*f14*/, + /*0x6C*/ 0, 0xc7 /*f10*/, 0x0a /*fn+enter on laptops*/, 0xc9 /*f12*/, + + /*0x70*/ 0, 0xcc /*f15*/, 0x6a /*help*/, 0x50 /*home*/, + /*0x74*/ 0x55 /*pgup*/, 0xff /*delete*/, 0xc1 /*f4*/, 0x57 /*end*/, + /*0x78*/ 0xbf /*f2*/, 0x56 /*pgdown*/, 0xbe /*f1*/, 0x51 /*left*/, + /*0x7C*/ 0x53 /*right*/, 0x54 /*down*/, 0x52 /*up*/, 0 +}; + +#ifdef MAC_OSX +/* Table for translating Mac keycode with the laptop `fn' key to that + without it. Destination symbols in comments are keys on US + keyboard, and they may not be the same on other types of keyboards. + If the destination is identical to the source (f1 ... f12), it + doesn't map `fn' key to a modifier. */ +static unsigned char fn_keycode_to_keycode_table[] = { + /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + /*0x20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + + /*0x30*/ 0, 0, 0, 0, + /*0x34*/ 0, 0, 0, 0, + /*0x38*/ 0, 0, 0, 0, + /*0x3C*/ 0, 0, 0, 0, + + /*0x40*/ 0, 0x2f /*kp-decimal -> '.'*/, 0, 0x23 /*kp-multiply -> 'p'*/, + /*0x44*/ 0, 0x2c /*kp-add -> '/'*/, 0, 0x16 /*clear -> '6'*/, + /*0x48*/ 0, 0, 0, 0x1d /*kp-/ -> '0'*/, + /*0x4C*/ 0x24 /*kp-enter -> return*/, 0, 0x29 /*kp-subtract -> ';'*/, 0, + + /*0x50*/ 0, 0x1b /*kp-equal -> '-'*/, 0x2e /*kp-0 -> 'm'*/, 0x26 /*kp-1 -> 'j'*/, + /*0x54*/ 0x28 /*kp-2 -> 'k'*/, 0x25 /*kp-3 -> 'l'*/, 0x20 /*kp-4 -> 'u'*/, 0x22 /*kp-5 ->'i'*/, + /*0x58*/ 0x1f /*kp-6 -> 'o'*/, 0x1a /*kp-7 -> '7'*/, 0, 0x1c /*kp-8 -> '8'*/, + /*0x5C*/ 0x19 /*kp-9 -> '9'*/, 0, 0, 0, + + /*0x60*/ 0x60 /*f5 = f5*/, 0x61 /*f6 = f6*/, 0x62 /*f7 = f7*/, 0x63 /*f3 = f3*/, + /*0x64*/ 0x64 /*f8 = f8*/, 0x65 /*f9 = f9*/, 0, 0x67 /*f11 = f11*/, + /*0x68*/ 0, 0, 0, 0, + /*0x6C*/ 0, 0x6d /*f10 = f10*/, 0, 0x6f /*f12 = f12*/, + + /*0x70*/ 0, 0, 0, 0x7b /*home -> left*/, + /*0x74*/ 0x7e /*pgup -> up*/, 0x33 /*delete -> backspace*/, 0x76 /*f4 = f4*/, 0x7c /*end -> right*/, + /*0x78*/ 0x78 /*f2 = f2*/, 0x7d /*pgdown -> down*/, 0x7a /*f1 = f1*/, 0, + /*0x7C*/ 0, 0, 0, 0 +}; +#endif /* MAC_OSX */ + static unsigned int #if USE_CARBON_EVENTS mac_to_emacs_modifiers (UInt32 mods) @@ -9671,7 +9746,6 @@ mac_handle_text_input_event (next_handler, event, data) { EventRef kbd_event; UInt32 actual_size, modifiers, mapped_modifiers; - UniChar code; err = GetEventParameter (event, kEventParamTextInputSendKeyboardEvent, typeEventRef, NULL, sizeof (EventRef), NULL, @@ -9699,26 +9773,37 @@ mac_handle_text_input_event (next_handler, event, data) err = GetEventParameter (kbd_event, kEventParamKeyUnicodes, typeUnicodeText, NULL, 0, &actual_size, NULL); - if (err == noErr) + if (err == noErr && actual_size == sizeof (UniChar)) { - if (actual_size == sizeof (UniChar)) - err = GetEventParameter (kbd_event, kEventParamKeyUnicodes, - typeUnicodeText, NULL, - sizeof (UniChar), NULL, &code); + UniChar code; + + err = GetEventParameter (kbd_event, kEventParamKeyUnicodes, + typeUnicodeText, NULL, + sizeof (UniChar), NULL, &code); if (err == noErr && code < 0x80) { /* ASCII character. Process it in XTread_socket. */ if (read_socket_inev && code >= 0x20 && code <= 0x7e) { - struct frame *f = mac_focus_frame (&one_mac_display_info); - - read_socket_inev->kind = ASCII_KEYSTROKE_EVENT; - read_socket_inev->code = code; - read_socket_inev->modifiers = - (extra_keyboard_modifiers - & (meta_modifier | alt_modifier - | hyper_modifier | super_modifier)); - XSETFRAME (read_socket_inev->frame_or_window, f); + UInt32 key_code; + + err = GetEventParameter (kbd_event, kEventParamKeyCode, + typeUInt32, NULL, sizeof (UInt32), + NULL, &key_code); + if (!(err == noErr && key_code <= 0x7f + && keycode_to_xkeysym_table [key_code])) + { + struct frame *f = + mac_focus_frame (&one_mac_display_info); + + read_socket_inev->kind = ASCII_KEYSTROKE_EVENT; + read_socket_inev->code = code; + read_socket_inev->modifiers = + (extra_keyboard_modifiers + & (meta_modifier | alt_modifier + | hyper_modifier | super_modifier)); + XSETFRAME (read_socket_inev->frame_or_window, f); + } } return eventNotHandledErr; } @@ -9991,89 +10076,6 @@ main (void) } #endif -/* Table for translating Mac keycode to X keysym values. Contributed - by Sudhir Shenoy. - Mapping for special keys is now identical to that in Apple X11 - except `clear' (-> <clear>) on the KeyPad, `enter' (-> <kp-enter>) - on the right of the Cmd key on laptops, and fn + `enter' (-> - <linefeed>). */ -static unsigned char keycode_to_xkeysym_table[] = { - /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - /*0x20*/ 0, 0, 0, 0, 0x0d /*return*/, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - - /*0x30*/ 0x09 /*tab*/, 0 /*0x0020 space*/, 0, 0x08 /*backspace*/, - /*0x34*/ 0x8d /*enter on laptops*/, 0x1b /*escape*/, 0, 0, - /*0x38*/ 0, 0, 0, 0, - /*0x3C*/ 0, 0, 0, 0, - - /*0x40*/ 0, 0xae /*kp-.*/, 0, 0xaa /*kp-**/, - /*0x44*/ 0, 0xab /*kp-+*/, 0, 0x0b /*clear*/, - /*0x48*/ 0, 0, 0, 0xaf /*kp-/*/, - /*0x4C*/ 0x8d /*kp-enter*/, 0, 0xad /*kp--*/, 0, - - /*0x50*/ 0, 0xbd /*kp-=*/, 0xb0 /*kp-0*/, 0xb1 /*kp-1*/, - /*0x54*/ 0xb2 /*kp-2*/, 0xb3 /*kp-3*/, 0xb4 /*kp-4*/, 0xb5 /*kp-5*/, - /*0x58*/ 0xb6 /*kp-6*/, 0xb7 /*kp-7*/, 0, 0xb8 /*kp-8*/, - /*0x5C*/ 0xb9 /*kp-9*/, 0, 0, 0, - - /*0x60*/ 0xc2 /*f5*/, 0xc3 /*f6*/, 0xc4 /*f7*/, 0xc0 /*f3*/, - /*0x64*/ 0xc5 /*f8*/, 0xc6 /*f9*/, 0, 0xc8 /*f11*/, - /*0x68*/ 0, 0xca /*f13*/, 0xcd /*f16*/, 0xcb /*f14*/, - /*0x6C*/ 0, 0xc7 /*f10*/, 0x0a /*fn+enter on laptops*/, 0xc9 /*f12*/, - - /*0x70*/ 0, 0xcc /*f15*/, 0x6a /*help*/, 0x50 /*home*/, - /*0x74*/ 0x55 /*pgup*/, 0xff /*delete*/, 0xc1 /*f4*/, 0x57 /*end*/, - /*0x78*/ 0xbf /*f2*/, 0x56 /*pgdown*/, 0xbe /*f1*/, 0x51 /*left*/, - /*0x7C*/ 0x53 /*right*/, 0x54 /*down*/, 0x52 /*up*/, 0 -}; - - -static int -keycode_to_xkeysym (int keyCode, int *xKeySym) -{ - *xKeySym = keycode_to_xkeysym_table [keyCode & 0x7f]; - return *xKeySym != 0; -} - -#ifdef MAC_OSX -/* Table for translating Mac keycode with the laptop `fn' key to that - without it. Destination symbols in comments are keys on US - keyboard, and they may not be the same on other types of keyboards. - If the destination is identical to the source (f1 ... f12), it - doesn't map `fn' key to a modifier. */ -static unsigned char fn_keycode_to_keycode_table[] = { - /*0x00*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - /*0x10*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - /*0x20*/ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - - /*0x30*/ 0, 0, 0, 0, - /*0x34*/ 0, 0, 0, 0, - /*0x38*/ 0, 0, 0, 0, - /*0x3C*/ 0, 0, 0, 0, - - /*0x40*/ 0, 0x2f /*kp-. -> '.'*/, 0, 0x23 /*kp-* -> 'p'*/, - /*0x44*/ 0, 0x2c /*kp-+ -> '/'*/, 0, 0x16 /*clear -> '6'*/, - /*0x48*/ 0, 0, 0, 0x1d /*kp-/ -> '0'*/, - /*0x4C*/ 0x24 /*kp-enter -> return*/, 0, 0x29 /*kp-- -> ';'*/, 0, - - /*0x50*/ 0, 0x1b /*kp-= -> '-'*/, 0x2e /*kp-0 -> 'm'*/, 0x26 /*kp-1 -> 'j'*/, - /*0x54*/ 0x28 /*kp-2 -> 'k'*/, 0x25 /*kp-3 -> 'l'*/, 0x20 /*kp-4 -> 'u'*/, 0x22 /*kp-5 ->'i'*/, - /*0x58*/ 0x1f /*kp-6 -> 'o'*/, 0x1a /*kp-7 -> '7'*/, 0, 0x1c /*kp-8 -> '8'*/, - /*0x5C*/ 0x19 /*kp-9 -> '9'*/, 0, 0, 0, - - /*0x60*/ 0x60 /*f5 = f5*/, 0x61 /*f6 = f6*/, 0x62 /*f7 = f7*/, 0x63 /*f3 = f3*/, - /*0x64*/ 0x64 /*f8 = f8*/, 0x65 /*f9 = f9*/, 0, 0x67 /*f11 = f11*/, - /*0x68*/ 0, 0, 0, 0, - /*0x6C*/ 0, 0x6d /*f10 = f10*/, 0, 0x6f /*f12 = f12*/, - - /*0x70*/ 0, 0, 0, 0x7b /*home -> left*/, - /*0x74*/ 0x7e /*pgup -> up*/, 0x33 /*delete -> backspace*/, 0x76 /*f4 = f4*/, 0x7c /*end -> right*/, - /*0x78*/ 0x78 /*f2 = f2*/, 0x7d /*pgdown -> down*/, 0x7a /*f1 = f1*/, 0, - /*0x7C*/ 0, 0, 0, 0 -}; -#endif /* MAC_OSX */ - #if !USE_CARBON_EVENTS static RgnHandle mouse_region = NULL; @@ -10676,7 +10678,6 @@ XTread_socket (sd, expected, hold_quit) case autoKey: { int keycode = (er.message & keyCodeMask) >> 8; - int xkeysym; static SInt16 last_key_script = -1; SInt16 current_key_script; UInt32 modifiers = er.modifiers, mapped_modifiers; @@ -10755,10 +10756,10 @@ XTread_socket (sd, expected, hold_quit) && fn_keycode_to_keycode_table[keycode]) keycode = fn_keycode_to_keycode_table[keycode]; #endif - if (keycode_to_xkeysym (keycode, &xkeysym)) + if (keycode <= 0x7f && keycode_to_xkeysym_table [keycode]) { inev.kind = NON_ASCII_KEYSTROKE_EVENT; - inev.code = 0xff00 | xkeysym; + inev.code = 0xff00 | keycode_to_xkeysym_table [keycode]; #ifdef MAC_OSX if (modifiers & kEventKeyModifierFnMask && keycode <= 0x7f @@ -11098,7 +11099,7 @@ mac_initialize_display_info () #ifdef MAC_OSX /* HasDepth returns true if it is possible to have a 32 bit display, but this may not be what is actually used. Mac OSX can do better. */ - dpyinfo->color_p = 1; + dpyinfo->color_p = CGDisplaySamplesPerPixel (kCGDirectMainDisplay) > 1; dpyinfo->n_planes = CGDisplayBitsPerPixel (kCGDirectMainDisplay); dpyinfo->height = CGDisplayPixelsHigh (kCGDirectMainDisplay); dpyinfo->width = CGDisplayPixelsWide (kCGDirectMainDisplay); @@ -11229,11 +11230,14 @@ x_delete_display (dpyinfo) xfree (dpyinfo->font_table[i].name); } - if (dpyinfo->font_table->font_encoder) - xfree (dpyinfo->font_table->font_encoder); - - xfree (dpyinfo->font_table); - xfree (dpyinfo->mac_id_name); + if (dpyinfo->font_table) + { + if (dpyinfo->font_table->font_encoder) + xfree (dpyinfo->font_table->font_encoder); + xfree (dpyinfo->font_table); + } + if (dpyinfo->mac_id_name) + xfree (dpyinfo->mac_id_name); if (x_display_list == 0) { diff --git a/src/marker.c b/src/marker.c index 0511debbe54..82e62e0aa99 100644 --- a/src/marker.c +++ b/src/marker.c @@ -835,8 +835,7 @@ see `marker-insertion-type'. */) { register Lisp_Object new; - if (! (INTEGERP (marker) || MARKERP (marker))) - marker = wrong_type_argument (Qinteger_or_marker_p, marker); + CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker); new = Fmake_marker (); Fset_marker (new, marker, diff --git a/src/minibuf.c b/src/minibuf.c index c5910b1771f..848dbd0fed0 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -2683,7 +2683,7 @@ temp_echo_area_glyphs (string) insert_from_string (string, 0, 0, SCHARS (string), SBYTES (string), 0); SET_PT_BOTH (opoint, opoint_byte); Vinhibit_quit = Qt; - Fsit_for (make_number (2), Qnil, Qnil); + sit_for (make_number (2), 0, 2); del_range_both (osize, osize_byte, ZV, ZV_BYTE, 1); SET_PT_BOTH (opoint, opoint_byte); if (!NILP (Vquit_flag)) diff --git a/src/msdos.c b/src/msdos.c index 026ebc572b4..581b2ea38e8 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -204,9 +204,9 @@ them. This happens with wheeled mice on Windows 9X, for example. */) CHECK_NUMBER (nbuttons); n = XINT (nbuttons); if (n < 2 || n > 3) - Fsignal (Qargs_out_of_range, - Fcons (build_string ("only 2 or 3 mouse buttons are supported"), - Fcons (nbuttons, Qnil))); + xsignal2 (Qargs_out_of_range, + build_string ("only 2 or 3 mouse buttons are supported"), + nbuttons); mouse_setup_buttons (n); return Qnil; } diff --git a/src/print.c b/src/print.c index 0db9780e314..6fdd41ada04 100644 --- a/src/print.c +++ b/src/print.c @@ -1032,7 +1032,9 @@ error message is constructed. */) } /* Print an error message for the error DATA onto Lisp output stream - STREAM (suitable for the print functions). */ + STREAM (suitable for the print functions). + CONTEXT is a C string describing the context of the error. + CALLER is the Lisp function inside which the error was signaled. */ void print_error_message (data, stream, context, caller) diff --git a/src/process.c b/src/process.c index 2281f1ce3f6..45bf6446644 100644 --- a/src/process.c +++ b/src/process.c @@ -5158,7 +5158,7 @@ read_process_output (proc, channel) #endif /* But do it only if the caller is actually going to read events. Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make Fsit_for return). */ + cause trouble (for example it would make sit_for return). */ if (waiting_for_user_input_p == -1) record_asynch_buffer_change (); @@ -6595,7 +6595,7 @@ exec_sentinel (proc, reason) #endif /* But do it only if the caller is actually going to read events. Otherwise there's no need to make him wake up, and it could - cause trouble (for example it would make Fsit_for return). */ + cause trouble (for example it would make sit_for return). */ if (waiting_for_user_input_p == -1) record_asynch_buffer_change (); diff --git a/src/puresize.h b/src/puresize.h index fa01ad610a1..457a75ea023 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -43,7 +43,7 @@ Boston, MA 02110-1301, USA. */ #endif #ifndef BASE_PURESIZE -#define BASE_PURESIZE (1210500 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) +#define BASE_PURESIZE (1211000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) #endif /* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ diff --git a/src/search.c b/src/search.c index 15cc51cb511..d826e2e1b05 100644 --- a/src/search.c +++ b/src/search.c @@ -83,6 +83,9 @@ static Lisp_Object last_thing_searched; Lisp_Object Qinvalid_regexp; +/* Error condition used for failing searches */ +Lisp_Object Qsearch_failed; + Lisp_Object Vsearch_spaces_regexp; static void set_search_regs (); @@ -145,7 +148,7 @@ compile_pattern_1 (cp, pattern, translate, regp, posix, multibyte) re_set_syntax (old); UNBLOCK_INPUT; if (val) - Fsignal (Qinvalid_regexp, Fcons (build_string (val), Qnil)); + xsignal1 (Qinvalid_regexp, build_string (val)); cp->regexp = Fcopy_sequence (pattern); } @@ -232,16 +235,6 @@ compile_pattern (pattern, regp, translate, posix, multibyte) return &cp->buf; } -/* Error condition used for failing searches */ -Lisp_Object Qsearch_failed; - -Lisp_Object -signal_failure (arg) - Lisp_Object arg; -{ - Fsignal (Qsearch_failed, Fcons (arg, Qnil)); - return Qnil; -} static Lisp_Object looking_at_1 (string, posix) @@ -914,7 +907,8 @@ search_command (string, bound, noerror, count, direction, RE, posix) if (np <= 0) { if (NILP (noerror)) - return signal_failure (string); + xsignal1 (Qsearch_failed, string); + if (!EQ (noerror, Qt)) { if (lim < BEGV || lim > ZV) @@ -2850,8 +2844,7 @@ If optional arg RESEAT is non-nil, make markers on LIST point nowhere. */) if (running_asynch_code) save_search_regs (); - if (!CONSP (list) && !NILP (list)) - list = wrong_type_argument (Qconsp, list); + CHECK_LIST (list); /* Unless we find a marker with a buffer or an explicit buffer in LIST, assume that this match data came from a string. */ diff --git a/src/sound.c b/src/sound.c index af2369040cc..6f955a7d691 100644 --- a/src/sound.c +++ b/src/sound.c @@ -990,6 +990,7 @@ alsa_configure (sd) struct sound_device *sd; { int val, err, dir; + unsigned uval; struct alsa_params *p = (struct alsa_params *) sd->data; snd_pcm_uframes_t buffer_size; @@ -1017,8 +1018,8 @@ alsa_configure (sd) if (err < 0) alsa_sound_perror ("Could not set sound format", err); - val = sd->sample_rate; - err = snd_pcm_hw_params_set_rate_near (p->handle, p->hwparams, &val, 0); + uval = sd->sample_rate; + err = snd_pcm_hw_params_set_rate_near (p->handle, p->hwparams, &uval, 0); if (err < 0) alsa_sound_perror ("Could not set sample rate", err); @@ -1123,7 +1124,7 @@ alsa_close (sd) snd_pcm_sw_params_free (p->swparams); if (p->handle) { - snd_pcm_drain(p->handle); + snd_pcm_drain (p->handle); snd_pcm_close (p->handle); } free (p); @@ -1269,7 +1270,8 @@ alsa_init (sd) err = snd_pcm_open (&handle, file, SND_PCM_STREAM_PLAYBACK, 0); snd_lib_error_set_handler (NULL); if (err < 0) - return 0; + return 0; + snd_pcm_close (handle); sd->fd = -1; sd->open = alsa_open; diff --git a/src/sunfns.c b/src/sunfns.c index 1c04f1108a8..336f02221cf 100644 --- a/src/sunfns.c +++ b/src/sunfns.c @@ -363,7 +363,7 @@ sun_item_create (Pair) Lisp_Object String; Lisp_Object Value; - if (!CONSP(Pair)) wrong_type_argument(Qlistp, Pair); + CHECK_LIST_CONS (Pair, Pair); String = Fcar(Pair); CHECK_STRING(String); Value = Fcdr(Pair); diff --git a/src/syntax.c b/src/syntax.c index 4f5481ca111..b0b4bdc0032 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -97,11 +97,12 @@ static int find_start_modiff; static int find_defun_start P_ ((int, int)); -static int back_comment P_ ((int, int, int, int, int, int *, int *)); +static int back_comment P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int, int, + EMACS_INT *, EMACS_INT *)); static int char_quoted P_ ((int, int)); static Lisp_Object skip_chars P_ ((int, Lisp_Object, Lisp_Object, int)); static Lisp_Object skip_syntaxes P_ ((int, Lisp_Object, Lisp_Object)); -static Lisp_Object scan_lists P_ ((int, int, int, int)); +static Lisp_Object scan_lists P_ ((EMACS_INT, EMACS_INT, EMACS_INT, int)); static void scan_sexps_forward P_ ((struct lisp_parse_state *, int, int, int, int, int, Lisp_Object, int)); @@ -472,9 +473,9 @@ prev_char_comend_first (pos, pos_byte) static int back_comment (from, from_byte, stop, comnested, comstyle, charpos_ptr, bytepos_ptr) - int from, from_byte, stop; + EMACS_INT from, from_byte, stop; int comnested, comstyle; - int *charpos_ptr, *bytepos_ptr; + EMACS_INT *charpos_ptr, *bytepos_ptr; { /* Look back, counting the parity of string-quotes, and recording the comment-starters seen. @@ -749,9 +750,8 @@ static void check_syntax_table (obj) Lisp_Object obj; { - if (!(CHAR_TABLE_P (obj) - && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table))) - wrong_type_argument (Qsyntax_table_p, obj); + CHECK_TYPE (CHAR_TABLE_P (obj) && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table), + Qsyntax_table_p, obj); } DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, @@ -2111,9 +2111,10 @@ in_classes (c, iso_classes) static int forw_comment (from, from_byte, stop, nesting, style, prev_syntax, charpos_ptr, bytepos_ptr, incomment_ptr) - int from, from_byte, stop; + EMACS_INT from, from_byte, stop; int nesting, style, prev_syntax; - int *charpos_ptr, *bytepos_ptr, *incomment_ptr; + EMACS_INT *charpos_ptr, *bytepos_ptr; + int *incomment_ptr; { register int c, c1; register enum syntaxcode code; @@ -2213,16 +2214,16 @@ between them, return t; otherwise return nil. */) (count) Lisp_Object count; { - register int from; - int from_byte; - register int stop; + register EMACS_INT from; + EMACS_INT from_byte; + register EMACS_INT stop; register int c, c1; register enum syntaxcode code; int comstyle = 0; /* style of comment encountered */ int comnested = 0; /* whether the comment is nestable or not */ int found; - int count1; - int out_charpos, out_bytepos; + EMACS_INT count1; + EMACS_INT out_charpos, out_bytepos; int dummy; CHECK_NUMBER (count); @@ -2420,11 +2421,12 @@ between them, return t; otherwise return nil. */) static Lisp_Object scan_lists (from, count, depth, sexpflag) - register int from; - int count, depth, sexpflag; + register EMACS_INT from; + EMACS_INT count, depth; + int sexpflag; { Lisp_Object val; - register int stop = count > 0 ? ZV : BEGV; + register EMACS_INT stop = count > 0 ? ZV : BEGV; register int c, c1; int stringterm; int quoted; @@ -2433,11 +2435,11 @@ scan_lists (from, count, depth, sexpflag) int min_depth = depth; /* Err out if depth gets less than this. */ int comstyle = 0; /* style of comment encountered */ int comnested = 0; /* whether the comment is nestable or not */ - int temp_pos; - int last_good = from; + EMACS_INT temp_pos; + EMACS_INT last_good = from; int found; - int from_byte; - int out_bytepos, out_charpos; + EMACS_INT from_byte; + EMACS_INT out_bytepos, out_charpos; int temp, dummy; int multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol; @@ -2567,10 +2569,9 @@ scan_lists (from, count, depth, sexpflag) close1: if (!--depth) goto done; if (depth < min_depth) - Fsignal (Qscan_error, - Fcons (build_string ("Containing expression ends prematurely"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); + xsignal3 (Qscan_error, + build_string ("Containing expression ends prematurely"), + make_number (last_good), make_number (from)); break; case Sstring: @@ -2719,10 +2720,9 @@ scan_lists (from, count, depth, sexpflag) open2: if (!--depth) goto done2; if (depth < min_depth) - Fsignal (Qscan_error, - Fcons (build_string ("Containing expression ends prematurely"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); + xsignal3 (Qscan_error, + build_string ("Containing expression ends prematurely"), + make_number (last_good), make_number (from)); break; case Sendcomment: @@ -2792,12 +2792,9 @@ scan_lists (from, count, depth, sexpflag) return val; lose: - Fsignal (Qscan_error, - Fcons (build_string ("Unbalanced parentheses"), - Fcons (make_number (last_good), - Fcons (make_number (from), Qnil)))); - abort (); - /* NOTREACHED */ + xsignal3 (Qscan_error, + build_string ("Unbalanced parentheses"), + make_number (last_good), make_number (from)); } DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0, @@ -2924,7 +2921,7 @@ scan_sexps_forward (stateptr, from, from_byte, end, targetdepth, int boundary_stop = commentstop == -1; int nofence; int found; - int out_bytepos, out_charpos; + EMACS_INT out_bytepos, out_charpos; int temp; prev_from = from; diff --git a/src/textprop.c b/src/textprop.c index 0318d12913f..fd70f039d22 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -78,6 +78,8 @@ Lisp_Object Vtext_property_default_nonsticky; Lisp_Object interval_insert_behind_hooks; Lisp_Object interval_insert_in_front_hooks; +static void text_read_only P_ ((Lisp_Object)) NO_RETURN; + /* Signal a `text-read-only' error. This function makes it easier to capture that error in GDB by putting a breakpoint on it. */ @@ -86,7 +88,10 @@ static void text_read_only (propval) Lisp_Object propval; { - Fsignal (Qtext_read_only, STRINGP (propval) ? Fcons (propval, Qnil) : Qnil); + if (STRINGP (propval)) + xsignal1 (Qtext_read_only, propval); + + xsignal0 (Qtext_read_only); } diff --git a/src/unexsol.c b/src/unexsol.c index 426a7f7cb99..9f919faedc0 100644 --- a/src/unexsol.c +++ b/src/unexsol.c @@ -24,7 +24,7 @@ unexec (char *new_name, char *old_name, unsigned int data_start, errstring = code_convert_string_norecord (build_string (dlerror ()), Vlocale_coding_system, 0); - Fsignal (Qfile_error, + xsignal (Qfile_error, Fcons (build_string ("Cannot unexec"), Fcons (errstring, data))); } diff --git a/src/w32.c b/src/w32.c index f11ffb7a785..d01a1022a19 100644 --- a/src/w32.c +++ b/src/w32.c @@ -2700,6 +2700,9 @@ utime (const char *name, struct utimbuf *times) int (PASCAL *pfn_WSAStartup) (WORD wVersionRequired, LPWSADATA lpWSAData); void (PASCAL *pfn_WSASetLastError) (int iError); int (PASCAL *pfn_WSAGetLastError) (void); +int (PASCAL *pfn_WSAEventSelect) (SOCKET s, HANDLE hEventObject, long lNetworkEvents); +HANDLE (PASCAL *pfn_WSACreateEvent) (void); +int (PASCAL *pfn_WSACloseEvent) (HANDLE hEvent); int (PASCAL *pfn_socket) (int af, int type, int protocol); int (PASCAL *pfn_bind) (SOCKET s, const struct sockaddr *addr, int namelen); int (PASCAL *pfn_connect) (SOCKET s, const struct sockaddr *addr, int namelen); @@ -2769,7 +2772,7 @@ init_winsock (int load_now) = (void *) GetProcAddress (GetModuleHandle ("kernel32.dll"), "SetHandleInformation"); - winsock_lib = LoadLibrary ("wsock32.dll"); + winsock_lib = LoadLibrary ("Ws2_32.dll"); if (winsock_lib != NULL) { @@ -2782,6 +2785,9 @@ init_winsock (int load_now) LOAD_PROC( WSAStartup ); LOAD_PROC( WSASetLastError ); LOAD_PROC( WSAGetLastError ); + LOAD_PROC( WSAEventSelect ); + LOAD_PROC( WSACreateEvent ); + LOAD_PROC( WSACloseEvent ); LOAD_PROC( socket ); LOAD_PROC( bind ); LOAD_PROC( connect ); @@ -3295,6 +3301,8 @@ sys_listen (int s, int backlog) int rc = pfn_listen (SOCK_HANDLE (s), backlog); if (rc == SOCKET_ERROR) set_errno (); + else + fd_info[s].flags |= FILE_LISTEN; return rc; } h_errno = ENOTSOCK; @@ -3332,14 +3340,18 @@ sys_accept (int s, struct sockaddr * addr, int * addrlen) } check_errno (); - if (fd_info[s].flags & FILE_SOCKET) + if (fd_info[s].flags & FILE_LISTEN) { SOCKET t = pfn_accept (SOCK_HANDLE (s), addr, addrlen); - if (t != INVALID_SOCKET) - return socket_to_fd (t); + int fd = -1; + if (t == INVALID_SOCKET) + set_errno (); + else + fd = socket_to_fd (t); - set_errno (); - return -1; + fd_info[s].cp->status = STATUS_READ_ACKNOWLEDGED; + ResetEvent (fd_info[s].cp->char_avail); + return fd; } h_errno = ENOTSOCK; return -1; @@ -3641,6 +3653,36 @@ _sys_read_ahead (int fd) return cp->status; } +int _sys_wait_accept (int fd) +{ + HANDLE hEv; + child_process * cp; + int rc; + + if (fd < 0 || fd >= MAXDESC) + return STATUS_READ_ERROR; + + cp = fd_info[fd].cp; + + if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY) + return STATUS_READ_ERROR; + + cp->status = STATUS_READ_FAILED; + + hEv = pfn_WSACreateEvent (); + rc = pfn_WSAEventSelect (SOCK_HANDLE (fd), hEv, FD_ACCEPT); + if (rc != SOCKET_ERROR) + { + rc = WaitForSingleObject (hEv, INFINITE); + pfn_WSAEventSelect (SOCK_HANDLE (fd), NULL, 0); + pfn_WSACloseEvent (hEv); + if (rc == WAIT_OBJECT_0) + cp->status = STATUS_READ_SUCCEEDED; + } + + return cp->status; +} + int sys_read (int fd, char * buffer, unsigned int count) { diff --git a/src/w32.h b/src/w32.h index ecc986269fb..1d5dbee6d40 100644 --- a/src/w32.h +++ b/src/w32.h @@ -93,6 +93,7 @@ extern filedesc fd_info [ MAXDESC ]; /* fd_info flag definitions */ #define FILE_READ 0x0001 #define FILE_WRITE 0x0002 +#define FILE_LISTEN 0x0004 #define FILE_BINARY 0x0010 #define FILE_LAST_CR 0x0020 #define FILE_AT_EOF 0x0040 @@ -136,6 +137,9 @@ extern void syms_of_w32menu (void); extern void globals_of_w32menu (void); extern void syms_of_fontset (void); +extern int _sys_read_ahead (int fd); +extern int _sys_wait_accept (int fd); + #endif /* EMACS_W32_H */ /* arch-tag: 02c36b00-312b-4c4d-a1d9-f905c5e968f0 diff --git a/src/w32proc.c b/src/w32proc.c index a9e0e0cb83f..d874d183b17 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1,6 +1,6 @@ /* Process support for GNU Emacs on the Microsoft W32 API. Copyright (C) 1992, 1995, 1999, 2000, 2001, 2002, 2003, 2004, - 2005, 2006 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -280,7 +280,10 @@ reader_thread (void *arg) { int rc; - rc = _sys_read_ahead (cp->fd); + if (fd_info[cp->fd].flags & FILE_LISTEN) + rc = _sys_wait_accept (cp->fd); + else + rc = _sys_read_ahead (cp->fd); /* The name char_avail is a misnomer - it really just means the read-ahead has completed, whether successfully or not. */ diff --git a/src/w32term.c b/src/w32term.c index 3683089cb3e..ddc15e77259 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -5480,20 +5480,52 @@ x_calc_absolute_position (f) { int flags = f->size_hint_flags; - /* Treat negative positions as relative to the leftmost bottommost + /* The sum of the widths of the frame's left and right borders, and + the sum of the heights of the frame's top and bottom borders (in + pixels) drawn by Windows. */ + unsigned int left_right_borders_width, top_bottom_borders_height; + + /* Try to get the actual values of these two variables. We compute + the border width (height) by subtracting the width (height) of + the frame's client area from the width (height) of the frame's + entire window. */ + WINDOWPLACEMENT wp = { 0 }; + RECT client_rect = { 0 }; + + if (GetWindowPlacement (FRAME_W32_WINDOW (f), &wp) + && GetClientRect (FRAME_W32_WINDOW (f), &client_rect)) + { + left_right_borders_width = + (wp.rcNormalPosition.right - wp.rcNormalPosition.left) - + (client_rect.right - client_rect.left); + + top_bottom_borders_height = + (wp.rcNormalPosition.bottom - wp.rcNormalPosition.top) - + (client_rect.bottom - client_rect.top); + } + else + { + /* Use sensible default values. */ + left_right_borders_width = 8; + top_bottom_borders_height = 32; + } + + /* Treat negative positions as relative to the rightmost bottommost position that fits on the screen. */ if (flags & XNegative) f->left_pos = (FRAME_W32_DISPLAY_INFO (f)->width - FRAME_PIXEL_WIDTH (f) - + f->left_pos); + + f->left_pos + - (left_right_borders_width - 1)); if (flags & YNegative) f->top_pos = (FRAME_W32_DISPLAY_INFO (f)->height - FRAME_PIXEL_HEIGHT (f) - + f->top_pos); - /* The left_pos and top_pos - are now relative to the top and left screen edges, - so the flags should correspond. */ + + f->top_pos + - (top_bottom_borders_height - 1)); + + /* The left_pos and top_pos are now relative to the top and left + screen edges, so the flags should correspond. */ f->size_hint_flags &= ~ (XNegative | YNegative); } diff --git a/src/window.c b/src/window.c index 5a03296a18a..2d15cdc7e4e 100644 --- a/src/window.c +++ b/src/window.c @@ -3676,7 +3676,7 @@ displayed. */) DEFUN ("force-window-update", Fforce_window_update, Sforce_window_update, 0, 1, 0, - doc: /* Force redisplay of all windows. + doc: /* Force all windows to be updated on next redisplay. If optional arg OBJECT is a window, force redisplay of that window only. If OBJECT is a buffer or buffer name, force redisplay of all windows displaying that buffer. */) @@ -4959,9 +4959,9 @@ window_scroll_pixel_based (window, n, whole, noerror) else if (noerror) return; else if (n < 0) /* could happen with empty buffers */ - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); else - Fsignal (Qend_of_buffer, Qnil); + xsignal0 (Qend_of_buffer); } else { @@ -4972,7 +4972,7 @@ window_scroll_pixel_based (window, n, whole, noerror) else if (noerror) return; else - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); } /* If control gets here, then we vscrolled. */ @@ -5173,7 +5173,7 @@ window_scroll_line_based (window, n, whole, noerror) if (noerror) return; else - Fsignal (Qbeginning_of_buffer, Qnil); + xsignal0 (Qbeginning_of_buffer); } if (pos < ZV) @@ -5259,7 +5259,7 @@ window_scroll_line_based (window, n, whole, noerror) if (noerror) return; else - Fsignal (Qend_of_buffer, Qnil); + xsignal0 (Qend_of_buffer); } } @@ -5883,8 +5883,7 @@ DEFUN ("window-configuration-frame", Fwindow_configuration_frame, Swindow_config register struct save_window_data *data; struct Lisp_Vector *saved_windows; - if (! WINDOW_CONFIGURATIONP (config)) - wrong_type_argument (Qwindow_configuration_p, config); + CHECK_WINDOW_CONFIGURATION (config); data = (struct save_window_data *) XVECTOR (config); saved_windows = XVECTOR (data->saved_windows); @@ -5909,8 +5908,7 @@ the return value is nil. Otherwise the value is t. */) FRAME_PTR f; int old_point = -1; - while (!WINDOW_CONFIGURATIONP (configuration)) - wrong_type_argument (Qwindow_configuration_p, configuration); + CHECK_WINDOW_CONFIGURATION (configuration); data = (struct save_window_data *) XVECTOR (configuration); saved_windows = XVECTOR (data->saved_windows); @@ -6949,10 +6947,8 @@ compare_window_configurations (c1, c2, ignore_positions) struct Lisp_Vector *sw1, *sw2; int i; - if (!WINDOW_CONFIGURATIONP (c1)) - wrong_type_argument (Qwindow_configuration_p, c1); - if (!WINDOW_CONFIGURATIONP (c2)) - wrong_type_argument (Qwindow_configuration_p, c2); + CHECK_WINDOW_CONFIGURATION (c1); + CHECK_WINDOW_CONFIGURATION (c2); d1 = (struct save_window_data *) XVECTOR (c1); d2 = (struct save_window_data *) XVECTOR (c2); diff --git a/src/xdisp.c b/src/xdisp.c index 8a745ac778e..fbd61f7e2be 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3889,7 +3889,7 @@ handle_single_display_spec (it, spec, object, position, { Lisp_Object form; Lisp_Object location, value; - struct text_pos start_pos; + struct text_pos start_pos, save_pos; int valid_p; /* If SPEC is a list of the form `(when FORM . VALUE)', evaluate FORM. @@ -4106,7 +4106,10 @@ handle_single_display_spec (it, spec, object, position, /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ + save_pos = it->position; + it->position = *position; push_it (it); + it->position = save_pos; it->area = TEXT_AREA; it->what = IT_IMAGE; @@ -4180,7 +4183,10 @@ handle_single_display_spec (it, spec, object, position, { /* Save current settings of IT so that we can restore them when we are finished with the glyph property value. */ + save_pos = it->position; + it->position = *position; push_it (it); + it->position = save_pos; if (NILP (location)) it->area = TEXT_AREA; @@ -5090,6 +5096,12 @@ pop_it (it) case GET_FROM_STRETCH: it->object = p->u.comp.object; break; + case GET_FROM_BUFFER: + it->object = it->w->buffer; + break; + case GET_FROM_STRING: + it->object = it->string; + break; } it->end_charpos = p->end_charpos; it->string_nchars = p->string_nchars; @@ -5409,7 +5421,6 @@ reseat_1 (it, pos, set_stop_p) xassert (CHARPOS (pos) >= BEGV && CHARPOS (pos) <= ZV); it->current.pos = it->position = pos; - XSETBUFFER (it->object, current_buffer); it->end_charpos = ZV; it->dpvec = NULL; it->current.dpvec_index = -1; @@ -5905,14 +5916,12 @@ set_iterator_to_next (it, reseat_p) { IT_STRING_BYTEPOS (*it) += it->len; IT_STRING_CHARPOS (*it) += it->cmp_len; - it->object = it->string; goto consider_string_end; } else if (it->method == GET_FROM_BUFFER) { IT_BYTEPOS (*it) += it->len; IT_CHARPOS (*it) += it->cmp_len; - it->object = it->w->buffer; } break; @@ -6152,9 +6161,7 @@ next_element_from_string (it) } } - /* Record what we have and where it came from. Note that we store a - buffer position in IT->position although it could arguably be a - string position. */ + /* Record what we have and where it came from. */ it->what = IT_CHARACTER; it->object = it->string; it->position = position; @@ -6879,6 +6886,10 @@ move_it_to (it, to_charpos, to_x, to_y, to_vpos, op) if (reached) break; } + else if (BUFFERP (it->object) + && it->method == GET_FROM_BUFFER + && IT_CHARPOS (*it) >= to_charpos) + skip = MOVE_POS_MATCH_OR_ZV; else skip = move_it_in_display_line_to (it, to_charpos, -1, MOVE_TO_POS); @@ -16648,6 +16659,7 @@ display_mode_line (w, face_id, format) kboard-local variables in the mode_line_format will get the right values. */ push_frame_kboard (it.f); + record_unwind_save_match_data (); display_mode_element (&it, 0, 0, 0, format, Qnil, 0); pop_frame_kboard (); diff --git a/src/xfaces.c b/src/xfaces.c index 43d1352f335..6a05611939e 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -496,7 +496,6 @@ static int font_scalable_p P_ ((struct font_name *)); static int get_lface_attributes P_ ((struct frame *, Lisp_Object, Lisp_Object *, int)); static int load_pixmap P_ ((struct frame *, Lisp_Object, unsigned *, unsigned *)); static unsigned char *xstrlwr P_ ((unsigned char *)); -static void signal_error P_ ((char *, Lisp_Object)); static struct frame *frame_or_selected_frame P_ ((Lisp_Object, int)); static void load_face_font P_ ((struct frame *, struct face *)); static void load_face_colors P_ ((struct frame *, struct face *, Lisp_Object *)); @@ -863,17 +862,6 @@ xstrlwr (s) } -/* Signal `error' with message S, and additional argument ARG. */ - -static void -signal_error (s, arg) - char *s; - Lisp_Object arg; -{ - Fsignal (Qerror, Fcons (build_string (s), Fcons (arg, Qnil))); -} - - /* If FRAME is nil, return a pointer to the selected frame. Otherwise, check that FRAME is a live frame, and return a pointer to it. NPARAM is the parameter number of FRAME, for @@ -1182,14 +1170,11 @@ load_pixmap (f, name, w_ptr, h_ptr) unsigned int *w_ptr, *h_ptr; { int bitmap_id; - Lisp_Object tem; if (NILP (name)) return 0; - tem = Fbitmap_spec_p (name); - if (NILP (tem)) - wrong_type_argument (Qbitmap_spec_p, name); + CHECK_TYPE (!NILP (Fbitmap_spec_p (name)), Qbitmap_spec_p, name); BLOCK_INPUT; if (CONSP (name)) @@ -3409,7 +3394,7 @@ resolve_face_name (face_name, signal_p) if (EQ (hare, tortoise)) { if (signal_p) - Fsignal (Qcircular_list, Fcons (orig_face, Qnil)); + xsignal1 (Qcircular_list, orig_face); return Qdefault; } } diff --git a/src/xfns.c b/src/xfns.c index 253f2829f85..85296bc6c35 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -766,9 +766,7 @@ x_decode_color (f, color_name, mono_color) if (x_defined_color (f, SDATA (color_name), &cdef, 1)) return cdef.pixel; - Fsignal (Qerror, Fcons (build_string ("Undefined color"), - Fcons (color_name, Qnil))); - return 0; + signal_error ("Undefined color", color_name); } diff --git a/src/xselect.c b/src/xselect.c index 9c2c221c021..fcac2860359 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -555,11 +555,9 @@ x_get_local_selection (selection_symbol, target_type, local_request) && INTEGERP (XCAR (XCDR (check))) && NILP (XCDR (XCDR (check)))))) return value; - else - return - Fsignal (Qerror, - Fcons (build_string ("invalid data returned by selection-conversion function"), - Fcons (handler_fn, Fcons (value, Qnil)))); + + signal_error ("Invalid data returned by selection-conversion function", + list2 (handler_fn, value)); } /* Subroutines of x_reply_selection_request. */ @@ -1348,8 +1346,7 @@ copy_multiple_data (obj) CHECK_VECTOR (vec2); if (XVECTOR (vec2)->size != 2) /* ??? Confusing error message */ - Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"), - Fcons (vec2, Qnil))); + signal_error ("Vectors must be of length 2", vec2); XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil); XVECTOR (XVECTOR (vec)->contents [i])->contents [0] = XVECTOR (vec2)->contents [0]; @@ -1717,19 +1714,15 @@ x_get_window_property_as_lisp_data (display, window, property, target_type, there_is_a_selection_owner = XGetSelectionOwner (display, selection_atom); UNBLOCK_INPUT; - Fsignal (Qerror, - there_is_a_selection_owner - ? Fcons (build_string ("selection owner couldn't convert"), - actual_type - ? Fcons (target_type, - Fcons (x_atom_to_symbol (display, - actual_type), - Qnil)) - : Fcons (target_type, Qnil)) - : Fcons (build_string ("no selection"), - Fcons (x_atom_to_symbol (display, - selection_atom), - Qnil))); + if (there_is_a_selection_owner) + signal_error ("Selection owner couldn't convert", + actual_type + ? list2 (target_type, + x_atom_to_symbol (display, actual_type)) + : target_type); + else + signal_error ("No selection", + x_atom_to_symbol (display, selection_atom)); } if (actual_type == dpyinfo->Xatom_INCR) @@ -1929,10 +1922,7 @@ lisp_data_to_selection_data (display, obj, { if (SCHARS (obj) < SBYTES (obj)) /* OBJ is a multibyte string containing a non-ASCII char. */ - Fsignal (Qerror, /* Qselection_error */ - Fcons (build_string - ("Non-ASCII string must be encoded in advance"), - Fcons (obj, Qnil))); + signal_error ("Non-ASCII string must be encoded in advance", obj); if (NILP (type)) type = QSTRING; *format_ret = 8; @@ -1993,10 +1983,7 @@ lisp_data_to_selection_data (display, obj, (*(Atom **) data_ret) [i] = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]); else - Fsignal (Qerror, /* Qselection_error */ - Fcons (build_string - ("all elements of selection vector must have same type"), - Fcons (obj, Qnil))); + signal_error ("All elements of selection vector must have same type", obj); } #if 0 /* #### MULTIPLE doesn't work yet */ else if (VECTORP (XVECTOR (obj)->contents [0])) @@ -2012,10 +1999,9 @@ lisp_data_to_selection_data (display, obj, { Lisp_Object pair = XVECTOR (obj)->contents [i]; if (XVECTOR (pair)->size != 2) - Fsignal (Qerror, - Fcons (build_string - ("elements of the vector must be vectors of exactly two elements"), - Fcons (pair, Qnil))); + signal_error ( + "Elements of the vector must be vectors of exactly two elements", + pair); (*(Atom **) data_ret) [i * 2] = symbol_to_x_atom (dpyinfo, display, @@ -2025,10 +2011,8 @@ lisp_data_to_selection_data (display, obj, XVECTOR (pair)->contents [1]); } else - Fsignal (Qerror, - Fcons (build_string - ("all elements of the vector must be of the same type"), - Fcons (obj, Qnil))); + signal_error ("All elements of the vector must be of the same type", + obj); } #endif @@ -2043,10 +2027,9 @@ lisp_data_to_selection_data (display, obj, if (CONSP (XVECTOR (obj)->contents [i])) *format_ret = 32; else if (!INTEGERP (XVECTOR (obj)->contents [i])) - Fsignal (Qerror, /* Qselection_error */ - Fcons (build_string - ("elements of selection vector must be integers or conses of integers"), - Fcons (obj, Qnil))); + signal_error (/* Qselection_error */ + "Elements of selection vector must be integers or conses of integers", + obj); /* Use sizeof(long) even if it is more than 32 bits. See comment in x_get_window_property and x_fill_property_data. */ @@ -2063,9 +2046,7 @@ lisp_data_to_selection_data (display, obj, } } else - Fsignal (Qerror, /* Qselection_error */ - Fcons (build_string ("unrecognized selection data"), - Fcons (obj, Qnil))); + signal_error (/* Qselection_error */ "Unrecognized selection data", obj); *type_ret = symbol_to_x_atom (dpyinfo, display, type); } @@ -2351,15 +2332,13 @@ initialize_cut_buffers (display, window) #define CHECK_CUT_BUFFER(symbol) \ - { CHECK_SYMBOL ((symbol)); \ + do { CHECK_SYMBOL ((symbol)); \ if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \ && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \ && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \ && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \ - Fsignal (Qerror, \ - Fcons (build_string ("doesn't name a cut buffer"), \ - Fcons ((symbol), Qnil))); \ - } + signal_error ("Doesn't name a cut buffer", (symbol)); \ + } while (0) DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal, Sx_get_cut_buffer_internal, 1, 1, 0, @@ -2392,10 +2371,9 @@ DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal, return Qnil; if (format != 8 || type != XA_STRING) - Fsignal (Qerror, - Fcons (build_string ("cut buffer doesn't contain 8-bit data"), - Fcons (x_atom_to_symbol (display, type), - Fcons (make_number (format), Qnil)))); + signal_error ("Cut buffer doesn't contain 8-bit data", + list2 (x_atom_to_symbol (display, type), + make_number (format))); ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil); /* Use xfree, not XFree, because x_get_window_property diff --git a/src/xterm.c b/src/xterm.c index 165bc1df766..ca5af4afbfc 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -363,7 +363,7 @@ static void x_check_expected_move P_ ((struct frame *, int, int)); static void x_sync_with_move P_ ((struct frame *, int, int, int)); static int handle_one_xevent P_ ((struct x_display_info *, XEvent *, int *, struct input_event *)); -static SIGTYPE x_connection_closed P_ ((Display *, char *)); +static SIGTYPE x_connection_closed P_ ((Display *, char *)) NO_RETURN; /* Flush display of frame F, or of all frames if F is null. */ @@ -7988,7 +7988,7 @@ x_connection_closed (dpy, error_message) /* We specifically use it before defining it, so that gcc doesn't inline it, otherwise gdb doesn't know how to properly put a breakpoint on it. */ -static void x_error_quitter (Display *display, XErrorEvent *error); +static void x_error_quitter P_ ((Display *, XErrorEvent *)) NO_RETURN; /* This is the first-level handler for X protocol errors. It calls x_error_quitter or x_error_catcher. */ |