#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. */
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);
XRECORD (x, command_builder, struct command_builder)
#define XSETCOMMAND_BUILDER(x, p) XSETRECORD (x, p, command_builder)
#define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
-#define GC_COMMAND_BUILDERP(x) GC_RECORDP (x, command_builder)
#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);
}
static int
-maybe_read_quit_event (struct Lisp_Event *event)
+maybe_read_quit_event (Lisp_Event *event)
{
/* A C-g that came from `sigint_happened' will always come from the
controlling terminal. If that doesn't exist, however, then the
}
void
-event_stream_next_event (struct Lisp_Event *event)
+event_stream_next_event (Lisp_Event *event)
{
Lisp_Object event_obj;
}
void
-event_stream_handle_magic_event (struct Lisp_Event *event)
+event_stream_handle_magic_event (Lisp_Event *event)
{
check_event_stream_ok (EVENT_STREAM_READ);
event_stream->handle_magic_event_cb (event);
}
void
-event_stream_select_process (struct Lisp_Process *proc)
+event_stream_select_process (Lisp_Process *proc)
{
check_event_stream_ok (EVENT_STREAM_PROCESS);
if (!get_process_selected_p (proc))
}
void
-event_stream_unselect_process (struct Lisp_Process *proc)
+event_stream_unselect_process (Lisp_Process *proc)
{
check_event_stream_ok (EVENT_STREAM_PROCESS);
if (get_process_selected_p (proc))
}
else if (CHARP (traduit))
{
- struct Lisp_Event ev2;
+ Lisp_Event ev2;
/* This used to call Fcharacter_to_event() directly into EVENT,
but that can eradicate timestamps and other such stuff.
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);
+ 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 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 (Lisp_Timeout, function) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
+ { XD_END }
+};
+
+DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
+ mark_timeout, print_timeout,
+ 0, 0, 0, timeout_description, 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);
+ 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;
+ 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;
+ 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;
+ 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;
}
else
{
- struct Lisp_Event *e = XEVENT (target_event);
+ Lisp_Event *e = XEVENT (target_event);
/* The command_event_queue was empty. Wait for an event. */
event_stream_next_event (e);
case timeout_event:
{
- struct Lisp_Event *e = XEVENT (event);
+ Lisp_Event *e = XEVENT (event);
if (!NILP (e->event.timeout.function))
call1 (e->event.timeout.function,
e->event.timeout.object);
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)
|| (CHAR_OR_CHAR_INTP (key->keysym)
&& ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
{
- struct Lisp_Event terminal_copy = *XEVENT (terminal);
+ Lisp_Event terminal_copy = *XEVENT (terminal);
if (key->modifiers & MOD_SHIFT)
key->modifiers &= (~ MOD_SHIFT);
if (EVENTP (recent)
&& event_matches_key_specifier_p (XEVENT (recent), Vmeta_prefix_char))
{
- struct Lisp_Event *e;
+ Lisp_Event *e;
/* When we see a sequence like "ESC x", pretend we really saw "M-x".
DoubleThink the recent-keys and this-command-keys as well. */
}
else if (!NILP (Vquit_flag)) {
Lisp_Object quit_event = Fmake_event(Qnil, Qnil);
- struct Lisp_Event *e = XEVENT (quit_event);
+ Lisp_Event *e = XEVENT (quit_event);
/* if quit happened during menu acceleration, pretend we read it */
struct console *con = XCONSOLE (Fselected_console ());
int ch = CONSOLE_QUIT_CHAR (con);
#if 0
/* If the last command deleted the frame, `win' might be nil.
It seems safest to do nothing in this case. */
- /* ### This doesn't really fix the problem,
+ /* #### This doesn't really fix the problem,
if delete-frame is called by some hook */
if (NILP (win))
return;
{
/* This function can GC */
struct command_builder *command_builder;
- struct Lisp_Event *ev;
+ Lisp_Event *ev;
Lisp_Object console;
Lisp_Object channel;
}
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)
{
recent_keys_ring_index = 0;
recent_keys_ring_size = 100;
+ num_input_chars = 0;
+ Vtimeout_free_list = make_lcrecord_list (sizeof (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;
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 ();
projects / chise / xemacs-chise.git.1 / blobdiff