xemacs-beta: src/event-stream.c comparison

comparison src/event-stream.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29

author	cvs
date	Mon, 13 Aug 2007 11:13:30 +0200
parents	7d59cb494b73
children	a86b2b5e0111

comparison

equal deleted inserted replaced

-:f4aeb21a5bad
+:74fd4e045ea6
 #include "frame.h"
 #include "insdel.h"		/* for buffer_reset_changes */
 #include "keymap.h"
 #include "lstream.h"
 #include "macros.h"		/* for defining_keyboard_macro */
-#include "opaque.h"
 #include "process.h"
 #include "window.h"
 #include "sysdep.h"		/* init_poll_for_quit() */
 #include "syssignal.h"		/* SIGCHLD, etc. */
 /* The number of keystrokes between auto-saves. */
 static int auto_save_interval;
 Lisp_Object Qundefined_keystroke_sequence;
-Lisp_Object Qcommand_execute;
 Lisp_Object Qcommand_event_p;
 /* Hooks to run before and after each command.  */
 Lisp_Object Vpre_command_hook, Vpost_command_hook;
 Lisp_Object Qmenu_down;
 Lisp_Object Qmenu_left;
 Lisp_Object Qmenu_right;
 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);
 #ifdef DEBUG_XEMACS
 #define XCOMMAND_BUILDER(x) \
 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);
+mark_object (builder->prefix_events);
-markobj (builder->current_events);
+mark_object (builder->current_events);
-markobj (builder->most_current_event);
+mark_object (builder->most_current_event);
-markobj (builder->last_non_munged_event);
+mark_object (builder->last_non_munged_event);
-markobj (builder->munge_me[0].first_mungeable_event);
+mark_object (builder->munge_me[0].first_mungeable_event);
-markobj (builder->munge_me[1].first_mungeable_event);
+mark_object (builder->munge_me[1].first_mungeable_event);
 return builder->console;
 }
 static void
 finalize_command_builder (void *header, int for_disksave)
 }
 }
 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);
 static void
 reset_command_builder_event_chain (struct command_builder *builder)
 {
 Lisp_Object
 allocate_command_builder (Lisp_Object console)
 {
 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);
 builder->echo_buf_length = 300; /* #### Kludge */
 builder->echo_buf = xnew_array (Bufbyte, builder->echo_buf_length);
 {
 return event_stream && event_stream->event_pending_p (user);
 }
 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
 user manually sent us a SIGINT, and we pretend the C-g came from
 the selected console. */
 }
 return 0;
 }
 void
-event_stream_next_event (struct Lisp_Event *event)
+event_stream_next_event (Lisp_Event *event)
 {
 Lisp_Object event_obj;
 check_event_stream_ok (EVENT_STREAM_READ);
 #endif
 maybe_kbd_translate (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);
 }
 con->input_enabled = 0;
 }
 }
 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))
 {
 event_stream->select_process_cb (proc);
 set_process_selected_p (proc, 1);
 }
 }
 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))
 {
 event_stream->unselect_process_cb (proc);
 	  XEVENT (event)->event.key.modifiers = 0;
 	  did_translate = 1;
 	}
 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.
 	     This way is safer. */
 	  zero_event (&ev2);
 /* We ensure that 0 is never a valid ID, so that a value of 0 can be
 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;
 /* Add a one-shot timeout at time TIME to TIMEOUT_LIST.  Return
 /**** High-level timeout functions. ****/
 static int timeout_id_tick;
-/* Since timeout structures contain Lisp_Objects, they need to be GC'd
+static Lisp_Object pending_timeout_list, pending_async_timeout_list;
-properly.  The opaque data type provides a convenient way of doing
-this without having to create a new Lisp object, since we can
+static Lisp_Object Vtimeout_free_list;
-provide our own mark function. */
+static Lisp_Object
-struct timeout
+mark_timeout (Lisp_Object obj)
 {
-int id; /* Id we use to identify the timeout over its lifetime */
+Lisp_Timeout *tm = XTIMEOUT (obj);
-int interval_id; /* Id for this particular interval; this may
+mark_object (tm->function);
-		      be different each time the timeout is
+return tm->object;
-		      signalled.*/
+}
-Lisp_Object function, object; /* Function and object associated
-				   with timeout. */
+/* Should never, ever be called. (except by an external debugger) */
-EMACS_TIME next_signal_time;  /* Absolute time when the timeout
+static void
-				   is next going to be signalled. */
+print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
-unsigned int resignal_msecs;  /* How far after the next timeout
+{
-				   should the one after that
+const Lisp_Timeout *t = XTIMEOUT (obj);
-				   occur? */
+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 }
 };
