Mercurial > hg > xemacs-beta
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; |