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