comparison src/event-stream.c @ 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005

Checking in final CVS version of workspace 'ben-lisp-object'
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 00:20:27 -0600
parents facf3239ba30
children e0db3c197671
comparison
equal deleted inserted replaced
5116:e56f73345619 5117:3742ea8250b5
1 /* The portable interface to event streams. 1 /* The portable interface to event streams.
2 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. 2 Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois. 3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Sun Microsystems, Inc. 4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing. 5 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2005 Ben Wing.
6 6
7 This file is part of XEmacs. 7 This file is part of XEmacs.
8 8
9 XEmacs is free software; you can redistribute it and/or modify it 9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the 10 under the terms of the GNU General Public License as published by the
327 #define wrap_command_builder(p) wrap_record (p, command_builder) 327 #define wrap_command_builder(p) wrap_record (p, command_builder)
328 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder) 328 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
329 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder) 329 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
330 #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder) 330 #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder)
331 331
332 #ifndef MC_ALLOC
333 static Lisp_Object Vcommand_builder_free_list;
334 #endif /* not MC_ALLOC */
335
336 static const struct memory_description command_builder_description [] = { 332 static const struct memory_description command_builder_description [] = {
337 { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) }, 333 { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) },
338 { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) }, 334 { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) },
339 { XD_LISP_OBJECT, offsetof (struct command_builder, last_non_munged_event) }, 335 { XD_LISP_OBJECT, offsetof (struct command_builder, last_non_munged_event) },
340 { XD_LISP_OBJECT, offsetof (struct command_builder, console) }, 336 { XD_LISP_OBJECT, offsetof (struct command_builder, console) },
366 b->echo_buf = 0; 362 b->echo_buf = 0;
367 } 363 }
368 } 364 }
369 } 365 }
370 366
371 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder, 367 DEFINE_NONDUMPABLE_LISP_OBJECT ("command-builder", command_builder,
372 0, /*dumpable-flag*/ 368 mark_command_builder,
373 mark_command_builder, internal_object_printer, 369 0,
374 finalize_command_builder, 0, 0, 370 finalize_command_builder, 0, 0,
375 command_builder_description, 371 command_builder_description,
376 struct command_builder); 372 struct command_builder);
377 373
378 static void 374 static void
379 reset_command_builder_event_chain (struct command_builder *builder) 375 reset_command_builder_event_chain (struct command_builder *builder)
380 { 376 {
381 builder->current_events = Qnil; 377 builder->current_events = Qnil;
386 } 382 }
387 383
388 Lisp_Object 384 Lisp_Object
389 allocate_command_builder (Lisp_Object console, int with_echo_buf) 385 allocate_command_builder (Lisp_Object console, int with_echo_buf)
390 { 386 {
391 Lisp_Object builder_obj = 387 Lisp_Object builder_obj = ALLOC_LISP_OBJECT (command_builder);
392 #ifdef MC_ALLOC
393 wrap_pointer_1 (alloc_lrecord_type (struct command_builder,
394 &lrecord_command_builder));
395 #else /* not MC_ALLOC */
396 alloc_managed_lcrecord (Vcommand_builder_free_list);
397 #endif /* not MC_ALLOC */
398 struct command_builder *builder = XCOMMAND_BUILDER (builder_obj); 388 struct command_builder *builder = XCOMMAND_BUILDER (builder_obj);
399 389
400 builder->console = console; 390 builder->console = console;
401 reset_command_builder_event_chain (builder); 391 reset_command_builder_event_chain (builder);
402 if (with_echo_buf) 392 if (with_echo_buf)
461 if (builder->echo_buf) 451 if (builder->echo_buf)
462 { 452 {
463 xfree (builder->echo_buf, Ibyte *); 453 xfree (builder->echo_buf, Ibyte *);
464 builder->echo_buf = NULL; 454 builder->echo_buf = NULL;
465 } 455 }
466 #ifdef MC_ALLOC 456 FREE_LCRECORD (wrap_command_builder (builder));
467 free_lrecord (wrap_command_builder (builder));
468 #else /* not MC_ALLOC */
469 free_managed_lcrecord (Vcommand_builder_free_list,
470 wrap_command_builder (builder));
471 #endif /* not MC_ALLOC */
472 } 457 }
473 458
474 static void 459 static void
475 command_builder_append_event (struct command_builder *builder, 460 command_builder_append_event (struct command_builder *builder,
476 Lisp_Object event) 461 Lisp_Object event)
1029 used to indicate an absence of a timer. */ 1014 used to indicate an absence of a timer. */
1030 static int timeout_id_tick; 1015 static int timeout_id_tick;
1031 1016
1032 static Lisp_Object pending_timeout_list, pending_async_timeout_list; 1017 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1033 1018
1034 #ifndef MC_ALLOC
1035 static Lisp_Object Vtimeout_free_list;
1036 #endif /* not MC_ALLOC */
1037
1038 static Lisp_Object 1019 static Lisp_Object
1039 mark_timeout (Lisp_Object obj) 1020 mark_timeout (Lisp_Object obj)
1040 { 1021 {
1041 Lisp_Timeout *tm = XTIMEOUT (obj); 1022 Lisp_Timeout *tm = XTIMEOUT (obj);
1042 mark_object (tm->function); 1023 mark_object (tm->function);
1047 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) }, 1028 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
1048 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) }, 1029 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
1049 { XD_END } 1030 { XD_END }
1050 }; 1031 };
1051 1032
1052 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout, 1033 DEFINE_INTERNAL_LISP_OBJECT ("timeout", timeout, Lisp_Timeout,
1053 1, /*dumpable-flag*/ 1034 timeout_description, mark_timeout);
1054 mark_timeout, internal_object_printer,
1055 0, 0, 0, timeout_description, Lisp_Timeout);
1056 1035
1057 /* Generate a timeout and return its ID. */ 1036 /* Generate a timeout and return its ID. */
1058 1037
1059 int 1038 int
1060 event_stream_generate_wakeup (unsigned int milliseconds, 1039 event_stream_generate_wakeup (unsigned int milliseconds,
1061 unsigned int vanilliseconds, 1040 unsigned int vanilliseconds,
1062 Lisp_Object function, Lisp_Object object, 1041 Lisp_Object function, Lisp_Object object,
1063 int async_p) 1042 int async_p)
1064 { 1043 {
1065 #ifdef MC_ALLOC 1044 Lisp_Object op = ALLOC_LISP_OBJECT (timeout);
1066 Lisp_Object op =
1067 wrap_pointer_1 (alloc_lrecord_type (Lisp_Timeout, &lrecord_timeout));
1068 #else /* not MC_ALLOC */
1069 Lisp_Object op = alloc_managed_lcrecord (Vtimeout_free_list);
1070 #endif /* not MC_ALLOC */
1071 Lisp_Timeout *timeout = XTIMEOUT (op); 1045 Lisp_Timeout *timeout = XTIMEOUT (op);
1072 EMACS_TIME current_time; 1046 EMACS_TIME current_time;
1073 EMACS_TIME interval; 1047 EMACS_TIME interval;
1074 1048
1075 /* Don't just use ++timeout_id_tick, for the (admittedly rare) case 1049 /* Don't just use ++timeout_id_tick, for the (admittedly rare) case
1183 is to move frequently-hit timeouts to the front of the 1157 is to move frequently-hit timeouts to the front of the
1184 list, which is a good thing. */ 1158 list, which is a good thing. */
1185 *timeout_list = noseeum_cons (op, *timeout_list); 1159 *timeout_list = noseeum_cons (op, *timeout_list);
1186 } 1160 }
1187 else 1161 else
1188 #ifdef MC_ALLOC 1162 FREE_LCRECORD (op);
1189 free_lrecord (op);
1190 #else /* not MC_ALLOC */
1191 free_managed_lcrecord (Vtimeout_free_list, op);
1192 #endif /* not MC_ALLOC */
1193 1163
1194 UNGCPRO; 1164 UNGCPRO;
1195 return id; 1165 return id;
1196 } 1166 }
1197 1167
1224 delq_no_quit_and_free_cons (op, *timeout_list); 1194 delq_no_quit_and_free_cons (op, *timeout_list);
1225 if (async_p) 1195 if (async_p)
1226 signal_remove_async_interval_timeout (timeout->interval_id); 1196 signal_remove_async_interval_timeout (timeout->interval_id);
1227 else 1197 else
1228 event_stream_remove_timeout (timeout->interval_id); 1198 event_stream_remove_timeout (timeout->interval_id);
1229 #ifdef MC_ALLOC 1199 FREE_LCRECORD (op);
1230 free_lrecord (op);
1231 #else /* not MC_ALLOC */
1232 free_managed_lcrecord (Vtimeout_free_list, op);
1233 #endif /* not MC_ALLOC */
1234 } 1200 }
1235 } 1201 }
1236 1202
1237 static int 1203 static int
1238 event_stream_wakeup_pending_p (int id, int async_p) 1204 event_stream_wakeup_pending_p (int id, int async_p)
4868 /************************************************************************/ 4834 /************************************************************************/
4869 4835
4870 void 4836 void
4871 syms_of_event_stream (void) 4837 syms_of_event_stream (void)
4872 { 4838 {
4873 INIT_LRECORD_IMPLEMENTATION (command_builder); 4839 INIT_LISP_OBJECT (command_builder);
4874 INIT_LRECORD_IMPLEMENTATION (timeout); 4840 INIT_LISP_OBJECT (timeout);
4875 4841
4876 DEFSYMBOL (Qdisabled); 4842 DEFSYMBOL (Qdisabled);
4877 DEFSYMBOL (Qcommand_event_p); 4843 DEFSYMBOL (Qcommand_event_p);
4878 4844
4879 DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qsyntax_error); 4845 DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qsyntax_error);
4923 reinit_vars_of_event_stream (void) 4889 reinit_vars_of_event_stream (void)
4924 { 4890 {
4925 recent_keys_ring_index = 0; 4891 recent_keys_ring_index = 0;
4926 recent_keys_ring_size = 100; 4892 recent_keys_ring_size = 100;
4927 num_input_chars = 0; 4893 num_input_chars = 0;
4928 #ifndef MC_ALLOC
4929 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
4930 &lrecord_timeout);
4931 staticpro_nodump (&Vtimeout_free_list);
4932 Vcommand_builder_free_list =
4933 make_lcrecord_list (sizeof (struct command_builder),
4934 &lrecord_command_builder);
4935 staticpro_nodump (&Vcommand_builder_free_list);
4936 #endif /* not MC_ALLOC */
4937 the_low_level_timeout_blocktype = 4894 the_low_level_timeout_blocktype =
4938 Blocktype_new (struct low_level_timeout_blocktype); 4895 Blocktype_new (struct low_level_timeout_blocktype);
4939 something_happened = 0; 4896 something_happened = 0;
4940 recursive_sit_for = 0; 4897 recursive_sit_for = 0;
4941 in_modal_loop = 0; 4898 in_modal_loop = 0;