X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1161d3675c35b7017a0e6ca2bef88157e691c039..ffa85ae7a58613248810a0cb2978b5763794672d:/src/keyboard.c diff --git a/src/keyboard.c b/src/keyboard.c index b5d9f3c147..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 */ @@ -166,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; @@ -179,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; @@ -354,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; @@ -420,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, @@ -441,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. @@ -459,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 @@ -482,6 +520,7 @@ 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; @@ -580,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. */ @@ -654,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); @@ -733,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 (); } @@ -748,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. */ @@ -818,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); @@ -856,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; @@ -1014,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 (); @@ -1039,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)); @@ -1119,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); } @@ -1148,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; @@ -1172,7 +1259,6 @@ command_loop_1 () cancel_echoing (); nonundocount = 0; - no_redisplay = 0; this_command_key_count = 0; this_single_command_key_start = 0; @@ -1183,6 +1269,11 @@ 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); @@ -1202,7 +1293,7 @@ command_loop_1 () while (1) { - if (! FRAME_LIVE_P (selected_frame)) + if (! FRAME_LIVE_P (XFRAME (selected_frame))) Fkill_emacs (Qnil); /* Make sure the current window's buffer is selected. */ @@ -1222,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 @@ -1256,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, @@ -1276,7 +1368,7 @@ command_loop_1 () Qnil, 0, 1, 1); /* A filter may have run while we were reading the input. */ - if (! FRAME_LIVE_P (selected_frame)) + 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)); @@ -1307,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; @@ -1323,17 +1417,18 @@ 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. */ Vthis_command = cmd; @@ -1386,7 +1481,7 @@ 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 (Vthis_command, Qbackward_char) && PT > BEGV) @@ -1412,7 +1507,7 @@ 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 (Vthis_command, Qself_insert_command) @@ -1421,7 +1516,6 @@ command_loop_1 () { unsigned int c = XINT (last_command_char); int value; - if (NILP (Vexecuting_macro) && !EQ (minibuf_window, selected_window)) { @@ -1432,6 +1526,7 @@ command_loop_1 () } nonundocount++; } + lose = ((XFASTINT (XWINDOW (selected_window)->last_modified) < MODIFF) || (XFASTINT (XWINDOW (selected_window)->last_overlay_modified) @@ -1444,62 +1539,37 @@ 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 (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; @@ -1509,6 +1579,11 @@ 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)) safe_run_hooks (Qdeferred_action_function); @@ -1556,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) @@ -1569,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 @@ -1584,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 @@ -1595,7 +1725,6 @@ void safe_run_hooks (hook) Lisp_Object hook; { - Lisp_Object value; int count = specpdl_ptr - specpdl; specbind (Qinhibit_quit, hook); @@ -1603,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. */ @@ -1644,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 } @@ -1674,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 } @@ -1719,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. */ @@ -1764,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 */ @@ -1810,7 +2035,7 @@ 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 echo_area_message; + Lisp_Object previous_echo_area_message; Lisp_Object also_record; int reread; struct gcpro gcpro1, gcpro2; @@ -1820,25 +2045,25 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) before_command_key_count = this_command_key_count; before_command_echo_length = echo_length (); c = Qnil; - echo_area_message = Qnil; + previous_echo_area_message = Qnil; - GCPRO2 (c, echo_area_message); + GCPRO2 (c, previous_echo_area_message); retry: reread = 0; if (CONSP (Vunread_post_input_method_events)) { - c = XCONS (Vunread_post_input_method_events)->car; + c = XCAR (Vunread_post_input_method_events); Vunread_post_input_method_events - = XCONS (Vunread_post_input_method_events)->cdr; + = 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); reread = 1; goto reread_first; @@ -1855,15 +2080,15 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) 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); /* 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); reread = 1; goto reread_for_input_method; @@ -1871,15 +2096,15 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (CONSP (Vunread_input_method_events)) { - c = XCONS (Vunread_input_method_events)->car; - Vunread_input_method_events = XCONS (Vunread_input_method_events)->cdr; + 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 (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); reread = 1; goto reread_for_input_method; } @@ -1957,15 +2182,43 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) } } - /* 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 @@ -1996,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. */ @@ -2005,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; @@ -2013,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); @@ -2034,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. */ @@ -2050,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)) @@ -2080,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) @@ -2146,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. */ @@ -2158,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; } } @@ -2218,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); @@ -2324,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); @@ -2356,13 +2623,21 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (INTEGERP (c) && ! NILP (Vinput_method_function) && (unsigned) XINT (c) >= ' ' - && (unsigned) XINT (c) < 127) - Vinput_method_previous_message = echo_area_message = Fcurrent_message (); + && (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. */ - if (echo_area_glyphs) - safe_run_hooks (Qecho_area_clear_hook); - echo_area_glyphs = 0; + /* 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: @@ -2373,7 +2648,8 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) after the first event of the key sequence. */ && NILP (prev_event) && (unsigned) XINT (c) >= ' ' - && (unsigned) XINT (c) < 127) + && (unsigned) XINT (c) != 127 + && (unsigned) XINT (c) < 256) { Lisp_Object keys; int key_count; @@ -2382,7 +2658,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) /* Save the echo status. */ int saved_immediate_echo = current_kboard->immediate_echo; - char *saved_ok_to_echo = ok_to_echo_at_next_pause; + 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) @@ -2407,16 +2683,15 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) this_command_key_count = 0; /* Now wipe the echo area. */ - if (echo_area_glyphs) + if (!NILP (echo_area_buffer[0])) safe_run_hooks (Qecho_area_clear_hook); - echo_area_glyphs = 0; + 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_exit_on_first_char, Qt); specbind (Qinput_method_use_echo_area, Qt); } @@ -2443,25 +2718,39 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) if (! CONSP (tem)) { /* Bring back the previous message, if any. */ - if (! NILP (echo_area_message)) - message_with_string ("%s", echo_area_message, 0); + if (! NILP (previous_echo_area_message)) + message_with_string ("%s", previous_echo_area_message, 0); goto retry; } /* It returned one event or more. */ - c = XCONS (tem)->car; + c = XCAR (tem); Vunread_post_input_method_events - = nconc2 (XCONS (tem)->cdr, 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)) + { + /* (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 (); /* Don't echo mouse motion events. */ - if (echo_keystrokes + if ((FLOATP (Vecho_keystrokes) || INTEGERP (Vecho_keystrokes)) + && NILP (Fzerop (Vecho_keystrokes)) && ! (EVENT_HAS_PARAMETERS (c) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (c)), Qmouse_movement))) { @@ -2470,7 +2759,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu) 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; + ok_to_echo_at_next_pause = current_kboard; } /* Record this character as part of the current key. */ @@ -2523,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); @@ -2531,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); @@ -2558,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; } @@ -2666,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, @@ -2751,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)); @@ -2809,6 +3100,7 @@ kbd_buffer_store_event (event) { sp->kind = no_event; sp->frame_or_window = Qnil; + sp->arg = Qnil; } } return; @@ -2856,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) { @@ -2866,22 +3163,94 @@ 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 + + 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; + } +} + - kbd_store_ptr++; +/* 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. */ @@ -2904,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, @@ -2918,7 +3329,6 @@ kbd_buffer_get_event (kbp, used_mouse_menu) { register int c; Lisp_Object obj; - EMACS_TIME next_timer_delay; if (noninteractive) { @@ -2975,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; } @@ -3101,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); - /* If this event is on a different frame, return a switch-frame this - time, and leave the event in the queue for next time. */ + 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 (!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)); @@ -3120,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; @@ -3129,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; } } @@ -3181,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; } @@ -3289,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; @@ -3357,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; @@ -3366,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; @@ -3378,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; @@ -3396,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; } } @@ -3407,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]))); @@ -3419,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]))); @@ -3438,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; @@ -3918,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 @@ -3947,12 +4396,21 @@ static char *lispy_drag_n_drop_names[] = /* 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 }; @@ -4027,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: @@ -4088,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; @@ -4096,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) { @@ -4106,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 @@ -4113,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 @@ -4139,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) @@ -4156,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, @@ -4167,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)) { @@ -4176,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 @@ -4198,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; @@ -4217,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; @@ -4278,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; } @@ -4307,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, @@ -4328,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: { @@ -4337,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; @@ -4366,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)); @@ -4390,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)) { @@ -4402,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); @@ -4410,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)); } { @@ -4444,7 +4997,6 @@ make_lispy_event (event) FRAME_PTR f; Lisp_Object window; Lisp_Object posn; - Lisp_Object head, position; Lisp_Object files; int row, column; @@ -4454,8 +5006,8 @@ make_lispy_event (event) if (! CONSP (event->frame_or_window)) abort (); - f = XFRAME (XCONS (event->frame_or_window)->car); - files = XCONS (event->frame_or_window)->cdr; + 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. */ @@ -4463,30 +5015,36 @@ 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)) { - window = XCONS (event->frame_or_window)->car; + window = XCAR (event->frame_or_window); posn = Qnil; } else { - int pixcolumn, pixrow; - column -= XINT (XWINDOW (window)->left); - row -= XINT (XWINDOW (window)->top); - glyph_to_pixel_coords (f, column, row, &pixcolumn, &pixrow); - XSETINT (event->x, pixcolumn); - XSETINT (event->y, pixrow); + /* 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 (XWINDOW (window), - column, row)); + XSETINT (posn, buffer_posn_from_coords (w, &wx, &wy)); } { @@ -4512,13 +5070,29 @@ make_lispy_event (event) #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 (); @@ -4557,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) { @@ -4867,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. */ @@ -4925,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)); } @@ -4939,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 @@ -4960,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; @@ -5005,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]); @@ -5067,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)) @@ -5203,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; } @@ -5280,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. @@ -5388,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 @@ -5440,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; } } @@ -5618,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; } @@ -5649,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, @@ -5681,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)); @@ -5702,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. */ @@ -5740,6 +6331,7 @@ menu_bar_item (key, item) { struct gcpro gcpro1; int i; + Lisp_Object tem; if (EQ (item, Qundefined)) { @@ -5768,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. */ @@ -5782,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)); @@ -5813,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; @@ -5821,7 +6421,7 @@ 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; { @@ -5876,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. */ @@ -5918,47 +6518,47 @@ 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)) 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 = item; else if (EQ (tem, QCkey_sequence)) { - tem = XCONS (item)->car; + tem = XCAR (item); if (NILP (cachelist) && (SYMBOLP (tem) || STRINGP (tem) || VECTORP (tem))) /* Be GC protected. Set keyhint to item instead of tem. */ @@ -5966,25 +6566,25 @@ parse_menu_item (item, notreal, inmenubar) } else if (EQ (tem, QCkeys)) { - tem = XCONS (item)->car; - if (CONSP (tem) || STRINGP (tem) && NILP (cachelist)) + tem = XCAR (item); + if (CONSP (tem) || (STRINGP (tem) && NILP (cachelist))) XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ] = tem; } - else if (EQ (tem, QCbutton) && CONSP (XCONS (item)->car)) + else if (EQ (tem, QCbutton) && CONSP (XCAR (item))) { Lisp_Object type; - tem = XCONS (item)->car; - type = XCONS (tem)->car; + 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)) @@ -6008,7 +6608,7 @@ parse_menu_item (item, notreal, inmenubar) def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; if (!NILP (filter)) { - def = menu_item_eval_property (list2 (XCONS (filter)->car, + def = menu_item_eval_property (list2 (XCAR (filter), list2 (Qquote, def))); XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF] = def; @@ -6053,22 +6653,22 @@ parse_menu_item (item, notreal, inmenubar) { /* 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; + 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)) { - XCONS (cachelist)->car = XCONS (keyhint)->car; + XCAR (cachelist) = XCAR (keyhint); newcache = 0; } else if (STRINGP (tem)) { - XCONS (cachelist)->cdr = Fsubstitute_command_keys (tem); - XCONS (cachelist)->car = Qt; + XCDR (cachelist) = Fsubstitute_command_keys (tem); + XCAR (cachelist) = Qt; } } - tem = XCONS (cachelist)->car; + tem = XCAR (cachelist); if (!EQ (tem, Qt)) { int chkcache = 0; @@ -6080,13 +6680,13 @@ parse_menu_item (item, notreal, inmenubar) prefix = XVECTOR (item_properties)->contents[ITEM_PROPERTY_KEYEQ]; if (CONSP (prefix)) { - def = XCONS (prefix)->car; - prefix = XCONS (prefix)->cdr; + def = XCAR (prefix); + prefix = XCDR (prefix); } else def = XVECTOR (item_properties)->contents[ITEM_PROPERTY_DEF]; - if (NILP (XCONS (cachelist)->car)) /* Have no saved key. */ + if (NILP (XCAR (cachelist))) /* Have no saved key. */ { if (newcache /* Always check first time. */ /* Should we check everything when precomputing key @@ -6102,11 +6702,11 @@ parse_menu_item (item, notreal, inmenubar) } /* 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))) + || (!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) @@ -6120,16 +6720,16 @@ parse_menu_item (item, notreal, inmenubar) && ! NILP (Fget (def, Qmenu_alias))) def = XSYMBOL (def)->function; tem = Fwhere_is_internal (def, Qnil, Qt, Qnil); - XCONS (cachelist)->car = tem; + XCAR (cachelist) = tem; if (NILP (tem)) { - XCONS (cachelist)->cdr = Qnil; + XCDR (cachelist) = Qnil; chkcache = 0; } } - else if (!NILP (keyhint) && !NILP (XCONS (cachelist)->car)) + else if (!NILP (keyhint) && !NILP (XCAR (cachelist))) { - tem = XCONS (cachelist)->car; + tem = XCAR (cachelist); chkcache = 1; } @@ -6139,20 +6739,20 @@ parse_menu_item (item, notreal, inmenubar) tem = Fkey_description (tem); if (CONSP (prefix)) { - if (STRINGP (XCONS (prefix)->car)) - tem = concat2 (XCONS (prefix)->car, tem); - if (STRINGP (XCONS (prefix)->cdr)) - tem = concat2 (tem, XCONS (prefix)->cdr); + if (STRINGP (XCAR (prefix))) + tem = concat2 (XCAR (prefix), tem); + if (STRINGP (XCDR (prefix))) + tem = concat2 (tem, XCDR (prefix)); } - XCONS (cachelist)->cdr = tem; + XCDR (cachelist) = tem; } } - tem = XCONS (cachelist)->cdr; + tem = XCDR (cachelist); if (newcache && !NILP (tem)) { tem = concat3 (build_string (" ("), tem, build_string (")")); - XCONS (cachelist)->cdr = tem; + XCDR (cachelist) = tem; } /* If we only want to precompute equivalent key bindings, stop here. */ @@ -6181,6 +6781,395 @@ parse_menu_item (item, notreal, inmenubar) 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); + + if (EQ (def, Qundefined)) + { + /* 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 (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 (); + + 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)) + { + for (i = 0; i < TOOL_BAR_ITEM_NSLOTS; ++i) + PROP (i) = Qnil; + } + else + tool_bar_item_properties + = Fmake_vector (make_number (TOOL_BAR_ITEM_NSLOTS), Qnil); + + /* 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; + + /* 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))) + { + 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 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. */ + if (!NILP (PROP (TOOL_BAR_ITEM_SELECTED_P))) + PROP (TOOL_BAR_ITEM_SELECTED_P) + = menu_item_eval_property (PROP (TOOL_BAR_ITEM_SELECTED_P)); + + 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. @@ -6211,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; @@ -6244,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 @@ -6262,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. @@ -6272,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; @@ -6314,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; @@ -6432,7 +7421,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps) 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]; @@ -6577,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])) @@ -6609,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; } @@ -6698,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; @@ -6769,7 +7762,9 @@ 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; @@ -6791,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 (); @@ -6815,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, @@ -6851,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; } @@ -6941,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)) @@ -6970,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)))) @@ -6982,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 @@ -7021,13 +8022,14 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, of the command_loop_1. */ if (fix_current_buffer) { - if (! FRAME_LIVE_P (selected_frame)) + 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; } @@ -7041,7 +8043,8 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, 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; } @@ -7089,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 @@ -7123,34 +8127,52 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last, emacsclient). */ record_unwind_protect (Fset_buffer, Fcurrent_buffer ()); - if (! FRAME_LIVE_P (selected_frame)) + 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); + 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; } } @@ -7166,24 +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 (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"); @@ -7241,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. @@ -7310,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)); @@ -7375,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 @@ -7388,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. */ @@ -7451,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; @@ -7483,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 @@ -7496,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) @@ -7554,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; } @@ -7623,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; @@ -7633,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; @@ -7676,7 +8752,8 @@ 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]); } @@ -7747,7 +8824,7 @@ DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 0, { Lisp_Object keybuf[30]; register int i; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; int count = specpdl_ptr - specpdl; if (!NILP (prompt)) @@ -7769,10 +8846,20 @@ DEFUN ("read-key-sequence", Fread_key_sequence, Sread_key_sequence, 1, 5, 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; @@ -7792,7 +8879,7 @@ DEFUN ("read-key-sequence-vector", Fread_key_sequence_vector, { Lisp_Object keybuf[30]; register int i; - struct gcpro gcpro1, gcpro2; + struct gcpro gcpro1; int count = specpdl_ptr - specpdl; if (!NILP (prompt)) @@ -7814,10 +8901,20 @@ 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; @@ -7901,7 +8998,7 @@ a special event, so ignore the prefix argument and don't clear it.") { tem = Fnthcdr (Vhistory_length, Vcommand_history); if (CONSP (tem)) - XCONS (tem)->cdr = Qnil; + XCDR (tem) = Qnil; } } @@ -7944,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 (); } @@ -7960,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 (); } @@ -8030,7 +9127,7 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ { /* But first wait, and skip the message if there is input. */ int delay_time; - if (echo_area_glyphs != 0) + 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) @@ -8045,9 +9142,7 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_ { 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); @@ -8063,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 (); } } @@ -8096,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; @@ -8135,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; } @@ -8263,10 +9373,18 @@ appears in the echo area and in the value of `this-command-keys.'.") 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.") + "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; } @@ -8314,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; @@ -8339,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); @@ -8371,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)) @@ -8403,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 */ @@ -8446,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, */ @@ -8464,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)) @@ -8478,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 @@ -8603,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 (); @@ -8622,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); @@ -8797,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 @@ -8815,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); @@ -8881,9 +9995,24 @@ 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; @@ -8936,6 +10065,11 @@ syms_of_keyboard () 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); Qmenu_alias = intern ("menu-alias"); @@ -8944,6 +10078,8 @@ syms_of_keyboard () staticpro (&QCenable); QCvisible = intern (":visible"); staticpro (&QCvisible); + QChelp = intern (":help"); + staticpro (&QChelp); QCfilter = intern (":filter"); staticpro (&QCfilter); QCbutton = intern (":button"); @@ -8976,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); @@ -9005,6 +10149,8 @@ syms_of_keyboard () Fset (Qinput_method_exit_on_first_char, Qnil); Fset (Qinput_method_use_echo_area, Qnil); + last_point_position_buffer = Qnil; + { struct event_head *p; @@ -9019,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; @@ -9046,9 +10194,8 @@ syms_of_keyboard () 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); @@ -9056,9 +10203,6 @@ 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); @@ -9076,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); @@ -9142,14 +10289,15 @@ 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\ @@ -9169,7 +10317,7 @@ will be in `last-command' during the following command."); 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; @@ -9180,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\ @@ -9260,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, @@ -9429,6 +10578,32 @@ for guidance on what to do."); 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