X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/dfcf069d565c347abf3cb7cec80e6ed8432037ba..ffa85ae7a58613248810a0cb2978b5763794672d:/src/keyboard.c diff --git a/src/keyboard.c b/src/keyboard.c index b6b0012763..6c25c3d99e 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1,5 +1,6 @@ /* Keyboard and mouse input; editor command loop. - Copyright (C) 1985,86,87,88,89,93,94,95,96,97 Free Software Foundation, Inc. + Copyright (C) 1985,86,87,88,89,93,94,95,96,97,99, 2000 + Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -18,16 +19,15 @@ along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ -/* Allow config.h to undefine symbols found here. */ -#include - #include +#include #include #include "termchar.h" #include "termopts.h" #include "lisp.h" #include "termhooks.h" #include "macros.h" +#include "keyboard.h" #include "frame.h" #include "window.h" #include "commands.h" @@ -35,11 +35,12 @@ Boston, MA 02111-1307, USA. */ #include "charset.h" #include "disptab.h" #include "dispextern.h" -#include "keyboard.h" #include "syntax.h" #include "intervals.h" #include "blockinput.h" #include "puresize.h" +#include "systime.h" +#include "atimer.h" #include #include @@ -55,6 +56,11 @@ Boston, MA 02111-1307, USA. */ #include "syssignal.h" #include "systty.h" +#include +#ifdef HAVE_UNISTD_H +#include +#endif + /* This is to get the definitions of the XK_ symbols. */ #ifdef HAVE_X_WINDOWS #include "xterm.h" @@ -67,7 +73,9 @@ Boston, MA 02111-1307, USA. */ /* Include systime.h after xterm.h to avoid double inclusion of time.h. */ #include "systime.h" +#ifndef USE_CRT_DLL extern int errno; +#endif /* Variables for blockinput.h: */ @@ -84,7 +92,12 @@ extern int input_fd; #ifdef HAVE_WINDOW_SYSTEM /* Make all keyboard buffers much bigger when using X windows. */ +#ifdef macintosh +/* But not too big (local data > 32K error) if on macintosh */ +#define KBD_BUFFER_SIZE 512 +#else #define KBD_BUFFER_SIZE 4096 +#endif #else /* No X-windows, character input */ #define KBD_BUFFER_SIZE 256 #endif /* No X-windows */ @@ -128,6 +141,22 @@ Lisp_Object recent_keys; /* A vector, holding the last 100 keystrokes */ Lisp_Object this_command_keys; int this_command_key_count; +/* This vector is used as a buffer to record the events that were actually read + by read_key_sequence. */ +Lisp_Object raw_keybuf; +int raw_keybuf_count; + +#define GROW_RAW_KEYBUF \ +if (raw_keybuf_count == XVECTOR (raw_keybuf)->size) \ + { \ + int newsize = 2 * XVECTOR (raw_keybuf)->size; \ + Lisp_Object new; \ + new = Fmake_vector (make_number (newsize), Qnil); \ + bcopy (XVECTOR (raw_keybuf)->contents, XVECTOR (new)->contents, \ + raw_keybuf_count * sizeof (Lisp_Object)); \ + raw_keybuf = new; \ + } + /* Number of elements of this_command_keys that precede this key sequence. */ int this_single_command_key_start; @@ -150,6 +179,11 @@ extern int message_enable_multibyte; extern struct backtrace *backtrace_list; +/* If non-nil, the function that implements the display of help. + It's called with one argument, the help string to display. */ + +Lisp_Object Vshow_help_function; + /* Nonzero means do menu prompting. */ static int menu_prompting; @@ -163,11 +197,25 @@ static jmp_buf getcjmp; int waiting_for_input; /* True while displaying for echoing. Delays C-g throwing. */ + static int echoing; -/* True means we can start echoing at the next input pause - even though there is something in the echo area. */ -static char *ok_to_echo_at_next_pause; +/* Non-null means we can start echoing at the next input pause even + though there is something in the echo area. */ + +static struct kboard *ok_to_echo_at_next_pause; + +/* The kboard last echoing, or null for none. Reset to 0 in + cancel_echoing. If non-null, and a current echo area message + exists, and echo_message_buffer is eq to the current message + buffer, we know that the message comes from echo_kboard. */ + +static struct kboard *echo_kboard; + +/* The buffer used for echoing. Set in echo_now, reset in + cancel_echoing. */ + +static Lisp_Object echo_message_buffer; /* Nonzero means disregard local maps for the menu bar. */ static int inhibit_local_menu_bar_menus; @@ -249,6 +297,14 @@ Lisp_Object last_input_char; /* If not Qnil, a list of objects to be read as subsequent command input. */ Lisp_Object Vunread_command_events; +/* If not Qnil, a list of objects to be read as subsequent command input + including input method processing. */ +Lisp_Object Vunread_input_method_events; + +/* If not Qnil, a list of objects to be read as subsequent command input + but NOT including input method processing. */ +Lisp_Object Vunread_post_input_method_events; + /* If not -1, an event to be read as subsequent command input. */ int unread_command_char; @@ -293,7 +349,10 @@ int last_auto_save; /* The command being executed by the command loop. Commands may set this, and the value set will be copied into current_kboard->Vlast_command instead of the actual command. */ -Lisp_Object this_command; +Lisp_Object Vthis_command; + +/* This is like Vthis_command, except that commands never set it. */ +Lisp_Object real_this_command; /* The value of point when the last command was executed. */ int last_point_position; @@ -327,6 +386,9 @@ Lisp_Object Qtimer_event_handler; key sequence that it reads. */ Lisp_Object read_key_sequence_cmd; +/* Echo unfinished commands after this many seconds of pause. */ +Lisp_Object Vecho_keystrokes; + /* Form to evaluate (if non-nil) when Emacs is started. */ Lisp_Object Vtop_level; @@ -340,6 +402,14 @@ extern Lisp_Object Vfunction_key_map; This one takes precedence over ordinary definitions. */ extern Lisp_Object Vkey_translation_map; +/* If non-nil, this implements the current input method. */ +Lisp_Object Vinput_method_function; +Lisp_Object Qinput_method_function; + +/* When we call Vinput_method_function, + this holds the echo area message that was just erased. */ +Lisp_Object Vinput_method_previous_message; + /* Non-nil means deactivate the mark at end of this command. */ Lisp_Object Vdeactivate_mark; @@ -368,6 +438,9 @@ Lisp_Object Vdeferred_action_list; Lisp_Object Vdeferred_action_function; Lisp_Object Qdeferred_action_function; +Lisp_Object Qinput_method_exit_on_first_char; +Lisp_Object Qinput_method_use_echo_area; + /* File in which we write all commands we read. */ FILE *dribble; @@ -382,9 +455,10 @@ int meta_key; extern char *pending_malloc_warning; /* Circular buffer for pre-read keyboard input. */ + static struct input_event kbd_buffer[KBD_BUFFER_SIZE]; -/* Vector to GCPRO the frames and windows mentioned in kbd_buffer. +/* Vector to GCPRO the Lisp objects referenced from kbd_buffer. The interrupt-level event handlers will never enqueue an event on a frame which is not in Vframe_list, and once an event is dequeued, @@ -403,14 +477,16 @@ static struct input_event kbd_buffer[KBD_BUFFER_SIZE]; Similar things happen when an event on a scroll bar is enqueued; the window may be deleted while the event is in the queue. - So, we use this vector to protect the frame_or_window field in the - event queue. That way, they'll be dequeued as dead frames or - windows, but still valid lisp objects. + So, we use this vector to protect the Lisp_Objects in the event + queue. That way, they'll be dequeued as dead frames or windows, + but still valid Lisp objects. If kbd_buffer[i].kind != no_event, then - (XVECTOR (kbd_buffer_frame_or_window)->contents[i] - == kbd_buffer[i].frame_or_window. */ -static Lisp_Object kbd_buffer_frame_or_window; + + AREF (kbd_buffer_gcpro, 2 * i) == kbd_buffer[i].frame_or_window. + AREF (kbd_buffer_gcpro, 2 * i + 1) == kbd_buffer[i].arg. */ + +static Lisp_Object kbd_buffer_gcpro; /* Pointer to next available character in kbd_buffer. If kbd_fetch_ptr == kbd_store_ptr, the buffer is empty. @@ -421,7 +497,7 @@ static struct input_event *kbd_fetch_ptr; /* Pointer to next place to store character in kbd_buffer. This may be kbd_buffer + KBD_BUFFER_SIZE, meaning that the next character should go in kbd_buffer[0]. */ -static volatile struct input_event *kbd_store_ptr; +static struct input_event * volatile kbd_store_ptr; /* The above pair of variables forms a "queue empty" flag. When we enqueue a non-hook event, we increment kbd_store_ptr. When we @@ -444,13 +520,16 @@ Lisp_Object Qswitch_frame; Lisp_Object Qdelete_frame; Lisp_Object Qiconify_frame; Lisp_Object Qmake_frame_visible; +Lisp_Object Qhelp_echo; /* Symbols to denote kinds of events. */ Lisp_Object Qfunction_key; Lisp_Object Qmouse_click; #ifdef WINDOWSNT Lisp_Object Qmouse_wheel; +Lisp_Object Qlanguage_change; #endif +Lisp_Object Qdrag_n_drop; /* Lisp_Object Qmouse_movement; - also an event header */ /* Properties of event headers. */ @@ -460,7 +539,8 @@ Lisp_Object Qevent_symbol_elements; /* menu item parts */ Lisp_Object Qmenu_alias; Lisp_Object Qmenu_enable; -Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCbutton, QCtoggle, QCradio; +Lisp_Object QCenable, QCvisible, QChelp, QCfilter, QCkeys, QCkey_sequence; +Lisp_Object QCbutton, QCtoggle, QCradio; extern Lisp_Object Vdefine_key_rebound_commands; extern Lisp_Object Qmenu_item; @@ -488,6 +568,8 @@ Lisp_Object Fthis_command_keys (); Lisp_Object Qextended_command_history; EMACS_TIME timer_check (); +extern Lisp_Object Vhistory_length; + extern char *x_get_keysym_name (); static void record_menu_key (); @@ -537,29 +619,51 @@ int flow_control; #ifdef HAVE_WINDOW_SYSTEM #define POLL_FOR_INPUT #endif + +/* After a command is executed, if point is moved into a region that + has specific properties (e.g. composition, display), we adjust + point to the boundary of the region. But, if a command sets this + valiable to non-nil, we suppress this point adjustment. This + variable is set to nil before reading a command. */ + +Lisp_Object Vdisable_point_adjustment; + +/* If non-nil, always disable point adjustment. */ + +Lisp_Object Vglobal_disable_point_adjustment; + /* Global variable declarations. */ /* Function for init_keyboard to call with no args (if nonzero). */ void (*keyboard_init_hook) (); -static int read_avail_input (); -static void get_input_pending (); -static int readable_events (); +static int read_avail_input P_ ((int)); +static void get_input_pending P_ ((int *, int)); +static int readable_events P_ ((int)); +static Lisp_Object read_char_x_menu_prompt P_ ((int, Lisp_Object *, + Lisp_Object, int *)); static Lisp_Object read_char_x_menu_prompt (); -static Lisp_Object read_char_minibuf_menu_prompt (); -static Lisp_Object make_lispy_event (); +static Lisp_Object read_char_minibuf_menu_prompt P_ ((int, int, + Lisp_Object *)); +static Lisp_Object make_lispy_event P_ ((struct input_event *)); #ifdef HAVE_MOUSE -static Lisp_Object make_lispy_movement (); +static Lisp_Object make_lispy_movement P_ ((struct frame *, Lisp_Object, + enum scroll_bar_part, + Lisp_Object, Lisp_Object, + unsigned long)); #endif -static Lisp_Object modify_event_symbol (); -static Lisp_Object make_lispy_switch_frame (); +static Lisp_Object modify_event_symbol P_ ((int, unsigned, Lisp_Object, + Lisp_Object, char **, + Lisp_Object *, unsigned)); +static Lisp_Object make_lispy_switch_frame P_ ((Lisp_Object)); +static int parse_solitary_modifier P_ ((Lisp_Object)); static int parse_solitary_modifier (); +static void save_getcjmp P_ ((jmp_buf)); static void save_getcjmp (); -static void restore_getcjmp (); - -/* > 0 if we are to echo keystrokes. */ -static int echo_keystrokes; +static void restore_getcjmp P_ ((jmp_buf)); +static Lisp_Object apply_modifiers P_ ((int, Lisp_Object)); +static void clear_event P_ ((struct input_event *)); /* Nonzero means don't try to suspend even if the operating system seems to support it. */ @@ -611,7 +715,8 @@ echo_char (c) if (INTEGERP (c)) { - if (ptr - current_kboard->echobuf > ECHOBUFSIZE - 6) + if (ptr - current_kboard->echobuf + > ECHOBUFSIZE - KEY_DESCRIPTION_SIZE) return; ptr = push_key_description (XINT (c), ptr); @@ -690,9 +795,12 @@ echo_now () echoing = 1; message2_nolog (current_kboard->echobuf, strlen (current_kboard->echobuf), ! NILP (current_buffer->enable_multibyte_characters)); - echoing = 0; + /* Record in what buffer we echoed, and from which kboard. */ + echo_message_buffer = echo_area_buffer[0]; + echo_kboard = current_kboard; + if (waiting_for_input && !NILP (Vquit_flag)) quit_throw_to_read_char (); } @@ -705,7 +813,9 @@ cancel_echoing () current_kboard->immediate_echo = 0; current_kboard->echoptr = current_kboard->echobuf; current_kboard->echo_after_prompt = -1; - ok_to_echo_at_next_pause = 0; + ok_to_echo_at_next_pause = NULL; + echo_kboard = NULL; + echo_message_buffer = Qnil; } /* Return the length of the current echo string. */ @@ -775,6 +885,14 @@ recursive_edit_1 () specbind (Qstandard_input, Qt); } +#ifdef HAVE_X_WINDOWS + /* The command loop has started a busy-cursor timer, so we have to + cancel it here, otherwise it will fire because the recursive edit + can take some time. */ + if (display_busy_cursor_p) + cancel_busy_cursor (); +#endif + val = command_loop (); if (EQ (val, Qt)) Fsignal (Qquit, Qnil); @@ -813,7 +931,6 @@ This function is called by the editor initialization to begin editing.") () { int count = specpdl_ptr - specpdl; - Lisp_Object val; command_loop_level++; update_mode_lines = 1; @@ -935,6 +1052,7 @@ cmd_error (data) Vexecuting_macro = Qnil; executing_macro = Qnil; current_kboard->Vprefix_arg = Qnil; + current_kboard->Vlast_prefix_arg = Qnil; cancel_echoing (); /* Avoid unquittable loop if data contains a circular list. */ @@ -970,17 +1088,27 @@ cmd_error_internal (data, context) char *context; { Lisp_Object stream; + int kill_emacs_p = 0; + struct frame *sf = SELECTED_FRAME (); Vquit_flag = Qnil; Vinhibit_quit = Qt; - echo_area_glyphs = 0; + clear_message (1, 0); /* If the window system or terminal frame hasn't been initialized yet, or we're not interactive, it's best to dump this message out to stderr and exit. */ - if (! FRAME_MESSAGE_BUF (selected_frame) + if (!sf->glyphs_initialized_p + /* This is the case of the frame dumped with Emacs, when we're + running under a window system. */ + || (!NILP (Vwindow_system) + && !inhibit_window_system + && FRAME_TERMCAP_P (sf)) || noninteractive) - stream = Qexternal_debugging_output; + { + stream = Qexternal_debugging_output; + kill_emacs_p = 1; + } else { Fdiscard_input (); @@ -995,8 +1123,7 @@ cmd_error_internal (data, context) /* If the window system or terminal frame hasn't been initialized yet, or we're in -batch mode, this error should cause Emacs to exit. */ - if (! FRAME_MESSAGE_BUF (selected_frame) - || noninteractive) + if (kill_emacs_p) { Fterpri (stream); Fkill_emacs (make_number (-1)); @@ -1016,13 +1143,17 @@ command_loop () { if (command_loop_level > 0 || minibuf_level > 0) { - return internal_catch (Qexit, command_loop_2, Qnil); + Lisp_Object val; + val = internal_catch (Qexit, command_loop_2, Qnil); + executing_macro = Qnil; + return val; } else while (1) { internal_catch (Qtop_level, top_level_1, Qnil); internal_catch (Qtop_level, command_loop_2, Qnil); + executing_macro = Qnil; /* End of file in -batch run causes exit here. */ if (noninteractive) @@ -1071,6 +1202,10 @@ DEFUN ("top-level", Ftop_level, Stop_level, 0, 0, "", "Exit all recursive editing levels.") () { +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + cancel_busy_cursor (); +#endif Fthrow (Qtop_level, Qnil); } @@ -1100,16 +1235,16 @@ DEFUN ("abort-recursive-edit", Fabort_recursive_edit, Sabort_recursive_edit, 0, Lisp_Object Fcommand_execute (); static int read_key_sequence (); void safe_run_hooks (); +static void adjust_point_for_property (); Lisp_Object command_loop_1 () { - Lisp_Object cmd, tem; - int lose, lose2; + Lisp_Object cmd; + int lose; int nonundocount; Lisp_Object keybuf[30]; int i; - int no_redisplay; int no_direct; int prev_modiff; struct buffer *prev_buffer; @@ -1118,12 +1253,12 @@ command_loop_1 () #endif current_kboard->Vprefix_arg = Qnil; + current_kboard->Vlast_prefix_arg = Qnil; Vdeactivate_mark = Qnil; waiting_for_input = 0; cancel_echoing (); nonundocount = 0; - no_redisplay = 0; this_command_key_count = 0; this_single_command_key_start = 0; @@ -1134,22 +1269,33 @@ command_loop_1 () if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks)) safe_run_hooks (Qpost_command_hook); + /* If displaying a message, resize the echo area window to fit + that message's size exactly. */ + if (!NILP (echo_area_buffer[0])) + resize_echo_area_axactly (); + if (!NILP (Vdeferred_action_list)) call0 (Vdeferred_action_function); if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks)) { if (NILP (Vunread_command_events) + && NILP (Vunread_input_method_events) + && NILP (Vunread_post_input_method_events) && NILP (Vexecuting_macro) && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1))) safe_run_hooks (Qpost_command_idle_hook); } /* Do this after running Vpost_command_hook, for consistency. */ - current_kboard->Vlast_command = this_command; + current_kboard->Vlast_command = Vthis_command; + current_kboard->Vreal_last_command = real_this_command; while (1) { + if (! FRAME_LIVE_P (XFRAME (selected_frame))) + Fkill_emacs (Qnil); + /* Make sure the current window's buffer is selected. */ if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer)); @@ -1167,7 +1313,8 @@ command_loop_1 () /* If minibuffer on and echo area in use, wait 2 sec and redraw minibuffer. */ - if (minibuf_level && echo_area_glyphs + if (minibuf_level + && !NILP (echo_area_buffer[0]) && EQ (minibuf_window, echo_area_window)) { /* Bind inhibit-quit to t so that C-g gets read in @@ -1201,7 +1348,7 @@ command_loop_1 () code swallows a switch-frame event, we'll fix things up here. Is this a good idea? */ if (FRAMEP (internal_last_event_frame) - && XFRAME (internal_last_event_frame) != selected_frame) + && !EQ (internal_last_event_frame, selected_frame)) Fselect_frame (internal_last_event_frame, Qnil); #endif /* If it has changed current-menubar from previous value, @@ -1213,13 +1360,16 @@ command_loop_1 () before_command_key_count = this_command_key_count; before_command_echo_length = echo_length (); - this_command = Qnil; + Vthis_command = Qnil; + real_this_command = Qnil; /* Read next key sequence; i gets its length. */ i = read_key_sequence (keybuf, sizeof keybuf / sizeof keybuf[0], Qnil, 0, 1, 1); /* A filter may have run while we were reading the input. */ + if (! FRAME_LIVE_P (XFRAME (selected_frame))) + Fkill_emacs (Qnil); if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) set_buffer_internal (XBUFFER (XWINDOW (selected_window)->buffer)); @@ -1249,8 +1399,10 @@ command_loop_1 () update the whole window properly. */ if (!NILP (XWINDOW (selected_window)->force_start)) { + struct buffer *b; XWINDOW (selected_window)->force_start = Qnil; - beg_unchanged = end_unchanged = 0; + b = XBUFFER (XWINDOW (selected_window)->buffer); + BUF_BEG_UNCHANGED (b) = BUF_END_UNCHANGED (b) = 0; } cmd = read_key_sequence_cmd; @@ -1265,26 +1417,28 @@ command_loop_1 () } /* Do redisplay processing after this command except in special - cases identified below that set no_redisplay to 1. - (actually, there's currently no way to prevent the redisplay, - and no_redisplay is ignored. - Perhaps someday we will really implement it.) */ - no_redisplay = 0; - + cases identified below. */ prev_buffer = current_buffer; prev_modiff = MODIFF; last_point_position = PT; XSETBUFFER (last_point_position_buffer, prev_buffer); + /* By default, we adjust point to a boundary of a region that + has such a property that should be treated intangible + (e.g. composition, display). But, some commands will set + this variable differently. */ + Vdisable_point_adjustment = Qnil; + /* Execute the command. */ - this_command = cmd; + Vthis_command = cmd; + real_this_command = cmd; /* Note that the value cell will never directly contain nil if the symbol is a local variable. */ if (!NILP (Vpre_command_hook) && !NILP (Vrun_hooks)) safe_run_hooks (Qpre_command_hook); - - if (NILP (this_command)) + + if (NILP (Vthis_command)) { /* nil means key is undefined. */ bitch_at_user (); @@ -1296,13 +1450,16 @@ command_loop_1 () { if (NILP (current_kboard->Vprefix_arg) && ! no_direct) { + /* In case we jump to directly_done. */ + Vcurrent_prefix_arg = current_kboard->Vprefix_arg; + /* Recognize some common commands in common situations and do them directly. */ - if (EQ (this_command, Qforward_char) && PT < ZV) + if (EQ (Vthis_command, Qforward_char) && PT < ZV) { struct Lisp_Char_Table *dp = window_display_table (XWINDOW (selected_window)); - lose = FETCH_BYTE (PT_BYTE); + lose = FETCH_CHAR (PT_BYTE); SET_PT (PT + 1); if ((dp ? (VECTORP (DISP_CHAR_VECTOR (dp, lose)) @@ -1324,15 +1481,15 @@ command_loop_1 () && !detect_input_pending () && NILP (XWINDOW (selected_window)->column_number_displayed) && NILP (Vexecuting_macro)) - no_redisplay = direct_output_forward_char (1); + direct_output_forward_char (1); goto directly_done; } - else if (EQ (this_command, Qbackward_char) && PT > BEGV) + else if (EQ (Vthis_command, Qbackward_char) && PT > BEGV) { struct Lisp_Char_Table *dp = window_display_table (XWINDOW (selected_window)); SET_PT (PT - 1); - lose = FETCH_BYTE (PT_BYTE); + lose = FETCH_CHAR (PT_BYTE); if ((dp ? (VECTORP (DISP_CHAR_VECTOR (dp, lose)) ? XVECTOR (DISP_CHAR_VECTOR (dp, lose))->size == 1 @@ -1350,16 +1507,15 @@ command_loop_1 () && !detect_input_pending () && NILP (XWINDOW (selected_window)->column_number_displayed) && NILP (Vexecuting_macro)) - no_redisplay = direct_output_forward_char (-1); + direct_output_forward_char (-1); goto directly_done; } - else if (EQ (this_command, Qself_insert_command) + else if (EQ (Vthis_command, Qself_insert_command) /* Try this optimization only on ascii keystrokes. */ && INTEGERP (last_command_char)) { unsigned int c = XINT (last_command_char); int value; - if (NILP (Vexecuting_macro) && !EQ (minibuf_window, selected_window)) { @@ -1370,6 +1526,7 @@ command_loop_1 () } nonundocount++; } + lose = ((XFASTINT (XWINDOW (selected_window)->last_modified) < MODIFF) || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified) @@ -1382,77 +1539,59 @@ command_loop_1 () || detect_input_pending () || !NILP (XWINDOW (selected_window)->column_number_displayed) || !NILP (Vexecuting_macro)); + value = internal_self_insert (c, 0); - if (value) - lose = 1; + if (value == 2) nonundocount = 0; - if (!lose - && (PT == ZV || FETCH_BYTE (PT_BYTE) == '\n')) - { - struct Lisp_Char_Table *dp - = window_display_table (XWINDOW (selected_window)); - int lose = c; - - /* Add the offset to the character, for Finsert_char. - We pass internal_self_insert the unmodified character - because it itself does this offsetting. */ - if (! NILP (current_buffer->enable_multibyte_characters)) - lose = unibyte_char_to_multibyte (lose); - - if (dp) - { - Lisp_Object obj; - - obj = DISP_CHAR_VECTOR (dp, lose); - if (NILP (obj)) - { - /* Do it only for char codes - that by default display as themselves. */ - if (lose >= 0x20 && lose <= 0x7e) - no_redisplay = direct_output_for_insert (lose); - } - else if (VECTORP (obj) - && XVECTOR (obj)->size == 1 - && (obj = XVECTOR (obj)->contents[0], - INTEGERP (obj)) - /* Insist face not specified in glyph. */ - && (XINT (obj) & ((-1) << 8)) == 0) - no_redisplay - = direct_output_for_insert (XINT (obj)); - } - else - { - if (lose >= 0x20 && lose <= 0x7e) - no_redisplay = direct_output_for_insert (lose); - } - } + /* VALUE == 1 when AFTER-CHANGE functions are + installed which is the case most of the time + because FONT-LOCK installs one. */ + if (!lose && !value) + direct_output_for_insert (c); goto directly_done; } } /* Here for a command that isn't executed directly */ +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + start_busy_cursor (); +#endif + nonundocount = 0; if (NILP (current_kboard->Vprefix_arg)) Fundo_boundary (); - Fcommand_execute (this_command, Qnil, Qnil, Qnil); + Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil); +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + cancel_busy_cursor (); +#endif } directly_done: ; + current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg; /* Note that the value cell will never directly contain nil if the symbol is a local variable. */ if (!NILP (Vpost_command_hook) && !NILP (Vrun_hooks)) safe_run_hooks (Qpost_command_hook); + /* If displaying a message, resize the echo area window to fit + that message's size exactly. */ + if (!NILP (echo_area_buffer[0])) + resize_echo_area_axactly (); + if (!NILP (Vdeferred_action_list)) safe_run_hooks (Qdeferred_action_function); if (!NILP (Vpost_command_idle_hook) && !NILP (Vrun_hooks)) { if (NILP (Vunread_command_events) + && NILP (Vunread_input_method_events) + && NILP (Vunread_post_input_method_events) && NILP (Vexecuting_macro) && !NILP (sit_for (0, post_command_idle_delay, 0, 1, 1))) safe_run_hooks (Qpost_command_idle_hook); @@ -1473,7 +1612,8 @@ command_loop_1 () then the above doesn't apply. */ if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_char)) { - current_kboard->Vlast_command = this_command; + current_kboard->Vlast_command = Vthis_command; + current_kboard->Vreal_last_command = real_this_command; cancel_echoing (); this_command_key_count = 0; this_single_command_key_start = 0; @@ -1491,6 +1631,13 @@ command_loop_1 () } finalize: + + if (current_buffer == prev_buffer + && last_point_position != PT + && NILP (Vdisable_point_adjustment) + && NILP (Vglobal_disable_point_adjustment)) + adjust_point_for_property (last_point_position); + /* Install chars successfully executed in kbd macro. */ if (!NILP (current_kboard->defining_kbd_macro) @@ -1504,6 +1651,54 @@ command_loop_1 () } } +extern Lisp_Object Qcomposition, Qdisplay; + +/* Adjust point to a boundary of a region that has such a property + that should be treated intangible. For the moment, we check + `composition' and `display' property. LAST_PT is the last position + of point. */ + +static void +adjust_point_for_property (last_pt) + int last_pt; +{ + int start, end; + Lisp_Object val; + int check_composition = 1, check_display = 1; + + while (check_composition || check_display) + { + if (check_composition + && PT > BEGV && PT < ZV + && get_property_and_range (PT, Qcomposition, &val, &start, &end, Qnil) + && COMPOSITION_VALID_P (start, end, val) + && start < PT && end > PT + && (last_pt <= start || last_pt >= end)) + { + if (PT < last_pt) + SET_PT (start); + else + SET_PT (end); + check_display = 1; + } + check_composition = 0; + if (check_display + && PT > BEGV && PT < ZV + && get_property_and_range (PT, Qdisplay, &val, &start, &end, Qnil) + && display_prop_intangible_p (val) + && start < PT && end > PT + && (last_pt <= start || last_pt >= end)) + { + if (PT < last_pt) + SET_PT (start); + else + SET_PT (end); + check_composition = 1; + } + check_display = 0; + } +} + /* Subroutine for safe_run_hooks: run the hook HOOK. */ static Lisp_Object @@ -1519,7 +1714,7 @@ static Lisp_Object safe_run_hooks_error (data) Lisp_Object data; { - Fset (Vinhibit_quit, Qnil); + return Fset (Vinhibit_quit, Qnil); } /* If we get an error while running the hook, cause the hook variable @@ -1530,7 +1725,6 @@ void safe_run_hooks (hook) Lisp_Object hook; { - Lisp_Object value; int count = specpdl_ptr - specpdl; specbind (Qinhibit_quit, hook); @@ -1538,37 +1732,48 @@ safe_run_hooks (hook) unbind_to (count, Qnil); } + -/* Number of seconds between polling for input. */ +/* Number of seconds between polling for input. This is a Lisp + variable that can be bound. */ + int polling_period; /* Nonzero means polling for input is temporarily suppressed. */ + int poll_suppress_count; -/* Nonzero if polling_for_input is actually being used. */ -int polling_for_input; +/* Asynchronous timer for polling. */ + +struct atimer *poll_timer; + #ifdef POLL_FOR_INPUT -/* Handle an alarm once each second and read pending input - so as to handle a C-g if it comces in. */ +/* Poll for input, so what we catch a C-g if it comes in. This + function is called from x_make_frame_visible, see comment + there. */ -SIGTYPE -input_poll_signal (signalnum) /* If we don't have an argument, */ - int signalnum; /* some compilers complain in signal calls. */ +void +poll_for_input_1 () { - /* This causes the call to start_polling at the end - to do its job. It also arranges for a quit or error - from within read_avail_input to resume polling. */ - poll_suppress_count++; if (interrupt_input_blocked == 0 && !waiting_for_input) read_avail_input (0); - /* Turn on the SIGALRM handler and request another alarm. */ - start_polling (); } -#endif +/* Timer callback function for poll_timer. TIMER is equal to + poll_timer. */ + +void +poll_for_input (timer) + struct atimer *timer; +{ + if (poll_suppress_count == 0) + poll_for_input_1 (); +} + +#endif /* POLL_FOR_INPUT */ /* Begin signals to poll for input, if they are appropriate. This function is called unconditionally from various places. */ @@ -1579,13 +1784,28 @@ start_polling () #ifdef POLL_FOR_INPUT if (read_socket_hook && !interrupt_input) { - poll_suppress_count--; - if (poll_suppress_count == 0) + /* Turn alarm handling on unconditionally. It might have + been turned off in process.c. */ + turn_on_atimers (1); + + /* If poll timer doesn't exist, are we need one with + a different interval, start a new one. */ + if (poll_timer == NULL + || EMACS_SECS (poll_timer->interval) != polling_period) { - signal (SIGALRM, input_poll_signal); - polling_for_input = 1; - alarm (polling_period); + EMACS_TIME interval; + + if (poll_timer) + cancel_atimer (poll_timer); + + EMACS_SET_SECS_USECS (interval, polling_period, 0); + poll_timer = start_atimer (ATIMER_CONTINUOUS, interval, + poll_for_input, NULL); } + + /* Let the timer's callback function poll for input + if this becomes zero. */ + --poll_suppress_count; } #endif } @@ -1609,14 +1829,7 @@ stop_polling () { #ifdef POLL_FOR_INPUT if (read_socket_hook && !interrupt_input) - { - if (poll_suppress_count == 0) - { - polling_for_input = 0; - alarm (0); - } - poll_suppress_count++; - } + ++poll_suppress_count; #endif } @@ -1654,6 +1867,7 @@ bind_polling_period (n) if (n > new) new = n; + stop_other_atimers (poll_timer); stop_polling (); specbind (Qpolling_period, make_number (new)); /* Start a new alarm with the new period. */ @@ -1699,6 +1913,82 @@ make_ctrl_char (c) return c; } +/* Display help echo in the echo area. + + HELP a string means display that string, HELP nil means clear the + help echo. If HELP is a function, call it with OBJECT and POS as + arguments; the function should return a help string or nil for + none. For all other types of HELP evaluate it to obtain a string. + + WINDOW is the window in which the help was generated, if any. + It is nil if not in a window. + + If OBJECT is a buffer, POS is the position in the buffer where the + `help-echo' text property was found. + + If OBJECT is an overlay, that overlay has a `help-echo' property, + and POS is the position in the overlay's buffer under the mouse. + + If OBJECT is a string (an overlay string or a string displayed with + the `display' property). POS is the position in that string under + the mouse. + + OK_TO_IVERWRITE_KEYSTROKE_ECHO non-zero means it's okay if the help + echo overwrites a keystroke echo currently displayed in the echo + area. + + Note: this function may only be called with HELP nil or a string + from X code running asynchronously. */ + +void +show_help_echo (help, window, object, pos, ok_to_overwrite_keystroke_echo) + Lisp_Object help, window, object, pos; + int ok_to_overwrite_keystroke_echo; +{ + if (!NILP (help) && !STRINGP (help)) + { + if (FUNCTIONP (help)) + { + Lisp_Object args[4]; + args[0] = help; + args[1] = window; + args[2] = object; + args[3] = pos; + help = call_function (4, args); + } + else + help = eval_form (help); + + if (!STRINGP (help)) + return; + } + + if (STRINGP (help) || NILP (help)) + { + if (!NILP (Vshow_help_function)) + call1 (Vshow_help_function, help); + else if (/* Don't overwrite minibuffer contents. */ + !MINI_WINDOW_P (XWINDOW (selected_window)) + /* Don't overwrite a keystroke echo. */ + && (NILP (echo_message_buffer) + || ok_to_overwrite_keystroke_echo) + /* Don't overwrite a prompt. */ + && !cursor_in_echo_area) + { + if (STRINGP (help)) + { + int count = specpdl_ptr - specpdl; + specbind (Qmessage_truncate_lines, Qt); + message3_nolog (help, XSTRING (help)->size, + STRING_MULTIBYTE (help)); + unbind_to (count, Qnil); + } + else + message (0); + } + } +} + /* Input of single characters from keyboard */ @@ -1720,7 +2010,10 @@ static jmp_buf wrong_kboard_jmpbuf; MAPS is an array of keymaps; NMAPS is the length of MAPS. PREV_EVENT is the previous input event, or nil if we are reading - the first event of a key sequence. + the first event of a key sequence (or not reading a key sequence). + If PREV_EVENT is t, that is a "magic" value that says + not to run input methods, but in other respects to act as if + not reading a key sequence. If USED_MOUSE_MENU is non-null, then we set *USED_MOUSE_MENU to 1 if we used a mouse menu to read the input, or zero otherwise. If @@ -1742,35 +2035,38 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) jmp_buf save_jump; int key_already_recorded = 0; Lisp_Object tem, save; + Lisp_Object previous_echo_area_message; Lisp_Object also_record; - struct gcpro gcpro1; + int reread; + struct gcpro gcpro1, gcpro2; also_record = Qnil; before_command_key_count = this_command_key_count; before_command_echo_length = echo_length (); c = Qnil; + previous_echo_area_message = Qnil; - GCPRO1 (c); + GCPRO2 (c, previous_echo_area_message); retry: - if (CONSP (Vunread_command_events)) + reread = 0; + if (CONSP (Vunread_post_input_method_events)) { - c = XCONS (Vunread_command_events)->car; - Vunread_command_events = XCONS (Vunread_command_events)->cdr; + c = XCAR (Vunread_post_input_method_events); + Vunread_post_input_method_events + = XCDR (Vunread_post_input_method_events); /* Undo what read_char_x_menu_prompt did when it unread additional keys returned by Fx_popup_menu. */ if (CONSP (c) - && (SYMBOLP (XCONS (c)->car) || INTEGERP (XCONS (c)->car)) - && NILP (XCONS (c)->cdr)) - c = XCONS (c)->car; + && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))) + && NILP (XCDR (c))) + c = XCAR (c); - if (this_command_key_count == 0) - goto reread_first; - else - goto reread; + reread = 1; + goto reread_first; } if (unread_command_char != -1) @@ -1778,10 +2074,39 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) XSETINT (c, unread_command_char); unread_command_char = -1; - if (this_command_key_count == 0) - goto reread_first; - else - goto reread; + reread = 1; + goto reread_first; + } + + if (CONSP (Vunread_command_events)) + { + c = XCAR (Vunread_command_events); + Vunread_command_events = XCDR (Vunread_command_events); + + /* Undo what read_char_x_menu_prompt did when it unread + additional keys returned by Fx_popup_menu. */ + if (CONSP (c) + && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))) + && NILP (XCDR (c))) + c = XCAR (c); + + reread = 1; + goto reread_for_input_method; + } + + if (CONSP (Vunread_input_method_events)) + { + c = XCAR (Vunread_input_method_events); + Vunread_input_method_events = XCDR (Vunread_input_method_events); + + /* Undo what read_char_x_menu_prompt did when it unread + additional keys returned by Fx_popup_menu. */ + if (CONSP (c) + && (SYMBOLP (XCAR (c)) || INTEGERP (XCAR (c))) + && NILP (XCDR (c))) + c = XCAR (c); + reread = 1; + goto reread_for_input_method; } /* If there is no function key translated before @@ -1828,29 +2153,72 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) unread_switch_frame = Qnil; /* This event should make it into this_command_keys, and get echoed - again, so we go to reread_first, rather than reread. */ + again, so we do not set `reread'. */ goto reread_first; } + /* if redisplay was requested */ if (commandflag >= 0) { + /* If there is pending input, process any events which are not + user-visible, such as X selection_request events. */ if (input_pending || detect_input_pending_run_timers (0)) - swallow_events (0); + swallow_events (0); /* may clear input_pending */ - if (!input_pending) - redisplay (); + /* Redisplay if no pending input. */ + while (!input_pending) + { + redisplay (); + + if (!input_pending) + /* Normal case: no input arrived during redisplay. */ + break; + + /* Input arrived and pre-empted redisplay. + Process any events which are not user-visible. */ + swallow_events (0); + /* If that cleared input_pending, try again to redisplay. */ + } } - /* Message turns off echoing unless more keystrokes turn it on again. */ - if (echo_area_glyphs && *echo_area_glyphs - && echo_area_glyphs != current_kboard->echobuf - && ok_to_echo_at_next_pause != echo_area_glyphs) + /* Message turns off echoing unless more keystrokes turn it on again. + + The code in 20.x for the condition was + + 1. echo_area_glyphs && *echo_area_glyphs + 2. && echo_area_glyphs != current_kboard->echobuf + 3. && ok_to_echo_at_next_pause != echo_area_glyphs + + (1) means there's a current message displayed + + (2) means it's not the message from echoing from the current + kboard. + + (3) There's only one place in 20.x where ok_to_echo_at_next_pause + is set to a non-null value. This is done in read_char and it is + set to echo_area_glyphs after a call to echo_char. That means + ok_to_echo_at_next_pause is either null or + current_kboard->echobuf with the appropriate current_kboard at + that time. + + So, condition (3) means in clear text ok_to_echo_at_next_pause + must be either null, or the current message isn't from echoing at + all, or it's from echoing from a different kboard than the + current one. */ + + if (/* There currently something in the echo area */ + !NILP (echo_area_buffer[0]) + && (/* And it's either not from echoing. */ + !EQ (echo_area_buffer[0], echo_message_buffer) + /* Or it's an echo from a different kboard. */ + || echo_kboard != current_kboard + /* Or we explicitly allow overwriting whatever there is. */ + || ok_to_echo_at_next_pause == NULL)) cancel_echoing (); else - /* If already echoing, continue. */ echo_dash (); - + /* Try reading a character via menu prompting in the minibuf. Try this before the sit-for, because the sit-for would do the wrong thing if we are supposed to do @@ -1881,7 +2249,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (_setjmp (local_getcjmp)) { XSETINT (c, quit_char); - XSETFRAME (internal_last_event_frame, selected_frame); + internal_last_event_frame = selected_frame; Vlast_event_frame = internal_last_event_frame; /* If we report the quit char as an event, don't do so more than once. */ @@ -1890,7 +2258,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) #ifdef MULTI_KBOARD { - KBOARD *kb = FRAME_KBOARD (selected_frame); + KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame)); if (kb != current_kboard) { Lisp_Object *tailp = &kb->kbd_queue; @@ -1898,7 +2266,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (single_kboard) abort (); while (CONSP (*tailp)) - tailp = &XCONS (*tailp)->cdr; + tailp = &XCDR (*tailp); if (!NILP (*tailp)) abort (); *tailp = Fcons (c, Qnil); @@ -1919,15 +2287,24 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* If in middle of key sequence and minibuffer not active, start echoing if enough time elapses. */ - if (minibuf_level == 0 && !current_kboard->immediate_echo + if (minibuf_level == 0 + && !current_kboard->immediate_echo && this_command_key_count > 0 && ! noninteractive - && echo_keystrokes > 0 - && (echo_area_glyphs == 0 || *echo_area_glyphs == 0 - || ok_to_echo_at_next_pause == echo_area_glyphs)) + && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) + && NILP (Fzerop (Vecho_keystrokes)) + && (/* No message. */ + NILP (echo_area_buffer[0]) + /* Or empty message. */ + || (BUF_BEG (XBUFFER (echo_area_buffer[0])) + == BUF_Z (XBUFFER (echo_area_buffer[0]))) + /* Or already echoing from same kboard. */ + || (echo_kboard && ok_to_echo_at_next_pause == echo_kboard) + /* Or not echoing before and echoing allowed. */ + || (!echo_kboard && ok_to_echo_at_next_pause))) { Lisp_Object tem0; - + /* After a mouse event, start echoing right away. This is because we are probably about to display a menu, and we don't want to delay before doing so. */ @@ -1935,9 +2312,13 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) echo_now (); else { + int sec, usec; + double duration = extract_float (Vecho_keystrokes); + sec = (int) duration; + usec = (duration - sec) * 1000000; save_getcjmp (save_jump); restore_getcjmp (local_getcjmp); - tem0 = sit_for (echo_keystrokes, 0, 1, 1, 0); + tem0 = sit_for (sec, usec, 1, 1, 0); restore_getcjmp (save_jump); if (EQ (tem0, Qt) && ! CONSP (Vunread_command_events)) @@ -1965,7 +2346,8 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (nmaps > 0 && INTERACTIVE && !NILP (prev_event) && EVENT_HAS_PARAMETERS (prev_event) - && !EQ (XCONS (prev_event)->car, Qmenu_bar) + && !EQ (XCAR (prev_event), Qmenu_bar) + && !EQ (XCAR (prev_event), Qtool_bar) /* Don't bring up a menu if we already have another event. */ && NILP (Vunread_command_events) && unread_command_char < 0) @@ -2031,8 +2413,8 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) or sentinel or filter. */ if (CONSP (Vunread_command_events)) { - c = XCONS (Vunread_command_events)->car; - Vunread_command_events = XCONS (Vunread_command_events)->cdr; + c = XCAR (Vunread_command_events); + Vunread_command_events = XCDR (Vunread_command_events); } /* Read something from current KBOARD's side queue, if possible. */ @@ -2043,15 +2425,15 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) { if (!CONSP (current_kboard->kbd_queue)) abort (); - c = XCONS (current_kboard->kbd_queue)->car; + c = XCAR (current_kboard->kbd_queue); current_kboard->kbd_queue - = XCONS (current_kboard->kbd_queue)->cdr; + = XCDR (current_kboard->kbd_queue); if (NILP (current_kboard->kbd_queue)) current_kboard->kbd_queue_has_data = 0; input_pending = readable_events (0); if (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qswitch_frame)) - internal_last_event_frame = XCONS (XCONS (c)->cdr)->car; + internal_last_event_frame = XCAR (XCDR (c)); Vlast_event_frame = internal_last_event_frame; } } @@ -2103,7 +2485,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) { Lisp_Object *tailp = &kb->kbd_queue; while (CONSP (*tailp)) - tailp = &XCONS (*tailp)->cdr; + tailp = &XCDR (*tailp); if (!NILP (*tailp)) abort (); *tailp = Fcons (c, Qnil); @@ -2183,11 +2565,6 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) goto retry; } - /* Wipe the echo area. */ - if (echo_area_glyphs) - safe_run_hooks (Qecho_area_clear_hook); - echo_area_glyphs = 0; - /* Handle things that only apply to characters. */ if (INTEGERP (c)) { @@ -2214,16 +2591,16 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) return just menu-bar for now. Modify the mouse click event so we won't do this twice, then queue it up. */ if (EVENT_HAS_PARAMETERS (c) - && CONSP (XCONS (c)->cdr) + && CONSP (XCDR (c)) && CONSP (EVENT_START (c)) - && CONSP (XCONS (EVENT_START (c))->cdr)) + && CONSP (XCDR (EVENT_START (c)))) { Lisp_Object posn; posn = POSN_BUFFER_POSN (EVENT_START (c)); /* Handle menu-bar events: insert the dummy prefix event `menu-bar'. */ - if (EQ (posn, Qmenu_bar)) + if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar)) { /* Change menu-bar to (menu-bar) as the event "position". */ POSN_BUFFER_POSN (EVENT_START (c)) = Fcons (posn, Qnil); @@ -2234,36 +2611,163 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) } } + /* Store these characters into recent_keys, the dribble file if any, + and the keyboard macro being defined, if any. */ record_char (c); if (! NILP (also_record)) record_char (also_record); + /* Wipe the echo area. + But first, if we are about to use an input method, + save the echo area contents for it to refer to. */ + if (INTEGERP (c) + && ! NILP (Vinput_method_function) + && (unsigned) XINT (c) >= ' ' + && (unsigned) XINT (c) != 127 + && (unsigned) XINT (c) < 256) + { + previous_echo_area_message = Fcurrent_message (); + Vinput_method_previous_message = previous_echo_area_message; + } + + /* Now wipe the echo area, except for help events which do their + own stuff with the echo area. */ + if (!CONSP (c) || !(EQ (Qhelp_echo, XCAR (c)))) + { + if (!NILP (echo_area_buffer[0])) + safe_run_hooks (Qecho_area_clear_hook); + clear_message (1, 0); + } + + reread_for_input_method: from_macro: - reread_first: + /* Pass this to the input method, if appropriate. */ + if (INTEGERP (c) + && ! NILP (Vinput_method_function) + /* Don't run the input method within a key sequence, + after the first event of the key sequence. */ + && NILP (prev_event) + && (unsigned) XINT (c) >= ' ' + && (unsigned) XINT (c) != 127 + && (unsigned) XINT (c) < 256) + { + Lisp_Object keys; + int key_count; + struct gcpro gcpro1; + int count = specpdl_ptr - specpdl; + + /* Save the echo status. */ + int saved_immediate_echo = current_kboard->immediate_echo; + struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause; + int saved_echo_after_prompt = current_kboard->echo_after_prompt; + + if (before_command_restore_flag) + { + this_command_key_count = before_command_key_count_1; + if (this_command_key_count < this_single_command_key_start) + this_single_command_key_start = this_command_key_count; + echo_truncate (before_command_echo_length_1); + before_command_restore_flag = 0; + } - before_command_key_count = this_command_key_count; - before_command_echo_length = echo_length (); + /* Save the this_command_keys status. */ + key_count = this_command_key_count; - /* Don't echo mouse motion events. */ - if (echo_keystrokes - && ! (EVENT_HAS_PARAMETERS (c) - && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) + if (key_count > 0) + keys = Fcopy_sequence (this_command_keys); + else + keys = Qnil; + GCPRO1 (keys); + + /* Clear out this_command_keys. */ + this_command_key_count = 0; + + /* Now wipe the echo area. */ + if (!NILP (echo_area_buffer[0])) + safe_run_hooks (Qecho_area_clear_hook); + clear_message (1, 0); + echo_truncate (0); + + /* If we are not reading a key sequence, + never use the echo area. */ + if (maps == 0) + { + specbind (Qinput_method_use_echo_area, Qt); + } + + /* Call the input method. */ + tem = call1 (Vinput_method_function, c); + + tem = unbind_to (count, tem); + + /* Restore the saved echoing state + and this_command_keys state. */ + this_command_key_count = key_count; + if (key_count > 0) + this_command_keys = keys; + + cancel_echoing (); + ok_to_echo_at_next_pause = saved_ok_to_echo; + current_kboard->echo_after_prompt = saved_echo_after_prompt; + if (saved_immediate_echo) + echo_now (); + + UNGCPRO; + + /* The input method can return no events. */ + if (! CONSP (tem)) + { + /* Bring back the previous message, if any. */ + if (! NILP (previous_echo_area_message)) + message_with_string ("%s", previous_echo_area_message, 0); + goto retry; + } + /* It returned one event or more. */ + c = XCAR (tem); + Vunread_post_input_method_events + = nconc2 (XCDR (tem), Vunread_post_input_method_events); + } + + reread_first: + + /* Display help if not echoing. */ + if (CONSP (c) && EQ (XCAR (c), Qhelp_echo)) { - echo_char (c); - if (! NILP (also_record)) - echo_char (also_record); - /* Once we reread a character, echoing can happen - the next time we pause to read a new one. */ - ok_to_echo_at_next_pause = echo_area_glyphs; + /* (help-echo FRAME HELP WINDOW OBJECT POS). */ + Lisp_Object help, object, position, window; + help = Fnth (make_number (2), c); + window = Fnth (make_number (3), c); + object = Fnth (make_number (4), c); + position = Fnth (make_number (5), c); + show_help_echo (help, window, object, position, 0); + goto retry; } + + if (this_command_key_count == 0 || ! reread) + { + before_command_key_count = this_command_key_count; + before_command_echo_length = echo_length (); - /* Record this character as part of the current key. */ - add_command_key (c); - if (! NILP (also_record)) - add_command_key (also_record); + /* Don't echo mouse motion events. */ + if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) + && NILP (Fzerop (Vecho_keystrokes)) + && ! (EVENT_HAS_PARAMETERS (c) + && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) + { + echo_char (c); + if (! NILP (also_record)) + echo_char (also_record); + /* Once we reread a character, echoing can happen + the next time we pause to read a new one. */ + ok_to_echo_at_next_pause = current_kboard; + } + + /* Record this character as part of the current key. */ + add_command_key (c); + if (! NILP (also_record)) + add_command_key (also_record); + } - /* Re-reading in the middle of a command */ - reread: last_input_char = c; num_input_events++; @@ -2308,7 +2812,7 @@ record_menu_key (c) Lisp_Object c; { /* Wipe the echo area. */ - echo_area_glyphs = 0; + clear_message (1, 0); record_char (c); @@ -2316,7 +2820,8 @@ record_menu_key (c) before_command_echo_length = echo_length (); /* Don't echo mouse motion events. */ - if (echo_keystrokes) + if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) + && NILP (Fzerop (Vecho_keystrokes))) { echo_char (c); @@ -2343,8 +2848,8 @@ help_char_p (c) if (EQ (c, Vhelp_char)) return 1; - for (tail = Vhelp_event_list; CONSP (tail); tail = XCONS (tail)->cdr) - if (EQ (c, XCONS (tail)->car)) + for (tail = Vhelp_event_list; CONSP (tail); tail = XCDR (tail)) + if (EQ (c, XCAR (tail))) return 1; return 0; } @@ -2451,6 +2956,7 @@ tracking_off (old_value) get_input_pending (&input_pending, 1); } } + return Qnil; } DEFUN ("track-mouse", Ftrack_mouse, Strack_mouse, 0, UNEVALLED, 0, @@ -2536,7 +3042,7 @@ event_to_kboard (event) Lisp_Object frame; frame = event->frame_or_window; if (CONSP (frame)) - frame = XCONS (frame)->car; + frame = XCAR (frame); else if (WINDOWP (frame)) frame = WINDOW_FRAME (XWINDOW (frame)); @@ -2594,6 +3100,7 @@ kbd_buffer_store_event (event) { sp->kind = no_event; sp->frame_or_window = Qnil; + sp->arg = Qnil; } } return; @@ -2641,7 +3148,12 @@ kbd_buffer_store_event (event) Discard the event if it would fill the last slot. */ if (kbd_fetch_ptr - 1 != kbd_store_ptr) { - volatile struct input_event *sp = kbd_store_ptr; + int idx; + +#if 0 /* The selection_request_event case looks bogus, and it's error + prone to assign individual members for other events, in case + the input_event structure is changed. --2000-07-13, gerd. */ + struct input_event *sp = kbd_store_ptr; sp->kind = event->kind; if (event->kind == selection_request_event) { @@ -2651,31 +3163,103 @@ kbd_buffer_store_event (event) bcopy (event, (char *) sp, sizeof (*event)); } else + { sp->code = event->code; sp->part = event->part; sp->frame_or_window = event->frame_or_window; + sp->arg = event->arg; sp->modifiers = event->modifiers; sp->x = event->x; sp->y = event->y; sp->timestamp = event->timestamp; } - (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_store_ptr - - kbd_buffer] - = event->frame_or_window); +#else + *kbd_store_ptr = *event; +#endif - kbd_store_ptr++; + idx = 2 * (kbd_store_ptr - kbd_buffer); + ASET (kbd_buffer_gcpro, idx, event->frame_or_window); + ASET (kbd_buffer_gcpro, idx + 1, event->arg); + ++kbd_store_ptr; } } - -/* Discard any mouse events in the event buffer by setting them to - no_event. */ -void -discard_mouse_events () -{ - struct input_event *sp; - for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++) - { + + +/* Generate HELP_EVENT input_events in BUFP which has roon for + SIZE events. If there's not enough room in BUFP, ignore this + event. + + HELP is the help form. + + FRAME is the frame on which the help is generated. OBJECT is the + Lisp object where the help was found (a buffer, a string, an + overlay, or nil if neither from a string nor from a buffer. POS is + the position within OBJECT where the help was found. + + Value is the number of input_events generated. */ + +int +gen_help_event (bufp, size, help, frame, window, object, pos) + struct input_event *bufp; + int size; + Lisp_Object help, frame, object, window; + int pos; +{ + int nevents_stored = 0; + + if (size >= 2) + { + bufp->kind = HELP_EVENT; + bufp->frame_or_window = frame; + bufp->arg = object; + bufp->x = make_number (pos); + bufp->code = 0; + + ++bufp; + bufp->kind = HELP_EVENT; + bufp->frame_or_window = WINDOWP (window) ? window : frame; + bufp->arg = help; + bufp->code = 1; + nevents_stored = 2; + } + + return nevents_stored; +} + + +/* Store HELP_EVENTs for HELP on FRAME in the input queue. */ + +void +kbd_buffer_store_help_event (frame, help) + Lisp_Object frame, help; +{ + struct input_event event; + + event.kind = HELP_EVENT; + event.frame_or_window = frame; + event.arg = Qnil; + event.x = make_number (0); + event.code = 0; + kbd_buffer_store_event (&event); + + event.kind = HELP_EVENT; + event.frame_or_window = frame; + event.arg = help; + event.x = make_number (0); + event.code = 1; + kbd_buffer_store_event (&event); +} + + +/* Discard any mouse events in the event buffer by setting them to + no_event. */ +void +discard_mouse_events () +{ + struct input_event *sp; + for (sp = kbd_fetch_ptr; sp != kbd_store_ptr; sp++) + { if (sp == kbd_buffer + KBD_BUFFER_SIZE) sp = kbd_buffer; @@ -2689,7 +3273,49 @@ discard_mouse_events () } } } + + +/* Return non-zero if there are any real events waiting in the event + buffer, not counting `no_event's. + + If DISCARD is non-zero, discard no_event events at the front of + the input queue, possibly leaving the input queue empty if there + are no real input events. */ + +int +kbd_buffer_events_waiting (discard) + int discard; +{ + struct input_event *sp; + + for (sp = kbd_fetch_ptr; + sp != kbd_store_ptr && sp->kind == no_event; + ++sp) + { + if (sp == kbd_buffer + KBD_BUFFER_SIZE) + sp = kbd_buffer; + } + + if (discard) + kbd_fetch_ptr = sp; + + return sp != kbd_store_ptr && sp->kind != no_event; +} + +/* Clear input event EVENT. */ + +static INLINE void +clear_event (event) + struct input_event *event; +{ + int idx = 2 * (event - kbd_buffer); + ASET (kbd_buffer_gcpro, idx, Qnil); + ASET (kbd_buffer_gcpro, idx + 1, Qnil); + event->kind = no_event; +} + + /* Read one event from the event buffer, waiting if necessary. The value is a Lisp object representing the event. The value is nil for an event that should be ignored, @@ -2703,7 +3329,6 @@ kbd_buffer_get_event (kbp, used_mouse_menu) { register int c; Lisp_Object obj; - EMACS_TIME next_timer_delay; if (noninteractive) { @@ -2760,8 +3385,8 @@ kbd_buffer_get_event (kbp, used_mouse_menu) if (CONSP (Vunread_command_events)) { Lisp_Object first; - first = XCONS (Vunread_command_events)->car; - Vunread_command_events = XCONS (Vunread_command_events)->cdr; + first = XCAR (Vunread_command_events); + Vunread_command_events = XCDR (Vunread_command_events); *kbp = current_kboard; return first; } @@ -2864,6 +3489,17 @@ kbd_buffer_get_event (kbp, used_mouse_menu) if (FRAME_LIVE_P (XFRAME (event->frame_or_window))) x_activate_menubar (XFRAME (event->frame_or_window)); } +#endif +#ifdef WINDOWSNT + else if (event->kind == language_change_event) + { + /* Make an event (language-change (FRAME CHARSET LCID)). */ + obj = Fcons (event->modifiers, Qnil); + obj = Fcons (event->code, Qnil); + obj = Fcons (event->frame_or_window, obj); + obj = Fcons (Qlanguage_change, Fcons (obj, Qnil)); + kbd_fetch_ptr = event + 1; + } #endif /* Just discard these, by returning nil. With MULTI_KBOARD, these events are used as placeholders @@ -2875,17 +3511,59 @@ kbd_buffer_get_event (kbp, used_mouse_menu) mouse events during a popup-menu call. */ else if (event->kind == no_event) kbd_fetch_ptr = event + 1; + else if (event->kind == HELP_EVENT) + { + /* There are always two HELP_EVENTs in the input queue. */ + Lisp_Object object, position, help, frame, window; + + xassert (event->code == 0); + frame = event->frame_or_window; + object = event->arg; + position = event->x; + clear_event (event); + + kbd_fetch_ptr = event + 1; + event = ((kbd_fetch_ptr < kbd_buffer + KBD_BUFFER_SIZE) + ? kbd_fetch_ptr + : kbd_buffer); + xassert (event->code == 1); + help = event->arg; + window = event->frame_or_window; + if (!WINDOWP (window)) + window = Qnil; + obj = Fcons (Qhelp_echo, + list5 (frame, help, window, object, position)); + clear_event (event); + kbd_fetch_ptr = event + 1; + } + else if (event->kind == FOCUS_IN_EVENT) + { + /* Notification of a FocusIn event. The frame receiving the + focus is in event->frame_or_window. Generate a + switch-frame event if necessary. */ + Lisp_Object frame, focus; + + frame = event->frame_or_window; + focus = FRAME_FOCUS_FRAME (XFRAME (frame)); + if (FRAMEP (focus)) + frame = focus; - /* If this event is on a different frame, return a switch-frame this - time, and leave the event in the queue for next time. */ + if (!EQ (frame, internal_last_event_frame) + && !EQ (frame, selected_frame)) + obj = make_lispy_switch_frame (frame); + internal_last_event_frame = frame; + kbd_fetch_ptr = event + 1; + } else { + /* If this event is on a different frame, return a switch-frame this + time, and leave the event in the queue for next time. */ Lisp_Object frame; Lisp_Object focus; frame = event->frame_or_window; if (CONSP (frame)) - frame = XCONS (frame)->car; + frame = XCAR (frame); else if (WINDOWP (frame)) frame = WINDOW_FRAME (XWINDOW (frame)); @@ -2894,7 +3572,7 @@ kbd_buffer_get_event (kbp, used_mouse_menu) frame = focus; if (! EQ (frame, internal_last_event_frame) - && XFRAME (frame) != selected_frame) + && !EQ (frame, selected_frame)) obj = make_lispy_switch_frame (frame); internal_last_event_frame = frame; @@ -2903,23 +3581,25 @@ kbd_buffer_get_event (kbp, used_mouse_menu) if (NILP (obj)) { + int idx; + obj = make_lispy_event (event); + #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) /* If this was a menu selection, then set the flag to inhibit writing to last_nonmenu_event. Don't do this if the event we're returning is (menu-bar), though; that indicates the beginning of the menu sequence, and we might as well leave that as the `event with parameters' for this selection. */ - if (event->kind == menu_bar_event - && !(CONSP (obj) && EQ (XCONS (obj)->car, Qmenu_bar)) - && used_mouse_menu) + if (used_mouse_menu + && !EQ (event->frame_or_window, event->arg) + && (event->kind == MENU_BAR_EVENT + || event->kind == TOOL_BAR_EVENT)) *used_mouse_menu = 1; #endif /* Wipe out this event, to catch bugs. */ - event->kind = no_event; - XVECTOR (kbd_buffer_frame_or_window)->contents[event - kbd_buffer] = Qnil; - + clear_event (event); kbd_fetch_ptr = event + 1; } } @@ -2955,7 +3635,7 @@ kbd_buffer_get_event (kbp, used_mouse_menu) XSETFRAME (frame, f); if (! EQ (frame, internal_last_event_frame) - && XFRAME (frame) != selected_frame) + && !EQ (frame, selected_frame)) obj = make_lispy_switch_frame (frame); internal_last_event_frame = frame; } @@ -3063,11 +3743,11 @@ timer_start_idle () EMACS_GET_TIME (timer_idleness_start_time); /* Mark all idle-time timers as once again candidates for running. */ - for (timers = Vtimer_idle_list; CONSP (timers); timers = XCONS (timers)->cdr) + for (timers = Vtimer_idle_list; CONSP (timers); timers = XCDR (timers)) { Lisp_Object timer; - timer = XCONS (timers)->car; + timer = XCAR (timers); if (!VECTORP (timer) || XVECTOR (timer)->size != 8) continue; @@ -3131,7 +3811,6 @@ timer_check (do_it_now) while (CONSP (timers) || CONSP (idle_timers)) { - int triggertime = EMACS_SECS (now); Lisp_Object *vector; Lisp_Object timer, idle_timer; EMACS_TIME timer_time, idle_timer_time; @@ -3140,10 +3819,10 @@ timer_check (do_it_now) /* Skip past invalid timers and timers already handled. */ if (!NILP (timers)) { - timer = XCONS (timers)->car; + timer = XCAR (timers); if (!VECTORP (timer) || XVECTOR (timer)->size != 8) { - timers = XCONS (timers)->cdr; + timers = XCDR (timers); continue; } vector = XVECTOR (timer)->contents; @@ -3152,16 +3831,16 @@ timer_check (do_it_now) || !INTEGERP (vector[3]) || ! NILP (vector[0])) { - timers = XCONS (timers)->cdr; + timers = XCDR (timers); continue; } } if (!NILP (idle_timers)) { - timer = XCONS (idle_timers)->car; + timer = XCAR (idle_timers); if (!VECTORP (timer) || XVECTOR (timer)->size != 8) { - idle_timers = XCONS (idle_timers)->cdr; + idle_timers = XCDR (idle_timers); continue; } vector = XVECTOR (timer)->contents; @@ -3170,7 +3849,7 @@ timer_check (do_it_now) || !INTEGERP (vector[3]) || ! NILP (vector[0])) { - idle_timers = XCONS (idle_timers)->cdr; + idle_timers = XCDR (idle_timers); continue; } } @@ -3181,7 +3860,7 @@ timer_check (do_it_now) this timer becomes ripe (negative if it's already ripe). */ if (!NILP (timers)) { - timer = XCONS (timers)->car; + timer = XCAR (timers); vector = XVECTOR (timer)->contents; EMACS_SET_SECS (timer_time, (XINT (vector[1]) << 16) | (XINT (vector[2]))); @@ -3193,7 +3872,7 @@ timer_check (do_it_now) based on the next idle timer. */ if (!NILP (idle_timers)) { - idle_timer = XCONS (idle_timers)->car; + idle_timer = XCAR (idle_timers); vector = XVECTOR (idle_timer)->contents; EMACS_SET_SECS (idle_timer_time, (XINT (vector[1]) << 16) | (XINT (vector[2]))); @@ -3212,38 +3891,37 @@ timer_check (do_it_now) if (EMACS_TIME_NEG_P (temp)) { chosen_timer = timer; - timers = XCONS (timers)->cdr; + timers = XCDR (timers); difference = timer_difference; } else { chosen_timer = idle_timer; - idle_timers = XCONS (idle_timers)->cdr; + idle_timers = XCDR (idle_timers); difference = idle_timer_difference; } } else if (! NILP (timers)) { chosen_timer = timer; - timers = XCONS (timers)->cdr; + timers = XCDR (timers); difference = timer_difference; } else { chosen_timer = idle_timer; - idle_timers = XCONS (idle_timers)->cdr; + idle_timers = XCDR (idle_timers); difference = idle_timer_difference; } vector = XVECTOR (chosen_timer)->contents; - /* If timer is rupe, run it if it hasn't been run. */ + /* If timer is ripe, run it if it hasn't been run. */ if (EMACS_TIME_NEG_P (difference) || (EMACS_SECS (difference) == 0 && EMACS_USECS (difference) == 0)) { if (NILP (vector[0])) { - Lisp_Object tem; int was_locked = single_kboard; int count = specpdl_ptr - specpdl; @@ -3288,6 +3966,7 @@ static Lisp_Object mouse_syms; #ifdef WINDOWSNT static Lisp_Object mouse_wheel_syms; #endif +static Lisp_Object drag_n_drop_syms; /* This is a list of keysym codes for special "accent" characters. It parallels lispy_accent_keys. */ @@ -3405,15 +4084,15 @@ char *lispy_function_keys[] = 0, 0, /* 0x0E .. 0x0F */ - "shift", /* VK_SHIFT 0x10 */ - "control", /* VK_CONTROL 0x11 */ - "menu", /* VK_MENU 0x12 */ + 0, /* VK_SHIFT 0x10 */ + 0, /* VK_CONTROL 0x11 */ + 0, /* VK_MENU 0x12 */ "pause", /* VK_PAUSE 0x13 */ - "capital", /* VK_CAPITAL 0x14 */ + "capslock", /* VK_CAPITAL 0x14 */ 0, 0, 0, 0, 0, 0, /* 0x15 .. 0x1A */ - 0, /* VK_ESCAPE 0x1B */ + "escape", /* VK_ESCAPE 0x1B */ 0, 0, 0, 0, /* 0x1C .. 0x1F */ @@ -3540,6 +4219,7 @@ char *lispy_function_keys[] = "noname", /* VK_NONAME 0xFC */ "pa1", /* VK_PA1 0xFD */ "oem_clear", /* VK_OEM_CLEAR 0xFE */ + 0 /* 0xFF */ }; #else /* not HAVE_NTGUI */ @@ -3587,35 +4267,23 @@ static char *lispy_function_keys[] = { /* X Keysym value */ - 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00 */ - "backspace", - "tab", - "linefeed", - "clear", - 0, - "return", - 0, 0, - 0, 0, 0, /* 0xff10 */ - "pause", - 0, 0, 0, 0, 0, 0, 0, - "escape", + 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff00...0f */ + "backspace", "tab", "linefeed", "clear", + 0, "return", 0, 0, + 0, 0, 0, "pause", /* 0xff10...1f */ + 0, 0, 0, 0, 0, 0, 0, "escape", 0, 0, 0, 0, - 0, "kanji", "muhenkan", - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff20...2f */ - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff30...3f */ + 0, "kanji", "muhenkan", "henkan", /* 0xff20...2f */ + "romaji", "hiragana", "katakana", "hiragana-katakana", + "zenkaku", "hankaku", "zenkaku-hankaku", "touroku", + "massyo", "kana-lock", "kana-shift", "eisu-shift", + "eisu-toggle", /* 0xff30...3f */ + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0xff40...4f */ - "home", /* 0xff50 */ /* IsCursorKey */ - "left", - "up", - "right", - "down", - "prior", - "next", - "end", - "begin", - 0, /* 0xff59 */ - 0, 0, 0, 0, 0, 0, + "home", "left", "up", "right", /* 0xff50 */ /* IsCursorKey */ + "down", "prior", "next", "end", + "begin", 0, 0, 0, 0, 0, 0, 0, "select", /* 0xff60 */ /* IsMiscFunctionKey */ "print", "execute", @@ -3629,9 +4297,9 @@ static char *lispy_function_keys[] = "help", "break", /* 0xff6b */ - 0, 0, 0, 0, 0, 0, 0, 0, "backtab", 0, - 0, /* 0xff76 */ - 0, 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff7f */ + 0, 0, 0, 0, + 0, 0, 0, 0, "backtab", 0, 0, 0, /* 0xff70... */ + 0, 0, 0, 0, 0, 0, 0, "kp-numlock", /* 0xff78... */ "kp-space", /* 0xff80 */ /* IsKeypadKey */ 0, 0, 0, 0, 0, 0, 0, 0, "kp-tab", /* 0xff89 */ @@ -3702,10 +4370,7 @@ static char *iso_lispy_function_keys[] = #endif /* not HAVE_NTGUI */ -static char *lispy_mouse_names[] = -{ - "mouse-1", "mouse-2", "mouse-3", "mouse-4", "mouse-5" -}; +Lisp_Object Vlispy_mouse_stem; #ifdef WINDOWSNT /* mouse-wheel events are generated by the wheel on devices such as @@ -3719,16 +4384,33 @@ static char *lispy_mouse_wheel_names[] = { "mouse-wheel" }; + #endif /* WINDOWSNT */ +/* drag-n-drop events are generated when a set of selected files are + dragged from another application and dropped onto an Emacs window. */ +static char *lispy_drag_n_drop_names[] = +{ + "drag-n-drop" +}; + /* Scroll bar parts. */ Lisp_Object Qabove_handle, Qhandle, Qbelow_handle; -Lisp_Object Qup, Qdown; +Lisp_Object Qup, Qdown, Qbottom, Qend_scroll; +Lisp_Object Qtop, Qratio; /* An array of scroll bar parts, indexed by an enum scroll_bar_part value. */ Lisp_Object *scroll_bar_parts[] = { &Qabove_handle, &Qhandle, &Qbelow_handle, - &Qup, &Qdown, + &Qup, &Qdown, &Qtop, &Qbottom, &Qend_scroll, &Qratio +}; + +/* User signal events. */ +Lisp_Object Qusr1_signal, Qusr2_signal; + +Lisp_Object *lispy_user_signals[] = +{ + &Qusr1_signal, &Qusr2_signal }; @@ -3803,6 +4485,14 @@ make_lispy_event (event) return lispy_c; } + case multibyte_char_keystroke: + { + Lisp_Object lispy_c; + + XSETFASTINT (lispy_c, event->code); + return lispy_c; + } + /* A function key. The symbol may need to have modifier prefixes tacked onto it. */ case non_ascii_keystroke: @@ -3864,7 +4554,9 @@ make_lispy_event (event) /* A mouse click. Figure out where it is, decide whether it's a press, click or drag, and build the appropriate structure. */ case mouse_click: +#ifndef USE_TOOLKIT_SCROLL_BARS case scroll_bar_click: +#endif { int button = event->code; int is_double; @@ -3872,9 +4564,6 @@ make_lispy_event (event) Lisp_Object *start_pos_ptr; Lisp_Object start_pos; - if (button < 0 || button >= NUM_MOUSE_BUTTONS) - abort (); - /* Build the position as appropriate for this mouse click. */ if (event->kind == mouse_click) { @@ -3882,6 +4571,7 @@ make_lispy_event (event) FRAME_PTR f = XFRAME (event->frame_or_window); Lisp_Object window; Lisp_Object posn; + Lisp_Object string_info = Qnil; int row, column; /* Ignore mouse events that were made on frame that @@ -3889,8 +4579,13 @@ make_lispy_event (event) if (! FRAME_LIVE_P (f)) return Qnil; - pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), - &column, &row, NULL, 1); + /* EVENT->x and EVENT->y are frame-relative pixel + coordinates at this place. Under old redisplay, COLUMN + and ROW are set to frame relative glyph coordinates + which are then used to determine whether this click is + in a menu (non-toolkit version). */ + pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), + &column, &row, NULL, 1); #ifndef USE_X_TOOLKIT /* In the non-toolkit version, clicks on the menu bar @@ -3915,6 +4610,7 @@ make_lispy_event (event) return Qnil; #endif + /* Find the menu bar item under `column'. */ item = Qnil; items = FRAME_MENU_BAR_ITEMS (f); for (i = 0; i < XVECTOR (items)->size; i += 4) @@ -3932,6 +4628,8 @@ make_lispy_event (event) } } + /* ELisp manual 2.4b says (x y) are window relative but + code says they are frame-relative. */ position = Fcons (event->frame_or_window, Fcons (Qmenu_bar, @@ -3943,7 +4641,10 @@ make_lispy_event (event) } #endif /* not USE_X_TOOLKIT */ - window = window_from_coordinates (f, column, row, &part); + /* Set `window' to the window under frame pixel coordinates + event->x/event->y. */ + window = window_from_coordinates (f, XINT (event->x), + XINT (event->y), &part, 0); if (!WINDOWP (window)) { @@ -3952,21 +4653,36 @@ make_lispy_event (event) } else { - int pixcolumn, pixrow; - column -= WINDOW_LEFT_MARGIN (XWINDOW (window)); - row -= XINT (XWINDOW (window)->top); - glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow); - XSETINT (event->x, pixcolumn); - XSETINT (event->y, pixrow); - - if (part == 1) - posn = Qmode_line; + /* It's a click in window window at frame coordinates + event->x/ event->y. */ + struct window *w = XWINDOW (window); + + /* Get window relative coordinates. Original code + `rounded' this to glyph boundaries. */ + int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x)); + int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y)); + + /* Set event coordinates to window-relative coordinates + for constructing the Lisp event below. */ + XSETINT (event->x, wx); + XSETINT (event->y, wy); + + if (part == 1 || part == 3) + { + /* Mode line or top line. Look for a string under + the mouse that may have a `local-map' property. */ + Lisp_Object string; + int charpos; + + posn = part == 1 ? Qmode_line : Qheader_line; + string = mode_line_string (w, wx, wy, part == 1, &charpos); + if (STRINGP (string)) + string_info = Fcons (string, make_number (charpos)); + } else if (part == 2) posn = Qvertical_line; else - XSETINT (posn, - buffer_posn_from_coords (XWINDOW (window), - column, row)); + XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy)); } position @@ -3974,10 +4690,14 @@ make_lispy_event (event) Fcons (posn, Fcons (Fcons (event->x, event->y), Fcons (make_number (event->timestamp), - Qnil)))); + (NILP (string_info) + ? Qnil + : Fcons (string_info, Qnil)))))); } +#ifndef USE_TOOLKIT_SCROLL_BARS else { + /* It's a scrollbar click. */ Lisp_Object window; Lisp_Object portion_whole; Lisp_Object part; @@ -3993,7 +4713,15 @@ make_lispy_event (event) Fcons (make_number (event->timestamp), Fcons (part, Qnil))))); } +#endif /* not USE_TOOLKIT_SCROLL_BARS */ + if (button >= XVECTOR (button_down_location)->size) + { + button_down_location = larger_vector (button_down_location, + button + 1, Qnil); + mouse_syms = larger_vector (mouse_syms, button + 1, Qnil); + } + start_pos_ptr = &XVECTOR (button_down_location)->contents[button]; start_pos = *start_pos_ptr; @@ -4054,8 +4782,8 @@ make_lispy_event (event) Lisp_Object down; down = Fnth (make_number (2), start_pos); - if (EQ (event->x, XCONS (down)->car) - && EQ (event->y, XCONS (down)->cdr)) + if (EQ (event->x, XCAR (down)) + && EQ (event->y, XCDR (down))) { event->modifiers |= click_modifier; } @@ -4083,10 +4811,10 @@ make_lispy_event (event) head = modify_event_symbol (button, event->modifiers, - Qmouse_click, Qnil, - lispy_mouse_names, &mouse_syms, - (sizeof (lispy_mouse_names) - / sizeof (lispy_mouse_names[0]))); + Qmouse_click, Vlispy_mouse_stem, + NULL, + &mouse_syms, + XVECTOR (mouse_syms)->size); if (event->modifiers & drag_modifier) return Fcons (head, Fcons (start_pos, @@ -4104,6 +4832,55 @@ make_lispy_event (event) } } +#if USE_TOOLKIT_SCROLL_BARS + + /* We don't have down and up events if using toolkit scroll bars, + so make this always a click event. Store in the `part' of + the Lisp event a symbol which maps to the following actions: + + `above_handle' page up + `below_handle' page down + `up' line up + `down' line down + `top' top of buffer + `bottom' bottom of buffer + `handle' thumb has been dragged. + `end-scroll' end of interaction with scroll bar + + The incoming input_event contains in its `part' member an + index of type `enum scroll_bar_part' which we can use as an + index in scroll_bar_parts to get the appropriate symbol. */ + + case scroll_bar_click: + { + Lisp_Object position, head, window, portion_whole, part; + + window = event->frame_or_window; + portion_whole = Fcons (event->x, event->y); + part = *scroll_bar_parts[(int) event->part]; + + position + = Fcons (window, + Fcons (Qvertical_scroll_bar, + Fcons (portion_whole, + Fcons (make_number (event->timestamp), + Fcons (part, Qnil))))); + + /* Always treat scroll bar events as clicks. */ + event->modifiers |= click_modifier; + + /* Get the symbol we should use for the mouse click. */ + head = modify_event_symbol (event->code, + event->modifiers, + Qmouse_click, + Vlispy_mouse_stem, + NULL, &mouse_syms, + XVECTOR (mouse_syms)->size); + return Fcons (head, Fcons (position, Qnil)); + } + +#endif /* USE_TOOLKIT_SCROLL_BARS */ + #ifdef WINDOWSNT case w32_scroll_bar_click: { @@ -4113,9 +4890,6 @@ make_lispy_event (event) Lisp_Object *start_pos_ptr; Lisp_Object start_pos; - if (button < 0 || button >= NUM_MOUSE_BUTTONS) - abort (); - { Lisp_Object window; Lisp_Object portion_whole; @@ -4142,10 +4916,10 @@ make_lispy_event (event) head = modify_event_symbol (button, event->modifiers, - Qmouse_click, Qnil, - lispy_mouse_names, &mouse_syms, - (sizeof (lispy_mouse_names) - / sizeof (lispy_mouse_names[0]))); + Qmouse_click, + Vlispy_mouse_stem, + NULL, &mouse_syms, + XVECTOR (mouse_syms)->size); return Fcons (head, Fcons (position, Qnil)); @@ -4166,7 +4940,7 @@ make_lispy_event (event) return Qnil; pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), &column, &row, NULL, 1); - window = window_from_coordinates (f, column, row, &part); + window = window_from_coordinates (f, column, row, &part, 0); if (!WINDOWP (window)) { @@ -4178,7 +4952,8 @@ make_lispy_event (event) int pixcolumn, pixrow; column -= XINT (XWINDOW (window)->left); row -= XINT (XWINDOW (window)->top); - glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow); + glyph_to_pixel_coords (XWINDOW(window), column, row, + &pixcolumn, &pixrow); XSETINT (event->x, pixcolumn); XSETINT (event->y, pixrow); @@ -4186,10 +4961,12 @@ make_lispy_event (event) posn = Qmode_line; else if (part == 2) posn = Qvertical_line; + else if (part == 3) + posn = Qheader_line; else XSETINT (posn, buffer_posn_from_coords (XWINDOW (window), - column, row)); + &column, &row)); } { @@ -4213,16 +4990,109 @@ make_lispy_event (event) } } #endif /* WINDOWSNT */ + + case drag_n_drop: + { + int part; + FRAME_PTR f; + Lisp_Object window; + Lisp_Object posn; + Lisp_Object files; + int row, column; + + /* The frame_or_window field should be a cons of the frame in + which the event occurred and a list of the filenames + dropped. */ + if (! CONSP (event->frame_or_window)) + abort (); + + f = XFRAME (XCAR (event->frame_or_window)); + files = XCDR (event->frame_or_window); + + /* Ignore mouse events that were made on frames that + have been deleted. */ + if (! FRAME_LIVE_P (f)) + return Qnil; + pixel_to_glyph_coords (f, XINT (event->x), XINT (event->y), + &column, &row, NULL, 1); + window = window_from_coordinates (f, column, row, &part, 0); + + if (!WINDOWP (window)) + { + window = XCAR (event->frame_or_window); + posn = Qnil; + } + else + { + /* It's an event in window `window' at frame coordinates + event->x/ event->y. */ + struct window *w = XWINDOW (window); + + /* Get window relative coordinates. */ + int wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (event->x)); + int wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (event->y)); + + /* Set event coordinates to window-relative coordinates + for constructing the Lisp event below. */ + XSETINT (event->x, wx); + XSETINT (event->y, wy); + + if (part == 1) + posn = Qmode_line; + else if (part == 2) + posn = Qvertical_line; + else if (part == 3) + posn = Qheader_line; + else + XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy)); + } + + { + Lisp_Object head, position; + + position + = Fcons (window, + Fcons (posn, + Fcons (Fcons (event->x, event->y), + Fcons (make_number (event->timestamp), + Qnil)))); + + head = modify_event_symbol (0, event->modifiers, + Qdrag_n_drop, Qnil, + lispy_drag_n_drop_names, + &drag_n_drop_syms, 1); + return Fcons (head, + Fcons (position, + Fcons (files, + Qnil))); + } + } #endif /* HAVE_MOUSE */ #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) - case menu_bar_event: - /* The event value is in the cdr of the frame_or_window slot. */ - if (!CONSP (event->frame_or_window)) - abort (); - return XCONS (event->frame_or_window)->cdr; + case MENU_BAR_EVENT: + if (EQ (event->arg, event->frame_or_window)) + /* This is the prefix key. We translate this to + `(menu_bar)' because the code in keyboard.c for menu + events, which we use, relies on this. */ + return Fcons (Qmenu_bar, Qnil); + return event->arg; #endif + case TOOL_BAR_EVENT: + if (EQ (event->arg, event->frame_or_window)) + /* This is the prefix key. We translate this to + `(tool_bar)' because the code in keyboard.c for menu + events, which we use, relies on this. */ + return Fcons (Qtool_bar, Qnil); + else if (SYMBOLP (event->arg)) + return apply_modifiers (event->modifiers, event->arg); + return event->arg; + + case USER_SIGNAL_EVENT: + /* A user signal. */ + return *lispy_user_signals[event->code]; + /* The 'kind' field of the event is something we don't recognize. */ default: abort (); @@ -4261,34 +5131,32 @@ make_lispy_movement (frame, bar_window, part, x, y, time) int area; Lisp_Object window; Lisp_Object posn; - int column, row; if (frame) - { - /* It's in a frame; which window on that frame? */ - pixel_to_glyph_coords (frame, XINT (x), XINT (y), &column, &row, - NULL, 1); - window = window_from_coordinates (frame, column, row, &area); - } + /* It's in a frame; which window on that frame? */ + window = window_from_coordinates (frame, XINT (x), XINT (y), &area, 0); else window = Qnil; if (WINDOWP (window)) { - int pixcolumn, pixrow; - column -= WINDOW_LEFT_MARGIN (XWINDOW (window)); - row -= XINT (XWINDOW (window)->top); - glyph_to_pixel_coords (frame, column, row, &pixcolumn, &pixrow); - XSETINT (x, pixcolumn); - XSETINT (y, pixrow); - + struct window *w = XWINDOW (window); + int wx, wy; + + /* Get window relative coordinates. */ + wx = FRAME_TO_WINDOW_PIXEL_X (w, XINT (x)); + wy = FRAME_TO_WINDOW_PIXEL_Y (w, XINT (y)); + XSETINT (x, wx); + XSETINT (y, wy); + if (area == 1) posn = Qmode_line; else if (area == 2) posn = Qvertical_line; + else if (area == 3) + posn = Qheader_line; else - XSETINT (posn, - buffer_posn_from_coords (XWINDOW (window), column, row)); + XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy)); } else if (frame != 0) { @@ -4506,7 +5374,7 @@ lispy_modifier_list (modifiers) SYMBOL's Qevent_symbol_element_mask property, and maintains the Qevent_symbol_elements property. */ -static Lisp_Object +Lisp_Object parse_modifiers (symbol) Lisp_Object symbol; { @@ -4571,7 +5439,7 @@ apply_modifiers (modifiers, base) entry = assq_no_quit (index, cache); if (CONSP (entry)) - new_symbol = XCONS (entry)->cdr; + new_symbol = XCDR (entry); else { /* We have to create the symbol ourselves. */ @@ -4629,8 +5497,8 @@ reorder_modifiers (symbol) Lisp_Object parsed; parsed = parse_modifiers (symbol); - return apply_modifiers ((int) XINT (XCONS (XCONS (parsed)->cdr)->car), - XCONS (parsed)->car); + return apply_modifiers ((int) XINT (XCAR (XCDR (parsed))), + XCAR (parsed)); } @@ -4643,8 +5511,11 @@ reorder_modifiers (symbol) is the name of the i'th symbol. TABLE_SIZE is the number of elements in the table. - Alternatively, NAME_ALIST is an alist mapping codes into symbol names. - NAME_ALIST is used if it is non-nil; otherwise NAME_TABLE is used. + Alternatively, NAME_ALIST_OR_STEM is either an alist mapping codes + into symbol names, or a string specifying a name stem used to + construct a symbol name or the form `STEM-N', where N is the decimal + representation of SYMBOL_NUM. NAME_ALIST_OR_STEM is used if it is + non-nil; otherwise NAME_TABLE is used. SYMBOL_TABLE should be a pointer to a Lisp_Object whose value will persist between calls to modify_event_symbol that it can use to @@ -4664,12 +5535,12 @@ reorder_modifiers (symbol) in the symbol's name. */ static Lisp_Object -modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist, +modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist_or_stem, name_table, symbol_table, table_size) int symbol_num; unsigned modifiers; Lisp_Object symbol_kind; - Lisp_Object name_alist; + Lisp_Object name_alist_or_stem; char **name_table; Lisp_Object *symbol_table; unsigned int table_size; @@ -4709,8 +5580,16 @@ modify_event_symbol (symbol_num, modifiers, symbol_kind, name_alist, if (NILP (value)) { /* No; let's create it. */ - if (!NILP (name_alist)) - value = Fcdr_safe (Fassq (symbol_int, name_alist)); + if (CONSP (name_alist_or_stem)) + value = Fcdr_safe (Fassq (symbol_int, name_alist_or_stem)); + else if (STRINGP (name_alist_or_stem)) + { + int len = STRING_BYTES (XSTRING (name_alist_or_stem)); + char *buf = (char *) alloca (len + 50); + sprintf (buf, "%s-%d", XSTRING (name_alist_or_stem)->data, + XINT (symbol_int) + 1); + value = intern (buf); + } else if (name_table != 0 && name_table[symbol_num]) value = intern (name_table[symbol_num]); @@ -4771,8 +5650,8 @@ has the same base event type and all the specified modifiers.") Lisp_Object elt; int this = 0; - elt = XCONS (rest)->car; - rest = XCONS (rest)->cdr; + elt = XCAR (rest); + rest = XCDR (rest); /* Given a symbol, see if it is a modifier name. */ if (SYMBOLP (elt) && CONSP (rest)) @@ -4907,10 +5786,10 @@ lucid_event_type_list_p (object) if (! CONSP (object)) return 0; - for (tail = object; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = object; CONSP (tail); tail = XCDR (tail)) { Lisp_Object elt; - elt = XCONS (tail)->car; + elt = XCAR (tail); if (! (INTEGERP (elt) || SYMBOLP (elt))) return 0; } @@ -4984,6 +5863,7 @@ record_asynch_buffer_change () event.kind = buffer_switch_event; event.frame_or_window = Qnil; + event.arg = Qnil; #ifdef subprocesses /* We don't need a buffer-switch event unless Emacs is waiting for input. @@ -5092,7 +5972,7 @@ read_avail_input (expected) cbuf[0] = dos_keyread (); nread = 1; #else - nread = read (input_fd, cbuf, n_to_read); + nread = emacs_read (input_fd, cbuf, n_to_read); #endif /* POSIX infers that processes which are not in the session leader's process group won't get SIGHUP's at logout time. BSDI adheres to @@ -5144,7 +6024,8 @@ read_avail_input (expected) cbuf[i] &= ~0x80; buf[i].code = cbuf[i]; - XSETFRAME (buf[i].frame_or_window, selected_frame); + buf[i].frame_or_window = selected_frame; + buf[i].arg = Qnil; } } @@ -5322,15 +6203,18 @@ menu_bar_items (old) } else { - /* No, so use major and minor mode keymaps. */ + /* No, so use major and minor mode keymaps and keymap property. */ + int extra_maps = 2; + Lisp_Object map = get_local_map (PT, current_buffer, keymap); + if (!NILP (map)) + extra_maps = 3; nmaps = current_minor_maps (NULL, &tmaps); - maps = (Lisp_Object *) alloca ((nmaps + 2) * sizeof (maps[0])); + maps = (Lisp_Object *) alloca ((nmaps + extra_maps) + * sizeof (maps[0])); bcopy (tmaps, maps, nmaps * sizeof (maps[0])); -#ifdef USE_TEXT_PROPERTIES - maps[nmaps++] = get_local_map (PT, current_buffer); -#else - maps[nmaps++] = current_buffer->keymap; -#endif + if (!NILP (map)) + maps[nmaps++] = get_local_map (PT, current_buffer, keymap); + maps[nmaps++] = get_local_map (PT, current_buffer, local_map); } maps[nmaps++] = current_global_map; } @@ -5353,13 +6237,13 @@ menu_bar_items (old) /* Move to the end those items that should be at the end. */ - for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCDR (tail)) { int i; int end = menu_bar_items_index; for (i = 0; i < end; i += 4) - if (EQ (XCONS (tail)->car, XVECTOR (menu_bar_items_vector)->contents[i])) + if (EQ (XCAR (tail), XVECTOR (menu_bar_items_vector)->contents[i])) { Lisp_Object tem0, tem1, tem2, tem3; /* Move the item at index I to the end, @@ -5385,7 +6269,6 @@ menu_bar_items (old) if (i + 4 > XVECTOR (menu_bar_items_vector)->size) { Lisp_Object tem; - int newsize = 2 * i; tem = Fmake_vector (make_number (2 * i), Qnil); bcopy (XVECTOR (menu_bar_items_vector)->contents, XVECTOR (tem)->contents, i * sizeof (Lisp_Object)); @@ -5406,18 +6289,22 @@ menu_bar_items (old) /* Scan one map KEYMAP, accumulating any menu items it defines in menu_bar_items_vector. */ +static Lisp_Object menu_bar_one_keymap_changed_items; + static void menu_bar_one_keymap (keymap) Lisp_Object keymap; { - Lisp_Object tail, item, table; + Lisp_Object tail, item; + + menu_bar_one_keymap_changed_items = Qnil; /* Loop over all keymap entries that have menu strings. */ - for (tail = keymap; CONSP (tail); tail = XCONS (tail)->cdr) + for (tail = keymap; CONSP (tail); tail = XCDR (tail)) { - item = XCONS (tail)->car; + item = XCAR (tail); if (CONSP (item)) - menu_bar_item (XCONS (item)->car, XCONS (item)->cdr); + menu_bar_item (XCAR (item), XCDR (item)); else if (VECTORP (item)) { /* Loop over the char values represented in the vector. */ @@ -5444,6 +6331,7 @@ menu_bar_item (key, item) { struct gcpro gcpro1; int i; + Lisp_Object tem; if (EQ (item, Qundefined)) { @@ -5472,6 +6360,15 @@ menu_bar_item (key, item) if (!i) return; + /* If this keymap has already contributed to this KEY, + don't contribute to it a second time. */ + tem = Fmemq (key, menu_bar_one_keymap_changed_items); + if (!NILP (tem)) + return; + + menu_bar_one_keymap_changed_items + = Fcons (key, menu_bar_one_keymap_changed_items); + item = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; /* Find any existing item for this KEY. */ @@ -5486,7 +6383,6 @@ menu_bar_item (key, item) if (i + 4 > XVECTOR (menu_bar_items_vector)->size) { Lisp_Object tem; - int newsize = 2 * i; tem = Fmake_vector (make_number (2 * i), Qnil); bcopy (XVECTOR (menu_bar_items_vector)->contents, XVECTOR (tem)->contents, i * sizeof (Lisp_Object)); @@ -5517,7 +6413,7 @@ menu_item_eval_property_1 (arg) { /* If we got a quit from within the menu computation, quit all the way out of it. This takes care of C-] in the debugger. */ - if (CONSP (arg) && EQ (XCONS (arg)->car, Qquit)) + if (CONSP (arg) && EQ (XCAR (arg), Qquit)) Fsignal (Qquit, Qnil); return Qnil; @@ -5525,14 +6421,16 @@ menu_item_eval_property_1 (arg) /* Evaluate an expression and return the result (or nil if something went wrong). Used to evaluate dynamic parts of menu items. */ -static Lisp_Object +Lisp_Object menu_item_eval_property (sexpr) Lisp_Object sexpr; { + int count = specpdl_ptr - specpdl; Lisp_Object val; + specbind (Qinhibit_redisplay, Qt); val = internal_condition_case_1 (Feval, sexpr, Qerror, menu_item_eval_property_1); - return val; + return unbind_to (count, val); } /* This function parses a menu item and leaves the result in the @@ -5540,8 +6438,9 @@ menu_item_eval_property (sexpr) ITEM is a key binding, a possible menu item. If NOTREAL is nonzero, only check for equivalent key bindings, don't evaluate dynamic expressions in the menu item. - INMENUBAR is true when this is considered for an entry in a menu bar + INMENUBAR is > 0 when this is considered for an entry in a menu bar top level. + INMENUBAR is < 0 when this is considered for an entry in a keyboard menu. parse_menu_item returns true if the item is a menu item and false otherwise. */ @@ -5550,28 +6449,20 @@ parse_menu_item (item, notreal, inmenubar) Lisp_Object item; int notreal, inmenubar; { - Lisp_Object def, tem; - - Lisp_Object type = Qnil; - Lisp_Object cachelist = Qnil; - Lisp_Object filter = Qnil; - Lisp_Object item_string, start; + Lisp_Object def, tem, item_string, start; + Lisp_Object cachelist; + Lisp_Object filter; + Lisp_Object keyhint; int i; - struct gcpro gcpro1, gcpro2, gcpro3; + int newcache = 0; -#define RET0 \ - if (1) \ - { \ - UNGCPRO; \ - return 0; \ - } \ - else + cachelist = Qnil; + filter = Qnil; + keyhint = Qnil; if (!CONSP (item)) return 0; - GCPRO3 (item, notreal, inmenubar); - /* Create item_properties vector if necessary. */ if (NILP (item_properties)) item_properties @@ -5585,31 +6476,31 @@ parse_menu_item (item, notreal, inmenubar) /* Save the item here to protect it from GC. */ XVECTOR (item_properties)->contents[ITEM_PROPERTY_ITEM] = item; - item_string = XCONS (item)->car; + item_string = XCAR (item); start = item; - item = XCONS (item)->cdr; + item = XCDR (item); if (STRINGP (item_string)) { /* Old format menu item. */ XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string; /* Maybe help string. */ - if (CONSP (item) && STRINGP (XCONS (item)->car)) + if (CONSP (item) && STRINGP (XCAR (item))) { XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] - = XCONS (item)->car; + = XCAR (item); start = item; - item = XCONS (item)->cdr; + item = XCDR (item); } - /* Maybee key binding cache. */ - if (CONSP (item) && CONSP (XCONS (item)->car) - && (NILP (XCONS (XCONS (item)->car)->car) - || VECTORP (XCONS (XCONS (item)->car)->car))) + /* Maybe key binding cache. */ + if (CONSP (item) && CONSP (XCAR (item)) + && (NILP (XCAR (XCAR (item))) + || VECTORP (XCAR (XCAR (item))))) { - cachelist = XCONS (item)->car; - item = XCONS (item)->cdr; + cachelist = XCAR (item); + item = XCDR (item); } /* This is the real definition--the function to run. */ @@ -5627,64 +6518,80 @@ parse_menu_item (item, notreal, inmenubar) { /* New format menu item. */ XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] - = XCONS (item)->car; - start = XCONS (item)->cdr; + = XCAR (item); + start = XCDR (item); if (CONSP (start)) { /* We have a real binding. */ XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] - = XCONS (start)->car; + = XCAR (start); - item = XCONS (start)->cdr; + item = XCDR (start); /* Is there a cache list with key equivalences. */ - if (CONSP (item) && CONSP (XCONS (item)->car)) + if (CONSP (item) && CONSP (XCAR (item))) { - cachelist = XCONS (item)->car; - item = XCONS (item)->cdr; + cachelist = XCAR (item); + item = XCDR (item); } /* Parse properties. */ - while (CONSP (item) && CONSP (XCONS (item)->cdr)) + while (CONSP (item) && CONSP (XCDR (item))) { - tem = XCONS (item)->car; - item = XCONS (item)->cdr; + tem = XCAR (item); + item = XCDR (item); if (EQ (tem, QCenable)) XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] - = XCONS (item)->car; + = XCAR (item); else if (EQ (tem, QCvisible) && !notreal) { /* If got a visible property and that evaluates to nil then ignore this item. */ - tem = menu_item_eval_property (XCONS (item)->car); + tem = menu_item_eval_property (XCAR (item)); if (NILP (tem)) - RET0; + return 0; } else if (EQ (tem, QChelp)) XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] - = XCONS (item)->car; + = XCAR (item); else if (EQ (tem, QCfilter)) - filter = XCONS (item)->car; - else if (EQ (tem, QCbutton) && CONSP (XCONS (item)->car)) + filter = item; + else if (EQ (tem, QCkey_sequence)) { - tem = XCONS (item)->car; - type = XCONS (tem)->car; + tem = XCAR (item); + if (NILP (cachelist) + && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem))) + /* Be GC protected. Set keyhint to item instead of tem. */ + keyhint = item; + } + else if (EQ (tem, QCkeys)) + { + tem = XCAR (item); + if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist))) + XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ] + = tem; + } + else if (EQ (tem, QCbutton) && CONSP (XCAR (item))) + { + Lisp_Object type; + tem = XCAR (item); + type = XCAR (tem); if (EQ (type, QCtoggle) || EQ (type, QCradio)) { XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED] - = XCONS (tem)->cdr; + = XCDR (tem); XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE] = type; } } - item = XCONS (item)->cdr; + item = XCDR (item); } } else if (inmenubar || !NILP (start)) - RET0; + return 0; } else - RET0; + return 0; /* not a menu item */ /* If item string is not a string, evaluate it to get string. If we don't get a string, skip this item. */ @@ -5693,7 +6600,7 @@ parse_menu_item (item, notreal, inmenubar) { item_string = menu_item_eval_property (item_string); if (!STRINGP (item_string)) - RET0; + return 0; XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME] = item_string; } @@ -5701,132 +6608,568 @@ parse_menu_item (item, notreal, inmenubar) def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; if (!NILP (filter)) { - def = menu_item_eval_property (Fcons (filter, Fcons (def, Qnil))); + def = menu_item_eval_property (list2 (XCAR (filter), + list2 (Qquote, def))); + XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = def; } - /* If we got no definition, this item is just unselectable text which - is ok when in a submenu and if there is an item string. */ - item_string = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME]; - if (NILP (def)) - { - UNGCPRO; - return (!inmenubar && STRINGP (item_string) ? 1 : 0); - } - - /* Enable or disable selection of item. */ - tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE]; - if (!EQ (tem, Qt)) - { - if (notreal) - tem = Qt; - else - tem = menu_item_eval_property (tem); - if (inmenubar && NILP (tem)) - RET0; /* Ignore disabled items in menu bar. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem; - } + /* If we got no definition, this item is just unselectable text which + is OK in a submenu but not in the menubar. */ + if (NILP (def)) + return (inmenubar ? 0 : 1); + + /* Enable or disable selection of item. */ + tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE]; + if (!EQ (tem, Qt)) + { + if (notreal) + tem = Qt; + else + tem = menu_item_eval_property (tem); + if (inmenubar && NILP (tem)) + return 0; /* Ignore disabled items in menu bar. */ + XVECTOR (item_properties)->contents[ITEM_PROPERTY_ENABLE] = tem; + } + + /* See if this is a separate pane or a submenu. */ + def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; + tem = get_keymap_1 (def, 0, 1); + /* For a subkeymap, just record its details and exit. */ + if (!NILP (tem)) + { + XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP] = tem; + XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = tem; + return 1; + } + /* At the top level in the menu bar, do likewise for commands also. + The menu bar does not display equivalent key bindings anyway. + ITEM_PROPERTY_DEF is already set up properly. */ + if (inmenubar > 0) + return 1; + + /* This is a command. See if there is an equivalent key binding. */ + if (NILP (cachelist)) + { + /* We have to create a cachelist. */ + CHECK_IMPURE (start); + XCDR (start) = Fcons (Fcons (Qnil, Qnil), XCDR (start)); + cachelist = XCAR (XCDR (start)); + newcache = 1; + tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]; + if (!NILP (keyhint)) + { + XCAR (cachelist) = XCAR (keyhint); + newcache = 0; + } + else if (STRINGP (tem)) + { + XCDR (cachelist) = Fsubstitute_command_keys (tem); + XCAR (cachelist) = Qt; + } + } + tem = XCAR (cachelist); + if (!EQ (tem, Qt)) + { + int chkcache = 0; + Lisp_Object prefix; + + if (!NILP (tem)) + tem = Fkey_binding (tem, Qnil); + + prefix = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]; + if (CONSP (prefix)) + { + def = XCAR (prefix); + prefix = XCDR (prefix); + } + else + def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; + + if (NILP (XCAR (cachelist))) /* Have no saved key. */ + { + if (newcache /* Always check first time. */ + /* Should we check everything when precomputing key + bindings? */ + /* || notreal */ + /* If something had no key binding before, don't recheck it + because that is too slow--except if we have a list of + rebound commands in Vdefine_key_rebound_commands, do + recheck any command that appears in that list. */ + || (CONSP (Vdefine_key_rebound_commands) + && !NILP (Fmemq (def, Vdefine_key_rebound_commands)))) + chkcache = 1; + } + /* We had a saved key. Is it still bound to the command? */ + else if (NILP (tem) + || (!EQ (tem, def) + /* If the command is an alias for another + (such as lmenu.el set it up), check if the + original command matches the cached command. */ + && !(SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function)))) + chkcache = 1; /* Need to recompute key binding. */ + + if (chkcache) + { + /* Recompute equivalent key binding. If the command is an alias + for another (such as lmenu.el set it up), see if the original + command name has equivalent keys. Otherwise look up the + specified command itself. We don't try both, because that + makes lmenu menus slow. */ + if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function) + && ! NILP (Fget (def, Qmenu_alias))) + def = XSYMBOL (def)->function; + tem = Fwhere_is_internal (def, Qnil, Qt, Qnil); + XCAR (cachelist) = tem; + if (NILP (tem)) + { + XCDR (cachelist) = Qnil; + chkcache = 0; + } + } + else if (!NILP (keyhint) && !NILP (XCAR (cachelist))) + { + tem = XCAR (cachelist); + chkcache = 1; + } + + newcache = chkcache; + if (chkcache) + { + tem = Fkey_description (tem); + if (CONSP (prefix)) + { + if (STRINGP (XCAR (prefix))) + tem = concat2 (XCAR (prefix), tem); + if (STRINGP (XCDR (prefix))) + tem = concat2 (tem, XCDR (prefix)); + } + XCDR (cachelist) = tem; + } + } + + tem = XCDR (cachelist); + if (newcache && !NILP (tem)) + { + tem = concat3 (build_string (" ("), tem, build_string (")")); + XCDR (cachelist) = tem; + } + + /* If we only want to precompute equivalent key bindings, stop here. */ + if (notreal) + return 1; + + /* If we have an equivalent key binding, use that. */ + XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ] = tem; + + /* Include this when menu help is implemented. + tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]; + if (!(NILP (tem) || STRINGP (tem))) + { + tem = menu_item_eval_property (tem); + if (!STRINGP (tem)) + tem = Qnil; + XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem; + } + */ + + /* Handle radio buttons or toggle boxes. */ + tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]; + if (!NILP (tem)) + XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED] + = menu_item_eval_property (tem); + + return 1; +} + + + +/*********************************************************************** + Tool-bars + ***********************************************************************/ + +/* A vector holding tool bar items while they are parsed in function + tool_bar_items runs Each item occupies TOOL_BAR_ITEM_NSCLOTS elements + in the vector. */ + +static Lisp_Object tool_bar_items_vector; + +/* A vector holding the result of parse_tool_bar_item. Layout is like + the one for a single item in tool_bar_items_vector. */ + +static Lisp_Object tool_bar_item_properties; + +/* Next free index in tool_bar_items_vector. */ + +static int ntool_bar_items; + +/* The symbols `tool-bar', and `:image'. */ + +extern Lisp_Object Qtool_bar; +Lisp_Object QCimage; + +/* Function prototypes. */ + +static void init_tool_bar_items P_ ((Lisp_Object)); +static void process_tool_bar_item P_ ((Lisp_Object, Lisp_Object)); +static int parse_tool_bar_item P_ ((Lisp_Object, Lisp_Object)); +static void append_tool_bar_item P_ ((void)); + + +/* Return a vector of tool bar items for keymaps currently in effect. + Reuse vector REUSE if non-nil. Return in *NITEMS the number of + tool bar items found. */ + +Lisp_Object +tool_bar_items (reuse, nitems) + Lisp_Object reuse; + int *nitems; +{ + Lisp_Object *maps; + int nmaps, i; + Lisp_Object oquit; + Lisp_Object *tmaps; + extern Lisp_Object Voverriding_local_map_menu_flag; + extern Lisp_Object Voverriding_local_map; + + *nitems = 0; + + /* In order to build the menus, we need to call the keymap + accessors. They all call QUIT. But this function is called + during redisplay, during which a quit is fatal. So inhibit + quitting while building the menus. We do this instead of + specbind because (1) errors will clear it anyway and (2) this + avoids risk of specpdl overflow. */ + oquit = Vinhibit_quit; + Vinhibit_quit = Qt; + + /* Initialize tool_bar_items_vector and protect it from GC. */ + init_tool_bar_items (reuse); + + /* Build list of keymaps in maps. Set nmaps to the number of maps + to process. */ + + /* Should overriding-terminal-local-map and overriding-local-map apply? */ + if (!NILP (Voverriding_local_map_menu_flag)) + { + /* Yes, use them (if non-nil) as well as the global map. */ + maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); + nmaps = 0; + if (!NILP (current_kboard->Voverriding_terminal_local_map)) + maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; + if (!NILP (Voverriding_local_map)) + maps[nmaps++] = Voverriding_local_map; + } + else + { + /* No, so use major and minor mode keymaps and keymap property. */ + int extra_maps = 2; + Lisp_Object map = get_local_map (PT, current_buffer, keymap); + if (!NILP (map)) + extra_maps = 3; + nmaps = current_minor_maps (NULL, &tmaps); + maps = (Lisp_Object *) alloca ((nmaps + extra_maps) + * sizeof (maps[0])); + bcopy (tmaps, maps, nmaps * sizeof (maps[0])); + if (!NILP (map)) + maps[nmaps++] = get_local_map (PT, current_buffer, keymap); + maps[nmaps++] = get_local_map (PT, current_buffer, local_map); + } + + /* Add global keymap at the end. */ + maps[nmaps++] = current_global_map; + + /* Process maps in reverse order and look up in each map the prefix + key `tool-bar'. */ + for (i = nmaps - 1; i >= 0; --i) + if (!NILP (maps[i])) + { + Lisp_Object keymap; + + keymap = get_keyelt (access_keymap (maps[i], Qtool_bar, 1, 1), 0); + if (!NILP (Fkeymapp (keymap))) + { + Lisp_Object tail; + + /* KEYMAP is a list `(keymap (KEY . BINDING) ...)'. */ + for (tail = keymap; CONSP (tail); tail = XCDR (tail)) + { + Lisp_Object keydef = XCAR (tail); + if (CONSP (keydef)) + process_tool_bar_item (XCAR (keydef), XCDR (keydef)); + } + } + } + + Vinhibit_quit = oquit; + *nitems = ntool_bar_items / TOOL_BAR_ITEM_NSLOTS; + return tool_bar_items_vector; +} + + +/* Process the definition of KEY which is DEF. */ + +static void +process_tool_bar_item (key, def) + Lisp_Object key, def; +{ + int i; + extern Lisp_Object Qundefined; + struct gcpro gcpro1, gcpro2; + + /* Protect KEY and DEF from GC because parse_tool_bar_item may call + eval. */ + GCPRO2 (key, def); - /* See if this is a separate pane or a submenu. */ - tem = get_keymap_1 (def, 0, 1); - if (!NILP (tem)) + if (EQ (def, Qundefined)) { - XVECTOR (item_properties)->contents[ITEM_PROPERTY_MAP] = tem; - XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = tem; - UNGCPRO; - return 1; + /* If a map has an explicit `undefined' as definition, + discard any previously made item. */ + for (i = 0; i < ntool_bar_items; i += TOOL_BAR_ITEM_NSLOTS) + { + Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i; + + if (EQ (key, v[TOOL_BAR_ITEM_KEY])) + { + if (ntool_bar_items > i + TOOL_BAR_ITEM_NSLOTS) + bcopy (v + TOOL_BAR_ITEM_NSLOTS, v, + ((ntool_bar_items - i - TOOL_BAR_ITEM_NSLOTS) + * sizeof (Lisp_Object))); + ntool_bar_items -= TOOL_BAR_ITEM_NSLOTS; + break; + } + } } - else if (inmenubar) - RET0; /* Entries in menu bar must be submenus. */ + else if (parse_tool_bar_item (key, def)) + /* Append a new tool bar item to tool_bar_items_vector. Accept + more than one definition for the same key. */ + append_tool_bar_item (); - /* This is a command. See if there is an equivalent key binding. */ - if (NILP (cachelist)) + UNGCPRO; +} + + +/* Parse a tool bar item specification ITEM for key KEY and return the + result in tool_bar_item_properties. Value is zero if ITEM is + invalid. + + ITEM is a list `(menu-item CAPTION BINDING PROPS...)'. + + CAPTION is the caption of the item, If it's not a string, it is + evaluated to get a string. + + BINDING is the tool bar item's binding. Tool-bar items with keymaps + as binding are currently ignored. + + The following properties are recognized: + + - `:enable FORM'. + + FORM is evaluated and specifies whether the tool bar item is + enabled or disabled. + + - `:visible FORM' + + FORM is evaluated and specifies whether the tool bar item is visible. + + - `:filter FUNCTION' + + FUNCTION is invoked with one parameter `(quote BINDING)'. Its + result is stored as the new binding. + + - `:button (TYPE SELECTED)' + + TYPE must be one of `:radio' or `:toggle'. SELECTED is evaluated + and specifies whether the button is selected (pressed) or not. + + - `:image IMAGES' + + IMAGES is either a single image specification or a vector of four + image specifications. See enum tool_bar_item_images. + + - `:help HELP-STRING'. + + Gives a help string to display for the tool bar item. */ + +static int +parse_tool_bar_item (key, item) + Lisp_Object key, item; +{ + /* Access slot with index IDX of vector tool_bar_item_properties. */ +#define PROP(IDX) XVECTOR (tool_bar_item_properties)->contents[IDX] + + Lisp_Object filter = Qnil; + Lisp_Object caption; + extern Lisp_Object QCenable, QCvisible, QChelp, QCfilter; + extern Lisp_Object QCbutton, QCtoggle, QCradio; + int i; + + /* Defininition looks like `(tool-bar-item CAPTION BINDING + PROPS...)'. Rule out items that aren't lists, don't start with + `tool-bar-item' or whose rest following `tool-bar-item' is not a + list. */ + if (!CONSP (item) + || !EQ (XCAR (item), Qmenu_item) + || (item = XCDR (item), + !CONSP (item))) + return 0; + + /* Create tool_bar_item_properties vector if necessary. Reset it to + defaults. */ + if (VECTORP (tool_bar_item_properties)) { - /* We have to create a cachelist. */ - CHECK_IMPURE (start); - XCONS (start)->cdr = Fcons (Fcons (Qnil, Qnil), XCONS (start)->cdr); - cachelist = XCONS (XCONS (start)->cdr)->car; - /* We have not checked this before so check it now. */ - tem = def; - } - else if (VECTORP (XCONS (cachelist)->car)) /* Saved key */ - { - tem = Fkey_binding (XCONS (cachelist)->car, Qnil); - if (EQ (tem, def) - /* If the command is an alias for another - (such as easymenu.el and lmenu.el set it up), - check if the original command matches the cached command. */ - || (SYMBOLP (def) && EQ (tem, XSYMBOL (def)->function))) - tem = Qnil; /* Don't need to recompute key binding. */ - else - tem = def; - } - /* If something had no key binding before, don't recheck it - because that is too slow--except if we have a list of rebound - commands in Vdefine_key_rebound_commands, do recheck any command - that appears in that list. */ - else if (!NILP (XCONS (cachelist)->car)) - tem = def; /* Should signal an error here. */ - else if ( - /* Should we check everything when precomputing key bindings? */ - /* notreal || */ - CONSP (Vdefine_key_rebound_commands) - && !NILP (Fmemq (def, Vdefine_key_rebound_commands))) - tem = def; + for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i) + PROP (i) = Qnil; + } else - tem = Qnil; + tool_bar_item_properties + = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil); - if (!NILP (tem)) - { - /* Recompute equivalent key binding. - If the command is an alias for another - (such as easymenu.el and lmenu.el set it up), - see if the original command name has equivalent keys. - Otherwise look up the specified command itself. - We don't try both, because that makes easymenu menus slow. */ - if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function) - && ! NILP (Fget (def, Qmenu_alias))) - tem = XSYMBOL (def)->function; - tem = Fwhere_is_internal (tem, Qnil, Qt, Qnil); - XCONS (cachelist)->car = tem; - XCONS (cachelist)->cdr - = (NILP (tem) ? Qnil - : - concat2 (build_string (" ("), - concat2 (Fkey_description (tem), build_string (")")))); + /* Set defaults. */ + PROP (TOOL_BAR_ITEM_KEY) = key; + PROP (TOOL_BAR_ITEM_ENABLED_P) = Qt; + + /* Get the caption of the item. If the caption is not a string, + evaluate it to get a string. If we don't get a string, skip this + item. */ + caption = XCAR (item); + if (!STRINGP (caption)) + { + caption = menu_item_eval_property (caption); + if (!STRINGP (caption)) + return 0; } + PROP (TOOL_BAR_ITEM_CAPTION) = caption; - /* If we only want to precompute equivalent key bindings, stop here. */ - if (notreal) + /* Give up if rest following the caption is not a list. */ + item = XCDR (item); + if (!CONSP (item)) + return 0; + + /* Store the binding. */ + PROP (TOOL_BAR_ITEM_BINDING) = XCAR (item); + item = XCDR (item); + + /* Process the rest of the properties. */ + for (; CONSP (item) && CONSP (XCDR (item)); item = XCDR (XCDR (item))) { - UNGCPRO; - return 1; + Lisp_Object key, value; + + key = XCAR (item); + value = XCAR (XCDR (item)); + + if (EQ (key, QCenable)) + /* `:enable FORM'. */ + PROP (TOOL_BAR_ITEM_ENABLED_P) = value; + else if (EQ (key, QCvisible)) + { + /* `:visible FORM'. If got a visible property and that + evaluates to nil then ignore this item. */ + if (NILP (menu_item_eval_property (value))) + return 0; + } + else if (EQ (key, QChelp)) + /* `:help HELP-STRING'. */ + PROP (TOOL_BAR_ITEM_HELP) = value; + else if (EQ (key, QCfilter)) + /* ':filter FORM'. */ + filter = value; + else if (EQ (key, QCbutton) && CONSP (value)) + { + /* `:button (TYPE . SELECTED)'. */ + Lisp_Object type, selected; + + type = XCAR (value); + selected = XCDR (value); + if (EQ (type, QCtoggle) || EQ (type, QCradio)) + { + PROP (TOOL_BAR_ITEM_SELECTED_P) = selected; + PROP (TOOL_BAR_ITEM_TYPE) = type; + } + } + else if (EQ (key, QCimage) + && (CONSP (value) + || (VECTORP (value) && XVECTOR (value)->size == 4))) + /* Value is either a single image specification or a vector + of 4 such specifications for the different buttion states. */ + PROP (TOOL_BAR_ITEM_IMAGES) = value; } - /* If we have an equivalent key binding, use that. */ - XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ] - = XCONS (cachelist)->cdr; - - /* Include this when menu help is implemented. - tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP]; - if (!(NILP (tem) || STRINGP (tem))) - { - tem = menu_item_eval_property (tem); - if (!STRINGP (tem)) - tem = Qnil; - XVECTOR (item_properties)->contents[ITEM_PROPERTY_HELP] = tem; - } - */ + /* If got a filter apply it on binding. */ + if (!NILP (filter)) + PROP (TOOL_BAR_ITEM_BINDING) + = menu_item_eval_property (list2 (filter, + list2 (Qquote, + PROP (TOOL_BAR_ITEM_BINDING)))); + + /* See if the binding is a keymap. Give up if it is. */ + if (!NILP (get_keymap_1 (PROP (TOOL_BAR_ITEM_BINDING), 0, 1))) + return 0; + + /* Enable or disable selection of item. */ + if (!EQ (PROP (TOOL_BAR_ITEM_ENABLED_P), Qt)) + PROP (TOOL_BAR_ITEM_ENABLED_P) + = menu_item_eval_property (PROP (TOOL_BAR_ITEM_ENABLED_P)); /* Handle radio buttons or toggle boxes. */ - tem = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]; - if (!NILP (tem)) - XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED] - = menu_item_eval_property (tem); + if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P))) + PROP (TOOL_BAR_ITEM_SELECTED_P) + = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P)); - UNGCPRO; return 1; + +#undef PROP +} + + +/* Initialize tool_bar_items_vector. REUSE, if non-nil, is a vector + that can be reused. */ + +static void +init_tool_bar_items (reuse) + Lisp_Object reuse; +{ + if (VECTORP (reuse)) + tool_bar_items_vector = reuse; + else + tool_bar_items_vector = Fmake_vector (make_number (64), Qnil); + ntool_bar_items = 0; +} + + +/* Append parsed tool bar item properties from + tool_bar_item_properties */ + +static void +append_tool_bar_item () +{ + Lisp_Object *to, *from; + + /* Enlarge tool_bar_items_vector if necessary. */ + if (ntool_bar_items + TOOL_BAR_ITEM_NSLOTS + >= XVECTOR (tool_bar_items_vector)->size) + { + Lisp_Object new_vector; + int old_size = XVECTOR (tool_bar_items_vector)->size; + + new_vector = Fmake_vector (make_number (2 * old_size), Qnil); + bcopy (XVECTOR (tool_bar_items_vector)->contents, + XVECTOR (new_vector)->contents, + old_size * sizeof (Lisp_Object)); + tool_bar_items_vector = new_vector; + } + + /* Append entries from tool_bar_item_properties to the end of + tool_bar_items_vector. */ + to = XVECTOR (tool_bar_items_vector)->contents + ntool_bar_items; + from = XVECTOR (tool_bar_item_properties)->contents; + bcopy (from, to, TOOL_BAR_ITEM_NSLOTS * sizeof *to); + ntool_bar_items += TOOL_BAR_ITEM_NSLOTS; } + + + + /* Read a character using menus based on maps in the array MAPS. NMAPS is the length of MAPS. Return nil if there are no menus in the maps. @@ -5857,7 +7200,6 @@ read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) { int mapno; register Lisp_Object name; - Lisp_Object rest, vector; if (used_mouse_menu) *used_mouse_menu = 0; @@ -5890,7 +7232,8 @@ read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) /* If we got to this point via a mouse click, use a real menu for mouse selection. */ if (EVENT_HAS_PARAMETERS (prev_event) - && !EQ (XCONS (prev_event)->car, Qmenu_bar)) + && !EQ (XCAR (prev_event), Qmenu_bar) + && !EQ (XCAR (prev_event), Qtool_bar)) { /* Display the menu and get the selection. */ Lisp_Object *realmaps @@ -5908,7 +7251,7 @@ read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) { Lisp_Object tem; - record_menu_key (XCONS (value)->car); + record_menu_key (XCAR (value)); /* If we got multiple events, unread all but the first. @@ -5918,22 +7261,22 @@ read_char_x_menu_prompt (nmaps, maps, prev_event, used_mouse_menu) to indicate that they came from a mouse menu, so that when present in last_nonmenu_event they won't confuse things. */ - for (tem = XCONS (value)->cdr; !NILP (tem); - tem = XCONS (tem)->cdr) + for (tem = XCDR (value); !NILP (tem); + tem = XCDR (tem)) { - record_menu_key (XCONS (tem)->car); - if (SYMBOLP (XCONS (tem)->car) - || INTEGERP (XCONS (tem)->car)) - XCONS (tem)->car - = Fcons (XCONS (tem)->car, Qnil); + record_menu_key (XCAR (tem)); + if (SYMBOLP (XCAR (tem)) + || INTEGERP (XCAR (tem))) + XCAR (tem) + = Fcons (XCAR (tem), Qnil); } /* If we got more than one event, put all but the first onto this list to be read later. Return just the first event now. */ Vunread_command_events - = nconc2 (XCONS (value)->cdr, Vunread_command_events); - value = XCONS (value)->car; + = nconc2 (XCDR (value), Vunread_command_events); + value = XCAR (value); } else if (NILP (value)) value = Qt; @@ -5960,7 +7303,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) int mapno; register Lisp_Object name; int nlength; - int width = FRAME_WIDTH (selected_frame) - 4; + int width = FRAME_WIDTH (SELECTED_FRAME ()) - 4; int idx = -1; int nobindings = 1; Lisp_Object rest, vector; @@ -6018,7 +7361,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) /* Loop over elements of map. */ while (i < width) { - Lisp_Object s, elt; + Lisp_Object elt; /* If reached end of map, start at beginning of next map. */ if (NILP (rest)) @@ -6051,33 +7394,55 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) else { /* An ordinary element. */ - Lisp_Object event; + Lisp_Object event, tem; if (idx < 0) { - s = Fcar_safe (Fcdr_safe (elt)); /* alist */ - event = Fcar_safe (elt); + event = Fcar_safe (elt); /* alist */ + elt = Fcdr_safe (elt); } else { - s = Fcar_safe (elt); /* vector */ - XSETINT (event, idx); + XSETINT (event, idx); /* vector */ } /* Ignore the element if it has no prompt string. */ - if (STRINGP (s) && INTEGERP (event)) + if (INTEGERP (event) && parse_menu_item (elt, 0, -1)) { /* 1 if the char to type matches the string. */ int char_matches; Lisp_Object upcased_event, downcased_event; Lisp_Object desc; + Lisp_Object s + = XVECTOR (item_properties)->contents[ITEM_PROPERTY_NAME]; upcased_event = Fupcase (event); downcased_event = Fdowncase (event); char_matches = (XINT (upcased_event) == XSTRING (s)->data[0] || XINT (downcased_event) == XSTRING (s)->data[0]); if (! char_matches) - desc = Fsingle_key_description (event); + desc = Fsingle_key_description (event, Qnil); + + tem + = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]; + if (!NILP (tem)) + /* Insert equivalent keybinding. */ + s = concat2 (s, tem); + + tem + = XVECTOR (item_properties)->contents[ITEM_PROPERTY_TYPE]; + if (EQ (tem, QCradio) || EQ (tem, QCtoggle)) + { + /* Insert button prefix. */ + Lisp_Object selected + = XVECTOR (item_properties)->contents[ITEM_PROPERTY_SELECTED]; + if (EQ (tem, QCradio)) + tem = build_string (NILP (selected) ? "(*) " : "( ) "); + else + tem = build_string (NILP (selected) ? "[X] " : "[ ] "); + s = concat2 (tem, s); + } + /* If we have room for the prompt string, add it to this line. If this is the first on the line, always add it. */ @@ -6201,7 +7566,7 @@ follow_key (key, nmaps, current, defs, next) followed by the corresponding non-meta character. Put the results into DEFS, since we are going to alter that anyway. Do not alter CURRENT or NEXT. */ - if (INTEGERP (key) && (XINT (key) & CHAR_META)) + if (INTEGERP (key) && (XUINT (key) & CHAR_META)) { for (i = 0; i < nmaps; i++) if (! NILP (current[i])) @@ -6233,7 +7598,7 @@ follow_key (key, nmaps, current, defs, next) else map = current[i]; - defs[i] = get_keyelt (access_keymap (map, key, 1, 0), 0); + defs[i] = get_keyelt (access_keymap (map, key, 1, 0), 1); if (! NILP (defs[i])) first_binding = i; } @@ -6322,6 +7687,10 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, /* The local map to start out with at start of key sequence. */ Lisp_Object orig_local_map; + /* The map from the `keymap' property to start out with at start of + key sequence. */ + Lisp_Object orig_keymap; + /* 1 if we have already considered switching to the local-map property of the place where a mouse click occurred. */ int localized_local_map = 0; @@ -6393,7 +7762,11 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, int prev_keytran_start; int prev_keytran_end; +#if defined (GOBBLE_FIRST_EVENT) int junk; +#endif + + raw_keybuf_count = 0; last_nonmenu_event = Qnil; @@ -6413,7 +7786,9 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, { if (!NILP (prompt)) echo_prompt (XSTRING (prompt)->data); - else if (cursor_in_echo_area && echo_keystrokes) + else if (cursor_in_echo_area + && (FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) + && NILP (Fzerop (Vecho_keystrokes))) /* This doesn't put in a dash if the echo buffer is empty, so you don't always see a dash hanging out in the minibuffer. */ echo_dash (); @@ -6437,7 +7812,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, &junk); #endif /* GOBBLE_FIRST_EVENT */ - orig_local_map = get_local_map (PT, current_buffer); + orig_local_map = get_local_map (PT, current_buffer, local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); /* We jump here when the key sequence has been thoroughly changed, and we need to rescan it starting from the beginning. When we jump here, @@ -6473,19 +7849,22 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, } else { + int extra_maps = 2; nmaps = current_minor_maps (0, &maps); - if (nmaps + 2 > nmaps_allocated) + if (!NILP (orig_keymap)) + extra_maps = 3; + if (nmaps + extra_maps > nmaps_allocated) { - submaps = (Lisp_Object *) alloca ((nmaps+2) * sizeof (submaps[0])); - defs = (Lisp_Object *) alloca ((nmaps+2) * sizeof (defs[0])); - nmaps_allocated = nmaps + 2; + submaps = (Lisp_Object *) alloca ((nmaps+extra_maps) + * sizeof (submaps[0])); + defs = (Lisp_Object *) alloca ((nmaps+extra_maps) + * sizeof (defs[0])); + nmaps_allocated = nmaps + extra_maps; } bcopy (maps, submaps, nmaps * sizeof (submaps[0])); -#ifdef USE_TEXT_PROPERTIES + if (!NILP (orig_keymap)) + submaps[nmaps++] = orig_keymap; submaps[nmaps++] = orig_local_map; -#else - submaps[nmaps++] = current_buffer->keymap; -#endif } submaps[nmaps++] = current_global_map; } @@ -6563,19 +7942,18 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, { key = keybuf[t]; add_command_key (key); - if (echo_keystrokes) + if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) + && NILP (Fzerop (Vecho_keystrokes))) echo_char (key); } /* If not, we should actually read a character. */ else { - struct buffer *buf = current_buffer; - { #ifdef MULTI_KBOARD KBOARD *interrupted_kboard = current_kboard; - struct frame *interrupted_frame = selected_frame; + struct frame *interrupted_frame = SELECTED_FRAME (); if (setjmp (wrong_kboard_jmpbuf)) { if (!NILP (delayed_switch_frame)) @@ -6592,7 +7970,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, /* If the side queue is non-empty, ensure it begins with a switch-frame, so we'll replay it in the right context. */ if (CONSP (interrupted_kboard->kbd_queue) - && (key = XCONS (interrupted_kboard->kbd_queue)->car, + && (key = XCAR (interrupted_kboard->kbd_queue), !(EVENT_HAS_PARAMETERS (key) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame)))) @@ -6604,7 +7982,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, interrupted_kboard->kbd_queue); } mock_input = 0; - orig_local_map = get_local_map (PT, current_buffer); + orig_local_map = get_local_map (PT, current_buffer, local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); goto replay_sequence; } #endif @@ -6615,7 +7994,10 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, /* read_char returns t when it shows a menu and the user rejects it. Just return -1. */ if (EQ (key, Qt)) - return -1; + { + unbind_to (count, Qnil); + return -1; + } /* read_char returns -1 at the end of a macro. Emacs 18 handles this by returning immediately with a @@ -6639,10 +8021,15 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, This is to be more consistent with the behavior of the command_loop_1. */ if (fix_current_buffer) - if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) - Fset_buffer (XWINDOW (selected_window)->buffer); + { + if (! FRAME_LIVE_P (XFRAME (selected_frame))) + Fkill_emacs (Qnil); + if (XBUFFER (XWINDOW (selected_window)->buffer) != current_buffer) + Fset_buffer (XWINDOW (selected_window)->buffer); + } - orig_local_map = get_local_map (PT, current_buffer); + orig_local_map = get_local_map (PT, current_buffer, local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); goto replay_sequence; } @@ -6651,14 +8038,33 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, replay to get the right keymap. */ if (XINT (key) == quit_char && current_buffer != starting_buffer) { + GROW_RAW_KEYBUF; + XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key; keybuf[t++] = key; mock_input = t; Vquit_flag = Qnil; - orig_local_map = get_local_map (PT, current_buffer); + orig_local_map = get_local_map (PT, current_buffer, local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); goto replay_sequence; } Vquit_flag = Qnil; + + if (EVENT_HAS_PARAMETERS (key) + && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame)) + { + /* If we're at the beginning of a key sequence, and the caller + says it's okay, go ahead and return this event. If we're + in the midst of a key sequence, delay it until the end. */ + if (t > 0 || !can_return_switch_frame) + { + delayed_switch_frame = key; + goto replay_key; + } + } + + GROW_RAW_KEYBUF; + XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key; } /* Clicks in non-text areas get prefixed by the symbol @@ -6686,6 +8092,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, window = POSN_WINDOW (EVENT_START (key)); posn = POSN_BUFFER_POSN (EVENT_START (key)); + if (CONSP (posn)) { /* We're looking at the second event of a @@ -6704,6 +8111,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, && BUFFERP (XWINDOW (window)->buffer) && XBUFFER (XWINDOW (window)->buffer) != current_buffer) { + XVECTOR (raw_keybuf)->contents[raw_keybuf_count++] = key; keybuf[t] = key; mock_input = t + 1; @@ -6719,32 +8127,52 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, emacsclient). */ record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - set_buffer_internal (XBUFFER (XWINDOW (window)->buffer)); - orig_local_map = get_local_map (PT, current_buffer); + if (! FRAME_LIVE_P (XFRAME (selected_frame))) + Fkill_emacs (Qnil); + set_buffer_internal (XBUFFER (XWINDOW + (window)->buffer) +); + orig_local_map = get_local_map (PT, current_buffer, + local_map); + orig_keymap = get_local_map (PT, current_buffer, keymap); goto replay_sequence; } + /* For a mouse click, get the local text-property keymap of the place clicked on, rather than point. */ - if (last_real_key_start == 0 && CONSP (XCONS (key)->cdr) + if (last_real_key_start == 0 + && CONSP (XCDR (key)) && ! localized_local_map) { Lisp_Object map_here, start, pos; localized_local_map = 1; start = EVENT_START (key); - if (CONSP (start) && CONSP (XCONS (start)->cdr)) + + if (CONSP (start) && CONSP (XCDR (start))) { pos = POSN_BUFFER_POSN (start); if (INTEGERP (pos) && XINT (pos) >= BEG && XINT (pos) <= Z) { - map_here = get_local_map (XINT (pos), current_buffer); + map_here = get_local_map (XINT (pos), + current_buffer, local_map); if (!EQ (map_here, orig_local_map)) { orig_local_map = map_here; keybuf[t] = key; mock_input = t + 1; + goto replay_sequence; + } + map_here = get_local_map (XINT (pos), + current_buffer, keymap); + if (!EQ (map_here, orig_keymap)) + { + orig_keymap = map_here; + keybuf[t] = key; + mock_input = t + 1; + goto replay_sequence; } } @@ -6760,35 +8188,48 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, keybuf[t] = posn; keybuf[t+1] = key; mock_input = t + 2; - + /* Zap the position in key, so we know that we've expanded it, and don't try to do so again. */ POSN_BUFFER_POSN (EVENT_START (key)) = Fcons (posn, Qnil); + + /* If on a mode line string with a local keymap, + reconsider the key sequence with that keymap. */ + if (CONSP (POSN_STRING (EVENT_START (key)))) + { + Lisp_Object string, pos, map, map2; + + string = POSN_STRING (EVENT_START (key)); + pos = XCDR (string); + string = XCAR (string); + if (XINT (pos) >= 0 + && XINT (pos) < XSTRING (string)->size) + { + map = Fget_text_property (pos, Qlocal_map, string); + if (!NILP (map)) + orig_local_map = map; + map2 = Fget_text_property (pos, Qkeymap, string); + if (!NILP (map2)) + orig_keymap = map2; + if (!NILP (map) || !NILP (map2)) + goto replay_sequence; + } + } + goto replay_key; } } - else if (EQ (kind, Qswitch_frame)) - { - /* If we're at the beginning of a key sequence, and the caller - says it's okay, go ahead and return this event. If we're - in the midst of a key sequence, delay it until the end. */ - if (t > 0 || !can_return_switch_frame) - { - delayed_switch_frame = key; - goto replay_key; - } - } - else if (CONSP (XCONS (key)->cdr) + else if (CONSP (XCDR (key)) && CONSP (EVENT_START (key)) - && CONSP (XCONS (EVENT_START (key))->cdr)) + && CONSP (XCDR (EVENT_START (key)))) { Lisp_Object posn; posn = POSN_BUFFER_POSN (EVENT_START (key)); /* Handle menu-bar events: insert the dummy prefix event `menu-bar'. */ - if (EQ (posn, Qmenu_bar)) + if (EQ (posn, Qmenu_bar) || EQ (posn, Qtool_bar)) { if (t + 1 >= bufsize) error ("Key sequence too long"); @@ -6846,7 +8287,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, int modifiers; breakdown = parse_modifiers (head); - modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car); + modifiers = XINT (XCAR (XCDR (breakdown))); /* Attempt to reduce an unbound mouse event to a simpler event that is bound: Drags reduce to clicks. @@ -6915,7 +8356,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, } new_head - = apply_modifiers (modifiers, XCONS (breakdown)->car); + = apply_modifiers (modifiers, XCAR (breakdown)); new_click = Fcons (new_head, Fcons (EVENT_START (key), Qnil)); @@ -6980,7 +8421,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, key = keybuf[fkey_end++]; /* Look up meta-characters by prefixing them with meta_prefix_char. I hate this. */ - if (INTEGERP (key) && XINT (key) & meta_modifier) + if (INTEGERP (key) && XUINT (key) & meta_modifier) { fkey_next = get_keymap_1 @@ -6993,7 +8434,21 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, fkey_next = fkey_map; fkey_next - = get_keyelt (access_keymap (fkey_next, key, 1, 0), 0); + = get_keyelt (access_keymap (fkey_next, key, 1, 0), 1); + + /* Handle symbol with autoload definition. */ + if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next)) + && CONSP (XSYMBOL (fkey_next)->function) + && EQ (XCAR (XSYMBOL (fkey_next)->function), Qautoload)) + do_autoload (XSYMBOL (fkey_next)->function, + fkey_next); + + /* Handle a symbol whose function definition is a keymap + or an array. */ + if (SYMBOLP (fkey_next) && ! NILP (Ffboundp (fkey_next)) + && (!NILP (Farrayp (XSYMBOL (fkey_next)->function)) + || !NILP (Fkeymapp (XSYMBOL (fkey_next)->function)))) + fkey_next = XSYMBOL (fkey_next)->function; #if 0 /* I didn't turn this on, because it might cause trouble for the mapping of return into C-m and tab into C-i. */ @@ -7056,8 +8511,10 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, fkey_start = fkey_end = t; fkey_map = Vfunction_key_map; - /* Do pass the results through key-translation-map. */ - keytran_start = keytran_end = 0; + /* Do pass the results through key-translation-map. + But don't retranslate what key-translation-map + has already translated. */ + keytran_end = keytran_start; keytran_map = Vkey_translation_map; goto replay_sequence; @@ -7088,7 +8545,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, key = keybuf[keytran_end++]; /* Look up meta-characters by prefixing them with meta_prefix_char. I hate this. */ - if (INTEGERP (key) && XINT (key) & meta_modifier) + if (INTEGERP (key) && XUINT (key) & meta_modifier) { keytran_next = get_keymap_1 @@ -7101,10 +8558,24 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, keytran_next = keytran_map; keytran_next - = get_keyelt (access_keymap (keytran_next, key, 1, 0), 0); + = get_keyelt (access_keymap (keytran_next, key, 1, 0), 1); + + /* Handle symbol with autoload definition. */ + if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next)) + && CONSP (XSYMBOL (keytran_next)->function) + && EQ (XCAR (XSYMBOL (keytran_next)->function), Qautoload)) + do_autoload (XSYMBOL (keytran_next)->function, + keytran_next); + /* Handle a symbol whose function definition is a keymap + or an array. */ + if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next)) + && (!NILP (Farrayp (XSYMBOL (keytran_next)->function)) + || !NILP (Fkeymapp (XSYMBOL (keytran_next)->function)))) + keytran_next = XSYMBOL (keytran_next)->function; + /* If the key translation map gives a function, not an - array, then call the function with no args and use + array, then call the function with one arg and use its value instead. */ if (SYMBOLP (keytran_next) && ! NILP (Ffboundp (keytran_next)) && keytran_end == t) @@ -7159,7 +8630,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, /* Don't pass the results of key-translation-map through function-key-map. */ fkey_start = fkey_end = t; - fkey_map = Vkey_translation_map; + fkey_map = Vfunction_key_map; goto replay_sequence; } @@ -7228,7 +8699,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, int modifiers; breakdown = parse_modifiers (key); - modifiers = XINT (XCONS (XCONS (breakdown)->cdr)->car); + modifiers = XINT (XCAR (XCDR (breakdown))); if (modifiers & shift_modifier) { Lisp_Object new_key; @@ -7238,7 +8709,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, modifiers &= ~shift_modifier; new_key = apply_modifiers (modifiers, - XCONS (breakdown)->car); + XCAR (breakdown)); keybuf[t - 1] = new_key; mock_input = t; @@ -7281,11 +8752,14 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, Better ideas? */ for (; t < mock_input; t++) { - if (echo_keystrokes) + if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) + && NILP (Fzerop (Vecho_keystrokes))) echo_char (keybuf[t]); add_command_key (keybuf[t]); } + + return t; } @@ -7332,24 +8806,36 @@ is nil, then the event will be put off until after the current key sequence.\n\ \n\ `read-key-sequence' checks `function-key-map' for function key\n\ sequences, where they wouldn't conflict with ordinary bindings. See\n\ -`function-key-map' for more details.") - (prompt, continue_echo, dont_downcase_last, can_return_switch_frame) +`function-key-map' for more details.\n\ +\n\ +The optional fifth argument COMMAND-LOOP, if non-nil, means\n\ +that this key sequence is being read by something that will\n\ +read commands one after another. It should be nil if the caller\n\ +will read just one key sequence.") + (prompt, continue_echo, dont_downcase_last, can_return_switch_frame, command-loop) #endif -DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0, +DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0, 0) - (prompt, continue_echo, dont_downcase_last, can_return_switch_frame) + (prompt, continue_echo, dont_downcase_last, can_return_switch_frame, + command_loop) Lisp_Object prompt, continue_echo, dont_downcase_last; - Lisp_Object can_return_switch_frame; + Lisp_Object can_return_switch_frame, command_loop; { Lisp_Object keybuf[30]; register int i; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; + int count = specpdl_ptr - specpdl; if (!NILP (prompt)) CHECK_STRING (prompt, 0); QUIT; + specbind (Qinput_method_exit_on_first_char, + (NILP (command_loop) ? Qt : Qnil)); + specbind (Qinput_method_use_echo_area, + (NILP (command_loop) ? Qt : Qnil)); + bzero (keybuf, sizeof keybuf); GCPRO1 (keybuf[0]); gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0])); @@ -7360,34 +8846,51 @@ DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 4, 0, this_single_command_key_start = 0; } +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + cancel_busy_cursor (); +#endif + i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])), prompt, ! NILP (dont_downcase_last), ! NILP (can_return_switch_frame), 0); +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + start_busy_cursor (); +#endif + if (i == -1) { Vquit_flag = Qt; QUIT; } UNGCPRO; - return make_event_array (i, keybuf); + return unbind_to (count, make_event_array (i, keybuf)); } DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector, - Sread_key_sequence_vector, 1, 4, 0, + Sread_key_sequence_vector, 1, 5, 0, "Like `read-key-sequence' but always return a vector.") - (prompt, continue_echo, dont_downcase_last, can_return_switch_frame) + (prompt, continue_echo, dont_downcase_last, can_return_switch_frame, + command_loop) Lisp_Object prompt, continue_echo, dont_downcase_last; - Lisp_Object can_return_switch_frame; + Lisp_Object can_return_switch_frame, command_loop; { Lisp_Object keybuf[30]; register int i; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; + int count = specpdl_ptr - specpdl; if (!NILP (prompt)) CHECK_STRING (prompt, 0); QUIT; + specbind (Qinput_method_exit_on_first_char, + (NILP (command_loop) ? Qt : Qnil)); + specbind (Qinput_method_use_echo_area, + (NILP (command_loop) ? Qt : Qnil)); + bzero (keybuf, sizeof keybuf); GCPRO1 (keybuf[0]); gcpro1.nvars = (sizeof keybuf/sizeof (keybuf[0])); @@ -7398,17 +8901,27 @@ DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector, this_single_command_key_start = 0; } +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + cancel_busy_cursor (); +#endif + i = read_key_sequence (keybuf, (sizeof keybuf/sizeof (keybuf[0])), prompt, ! NILP (dont_downcase_last), ! NILP (can_return_switch_frame), 0); +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + start_busy_cursor (); +#endif + if (i == -1) { Vquit_flag = Qt; QUIT; } UNGCPRO; - return Fvector (i, keybuf); + return unbind_to (count, Fvector (i, keybuf)); } DEFUN ("command-execute", Fcommand_execute, Scommand_execute, 1, 4, 0, @@ -7474,13 +8987,24 @@ a special event, so ignore the prefix argument and don't clear it.") other sorts of commands, call-interactively takes care of this. */ if (!NILP (record_flag)) - Vcommand_history - = Fcons (Fcons (Qexecute_kbd_macro, - Fcons (final, Fcons (prefixarg, Qnil))), - Vcommand_history); + { + Vcommand_history + = Fcons (Fcons (Qexecute_kbd_macro, + Fcons (final, Fcons (prefixarg, Qnil))), + Vcommand_history); + + /* Don't keep command history around forever. */ + if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0) + { + tem = Fnthcdr (Vhistory_length, Vcommand_history); + if (CONSP (tem)) + XCDR (tem) = Qnil; + } + } return Fexecute_kbd_macro (final, prefixarg); } + if (CONSP (final) || SUBRP (final) || COMPILEDP (final)) { backtrace.next = backtrace_list; @@ -7517,14 +9041,14 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ if (EQ (prefixarg, Qminus)) strcpy (buf, "- "); - else if (CONSP (prefixarg) && XINT (XCONS (prefixarg)->car) == 4) + else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4) strcpy (buf, "C-u "); - else if (CONSP (prefixarg) && INTEGERP (XCONS (prefixarg)->car)) + else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg))) { if (sizeof (int) == sizeof (EMACS_INT)) - sprintf (buf, "%d ", XINT (XCONS (prefixarg)->car)); + sprintf (buf, "%d ", XINT (XCAR (prefixarg))); else if (sizeof (long) == sizeof (EMACS_INT)) - sprintf (buf, "%ld ", XINT (XCONS (prefixarg)->car)); + sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg))); else abort (); } @@ -7533,7 +9057,7 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ if (sizeof (int) == sizeof (EMACS_INT)) sprintf (buf, "%d ", XINT (prefixarg)); else if (sizeof (long) == sizeof (EMACS_INT)) - sprintf (buf, "%ld ", XINT (prefixarg)); + sprintf (buf, "%ld ", (long) XINT (prefixarg)); else abort (); } @@ -7580,7 +9104,8 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ function = Fintern (function, Qnil); current_kboard->Vprefix_arg = prefixarg; - this_command = function; + Vthis_command = function; + real_this_command = function; /* If enabled, show which key runs this command. */ if (!NILP (Vsuggest_key_bindings) @@ -7601,16 +9126,23 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ Qmouse_movement))) { /* But first wait, and skip the message if there is input. */ - if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings) - ? Vsuggest_key_bindings : make_number (2)), - Qnil, Qnil)) + int delay_time; + if (!NILP (echo_area_buffer[0])) + /* This command displayed something in the echo area; + so wait a few seconds, then display our suggestion message. */ + delay_time = (NUMBERP (Vsuggest_key_bindings) + ? XINT (Vsuggest_key_bindings) : 2); + else + /* This command left the echo area empty, + so display our message immediately. */ + delay_time = 0; + + if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil)) && ! CONSP (Vunread_command_events)) { Lisp_Object binding; char *newmessage; - char *oldmessage = echo_area_glyphs; - int oldmessage_len = echo_area_glyphs_length; - int oldmultibyte = message_enable_multibyte; + int message_p = push_message (); binding = Fkey_description (bindings); @@ -7626,8 +9158,11 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ STRING_MULTIBYTE (binding)); if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings) ? Vsuggest_key_bindings : make_number (2)), - Qnil, Qnil))) - message2_nolog (oldmessage, oldmessage_len, oldmultibyte); + Qnil, Qnil)) + && message_p) + restore_message (); + + pop_message (); } } @@ -7659,15 +9194,18 @@ current_active_maps (maps_p) } else { - /* No, so use major and minor mode keymaps. */ + /* No, so use major and minor mode keymaps and keymap property. */ + int extra_maps = 2; + Lisp_Object map = get_local_map (PT, current_buffer, keymap); + if (!NILP (map)) + extra_maps = 3; nmaps = current_minor_maps (NULL, &tmaps); - maps = (Lisp_Object *) xmalloc ((nmaps + 2) * sizeof (maps[0])); + maps = (Lisp_Object *) alloca ((nmaps + extra_maps) + * sizeof (maps[0])); bcopy (tmaps, maps, nmaps * sizeof (maps[0])); -#ifdef USE_TEXT_PROPERTIES - maps[nmaps++] = get_local_map (PT, current_buffer); -#else - maps[nmaps++] = current_buffer->keymap; -#endif + if (!NILP (map)) + maps[nmaps++] = get_local_map (PT, current_buffer, keymap); + maps[nmaps++] = get_local_map (PT, current_buffer, local_map); } maps[nmaps++] = current_global_map; @@ -7698,7 +9236,16 @@ detect_input_pending_run_timers (do_display) get_input_pending (&input_pending, 1); if (old_timers_run != timers_run && do_display) - redisplay_preserve_echo_area (); + { + redisplay_preserve_echo_area (); + /* The following fixes a bug when using lazy-lock with + lazy-lock-defer-on-the-fly set to t, i.e. when fontifying + from an idle timer function. The symptom of the bug is that + the cursor sometimes doesn't become visible until the next X + event is processed. --gerd. */ + if (rif) + rif->flush_display (NULL); + } return input_pending; } @@ -7791,6 +9338,18 @@ The value is always a vector.") + this_single_command_key_start)); } +DEFUN ("this-single-command-raw-keys", Fthis_single_command_raw_keys, + Sthis_single_command_raw_keys, 0, 0, 0, + "Return the raw events that were read for this command.\n\ +Unlike `this-single-command-keys', this function's value\n\ +shows the events before all translations (except for input methods).\n\ +The value is always a vector.") + () +{ + return Fvector (raw_keybuf_count, + (XVECTOR (raw_keybuf)->contents)); +} + DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, Sreset_this_command_lengths, 0, 0, 0, "Used for complicated reasons in `universal-argument-other-key'.\n\ @@ -7809,6 +9368,24 @@ appears in the echo area and in the value of `this-command-keys.'.") before_command_restore_flag = 1; before_command_key_count_1 = before_command_key_count; before_command_echo_length_1 = before_command_echo_length; + return Qnil; +} + +DEFUN ("clear-this-command-keys", Fclear_this_command_keys, + Sclear_this_command_keys, 0, 0, 0, + "Clear out the vector that `this-command-keys' returns.\n\ +Clear vector containing last 100 events.") + () +{ + int i; + + this_command_key_count = 0; + + for (i = 0; i < XVECTOR (recent_keys)->size; ++i) + XVECTOR (recent_keys)->contents[i] = Qnil; + total_keys = 0; + recent_keys_index = 0; + return Qnil; } DEFUN ("recursion-depth", Frecursion_depth, Srecursion_depth, 0, 0, 0, @@ -7855,11 +9432,8 @@ Also cancel any kbd macro being defined.") discard_tty_input (); - /* Without the cast, GCC complains that this assignment loses the - volatile qualifier of kbd_store_ptr. Is there anything wrong - with that? */ - kbd_fetch_ptr = (struct input_event *) kbd_store_ptr; - Ffillarray (kbd_buffer_frame_or_window, Qnil); + kbd_fetch_ptr = kbd_store_ptr; + Ffillarray (kbd_buffer_gcpro, Qnil); input_pending = 0; return Qnil; @@ -7880,11 +9454,10 @@ On such systems, Emacs starts a subshell instead of suspending.") (stuffstring) Lisp_Object stuffstring; { - Lisp_Object tem; int count = specpdl_ptr - specpdl; int old_height, old_width; int width, height; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; if (!NILP (stuffstring)) CHECK_STRING (stuffstring, 0); @@ -7899,7 +9472,7 @@ On such systems, Emacs starts a subshell instead of suspending.") /* sys_suspend can get an error if it tries to fork a subshell and the system resources aren't available for that. */ record_unwind_protect ((Lisp_Object (*) P_ ((Lisp_Object))) init_sys_modes, - 0); + Qnil); stuff_buffered_input (stuffstring); if (cannot_suspend) sys_subshell (); @@ -7912,7 +9485,7 @@ On such systems, Emacs starts a subshell instead of suspending.") with a window system; but suspend should be disabled in that case. */ get_frame_size (&width, &height); if (width != old_width || height != old_height) - change_frame_size (selected_frame, height, width, 0, 0); + change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0); /* Run suspend-resume-hook. */ if (!NILP (Vrun_hooks)) @@ -7944,20 +9517,25 @@ stuff_buffered_input (stuffstring) stuff_char (*p++); stuff_char ('\n'); } + /* Anything we have read ahead, put back for the shell to read. */ /* ?? What should this do when we have multiple keyboards?? Should we ignore anything that was typed in at the "wrong" kboard? */ for (; kbd_fetch_ptr != kbd_store_ptr; kbd_fetch_ptr++) { + int idx; + if (kbd_fetch_ptr == kbd_buffer + KBD_BUFFER_SIZE) kbd_fetch_ptr = kbd_buffer; if (kbd_fetch_ptr->kind == ascii_keystroke) stuff_char (kbd_fetch_ptr->code); + kbd_fetch_ptr->kind = no_event; - (XVECTOR (kbd_buffer_frame_or_window)->contents[kbd_fetch_ptr - - kbd_buffer] - = Qnil); + idx = 2 * (kbd_fetch_ptr - kbd_buffer); + ASET (kbd_buffer_gcpro, idx, Qnil); + ASET (kbd_buffer_gcpro, idx + 1, Qnil); } + input_pending = 0; #endif #endif /* BSD_SYSTEM and not BSD4_1 */ @@ -7987,16 +9565,17 @@ clear_waiting_for_input () } /* This routine is called at interrupt level in response to C-G. - If interrupt_input, this is the handler for SIGINT. - Otherwise, it is called from kbd_buffer_store_event, - in handling SIGIO or SIGTINT. + + If interrupt_input, this is the handler for SIGINT. Otherwise, it + is called from kbd_buffer_store_event, in handling SIGIO or + SIGTINT. - If `waiting_for_input' is non zero, then unless `echoing' is nonzero, - immediately throw back to read_char. + If `waiting_for_input' is non zero, then unless `echoing' is + nonzero, immediately throw back to read_char. - Otherwise it sets the Lisp variable quit-flag not-nil. - This causes eval to throw, when it gets a chance. - If quit-flag is already non-nil, it stops the job right away. */ + Otherwise it sets the Lisp variable quit-flag not-nil. This causes + eval to throw, when it gets a chance. If quit-flag is already + non-nil, it stops the job right away. */ SIGTYPE interrupt_signal (signalnum) /* If we don't have an argument, */ @@ -8005,6 +9584,7 @@ interrupt_signal (signalnum) /* If we don't have an argument, */ char c; /* Must preserve main program's value of errno. */ int old_errno = errno; + struct frame *sf = SELECTED_FRAME (); #if defined (USG) && !defined (POSIX_SIGNALS) if (!read_socket_hook && NILP (Vwindow_system)) @@ -8019,7 +9599,7 @@ interrupt_signal (signalnum) /* If we don't have an argument, */ cancel_echoing (); if (!NILP (Vquit_flag) - && (FRAME_TERMCAP_P (selected_frame) || FRAME_MSDOS_P (selected_frame))) + && (FRAME_TERMCAP_P (sf) || FRAME_MSDOS_P (sf))) { /* If SIGINT isn't blocked, don't let us be interrupted by another SIGINT, it might be harmful due to non-reentrancy @@ -8144,7 +9724,6 @@ interrupt_signal (signalnum) /* If we don't have an argument, */ void quit_throw_to_read_char () { - quit_error_check (); sigfree (); /* Prevent another signal from doing this before we finish. */ clear_waiting_for_input (); @@ -8163,7 +9742,7 @@ quit_throw_to_read_char () #endif #endif if (FRAMEP (internal_last_event_frame) - && XFRAME (internal_last_event_frame) != selected_frame) + && !EQ (internal_last_event_frame, selected_frame)) do_switch_frame (make_lispy_switch_frame (internal_last_event_frame), Qnil, 0); @@ -8278,7 +9857,9 @@ init_kboard (kb) { kb->Voverriding_terminal_local_map = Qnil; kb->Vlast_command = Qnil; + kb->Vreal_last_command = Qnil; kb->Vprefix_arg = Qnil; + kb->Vlast_prefix_arg = Qnil; kb->kbd_queue = Qnil; kb->kbd_queue_has_data = 0; kb->immediate_echo = 0; @@ -8336,8 +9917,7 @@ init_keyboard () recent_keys_index = 0; kbd_fetch_ptr = kbd_buffer; kbd_store_ptr = kbd_buffer; - kbd_buffer_frame_or_window - = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); + kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil); #ifdef HAVE_MOUSE do_mouse_tracking = Qnil; #endif @@ -8354,11 +9934,6 @@ init_keyboard () wipe_kboard (current_kboard); init_kboard (current_kboard); - if (initialized) - Ffillarray (kbd_buffer_frame_or_window, Qnil); - - kbd_buffer_frame_or_window - = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); if (!noninteractive && !read_socket_hook && NILP (Vwindow_system)) { signal (SIGINT, interrupt_signal); @@ -8420,9 +9995,27 @@ struct event_head head_table[] = { void syms_of_keyboard () { + Vlispy_mouse_stem = build_string ("mouse"); + staticpro (&Vlispy_mouse_stem); + + /* Tool-bars. */ + QCimage = intern (":image"); + staticpro (&QCimage); + + staticpro (&Qhelp_echo); + Qhelp_echo = intern ("help-echo"); + staticpro (&item_properties); item_properties = Qnil; + staticpro (&tool_bar_item_properties); + tool_bar_item_properties = Qnil; + staticpro (&tool_bar_items_vector); + tool_bar_items_vector = Qnil; + + staticpro (&real_this_command); + real_this_command = Qnil; + Qtimer_event_handler = intern ("timer-event-handler"); staticpro (&Qtimer_event_handler); @@ -8466,7 +10059,16 @@ syms_of_keyboard () #ifdef WINDOWSNT Qmouse_wheel = intern ("mouse-wheel"); staticpro (&Qmouse_wheel); + Qlanguage_change = intern ("language-change"); + staticpro (&Qlanguage_change); #endif + Qdrag_n_drop = intern ("drag-n-drop"); + staticpro (&Qdrag_n_drop); + + Qusr1_signal = intern ("usr1-signal"); + staticpro (&Qusr1_signal); + Qusr2_signal = intern ("usr2-signal"); + staticpro (&Qusr2_signal); Qmenu_enable = intern ("menu-enable"); staticpro (&Qmenu_enable); @@ -8476,10 +10078,16 @@ syms_of_keyboard () staticpro (&QCenable); QCvisible = intern (":visible"); staticpro (&QCvisible); + QChelp = intern (":help"); + staticpro (&QChelp); QCfilter = intern (":filter"); staticpro (&QCfilter); QCbutton = intern (":button"); staticpro (&QCbutton); + QCkeys = intern (":keys"); + staticpro (&QCkeys); + QCkey_sequence = intern (":key-sequence"); + staticpro (&QCkey_sequence); QCtoggle = intern (":toggle"); staticpro (&QCtoggle); QCradio = intern (":radio"); @@ -8504,6 +10112,14 @@ syms_of_keyboard () staticpro (&Qup); Qdown = intern ("down"); staticpro (&Qdown); + Qtop = intern ("top"); + staticpro (&Qtop); + Qbottom = intern ("bottom"); + staticpro (&Qbottom); + Qend_scroll = intern ("end-scroll"); + staticpro (&Qend_scroll); + Qratio = intern ("ratio"); + staticpro (&Qratio); Qevent_kind = intern ("event-kind"); staticpro (&Qevent_kind); @@ -8522,6 +10138,19 @@ syms_of_keyboard () Qpolling_period = intern ("polling-period"); staticpro (&Qpolling_period); + Qinput_method_function = intern ("input-method-function"); + staticpro (&Qinput_method_function); + + Qinput_method_exit_on_first_char = intern ("input-method-exit-on-first-char"); + staticpro (&Qinput_method_exit_on_first_char); + Qinput_method_use_echo_area = intern ("input-method-use-echo-area"); + staticpro (&Qinput_method_use_echo_area); + + Fset (Qinput_method_exit_on_first_char, Qnil); + Fset (Qinput_method_use_echo_area, Qnil); + + last_point_position_buffer = Qnil; + { struct event_head *p; @@ -8536,8 +10165,10 @@ syms_of_keyboard () } } - button_down_location = Fmake_vector (make_number (NUM_MOUSE_BUTTONS), Qnil); + button_down_location = Fmake_vector (make_number (1), Qnil); staticpro (&button_down_location); + mouse_syms = Fmake_vector (make_number (1), Qnil); + staticpro (&mouse_syms); { int i; @@ -8556,13 +10187,15 @@ syms_of_keyboard () this_command_keys = Fmake_vector (make_number (40), Qnil); staticpro (&this_command_keys); + raw_keybuf = Fmake_vector (make_number (30), Qnil); + staticpro (&raw_keybuf); + Qextended_command_history = intern ("extended-command-history"); Fset (Qextended_command_history, Qnil); staticpro (&Qextended_command_history); - kbd_buffer_frame_or_window - = Fmake_vector (make_number (KBD_BUFFER_SIZE), Qnil); - staticpro (&kbd_buffer_frame_or_window); + kbd_buffer_gcpro = Fmake_vector (make_number (2 * KBD_BUFFER_SIZE), Qnil); + staticpro (&kbd_buffer_gcpro); accent_key_syms = Qnil; staticpro (&accent_key_syms); @@ -8570,12 +10203,12 @@ syms_of_keyboard () func_key_syms = Qnil; staticpro (&func_key_syms); - mouse_syms = Qnil; - staticpro (&mouse_syms); - #ifdef WINDOWSNT mouse_wheel_syms = Qnil; staticpro (&mouse_wheel_syms); + + drag_n_drop_syms = Qnil; + staticpro (&drag_n_drop_syms); #endif unread_switch_frame = Qnil; @@ -8587,6 +10220,9 @@ syms_of_keyboard () read_key_sequence_cmd = Qnil; staticpro (&read_key_sequence_cmd); + menu_bar_one_keymap_changed_items = Qnil; + staticpro (&menu_bar_one_keymap_changed_items); + defsubr (&Sevent_convert_list); defsubr (&Sread_key_sequence); defsubr (&Sread_key_sequence_vector); @@ -8600,7 +10236,9 @@ syms_of_keyboard () defsubr (&Sthis_command_keys); defsubr (&Sthis_command_keys_vector); defsubr (&Sthis_single_command_keys); + defsubr (&Sthis_single_command_raw_keys); defsubr (&Sreset_this_command_lengths); + defsubr (&Sclear_this_command_keys); defsubr (&Ssuspend_emacs); defsubr (&Sabort_recursive_edit); defsubr (&Sexit_recursive_edit); @@ -8631,20 +10269,35 @@ so that you can determine whether the command was run by mouse or not."); "Last input event."); DEFVAR_LISP ("unread-command-events", &Vunread_command_events, - "List of objects to be read as next command input events."); + "List of events to be read as the command input.\n\ +These events are processed first, before actual keyboard input."); + Vunread_command_events = Qnil; DEFVAR_INT ("unread-command-char", &unread_command_char, "If not -1, an object to be read as next command input event."); + DEFVAR_LISP ("unread-post-input-method-events", &Vunread_post_input_method_events, + "List of events to be processed as input by input methods.\n\ +These events are processed after `unread-command-events', but\n\ +before actual keyboard input."); + Vunread_post_input_method_events = Qnil; + + DEFVAR_LISP ("unread-input-method-events", &Vunread_input_method_events, + "List of events to be processed as input by input methods.\n\ +These events are processed after `unread-command-events', but\n\ +before actual keyboard input."); + Vunread_input_method_events = Qnil; + DEFVAR_LISP ("meta-prefix-char", &meta_prefix_char, - "Meta-prefix character code. Meta-foo as command input\n\ -turns into this character followed by foo."); + "Meta-prefix character code.\n\ +Meta-foo as command input turns into this character followed by foo."); XSETINT (meta_prefix_char, 033); DEFVAR_KBOARD ("last-command", Vlast_command, - "The last command executed. Normally a symbol with a function definition,\n\ -but can be whatever was found in the keymap, or whatever the variable\n\ -`this-command' was set to by that command.\n\ + "The last command executed.\n\ +Normally a symbol with a function definition, but can be whatever was found\n\ +in the keymap, or whatever the variable `this-command' was set to by that\n\ +command.\n\ \n\ The value `mode-exit' is special; it means that the previous command\n\ read an event that told it to exit, and it did so and unread that event.\n\ @@ -8654,14 +10307,17 @@ command exit.\n\ The value `kill-region' is special; it means that the previous command\n\ was a kill command."); - DEFVAR_LISP ("this-command", &this_command, + DEFVAR_KBOARD ("real-last-command", Vreal_last_command, + "Same as `last-command', but never altered by Lisp code."); + + DEFVAR_LISP ("this-command", &Vthis_command, "The command now being executed.\n\ The command can set this variable; whatever is put here\n\ will be in `last-command' during the following command."); - this_command = Qnil; + Vthis_command = Qnil; DEFVAR_INT ("auto-save-interval", &auto_save_interval, - "*Number of keyboard input characters between auto-saves.\n\ + "*Number of input events between auto-saves.\n\ Zero means disable autosaving due to number of characters typed."); auto_save_interval = 300; @@ -8672,9 +10328,10 @@ After auto-saving due to this many seconds of idle time,\n\ Emacs also does a garbage collection if that seems to be warranted."); XSETFASTINT (Vauto_save_timeout, 30); - DEFVAR_INT ("echo-keystrokes", &echo_keystrokes, - "*Nonzero means echo unfinished commands after this many seconds of pause."); - echo_keystrokes = 1; + DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes, + "*Nonzero means echo unfinished commands after this many seconds of pause.\n\ +The value may be integer or floating point."); + Vecho_keystrokes = make_number (1); DEFVAR_INT ("polling-period", &polling_period, "*Interval between polling for input during Lisp execution.\n\ @@ -8752,8 +10409,8 @@ In a vector or a char-table, an element which is nil means \"no translation\".") Vkeyboard_translate_table = Qnil; DEFVAR_BOOL ("cannot-suspend", &cannot_suspend, - "Non-nil means to always spawn a subshell instead of suspending,\n\ -even if the operating system has support for stopping a process."); + "Non-nil means to always spawn a subshell instead of suspending.\n\ +\(Even if the operating system has support for stopping a process.\)"); cannot_suspend = 0; DEFVAR_BOOL ("menu-prompting", &menu_prompting, @@ -8797,12 +10454,16 @@ Buffer modification stores t in this variable."); DEFVAR_LISP ("pre-command-hook", &Vpre_command_hook, "Normal hook run before each command is executed.\n\ -Errors running the hook are caught and ignored."); +If an unhandled error happens in running this hook,\n\ +the hook value is set to nil, since otherwise the error\n\ +might happen repeatedly and make Emacs nonfunctional."); Vpre_command_hook = Qnil; DEFVAR_LISP ("post-command-hook", &Vpost_command_hook, "Normal hook run after each command is executed.\n\ -Errors running the hook are caught and ignored."); +If an unhandled error happens in running this hook,\n\ +the hook value is set to nil, since otherwise the error\n\ +might happen repeatedly and make Emacs nonfunctional."); Vpost_command_hook = Qnil; DEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook, @@ -8877,7 +10538,7 @@ whenever `deferred-action-list' is non-nil."); Vdeferred_action_function = Qnil; DEFVAR_LISP ("suggest-key-bindings", &Vsuggest_key_bindings, - "Non-nil means show the equivalent key-binding when M-x command has one.\n\ + "*Non-nil means show the equivalent key-binding when M-x command has one.\n\ The value can be a length of time to show the message for.\n\ If the value is non-nil and not a number, we wait 2 seconds."); Vsuggest_key_bindings = Qt; @@ -8889,6 +10550,60 @@ If the value is non-nil and not a number, we wait 2 seconds."); DEFVAR_LISP ("timer-idle-list", &Vtimer_idle_list, "List of active idle-time timers in order of increasing time"); Vtimer_idle_list = Qnil; + + DEFVAR_LISP ("input-method-function", &Vinput_method_function, + "If non-nil, the function that implements the current input method.\n\ +It's called with one argument, a printing character that was just read.\n\ +\(That means a character with code 040...0176.)\n\ +Typically this function uses `read-event' to read additional events.\n\ +When it does so, it should first bind `input-method-function' to nil\n\ +so it will not be called recursively.\n\ +\n\ +The function should return a list of zero or more events\n\ +to be used as input. If it wants to put back some events\n\ +to be reconsidered, separately, by the input method,\n\ +it can add them to the beginning of `unread-command-events'.\n\ +\n\ +The input method function can find in `input-method-previous-method'\n\ +the previous echo area message.\n\ +\n\ +The input method function should refer to the variables\n\ +`input-method-use-echo-area' and `input-method-exit-on-first-char'\n\ +for guidance on what to do."); + Vinput_method_function = Qnil; + + DEFVAR_LISP ("input-method-previous-message", + &Vinput_method_previous_message, + "When `input-method-function' is called, hold the previous echo area message.\n\ +This variable exists because `read-event' clears the echo area\n\ +before running the input method. It is nil if there was no message."); + Vinput_method_previous_message = Qnil; + + DEFVAR_LISP ("show-help-function", &Vshow_help_function, + "If non-nil, the function that implements the display of help.\n\ +It's called with one argument, the help string to display."); + Vshow_help_function = Qnil; + + DEFVAR_LISP ("disable-point-adjustment", &Vdisable_point_adjustment, + "If non-nil, suppress point adjustment after executing a command.\n\ +\n\ +After a command is executed, if point is moved into a region that has\n\ +special properties (e.g. composition, display), we adjust point to\n\ +the boundary of the region. But, several special commands sets this\n\ +variable to non-nil, then we suppress the point adjustment.\n\ +\n\ +This variable is set to nil before reading a command, and is checked\n\ +just after executing the command"); + Vdisable_point_adjustment = Qnil; + + DEFVAR_LISP ("global-disable-point-adjustment", + &Vglobal_disable_point_adjustment, + "*If non-nil, always suppress point adjustment.\n\ +\n\ +The default value is nil, in which case, point adjustment are\n\ +suppressed only after special commands that set\n\ +`disable-point-adjustment' (which see) to non-nil."); + Vglobal_disable_point_adjustment = Qnil; } void