X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/3b158d1150cbbffc77afef323008623ac5c3e169..3b8d5131a316ad2fdc206744cec489a11f0bf1d3:/src/keyboard.c diff --git a/src/keyboard.c b/src/keyboard.c index 669e85518f..8ccbf77871 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -82,7 +82,7 @@ volatile bool pending_signals; KBOARD *initial_kboard; KBOARD *current_kboard; -KBOARD *all_kboards; +static KBOARD *all_kboards; /* True in the single-kboard state, false in the any-kboard state. */ static bool single_kboard; @@ -218,10 +218,6 @@ static ptrdiff_t last_point_position; 'volatile' here. */ Lisp_Object internal_last_event_frame; -/* The timestamp of the last input event we received from the X server. - X Windows wants this for selection ownership. */ -Time last_event_timestamp; - static Lisp_Object Qx_set_selection, Qhandle_switch_frame; static Lisp_Object Qhandle_select_window; Lisp_Object QPRIMARY; @@ -351,6 +347,7 @@ static Lisp_Object Qmodifier_cache; /* Symbols to use for parts of windows. */ Lisp_Object Qmode_line; Lisp_Object Qvertical_line; +Lisp_Object Qright_divider, Qbottom_divider; static Lisp_Object Qvertical_scroll_bar; Lisp_Object Qmenu_bar; @@ -825,7 +822,7 @@ This function is called by the editor initialization to begin editing. */) return Qnil; command_loop_level++; - update_mode_lines = 1; + update_mode_lines = 17; if (command_loop_level && current_buffer != XBUFFER (XWINDOW (selected_window)->contents)) @@ -852,7 +849,7 @@ recursive_edit_unwind (Lisp_Object buffer) Fset_buffer (buffer); command_loop_level--; - update_mode_lines = 1; + update_mode_lines = 18; } @@ -1068,8 +1065,6 @@ cmd_error (Lisp_Object data) void cmd_error_internal (Lisp_Object data, const char *context) { - struct frame *sf = SELECTED_FRAME (); - /* The immediate context is not interesting for Quits, since they are asynchronous. */ if (EQ (XCAR (data), Qquit)) @@ -1083,9 +1078,23 @@ cmd_error_internal (Lisp_Object data, const char *context) call3 (Vcommand_error_function, data, context ? build_string (context) : empty_unibyte_string, Vsignaling_function); + + Vsignaling_function = Qnil; +} + +DEFUN ("command-error-default-function", Fcommand_error_default_function, + Scommand_error_default_function, 3, 3, 0, + doc: /* Produce default output for unhandled error message. +Default value of `command-error-function'. */) + (Lisp_Object data, Lisp_Object context, Lisp_Object signal) +{ + struct frame *sf = SELECTED_FRAME (); + + CHECK_STRING (context); + /* If the window system or terminal frame hasn't been initialized yet, or we're not interactive, write the message to stderr and exit. */ - else if (!sf->glyphs_initialized_p + if (!sf->glyphs_initialized_p /* The initial frame is a special non-displaying frame. It will be current in daemon mode when there are no frames to display, and in non-daemon mode before the real frame @@ -1100,7 +1109,7 @@ cmd_error_internal (Lisp_Object data, const char *context) || noninteractive) { print_error_message (data, Qexternal_debugging_output, - context, Vsignaling_function); + SSDATA (context), signal); Fterpri (Qexternal_debugging_output); Fkill_emacs (make_number (-1)); } @@ -1111,10 +1120,9 @@ cmd_error_internal (Lisp_Object data, const char *context) message_log_maybe_newline (); bitch_at_user (); - print_error_message (data, Qt, context, Vsignaling_function); + print_error_message (data, Qt, SSDATA (context), signal); } - - Vsignaling_function = Qnil; + return Qnil; } static Lisp_Object command_loop_2 (Lisp_Object); @@ -1314,6 +1322,8 @@ static void adjust_point_for_property (ptrdiff_t, bool); /* The last boundary auto-added to buffer-undo-list. */ Lisp_Object last_undo_boundary; +extern Lisp_Object Qregion_extract_function; + /* FIXME: This is wrong rather than test window-system, we should call a new set-selection, which will then dispatch to x-set-selection, or tty-set-selection, or w32-set-selection, ... */ @@ -1514,27 +1524,8 @@ command_loop_1 (void) already_adjusted = 0; if (NILP (Vthis_command)) - { - /* nil means key is undefined. */ - Lisp_Object keys = Fvector (i, keybuf); - keys = Fkey_description (keys, Qnil); - bitch_at_user (); - message_with_string ("%s is undefined", keys, 0); - kset_defining_kbd_macro (current_kboard, Qnil); - update_mode_lines = 1; - /* If this is a down-mouse event, don't reset prefix-arg; - pass it to the command run by the up event. */ - if (EVENT_HAS_PARAMETERS (last_command_event)) - { - Lisp_Object breakdown - = parse_modifiers (EVENT_HEAD (last_command_event)); - int modifiers = XINT (XCAR (XCDR (breakdown))); - if (!(modifiers & down_modifier)) - kset_prefix_arg (current_kboard, Qnil); - } - else - kset_prefix_arg (current_kboard, Qnil); - } + /* nil means key is undefined. */ + call0 (Qundefined); else { /* Here for a command that isn't executed directly. */ @@ -1641,16 +1632,11 @@ command_loop_1 (void) && NILP (Fmemq (Vthis_command, Vselection_inhibit_update_commands))) { - ptrdiff_t beg = - XINT (Fmarker_position (BVAR (current_buffer, mark))); - ptrdiff_t end = PT; - if (beg < end) - call2 (Qx_set_selection, QPRIMARY, - make_buffer_string (beg, end, 0)); - else if (beg > end) - call2 (Qx_set_selection, QPRIMARY, - make_buffer_string (end, beg, 0)); - /* Don't set empty selections. */ + Lisp_Object txt + = call1 (Fsymbol_value (Qregion_extract_function), Qnil); + if (XINT (Flength (txt)) > 0) + /* Don't set empty selections. */ + call2 (Qx_set_selection, QPRIMARY, txt); } if (current_buffer != prev_buffer || MODIFF != prev_modiff) @@ -1679,7 +1665,7 @@ command_loop_1 (void) cluster to prevent automatic composition. To recover the automatic composition, we must update the display. */ - windows_or_buffers_changed++; + windows_or_buffers_changed = 21; if (!already_adjusted) adjust_point_for_property (last_point_position, MODIFF != prev_modiff); @@ -1786,8 +1772,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) than skip both boundaries. However, this code also stops anywhere in a non-sticky text-property, which breaks (e.g.) Org mode. */ - && (val = get_pos_property (make_number (end), - Qinvisible, Qnil), + && (val = Fget_pos_property (make_number (end), + Qinvisible, Qnil), TEXT_PROP_MEANS_INVISIBLE (val)) #endif && !NILP (val = get_char_property_and_overlay @@ -1804,8 +1790,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) } while (beg > BEGV #if 0 - && (val = get_pos_property (make_number (beg), - Qinvisible, Qnil), + && (val = Fget_pos_property (make_number (beg), + Qinvisible, Qnil), TEXT_PROP_MEANS_INVISIBLE (val)) #endif && !NILP (val = get_char_property_and_overlay @@ -1858,12 +1844,12 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) to the other end would mean moving backwards and thus could lead to an infinite loop. */ ; - else if (val = get_pos_property (make_number (PT), - Qinvisible, Qnil), + else if (val = Fget_pos_property (make_number (PT), + Qinvisible, Qnil), TEXT_PROP_MEANS_INVISIBLE (val) - && (val = get_pos_property - (make_number (PT == beg ? end : beg), - Qinvisible, Qnil), + && (val = (Fget_pos_property + (make_number (PT == beg ? end : beg), + Qinvisible, Qnil)), !TEXT_PROP_MEANS_INVISIBLE (val))) (check_composition = check_display = 1, SET_PT (PT == beg ? end : beg)); @@ -1968,10 +1954,7 @@ int poll_suppress_count; static struct atimer *poll_timer; -/* Poll for input, so that we catch a C-g if it comes in. This - function is called from x_make_frame_visible, see comment - there. */ - +/* Poll for input, so that we catch a C-g if it comes in. */ void poll_for_input_1 (void) { @@ -2101,6 +2084,9 @@ bind_polling_period (int n) /* Apply the control modifier to CHARACTER. */ +#ifndef HAVE_NTGUI +static +#endif int make_ctrl_char (int c) { @@ -3234,8 +3220,6 @@ read_char (int commandflag, Lisp_Object map, RETURN_UNGCPRO (c); } -#ifdef HAVE_MENUS - /* Record a key that came from a mouse menu. Record it for echoing, for this-command-keys, and so on. */ @@ -3266,13 +3250,11 @@ record_menu_key (Lisp_Object c) /* Record this character as part of the current key. */ add_command_key (c); - /* Re-reading in the middle of a command */ + /* Re-reading in the middle of a command. */ last_input_event = c; num_input_events++; } -#endif /* HAVE_MENUS */ - /* Return true if should recognize C as "the help character". */ static bool @@ -3632,8 +3614,6 @@ kbd_buffer_store_event_hold (register struct input_event *event, Vlast_event_frame = focus; } - last_event_timestamp = event->timestamp; - handle_interrupt (0); return; } @@ -3938,8 +3918,6 @@ kbd_buffer_get_event (KBOARD **kbp, ? kbd_fetch_ptr : kbd_buffer); - last_event_timestamp = event->timestamp; - *kbp = event_to_kboard (event); if (*kbp == 0) *kbp = current_kboard; /* Better than returning null ptr? */ @@ -4301,8 +4279,6 @@ process_special_events (void) else kbd_fetch_ptr++; - /* X wants last_event_timestamp for selection ownership. */ - last_event_timestamp = copy.timestamp; input_pending = readable_events (0); x_handle_selection_event (©); #else @@ -4383,7 +4359,7 @@ decode_timer (Lisp_Object timer, struct timespec *result) if (! (VECTORP (timer) && ASIZE (timer) == 9)) return 0; - vector = XVECTOR (timer)->u.contents; + vector = XVECTOR (timer)->contents; if (! NILP (vector[0])) return 0; @@ -5324,6 +5300,20 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, dy = yret = wy; } /* Nothing special for part == ON_SCROLL_BAR. */ + else if (part == ON_RIGHT_DIVIDER) + { + posn = Qright_divider; + width = WINDOW_RIGHT_DIVIDER_WIDTH (w); + dx = xret = wx; + dy = yret = wy; + } + else if (part == ON_BOTTOM_DIVIDER) + { + posn = Qbottom_divider; + width = WINDOW_BOTTOM_DIVIDER_WIDTH (w); + dx = xret = wx; + dy = yret = wy; + } /* For clicks in the text area, fringes, or margins, call buffer_posn_from_coords to extract TEXTPOS, the buffer @@ -5554,6 +5544,9 @@ make_lispy_event (struct input_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_EVENT: +#ifdef HAVE_GPM + case GPM_CLICK_EVENT: +#endif #ifndef USE_TOOLKIT_SCROLL_BARS case SCROLL_BAR_CLICK_EVENT: #endif @@ -5567,7 +5560,11 @@ make_lispy_event (struct input_event *event) position = Qnil; /* Build the position as appropriate for this mouse click. */ - if (event->kind == MOUSE_CLICK_EVENT) + if (event->kind == MOUSE_CLICK_EVENT +#ifdef HAVE_GPM + || event->kind == GPM_CLICK_EVENT +#endif + ) { struct frame *f = XFRAME (event->frame_or_window); int row, column; @@ -6032,55 +6029,6 @@ make_lispy_event (struct input_event *event) case CONFIG_CHANGED_EVENT: return list3 (Qconfig_changed_event, event->arg, event->frame_or_window); -#ifdef HAVE_GPM - case GPM_CLICK_EVENT: - { - struct frame *f = XFRAME (event->frame_or_window); - Lisp_Object head, position; - Lisp_Object *start_pos_ptr; - Lisp_Object start_pos; - int button = event->code; - - if (button >= ASIZE (button_down_location)) - { - ptrdiff_t incr = button - ASIZE (button_down_location) + 1; - button_down_location = larger_vector (button_down_location, - incr, -1); - mouse_syms = larger_vector (mouse_syms, incr, -1); - } - - start_pos_ptr = aref_addr (button_down_location, button); - start_pos = *start_pos_ptr; - - position = make_lispy_position (f, event->x, event->y, - event->timestamp); - - if (event->modifiers & down_modifier) - *start_pos_ptr = Fcopy_alist (position); - else if (event->modifiers & (up_modifier | drag_modifier)) - { - if (!CONSP (start_pos)) - return Qnil; - event->modifiers &= ~up_modifier; - } - - head = modify_event_symbol (button, - event->modifiers, - Qmouse_click, Vlispy_mouse_stem, - NULL, - &mouse_syms, - ASIZE (mouse_syms)); - - if (event->modifiers & drag_modifier) - return list3 (head, start_pos, position); - else if (event->modifiers & double_modifier) - return list3 (head, position, make_number (2)); - else if (event->modifiers & triple_modifier) - return list3 (head, position, make_number (3)); - else - return list2 (head, position); - } -#endif /* HAVE_GPM */ /* The 'kind' field of the event is something we don't recognize. */ default: @@ -8055,7 +8003,7 @@ process_tool_bar_item (Lisp_Object key, Lisp_Object def, Lisp_Object data, void 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)->u.contents + i; + Lisp_Object *v = XVECTOR (tool_bar_items_vector)->contents + i; if (EQ (key, v[TOOL_BAR_ITEM_KEY])) { @@ -8379,7 +8327,7 @@ append_tool_bar_item (void) /* Append entries from tool_bar_item_properties to the end of tool_bar_items_vector. */ vcopy (tool_bar_items_vector, ntool_bar_items, - XVECTOR (tool_bar_item_properties)->u.contents, TOOL_BAR_ITEM_NSLOTS); + XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS); ntool_bar_items += TOOL_BAR_ITEM_NSLOTS; } @@ -8419,7 +8367,6 @@ read_char_x_menu_prompt (Lisp_Object map, if (! menu_prompting) return Qnil; -#ifdef HAVE_MENUS /* If we got to this point via a mouse click, use a real menu for mouse selection. */ if (EVENT_HAS_PARAMETERS (prev_event) @@ -8465,7 +8412,6 @@ read_char_x_menu_prompt (Lisp_Object map, *used_mouse_menu = 1; return value; } -#endif /* HAVE_MENUS */ return Qnil ; } @@ -9957,12 +9903,13 @@ requeued_events_pending_p (void) return (!NILP (Vunread_command_events)); } - -DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 0, 0, +DEFUN ("input-pending-p", Finput_pending_p, Sinput_pending_p, 0, 1, 0, doc: /* Return t if command input is currently available with no wait. Actually, the value is nil only if we can be sure that no input is available; -if there is a doubt, the value is t. */) - (void) +if there is a doubt, the value is t. + +If CHECK-TIMERS is non-nil, timers that are ready to run will do so. */) + (Lisp_Object check_timers) { if (!NILP (Vunread_command_events) || !NILP (Vunread_post_input_method_events) @@ -9972,7 +9919,8 @@ if there is a doubt, the value is t. */) /* Process non-user-visible events (Bug#10195). */ process_special_events (); - return (get_input_pending (READABLE_EVENTS_DO_TIMERS_NOW + return (get_input_pending ((NILP (check_timers) + ? 0 : READABLE_EVENTS_DO_TIMERS_NOW) | READABLE_EVENTS_FILTER_EVENTS) ? Qt : Qnil); } @@ -9981,7 +9929,7 @@ DEFUN ("recent-keys", Frecent_keys, Srecent_keys, 0, 0, 0, doc: /* Return vector of last 300 events, not counting those from keyboard macros. */) (void) { - Lisp_Object *keys = XVECTOR (recent_keys)->u.contents; + Lisp_Object *keys = XVECTOR (recent_keys)->contents; Lisp_Object val; if (total_keys < NUM_RECENT_KEYS) @@ -10007,7 +9955,7 @@ See also `this-command-keys-vector'. */) (void) { return make_event_array (this_command_key_count, - XVECTOR (this_command_keys)->u.contents); + XVECTOR (this_command_keys)->contents); } DEFUN ("this-command-keys-vector", Fthis_command_keys_vector, Sthis_command_keys_vector, 0, 0, 0, @@ -10019,7 +9967,7 @@ See also `this-command-keys'. */) (void) { return Fvector (this_command_key_count, - XVECTOR (this_command_keys)->u.contents); + XVECTOR (this_command_keys)->contents); } DEFUN ("this-single-command-keys", Fthis_single_command_keys, @@ -10034,7 +9982,7 @@ The value is always a vector. */) { return Fvector (this_command_key_count - this_single_command_key_start, - (XVECTOR (this_command_keys)->u.contents + (XVECTOR (this_command_keys)->contents + this_single_command_key_start)); } @@ -10048,7 +9996,7 @@ shows the events before all translations (except for input methods). The value is always a vector. */) (void) { - return Fvector (raw_keybuf_count, XVECTOR (raw_keybuf)->u.contents); + return Fvector (raw_keybuf_count, XVECTOR (raw_keybuf)->contents); } DEFUN ("reset-this-command-lengths", Freset_this_command_lengths, @@ -10206,7 +10154,7 @@ On such systems, Emacs starts a subshell instead of suspending. */) with a window system; but suspend should be disabled in that case. */ get_tty_size (fileno (CURTTY ()->input), &width, &height); if (width != old_width || height != old_height) - change_frame_size (SELECTED_FRAME (), height, width, 0, 0, 0); + change_frame_size (SELECTED_FRAME (), width, height, 0, 0, 0, 0); /* Run suspend-resume-hook. */ hook = intern ("suspend-resume-hook"); @@ -10790,12 +10738,11 @@ The `posn-' functions access elements of such lists. */) return tem; } - -/* - * Set up a new kboard object with reasonable initial values. - */ -void -init_kboard (KBOARD *kb) +/* Set up a new kboard object with reasonable initial values. + TYPE is a window system for which this keyboard is used. */ + +static void +init_kboard (KBOARD *kb, Lisp_Object type) { kset_overriding_terminal_local_map (kb, Qnil); kset_last_command (kb, Qnil); @@ -10816,13 +10763,27 @@ init_kboard (KBOARD *kb) kb->reference_count = 0; kset_system_key_alist (kb, Qnil); kset_system_key_syms (kb, Qnil); - kset_window_system (kb, Qt); /* Unset. */ + kset_window_system (kb, type); kset_input_decode_map (kb, Fmake_sparse_keymap (Qnil)); kset_local_function_key_map (kb, Fmake_sparse_keymap (Qnil)); Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map); kset_default_minibuffer_frame (kb, Qnil); } +/* Allocate and basically initialize keyboard + object to use with window system TYPE. */ + +KBOARD * +allocate_kboard (Lisp_Object type) +{ + KBOARD *kb = xmalloc (sizeof *kb); + + init_kboard (kb, type); + kb->next_kboard = all_kboards; + all_kboards = kb; + return kb; +} + /* * Destroy the contents of a kboard object, but not the object itself. * We use this just before deleting it, or if we're going to initialize @@ -10887,10 +10848,9 @@ init_keyboard (void) current_kboard = initial_kboard; /* Re-initialize the keyboard again. */ wipe_kboard (current_kboard); - init_kboard (current_kboard); /* A value of nil for Vwindow_system normally means a tty, but we also use it for the initial terminal since there is no window system there. */ - kset_window_system (current_kboard, Qnil); + init_kboard (current_kboard, Qnil); if (!noninteractive) { @@ -11030,6 +10990,8 @@ syms_of_keyboard (void) DEFSYM (Qvertical_line, "vertical-line"); DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar"); DEFSYM (Qmenu_bar, "menu-bar"); + DEFSYM (Qright_divider, "right-divider"); + DEFSYM (Qbottom_divider, "bottom-divider"); DEFSYM (Qmouse_fixup_help_message, "mouse-fixup-help-message"); @@ -11162,6 +11124,7 @@ syms_of_keyboard (void) defsubr (&Sabort_recursive_edit); defsubr (&Sexit_recursive_edit); defsubr (&Srecursion_depth); + defsubr (&Scommand_error_default_function); defsubr (&Stop_level); defsubr (&Sdiscard_input); defsubr (&Sopen_dribble_file); @@ -11452,18 +11415,19 @@ tool-bar separators natively. Otherwise it is unused (e.g. on GTK). */); DEFVAR_KBOARD ("overriding-terminal-local-map", Voverriding_terminal_local_map, doc: /* Per-terminal keymap that takes precedence over all other keymaps. - This variable is intended to let commands such as `universal-argument' set up a different keymap for reading the next command. `overriding-terminal-local-map' has a separate binding for each -terminal device. -See Info node `(elisp)Multiple Terminals'. */); +terminal device. See Info node `(elisp)Multiple Terminals'. */); DEFVAR_LISP ("overriding-local-map", Voverriding_local_map, - doc: /* Keymap that overrides almost all other local keymaps. -If this variable is non-nil, it is used as a keymap--replacing the -buffer's local map, the minor mode keymaps, and char property keymaps. */); + doc: /* Keymap that replaces (overrides) local keymaps. +If this variable is non-nil, Emacs looks up key bindings in this +keymap INSTEAD OF the keymap char property, minor mode maps, and the +buffer's local map. Hence, the only active keymaps would be +`overriding-terminal-local-map', this keymap, and `global-keymap', in +order of precedence. */); Voverriding_local_map = Qnil; DEFVAR_LISP ("overriding-local-map-menu-flag", Voverriding_local_map_menu_flag, @@ -11641,13 +11605,13 @@ peculiar kind of quitting. */); Vthrow_on_input = Qnil; DEFVAR_LISP ("command-error-function", Vcommand_error_function, - doc: /* If non-nil, function to output error messages. -The arguments are the error data, a list of the form - (SIGNALED-CONDITIONS . SIGNAL-DATA) -such as just as `condition-case' would bind its variable to, -the context (a string which normally goes at the start of the message), -and the Lisp function within which the error was signaled. */); - Vcommand_error_function = Qnil; + doc: /* Function to output error messages. +Called with three arguments: +- the error data, a list of the form (SIGNALED-CONDITION . SIGNAL-DATA) + such as what `condition-case' would bind its variable to, +- the context (a string which normally goes at the start of the message), +- the Lisp function within which the error was signaled. */); + Vcommand_error_function = intern ("command-error-default-function"); DEFVAR_LISP ("enable-disabled-menus-and-buttons", Venable_disabled_menus_and_buttons, @@ -11695,12 +11659,8 @@ Currently, the only supported values for this variable are `sigusr1' and `sigusr2'. */); Vdebug_on_event = intern_c_string ("sigusr2"); - /* Create the initial keyboard. */ - initial_kboard = xmalloc (sizeof *initial_kboard); - init_kboard (initial_kboard); - /* Vwindow_system is left at t for now. */ - initial_kboard->next_kboard = all_kboards; - all_kboards = initial_kboard; + /* Create the initial keyboard. Qt means 'unset'. */ + initial_kboard = allocate_kboard (Qt); } void