sequence, without disturbing the key sequence composition, or the
command builder structure representing it.
- Someone should rethink univeral-argument and figure out how an
+ Someone should rethink universal-argument and figure out how an
arbitrary command can influence the next command (universal-argument
- or univeral-coding-system-argument) or the next key (hyperify).
+ or universal-coding-system-argument) or the next key (hyperify).
Both C-h and Help in the middle of a key sequence should trigger
prefix-help-command. help-char is stupid. Maybe we need
#include "keymap.h"
#include "lstream.h"
#include "macros.h" /* for defining_keyboard_macro */
-#include "opaque.h"
#include "process.h"
#include "window.h"
Lisp_Object Qundefined_keystroke_sequence;
-Lisp_Object Qcommand_execute;
-
Lisp_Object Qcommand_event_p;
/* Hooks to run before and after each command. */
/* whether menu accelerators are enabled */
Lisp_Object Vmenu_accelerator_enabled;
-/* keymap for auxillary menu accelerator functions */
+/* keymap for auxiliary menu accelerator functions */
Lisp_Object Vmenu_accelerator_map;
Lisp_Object Qmenu_force;
Lisp_Object Qmenu_select;
Lisp_Object Qmenu_escape;
+Lisp_Object Qself_insert_defer_undo;
+
/* this is in keymap.c */
extern Lisp_Object Fmake_keymap (Lisp_Object name);
#define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
static Lisp_Object
-mark_command_builder (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_command_builder (Lisp_Object obj)
{
struct command_builder *builder = XCOMMAND_BUILDER (obj);
- (markobj) (builder->prefix_events);
- (markobj) (builder->current_events);
- (markobj) (builder->most_current_event);
- (markobj) (builder->last_non_munged_event);
- (markobj) (builder->munge_me[0].first_mungeable_event);
- (markobj) (builder->munge_me[1].first_mungeable_event);
+ mark_object (builder->prefix_events);
+ mark_object (builder->current_events);
+ mark_object (builder->most_current_event);
+ mark_object (builder->last_non_munged_event);
+ mark_object (builder->munge_me[0].first_mungeable_event);
+ mark_object (builder->munge_me[1].first_mungeable_event);
return builder->console;
}
DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder,
mark_command_builder, internal_object_printer,
- finalize_command_builder, 0, 0,
+ finalize_command_builder, 0, 0, 0,
struct command_builder);
\f
static void
{
Lisp_Object builder_obj;
struct command_builder *builder =
- alloc_lcrecord_type (struct command_builder, lrecord_command_builder);
+ alloc_lcrecord_type (struct command_builder, &lrecord_command_builder);
builder->console = console;
reset_command_builder_event_chain (builder);
if (XEVENT_TYPE (event) != key_press_event)
return;
- if (!HASHTABLEP (Vkeyboard_translate_table))
+ if (!HASH_TABLEP (Vkeyboard_translate_table))
return;
- if (EQ (Fhashtable_fullness (Vkeyboard_translate_table), Qzero))
+ if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero))
return;
c = event_to_character (XEVENT (event), 0, 0, 0);
help = Feval (Vhelp_form);
if (STRINGP (help))
- internal_with_output_to_temp_buffer ("*Help*",
+ internal_with_output_to_temp_buffer (build_string ("*Help*"),
print_help, help, Qnil);
Fnext_command_event (event, Qnil);
/* Remove the help from the frame */
used to indicate an absence of a timer. */
static int low_level_timeout_id_tick;
-struct low_level_timeout_blocktype
+static struct low_level_timeout_blocktype
{
Blocktype_declare (struct low_level_timeout);
} *the_low_level_timeout_blocktype;
static int timeout_id_tick;
-/* Since timeout structures contain Lisp_Objects, they need to be GC'd
- properly. The opaque data type provides a convenient way of doing
- this without having to create a new Lisp object, since we can
- provide our own mark function. */
-
-struct timeout
-{
- int id; /* Id we use to identify the timeout over its lifetime */
- int interval_id; /* Id for this particular interval; this may
- be different each time the timeout is
- signalled.*/
- Lisp_Object function, object; /* Function and object associated
- with timeout. */
- EMACS_TIME next_signal_time; /* Absolute time when the timeout
- is next going to be signalled. */
- unsigned int resignal_msecs; /* How far after the next timeout
- should the one after that
- occur? */
-};
-
static Lisp_Object pending_timeout_list, pending_async_timeout_list;
static Lisp_Object Vtimeout_free_list;
static Lisp_Object
-mark_timeout (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_timeout (Lisp_Object obj)
{
- struct timeout *tm = (struct timeout *) XOPAQUE_DATA (obj);
- (markobj) (tm->function);
+ struct Lisp_Timeout *tm = XTIMEOUT (obj);
+ mark_object (tm->function);
return tm->object;
}
+/* Should never, ever be called. (except by an external debugger) */
+static void
+print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+ CONST struct Lisp_Timeout *t = XTIMEOUT (obj);
+ char buf[64];
+
+ sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
+ (unsigned long) t);
+ write_c_string (buf, printcharfun);
+}
+
+static const struct lrecord_description timeout_description[] = {
+ { XD_LISP_OBJECT, offsetof(struct Lisp_Timeout, function), 2 },
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
+ mark_timeout, print_timeout,
+ 0, 0, 0, timeout_description, struct Lisp_Timeout);
+
/* Generate a timeout and return its ID. */
int
Lisp_Object function, Lisp_Object object,
int async_p)
{
- Lisp_Object op = allocate_managed_opaque (Vtimeout_free_list, 0);
- struct timeout *timeout = (struct timeout *) XOPAQUE_DATA (op);
+ Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
+ struct Lisp_Timeout *timeout = XTIMEOUT (op);
EMACS_TIME current_time;
EMACS_TIME interval;
Lisp_Object *function, Lisp_Object *object)
{
Lisp_Object op = Qnil, rest;
- struct timeout *timeout;
+ struct Lisp_Timeout *timeout;
Lisp_Object *timeout_list;
struct gcpro gcpro1;
int id;
/* Find the timeout on the list of pending ones. */
LIST_LOOP (rest, *timeout_list)
{
- timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
+ timeout = XTIMEOUT (XCAR (rest));
if (timeout->interval_id == interval_id)
break;
}
assert (!NILP (rest));
op = XCAR (rest);
- timeout = (struct timeout *) XOPAQUE_DATA (op);
+ timeout = XTIMEOUT (op);
/* We make sure to snarf the data out of the timeout object before
- we free it with free_managed_opaque(). */
+ we free it with free_managed_lcrecord(). */
id = timeout->id;
*function = timeout->function;
*object = timeout->object;
*timeout_list = noseeum_cons (op, *timeout_list);
}
else
- free_managed_opaque (Vtimeout_free_list, op);
+ free_managed_lcrecord (Vtimeout_free_list, op);
UNGCPRO;
return id;
void
event_stream_disable_wakeup (int id, int async_p)
{
- struct timeout *timeout = 0;
+ struct Lisp_Timeout *timeout = 0;
Lisp_Object rest;
Lisp_Object *timeout_list;
/* Find the timeout on the list of pending ones, if it's still there. */
LIST_LOOP (rest, *timeout_list)
{
- timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
+ timeout = XTIMEOUT (XCAR (rest));
if (timeout->id == id)
break;
}
event_stream_remove_async_timeout (timeout->interval_id);
else
event_stream_remove_timeout (timeout->interval_id);
- free_managed_opaque (Vtimeout_free_list, op);
+ free_managed_lcrecord (Vtimeout_free_list, op);
}
}
static int
event_stream_wakeup_pending_p (int id, int async_p)
{
- struct timeout *timeout;
+ struct Lisp_Timeout *timeout;
Lisp_Object rest;
Lisp_Object timeout_list;
int found = 0;
/* Find the element on the list of pending ones, if it's still there. */
LIST_LOOP (rest, timeout_list)
{
- timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
+ timeout = XTIMEOUT (XCAR (rest));
if (timeout->id == id)
{
found = 1;
* get here and have it be non-nil.
*/
if (FRAMEP (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d)))
- old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
+ old_frame = DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d);
else if (FRAMEP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)))
old_frame = DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d);
XCAR (XCDR (XCDR (Vlast_command_event_time)))
= make_int (EMACS_USECS (t));
}
-
/* If this key came from the keyboard or from a keyboard macro, then
it goes into the recent-keys and this-command-keys vectors.
If this key came from the keyboard, and we're defining a keyboard
The event returned will be a keyboard, mouse press, or mouse release event.
If there are non-command events available (mouse motion, sub-process output,
etc) then these will be executed (with `dispatch-event') and discarded. This
-function is provided as a convenience; it is rougly equivalent to the lisp code
+function is provided as a convenience; it is roughly equivalent to the lisp code
(while (progn
(next-event event prompt)
All of these routines install timeouts, so we clear the installed
timeout as well.
- Note: It's very easy to break the desired behaviours of these
+ Note: It's very easy to break the desired behaviors of these
3 routines. If you make any changes to anything in this area, run
the regression tests at the bottom of the file. -- dmoore */
if (noninteractive || !NILP (Vexecuting_macro))
return Qnil;
- /* Recusive call from a filter function or timeout handler. */
+ /* Recursive call from a filter function or timeout handler. */
if (!NILP(recursive_sit_for))
{
if (!event_stream_event_pending_p (1) && NILP (nodisplay))
static void
menu_move_up (void)
{
- widget_value *current, *prev;
- widget_value *entries;
+ widget_value *current = lw_get_entries (False);
+ widget_value *entries = lw_get_entries (True);
+ widget_value *prev = NULL;
- current = lw_get_entries (False);
- entries = lw_get_entries (True);
- prev = NULL;
- if (current != entries)
+ while (entries != current)
{
- while (entries != current)
- {
- if (entries->name /*&& entries->enabled*/) prev = entries;
- entries = entries->next;
- assert (entries);
- }
+ if (entries->name /*&& entries->enabled*/) prev = entries;
+ entries = entries->next;
+ assert (entries);
}
if (!prev)
static void
menu_move_down (void)
{
- widget_value *current;
- widget_value *new;
-
- current = lw_get_entries (False);
- new = current;
+ widget_value *current = lw_get_entries (False);
+ widget_value *new = current;
while (new->next)
{
int l = level;
widget_value *current;
- while (level >= 3)
- {
- --level;
- lw_pop_menu ();
- }
+ while (level-- >= 3)
+ lw_pop_menu ();
+
menu_move_up ();
current = lw_get_entries (False);
if (l > 2 && current->contents)
int l = level;
widget_value *current;
- while (level >= 3)
- {
- --level;
- lw_pop_menu ();
- }
+ while (level-- >= 3)
+ lw_pop_menu ();
+
menu_move_down ();
current = lw_get_entries (False);
if (l > 2 && current->contents)
/* Vthis_command_keys having value Qnil means that the next time
push_this_command_keys is called, it should start over.
The times at which the command-keys are reset
- (instead of merely being augmented) are pretty conterintuitive.
+ (instead of merely being augmented) are pretty counterintuitive.
(More specifically:
-- We do not reset this-command-keys when we finish reading a
;
else
#endif
- if (!NILP (con->prefix_arg))
+ if (!NILP (con->prefix_arg))
{
/* Commands that set the prefix arg don't update last-command, don't
reset the echoing state, and don't go into keyboard macros unless
}
else /* key sequence is bound to a command */
{
+ int magic_undo = 0;
+ int magic_undo_count = 20;
+
Vthis_command = leaf;
+
/* Don't push an undo boundary if the command set the prefix arg,
or if we are executing a keyboard macro, or if in the
minibuffer. If the command we are about to execute is
self-insert, it's tricky: up to 20 consecutive self-inserts may
be done without an undo boundary. This counter is reset as
soon as a command other than self-insert-command is executed.
- */
- if (! EQ (leaf, Qself_insert_command))
+
+ Programmers can also use the `self-insert-undo-magic'
+ property to install that behaviour on functions other
+ than `self-insert-command', or to change the magic
+ number 20 to something else. */
+
+ if (SYMBOLP (leaf))
+ {
+ Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
+ if (NATNUMP (prop))
+ magic_undo = 1, magic_undo_count = XINT (prop);
+ else if (!NILP (prop))
+ magic_undo = 1;
+ else if (EQ (leaf, Qself_insert_command))
+ magic_undo = 1;
+ }
+
+ if (!magic_undo)
command_builder->self_insert_countdown = 0;
if (NILP (XCONSOLE (console)->prefix_arg)
&& NILP (Vexecuting_macro)
&& command_builder->self_insert_countdown == 0)
Fundo_boundary ();
- if (EQ (leaf, Qself_insert_command))
+ if (magic_undo)
{
if (--command_builder->self_insert_countdown < 0)
- command_builder->self_insert_countdown = 20;
+ command_builder->self_insert_countdown = magic_undo_count;
}
execute_command_event
(command_builder,
Calling this function directs the translated event to replace
the original event, so that only one version of the event actually
-appears in the echo area and in the value of `this-command-keys.'.
+appears in the echo area and in the value of `this-command-keys'.
*/
())
{
{
Emchar ch = XCHAR (keysym);
Bufbyte str[MAX_EMCHAR_LEN];
- Bytecount len;
-
- len = set_charptr_emchar (str, ch);
+ Bytecount len = set_charptr_emchar (str, ch);
Lstream_write (XLSTREAM (Vdribble_file), str, len);
}
else if (string_char_length (XSYMBOL (keysym)->name) == 1)
deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
"Undefined keystroke sequence", Qerror);
- defsymbol (&Qcommand_execute, "command-execute");
DEFSUBR (Frecent_keys);
DEFSUBR (Frecent_keys_ring_size);
defsymbol (&Qmenu_select, "menu-select");
defsymbol (&Qmenu_escape, "menu-escape");
+ defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
}
void
-vars_of_event_stream (void)
+reinit_vars_of_event_stream (void)
{
-#ifdef HAVE_X_WINDOWS
- vars_of_event_Xt ();
-#endif
-#if defined(HAVE_TTY) && (defined (DEBUG_TTY_EVENT_STREAM) || !defined (HAVE_X_WINDOWS))
- vars_of_event_tty ();
-#endif
-#ifdef HAVE_MS_WINDOWS
- vars_of_event_mswindows ();
-#endif
-
recent_keys_ring_index = 0;
recent_keys_ring_size = 100;
+ num_input_chars = 0;
+ Vtimeout_free_list = make_lcrecord_list (sizeof (struct Lisp_Timeout),
+ &lrecord_timeout);
+ staticpro_nodump (&Vtimeout_free_list);
+ the_low_level_timeout_blocktype =
+ Blocktype_new (struct low_level_timeout_blocktype);
+ something_happened = 0;
+ recursive_sit_for = Qnil;
+}
+
+void
+vars_of_event_stream (void)
+{
+ reinit_vars_of_event_stream ();
Vrecent_keys_ring = Qnil;
staticpro (&Vrecent_keys_ring);
Vthis_command_keys = Qnil;
staticpro (&Vthis_command_keys);
Vthis_command_keys_tail = Qnil;
-
- num_input_chars = 0;
+ pdump_wire (&Vthis_command_keys_tail);
command_event_queue = Qnil;
staticpro (&command_event_queue);
command_event_queue_tail = Qnil;
+ pdump_wire (&command_event_queue_tail);
Vlast_selected_frame = Qnil;
staticpro (&Vlast_selected_frame);
pending_async_timeout_list = Qnil;
staticpro (&pending_async_timeout_list);
- Vtimeout_free_list = make_opaque_list (sizeof (struct timeout),
- mark_timeout);
- staticpro (&Vtimeout_free_list);
-
- the_low_level_timeout_blocktype =
- Blocktype_new (struct low_level_timeout_blocktype);
-
- something_happened = 0;
-
last_point_position_buffer = Qnil;
staticpro (&last_point_position_buffer);
- recursive_sit_for = Qnil;
-
DEFVAR_LISP ("echo-keystrokes", &Vecho_keystrokes /*
*Nonzero means echo unfinished commands after this many seconds of pause.
*/ );
*Variable to control XEmacs behavior with respect to focus changing.
If this variable is set to t, then XEmacs will not gratuitously change
the keyboard focus. XEmacs cannot in general detect when this mode is
-use by the window manager, so it is up to the user to set it.
+used by the window manager, so it is up to the user to set it.
*/ );
focus_follows_mouse = 0;
void
complex_vars_of_event_stream (void)
{
- Vkeyboard_translate_table = Fmake_hashtable (make_int (100), Qnil);
+ Vkeyboard_translate_table =
+ make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /*
Keymap for use when the menubar is active.
if (initialized)
{
#ifdef HAVE_UNIXOID_EVENT_LOOP
- /* if (strcmp (display_use, "mswindows") != 0)*/
- init_event_unixoid ();
+ init_event_unixoid ();
#endif
#ifdef HAVE_X_WINDOWS
if (!strcmp (display_use, "x"))
{
/* For TTY's, use the Xt event loop if we can; it allows
us to later open an X connection. */
-#if defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
+#if defined (HAVE_MS_WINDOWS) && (!defined (HAVE_TTY) \
+ || (defined (HAVE_MSG_SELECT) \
+ && !defined (DEBUG_TTY_EVENT_STREAM)))
+ init_event_mswindows_late ();
+#elif defined (HAVE_X_WINDOWS) && !defined (DEBUG_TTY_EVENT_STREAM)
init_event_Xt_late ();
#elif defined (HAVE_TTY)
init_event_tty_late ();
-#elif defined (HAVE_MS_WINDOWS)
- init_event_mswindows_late ();
#endif
}
init_interrupts_late ();
(tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer
; with sit-for only do the 2nd test.
-; Do all 3 tests with (accept-proccess-output nil 20)
+; Do all 3 tests with (accept-process-output nil 20)
Do this:
(setq enable-recursive-minibuffers t