diff options
author | Miles Bader <miles@gnu.org> | 2007-07-15 02:05:20 +0000 |
---|---|---|
committer | Miles Bader <miles@gnu.org> | 2007-07-15 02:05:20 +0000 |
commit | 7eb1e4534e88a32fe5e549e630fdabf3e062be2b (patch) | |
tree | 34fc72789f1cfbfeb067cf507f8871c322df300a /src | |
parent | 76d11d2cf9623e9f4c38e8239c4444ffc1fae485 (diff) | |
parent | 6f8a87c027ebd6f9cfdac5c0df97d651227bec62 (diff) | |
download | emacs-7eb1e4534e88a32fe5e549e630fdabf3e062be2b.tar.gz |
Merge from emacs--devo--0
Patches applied:
* emacs--devo--0 (patch 803-813)
- Update from CVS
- Merge from emacs--rel--22
* emacs--rel--22 (patch 51-58)
- Update from CVS
- Merge from gnus--rel--5.10
* gnus--rel--5.10 (patch 233-236)
- Merge from emacs--devo--0
- Update from CVS
Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-25
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 246 | ||||
-rw-r--r-- | src/Makefile.in | 2 | ||||
-rw-r--r-- | src/alloc.c | 13 | ||||
-rw-r--r-- | src/buffer.c | 4 | ||||
-rw-r--r-- | src/callint.c | 11 | ||||
-rw-r--r-- | src/casetab.c | 2 | ||||
-rw-r--r-- | src/coding.c | 6 | ||||
-rw-r--r-- | src/config.in | 4 | ||||
-rw-r--r-- | src/doc.c | 2 | ||||
-rw-r--r-- | src/editfns.c | 6 | ||||
-rw-r--r-- | src/eval.c | 123 | ||||
-rw-r--r-- | src/fileio.c | 5 | ||||
-rw-r--r-- | src/fns.c | 47 | ||||
-rw-r--r-- | src/fontset.c | 2 | ||||
-rw-r--r-- | src/gmalloc.c | 177 | ||||
-rw-r--r-- | src/image.c | 4 | ||||
-rw-r--r-- | src/keyboard.c | 2 | ||||
-rw-r--r-- | src/keymap.c | 502 | ||||
-rw-r--r-- | src/keymap.h | 4 | ||||
-rw-r--r-- | src/lisp.h | 14 | ||||
-rw-r--r-- | src/macgui.h | 4 | ||||
-rw-r--r-- | src/macmenu.c | 118 | ||||
-rw-r--r-- | src/macterm.c | 88 | ||||
-rw-r--r-- | src/makefile.w32-in | 3 | ||||
-rw-r--r-- | src/minibuf.c | 24 | ||||
-rw-r--r-- | src/print.c | 2 | ||||
-rw-r--r-- | src/process.c | 311 | ||||
-rw-r--r-- | src/process.h | 76 | ||||
-rw-r--r-- | src/search.c | 179 | ||||
-rw-r--r-- | src/term.c | 13 | ||||
-rw-r--r-- | src/w32.c | 12 | ||||
-rw-r--r-- | src/w32bdf.c | 3 | ||||
-rw-r--r-- | src/w32fns.c | 12 | ||||
-rw-r--r-- | src/w32menu.c | 68 | ||||
-rw-r--r-- | src/w32term.c | 5 | ||||
-rw-r--r-- | src/window.c | 2 | ||||
-rw-r--r-- | src/xdisp.c | 2 |
37 files changed, 1313 insertions, 785 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 4d2e7ccb375..a707d884454 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,219 @@ +2007-07-14 Jason Rumney <jasonr@gnu.org> + + * process.c [WINDOWSNT]: Don't undefine AF_INET6. + +2007-07-14 Richard Stallman <rms@gnu.org> + + * eval.c (maybe_call_debugger): New function. + (find_handler_clause): Use maybe_call_debugger. + Call it when the handler says `debug'. + Eliminate DEBUGGER_VALUE_PTR. + (Fsignal): Eliminate debugger_value. + (Qdebug): New variable. + (syms_of_eval): Initialize it. + +2007-07-14 Juanma Barranquero <lekktu@gmail.com> + + * eval.c (Fprogn): + * keyboard.c (Ftrack_mouse): + * print.c (Fwith_output_to_temp_buffer): + * window.c (Fsave_window_excursion): Doc fix. + +2007-07-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * eval.c (init_eval_once): Bump max_lisp_eval_depth to 400. + +2007-07-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * process.h (struct Lisp_Process): Turn slots infd, outfd, + kill_without_query, pty_flag, tick, update_tick, decoding_carryover, + inherit_coding_system_flag, filter_multibyte, adaptive_read_buffering, + read_output_delay, and read_output_skip from Lisp_Objects to ints. + Remove unused encoding_carryover. + * process.c: Adjust all functions accordingly. + +2007-07-12 Richard Stallman <rms@gnu.org> + + * term.c: Include unistd.h only if HAVE_UNISTD_H. + +2007-07-11 Jason Rumney <jasonr@gnu.org> + + * makefile.w32-in (LIBS): Include OLE32. + + * w32fns.c (w32_msg_pump) <WM_EMACS_CREATEWINDOW>: Initialize COM. + (w32_msg_pump) <WM_DESTROY>: Uninitialize COM. + +2007-07-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * lisp.h (struct Lisp_Hash_Table): Turn next_weak into a bare pointer. + * fns.c (weak_hash_tables): Rename from Vweak_hash_tables and turned + from a Lisp_Object into a bare pointer. + (make_hash_table, copy_hash_table, sweep_weak_hash_tables, init_fns): + Adjust the code correspondingly. + + * alloc.c (emacs_blocked_free): Remove unused var `bytes_used_now'. + + * term.c: Include unistd.h for ttyname, used in handle_one_term_event. + (term_show_mouse_face): Remove unused var `j'. + (handle_one_term_event): Remove unused vars `i' and `j'. + Don't cast return value of ttyname since it's not necessary. + +2007-07-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * alloc.c (mark_maybe_pointer): Enforce mult-of-8 alignment when using + USE_LSB_TAG. Suggested by Dmitry Antipov <dmantipov@yandex.ru>. + + * fns.c (map_char_table): Use an array of int for `indices' rather than + an array of Lisp_Objects (which are only ever integers anyway). + (Fmap_char_table): Update caller. + * lisp.h: Update prototype. + * keymap.c (Fset_keymap_parent, map_keymap, Fcopy_keymap): + * fontset.c (Ffontset_info): + * casetab.c (set_case_table): Update callers. + + * editfns.c (Ftranspose_regions): Use EMACS_INT for positions. + + * keymap.c (struct accessible_keymaps_data) + (struct where_is_internal_data): New structures. + (accessible_keymaps_1, where_is_internal_1): Use them to change + interface to adhere to the one used by map_keymap. + (Faccessible_keymaps, where_is_internal): Use map_keymap. + (accessible_keymaps_char_table, where_is_internal_2): Remove. + + * keymap.h (map_keymap_function_t): More informative prototype. + +2007-07-10 Guanpeng Xu <herberteuler@hotmail.com> + + * search.c (Vinhibit_changing_match_data, search_regs_1): New vars. + (looking_at_1): Don't change search_regs and last_thing_searched + if `inhibit-changing-match-data' is non-nil. + (string_match_1, search_buffer, set_search_regs): Likewise. + (syms_of_search): Add Lisp level definition for + `inhibit-changing-match-data' and set it to nil. + (boyer_moore): If `inhibit-changing-match-data' is non-nil, compute + start and end of the match, instead of using values in search_regs. + +2007-07-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuf.c (Fcompleting_read): New value `confirm-only' + for `require-match'. + +2007-06-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * fileio.c (Fdo_auto_save): Revert last patch installed unwillingly as + part of the 2007-06-27 change to syms_of_fileio. + +2007-06-28 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c [USE_MAC_TSM] (mac_handle_text_input_event): + Check WINDOWP before using XWINDOW. Consolidate return statements. + +2007-06-27 Richard Stallman <rms@gnu.org> + + * fileio.c (syms_of_fileio) <after-insert-file-functions>: Doc fix. + +2007-06-27 Juanma Barranquero <lekktu@gmail.com> + + * buffer.c (syms_of_buffer) <selective-display>: Fix typo in docstring. + +2007-06-26 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * gmalloc.c [HAVE_GTK_AND_PTHREAD]: Check this after including config.h. + (_aligned_blocks_mutex) [USE_PTHREAD]: New variable. + (LOCK_ALIGNED_BLOCKS, UNLOCK_ALIGNED_BLOCKS): New macros. + (_free_internal, memalign): Use them. + (_malloc_mutex, _aligned_blocks_mutex) [USE_PTHREAD]: + Initialize to PTHREAD_MUTEX_INITIALIZER. + (malloc_initialize_1) [USE_PTHREAD]: Don't use recursive mutex. + (morecore_nolock): Rename from morecore. All uses changed. + Use only nolock versions of internal allocation functions. + (_malloc_internal_nolock, _realloc_internal_nolock) + (_free_internal_nolock): New functions created from + _malloc_internal, _realloc_internal, and _free_internal. + (_malloc_internal, _realloc_internal, _free_internal): Use them. + Copy hook value to automatic variable before its use. + (memalign): Copy hook value to automatic variable before its use. + +2007-06-26 Kenichi Handa <handa@m17n.org> + + * coding.c (Ffind_operation_coding_system): Docstring improved. + (syms_of_coding): Docstring of `file-coding-system-alist' improved. + +2007-06-25 David Kastrup <dak@gnu.org> + + * keymap.c (Fcurrent_active_maps): Add `position' argument. + (Fwhere_is_internal): Adjust call to `current-active-maps' to + cater for additional parameter. + + * keymap.h: Adjust number of parameters to `current-active-maps'. + + * doc.c (Fsubstitute_command_keys): Adjust call of + `current-active-maps'. + +2007-06-25 David Kastrup <dak@gnu.org> + + * callint.c (Fcall_interactively): Make the parsing of interactive + specs somewhat more readable. + +2007-06-23 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macterm.c (x_draw_fringe_bitmap) [MAC_OSX]: Extend fringe background + to scroll bar gap also when bitmap fills fringe. Draw only foreground + if extended background has already been filled. + +2007-06-22 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * macgui.h (USE_CG_DRAWING): Don't require USE_ATSUI. + (USE_MAC_TOOLBAR): Require USE_CG_DRAWING. + + * macmenu.c (mac_dialog_modal_filter, Fx_popup_dialog) [MAC_OSX]: + Put special treatment for Fmessage_box, Fyes_or_no_p, and Fy_or_n_p + in #if 0 as it is not compatible with y-or-n-p-with-timeout. + (timer_check) [TARGET_API_MAC_CARBON]: Add extern. + [TARGET_API_MAC_CARBON] (mac_handle_dialog_event): Use QuitEventLoop + instead of QuitAppModalLoopForWindow. Consolidate QuitEventLoop calls. + (pop_down_dialog) [TARGET_API_MAC_CARBON]: New function. + [TARGET_API_MAC_CARBON] (create_and_show_dialog): Use it for unwind. + Run timers during dialog popup. + (Fmenu_or_popup_active_p) [TARGET_API_MAC_CARBON]: Use popup_activated. + +2007-06-21 Jason Rumney <jasonr@gnu.org> + + * image.c (convert_mono_to_color_image): Swap fore and background. + +2007-06-20 Jason Rumney <jasonr@gnu.org> + + * w32bdf.c (w32_BDF_to_x_font): Unmap memory when finished. + (w32_free_bdf_font): Unmap memory not handle. + +2007-06-20 Sam Steingold <sds@gnu.org> + + * gmalloc.c (__morecore): Fix the declaration to comply with the + definition. + +2007-06-20 Juanma Barranquero <lekktu@gmail.com> + + * w32term.c (w32_delete_display): Remove leftover declaration. + (w32_define_cursor, w32_initialize): Make static. + + * w32.c (_wsa_errlist): Fix typo in error message. + (init_environment): Ignore any environment variable from the + registry having a null value. + +2007-06-20 Glenn Morris <rgm@gnu.org> + + * Makefile.in (LIBGIF): Default to -lgif. + +2007-06-17 Jason Rumney <jasonr@gnu.org> + + * w32menu.c (add_menu_item): Don't use multibyte string functions on + unicode strings. + +2007-06-16 Juanma Barranquero <lekktu@gmail.com> + + * xdisp.c (syms_of_xdisp) <auto-resize-tool-bars>: + Fix typo in docstring. + 2007-06-16 Eli Zaretskii <eliz@gnu.org> * w32menu.c (add_menu_item): Escape `&' characters in menu items @@ -92,7 +308,7 @@ * w32fns.c (Fx_file_dialog): Take size from struct not pointer. -2007-06-08 Juanma Barranquero <lekktu@gmail.com> +2007-06-08 Juanma Barranquero <lekktu@gmail.com> * callint.c (Fcall_interactively): * editfns.c (Fdelete_and_extract_region): @@ -110,7 +326,7 @@ * xselect.c (Fx_get_atom_name): * xterm.c (x_term_init): Use empty_unibyte_string. -2007-06-08 Dmitry Antipov <dmitry.antipov@mail.ru> (tiny change) +2007-06-08 Dmitry Antipov <dmantipov@yandex.ru> (tiny change) * alloc.c (init_strings): Initialize canonical empty strings. (make_uninit_string, make_uninit_multibyte_string): Return appropriate @@ -145,7 +361,7 @@ [TARGET_API_MAC_CARBON] (install_menu_target_item_handler): Remove argument. Install handler to application. (set_frame_menubar): Don't change deep_p. - (mac_menu_show): Use FRAME_OUTER_TO_INNER_DIFF_X and + (mac_menu_show): Use FRAME_OUTER_TO_INNER_DIFF_X and FRAME_OUTER_TO_INNER_DIFF_Y. (DIALOG_BUTTON_COMMAND_ID_OFFSET, DIALOG_BUTTON_COMMAND_ID_P) (DIALOG_BUTTON_COMMAND_ID_VALUE, DIALOG_BUTTON_MAKE_COMMAND_ID) @@ -497,6 +713,10 @@ 2007-04-24 Chong Yidong <cyd@stupidchicken.com> + * Branch for 22.1. + +2007-04-24 Chong Yidong <cyd@stupidchicken.com> + * xdisp.c (redisplay_window): Use BEG_UNCHANGED and END_UNCHANGED values of the actual window. @@ -993,13 +1213,13 @@ when popup menu finishes. * w32fns.c (menubar_in_use): New flag. - (w32_wnd_proc) [WM_INITMENU, WM_EXITMENULOOP, WM_TIMER, WM_COMMAND]: + (w32_wnd_proc) <WM_INITMENU, WM_EXITMENULOOP, WM_TIMER, WM_COMMAND>: Use it. * w32menu.c (Fx_popup_menu): Don't free menu strings here. (w32_menu_show): Do it here instead. - * w32fns.c (w32_wnd_proc) [WM_INITMENU]: Set menubar_active frame + * w32fns.c (w32_wnd_proc) <WM_INITMENU>: Set menubar_active frame parameter. * w32menu.c (current_popup_menu): Make available globally. @@ -1007,7 +1227,7 @@ menu event into the keyboard buffer. Remove menu_command_in_progress. * w32fns.c (current_popup_menu): Use from w32menu.c. - (w32_wnd_proc) [WM_EXITMENULOOP, WM_TIMER]: Use menubar_active + (w32_wnd_proc) <WM_EXITMENULOOP, WM_TIMER>: Use menubar_active and current_popup_menu to determine whether a menubar menu has been cancelled. @@ -10118,7 +10338,7 @@ * w32term.h (x_output): Add focus_state. * w32term.c (x_focus_changed, w32_detect_focus_change): New functions. - (w32_read_socket) [WM_SETFOCUS]: Call w32_detect_focus_change. + (w32_read_socket) <WM_SETFOCUS>: Call w32_detect_focus_change. 2005-03-25 Stefan Monnier <monnier@iro.umontreal.ca> @@ -10517,7 +10737,7 @@ (XTread_socket) [!MAC_OSX]: Don't pass keyboard events to TSM. [MAC_OS8] (make_mac_terminal_frame) [TARGET_API_MAC_CARBON]: Set default cursors. - (mac_initialize) [USE_CARBON_EVENTS && !MAC_OSX] : Don't call + (mac_initialize) [USE_CARBON_EVENTS && !MAC_OSX]: Don't call init_service_handler or init_quit_char_handler. (mac_initialize) [!MAC_OSX]: Don't call MakeMeTheFrontProcess. @@ -11454,7 +11674,7 @@ (install_window_handler) [TARGET_API_MAC_CARBON]: Register handlers for tracking/receiving drag-and-drop items. (do_ae_open_documents): Generate unibyte strings for filenames. - (mac_do_receive_drag) [TARGET_API_MAC_CARBON] : Likewise. + (mac_do_receive_drag) [TARGET_API_MAC_CARBON]: Likewise. Reject only non-filename items. Set event modifiers, and return value. 2004-12-28 Dan Nicolaescu <dann@ics.uci.edu> @@ -13411,7 +13631,7 @@ * w32term.h (AppendMenuW_Proc): Move declaration from w32menu.c. - * w32fns.c (w32_wnd_proc) [WM_MEASUREITEM, WM_DRAWITEM]: + * w32fns.c (w32_wnd_proc) <WM_MEASUREITEM, WM_DRAWITEM>: Handle Unicode menu titles. 2004-09-07 Kim F. Storm <storm@cua.dk> @@ -15844,7 +16064,7 @@ * macgui.h [MAC_OSX]: Include Carbon/Carbon.h. (mktime, DEBUG, Z, free, malloc, realloc, max, min) - (init_process) [MAC_OSX] : Avoid conflicts with Carbon/Carbon.h. + (init_process) [MAC_OSX]: Avoid conflicts with Carbon/Carbon.h. [!MAC_OSX]: Include QDOffscreen.h and Controls.h. (INFINITY) [MAC_OSX]: Avoid conflict with definition in math.h. (Bitmap): Remove typedef. @@ -16149,7 +16369,7 @@ * cmds.c (Fend_of_line): Doc fix. -2004-02-16 Dmitry Antipov <dmitry.antipov@mail.ru> (tiny change) +2004-02-16 Dmitry Antipov <dmantipov@yandex.ru> (tiny change) * keyboard.c (prev_read): New static variable. (read_avail_input): Use it to zero out only those slots in buf[] @@ -21965,7 +22185,7 @@ (best_matching_font, choose_face_font): Add `needs_overstrike' argument, and use it to return whether overstriking is desirable for this face/font combo. - (set_font_frame_param: Pass new argument to choose_face_font. + (set_font_frame_param): Pass new argument to choose_face_font. 2002-11-17 Ben Key <BKey1@tampabay.rr.com> diff --git a/src/Makefile.in b/src/Makefile.in index 93496ca1199..a00cd10ef57 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -440,7 +440,7 @@ XFT_LIBS=@XFT_LIBS@ #if HAVE_GIF #ifndef LIBGIF -#define LIBGIF -lungif +#define LIBGIF -lgif #endif /* not defined LIBGIF */ #else /* not HAVE_GIF */ #define LIBGIF diff --git a/src/alloc.c b/src/alloc.c index cc6d1d55870..0c5b9d7a02b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1181,8 +1181,6 @@ emacs_blocked_free (ptr, ptr2) void *ptr; const void *ptr2; { - EMACS_INT bytes_used_now; - BLOCK_INPUT_ALLOC; #ifdef GC_MALLOC_CHECK @@ -4266,9 +4264,14 @@ mark_maybe_pointer (p) { struct mem_node *m; - /* Quickly rule out some values which can't point to Lisp data. We - assume that Lisp data is aligned on even addresses. */ - if ((EMACS_INT) p & 1) + /* Quickly rule out some values which can't point to Lisp data. */ + if ((EMACS_INT) p % +#ifdef USE_LSB_TAG + 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */ +#else + 2 /* We assume that Lisp data is aligned on even addresses. */ +#endif + ) return; m = mem_find (p); diff --git a/src/buffer.c b/src/buffer.c index dee7b04190a..c74a6cbc2a5 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5682,8 +5682,8 @@ Backing up is done before the first time the file is saved. */); DEFVAR_PER_BUFFER ("selective-display", ¤t_buffer->selective_display, Qnil, doc: /* Non-nil enables selective display. -An Integer N as value means display only lines -that start with less than n columns of space. +An integer N as value means display only lines +that start with less than N columns of space. A value of t means that the character ^M makes itself and all the rest of the line invisible; also, when saving the buffer in a file, save the ^M as a newline. */); diff --git a/src/callint.c b/src/callint.c index 85ee6722710..e404f2ac71a 100644 --- a/src/callint.c +++ b/src/callint.c @@ -473,16 +473,19 @@ invoke it. If KEYS is omitted or nil, the return value of /* Count the number of arguments the interactive spec would have us give to the function. */ tem = string; - for (j = 0; *tem; j++) + for (j = 0; *tem;) { /* 'r' specifications ("point and mark as 2 numeric args") produce *two* arguments. */ - if (*tem == 'r') j++; + if (*tem == 'r') + j += 2; + else + j++; tem = (unsigned char *) index (tem, '\n'); if (tem) - tem++; + ++tem; else - tem = (unsigned char *) ""; + break; } count = j; diff --git a/src/casetab.c b/src/casetab.c index 42c268dd7c6..cc0e814c171 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -126,7 +126,7 @@ set_case_table (table, standard) int standard; { Lisp_Object up, canon, eqv; - Lisp_Object indices[3]; + int indices[3]; check_case_table (table); diff --git a/src/coding.c b/src/coding.c index 8dc20ef6a3a..2b7a7422d5c 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7472,6 +7472,8 @@ They may specify a coding system, a cons of coding systems, or a function symbol to call. In the last case, we call the function with one argument, which is a list of all the arguments given to this function. +If the function can't decide a coding system, it can return +`undecided' so that the normal code-detection is performed. If OPERATION is `insert-file-contents', the argument corresponding to TARGET may be a cons (FILENAME . BUFFER). In that case, FILENAME is a @@ -7973,7 +7975,9 @@ and the cdr part is used for encoding. If VAL is a function symbol, the function must return a coding system or a cons of coding systems which are used as above. The function is called with an argument that is a list of the arguments with which -`find-operation-coding-system' was called. +`find-operation-coding-system' was called. If the function can't decide +a coding system, it can return `undecided' so that the normal +code-detection is performed. See also the function `find-operation-coding-system' and the variable `auto-coding-alist'. */); diff --git a/src/config.in b/src/config.in index 2b7b5503dcb..742c0f44673 100644 --- a/src/config.in +++ b/src/config.in @@ -228,7 +228,7 @@ Boston, MA 02110-1301, USA. */ /* Define to 1 if you have the `get_current_dir_name' function. */ #undef HAVE_GET_CURRENT_DIR_NAME -/* Define to 1 if you have a gif library (default -lungif; otherwise specify +/* Define to 1 if you have a gif library (default -lgif; otherwise specify with LIBGIF). */ #undef HAVE_GIF @@ -769,7 +769,7 @@ Boston, MA 02110-1301, USA. */ Solaris, for example). */ #undef LD_SWITCH_X_SITE_AUX -/* Compiler option to link with the gif library (if not -lungif). */ +/* Compiler option to link with the gif library (if not -lgif). */ #undef LIBGIF /* Define to 1 if localtime caches TZ. */ diff --git a/src/doc.c b/src/doc.c index 39fa6229183..c0d4961606b 100644 --- a/src/doc.c +++ b/src/doc.c @@ -883,7 +883,7 @@ a new string, without any text properties, is returned. */) struct buffer *oldbuf; int start_idx; /* This is for computing the SHADOWS arg for describe_map_tree. */ - Lisp_Object active_maps = Fcurrent_active_maps (Qnil); + Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil); Lisp_Object earlier_maps; changed = 1; diff --git a/src/editfns.c b/src/editfns.c index 5fd40ed51c7..f88d0a6b54c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4112,9 +4112,9 @@ Transposing beyond buffer boundaries is an error. */) (startr1, endr1, startr2, endr2, leave_markers) Lisp_Object startr1, endr1, startr2, endr2, leave_markers; { - register int start1, end1, start2, end2; - int start1_byte, start2_byte, len1_byte, len2_byte; - int gap, len1, len_mid, len2; + register EMACS_INT start1, end1, start2, end2; + EMACS_INT start1_byte, start2_byte, len1_byte, len2_byte; + EMACS_INT gap, len1, len_mid, len2; unsigned char *start1_addr, *start2_addr, *temp; INTERVAL cur_intv, tmp_interval1, tmp_interval_mid, tmp_interval2, tmp_interval3; diff --git a/src/eval.c b/src/eval.c index b1bd3daef7a..6de9a5acc99 100644 --- a/src/eval.c +++ b/src/eval.c @@ -97,6 +97,7 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Qdeclare; +Lisp_Object Qdebug; /* This holds either the symbol `run-hooks' or nil. It is nil at an early stage of startup, and when Emacs @@ -220,7 +221,7 @@ init_eval_once () specpdl_ptr = specpdl; /* Don't forget to update docs (lispref node "Local Variables"). */ max_specpdl_size = 1000; - max_lisp_eval_depth = 300; + max_lisp_eval_depth = 400; Vrun_hooks = Qnil; } @@ -433,7 +434,7 @@ usage: (cond CLAUSES...) */) DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0, doc: /* Eval BODY forms sequentially and return value of last one. -usage: (progn BODY ...) */) +usage: (progn BODY...) */) (args) Lisp_Object args; { @@ -1595,8 +1596,7 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun) static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object, - Lisp_Object *)); + Lisp_Object, Lisp_Object)); DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. @@ -1622,7 +1622,6 @@ See also the function `condition-case'. */) Lisp_Object conditions; extern int gc_in_progress; extern int waiting_for_input; - Lisp_Object debugger_value; Lisp_Object string; Lisp_Object real_error_symbol; struct backtrace *bp; @@ -1680,7 +1679,7 @@ See also the function `condition-case'. */) register Lisp_Object clause; clause = find_handler_clause (handlerlist->handler, conditions, - error_symbol, data, &debugger_value); + error_symbol, data); if (EQ (clause, Qlambda)) { @@ -1711,7 +1710,7 @@ See also the function `condition-case'. */) handlerlist = allhandlers; /* If no handler is present now, try to run the debugger, and if that fails, throw to top level. */ - find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value); + find_handler_clause (Qerror, conditions, error_symbol, data); if (catchlist != 0) Fthrow (Qtop_level, Qt); @@ -1863,75 +1862,54 @@ skip_debugger (conditions, data) = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). This is for memory-full errors only. - Store value returned from debugger into *DEBUGGER_VALUE_PTR. - We need to increase max_specpdl_size temporarily around anything we do that can push on the specpdl, so as not to get a second error here in case we're handling specpdl overflow. */ static Lisp_Object -find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) +find_handler_clause (handlers, conditions, sig, data) Lisp_Object handlers, conditions, sig, data; - Lisp_Object *debugger_value_ptr; { register Lisp_Object h; register Lisp_Object tem; + int debugger_called = 0; + int debugger_considered = 0; - if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */ + /* t is used by handlers for all conditions, set up by C code. */ + if (EQ (handlers, Qt)) return Qt; + + /* Don't run the debugger for a memory-full error. + (There is no room in memory to do that!) */ + if (NILP (sig)) + debugger_considered = 1; + /* error is used similarly, but means print an error message and run the debugger if that is enabled. */ if (EQ (handlers, Qerror) || !NILP (Vdebug_on_signal)) /* This says call debugger even if there is a handler. */ { - int debugger_called = 0; - Lisp_Object sig_symbol, combined_data; - /* This is set to 1 if we are handling a memory-full error, - because these must not run the debugger. - (There is no room in memory to do that!) */ - int no_debugger = 0; - - if (NILP (sig)) - { - combined_data = data; - sig_symbol = Fcar (data); - no_debugger = 1; - } - else - { - combined_data = Fcons (sig, data); - sig_symbol = sig; - } - - if (wants_debugger (Vstack_trace_on_error, conditions)) + if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions)) { max_specpdl_size++; -#ifdef PROTOTYPES + #ifdef PROTOTYPES internal_with_output_to_temp_buffer ("*Backtrace*", (Lisp_Object (*) (Lisp_Object)) Fbacktrace, Qnil); -#else + #else internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil); -#endif + #endif max_specpdl_size--; } - if (! no_debugger - /* Don't try to run the debugger with interrupts blocked. - The editing loop would return anyway. */ - && ! INPUT_BLOCKED_P - && (EQ (sig_symbol, Qquit) - ? debug_on_quit - : wants_debugger (Vdebug_on_error, conditions)) - && ! skip_debugger (conditions, combined_data) - && when_entered_debugger < num_nonmacro_input_events) + + if (!debugger_considered) { - *debugger_value_ptr - = call_debugger (Fcons (Qerror, - Fcons (combined_data, Qnil))); - debugger_called = 1; + debugger_considered = 1; + debugger_called = maybe_call_debugger (conditions, sig, data); } + /* If there is no handler, return saying whether we ran the debugger. */ if (EQ (handlers, Qerror)) { @@ -1940,6 +1918,7 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) return Qt; } } + for (h = handlers; CONSP (h); h = Fcdr (h)) { Lisp_Object handler, condit; @@ -1958,18 +1937,55 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) /* Handle a list of condition names in handler HANDLER. */ else if (CONSP (condit)) { - while (CONSP (condit)) + Lisp_Object tail; + for (tail = condit; CONSP (tail); tail = XCDR (tail)) { - tem = Fmemq (Fcar (condit), conditions); + tem = Fmemq (Fcar (tail), conditions); if (!NILP (tem)) - return handler; - condit = XCDR (condit); + { + /* This handler is going to apply. + Does it allow the debugger to run first? */ + if (! debugger_considered && !NILP (Fmemq (Qdebug, condit))) + maybe_call_debugger (conditions, sig, data); + return handler; + } } } } + return Qnil; } +/* Call the debugger if calling it is currently enabled for CONDITIONS. + SIG and DATA describe the signal, as in find_handler_clause. */ + +int +maybe_call_debugger (conditions, sig, data) + Lisp_Object conditions, sig, data; +{ + Lisp_Object combined_data; + + combined_data = Fcons (sig, data); + + if ( + /* Don't try to run the debugger with interrupts blocked. + The editing loop would return anyway. */ + ! INPUT_BLOCKED_P + /* Does user wants to enter debugger for this kind of error? */ + && (EQ (sig, Qquit) + ? debug_on_quit + : wants_debugger (Vdebug_on_error, conditions)) + && ! skip_debugger (conditions, combined_data) + /* rms: what's this for? */ + && when_entered_debugger < num_nonmacro_input_events) + { + call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); + return 1; + } + + return 0; +} + /* dump an error message; called like printf */ /* VARARGS 1 */ @@ -3610,6 +3626,9 @@ before making `inhibit-quit' nil. */); Qand_optional = intern ("&optional"); staticpro (&Qand_optional); + Qdebug = intern ("debug"); + staticpro (&Qdebug); + DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, doc: /* *Non-nil means errors display a backtrace buffer. More precisely, this happens for any error that is handled diff --git a/src/fileio.c b/src/fileio.c index cdbd35748f1..78ab412ddf4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6685,8 +6685,9 @@ or local variable spec of the tailing lines with `coding:' tag. */); DEFVAR_LISP ("after-insert-file-functions", &Vafter_insert_file_functions, doc: /* A list of functions to be called at the end of `insert-file-contents'. -Each is passed one argument, the number of characters inserted. -It should return the new character count, and leave point the same. +Each is passed one argument, the number of characters inserted, +with point at the start of the inserted text. Each function +should leave point the same, and return the new character count. If `insert-file-contents' is intercepted by a handler from `file-name-handler-alist', that handler is responsible for calling the functions in `after-insert-file-functions' if appropriate. */); diff --git a/src/fns.c b/src/fns.c index c25e62951dd..34ef497312e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2825,8 +2825,8 @@ DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table, void map_char_table (c_function, function, table, subtable, arg, depth, indices) void (*c_function) P_ ((Lisp_Object, Lisp_Object, Lisp_Object)); - Lisp_Object function, table, subtable, arg, *indices; - int depth; + Lisp_Object function, table, subtable, arg; + int depth, *indices; { int i, to; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; @@ -2860,7 +2860,7 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) } else { - int charset = XFASTINT (indices[0]) - 128; + int charset = indices[0] - 128; i = 32; to = SUB_CHAR_TABLE_ORDINARY_SLOTS; @@ -2874,8 +2874,8 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) int charset; elt = XCHAR_TABLE (subtable)->contents[i]; - XSETFASTINT (indices[depth], i); - charset = XFASTINT (indices[0]) - 128; + indices[depth] = i; + charset = indices[0] - 128; if (depth == 0 && (!CHARSET_DEFINED_P (charset) || charset == CHARSET_8_BIT_CONTROL @@ -2892,8 +2892,8 @@ map_char_table (c_function, function, table, subtable, arg, depth, indices) { int c1, c2, c; - c1 = depth >= 1 ? XFASTINT (indices[1]) : 0; - c2 = depth >= 2 ? XFASTINT (indices[2]) : 0; + c1 = depth >= 1 ? indices[1] : 0; + c2 = depth >= 2 ? indices[2] : 0; c = MAKE_CHAR (charset, c1, c2); if (NILP (elt)) @@ -2927,14 +2927,14 @@ The key is always a possible IDX argument to `aref'. */) Lisp_Object function, char_table; { /* The depth of char table is at most 3. */ - Lisp_Object indices[3]; + int indices[3]; CHECK_CHAR_TABLE (char_table); /* When Lisp_Object is represented as a union, `call2' cannot directly be passed to map_char_table because it returns a Lisp_Object rather than returning nothing. - Casting leads to crashes on some architectures. -stef */ + Casting leads to crashes on some architectures. --Stef */ map_char_table (void_call2, Qnil, char_table, char_table, function, 0, indices); return Qnil; } @@ -4271,7 +4271,7 @@ base64_decode_1 (from, to, length, multibyte, nchars_return) /* The list of all weak hash tables. Don't staticpro this one. */ -Lisp_Object Vweak_hash_tables; +struct Lisp_Hash_Table *weak_hash_tables; /* Various symbols. */ @@ -4617,11 +4617,11 @@ make_hash_table (test, size, rehash_size, rehash_threshold, weak, /* Maybe add this hash table to the list of all weak hash tables. */ if (NILP (h->weak)) - h->next_weak = Qnil; + h->next_weak = NULL; else { - h->next_weak = Vweak_hash_tables; - Vweak_hash_tables = table; + h->next_weak = weak_hash_tables; + weak_hash_tables = h; } return table; @@ -4652,8 +4652,8 @@ copy_hash_table (h1) /* Maybe add this hash table to the list of all weak hash tables. */ if (!NILP (h2->weak)) { - h2->next_weak = Vweak_hash_tables; - Vweak_hash_tables = table; + h2->next_weak = weak_hash_tables; + weak_hash_tables = h2; } return table; @@ -4972,13 +4972,12 @@ sweep_weak_table (h, remove_entries_p) /* Remove elements from weak hash tables that don't survive the current garbage collection. Remove weak tables that don't survive - from Vweak_hash_tables. Called from gc_sweep. */ + from weak_hash_tables. Called from gc_sweep. */ void sweep_weak_hash_tables () { - Lisp_Object table, used, next; - struct Lisp_Hash_Table *h; + struct Lisp_Hash_Table *h, *used, *next; int marked; /* Mark all keys and values that are in use. Keep on marking until @@ -4990,9 +4989,8 @@ sweep_weak_hash_tables () do { marked = 0; - for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak) + for (h = weak_hash_tables; h; h = h->next_weak) { - h = XHASH_TABLE (table); if (h->size & ARRAY_MARK_FLAG) marked |= sweep_weak_table (h, 0); } @@ -5000,9 +4998,8 @@ sweep_weak_hash_tables () while (marked); /* Remove tables and entries that aren't used. */ - for (table = Vweak_hash_tables, used = Qnil; !GC_NILP (table); table = next) + for (h = weak_hash_tables, used = NULL; h; h = next) { - h = XHASH_TABLE (table); next = h->next_weak; if (h->size & ARRAY_MARK_FLAG) @@ -5013,11 +5010,11 @@ sweep_weak_hash_tables () /* Add table to the list of used weak hash tables. */ h->next_weak = used; - used = table; + used = h; } } - Vweak_hash_tables = used; + weak_hash_tables = used; } @@ -5918,7 +5915,7 @@ used if both `use-dialog-box' and this variable are non-nil. */); void init_fns () { - Vweak_hash_tables = Qnil; + weak_hash_tables = NULL; } /* arch-tag: 787f8219-5b74-46bd-8469-7e1cc475fa31 diff --git a/src/fontset.c b/src/fontset.c index 7d227d8f43f..855d2322412 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1438,7 +1438,7 @@ If FRAME is omitted, it defaults to the currently selected frame. */) { Lisp_Object fontset; FRAME_PTR f; - Lisp_Object indices[3]; + int indices[3]; Lisp_Object val, tail, elt; Lisp_Object *realized; struct font_info *fontp = NULL; diff --git a/src/gmalloc.c b/src/gmalloc.c index 50535d4940c..fcd9f655321 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -1,9 +1,6 @@ /* This file is no longer automatically generated from libc. */ #define _MALLOC_INTERNAL -#ifdef HAVE_GTK_AND_PTHREAD -#define USE_PTHREAD -#endif /* The malloc headers and source files from the C library follow here. */ @@ -40,6 +37,10 @@ Fifth Floor, Boston, MA 02110-1301, USA. #include <config.h> #endif +#ifdef HAVE_GTK_AND_PTHREAD +#define USE_PTHREAD +#endif + #if ((defined __cplusplus || (defined (__STDC__) && __STDC__) \ || defined STDC_HEADERS || defined PROTOTYPES) \ && ! defined (BROKEN_PROTOTYPES)) @@ -235,14 +236,21 @@ extern __malloc_size_t _bytes_free; extern __ptr_t _malloc_internal PP ((__malloc_size_t __size)); extern __ptr_t _realloc_internal PP ((__ptr_t __ptr, __malloc_size_t __size)); extern void _free_internal PP ((__ptr_t __ptr)); +extern __ptr_t _malloc_internal_nolock PP ((__malloc_size_t __size)); +extern __ptr_t _realloc_internal_nolock PP ((__ptr_t __ptr, __malloc_size_t __size)); +extern void _free_internal_nolock PP ((__ptr_t __ptr)); #ifdef USE_PTHREAD -extern pthread_mutex_t _malloc_mutex; +extern pthread_mutex_t _malloc_mutex, _aligned_blocks_mutex; #define LOCK() pthread_mutex_lock (&_malloc_mutex) #define UNLOCK() pthread_mutex_unlock (&_malloc_mutex) +#define LOCK_ALIGNED_BLOCKS() pthread_mutex_lock (&_aligned_blocks_mutex) +#define UNLOCK_ALIGNED_BLOCKS() pthread_mutex_unlock (&_aligned_blocks_mutex) #else #define LOCK() #define UNLOCK() +#define LOCK_ALIGNED_BLOCKS() +#define UNLOCK_ALIGNED_BLOCKS() #endif #endif /* _MALLOC_INTERNAL. */ @@ -373,7 +381,7 @@ Fifth Floor, Boston, MA 02110-1301, USA. extern __ptr_t bss_sbrk PP ((ptrdiff_t __size)); extern int bss_sbrk_did_unexec; #endif -__ptr_t (*__morecore) PP ((ptrdiff_t __size)) = __default_morecore; +__ptr_t (*__morecore) PP ((__malloc_ptrdiff_t __size)) = __default_morecore; /* Debugging hook for `malloc'. */ __ptr_t (*__malloc_hook) PP ((__malloc_size_t __size)); @@ -554,7 +562,8 @@ register_heapinfo () #ifdef USE_PTHREAD static pthread_once_t malloc_init_once_control = PTHREAD_ONCE_INIT; -pthread_mutex_t _malloc_mutex; +pthread_mutex_t _malloc_mutex = PTHREAD_MUTEX_INITIALIZER; +pthread_mutex_t _aligned_blocks_mutex = PTHREAD_MUTEX_INITIALIZER; #endif static void @@ -567,7 +576,9 @@ malloc_initialize_1 () if (__malloc_initialize_hook) (*__malloc_initialize_hook) (); -#ifdef USE_PTHREAD + /* We don't use recursive mutex because pthread_mutexattr_init may + call malloc internally. */ +#if 0 /* defined (USE_PTHREAD) */ { pthread_mutexattr_t attr; @@ -616,9 +627,9 @@ static int morecore_recursing; /* Get neatly aligned memory, initializing or growing the heap info table as necessary. */ -static __ptr_t morecore PP ((__malloc_size_t)); +static __ptr_t morecore_nolock PP ((__malloc_size_t)); static __ptr_t -morecore (size) +morecore_nolock (size) __malloc_size_t size; { __ptr_t result; @@ -661,7 +672,7 @@ morecore (size) `morecore_recursing' flag and return null. */ int save = errno; /* Don't want to clobber errno with ENOMEM. */ morecore_recursing = 1; - newinfo = (malloc_info *) _realloc_internal + newinfo = (malloc_info *) _realloc_internal_nolock (_heapinfo, newsize * sizeof (malloc_info)); morecore_recursing = 0; if (newinfo == NULL) @@ -717,7 +728,7 @@ morecore (size) /* Reset _heaplimit so _free_internal never decides it can relocate or resize the info table. */ _heaplimit = 0; - _free_internal (oldinfo); + _free_internal_nolock (oldinfo); PROTECT_MALLOC_STATE (0); /* The new heap limit includes the new table just allocated. */ @@ -732,7 +743,7 @@ morecore (size) /* Allocate memory from the heap. */ __ptr_t -_malloc_internal (size) +_malloc_internal_nolock (size) __malloc_size_t size; { __ptr_t result; @@ -752,7 +763,6 @@ _malloc_internal (size) return NULL; #endif - LOCK (); PROTECT_MALLOC_STATE (0); if (size < sizeof (struct list)) @@ -802,8 +812,10 @@ _malloc_internal (size) /* No free fragments of the desired size, so get a new block and break it into fragments, returning the first. */ #ifdef GC_MALLOC_CHECK - result = _malloc_internal (BLOCKSIZE); + result = _malloc_internal_nolock (BLOCKSIZE); PROTECT_MALLOC_STATE (0); +#elif defined (USE_PTHREAD) + result = _malloc_internal_nolock (BLOCKSIZE); #else result = malloc (BLOCKSIZE); #endif @@ -874,7 +886,7 @@ _malloc_internal (size) _heaplimit += wantblocks - lastblocks; continue; } - result = morecore (wantblocks * BLOCKSIZE); + result = morecore_nolock (wantblocks * BLOCKSIZE); if (result == NULL) goto out; block = BLOCK (result); @@ -932,7 +944,19 @@ _malloc_internal (size) PROTECT_MALLOC_STATE (1); out: + return result; +} + +__ptr_t +_malloc_internal (size) + __malloc_size_t size; +{ + __ptr_t result; + + LOCK (); + result = _malloc_internal_nolock (size); UNLOCK (); + return result; } @@ -940,10 +964,21 @@ __ptr_t malloc (size) __malloc_size_t size; { + __ptr_t (*hook) (__malloc_size_t); + if (!__malloc_initialized && !__malloc_initialize ()) return NULL; - return (__malloc_hook != NULL ? *__malloc_hook : _malloc_internal) (size); + /* Copy the value of __malloc_hook to an automatic variable in case + __malloc_hook is modified in another thread between its + NULL-check and the use. + + Note: Strictly speaking, this is not a right solution. We should + use mutexes to access non-read-only variables that are shared + among multiple threads. We just leave it for compatibility with + glibc malloc (i.e., assignments to __malloc_hook) for now. */ + hook = __malloc_hook; + return (hook != NULL ? *hook : _malloc_internal) (size); } #ifndef _LIBC @@ -1024,9 +1059,9 @@ void (*__free_hook) PP ((__ptr_t __ptr)); struct alignlist *_aligned_blocks = NULL; /* Return memory to the heap. - Like `free' but don't call a __free_hook if there is one. */ + Like `_free_internal' but don't lock mutex. */ void -_free_internal (ptr) +_free_internal_nolock (ptr) __ptr_t ptr; { int type; @@ -1043,9 +1078,9 @@ _free_internal (ptr) if (ptr == NULL) return; - LOCK (); PROTECT_MALLOC_STATE (0); + LOCK_ALIGNED_BLOCKS (); for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == ptr) { @@ -1053,6 +1088,7 @@ _free_internal (ptr) ptr = l->exact; break; } + UNLOCK_ALIGNED_BLOCKS (); block = BLOCK (ptr); @@ -1158,7 +1194,7 @@ _free_internal (ptr) table's blocks to the system before we have copied them to the new location. */ _heaplimit = 0; - _free_internal (_heapinfo); + _free_internal_nolock (_heapinfo); _heaplimit = oldlimit; /* Tell malloc to search from the beginning of the heap for @@ -1166,8 +1202,8 @@ _free_internal (ptr) _heapindex = 0; /* Allocate new space for the info table and move its data. */ - newinfo = (malloc_info *) _malloc_internal (info_blocks - * BLOCKSIZE); + newinfo = (malloc_info *) _malloc_internal_nolock (info_blocks + * BLOCKSIZE); PROTECT_MALLOC_STATE (0); memmove (newinfo, _heapinfo, info_blocks * BLOCKSIZE); _heapinfo = newinfo; @@ -1230,8 +1266,8 @@ _free_internal (ptr) _chunks_free -= BLOCKSIZE >> type; _bytes_free -= BLOCKSIZE; -#ifdef GC_MALLOC_CHECK - _free_internal (ADDRESS (block)); +#if defined (GC_MALLOC_CHECK) || defined (USE_PTHREAD) + _free_internal_nolock (ADDRESS (block)); #else free (ADDRESS (block)); #endif @@ -1269,6 +1305,16 @@ _free_internal (ptr) } PROTECT_MALLOC_STATE (1); +} + +/* Return memory to the heap. + Like `free' but don't call a __free_hook if there is one. */ +void +_free_internal (ptr) + __ptr_t ptr; +{ + LOCK (); + _free_internal_nolock (ptr); UNLOCK (); } @@ -1278,8 +1324,10 @@ FREE_RETURN_TYPE free (ptr) __ptr_t ptr; { - if (__free_hook != NULL) - (*__free_hook) (ptr); + void (*hook) (__ptr_t) = __free_hook; + + if (hook != NULL) + (*hook) (ptr); else _free_internal (ptr); } @@ -1415,7 +1463,7 @@ __ptr_t (*__realloc_hook) PP ((__ptr_t __ptr, __malloc_size_t __size)); new region. This module has incestuous knowledge of the internals of both free and malloc. */ __ptr_t -_realloc_internal (ptr, size) +_realloc_internal_nolock (ptr, size) __ptr_t ptr; __malloc_size_t size; { @@ -1425,15 +1473,14 @@ _realloc_internal (ptr, size) if (size == 0) { - _free_internal (ptr); - return _malloc_internal (0); + _free_internal_nolock (ptr); + return _malloc_internal_nolock (0); } else if (ptr == NULL) - return _malloc_internal (size); + return _malloc_internal_nolock (size); block = BLOCK (ptr); - LOCK (); PROTECT_MALLOC_STATE (0); type = _heapinfo[block].busy.type; @@ -1443,11 +1490,11 @@ _realloc_internal (ptr, size) /* Maybe reallocate a large block to a small fragment. */ if (size <= BLOCKSIZE / 2) { - result = _malloc_internal (size); + result = _malloc_internal_nolock (size); if (result != NULL) { memcpy (result, ptr, size); - _free_internal (ptr); + _free_internal_nolock (ptr); goto out; } } @@ -1467,7 +1514,7 @@ _realloc_internal (ptr, size) Now we will free this chunk; increment the statistics counter so it doesn't become wrong when _free_internal decrements it. */ ++_chunks_used; - _free_internal (ADDRESS (block + blocks)); + _free_internal_nolock (ADDRESS (block + blocks)); result = ptr; } else if (blocks == _heapinfo[block].busy.info.size) @@ -1482,8 +1529,8 @@ _realloc_internal (ptr, size) /* Prevent free from actually returning memory to the system. */ oldlimit = _heaplimit; _heaplimit = 0; - _free_internal (ptr); - result = _malloc_internal (size); + _free_internal_nolock (ptr); + result = _malloc_internal_nolock (size); PROTECT_MALLOC_STATE (0); if (_heaplimit == 0) _heaplimit = oldlimit; @@ -1493,13 +1540,13 @@ _realloc_internal (ptr, size) the thing we just freed. Unfortunately it might have been coalesced with its neighbors. */ if (_heapindex == block) - (void) _malloc_internal (blocks * BLOCKSIZE); + (void) _malloc_internal_nolock (blocks * BLOCKSIZE); else { __ptr_t previous - = _malloc_internal ((block - _heapindex) * BLOCKSIZE); - (void) _malloc_internal (blocks * BLOCKSIZE); - _free_internal (previous); + = _malloc_internal_nolock ((block - _heapindex) * BLOCKSIZE); + (void) _malloc_internal_nolock (blocks * BLOCKSIZE); + _free_internal_nolock (previous); } goto out; } @@ -1519,18 +1566,31 @@ _realloc_internal (ptr, size) { /* The new size is different; allocate a new space, and copy the lesser of the new size and the old. */ - result = _malloc_internal (size); + result = _malloc_internal_nolock (size); if (result == NULL) goto out; memcpy (result, ptr, min (size, (__malloc_size_t) 1 << type)); - _free_internal (ptr); + _free_internal_nolock (ptr); } break; } PROTECT_MALLOC_STATE (1); out: + return result; +} + +__ptr_t +_realloc_internal (ptr, size) + __ptr_t ptr; + __malloc_size_t size; +{ + __ptr_t result; + + LOCK(); + result = _realloc_internal_nolock (ptr, size); UNLOCK (); + return result; } @@ -1539,11 +1599,13 @@ realloc (ptr, size) __ptr_t ptr; __malloc_size_t size; { + __ptr_t (*hook) (__ptr_t, __malloc_size_t); + if (!__malloc_initialized && !__malloc_initialize ()) return NULL; - return (__realloc_hook != NULL ? *__realloc_hook : _realloc_internal) - (ptr, size); + hook = __realloc_hook; + return (hook != NULL ? *hook : _realloc_internal) (ptr, size); } /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. @@ -1681,9 +1743,10 @@ memalign (alignment, size) { __ptr_t result; unsigned long int adj, lastadj; + __ptr_t (*hook) (__malloc_size_t, __malloc_size_t) = __memalign_hook; - if (__memalign_hook) - return (*__memalign_hook) (alignment, size); + if (hook) + return (*hook) (alignment, size); /* Allocate a block with enough extra space to pad the block with up to (ALIGNMENT - 1) bytes if necessary. */ @@ -1718,6 +1781,7 @@ memalign (alignment, size) of an allocated block. */ struct alignlist *l; + LOCK_ALIGNED_BLOCKS (); for (l = _aligned_blocks; l != NULL; l = l->next) if (l->aligned == NULL) /* This slot is free. Use it. */ @@ -1725,16 +1789,23 @@ memalign (alignment, size) if (l == NULL) { l = (struct alignlist *) malloc (sizeof (struct alignlist)); - if (l == NULL) + if (l != NULL) { - free (result); - return NULL; + l->next = _aligned_blocks; + _aligned_blocks = l; } - l->next = _aligned_blocks; - _aligned_blocks = l; } - l->exact = result; - result = l->aligned = (char *) result + alignment - adj; + if (l != NULL) + { + l->exact = result; + result = l->aligned = (char *) result + alignment - adj; + } + UNLOCK_ALIGNED_BLOCKS (); + if (l == NULL) + { + free (result); + result = NULL; + } } return result; diff --git a/src/image.c b/src/image.c index 322689c8d0f..f22c5014404 100644 --- a/src/image.c +++ b/src/image.c @@ -3123,8 +3123,8 @@ static void convert_mono_to_color_image (f, img, foreground, background) release_frame_dc (f, hdc); old_prev = SelectObject (old_img_dc, img->pixmap); new_prev = SelectObject (new_img_dc, new_pixmap); - SetTextColor (new_img_dc, foreground); - SetBkColor (new_img_dc, background); + SetTextColor (new_img_dc, background); + SetBkColor (new_img_dc, foreground); BitBlt (new_img_dc, 0, 0, img->width, img->height, old_img_dc, 0, 0, SRCCOPY); diff --git a/src/keyboard.c b/src/keyboard.c index 9786449a003..1fc666aa2ff 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1498,7 +1498,7 @@ DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0, Within a `track-mouse' form, mouse motion generates input events that you can read with `read-event'. Normally, mouse motion is ignored. -usage: (track-mouse BODY ...) */) +usage: (track-mouse BODY...) */) (args) Lisp_Object args; { diff --git a/src/keymap.c b/src/keymap.c index 904e3c89d55..869fd7a24a6 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -422,7 +422,7 @@ Return PARENT. PARENT should be nil or another keymap. */) if (CHAR_TABLE_P (XCAR (list))) { - Lisp_Object indices[3]; + int indices[3]; map_char_table (fix_submap_inheritance, Qnil, XCAR (list), XCAR (list), @@ -721,7 +721,7 @@ map_keymap (map, fun, args, data, autoload) } else if (CHAR_TABLE_P (binding)) { - Lisp_Object indices[3]; + int indices[3]; map_char_table (map_keymap_char_table_item, Qnil, binding, binding, Fcons (make_save_value (fun, 0), Fcons (make_save_value (data, 0), @@ -1072,7 +1072,7 @@ is not copied. */) Lisp_Object elt = XCAR (keymap); if (CHAR_TABLE_P (elt)) { - Lisp_Object indices[3]; + int indices[3]; elt = Fcopy_sequence (elt); map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices); } @@ -1149,7 +1149,7 @@ binding KEY to DEF is added at the front of KEYMAP. */) if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt)) Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands); - meta_bit = (VECTORP (key) || STRINGP (key) && STRING_MULTIBYTE (key) + meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key)) ? meta_modifier : 0x80); if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0))) @@ -1534,14 +1534,47 @@ current_minor_maps (modeptr, mapptr) } DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps, - 0, 1, 0, + 0, 2, 0, doc: /* Return a list of the currently active keymaps. OLP if non-nil indicates that we should obey `overriding-local-map' and -`overriding-terminal-local-map'. */) - (olp) - Lisp_Object olp; +`overriding-terminal-local-map'. POSITION can specify a click position +like in the respective argument of `key-binding'. */) + (olp, position) + Lisp_Object olp, position; { - Lisp_Object keymaps = Fcons (current_global_map, Qnil); + int count = SPECPDL_INDEX (); + + Lisp_Object keymaps; + + /* If a mouse click position is given, our variables are based on + the buffer clicked on, not the current buffer. So we may have to + switch the buffer here. */ + + if (CONSP (position)) + { + Lisp_Object window; + + window = POSN_WINDOW (position); + + if (WINDOWP (window) + && BUFFERP (XWINDOW (window)->buffer) + && XBUFFER (XWINDOW (window)->buffer) != current_buffer) + { + /* Arrange to go back to the original buffer once we're done + processing the key sequence. We don't use + save_excursion_{save,restore} here, in analogy to + `read-key-sequence' to avoid saving point. Maybe this + would not be a problem here, but it is easier to keep + things the same. + */ + + record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); + + set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); + } + } + + keymaps = Fcons (current_global_map, Qnil); if (!NILP (olp)) { @@ -1555,15 +1588,76 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and } if (NILP (XCDR (keymaps))) { - Lisp_Object local; Lisp_Object *maps; int nmaps, i; - /* This usually returns the buffer's local map, - but that can be overridden by a `local-map' property. */ - local = get_local_map (PT, current_buffer, Qlocal_map); - if (!NILP (local)) - keymaps = Fcons (local, keymaps); + Lisp_Object keymap, local_map; + EMACS_INT pt; + + pt = INTEGERP (position) ? XINT (position) + : MARKERP (position) ? marker_position (position) + : PT; + + /* Get the buffer local maps, possibly overriden by text or + overlay properties */ + + local_map = get_local_map (pt, current_buffer, Qlocal_map); + keymap = get_local_map (pt, current_buffer, Qkeymap); + + if (CONSP (position)) + { + Lisp_Object string; + + /* For a mouse click, get the local text-property keymap + of the place clicked on, rather than point. */ + + if (POSN_INBUFFER_P (position)) + { + Lisp_Object pos; + + pos = POSN_BUFFER_POSN (position); + if (INTEGERP (pos) + && XINT (pos) >= BEG && XINT (pos) <= Z) + { + local_map = get_local_map (XINT (pos), + current_buffer, Qlocal_map); + + keymap = get_local_map (XINT (pos), + current_buffer, Qkeymap); + } + } + + /* If on a mode line string with a local keymap, + or for a click on a string, i.e. overlay string or a + string displayed via the `display' property, + consider `local-map' and `keymap' properties of + that string. */ + + if (string = POSN_STRING (position), + (CONSP (string) && STRINGP (XCAR (string)))) + { + Lisp_Object pos, map; + + pos = XCDR (string); + string = XCAR (string); + if (INTEGERP (pos) + && XINT (pos) >= 0 + && XINT (pos) < SCHARS (string)) + { + map = Fget_text_property (pos, Qlocal_map, string); + if (!NILP (map)) + local_map = map; + + map = Fget_text_property (pos, Qkeymap, string); + if (!NILP (map)) + keymap = map; + } + } + + } + + if (!NILP (local_map)) + keymaps = Fcons (local_map, keymaps); /* Now put all the minor mode keymaps on the list. */ nmaps = current_minor_maps (0, &maps); @@ -1572,12 +1666,12 @@ OLP if non-nil indicates that we should obey `overriding-local-map' and if (!NILP (maps[i])) keymaps = Fcons (maps[i], keymaps); - /* This returns nil unless there is a `keymap' property. */ - local = get_local_map (PT, current_buffer, Qkeymap); - if (!NILP (local)) - keymaps = Fcons (local, keymaps); + if (!NILP (keymap)) + keymaps = Fcons (keymap, keymaps); } + unbind_to (count, Qnil); + return keymaps; } @@ -1945,12 +2039,23 @@ DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_ /* Help functions for describing and documenting keymaps. */ +struct accessible_keymaps_data { + Lisp_Object maps, tail, thisseq; + /* Does the current sequence end in the meta-prefix-char? */ + int is_metized; +}; static void -accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) - Lisp_Object maps, tail, thisseq, key, cmd; - int is_metized; /* If 1, `key' is assumed to be INTEGERP. */ +accessible_keymaps_1 (key, cmd, args, data) + Lisp_Object key, cmd, args; + /* Use void* to be compatible with map_keymap_function_t. */ + void *data; { + struct accessible_keymaps_data *d = data; /* Cast! */ + Lisp_Object maps = d->maps; + Lisp_Object tail = d->tail; + Lisp_Object thisseq = d->thisseq; + int is_metized = d->is_metized && INTEGERP (key); Lisp_Object tem; cmd = get_keymap (get_keyelt (cmd, 0), 0, 0); @@ -2004,17 +2109,6 @@ accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized) } } -static void -accessible_keymaps_char_table (args, index, cmd) - Lisp_Object args, index, cmd; -{ - accessible_keymaps_1 (index, cmd, - XCAR (XCAR (args)), - XCAR (XCDR (args)), - XCDR (XCDR (args)), - XINT (XCDR (XCAR (args)))); -} - /* This function cannot GC. */ DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps, @@ -2029,14 +2123,11 @@ then the value includes only maps for prefixes that start with PREFIX. */) Lisp_Object keymap, prefix; { Lisp_Object maps, tail; - int prefixlen = 0; + int prefixlen = XINT (Flength (prefix)); /* no need for gcpro because we don't autoload any keymaps. */ if (!NILP (prefix)) - prefixlen = XINT (Flength (prefix)); - - if (!NILP (prefix)) { /* If a prefix was specified, start with the keymap (if any) for that prefix, so we don't waste time considering other prefixes. */ @@ -2046,7 +2137,9 @@ then the value includes only maps for prefixes that start with PREFIX. */) if the prefix is not defined in this particular map. It might even give us a list that isn't a keymap. */ tem = get_keymap (tem, 0, 0); - if (CONSP (tem)) + /* If the keymap is autoloaded `tem' is not a cons-cell, but we still + want to return it. */ + if (!NILP (tem)) { /* Convert PREFIX to a vector now, so that later on we don't have to deal with the possibility of a string. */ @@ -2086,57 +2179,26 @@ then the value includes only maps for prefixes that start with PREFIX. */) for (tail = maps; CONSP (tail); tail = XCDR (tail)) { - register Lisp_Object thisseq, thismap; + struct accessible_keymaps_data data; + register Lisp_Object thismap = Fcdr (XCAR (tail)); Lisp_Object last; - /* Does the current sequence end in the meta-prefix-char? */ - int is_metized; - thisseq = Fcar (Fcar (tail)); - thismap = Fcdr (Fcar (tail)); - last = make_number (XINT (Flength (thisseq)) - 1); - is_metized = (XINT (last) >= 0 + data.thisseq = Fcar (XCAR (tail)); + data.maps = maps; + data.tail = tail; + last = make_number (XINT (Flength (data.thisseq)) - 1); + /* Does the current sequence end in the meta-prefix-char? */ + data.is_metized = (XINT (last) >= 0 /* Don't metize the last char of PREFIX. */ && XINT (last) >= prefixlen - && EQ (Faref (thisseq, last), meta_prefix_char)); - - for (; CONSP (thismap); thismap = XCDR (thismap)) - { - Lisp_Object elt; - - elt = XCAR (thismap); - - QUIT; - - if (CHAR_TABLE_P (elt)) - { - Lisp_Object indices[3]; - - map_char_table (accessible_keymaps_char_table, Qnil, elt, - elt, Fcons (Fcons (maps, make_number (is_metized)), - Fcons (tail, thisseq)), - 0, indices); - } - else if (VECTORP (elt)) - { - register int i; - - /* Vector keymap. Scan all the elements. */ - for (i = 0; i < ASIZE (elt); i++) - accessible_keymaps_1 (make_number (i), AREF (elt, i), - maps, tail, thisseq, is_metized); + && EQ (Faref (data.thisseq, last), meta_prefix_char)); - } - else if (CONSP (elt)) - accessible_keymaps_1 (XCAR (elt), XCDR (elt), - maps, tail, thisseq, - is_metized && INTEGERP (XCAR (elt))); - - } + /* Since we can't run lisp code, we can't scan autoloaded maps. */ + if (CONSP (thismap)) + map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0); } - return maps; } - Lisp_Object Qsingle_key_description, Qkey_description; /* This function cannot GC. */ @@ -2407,7 +2469,7 @@ around function keys and event symbols. */) { char buf[256]; - sprintf (buf, "Invalid char code %d", XINT (key)); + sprintf (buf, "Invalid char code %ld", XINT (key)); return build_string (buf); } else if (charset @@ -2550,8 +2612,8 @@ ascii_sequence_p (seq) /* where-is - finding a command in a set of keymaps. */ static Lisp_Object where_is_internal (); -static Lisp_Object where_is_internal_1 (); -static void where_is_internal_2 (); +static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding, + Lisp_Object args, void *data)); /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. Returns the first non-nil binding found in any of those maps. */ @@ -2580,6 +2642,12 @@ shadow_lookup (shadow, key, flag) static Lisp_Object Vmouse_events; +struct where_is_internal_data { + Lisp_Object definition, noindirect, this, last; + int last_is_meta; + Lisp_Object sequences; +}; + /* This function can GC if Flookup_key autoloads any keymaps. */ static Lisp_Object @@ -2617,6 +2685,7 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) { /* Key sequence to reach map, and the map that it reaches */ register Lisp_Object this, map, tem; + struct where_is_internal_data data; /* In order to fold [META-PREFIX-CHAR CHAR] sequences into [M-CHAR] sequences, check if last character of the sequence @@ -2641,148 +2710,94 @@ where_is_internal (definition, keymaps, firstonly, noindirect, no_remap) QUIT; - while (CONSP (map)) - { - /* Because the code we want to run on each binding is rather - large, we don't want to have two separate loop bodies for - sparse keymap bindings and tables; we want to iterate one - loop body over both keymap and vector bindings. + data.definition = definition; + data.noindirect = noindirect; + data.this = this; + data.last = last; + data.last_is_meta = last_is_meta; + data.sequences = Qnil; - For this reason, if Fcar (map) is a vector, we don't - advance map to the next element until i indicates that we - have finished off the vector. */ - Lisp_Object elt, key, binding; - elt = XCAR (map); - map = XCDR (map); + if (CONSP (map)) + map_keymap (map, where_is_internal_1, Qnil, &data, 0); - sequences = Qnil; + sequences = data.sequences; - QUIT; - - /* Set key and binding to the current key and binding, and - advance map and i to the next binding. */ - if (VECTORP (elt)) + while (CONSP (sequences)) + { + Lisp_Object sequence, remapped, function; + + sequence = XCAR (sequences); + sequences = XCDR (sequences); + + /* If the current sequence is a command remapping with + format [remap COMMAND], find the key sequences + which run COMMAND, and use those sequences instead. */ + remapped = Qnil; + if (NILP (no_remap) + && VECTORP (sequence) && XVECTOR (sequence)->size == 2 + && EQ (AREF (sequence, 0), Qremap) + && (function = AREF (sequence, 1), SYMBOLP (function))) { - Lisp_Object sequence; - int i; - /* In a vector, look at each element. */ - for (i = 0; i < XVECTOR (elt)->size; i++) + Lisp_Object remapped1; + + remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); + if (CONSP (remapped1)) { - binding = AREF (elt, i); - XSETFASTINT (key, i); - sequence = where_is_internal_1 (binding, key, definition, - noindirect, this, - last, nomenus, last_is_meta); - if (!NILP (sequence)) - sequences = Fcons (sequence, sequences); + /* Verify that this key binding actually maps to the + remapped command (see below). */ + if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) + continue; + sequence = XCAR (remapped1); + remapped = XCDR (remapped1); + goto record_sequence; } } - else if (CHAR_TABLE_P (elt)) - { - Lisp_Object indices[3]; - Lisp_Object args; - - args = Fcons (Fcons (Fcons (definition, noindirect), - Qnil), /* Result accumulator. */ - Fcons (Fcons (this, last), - Fcons (make_number (nomenus), - make_number (last_is_meta)))); - map_char_table (where_is_internal_2, Qnil, elt, elt, args, - 0, indices); - sequences = XCDR (XCAR (args)); - } - else if (CONSP (elt)) - { - Lisp_Object sequence; - key = XCAR (elt); - binding = XCDR (elt); + /* Verify that this key binding is not shadowed by another + binding for the same key, before we say it exists. - sequence = where_is_internal_1 (binding, key, definition, - noindirect, this, - last, nomenus, last_is_meta); - if (!NILP (sequence)) - sequences = Fcons (sequence, sequences); - } + Mechanism: look for local definition of this key and if + it is defined and does not match what we found then + ignore this key. + Either nil or number as value from Flookup_key + means undefined. */ + if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) + continue; - while (!NILP (sequences)) + record_sequence: + /* Don't annoy user with strings from a menu such as + Select Paste. Change them all to "(any string)", + so that there seems to be only one menu item + to report. */ + if (! NILP (sequence)) { - Lisp_Object sequence, remapped, function; - - sequence = XCAR (sequences); - sequences = XCDR (sequences); - - /* If the current sequence is a command remapping with - format [remap COMMAND], find the key sequences - which run COMMAND, and use those sequences instead. */ - remapped = Qnil; - if (NILP (no_remap) - && VECTORP (sequence) && XVECTOR (sequence)->size == 2 - && EQ (AREF (sequence, 0), Qremap) - && (function = AREF (sequence, 1), SYMBOLP (function))) - { - Lisp_Object remapped1; - - remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt); - if (CONSP (remapped1)) - { - /* Verify that this key binding actually maps to the - remapped command (see below). */ - if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function)) - continue; - sequence = XCAR (remapped1); - remapped = XCDR (remapped1); - goto record_sequence; - } - } - - /* Verify that this key binding is not shadowed by another - binding for the same key, before we say it exists. - - Mechanism: look for local definition of this key and if - it is defined and does not match what we found then - ignore this key. - - Either nil or number as value from Flookup_key - means undefined. */ - if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition)) - continue; - - record_sequence: - /* Don't annoy user with strings from a menu such as - Select Paste. Change them all to "(any string)", - so that there seems to be only one menu item - to report. */ - if (! NILP (sequence)) - { - Lisp_Object tem; - tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); - if (STRINGP (tem)) - Faset (sequence, make_number (XVECTOR (sequence)->size - 1), - build_string ("(any string)")); - } + Lisp_Object tem; + tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1)); + if (STRINGP (tem)) + Faset (sequence, make_number (XVECTOR (sequence)->size - 1), + build_string ("(any string)")); + } - /* It is a true unshadowed match. Record it, unless it's already - been seen (as could happen when inheriting keymaps). */ - if (NILP (Fmember (sequence, found))) - found = Fcons (sequence, found); - - /* If firstonly is Qnon_ascii, then we can return the first - binding we find. If firstonly is not Qnon_ascii but not - nil, then we should return the first ascii-only binding - we find. */ - if (EQ (firstonly, Qnon_ascii)) - RETURN_UNGCPRO (sequence); - else if (!NILP (firstonly) && ascii_sequence_p (sequence)) - RETURN_UNGCPRO (sequence); - - if (CONSP (remapped)) - { - sequence = XCAR (remapped); - remapped = XCDR (remapped); - goto record_sequence; - } + /* It is a true unshadowed match. Record it, unless it's already + been seen (as could happen when inheriting keymaps). */ + if (NILP (Fmember (sequence, found))) + found = Fcons (sequence, found); + + /* If firstonly is Qnon_ascii, then we can return the first + binding we find. If firstonly is not Qnon_ascii but not + nil, then we should return the first ascii-only binding + we find. */ + if (EQ (firstonly, Qnon_ascii)) + RETURN_UNGCPRO (sequence); + else if (!NILP (firstonly) && ascii_sequence_p (sequence)) + RETURN_UNGCPRO (sequence); + + if (CONSP (remapped)) + { + sequence = XCAR (remapped); + remapped = XCDR (remapped); + goto record_sequence; } } } @@ -2835,7 +2850,7 @@ remapped command in the returned list. */) else if (!NILP (keymap)) keymaps = Fcons (keymap, Fcons (current_global_map, Qnil)); else - keymaps = Fcurrent_active_maps (Qnil); + keymaps = Fcurrent_active_maps (Qnil, Qnil); /* Only use caching for the menubar (i.e. called with (def nil t nil). We don't really need to check `keymap'. */ @@ -2901,53 +2916,19 @@ remapped command in the returned list. */) return result; } -/* This is the function that Fwhere_is_internal calls using map_char_table. - ARGS has the form - (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT)) - . - ((THIS . LAST) . (NOMENUS . LAST_IS_META))) - Since map_char_table doesn't really use the return value from this function, - we the result append to RESULT, the slot in ARGS. - - This function can GC because it calls where_is_internal_1 which can - GC. */ - -static void -where_is_internal_2 (args, key, binding) - Lisp_Object args, key, binding; -{ - Lisp_Object definition, noindirect, this, last; - Lisp_Object result, sequence; - int nomenus, last_is_meta; - struct gcpro gcpro1, gcpro2, gcpro3; - - GCPRO3 (args, key, binding); - result = XCDR (XCAR (args)); - definition = XCAR (XCAR (XCAR (args))); - noindirect = XCDR (XCAR (XCAR (args))); - this = XCAR (XCAR (XCDR (args))); - last = XCDR (XCAR (XCDR (args))); - nomenus = XFASTINT (XCAR (XCDR (XCDR (args)))); - last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args)))); - - sequence = where_is_internal_1 (binding, key, definition, noindirect, - this, last, nomenus, last_is_meta); - - if (!NILP (sequence)) - XSETCDR (XCAR (args), Fcons (sequence, result)); - - UNGCPRO; -} - - /* This function can GC because get_keyelt can. */ -static Lisp_Object -where_is_internal_1 (binding, key, definition, noindirect, this, last, - nomenus, last_is_meta) - Lisp_Object binding, key, definition, noindirect, this, last; - int nomenus, last_is_meta; +static void +where_is_internal_1 (key, binding, args, data) + Lisp_Object key, binding, args; + void *data; { + struct where_is_internal_data *d = data; /* Cast! */ + Lisp_Object definition = d->definition; + Lisp_Object noindirect = d->noindirect; + Lisp_Object this = d->this; + Lisp_Object last = d->last; + int last_is_meta = d->last_is_meta; Lisp_Object sequence; /* Search through indirections unless that's not wanted. */ @@ -2961,7 +2942,7 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, || EQ (binding, definition) || (CONSP (definition) && !NILP (Fequal (binding, definition))))) /* Doesn't match. */ - return Qnil; + return; /* We have found a match. Construct the key sequence where we found it. */ if (INTEGERP (key) && last_is_meta) @@ -2976,10 +2957,9 @@ where_is_internal_1 (binding, key, definition, noindirect, this, last, { Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil); Fputhash (binding, Fcons (sequence, sequences), where_is_cache); - return Qnil; } else - return sequence; + d->sequences = Fcons (sequence, d->sequences); } /* describe-bindings - summarizing all the bindings in a set of keymaps. */ diff --git a/src/keymap.h b/src/keymap.h index b305a318944..6d8323d5038 100644 --- a/src/keymap.h +++ b/src/keymap.h @@ -34,7 +34,7 @@ EXFUN (Fkey_binding, 4); EXFUN (Fkey_description, 2); EXFUN (Fsingle_key_description, 2); EXFUN (Fwhere_is_internal, 5); -EXFUN (Fcurrent_active_maps, 1); +EXFUN (Fcurrent_active_maps, 2); extern Lisp_Object access_keymap P_ ((Lisp_Object, Lisp_Object, int, int, int)); extern Lisp_Object get_keyelt P_ ((Lisp_Object, int)); extern Lisp_Object get_keymap P_ ((Lisp_Object, int, int)); @@ -48,7 +48,7 @@ extern void syms_of_keymap P_ ((void)); extern void keys_of_keymap P_ ((void)); typedef void (*map_keymap_function_t) - P_ ((Lisp_Object, Lisp_Object, Lisp_Object, void*)); + P_ ((Lisp_Object key, Lisp_Object val, Lisp_Object args, void* data)); extern void map_keymap P_ ((Lisp_Object map, map_keymap_function_t fun, Lisp_Object largs, void* cargs, int autoload)); #endif diff --git a/src/lisp.h b/src/lisp.h index 7bf59d0f55a..b835c531e5e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -56,7 +56,7 @@ Boston, MA 02110-1301, USA. */ #ifdef GC_CHECK_CONS_LIST #define CHECK_CONS_LIST() check_cons_list() #else -#define CHECK_CONS_LIST() 0 +#define CHECK_CONS_LIST() ((void)0) #endif /* These are default choices for the types to use. */ @@ -1041,16 +1041,16 @@ struct Lisp_Hash_Table hash table size to reduce collisions. */ Lisp_Object index; - /* Next weak hash table if this is a weak hash table. The head - of the list is in Vweak_hash_tables. */ - Lisp_Object next_weak; - /* User-supplied hash function, or nil. */ Lisp_Object user_hash_function; /* User-supplied key comparison function, or nil. */ Lisp_Object user_cmp_function; + /* Next weak hash table if this is a weak hash table. The head + of the list is in weak_hash_tables. */ + struct Lisp_Hash_Table *next_weak; + /* C function to compare two keys. */ int (* cmpfn) P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned, Lisp_Object, unsigned)); @@ -2428,7 +2428,7 @@ EXFUN (Fstring_lessp, 2); extern int char_table_translate P_ ((Lisp_Object, int)); extern void map_char_table P_ ((void (*) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int, - Lisp_Object *)); + int *)); extern Lisp_Object char_table_ref_and_index P_ ((Lisp_Object, int, int *)); extern void syms_of_fns P_ ((void)); @@ -3255,6 +3255,7 @@ EXFUN (Fx_file_dialog, 5); #endif /* Defined in xfaces.c */ +EXFUN (Fclear_face_cache, 1); extern void syms_of_xfaces P_ ((void)); #ifndef HAVE_GETLOADAVG @@ -3270,6 +3271,7 @@ extern void syms_of_xfns P_ ((void)); extern void syms_of_xsmfns P_ ((void)); /* Defined in xselect.c */ +EXFUN (Fx_send_client_event, 6); extern void syms_of_xselect P_ ((void)); /* Defined in xterm.c */ diff --git a/src/macgui.h b/src/macgui.h index fb6f858c547..29905370763 100644 --- a/src/macgui.h +++ b/src/macgui.h @@ -98,7 +98,7 @@ typedef unsigned long Time; /* Whether to use Quartz 2D routines for drawing operations other than texts. */ #ifndef USE_CG_DRAWING -#if USE_ATSUI && MAC_OS_X_VERSION_MAX_ALLOWED >= 1020 +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1020 #define USE_CG_DRAWING 1 #endif #endif @@ -119,7 +119,7 @@ typedef unsigned long Time; /* Whether to use HIToolbar. */ #ifndef USE_MAC_TOOLBAR -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 && MAC_OS_X_VERSION_MIN_REQUIRED != 1020 +#if USE_CG_DRAWING && MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 && MAC_OS_X_VERSION_MIN_REQUIRED != 1020 #define USE_MAC_TOOLBAR 1 #endif #endif diff --git a/src/macmenu.c b/src/macmenu.c index c10a76f8a5d..0aa0f620778 100644 --- a/src/macmenu.c +++ b/src/macmenu.c @@ -882,7 +882,7 @@ no quit occurs and `x-popup-menu' returns nil. */) /* Regard ESC and C-g as Cancel even without the Cancel button. */ -#ifdef MAC_OSX +#if 0 /* defined (MAC_OSX) */ static Boolean mac_dialog_modal_filter (dialog, event, item_hit) DialogRef dialog; @@ -991,7 +991,7 @@ for instance using the window manager, then this produces a quit and but I don't want to make one now. */ CHECK_WINDOW (window); -#ifdef MAC_OSX +#if 0 /* defined (MAC_OSX) */ /* Special treatment for Fmessage_box, Fyes_or_no_p, and Fy_or_n_p. */ if (EQ (position, Qt) && STRINGP (Fcar (contents)) @@ -2330,14 +2330,17 @@ mac_menu_show (f, x, y, for_click, keymaps, title, error) #define DIALOG_BUTTON_MAKE_COMMAND_ID(value) \ ((value) + DIALOG_BUTTON_COMMAND_ID_OFFSET) +extern EMACS_TIME timer_check P_ ((int)); + static pascal OSStatus mac_handle_dialog_event (next_handler, event, data) EventHandlerCallRef next_handler; EventRef event; void *data; { - OSStatus err; + OSStatus err, result = eventNotHandledErr; WindowRef window = (WindowRef) data; + int quit_event_loop_p = 0; switch (GetEventClass (event)) { @@ -2352,12 +2355,11 @@ mac_handle_dialog_event (next_handler, event, data) if (DIALOG_BUTTON_COMMAND_ID_P (command.commandID)) { SetWRefCon (window, command.commandID); - err = QuitAppModalLoopForWindow (window); - - return err == noErr ? noErr : eventNotHandledErr; + quit_event_loop_p = 1; + break; } - return CallNextEventHandler (next_handler, event); + result = CallNextEventHandler (next_handler, event); } break; @@ -2367,8 +2369,8 @@ mac_handle_dialog_event (next_handler, event, data) char char_code; result = CallNextEventHandler (next_handler, event); - if (result == noErr) - return noErr; + if (result != eventNotHandledErr) + break; err = GetEventParameter (event, kEventParamKeyMacCharCodes, typeChar, NULL, sizeof (char), @@ -2377,7 +2379,7 @@ mac_handle_dialog_event (next_handler, event, data) switch (char_code) { case kEscapeCharCode: - err = QuitAppModalLoopForWindow (window); + quit_event_loop_p = 1; break; default: @@ -2392,26 +2394,26 @@ mac_handle_dialog_event (next_handler, event, data) typeUInt32, NULL, sizeof (UInt32), NULL, &key_code); if (err == noErr) - { - if (mac_quit_char_key_p (modifiers, key_code)) - err = QuitAppModalLoopForWindow (window); - else - err = eventNotHandledErr; - } + if (mac_quit_char_key_p (modifiers, key_code)) + quit_event_loop_p = 1; } break; } - - if (err == noErr) - result = noErr; - - return result; } break; default: abort (); } + + if (quit_event_loop_p) + { + err = QuitEventLoop (GetCurrentEventLoop ()); + if (err == noErr) + result = noErr; + } + + return result; } static OSStatus @@ -2446,6 +2448,25 @@ install_dialog_event_handler (window) #define DIALOG_ICON_LEFT_MARGIN (24) #define DIALOG_ICON_TOP_MARGIN (15) +static Lisp_Object +pop_down_dialog (arg) + Lisp_Object arg; +{ + struct Lisp_Save_Value *p = XSAVE_VALUE (arg); + WindowRef window = p->pointer; + + BLOCK_INPUT; + + if (popup_activated_flag) + EndAppModalStateForWindow (window); + DisposeWindow (window); + popup_activated_flag = 0; + + UNBLOCK_INPUT; + + return Qnil; +} + static int create_and_show_dialog (f, first_wv) FRAME_PTR f; @@ -2459,6 +2480,7 @@ create_and_show_dialog (f, first_wv) Rect empty_rect, *rects; WindowRef window = NULL; ControlRef *buttons, default_button = NULL, text; + int specpdl_count = SPECPDL_INDEX (); dialog_name = first_wv->name; nb_buttons = dialog_name[1] - '0'; @@ -2475,8 +2497,11 @@ create_and_show_dialog (f, first_wv) kWindowStandardHandlerAttribute, &empty_rect, &window); if (err == noErr) - err = SetThemeWindowBackground (window, kThemeBrushMovableModalBackground, - true); + { + record_unwind_protect (pop_down_dialog, make_save_value (window, 0)); + err = SetThemeWindowBackground (window, kThemeBrushMovableModalBackground, + true); + } if (err == noErr) err = SetWindowTitleWithCFString (window, (dialog_name[0] == 'Q' ? CFSTR ("Question") @@ -2701,7 +2726,45 @@ create_and_show_dialog (f, first_wv) SetWRefCon (window, 0); ShowWindow (window); BringToFront (window); - err = RunAppModalLoopForWindow (window); + popup_activated_flag = 1; + err = BeginAppModalStateForWindow (window); + } + if (err == noErr) + { + EventTargetRef toolbox_dispatcher = GetEventDispatcherTarget (); + + while (1) + { + EMACS_TIME next_time = timer_check (1); + long secs = EMACS_SECS (next_time); + long usecs = EMACS_USECS (next_time); + EventTimeout timeout; + EventRef event; + + if (secs < 0 || (secs == 0 && usecs == 0)) + { + /* Sometimes timer_check returns -1 (no timers) even if + there are timers. So do a timeout anyway. */ + secs = 1; + usecs = 0; + } + + timeout = (secs * kEventDurationSecond + + usecs * kEventDurationMicrosecond); + err = ReceiveNextEvent (0, NULL, timeout, kEventRemoveFromQueue, + &event); + if (err == noErr) + { + SendEventToEventTarget (event, toolbox_dispatcher); + ReleaseEvent (event); + } + else if (err != eventLoopTimedOutErr) + { + if (err == eventLoopQuitErr) + err = noErr; + break; + } + } } if (err == noErr) { @@ -2711,8 +2774,7 @@ create_and_show_dialog (f, first_wv) result = DIALOG_BUTTON_COMMAND_ID_VALUE (command_id); } - if (window) - DisposeWindow (window); + unbind_to (specpdl_count, Qnil); return result; } @@ -3282,9 +3344,13 @@ DEFUN ("menu-or-popup-active-p", Fmenu_or_popup_active_p, Smenu_or_popup_active_ doc: /* Return t if a menu or popup dialog is active. */) () { +#if TARGET_API_MAC_CARBON + return (popup_activated ()) ? Qt : Qnil; +#else /* Always return Qnil since menu selection functions do not return until a selection has been made or cancelled. */ return Qnil; +#endif } void diff --git a/src/macterm.c b/src/macterm.c index 9ea51f87cfb..fa0682feca0 100644 --- a/src/macterm.c +++ b/src/macterm.c @@ -2196,11 +2196,12 @@ x_draw_fringe_bitmap (w, row, p) Display *display = FRAME_MAC_DISPLAY (f); struct face *face = p->face; int rowY; + int overlay_p = p->overlay_p; #ifdef MAC_OSX - if (p->bx >= 0 && !p->overlay_p) + if (!overlay_p) { - int bx = p->bx, nx = p->nx; + int bx = p->bx, by = p->by, nx = p->nx, ny = p->ny; #if 0 /* MAC_TODO: stipple */ /* In case the same realized face is used for fringes and @@ -2229,17 +2230,40 @@ x_draw_fringe_bitmap (w, row, p) int width = (WINDOW_CONFIG_SCROLL_BAR_COLS (w) * FRAME_COLUMN_WIDTH (f)); - if (left + width == bx) + if (bx < 0 + && (left + width == p->x + || p->x + p->wd == left)) { - bx = left + sb_width; - nx += width - sb_width; + /* Bitmap fills the fringe and we need background + extension. */ + int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w); + + bx = p->x; + nx = p->wd; + by = WINDOW_TO_FRAME_PIXEL_Y (w, max (header_line_height, + row->y)); + ny = row->visible_height; + } + + if (bx >= 0) + { + if (left + width == bx) + { + bx = left + sb_width; + nx += width - sb_width; + } + else if (bx + nx == left) + nx += width - sb_width; } - else if (bx + nx == left) - nx += width - sb_width; } } - mac_erase_rectangle (f, face->gc, bx, p->by, nx, p->ny); + if (bx >= 0) + { + mac_erase_rectangle (f, face->gc, bx, by, nx, ny); + /* The fringe background has already been filled. */ + overlay_p = 1; + } #if 0 /* MAC_TODO: stipple */ if (!face->stipple) @@ -2304,10 +2328,10 @@ x_draw_fringe_bitmap (w, row, p) : face->foreground)); #if USE_CG_DRAWING mac_draw_cg_image (fringe_bmp[p->which], f, face->gc, 0, p->dh, - p->wd, p->h, p->x, p->y, p->overlay_p); + p->wd, p->h, p->x, p->y, overlay_p); #else mac_draw_bitmap (f, face->gc, p->x, p->y, - p->wd, p->h, p->bits + p->dh, p->overlay_p); + p->wd, p->h, p->bits + p->dh, overlay_p); #endif XSetForeground (display, face->gc, gcv.foreground); } @@ -11135,7 +11159,7 @@ mac_handle_text_input_event (next_handler, event, data) EventRef event; void *data; { - OSStatus result, err = noErr; + OSStatus err, result; Lisp_Object id_key = Qnil; int num_params; const EventParamName *names; @@ -11196,6 +11220,7 @@ mac_handle_text_input_event (next_handler, event, data) SetEventParameter (event, EVENT_PARAM_TEXT_INPUT_SEQUENCE_NUMBER, typeUInt32, sizeof (UInt32), &seqno_uaia); seqno_uaia++; + result = noErr; break; case kEventTextInputUnicodeForKeyEvent: @@ -11213,7 +11238,7 @@ mac_handle_text_input_event (next_handler, event, data) if (err == noErr && mac_mapped_modifiers (modifiers)) /* There're mapped modifier keys. Process it in do_keystroke. */ - return eventNotHandledErr; + break; if (err == noErr) err = GetEventParameter (kbd_event, kEventParamKeyUnicodes, typeUnicodeText, NULL, 0, &actual_size, @@ -11252,16 +11277,20 @@ mac_handle_text_input_event (next_handler, event, data) XSETFRAME (read_socket_inev->frame_or_window, f); } } - return eventNotHandledErr; + break; } } + if (err == noErr) + { + /* Non-ASCII keystrokes without mapped modifiers are + processed at the Lisp level. */ + id_key = Qunicode_for_key_event; + num_params = sizeof (names_ufke) / sizeof (names_ufke[0]); + names = names_ufke; + types = types_ufke; + result = noErr; + } } - /* Non-ASCII keystrokes without mapped modifiers are processed - at the Lisp level. */ - id_key = Qunicode_for_key_event; - num_params = sizeof (names_ufke) / sizeof (names_ufke[0]); - names = names_ufke; - types = types_ufke; break; case kEventTextInputOffsetToPos: @@ -11271,22 +11300,24 @@ mac_handle_text_input_event (next_handler, event, data) Point p; if (!OVERLAYP (Vmac_ts_active_input_overlay)) - return eventNotHandledErr; + break; /* Strictly speaking, this is not always correct because previous events may change some states about display. */ - if (NILP (Foverlay_get (Vmac_ts_active_input_overlay, Qbefore_string))) + if (!NILP (Foverlay_get (Vmac_ts_active_input_overlay, Qbefore_string))) + { + /* Active input area is displayed around the current point. */ + f = SELECTED_FRAME (); + w = XWINDOW (f->selected_window); + } + else if (WINDOWP (echo_area_window)) { /* Active input area is displayed in the echo area. */ w = XWINDOW (echo_area_window); f = WINDOW_XFRAME (w); } else - { - /* Active input area is displayed around the current point. */ - f = SELECTED_FRAME (); - w = XWINDOW (f->selected_window); - } + break; p.h = (WINDOW_TO_FRAME_PIXEL_X (w, w->cursor.x) + WINDOW_LEFT_FRINGE_WIDTH (w) @@ -11296,6 +11327,8 @@ mac_handle_text_input_event (next_handler, event, data) + f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f)); err = SetEventParameter (event, kEventParamTextInputReplyPoint, typeQDPoint, sizeof (typeQDPoint), &p); + if (err == noErr) + result = noErr; } break; @@ -11307,9 +11340,6 @@ mac_handle_text_input_event (next_handler, event, data) err = mac_store_event_ref_as_apple_event (0, 0, Qtext_input, id_key, event, num_params, names, types); - if (err == noErr) - result = noErr; - return result; } #endif diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 7f45f584bcf..d9986fb8368 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -139,7 +139,7 @@ LIBS = $(TLIB0) \ $(TLIB1) \ $(TLIBW32) \ $(TLASTLIB) \ - $(WINMM) \ + $(WINMM) \ $(ADVAPI32) \ $(GDI32) \ $(COMDLG32) \ @@ -147,6 +147,7 @@ LIBS = $(TLIB0) \ $(MPR) \ $(SHELL32) \ $(WINSPOOL) \ + $(OLE32) \ $(libc) # diff --git a/src/minibuf.c b/src/minibuf.c index 698a3478eb7..eeed61be868 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1723,9 +1723,15 @@ PREDICATE limits completion to a subset of COLLECTION. See `try-completion' and `all-completions' for more details on completion, COLLECTION, and PREDICATE. -If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless - the input is (or completes to) an element of COLLECTION or is null. - If it is also not t, typing RET does not exit if it does non-null completion. +REQUIRE-MATCH can take the following values: +- t means that the user is not allowed to exit unless + the input is (or completes to) an element of COLLECTION or is null. +- nil means that the user can exit with any input. +- `confirm-only' means that the user can exit with any input, but she will + need to confirm her choice if the input is not an element of COLLECTION. +- anything else behaves like t except that typing RET does not exit if it + does non-null completion. + If the input is null, `completing-read' returns DEF, or an empty string if DEF is nil, regardless of the value of REQUIRE-MATCH. @@ -2236,6 +2242,18 @@ a repetition of this command will exit. */) goto exit; } + if (EQ (Vminibuffer_completion_confirm, intern ("confirm-only"))) + { /* The user is permitted to exit with an input that's rejected + by test-completion, but at the condition to confirm her choice. */ + if (EQ (current_kboard->Vlast_command, Vthis_command)) + goto exit; + else + { + temp_echo_area_glyphs (build_string (" [Confirm]")); + return Qnil; + } + } + /* Call do_completion, but ignore errors. */ SET_PT (ZV); val = internal_condition_case (complete_and_exit_1, Qerror, diff --git a/src/print.c b/src/print.c index 250b62ec3a5..0eb026df831 100644 --- a/src/print.c +++ b/src/print.c @@ -690,7 +690,7 @@ If variable `temp-buffer-show-function' is non-nil, call it at the end to get the buffer displayed instead of just displaying the non-selected buffer and calling the hook. It gets one argument, the buffer to display. -usage: (with-output-to-temp-buffer BUFNAME BODY ...) */) +usage: (with-output-to-temp-buffer BUFNAME BODY...) */) (args) Lisp_Object args; { diff --git a/src/process.c b/src/process.c index 9a7cf29963f..b63edbe0b6d 100644 --- a/src/process.c +++ b/src/process.c @@ -121,14 +121,6 @@ Boston, MA 02110-1301, USA. */ #include <sys/wait.h> #endif -/* Disable IPv6 support for w32 until someone figures out how to do it - properly. */ -#ifdef WINDOWSNT -# ifdef AF_INET6 -# undef AF_INET6 -# endif -#endif - #include "lisp.h" #include "systime.h" #include "systty.h" @@ -393,7 +385,7 @@ struct sockaddr_and_len { int len; } datagram_address[MAXDESC]; #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0) -#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XINT (XPROCESS (proc)->infd)].sa != 0) +#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0) #else #define DATAGRAM_CHAN_P(chan) (0) #define DATAGRAM_CONN_P(proc) (0) @@ -628,19 +620,19 @@ make_process (name) p = allocate_process (); - XSETINT (p->infd, -1); - XSETINT (p->outfd, -1); - XSETFASTINT (p->tick, 0); - XSETFASTINT (p->update_tick, 0); + p->infd = -1; + p->outfd = -1; + p->tick = 0; + p->update_tick = 0; p->pid = 0; p->raw_status_new = 0; p->status = Qrun; p->mark = Fmake_marker (); #ifdef ADAPTIVE_READ_BUFFERING - p->adaptive_read_buffering = Qnil; - XSETFASTINT (p->read_output_delay, 0); - p->read_output_skip = Qnil; + p->adaptive_read_buffering = 0; + p->read_output_delay = 0; + p->read_output_skip = 0; #endif /* If name is already in use, modify it until it is unused. */ @@ -679,8 +671,8 @@ setup_process_coding_systems (process) Lisp_Object process; { struct Lisp_Process *p = XPROCESS (process); - int inch = XINT (p->infd); - int outch = XINT (p->outfd); + int inch = p->infd; + int outch = p->outfd; if (inch < 0 || outch < 0) return; @@ -692,7 +684,7 @@ setup_process_coding_systems (process) proc_decode_coding_system[inch]); if (! NILP (p->filter)) { - if (NILP (p->filter_multibyte)) + if (!p->filter_multibyte) setup_raw_text_coding_system (proc_decode_coding_system[inch]); } else if (BUFFERP (p->buffer)) @@ -815,10 +807,10 @@ nil, indicating the current buffer's process. */) if (NETCONN1_P (p)) { p->status = Fcons (Qexit, Fcons (make_number (0), Qnil)); - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; status_notify (p); } - else if (XINT (p->infd) >= 0) + else if (p->infd >= 0) { #ifdef SIGCHLD Lisp_Object symbol; @@ -846,7 +838,7 @@ nil, indicating the current buffer's process. */) /* Do this now, since remove_process will make sigchld_handler do nothing. */ p->status = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil)); - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; status_notify (p); } } @@ -1038,18 +1030,18 @@ The string argument is normally a multibyte string, except: (debug) (set-process-filter process ...) */ - if (XINT (p->infd) >= 0) + if (p->infd >= 0) { if (EQ (filter, Qt) && !EQ (p->status, Qlisten)) { - FD_CLR (XINT (p->infd), &input_wait_mask); - FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); + FD_CLR (p->infd, &input_wait_mask); + FD_CLR (p->infd, &non_keyboard_wait_mask); } else if (EQ (p->filter, Qt) && !EQ (p->command, Qt)) /* Network process not stopped. */ { - FD_SET (XINT (p->infd), &input_wait_mask); - FD_SET (XINT (p->infd), &non_keyboard_wait_mask); + FD_SET (p->infd, &input_wait_mask); + FD_SET (p->infd, &non_keyboard_wait_mask); } } @@ -1111,8 +1103,8 @@ DEFUN ("set-process-window-size", Fset_process_window_size, CHECK_NATNUM (height); CHECK_NATNUM (width); - if (XINT (XPROCESS (process)->infd) < 0 - || set_window_size (XINT (XPROCESS (process)->infd), + if (XPROCESS (process)->infd < 0 + || set_window_size (XPROCESS (process)->infd, XINT (height), XINT (width)) <= 0) return Qnil; else @@ -1140,7 +1132,7 @@ for the process which will run. */) register Lisp_Object process, flag; { CHECK_PROCESS (process); - XPROCESS (process)->inherit_coding_system_flag = flag; + XPROCESS (process)->inherit_coding_system_flag = !NILP (flag); return flag; } @@ -1155,7 +1147,7 @@ the process output. */) register Lisp_Object process; { CHECK_PROCESS (process); - return XPROCESS (process)->inherit_coding_system_flag; + return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil; } DEFUN ("set-process-query-on-exit-flag", @@ -1168,7 +1160,7 @@ exiting if PROCESS is running. */) register Lisp_Object process, flag; { CHECK_PROCESS (process); - XPROCESS (process)->kill_without_query = Fnull (flag); + XPROCESS (process)->kill_without_query = NILP (flag); return flag; } @@ -1180,7 +1172,7 @@ DEFUN ("process-query-on-exit-flag", register Lisp_Object process; { CHECK_PROCESS (process); - return Fnull (XPROCESS (process)->kill_without_query); + return (XPROCESS (process)->kill_without_query ? Qnil : Qt); } #ifdef DATAGRAM_SOCKETS @@ -1355,7 +1347,7 @@ list_processes_1 (query_only) p = XPROCESS (proc); if (NILP (p->childp)) continue; - if (!NILP (query_only) && !NILP (p->kill_without_query)) + if (!NILP (query_only) && p->kill_without_query) continue; if (STRINGP (p->name) && ( i = SCHARS (p->name), (i > w_proc))) @@ -1418,7 +1410,7 @@ list_processes_1 (query_only) p = XPROCESS (proc); if (NILP (p->childp)) continue; - if (!NILP (query_only) && !NILP (p->kill_without_query)) + if (!NILP (query_only) && p->kill_without_query) continue; Finsert (1, &p->name); @@ -1494,7 +1486,7 @@ list_processes_1 (query_only) if (NILP (port)) port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil); sprintf (tembuf, "(network %s server on %s)\n", - (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"), + (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"), (STRINGP (port) ? (char *)SDATA (port) : "?")); insert_string (tembuf); } @@ -1512,7 +1504,7 @@ list_processes_1 (query_only) if (NILP (host)) host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil); sprintf (tembuf, "(network %s connection to %s)\n", - (DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"), + (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"), (STRINGP (host) ? (char *)SDATA (host) : "?")); insert_string (tembuf); } @@ -1643,11 +1635,13 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) XPROCESS (proc)->sentinel = Qnil; XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->filter_multibyte - = buffer_defaults.enable_multibyte_characters; + = !NILP (buffer_defaults.enable_multibyte_characters); XPROCESS (proc)->command = Flist (nargs - 2, args + 2); #ifdef ADAPTIVE_READ_BUFFERING - XPROCESS (proc)->adaptive_read_buffering = Vprocess_adaptive_read_buffering; + XPROCESS (proc)->adaptive_read_buffering + = (NILP (Vprocess_adaptive_read_buffering) ? 0 + : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2); #endif /* Make the process marker point into the process buffer (if any). */ @@ -1778,13 +1772,11 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) #endif /* not VMS */ XPROCESS (proc)->decoding_buf = make_uninit_string (0); - XPROCESS (proc)->decoding_carryover = make_number (0); + XPROCESS (proc)->decoding_carryover = 0; XPROCESS (proc)->encoding_buf = make_uninit_string (0); - XPROCESS (proc)->encoding_carryover = make_number (0); XPROCESS (proc)->inherit_coding_system_flag - = (NILP (buffer) || !inherit_process_coding_system - ? Qnil : Qt); + = (NILP (buffer) || !inherit_process_coding_system); create_process (proc, (char **) new_argv, current_dir); @@ -1956,15 +1948,15 @@ create_process (process, new_argv, current_dir) /* Record this as an active process, with its channels. As a result, child_setup will close Emacs's side of the pipes. */ chan_process[inchannel] = process; - XSETINT (XPROCESS (process)->infd, inchannel); - XSETINT (XPROCESS (process)->outfd, outchannel); + XPROCESS (process)->infd = inchannel; + XPROCESS (process)->outfd = outchannel; /* Previously we recorded the tty descriptor used in the subprocess. It was only used for getting the foreground tty process, so now we just reopen the device (see emacs_get_tty_pgrp) as this is more portable (see USG_SUBTTY_WORKS above). */ - XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil); + XPROCESS (process)->pty_flag = pty_flag; XPROCESS (process)->status = Qrun; setup_process_coding_systems (process); @@ -2481,7 +2473,7 @@ DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_ if (!DATAGRAM_CONN_P (process)) return Qnil; - channel = XINT (XPROCESS (process)->infd); + channel = XPROCESS (process)->infd; return conv_sockaddr_to_lisp (datagram_address[channel].sa, datagram_address[channel].len); } @@ -2501,7 +2493,7 @@ Returns nil upon error setting address, ADDRESS otherwise. */) if (!DATAGRAM_CONN_P (process)) return Qnil; - channel = XINT (XPROCESS (process)->infd); + channel = XPROCESS (process)->infd; len = get_lisp_to_sockaddr_size (address, &family); if (datagram_address[channel].len != len) @@ -2666,7 +2658,7 @@ OPTION is not a supported option, return nil instead; otherwise return t. */) if (!NETCONN1_P (p)) error ("Process is not a network process"); - s = XINT (p->infd); + s = p->infd; if (s < 0) error ("Process is not running"); @@ -3425,18 +3417,18 @@ usage: (make-network-process &rest ARGS) */) p->buffer = buffer; p->sentinel = sentinel; p->filter = filter; - p->filter_multibyte = buffer_defaults.enable_multibyte_characters; + p->filter_multibyte = !NILP (buffer_defaults.enable_multibyte_characters); /* Override the above only if :filter-multibyte is specified. */ if (! NILP (Fplist_member (contact, QCfilter_multibyte))) - p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte); + p->filter_multibyte = !NILP (Fplist_get (contact, QCfilter_multibyte)); p->log = Fplist_get (contact, QClog); if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) - p->kill_without_query = Qt; + p->kill_without_query = 1; if ((tem = Fplist_get (contact, QCstop), !NILP (tem))) p->command = Qt; p->pid = 0; - XSETINT (p->infd, inch); - XSETINT (p->outfd, outch); + p->infd = inch; + p->outfd = outch; if (is_server && socktype == SOCK_STREAM) p->status = Qlisten; @@ -3557,13 +3549,11 @@ usage: (make-network-process &rest ARGS) */) setup_process_coding_systems (proc); p->decoding_buf = make_uninit_string (0); - p->decoding_carryover = make_number (0); + p->decoding_carryover = 0; p->encoding_buf = make_uninit_string (0); - p->encoding_carryover = make_number (0); p->inherit_coding_system_flag - = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system - ? Qnil : Qt); + = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system); UNGCPRO; return proc; @@ -3826,16 +3816,16 @@ deactivate_process (proc) register int inchannel, outchannel; register struct Lisp_Process *p = XPROCESS (proc); - inchannel = XINT (p->infd); - outchannel = XINT (p->outfd); + inchannel = p->infd; + outchannel = p->outfd; #ifdef ADAPTIVE_READ_BUFFERING - if (XINT (p->read_output_delay) > 0) + if (p->read_output_delay > 0) { if (--process_output_delay_count < 0) process_output_delay_count = 0; - XSETINT (p->read_output_delay, 0); - p->read_output_skip = Qnil; + p->read_output_delay = 0; + p->read_output_skip = 0; } #endif @@ -3857,8 +3847,8 @@ deactivate_process (proc) emacs_close (outchannel); #endif - XSETINT (p->infd, -1); - XSETINT (p->outfd, -1); + p->infd = -1; + p->outfd = -1; #ifdef DATAGRAM_SOCKETS if (DATAGRAM_CHAN_P (inchannel)) { @@ -3906,8 +3896,8 @@ close_process_descs () process = chan_process[i]; if (!NILP (process)) { - int in = XINT (XPROCESS (process)->infd); - int out = XINT (XPROCESS (process)->outfd); + int in = XPROCESS (process)->infd; + int out = XPROCESS (process)->outfd; if (in >= 0) emacs_close (in); if (out >= 0 && in != out) @@ -4151,8 +4141,8 @@ server_accept_connection (server, channel) p->filter = ps->filter; p->command = Qnil; p->pid = 0; - XSETINT (p->infd, s); - XSETINT (p->outfd, s); + p->infd = s; + p->outfd = s; p->status = Qrun; /* Client processes for accepted connections are not stopped initially. */ @@ -4175,12 +4165,11 @@ server_accept_connection (server, channel) setup_process_coding_systems (proc); p->decoding_buf = make_uninit_string (0); - p->decoding_carryover = make_number (0); + p->decoding_carryover = 0; p->encoding_buf = make_uninit_string (0); - p->encoding_carryover = make_number (0); p->inherit_coding_system_flag - = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag); + = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag); if (!NILP (ps->log)) call3 (ps->log, server, proc, @@ -4305,7 +4294,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, /* If wait_proc is a process to watch, set wait_channel accordingly. */ if (wait_proc != NULL) - wait_channel = XINT (wait_proc->infd); + wait_channel = wait_proc->infd; record_unwind_protect (wait_reading_process_output_unwind, make_number (waiting_for_user_input_p)); @@ -4490,9 +4479,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, XSETPROCESS (proc, wait_proc); /* Read data from the process, until we exhaust it. */ - while (XINT (wait_proc->infd) >= 0) + while (wait_proc->infd >= 0) { - nread = read_process_output (proc, XINT (wait_proc->infd)); + nread = read_process_output (proc, wait_proc->infd); if (nread == 0) break; @@ -4522,9 +4511,9 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, if (wait_proc && just_wait_proc) { - if (XINT (wait_proc->infd) < 0) /* Terminated */ + if (wait_proc->infd < 0) /* Terminated */ break; - FD_SET (XINT (wait_proc->infd), &Available); + FD_SET (wait_proc->infd, &Available); check_delay = 0; IF_NON_BLOCKING_CONNECT (check_connect = 0); } @@ -4572,7 +4561,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, #ifdef ADAPTIVE_READ_BUFFERING /* Set the timeout for adaptive read buffering if any - process has non-nil read_output_skip and non-zero + process has non-zero read_output_skip and non-zero read_output_delay, and we are not reading output for a specific wait_channel. It is not executed if Vprocess_adaptive_read_buffering is nil. */ @@ -4587,16 +4576,16 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, if (NILP (proc)) continue; /* Find minimum non-zero read_output_delay among the - processes with non-nil read_output_skip. */ - if (XINT (XPROCESS (proc)->read_output_delay) > 0) + processes with non-zero read_output_skip. */ + if (XPROCESS (proc)->read_output_delay > 0) { check_delay--; - if (NILP (XPROCESS (proc)->read_output_skip)) + if (!XPROCESS (proc)->read_output_skip) continue; FD_CLR (channel, &Available); - XPROCESS (proc)->read_output_skip = Qnil; - if (XINT (XPROCESS (proc)->read_output_delay) < usecs) - usecs = XINT (XPROCESS (proc)->read_output_delay); + XPROCESS (proc)->read_output_skip = 0; + if (XPROCESS (proc)->read_output_delay < usecs) + usecs = XPROCESS (proc)->read_output_delay; } } EMACS_SET_SECS_USECS (timeout, 0, usecs); @@ -4869,7 +4858,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, else { /* Preserve status of processes already terminated. */ - XSETINT (XPROCESS (proc)->tick, ++process_tick); + XPROCESS (proc)->tick = ++process_tick; deactivate_process (proc); if (XPROCESS (proc)->raw_status_new) update_status (XPROCESS (proc)); @@ -4921,7 +4910,7 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, #endif if (xerrno) { - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil)); deactivate_process (proc); } @@ -4934,8 +4923,8 @@ wait_reading_process_output (time_limit, microsecs, read_kbd, do_display, exec_sentinel (proc, build_string ("open\n")); if (!EQ (p->filter, Qt) && !EQ (p->command, Qt)) { - FD_SET (XINT (p->infd), &input_wait_mask); - FD_SET (XINT (p->infd), &non_keyboard_wait_mask); + FD_SET (p->infd, &input_wait_mask); + FD_SET (p->infd, &non_keyboard_wait_mask); } } } @@ -5009,7 +4998,7 @@ read_process_output (proc, channel) register struct Lisp_Process *p = XPROCESS (proc); register int opoint; struct coding_system *coding = proc_decode_coding_system[channel]; - int carryover = XINT (p->decoding_carryover); + int carryover = p->decoding_carryover; int readmax = 4096; #ifdef VMS @@ -5062,9 +5051,9 @@ read_process_output (proc, channel) { nbytes = emacs_read (channel, chars + carryover, readmax); #ifdef ADAPTIVE_READ_BUFFERING - if (nbytes > 0 && !NILP (p->adaptive_read_buffering)) + if (nbytes > 0 && p->adaptive_read_buffering) { - int delay = XINT (p->read_output_delay); + int delay = p->read_output_delay; if (nbytes < 256) { if (delay < READ_OUTPUT_DELAY_MAX_MAX) @@ -5080,10 +5069,10 @@ read_process_output (proc, channel) if (delay == 0) process_output_delay_count--; } - XSETINT (p->read_output_delay, delay); + p->read_output_delay = delay; if (delay) { - p->read_output_skip = Qt; + p->read_output_skip = 1; process_output_skip = 1; } } @@ -5101,7 +5090,7 @@ read_process_output (proc, channel) } #endif /* not VMS */ - XSETINT (p->decoding_carryover, 0); + p->decoding_carryover = 0; /* At this point, NBYTES holds number of bytes just received (including the one in proc_buffered_char[channel]). */ @@ -5175,14 +5164,14 @@ read_process_output (proc, channel) valid memory because p->outfd will be changed once EOF is sent to the process. */ if (NILP (p->encode_coding_system) - && proc_encode_coding_system[XINT (p->outfd)]) + && proc_encode_coding_system[p->outfd]) { p->encode_coding_system = coding->symbol; setup_coding_system (coding->symbol, - proc_encode_coding_system[XINT (p->outfd)]); - if (proc_encode_coding_system[XINT (p->outfd)]->eol_type + proc_encode_coding_system[p->outfd]); + if (proc_encode_coding_system[p->outfd]->eol_type == CODING_EOL_UNDECIDED) - proc_encode_coding_system[XINT (p->outfd)]->eol_type + proc_encode_coding_system[p->outfd]->eol_type = system_eol_type; } } @@ -5195,9 +5184,9 @@ read_process_output (proc, channel) p->decoding_buf = make_uninit_string (carryover); bcopy (chars + coding->consumed, SDATA (p->decoding_buf), carryover); - XSETINT (p->decoding_carryover, carryover); + p->decoding_carryover = carryover; /* Adjust the multibyteness of TEXT to that of the filter. */ - if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text)) + if (p->filter_multibyte != STRING_MULTIBYTE (text)) text = (STRING_MULTIBYTE (text) ? Fstring_as_unibyte (text) : Fstring_to_multibyte (text)); @@ -5289,14 +5278,14 @@ read_process_output (proc, channel) { p->decode_coding_system = coding->symbol; if (NILP (p->encode_coding_system) - && proc_encode_coding_system[XINT (p->outfd)]) + && proc_encode_coding_system[p->outfd]) { p->encode_coding_system = coding->symbol; setup_coding_system (coding->symbol, - proc_encode_coding_system[XINT (p->outfd)]); - if (proc_encode_coding_system[XINT (p->outfd)]->eol_type + proc_encode_coding_system[p->outfd]); + if (proc_encode_coding_system[p->outfd]->eol_type == CODING_EOL_UNDECIDED) - proc_encode_coding_system[XINT (p->outfd)]->eol_type + proc_encode_coding_system[p->outfd]->eol_type = system_eol_type; } } @@ -5308,7 +5297,7 @@ read_process_output (proc, channel) p->decoding_buf = make_uninit_string (carryover); bcopy (chars + coding->consumed, SDATA (p->decoding_buf), carryover); - XSETINT (p->decoding_carryover, carryover); + p->decoding_carryover = carryover; /* Adjust the multibyteness of TEXT to that of the buffer. */ if (NILP (current_buffer->enable_multibyte_characters) @@ -5427,10 +5416,10 @@ send_process (proc, buf, len, object) update_status (p); if (! EQ (p->status, Qrun)) error ("Process %s not running", SDATA (p->name)); - if (XINT (p->outfd) < 0) + if (p->outfd < 0) error ("Output file descriptor of %s is closed", SDATA (p->name)); - coding = proc_encode_coding_system[XINT (p->outfd)]; + coding = proc_encode_coding_system[p->outfd]; Vlast_coding_system_used = coding->symbol; if ((STRINGP (object) && STRING_MULTIBYTE (object)) @@ -5523,7 +5512,7 @@ send_process (proc, buf, len, object) if (pty_max_bytes == 0) { #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) - pty_max_bytes = fpathconf (XFASTINT (p->outfd), _PC_MAX_CANON); + pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON); if (pty_max_bytes < 0) pty_max_bytes = 250; #else @@ -5545,7 +5534,7 @@ send_process (proc, buf, len, object) /* Decide how much data we can send in one batch. Long lines need to be split into multiple batches. */ - if (!NILP (p->pty_flag)) + if (p->pty_flag) { /* Starting this at zero is always correct when not the first iteration because the previous iteration ended by sending C-d. @@ -5574,7 +5563,7 @@ send_process (proc, buf, len, object) /* Send this batch, using one or more write calls. */ while (this > 0) { - int outfd = XINT (p->outfd); + int outfd = p->outfd; old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); #ifdef DATAGRAM_SOCKETS if (DATAGRAM_CHAN_P (outfd)) @@ -5594,12 +5583,12 @@ send_process (proc, buf, len, object) { rv = emacs_write (outfd, (char *) buf, this); #ifdef ADAPTIVE_READ_BUFFERING - if (XINT (p->read_output_delay) > 0 - && EQ (p->adaptive_read_buffering, Qt)) + if (p->read_output_delay > 0 + && p->adaptive_read_buffering == 1) { - XSETFASTINT (p->read_output_delay, 0); + p->read_output_delay = 0; process_output_delay_count--; - p->read_output_skip = Qnil; + p->read_output_skip = 0; } #endif } @@ -5642,7 +5631,7 @@ send_process (proc, buf, len, object) if (errno == EAGAIN) { int flags = FWRITE; - ioctl (XINT (p->outfd), TIOCFLUSH, &flags); + ioctl (p->outfd, TIOCFLUSH, &flags); } #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */ @@ -5691,7 +5680,7 @@ send_process (proc, buf, len, object) #endif p->raw_status_new = 0; p->status = Fcons (Qexit, Fcons (make_number (256), Qnil)); - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; deactivate_process (proc); #ifdef VMS error ("Error writing to process %s; closed it", SDATA (p->name)); @@ -5743,10 +5732,10 @@ send_process_object (proc, start, end) update_status (p); if (! EQ (p->status, Qrun)) error ("Process %s not running", SDATA (p->name)); - if (XINT (p->outfd) < 0) + if (p->outfd < 0) error ("Output file descriptor of %s is closed", SDATA (p->name)); - coding = proc_encode_coding_system[XINT (p->outfd)]; + coding = proc_encode_coding_system[p->outfd]; if (! EQ (coding->symbol, p->encode_coding_system)) /* The coding system for encoding was changed to raw-text because we sent a unibyte text previously. Now we are @@ -5835,7 +5824,7 @@ emacs_get_tty_pgrp (p) int gid = -1; #ifdef TIOCGPGRP - if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) + if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name)) { int fd; /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the @@ -5873,7 +5862,7 @@ return t unconditionally. */) if (!EQ (p->childp, Qt)) error ("Process %s is not a subprocess", SDATA (p->name)); - if (XINT (p->infd) < 0) + if (p->infd < 0) error ("Process %s is not active", SDATA (p->name)); @@ -5916,11 +5905,11 @@ process_send_signal (process, signo, current_group, nomsg) if (!EQ (p->childp, Qt)) error ("Process %s is not a subprocess", SDATA (p->name)); - if (XINT (p->infd) < 0) + if (p->infd < 0) error ("Process %s is not active", SDATA (p->name)); - if (NILP (p->pty_flag)) + if (!p->pty_flag) current_group = Qnil; /* If we are using pgrps, get a pgrp number and make it negative. */ @@ -5939,7 +5928,7 @@ process_send_signal (process, signo, current_group, nomsg) struct termios t; cc_t *sig_char = NULL; - tcgetattr (XINT (p->infd), &t); + tcgetattr (p->infd, &t); switch (signo) { @@ -5979,16 +5968,16 @@ process_send_signal (process, signo, current_group, nomsg) switch (signo) { case SIGINT: - ioctl (XINT (p->infd), TIOCGETC, &c); + ioctl (p->infd, TIOCGETC, &c); send_process (proc, &c.t_intrc, 1, Qnil); return; case SIGQUIT: - ioctl (XINT (p->infd), TIOCGETC, &c); + ioctl (p->infd, TIOCGETC, &c); send_process (proc, &c.t_quitc, 1, Qnil); return; #ifdef SIGTSTP case SIGTSTP: - ioctl (XINT (p->infd), TIOCGLTC, &lc); + ioctl (p->infd, TIOCGLTC, &lc); send_process (proc, &lc.t_suspc, 1, Qnil); return; #endif /* ! defined (SIGTSTP) */ @@ -6003,16 +5992,16 @@ process_send_signal (process, signo, current_group, nomsg) switch (signo) { case SIGINT: - ioctl (XINT (p->infd), TCGETA, &t); + ioctl (p->infd, TCGETA, &t); send_process (proc, &t.c_cc[VINTR], 1, Qnil); return; case SIGQUIT: - ioctl (XINT (p->infd), TCGETA, &t); + ioctl (p->infd, TCGETA, &t); send_process (proc, &t.c_cc[VQUIT], 1, Qnil); return; #ifdef SIGTSTP case SIGTSTP: - ioctl (XINT (p->infd), TCGETA, &t); + ioctl (p->infd, TCGETA, &t); send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); return; #endif /* ! defined (SIGTSTP) */ @@ -6070,7 +6059,7 @@ process_send_signal (process, signo, current_group, nomsg) case SIGCONT: p->raw_status_new = 0; p->status = Qrun; - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; if (!nomsg) status_notify (NULL); break; @@ -6090,7 +6079,7 @@ process_send_signal (process, signo, current_group, nomsg) sys$forcex (&(p->pid), 0, 1); whoosh: #endif - flush_pending_output (XINT (p->infd)); + flush_pending_output (p->infd); break; } @@ -6107,7 +6096,7 @@ process_send_signal (process, signo, current_group, nomsg) #ifdef TIOCSIGSEND if (!NILP (current_group)) { - if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1) + if (ioctl (p->infd, TIOCSIGSEND, signo) == -1) EMACS_KILLPG (gid, signo); } else @@ -6173,10 +6162,10 @@ If PROCESS is a network process, inhibit handling of incoming traffic. */) p = XPROCESS (process); if (NILP (p->command) - && XINT (p->infd) >= 0) + && p->infd >= 0) { - FD_CLR (XINT (p->infd), &input_wait_mask); - FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); + FD_CLR (p->infd, &input_wait_mask); + FD_CLR (p->infd, &non_keyboard_wait_mask); } p->command = Qt; return process; @@ -6204,11 +6193,11 @@ If PROCESS is a network process, resume handling of incoming traffic. */) p = XPROCESS (process); if (EQ (p->command, Qt) - && XINT (p->infd) >= 0 + && p->infd >= 0 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten))) { - FD_SET (XINT (p->infd), &input_wait_mask); - FD_SET (XINT (p->infd), &non_keyboard_wait_mask); + FD_SET (p->infd, &input_wait_mask); + FD_SET (p->infd, &non_keyboard_wait_mask); } p->command = Qnil; return process; @@ -6405,7 +6394,7 @@ text to PROCESS after you call this function. */) return process; proc = get_process (process); - coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)]; + coding = proc_encode_coding_system[XPROCESS (proc)->outfd]; /* Make sure the process is really alive. */ if (XPROCESS (proc)->raw_status_new) @@ -6422,7 +6411,7 @@ text to PROCESS after you call this function. */) #ifdef VMS send_process (proc, "\032", 1, Qnil); /* ^z */ #else - if (!NILP (XPROCESS (proc)->pty_flag)) + if (XPROCESS (proc)->pty_flag) send_process (proc, "\004", 1, Qnil); else { @@ -6434,18 +6423,18 @@ text to PROCESS after you call this function. */) (In some old system, shutdown to socketpair doesn't work. Then we just can't win.) */ if (XPROCESS (proc)->pid == 0 - || XINT (XPROCESS (proc)->outfd) == XINT (XPROCESS (proc)->infd)) - shutdown (XINT (XPROCESS (proc)->outfd), 1); + || XPROCESS (proc)->outfd == XPROCESS (proc)->infd) + shutdown (XPROCESS (proc)->outfd, 1); /* In case of socketpair, outfd == infd, so don't close it. */ - if (XINT (XPROCESS (proc)->outfd) != XINT (XPROCESS (proc)->infd)) - emacs_close (XINT (XPROCESS (proc)->outfd)); + if (XPROCESS (proc)->outfd != XPROCESS (proc)->infd) + emacs_close (XPROCESS (proc)->outfd); #else /* not HAVE_SHUTDOWN */ - emacs_close (XINT (XPROCESS (proc)->outfd)); + emacs_close (XPROCESS (proc)->outfd); #endif /* not HAVE_SHUTDOWN */ new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0); if (new_outfd < 0) abort (); - old_outfd = XINT (XPROCESS (proc)->outfd); + old_outfd = XPROCESS (proc)->outfd; if (!proc_encode_coding_system[new_outfd]) proc_encode_coding_system[new_outfd] @@ -6456,7 +6445,7 @@ text to PROCESS after you call this function. */) bzero (proc_encode_coding_system[old_outfd], sizeof (struct coding_system)); - XSETINT (XPROCESS (proc)->outfd, new_outfd); + XPROCESS (proc)->outfd = new_outfd; } #endif /* VMS */ return process; @@ -6479,7 +6468,7 @@ kill_buffer_processes (buffer) { if (NETCONN_P (proc)) Fdelete_process (proc); - else if (XINT (XPROCESS (proc)->infd) >= 0) + else if (XPROCESS (proc)->infd >= 0) process_send_signal (proc, SIGHUP, Qnil, 1); } } @@ -6609,21 +6598,21 @@ sigchld_handler (signo) union { int i; WAITTYPE wt; } u; int clear_desc_flag = 0; - XSETINT (p->tick, ++process_tick); + p->tick = ++process_tick; u.wt = w; p->raw_status = u.i; p->raw_status_new = 1; /* If process has terminated, stop waiting for its output. */ if ((WIFSIGNALED (w) || WIFEXITED (w)) - && XINT (p->infd) >= 0) + && p->infd >= 0) clear_desc_flag = 1; /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */ if (clear_desc_flag) { - FD_CLR (XINT (p->infd), &input_wait_mask); - FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); + FD_CLR (p->infd, &input_wait_mask); + FD_CLR (p->infd, &non_keyboard_wait_mask); } /* Tell wait_reading_process_output that it needs to wake up and @@ -6800,18 +6789,18 @@ status_notify (deleting_process) proc = Fcdr (Fcar (tail)); p = XPROCESS (proc); - if (XINT (p->tick) != XINT (p->update_tick)) + if (p->tick != p->update_tick) { - XSETINT (p->update_tick, XINT (p->tick)); + p->update_tick = p->tick; /* If process is still active, read any output that remains. */ while (! EQ (p->filter, Qt) && ! EQ (p->status, Qconnect) && ! EQ (p->status, Qlisten) && ! EQ (p->command, Qt) /* Network process not stopped. */ - && XINT (p->infd) >= 0 + && p->infd >= 0 && p != deleting_process - && read_process_output (proc, XINT (p->infd)) > 0); + && read_process_output (proc, p->infd) > 0); buffer = p->buffer; @@ -6838,7 +6827,7 @@ status_notify (deleting_process) So set p->update_tick again so that an error in the sentinel will not cause this code to be run again. */ - XSETINT (p->update_tick, XINT (p->tick)); + p->update_tick = p->tick; /* Now output the message suitably. */ if (!NILP (p->sentinel)) exec_sentinel (proc, msg); @@ -6911,9 +6900,9 @@ encode subprocess input. */) CHECK_PROCESS (process); p = XPROCESS (process); - if (XINT (p->infd) < 0) + if (p->infd < 0) error ("Input file descriptor of %s closed", SDATA (p->name)); - if (XINT (p->outfd) < 0) + if (p->outfd < 0) error ("Output file descriptor of %s closed", SDATA (p->name)); Fcheck_coding_system (decoding); Fcheck_coding_system (encoding); @@ -6950,7 +6939,7 @@ suppressed. */) CHECK_PROCESS (process); p = XPROCESS (process); - p->filter_multibyte = flag; + p->filter_multibyte = !NILP (flag); setup_process_coding_systems (process); return Qnil; @@ -6967,7 +6956,7 @@ DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p, CHECK_PROCESS (process); p = XPROCESS (process); - return (NILP (p->filter_multibyte) ? Qnil : Qt); + return (p->filter_multibyte ? Qt : Qnil); } diff --git a/src/process.h b/src/process.h index 718d2a70ea8..fd7847b5e29 100644 --- a/src/process.h +++ b/src/process.h @@ -36,10 +36,6 @@ struct Lisp_Process { EMACS_INT size; struct Lisp_Vector *v_next; - /* Descriptor by which we read from this process */ - Lisp_Object infd; - /* Descriptor by which we write to this process */ - Lisp_Object outfd; /* Name of subprocess terminal. */ Lisp_Object tty_name; /* Name of this process */ @@ -64,61 +60,65 @@ struct Lisp_Process Lisp_Object plist; /* Marker set to end of last buffer-inserted output from this process */ Lisp_Object mark; - /* Non-nil means kill silently if Emacs is exited. - This is the inverse of the `query-on-exit' flag. */ - Lisp_Object kill_without_query; /* Symbol indicating status of process. This may be a symbol: run, open, or closed. Or it may be a list, whose car is stop, exit or signal and whose cdr is a pair (EXIT_CODE . COREDUMP_FLAG) or (SIGNAL_NUMBER . COREDUMP_FLAG). */ Lisp_Object status; - /* Non-nil if communicating through a pty. */ - Lisp_Object pty_flag; - /* Event-count of last event in which this process changed status. */ - Lisp_Object tick; - /* Event-count of last such event reported. */ - Lisp_Object update_tick; /* Coding-system for decoding the input from this process. */ Lisp_Object decode_coding_system; /* Working buffer for decoding. */ Lisp_Object decoding_buf; - /* Size of carryover in decoding. */ - Lisp_Object decoding_carryover; /* Coding-system for encoding the output to this process. */ Lisp_Object encode_coding_system; /* Working buffer for encoding. */ Lisp_Object encoding_buf; - /* Size of carryover in encoding. */ - Lisp_Object encoding_carryover; - /* Flag to set coding-system of the process buffer from the - coding_system used to decode process output. */ - Lisp_Object inherit_coding_system_flag; - /* Flat to decide the multibyteness of a string given to the - filter (if any). It is initialized to the value of - `default-enable-multibyte-characters' when the process is - generated, and can be changed by the function - `set-process-fileter-multibyte'. */ - Lisp_Object filter_multibyte; - /* Should we delay reading output from this process. - Initialized from `Vprocess_adaptive_read_buffering'. */ - Lisp_Object adaptive_read_buffering; - /* Hysteresis to try to read process output in larger blocks. - On some systems, e.g. GNU/Linux, Emacs is seen as - an interactive app also when reading process output, meaning - that process output can be read in as little as 1 byte at a - time. Value is micro-seconds to delay reading output from - this process. Range is 0 .. 50000. */ - Lisp_Object read_output_delay; - /* Skip reading this process on next read. */ - Lisp_Object read_output_skip; /* After this point, there are no Lisp_Objects any more. */ + /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ /* Number of this process. allocate_process assumes this is the first non-Lisp_Object field. A value 0 is used for pseudo-processes such as network connections. */ pid_t pid; + /* Descriptor by which we read from this process */ + int infd; + /* Descriptor by which we write to this process */ + int outfd; + /* Event-count of last event in which this process changed status. */ + int tick; + /* Event-count of last such event reported. */ + int update_tick; + /* Size of carryover in decoding. */ + int decoding_carryover; + /* Hysteresis to try to read process output in larger blocks. + On some systems, e.g. GNU/Linux, Emacs is seen as + an interactive app also when reading process output, meaning + that process output can be read in as little as 1 byte at a + time. Value is micro-seconds to delay reading output from + this process. Range is 0 .. 50000. */ + int read_output_delay; + /* Should we delay reading output from this process. + Initialized from `Vprocess_adaptive_read_buffering'. + 0 = nil, 1 = t, 2 = other. */ + int adaptive_read_buffering : 2; + /* Skip reading this process on next read. */ + int read_output_skip : 1; + /* Non-nil means kill silently if Emacs is exited. + This is the inverse of the `query-on-exit' flag. */ + int kill_without_query : 1; + /* Non-nil if communicating through a pty. */ + int pty_flag : 1; + /* Flag to set coding-system of the process buffer from the + coding_system used to decode process output. */ + int inherit_coding_system_flag : 1; + /* Flag to decide the multibyteness of a string given to the + filter (if any). It is initialized to the value of + `default-enable-multibyte-characters' when the process is + generated, and can be changed by the function + `set-process-filter-multibyte'. */ + int filter_multibyte : 1; /* Record the process status in the raw form in which it comes from `wait'. This is to avoid consing in a signal handler. The `raw_status_new' flag indicates that `raw_status' contains a new status that still diff --git a/src/search.c b/src/search.c index c9c6dfdd242..154f6c80e2d 100644 --- a/src/search.c +++ b/src/search.c @@ -92,6 +92,11 @@ Lisp_Object Qsearch_failed; Lisp_Object Vsearch_spaces_regexp; +/* If non-nil, the match data will not be changed during call to + searching or matching functions. This variable is for internal use + only. */ +Lisp_Object Vinhibit_changing_match_data; + static void set_search_regs (); static void save_search_regs (); static int simple_search (); @@ -321,7 +326,9 @@ looking_at_1 (string, posix) = current_buffer->case_eqv_table; CHECK_STRING (string); - bufp = compile_pattern (string, &search_regs, + bufp = compile_pattern (string, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL), (!NILP (current_buffer->case_fold_search) ? current_buffer->case_canon_table : Qnil), posix, @@ -352,7 +359,9 @@ looking_at_1 (string, posix) re_match_object = Qnil; i = re_match_2 (bufp, (char *) p1, s1, (char *) p2, s2, - PT_BYTE - BEGV_BYTE, &search_regs, + PT_BYTE - BEGV_BYTE, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL), ZV_BYTE - BEGV_BYTE); immediate_quit = 0; @@ -360,7 +369,7 @@ looking_at_1 (string, posix) matcher_overflow (); val = (0 <= i ? Qt : Qnil); - if (i >= 0) + if (NILP (Vinhibit_changing_match_data) && i >= 0) for (i = 0; i < search_regs.num_regs; i++) if (search_regs.start[i] >= 0) { @@ -369,7 +378,11 @@ looking_at_1 (string, posix) search_regs.end[i] = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); } - XSETBUFFER (last_thing_searched, current_buffer); + + /* Set last_thing_searched only when match data is changed. */ + if (NILP (Vinhibit_changing_match_data)) + XSETBUFFER (last_thing_searched, current_buffer); + return val; } @@ -431,7 +444,9 @@ string_match_1 (regexp, string, start, posix) XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] = current_buffer->case_eqv_table; - bufp = compile_pattern (regexp, &search_regs, + bufp = compile_pattern (regexp, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL), (!NILP (current_buffer->case_fold_search) ? current_buffer->case_canon_table : Qnil), posix, @@ -442,21 +457,27 @@ string_match_1 (regexp, string, start, posix) val = re_search (bufp, (char *) SDATA (string), SBYTES (string), pos_byte, SBYTES (string) - pos_byte, - &search_regs); + (NILP (Vinhibit_changing_match_data) + ? &search_regs : NULL)); immediate_quit = 0; - last_thing_searched = Qt; + + /* Set last_thing_searched only when match data is changed. */ + if (NILP (Vinhibit_changing_match_data)) + last_thing_searched = Qt; + if (val == -2) matcher_overflow (); if (val < 0) return Qnil; - for (i = 0; i < search_regs.num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] - = string_byte_to_char (string, search_regs.start[i]); - search_regs.end[i] - = string_byte_to_char (string, search_regs.end[i]); - } + if (NILP (Vinhibit_changing_match_data)) + for (i = 0; i < search_regs.num_regs; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] + = string_byte_to_char (string, search_regs.start[i]); + search_regs.end[i] + = string_byte_to_char (string, search_regs.end[i]); + } return make_number (string_byte_to_char (string, val)); } @@ -1074,6 +1095,11 @@ do \ } \ while (0) +/* Only used in search_buffer, to record the end position of the match + when searching regexps and SEARCH_REGS should not be changed + (i.e. Vinhibit_changing_match_data is non-nil). */ +static struct re_registers search_regs_1; + static int search_buffer (string, pos, pos_byte, lim, lim_byte, n, RE, trt, inverse_trt, posix) @@ -1109,7 +1135,10 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, int s1, s2; struct re_pattern_buffer *bufp; - bufp = compile_pattern (string, &search_regs, trt, posix, + bufp = compile_pattern (string, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : &search_regs_1), + trt, posix, !NILP (current_buffer->enable_multibyte_characters)); immediate_quit = 1; /* Quit immediately if user types ^G, @@ -1142,7 +1171,8 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, int val; val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos_byte - BEGV_BYTE, lim_byte - pos_byte, - &search_regs, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : &search_regs_1), /* Don't allow match past current point */ pos_byte - BEGV_BYTE); if (val == -2) @@ -1151,18 +1181,27 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, } if (val >= 0) { - pos_byte = search_regs.start[0] + BEGV_BYTE; - for (i = 0; i < search_regs.num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] - = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); - search_regs.end[i] - = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); - } - XSETBUFFER (last_thing_searched, current_buffer); - /* Set pos to the new position. */ - pos = search_regs.start[0]; + if (NILP (Vinhibit_changing_match_data)) + { + pos_byte = search_regs.start[0] + BEGV_BYTE; + for (i = 0; i < search_regs.num_regs; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] + = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); + search_regs.end[i] + = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); + } + XSETBUFFER (last_thing_searched, current_buffer); + /* Set pos to the new position. */ + pos = search_regs.start[0]; + } + else + { + pos_byte = search_regs_1.start[0] + BEGV_BYTE; + /* Set pos to the new position. */ + pos = BYTE_TO_CHAR (search_regs_1.start[0] + BEGV_BYTE); + } } else { @@ -1176,7 +1215,8 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, int val; val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos_byte - BEGV_BYTE, lim_byte - pos_byte, - &search_regs, + (NILP (Vinhibit_changing_match_data) + ? &search_regs : &search_regs_1), lim_byte - BEGV_BYTE); if (val == -2) { @@ -1184,17 +1224,25 @@ search_buffer (string, pos, pos_byte, lim, lim_byte, n, } if (val >= 0) { - pos_byte = search_regs.end[0] + BEGV_BYTE; - for (i = 0; i < search_regs.num_regs; i++) - if (search_regs.start[i] >= 0) - { - search_regs.start[i] - = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); - search_regs.end[i] - = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); - } - XSETBUFFER (last_thing_searched, current_buffer); - pos = search_regs.end[0]; + if (NILP (Vinhibit_changing_match_data)) + { + pos_byte = search_regs.end[0] + BEGV_BYTE; + for (i = 0; i < search_regs.num_regs; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] + = BYTE_TO_CHAR (search_regs.start[i] + BEGV_BYTE); + search_regs.end[i] + = BYTE_TO_CHAR (search_regs.end[i] + BEGV_BYTE); + } + XSETBUFFER (last_thing_searched, current_buffer); + pos = search_regs.end[0]; + } + else + { + pos_byte = search_regs_1.end[0] + BEGV_BYTE; + pos = BYTE_TO_CHAR (search_regs_1.end[0] + BEGV_BYTE); + } } else { @@ -1926,7 +1974,7 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, cursor += dirlen - i - direction; /* fix cursor */ if (i + direction == 0) { - int position; + int position, start, end; cursor -= direction; @@ -1934,11 +1982,24 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, ? 1 - len_byte : 0); set_search_regs (position, len_byte); + if (NILP (Vinhibit_changing_match_data)) + { + start = search_regs.start[0]; + end = search_regs.end[0]; + } + else + /* If Vinhibit_changing_match_data is non-nil, + search_regs will not be changed. So let's + compute start and end here. */ + { + start = BYTE_TO_CHAR (position); + end = BYTE_TO_CHAR (position + len_byte); + } + if ((n -= direction) != 0) cursor += dirlen; /* to resume search */ else - return ((direction > 0) - ? search_regs.end[0] : search_regs.start[0]); + return direction > 0 ? end : start; } else cursor += stride_for_teases; /* <sigh> we lose - */ @@ -2003,18 +2064,30 @@ boyer_moore (n, base_pat, len, len_byte, trt, inverse_trt, pos_byte += dirlen - i- direction; if (i + direction == 0) { - int position; + int position, start, end; pos_byte -= direction; position = pos_byte + ((direction > 0) ? 1 - len_byte : 0); - set_search_regs (position, len_byte); + if (NILP (Vinhibit_changing_match_data)) + { + start = search_regs.start[0]; + end = search_regs.end[0]; + } + else + /* If Vinhibit_changing_match_data is non-nil, + search_regs will not be changed. So let's + compute start and end here. */ + { + start = BYTE_TO_CHAR (position); + end = BYTE_TO_CHAR (position + len_byte); + } + if ((n -= direction) != 0) pos_byte += dirlen; /* to resume search */ else - return ((direction > 0) - ? search_regs.end[0] : search_regs.start[0]); + return direction > 0 ? end : start; } else pos_byte += stride_for_teases; @@ -2037,6 +2110,9 @@ set_search_regs (beg_byte, nbytes) { int i; + if (!NILP (Vinhibit_changing_match_data)) + return; + /* Make sure we have registers in which to store the match position. */ if (search_regs.num_regs == 0) @@ -3167,6 +3243,13 @@ or other such regexp constructs are not replaced with this. A value of nil (which is the normal value) means treat spaces literally. */); Vsearch_spaces_regexp = Qnil; + DEFVAR_LISP ("inhibit-changing-match-data", &Vinhibit_changing_match_data, + doc: /* Internal use only. +If non-nil, the match data will not be changed during call to searching or +matching functions, such as `looking-at', `string-match', `re-search-forward' +etc. */); + Vinhibit_changing_match_data = Qnil; + defsubr (&Slooking_at); defsubr (&Sposix_looking_at); defsubr (&Sstring_match); diff --git a/src/term.c b/src/term.c index 122eab91bdb..813fc29655c 100644 --- a/src/term.c +++ b/src/term.c @@ -27,7 +27,10 @@ Boston, MA 02110-1301, USA. */ #include <string.h> #include <errno.h> #include <sys/file.h> -#include <unistd.h> /* For isatty. */ + +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif #if HAVE_TERMIOS_H #include <termios.h> /* For TIOCNOTTY. */ @@ -2343,9 +2346,9 @@ the currently selected frame. */) void term_mouse_moveto (int x, int y) { + /* TODO: how to set mouse position? const char *name; int fd; - /* TODO: how to set mouse position? name = (const char *) ttyname (0); fd = open (name, O_WRONLY); SOME_FUNCTION (x, y, fd); @@ -2359,7 +2362,7 @@ term_show_mouse_face (enum draw_glyphs_face draw) { struct window *w = XWINDOW (Qmouse_face_window); int save_x, save_y; - int i, j; + int i; struct frame *f = XFRAME (w->frame); struct tty_display_info *tty = FRAME_TTY (f); @@ -2882,7 +2885,7 @@ int handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event, struct input_event* hold_quit) { struct frame *f = XFRAME (tty->top_frame); - int i, j, fd; + int fd; struct input_event ie; int do_help = 0; int count = 0; @@ -2906,7 +2909,7 @@ handle_one_term_event (struct tty_display_info *tty, Gpm_Event *event, struct in arg[1] = arg[3] = (unsigned short) event->y + gpm_zerobased; arg[4] = (unsigned short) 3; - name = (const char *) ttyname (0); + name = ttyname (0); fd = open (name, O_WRONLY); ioctl (fd, TIOCLINUX, buf + sizeof (short) - 1); close (fd); diff --git a/src/w32.c b/src/w32.c index 0ed462089d6..e8b152da76f 100644 --- a/src/w32.c +++ b/src/w32.c @@ -113,7 +113,7 @@ extern int w32_num_mouse_buttons; /* - Initialization states + Initialization states */ static BOOL g_b_init_is_windows_9x; static BOOL g_b_init_open_process_token; @@ -1143,7 +1143,9 @@ init_environment (char ** argv) { int dont_free = 0; - if ((lpval = w32_get_resource (env_vars[i].name, &dwType)) == NULL) + if ((lpval = w32_get_resource (env_vars[i].name, &dwType)) == NULL + /* Also ignore empty environment variables. */ + || *lpval == 0) { lpval = env_vars[i].def_value; dwType = REG_EXPAND_SZ; @@ -2514,7 +2516,7 @@ stat (const char * path, struct stat * buf) != INVALID_HANDLE_VALUE) { /* This is more accurate in terms of gettting the correct number - of links, but is quite slow (it is noticable when Emacs is + of links, but is quite slow (it is noticeable when Emacs is making a list of file name completions). */ BY_HANDLE_FILE_INFORMATION info; @@ -2999,7 +3001,7 @@ struct { WSAEINVALIDPROCTABLE , "Invalid procedure table from service provider", WSAEINVALIDPROVIDER , "Invalid service provider version number", WSAEPROVIDERFAILEDINIT , "Unable to initialize a service provider", - WSASYSCALLFAILURE , "System call failured", + WSASYSCALLFAILURE , "System call failure", WSASERVICE_NOT_FOUND , "Service not found", /* not sure */ WSATYPE_NOT_FOUND , "Class type not found", WSA_E_NO_MORE , "No more resources available", /* really not sure */ @@ -4198,7 +4200,7 @@ globals_of_w32 () SetConsoleCtrlHandler(shutdown_handler, TRUE); } -/* end of nt.c */ +/* end of w32.c */ /* arch-tag: 90442dd3-37be-482b-b272-ac752e3049f1 (do not change this comment) */ diff --git a/src/w32bdf.c b/src/w32bdf.c index 64ec2f7a3b0..40e705a18c9 100644 --- a/src/w32bdf.c +++ b/src/w32bdf.c @@ -302,7 +302,7 @@ w32_free_bdf_font(bdffont *fontp) font_char *pch; cache_bitmap *pcb; - UnmapViewOfFile(fontp->hfilemap); + UnmapViewOfFile(fontp->font); CloseHandle(fontp->hfilemap); CloseHandle(fontp->hfile); @@ -867,6 +867,7 @@ int w32_BDF_to_x_font (char *file, char* xstr, int len) retval = 1; } } + UnmapViewOfFile (font); CloseHandle (hfile); CloseHandle (hfilemap); return retval; diff --git a/src/w32fns.c b/src/w32fns.c index e76ca2ddc62..cacfa32c177 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -52,6 +52,7 @@ Boston, MA 02110-1301, USA. */ #include <shellapi.h> #include <ctype.h> #include <winspool.h> +#include <objbase.h> #include <dlgs.h> #define FILE_NAME_TEXT_FIELD edt1 @@ -2512,6 +2513,13 @@ w32_msg_pump (deferred_msg * msg_buf) /* Produced by complete_deferred_msg; just ignore. */ break; case WM_EMACS_CREATEWINDOW: + /* Initialize COM for this window. Even though we don't use it, + some third party shell extensions can cause it to be used in + system dialogs, which causes a crash if it is not initialized. + This is a known bug in Windows, which was fixed long ago, but + the patch for XP is not publically available until XP SP3, + and older versions will never be patched. */ + CoInitialize (NULL); w32_createwindow ((struct frame *) msg.wParam); if (!PostThreadMessage (dwMainThreadId, WM_EMACS_DONE, 0, 0)) abort (); @@ -3658,6 +3666,10 @@ w32_wnd_proc (hwnd, msg, wParam, lParam) my_post_msg (&wmsg, hwnd, msg, wParam, lParam); goto dflt; + case WM_DESTROY: + CoUninitialize (); + return 0; + case WM_CLOSE: wmsg.dwModifiers = w32_get_modifiers (); my_post_msg (&wmsg, hwnd, msg, wParam, lParam); diff --git a/src/w32menu.c b/src/w32menu.c index f86bfa3b7db..b92a57061ac 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -2292,29 +2292,53 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) /* Quote any special characters within the menu item's text and key binding. */ nlen = orig_len = strlen (out_string); - for (p = out_string; *p; p = _mbsinc (p)) - { - if (_mbsnextc (p) == '&') - nlen++; - } + if (unicode_append_menu) + { + /* With UTF-8, & cannot be part of a multibyte character. */ + for (p = out_string; *p; p++) + { + if (*p == '&') + nlen++; + } + } + else + { + /* If encoded with the system codepage, use multibyte string + functions in case of multibyte characters that contain '&'. */ + for (p = out_string; *p; p = _mbsinc (p)) + { + if (_mbsnextc (p) == '&') + nlen++; + } + } + if (nlen > orig_len) - { - p = out_string; - out_string = alloca (nlen + 1); - q = out_string; - while (*p) - { - if (_mbsnextc (p) == '&') - { - _mbsncpy (q, p, 1); - q = _mbsinc (q); - } - _mbsncpy (q, p, 1); - p = _mbsinc (p); - q = _mbsinc (q); - } - *q = '\0'; - } + { + p = out_string; + out_string = alloca (nlen + 1); + q = out_string; + while (*p) + { + if (unicode_append_menu) + { + if (*p == '&') + *q++ = *p; + *q++ = *p++; + } + else + { + if (_mbsnextc (p) == '&') + { + _mbsncpy (q, p, 1); + q = _mbsinc (q); + } + _mbsncpy (q, p, 1); + p = _mbsinc (p); + q = _mbsinc (q); + } + } + *q = '\0'; + } if (item != NULL) fuFlags = MF_POPUP; diff --git a/src/w32term.c b/src/w32term.c index 7173a5ed25a..a17fa2de918 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -218,10 +218,9 @@ extern int errno; extern EMACS_INT extra_keyboard_modifiers; static void x_update_window_end P_ ((struct window *, int, int)); -void w32_delete_display P_ ((struct w32_display_info *)); static void w32_handle_tool_bar_click P_ ((struct frame *, struct input_event *)); -void w32_define_cursor P_ ((Window, Cursor)); +static void w32_define_cursor P_ ((Window, Cursor)); void x_lower_frame P_ ((struct frame *)); void x_scroll_bar_clear P_ ((struct frame *)); @@ -3255,7 +3254,7 @@ redo_mouse_highlight () HIWORD (last_mouse_motion_event.lParam)); } -void +static void w32_define_cursor (window, cursor) Window window; Cursor cursor; diff --git a/src/window.c b/src/window.c index 70cb04fa63d..e5dd9b030d9 100644 --- a/src/window.c +++ b/src/window.c @@ -6645,7 +6645,7 @@ and the value of point and mark for each window. Also restore the choice of selected window. Also restore which buffer is current. Does not restore the value of point in current buffer. -usage: (save-window-excursion BODY ...) */) +usage: (save-window-excursion BODY...) */) (args) Lisp_Object args; { diff --git a/src/xdisp.c b/src/xdisp.c index 7c7fedeb0b8..ca6939109a9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -24153,7 +24153,7 @@ unselects the minibuffer if it is active. */); This dynamically changes the tool-bar's height to the minimum height that is needed to make all tool-bar items visible. If value is `grow-only', the tool-bar's height is only increased -automatically; to decreace the tool-bar height, use \\[recenter]. */); +automatically; to decrease the tool-bar height, use \\[recenter]. */); Vauto_resize_tool_bars = Qt; DEFVAR_BOOL ("auto-raise-tool-bar-buttons", &auto_raise_tool_bar_buttons_p, |