Mercurial > hg > xemacs-beta

comparison src/event-stream.c @ 5803:b79e1e02bf01

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Preserve extent information in the command builder code. src/ChangeLog addition: 2014-07-14 Aidan Kehoe <kehoea@parhasard.net> * event-stream.c: * event-stream.c (mark_command_builder): * event-stream.c (finalize_command_builder): Removed. * event-stream.c (allocate_command_builder): * event-stream.c (free_command_builder): Removed. Use free_normal_lisp_object() instead. * event-stream.c (echo_key_event): * event-stream.c (regenerate_echo_keys_from_this_command_keys): Detach all extents here. * event-stream.c (maybe_echo_keys): * event-stream.c (reset_key_echo): * event-stream.c (execute_help_form): * event-stream.c (Fnext_event): * event-stream.c (command_builder_find_leaf_no_jit_binding): * event-stream.c (command_builder_find_leaf): * event-stream.c (lookup_command_event): * events.h (struct command_builder): Move the command builder's echo_buf to being a Lisp string rather than a malloced Ibyte array. This allows passing through extent information, which was previously dropped. It also simplifies the allocation and release code for the command builder. Rename echo_buf_index to echo_buf_fill_pointer, better reflecting its function. Don't rely on zero-termination (something not particularly compatible with Lisp-level code) when showing a substring of echo_buf that differs from that designated by echo_buf_fill_pointer, keep a separate counter instead and use that. * minibuf.c: * minibuf.c (echo_area_append): Use the new START and END keyword arguments to #'append-message, rather than consing a new string for basically every #'next-event prompt displayed. test/ChangeLog addition: 2014-07-14 Aidan Kehoe <kehoea@parhasard.net> * automated/extent-tests.el: Check that extent information is passed through to the echo area correctly with #'next-event's PROMPT argument. lisp/ChangeLog addition: 2014-07-14 Aidan Kehoe <kehoea@parhasard.net> * simple.el (raw-append-message): Use #'write-sequence in this, take its START and END keyword arguments, so our callers don't have to cons as much. * simple.el (append-message): Pass through START and END here.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 14 Jul 2014 13:42:42 +0100
parents 0e9f791cc655
children 75435be92103
comparison
equal deleted inserted replaced
5802:236e4afc565d 5803:b79e1e02bf01
79 #include "buffer.h" 79 #include "buffer.h"
80 #include "commands.h" 80 #include "commands.h"
81 #include "device-impl.h" 81 #include "device-impl.h"
82 #include "elhash.h" 82 #include "elhash.h"
83 #include "events.h" 83 #include "events.h"
84 #include "extents.h"
84 #include "frame-impl.h" 85 #include "frame-impl.h"
85 #include "insdel.h" /* for buffer_reset_changes */ 86 #include "insdel.h" /* for buffer_reset_changes */
86 #include "keymap.h" 87 #include "keymap.h"
87 #include "lstream.h" 88 #include "lstream.h"
88 #include "macros.h" /* for defining_keyboard_macro */ 89 #include "macros.h" /* for defining_keyboard_macro */
334 { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) }, 335 { XD_LISP_OBJECT, offsetof (struct command_builder, current_events) },
335 { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) }, 336 { XD_LISP_OBJECT, offsetof (struct command_builder, most_current_event) },
336 { XD_LISP_OBJECT, offsetof (struct command_builder, last_non_munged_event) }, 337 { XD_LISP_OBJECT, offsetof (struct command_builder, last_non_munged_event) },
337 { XD_LISP_OBJECT, offsetof (struct command_builder, console) }, 338 { XD_LISP_OBJECT, offsetof (struct command_builder, console) },
338 { XD_LISP_OBJECT_ARRAY, offsetof (struct command_builder, first_mungeable_event), 2 }, 339 { XD_LISP_OBJECT_ARRAY, offsetof (struct command_builder, first_mungeable_event), 2 },
340 { XD_LISP_OBJECT, offsetof (struct command_builder, echo_buf) },
339 { XD_END } 341 { XD_END }
340 }; 342 };
341 343
342 static Lisp_Object 344 static Lisp_Object
343 mark_command_builder (Lisp_Object obj) 345 mark_command_builder (Lisp_Object obj)
346 mark_object (builder->current_events); 348 mark_object (builder->current_events);
347 mark_object (builder->most_current_event); 349 mark_object (builder->most_current_event);
348 mark_object (builder->last_non_munged_event); 350 mark_object (builder->last_non_munged_event);
349 mark_object (builder->first_mungeable_event[0]); 351 mark_object (builder->first_mungeable_event[0]);
350 mark_object (builder->first_mungeable_event[1]); 352 mark_object (builder->first_mungeable_event[1]);
353 mark_object (builder->echo_buf);
351 return builder->console; 354 return builder->console;
352 }
353
354 static void
355 finalize_command_builder (Lisp_Object obj)
356 {
357 struct command_builder *b = XCOMMAND_BUILDER (obj);
358 if (b->echo_buf)
359 {
360 xfree (b->echo_buf);
361 b->echo_buf = 0;
362 }
363 } 355 }
364 356
365 DEFINE_NODUMP_LISP_OBJECT ("command-builder", command_builder, 357 DEFINE_NODUMP_LISP_OBJECT ("command-builder", command_builder,
366 mark_command_builder, 358 mark_command_builder,
367 internal_object_printer, 359 internal_object_printer, 0, 0, 0,
368 finalize_command_builder, 0, 0,
369 command_builder_description, 360 command_builder_description,
370 struct command_builder); 361 struct command_builder);
371 362
372 static void 363 static void
373 reset_command_builder_event_chain (struct command_builder *builder) 364 reset_command_builder_event_chain (struct command_builder *builder)
387 378
388 builder->console = console; 379 builder->console = console;
389 reset_command_builder_event_chain (builder); 380 reset_command_builder_event_chain (builder);
390 if (with_echo_buf) 381 if (with_echo_buf)
391 { 382 {
392 /* #### This badly needs to be turned into a Dynarr */ 383 builder->echo_buf = make_uninit_string (300 * MAX_ICHAR_LEN);
393 builder->echo_buf_length = 300; /* #### Kludge */
394 builder->echo_buf = xnew_array (Ibyte, builder->echo_buf_length);
395 builder->echo_buf[0] = 0;
396 } 384 }
397 else 385 else
398 { 386 {
399 builder->echo_buf_length = 0; 387 builder->echo_buf = Qnil;
400 builder->echo_buf = NULL; 388 }
401 } 389 builder->echo_buf_fill_pointer = builder->echo_buf_end = -1;
402 builder->echo_buf_index = -1;
403 builder->self_insert_countdown = 0; 390 builder->self_insert_countdown = 0;
404 391
405 return builder_obj; 392 return builder_obj;
406 } 393 }
407 394
444 431
445 return wrap_command_builder (new_buildings); 432 return wrap_command_builder (new_buildings);
446 } 433 }
447 434
448 static void 435 static void
449 free_command_builder (struct command_builder *builder)
450 {
451 if (builder->echo_buf)
452 {
453 xfree (builder->echo_buf);
454 builder->echo_buf = NULL;
455 }
456 free_normal_lisp_object (wrap_command_builder (builder));
457 }
458
459 static void
460 command_builder_append_event (struct command_builder *builder, 436 command_builder_append_event (struct command_builder *builder,
461 Lisp_Object event) 437 Lisp_Object event)
462 { 438 {
463 assert (EVENTP (event)); 439 assert (EVENTP (event));
464 440
658 echo_key_event (struct command_builder *command_builder, 634 echo_key_event (struct command_builder *command_builder,
659 Lisp_Object event) 635 Lisp_Object event)
660 { 636 {
661 /* This function can GC */ 637 /* This function can GC */
662 DECLARE_EISTRING_MALLOC (buf); 638 DECLARE_EISTRING_MALLOC (buf);
663 Bytecount buf_index = command_builder->echo_buf_index; 639 Bytecount buf_fill_pointer = command_builder->echo_buf_fill_pointer;
664 Ibyte *e;
665 Bytecount len; 640 Bytecount len;
666 641
667 if (buf_index < 0) 642 if (buf_fill_pointer < 0)
668 { 643 {
669 buf_index = 0; /* We're echoing now */ 644 buf_fill_pointer = 0;
670 clear_echo_area (selected_frame (), Qnil, 0); 645 clear_echo_area (selected_frame (), Qnil, 0);
671 } 646 }
672 647
673 format_event_object (buf, event, 1); 648 format_event_object (buf, event, 1);
674 len = eilen (buf); 649 len = eilen (buf);
675 650
676 if (len + buf_index + 4 > command_builder->echo_buf_length) 651 if (NILP (command_builder->echo_buf) ||
652 (len + buf_fill_pointer + 4 > XSTRING_LENGTH (command_builder->echo_buf)))
677 { 653 {
678 eifree (buf); 654 eifree (buf);
679 return; 655 return;
680 } 656 }
681 e = command_builder->echo_buf + buf_index; 657
682 memcpy (e, eidata (buf), len); 658 eicat_ascii (buf, " - ");
683 e += len; 659
660 memcpy (XSTRING_DATA (command_builder->echo_buf) + buf_fill_pointer,
661 eidata (buf), eilen (buf));
662 init_string_ascii_begin (command_builder->echo_buf);
663 bump_string_modiff (command_builder->echo_buf);
664 sledgehammer_check_ascii_begin (command_builder->echo_buf);
665
666 command_builder->echo_buf_end = buf_fill_pointer + eilen (buf);
667 /* *Not* including the trailing " - ". */
668 command_builder->echo_buf_fill_pointer = buf_fill_pointer + len + 1;
684 eifree (buf); 669 eifree (buf);
685
686 e[0] = ' ';
687 e[1] = '-';
688 e[2] = ' ';
689 e[3] = 0;
690
691 command_builder->echo_buf_index = buf_index + len + 1;
692 } 670 }
693 671
694 static void 672 static void
695 regenerate_echo_keys_from_this_command_keys (struct command_builder * 673 regenerate_echo_keys_from_this_command_keys (struct command_builder *
696 builder) 674 builder)
697 { 675 {
698 Lisp_Object event; 676 Lisp_Object event;
699 677
700 builder->echo_buf_index = 0; 678 builder->echo_buf_fill_pointer = builder->echo_buf_end = 0;
679 if (STRINGP (builder->echo_buf))
680 {
681 detach_all_extents (builder->echo_buf);
682 }
701 683
702 EVENT_CHAIN_LOOP (event, Vthis_command_keys) 684 EVENT_CHAIN_LOOP (event, Vthis_command_keys)
703 echo_key_event (builder, event); 685 echo_key_event (builder, event);
704 } 686 }
705 687
732 if (NILP (Fsit_for (Vecho_keystrokes, Qnil))) 714 if (NILP (Fsit_for (Vecho_keystrokes, Qnil)))
733 /* input came in, so don't echo. */ 715 /* input came in, so don't echo. */
734 goto done; 716 goto done;
735 } 717 }
736 718
737 echo_area_message (f, command_builder->echo_buf, Qnil, 0, 719 echo_area_message (f, NULL, command_builder->echo_buf, 0,
738 /* not echo_buf_index. That doesn't include 720 command_builder->echo_buf_end, Qcommand);
739 the terminating " - ". */
740 strlen ((char *) command_builder->echo_buf),
741 Qcommand);
742 } 721 }
743 722
744 done: 723 done:
745 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ 724 Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */
746 unbind_to (depth); 725 unbind_to (depth);
752 { 731 {
753 /* This function can GC */ 732 /* This function can GC */
754 struct frame *f = selected_frame (); 733 struct frame *f = selected_frame ();
755 734
756 if (command_builder) 735 if (command_builder)
757 command_builder->echo_buf_index = -1; 736 {
737 command_builder->echo_buf_fill_pointer =
738 command_builder->echo_buf_end = -1;
739 }
758 740
759 if (remove_echo_area_echo) 741 if (remove_echo_area_echo)
760 clear_echo_area (f, Qcommand, 0); 742 clear_echo_area (f, Qcommand, 0);
761 } 743 }
762 744
812 Lisp_Object event) 794 Lisp_Object event)
813 { 795 {
814 /* This function can GC */ 796 /* This function can GC */
815 Lisp_Object help = Qnil; 797 Lisp_Object help = Qnil;
816 int speccount = specpdl_depth (); 798 int speccount = specpdl_depth ();
817 Bytecount buf_index = command_builder->echo_buf_index; 799 Bytecount buf_fill_pointer = command_builder->echo_buf_fill_pointer;
818 Lisp_Object echo = ((buf_index <= 0) 800 Bytecount buf_end = command_builder->echo_buf_end;
819 ? Qnil 801 Lisp_Object echo = ((buf_fill_pointer <= 0) ? Qnil
820 : make_string (command_builder->echo_buf, 802 : Fcopy_sequence (command_builder->echo_buf));
821 buf_index)); 803
822 struct gcpro gcpro1, gcpro2; 804 struct gcpro gcpro1, gcpro2;
823 GCPRO2 (echo, help); 805 GCPRO2 (echo, help);
824 806
825 record_unwind_protect (Feval, 807 record_unwind_protect (Feval,
826 list2 (Qset_window_configuration, 808 list2 (Qset_window_configuration,
854 /* Discard next key if it is a space */ 836 /* Discard next key if it is a space */
855 reset_key_echo (command_builder, 1); 837 reset_key_echo (command_builder, 1);
856 Fnext_command_event (event, Qnil); 838 Fnext_command_event (event, Qnil);
857 } 839 }
858 840
859 command_builder->echo_buf_index = buf_index; 841 command_builder->echo_buf_fill_pointer = buf_fill_pointer;
860 if (buf_index > 0) 842 command_builder->echo_buf_end = buf_end;
861 memcpy (command_builder->echo_buf, 843
862 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */ 844 if (buf_fill_pointer > 0)
845 {
846 command_builder->echo_buf = echo;
847 }
863 UNGCPRO; 848 UNGCPRO;
864 } 849 }
865 850
866 851
867 /**********************************************************************/ 852 /**********************************************************************/
2180 CHECK_LIVE_EVENT (event); 2165 CHECK_LIVE_EVENT (event);
2181 2166
2182 if (!NILP (prompt)) 2167 if (!NILP (prompt))
2183 { 2168 {
2184 Bytecount len; 2169 Bytecount len;
2170 Lisp_Object args[] = { Qnil, prompt };
2185 CHECK_STRING (prompt); 2171 CHECK_STRING (prompt);
2186 2172
2187 len = XSTRING_LENGTH (prompt); 2173 len = XSTRING_LENGTH (prompt);
2188 if (command_builder->echo_buf_length < len) 2174
2189 len = command_builder->echo_buf_length - 1; 2175 detach_all_extents (command_builder->echo_buf);
2190 memcpy (command_builder->echo_buf, XSTRING_DATA (prompt), len); 2176 if (XSTRING_LENGTH (command_builder->echo_buf) < len)
2191 command_builder->echo_buf[len] = 0; 2177 {
2192 command_builder->echo_buf_index = len; 2178 command_builder->echo_buf
2193 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)), 2179 = make_uninit_string (len + 200 * MAX_ICHAR_LEN);
2194 command_builder->echo_buf, 2180 }
2195 Qnil, 0, 2181
2196 command_builder->echo_buf_index, 2182 args[0] = command_builder->echo_buf;
2197 Qcommand); 2183 Freplace (countof (args), args);
2184 copy_string_extents (command_builder->echo_buf, prompt, 0, 0,
2185 XSTRING_LENGTH (prompt));
2186 command_builder->echo_buf_fill_pointer
2187 = command_builder->echo_buf_end = len;
2188
2189 echo_area_message (XFRAME (CONSOLE_SELECTED_FRAME (con)), NULL,
2190 command_builder->echo_buf, 0,
2191 command_builder->echo_buf_end, Qcommand);
2198 } 2192 }
2199 2193
2200 start_over_and_avoid_hosage: 2194 start_over_and_avoid_hosage:
2201 2195
2202 /* If there is something in unread-command-events, simply return it. 2196 /* If there is something in unread-command-events, simply return it.
3390 if (!NILP (result)) 3384 if (!NILP (result))
3391 { 3385 {
3392 copy_command_builder (neub, builder); 3386 copy_command_builder (neub, builder);
3393 *did_munge = 1; 3387 *did_munge = 1;
3394 } 3388 }
3395 free_command_builder (neub); 3389 free_normal_lisp_object (wrap_command_builder (neub));
3396 UNGCPRO; 3390 UNGCPRO;
3397 if (!NILP (result)) 3391 if (!NILP (result))
3398 return result; 3392 return result;
3399 } 3393 }
3400 } 3394 }
3602 make_char(tolower(this_alternative))); 3596 make_char(tolower(this_alternative)));
3603 result = command_builder_find_leaf_no_jit_binding 3597 result = command_builder_find_leaf_no_jit_binding
3604 (newb, allow_misc_user_events_p, did_munge); 3598 (newb, allow_misc_user_events_p, did_munge);
3605 } 3599 }
3606 3600
3607 free_command_builder (newb); 3601 free_normal_lisp_object (wrap_command_builder (newb));
3608 UNGCPRO; 3602 UNGCPRO;
3609 3603
3610 if (!NILP (result)) 3604 if (!NILP (result))
3611 return result; 3605 return result;
3612 } 3606 }
4072 { 4066 {
4073 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt); 4067 Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
4074 if (STRINGP (prompt)) 4068 if (STRINGP (prompt))
4075 { 4069 {
4076 /* Append keymap prompt to key echo buffer */ 4070 /* Append keymap prompt to key echo buffer */
4077 int buf_index = command_builder->echo_buf_index; 4071 int buf_fill_pointer = command_builder->echo_buf_fill_pointer;
4078 Bytecount len = XSTRING_LENGTH (prompt); 4072 Bytecount len = XSTRING_LENGTH (prompt);
4079 4073
4080 if (len + buf_index + 1 <= command_builder->echo_buf_length) 4074 if (len + buf_fill_pointer + 1
4075 <= XSTRING_LENGTH (command_builder->echo_buf))
4081 { 4076 {
4082 Ibyte *echo = command_builder->echo_buf + buf_index; 4077 memcpy (XSTRING_DATA (command_builder->echo_buf)
4083 memcpy (echo, XSTRING_DATA (prompt), len); 4078 + buf_fill_pointer,
4084 echo[len] = 0; 4079 XSTRING_DATA (prompt),
4080 len);
4081 copy_string_extents (command_builder->echo_buf, prompt,
4082 buf_fill_pointer, 0, len);
4083
4084 init_string_ascii_begin (command_builder->echo_buf);
4085 bump_string_modiff (command_builder->echo_buf);
4086 sledgehammer_check_ascii_begin (command_builder->echo_buf);
4087
4088 /* Show the keymap prompt, but don't adjust the fill
4089 pointer to reflect it. */
4090 command_builder->echo_buf_end
4091 = command_builder->echo_buf_fill_pointer + len;
4085 } 4092 }
4086 maybe_echo_keys (command_builder, 1); 4093 maybe_echo_keys (command_builder, 1);
4087 } 4094 }
4088 else 4095 else
4089 maybe_echo_keys (command_builder, 0); 4096 maybe_echo_keys (command_builder, 0);
4102 #endif 4109 #endif
4103 } 4110 }
4104 else if (!NILP (leaf)) 4111 else if (!NILP (leaf))
4105 { 4112 {
4106 if (EQ (Qcommand, echo_area_status (f)) 4113 if (EQ (Qcommand, echo_area_status (f))
4107 && command_builder->echo_buf_index > 0) 4114 && command_builder->echo_buf_fill_pointer > 0)
4108 { 4115 {
4109 /* If we had been echoing keys, echo the last one (without 4116 /* If we had been echoing keys, echo the last one (without
4110 the trailing dash) and redisplay before executing the 4117 the trailing dash) and redisplay before executing the
4111 command. */ 4118 command. */
4112 command_builder->echo_buf[command_builder->echo_buf_index] = 0; 4119 command_builder->echo_buf_end =
4120 command_builder->echo_buf_fill_pointer;
4113 maybe_echo_keys (command_builder, 1); 4121 maybe_echo_keys (command_builder, 1);
4114 Fsit_for (Qzero, Qt); 4122 Fsit_for (Qzero, Qt);
4115 } 4123 }
4116 } 4124 }
4117 RETURN_UNGCPRO (leaf); 4125 RETURN_UNGCPRO (leaf);