-static Lisp_Object pending_timeout_list, pending_async_timeout_list;
+DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout,
+			       mark_timeout, print_timeout,
-static Lisp_Object Vtimeout_free_list;
+			       0, 0, 0, timeout_description, Lisp_Timeout);
-static Lisp_Object
-mark_timeout (Lisp_Object obj, void (*markobj) (Lisp_Object))
-{
-struct timeout *tm = (struct timeout *) XOPAQUE_DATA (obj);
-markobj (tm->function);
-return tm->object;
-}
 /* Generate a timeout and return its ID. */
 int
 event_stream_generate_wakeup (unsigned int milliseconds,
 			      unsigned int vanilliseconds,
 			      Lisp_Object function, Lisp_Object object,
 			      int async_p)
 {
-Lisp_Object op = allocate_managed_opaque (Vtimeout_free_list, 0);
+Lisp_Object op = allocate_managed_lcrecord (Vtimeout_free_list);
-struct timeout *timeout = (struct timeout *) XOPAQUE_DATA (op);
+Lisp_Timeout *timeout = XTIMEOUT (op);
 EMACS_TIME current_time;
 EMACS_TIME interval;
 timeout->id = timeout_id_tick++;
 timeout->resignal_msecs = vanilliseconds;
 static int
 event_stream_resignal_wakeup (int interval_id, int async_p,
 			      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;
 GCPRO1 (op); /* just in case ...  because it's removed from the list
 timeout_list = async_p ? &pending_async_timeout_list : &pending_timeout_list;
 /* 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;
 /* Remove this one from the list of pending timeouts */
 is to move frequently-hit timeouts to the front of the
 	 list, which is a good thing. */
 *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;
 if (async_p)
 timeout_list = &pending_async_timeout_list;
 timeout_list = &pending_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;
 }
 /* If we found it, remove it from the list and disable the pending
 	delq_no_quit_and_free_cons (op, *timeout_list);
 if (async_p)
 	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;
 timeout_list = pending_timeout_list;
 /* 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;
 	  break;
 	}
 Fdeallocate_event (event);
 DEBUG_PRINT_EMACS_EVENT ("command event queue", target_event);
 }
 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);
 /* If this was a timeout, then we need to extract some data
 	 out of the returned closure and might need to resignal
 	return;
 }
 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);
 	return;
 }
 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
 static void
 menu_move_up (void)
 {
-widget_value *current, *prev;
+widget_value *current = lw_get_entries (False);
-widget_value *entries;
+widget_value *entries = lw_get_entries (True);
+widget_value *prev    = NULL;
-current = lw_get_entries (False);
-entries = lw_get_entries (True);
+while (entries != current)
-prev = NULL;
+{
-if (current != entries)
+if (entries->name /*&& entries->enabled*/) prev = entries;
-{
+entries = entries->next;
-while (entries != current)
+assert (entries);
-	{
-	  if (entries->name /*&& entries->enabled*/) prev = entries;
-	  entries = entries->next;
-	  assert (entries);
-	}
 }
 if (!prev)
 /* move to last item */
 {
 }
 static void
 menu_move_down (void)
 {
-widget_value *current;
+widget_value *current = lw_get_entries (False);
-widget_value *new;
+widget_value *new = current;
-current = lw_get_entries (False);
-new = current;
 while (new->next)
 {
 new = new->next;
 if (new->name /*&& new->enabled*/) break;
 {
 int level = lw_menu_level ();
 int l = level;
 widget_value *current;
-while (level >= 3)
+while (level-- >= 3)
-{
+lw_pop_menu ();
---level;
-lw_pop_menu ();
-}
 menu_move_up ();
 current = lw_get_entries (False);
 if (l > 2 && current->contents)
 lw_push_menu (current->contents);
 }
 {
 int level = lw_menu_level ();
 int l = level;
 widget_value *current;
-while (level >= 3)
+while (level-- >= 3)
-{
+lw_pop_menu ();
---level;
-lw_pop_menu ();
-}
 menu_move_down ();
 current = lw_get_entries (False);
 if (l > 2 && current->contents)
 lw_push_menu (current->contents);
 }
 	 (with-output-to-string (display-error errordata))
 	 but that stuff is all in Lisp currently. */
 args[1] = errordata;
 warn_when_safe_lispobj
 	(Qerror, Qwarning,
-	 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
+	 emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s",
 				   Qnil, -1, 2, args));
 }
 return Qnil;
 }
 Emchar c = 0;
 if ((key->modifiers & MOD_SHIFT)
 || (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);
 else
 key->keysym = make_char (c + 'a' - 'A');
 Lisp_Object recent = command_builder->most_current_event;
 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. */
 	/* Modify the previous most-recently-pushed event on the command
 	   builder to be a copy of this one with the meta-bit set instead of
 	    else
 	      maybe_echo_keys (command_builder, 0);
 	  }
 	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);
 	  character_to_event (ch, e, con, 1, 1);
 Lisp_Object win = Fselected_window (Qnil);
 #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;
 #endif
 */
 (event))
 {
 /* This function can GC */
 struct command_builder *command_builder;
-struct Lisp_Event *ev;
+Lisp_Event *ev;
 Lisp_Object console;
 Lisp_Object channel;
 CHECK_LIVE_EVENT (event);
 ev = XEVENT (event);
 	    /* Reset the command builder for reading the next sequence. */
 	    reset_this_command_keys (console, 1);
 	  }
 	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)
 #if 0
 		/* This was done in the days when there was no undo
 		&& !EQ (minibuf_window, Fselected_window (Qnil))
 #endif
 		&& 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,
 	       internal_equal (event, command_builder-> most_current_event, 0)
 ? event
 the value of `this-command-keys' in addition to the raw original event.
 That is not right.
 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'.
 */
 ())
 {
 /* #### I don't understand this at all, so currently it does nothing.
 If there is ever a problem, maybe someone should investigate. */
 Lisp_Object keysym = XEVENT (event)->event.key.keysym;
 if (CHARP (XEVENT (event)->event.key.keysym))
 	{
 	  Emchar ch = XCHAR (keysym);
 	  Bufbyte str[MAX_EMCHAR_LEN];
-	  Bytecount len;
+	  Bytecount len = set_charptr_emchar (str, ch);
-	  len = set_charptr_emchar (str, ch);
 	  Lstream_write (XLSTREAM (Vdribble_file), str, len);
 	}
 else if (string_char_length (XSYMBOL (keysym)->name) == 1)
 	/* one-char key events are printed with just the key name */
 	Fprinc (keysym, Vdribble_file);
 defsymbol (&Qdisabled, "disabled");
 defsymbol (&Qcommand_event_p, "command-event-p");
 deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
 "Undefined keystroke sequence", Qerror);
-defsymbol (&Qcommand_execute, "command-execute");
 DEFSUBR (Frecent_keys);
 DEFSUBR (Frecent_keys_ring_size);
 DEFSUBR (Fset_recent_keys_ring_size);
 DEFSUBR (Finput_pending_p);
 defsymbol (&Qmenu_left, "menu-left");
 defsymbol (&Qmenu_right, "menu-right");
 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
+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)
 {
-recent_keys_ring_index = 0;
+reinit_vars_of_event_stream ();
-recent_keys_ring_size = 100;
 Vrecent_keys_ring = Qnil;
 staticpro (&Vrecent_keys_ring);
 Vthis_command_keys = Qnil;
 staticpro (&Vthis_command_keys);
 Vthis_command_keys_tail = Qnil;
+pdump_wire (&Vthis_command_keys_tail);
-num_input_chars = 0;
 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_timeout_list = Qnil;
 staticpro (&pending_timeout_list);
 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.
 */ );
 Vecho_keystrokes = make_int (1);

Mercurial > hg > xemacs-beta

comparison src/event-stream.c @ 398:74fd4e045ea6 r21-2-29