comparison src/event-stream.c @ 5140:e5380fdaf8f1

merge
author Ben Wing <ben@xemacs.org>
date Sat, 13 Mar 2010 05:38:34 -0600
parents a48ef26d87ee a9c41067dd88
children 186aebf7f6c6
comparison
equal deleted inserted replaced
5139:a48ef26d87ee 5140:e5380fdaf8f1
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, 2010 Ben Wing. 5 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2005, 2010 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
330 #define wrap_command_builder(p) wrap_record (p, command_builder) 330 #define wrap_command_builder(p) wrap_record (p, command_builder)
331 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder) 331 #define COMMAND_BUILDERP(x) RECORDP (x, command_builder)
332 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder) 332 #define CHECK_COMMAND_BUILDER(x) CHECK_RECORD (x, command_builder)
333 #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder) 333 #define CONCHECK_COMMAND_BUILDER(x) CONCHECK_RECORD (x, command_builder)
334 334
335 #ifndef NEW_GC
336 static Lisp_Object Vcommand_builder_free_list;
337 #endif /* not NEW_GC */
338
339 static const struct memory_description command_builder_description [] = { 335 static const struct memory_description command_builder_description [] = {
340 { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) }, 336 { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) },
341 { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) }, 337 { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) },
342 { XD_LISP_OBJECT, offsetof (struct command_builder, last_non_munged_event) }, 338 { XD_LISP_OBJECT, offsetof (struct command_builder, last_non_munged_event) },
343 { XD_LISP_OBJECT, offsetof (struct command_builder, console) }, 339 { XD_LISP_OBJECT, offsetof (struct command_builder, console) },
356 mark_object (builder->first_mungeable_event[1]); 352 mark_object (builder->first_mungeable_event[1]);
357 return builder->console; 353 return builder->console;
358 } 354 }
359 355
360 static void 356 static void
361 finalize_command_builder (void *header, int for_disksave) 357 finalize_command_builder (Lisp_Object obj)
362 { 358 {
363 if (!for_disksave) 359 struct command_builder *b = XCOMMAND_BUILDER (obj);
364 { 360 if (b->echo_buf)
365 struct command_builder *b = (struct command_builder *) header; 361 {
366 if (b->echo_buf) 362 xfree (b->echo_buf);
367 { 363 b->echo_buf = 0;
368 xfree (b->echo_buf); 364 }
369 b->echo_buf = 0; 365 }
370 } 366
371 } 367 DEFINE_NODUMP_LISP_OBJECT ("command-builder", command_builder,
372 } 368 mark_command_builder,
373 369 internal_object_printer,
374 DEFINE_LRECORD_IMPLEMENTATION ("command-builder", command_builder, 370 finalize_command_builder, 0, 0,
375 0, /*dumpable-flag*/ 371 command_builder_description,
376 mark_command_builder, internal_object_printer, 372 struct command_builder);
377 finalize_command_builder, 0, 0,
378 command_builder_description,
379 struct command_builder);
380 373
381 static void 374 static void
382 reset_command_builder_event_chain (struct command_builder *builder) 375 reset_command_builder_event_chain (struct command_builder *builder)
383 { 376 {
384 builder->current_events = Qnil; 377 builder->current_events = Qnil;
389 } 382 }
390 383
391 Lisp_Object 384 Lisp_Object
392 allocate_command_builder (Lisp_Object console, int with_echo_buf) 385 allocate_command_builder (Lisp_Object console, int with_echo_buf)
393 { 386 {
394 Lisp_Object builder_obj = 387 Lisp_Object builder_obj = ALLOC_NORMAL_LISP_OBJECT (command_builder);
395 #ifdef NEW_GC
396 wrap_pointer_1 (alloc_lrecord_type (struct command_builder,
397 &lrecord_command_builder));
398 #else /* not NEW_GC */
399 alloc_managed_lcrecord (Vcommand_builder_free_list);
400 #endif /* not NEW_GC */
401 struct command_builder *builder = XCOMMAND_BUILDER (builder_obj); 388 struct command_builder *builder = XCOMMAND_BUILDER (builder_obj);
402 389
403 builder->console = console; 390 builder->console = console;
404 reset_command_builder_event_chain (builder); 391 reset_command_builder_event_chain (builder);
405 if (with_echo_buf) 392 if (with_echo_buf)
466 if (builder->echo_buf) 453 if (builder->echo_buf)
467 { 454 {
468 xfree (builder->echo_buf); 455 xfree (builder->echo_buf);
469 builder->echo_buf = NULL; 456 builder->echo_buf = NULL;
470 } 457 }
471 #ifdef NEW_GC 458 free_normal_lisp_object (wrap_command_builder (builder));
472 free_lrecord (wrap_command_builder (builder));
473 #else /* not NEW_GC */
474 free_managed_lcrecord (Vcommand_builder_free_list,
475 wrap_command_builder (builder));
476 #endif /* not NEW_GC */
477 } 459 }
478 460
479 static void 461 static void
480 command_builder_append_event (struct command_builder *builder, 462 command_builder_append_event (struct command_builder *builder,
481 Lisp_Object event) 463 Lisp_Object event)
1035 used to indicate an absence of a timer. */ 1017 used to indicate an absence of a timer. */
1036 static int timeout_id_tick; 1018 static int timeout_id_tick;
1037 1019
1038 static Lisp_Object pending_timeout_list, pending_async_timeout_list; 1020 static Lisp_Object pending_timeout_list, pending_async_timeout_list;
1039 1021
1040 #ifndef NEW_GC
1041 static Lisp_Object Vtimeout_free_list;
1042 #endif /* not NEW_GC */
1043
1044 static Lisp_Object 1022 static Lisp_Object
1045 mark_timeout (Lisp_Object obj) 1023 mark_timeout (Lisp_Object obj)
1046 { 1024 {
1047 Lisp_Timeout *tm = XTIMEOUT (obj); 1025 Lisp_Timeout *tm = XTIMEOUT (obj);
1048 mark_object (tm->function); 1026 mark_object (tm->function);
1053 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) }, 1031 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, function) },
1054 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) }, 1032 { XD_LISP_OBJECT, offsetof (Lisp_Timeout, object) },
1055 { XD_END } 1033 { XD_END }
1056 }; 1034 };
1057 1035
1058 DEFINE_LRECORD_IMPLEMENTATION ("timeout", timeout, 1036 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("timeout", timeout,
1059 1, /*dumpable-flag*/ 1037 mark_timeout, timeout_description,
1060 mark_timeout, internal_object_printer, 1038 Lisp_Timeout);
1061 0, 0, 0, timeout_description, Lisp_Timeout);
1062 1039
1063 /* Generate a timeout and return its ID. */ 1040 /* Generate a timeout and return its ID. */
1064 1041
1065 int 1042 int
1066 event_stream_generate_wakeup (unsigned int milliseconds, 1043 event_stream_generate_wakeup (unsigned int milliseconds,
1067 unsigned int vanilliseconds, 1044 unsigned int vanilliseconds,
1068 Lisp_Object function, Lisp_Object object, 1045 Lisp_Object function, Lisp_Object object,
1069 int async_p) 1046 int async_p)
1070 { 1047 {
1071 #ifdef NEW_GC 1048 Lisp_Object op = ALLOC_NORMAL_LISP_OBJECT (timeout);
1072 Lisp_Object op =
1073 wrap_pointer_1 (alloc_lrecord_type (Lisp_Timeout, &lrecord_timeout));
1074 #else /* not NEW_GC */
1075 Lisp_Object op = alloc_managed_lcrecord (Vtimeout_free_list);
1076 #endif /* not NEW_GC */
1077 Lisp_Timeout *timeout = XTIMEOUT (op); 1049 Lisp_Timeout *timeout = XTIMEOUT (op);
1078 EMACS_TIME current_time; 1050 EMACS_TIME current_time;
1079 EMACS_TIME interval; 1051 EMACS_TIME interval;
1080 1052
1081 /* Don't just use ++timeout_id_tick, for the (admittedly rare) case 1053 /* Don't just use ++timeout_id_tick, for the (admittedly rare) case
1189 is to move frequently-hit timeouts to the front of the 1161 is to move frequently-hit timeouts to the front of the
1190 list, which is a good thing. */ 1162 list, which is a good thing. */
1191 *timeout_list = noseeum_cons (op, *timeout_list); 1163 *timeout_list = noseeum_cons (op, *timeout_list);
1192 } 1164 }
1193 else 1165 else
1194 #ifdef NEW_GC 1166 free_normal_lisp_object (op);
1195 free_lrecord (op);
1196 #else /* not NEW_GC */
1197 free_managed_lcrecord (Vtimeout_free_list, op);
1198 #endif /* not NEW_GC */
1199 1167
1200 UNGCPRO; 1168 UNGCPRO;
1201 return id; 1169 return id;
1202 } 1170 }
1203 1171
1230 delq_no_quit_and_free_cons (op, *timeout_list); 1198 delq_no_quit_and_free_cons (op, *timeout_list);
1231 if (async_p) 1199 if (async_p)
1232 signal_remove_async_interval_timeout (timeout->interval_id); 1200 signal_remove_async_interval_timeout (timeout->interval_id);
1233 else 1201 else
1234 event_stream_remove_timeout (timeout->interval_id); 1202 event_stream_remove_timeout (timeout->interval_id);
1235 #ifdef NEW_GC 1203 free_normal_lisp_object (op);
1236 free_lrecord (op);
1237 #else /* not NEW_GC */
1238 free_managed_lcrecord (Vtimeout_free_list, op);
1239 #endif /* not NEW_GC */
1240 } 1204 }
1241 } 1205 }
1242 1206
1243 static int 1207 static int
1244 event_stream_wakeup_pending_p (int id, int async_p) 1208 event_stream_wakeup_pending_p (int id, int async_p)
4875 /************************************************************************/ 4839 /************************************************************************/
4876 4840
4877 void 4841 void
4878 syms_of_event_stream (void) 4842 syms_of_event_stream (void)
4879 { 4843 {
4880 INIT_LRECORD_IMPLEMENTATION (command_builder); 4844 INIT_LISP_OBJECT (command_builder);
4881 INIT_LRECORD_IMPLEMENTATION (timeout); 4845 INIT_LISP_OBJECT (timeout);
4882 4846
4883 DEFSYMBOL (Qdisabled); 4847 DEFSYMBOL (Qdisabled);
4884 DEFSYMBOL (Qcommand_event_p); 4848 DEFSYMBOL (Qcommand_event_p);
4885 4849
4886 DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qsyntax_error); 4850 DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qsyntax_error);
4932 reinit_vars_of_event_stream (void) 4896 reinit_vars_of_event_stream (void)
4933 { 4897 {
4934 recent_keys_ring_index = 0; 4898 recent_keys_ring_index = 0;
4935 recent_keys_ring_size = 100; 4899 recent_keys_ring_size = 100;
4936 num_input_chars = 0; 4900 num_input_chars = 0;
4937 #ifndef NEW_GC
4938 Vtimeout_free_list = make_lcrecord_list (sizeof (Lisp_Timeout),
4939 &lrecord_timeout);
4940 staticpro_nodump (&Vtimeout_free_list);
4941 Vcommand_builder_free_list =
4942 make_lcrecord_list (sizeof (struct command_builder),
4943 &lrecord_command_builder);
4944 staticpro_nodump (&Vcommand_builder_free_list);
4945 #endif /* not NEW_GC */
4946 the_low_level_timeout_blocktype = 4901 the_low_level_timeout_blocktype =
4947 Blocktype_new (struct low_level_timeout_blocktype); 4902 Blocktype_new (struct low_level_timeout_blocktype);
4948 something_happened = 0; 4903 something_happened = 0;
4949 recursive_sit_for = 0; 4904 recursive_sit_for = 0;
4950 in_modal_loop = 0; 4905 in_modal_loop = 0;