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

comparison src/event-stream.c @ 424:11054d720c21 r21-2-20

Import from CVS: tag r21-2-20

author	cvs
date	Mon, 13 Aug 2007 11:26:11 +0200
parents	41dbb7a9d5f2
children

comparison

equal deleted inserted replaced

-:28d9c139be4c
+:11054d720c21
 #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;
 #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)
 /* 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 */
+struct 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 struct 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(struct Lisp_Timeout, function), 2 },
+{ 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, struct 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);
+struct 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;
+struct 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;
+struct 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;
+struct 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;
 	}
 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 (&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 (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;
+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 @ 424:11054d720c21 r21-2-20