Mercurial > hg > xemacs-beta

comparison src/callint.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents b8cc9ab3f761
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
54 54
55 #if 0 /* ill-conceived */ 55 #if 0 /* ill-conceived */
56 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; 56 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
57 #endif 57 #endif
58 58
59 Lisp_Object QletX, Qsave_excursion; 59 Lisp_Object Qlet, QletX, Qsave_excursion;
60 60
61 Lisp_Object Qcurrent_prefix_arg;
62
63 Lisp_Object Quser_variable_p;
61 Lisp_Object Qread_from_minibuffer; 64 Lisp_Object Qread_from_minibuffer;
62 Lisp_Object Qread_file_name; 65 Lisp_Object Qread_file_name;
63 Lisp_Object Qread_directory_name; 66 Lisp_Object Qread_directory_name;
64 Lisp_Object Qcompleting_read; 67 Lisp_Object Qcompleting_read;
65 Lisp_Object Qread_buffer; 68 Lisp_Object Qread_buffer;
165 168
166 /* Modify EXPR by quotifying each element (except the first). */ 169 /* Modify EXPR by quotifying each element (except the first). */
167 static Lisp_Object 170 static Lisp_Object
168 quotify_args (Lisp_Object expr) 171 quotify_args (Lisp_Object expr)
169 { 172 {
170 Lisp_Object tail; 173 REGISTER Lisp_Object tail;
171 Lisp_Cons *ptr; 174 REGISTER struct Lisp_Cons *ptr;
172 for (tail = expr; CONSP (tail); tail = ptr->cdr) 175 for (tail = expr; CONSP (tail); tail = ptr->cdr)
173 { 176 {
174 ptr = XCONS (tail); 177 ptr = XCONS (tail);
175 ptr->car = Fquote_maybe (ptr->car); 178 ptr->car = Fquote_maybe (ptr->car);
176 } 179 }
191 194
192 return marker_position (current_buffer->mark); 195 return marker_position (current_buffer->mark);
193 } 196 }
194 197
195 static Lisp_Object 198 static Lisp_Object
196 callint_prompt (const Bufbyte *prompt_start, Bytecount prompt_length, 199 callint_prompt (CONST Bufbyte *prompt_start, Bytecount prompt_length,
197 const Lisp_Object *args, int nargs) 200 CONST Lisp_Object *args, int nargs)
198 { 201 {
199 Lisp_Object s = make_string (prompt_start, prompt_length); 202 Lisp_Object s = make_string (prompt_start, prompt_length);
200 struct gcpro gcpro1; 203 struct gcpro gcpro1;
201 204
202 /* Fformat no longer smashes its arg vector, so no need to copy it. */ 205 /* Fformat no longer smashes its arg vector, so no need to copy it. */
239 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS 242 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS
240 Lisp_Object enable; 243 Lisp_Object enable;
241 #endif 244 #endif
242 /* If SPECS is a string, we reset prompt_data to string_data 245 /* If SPECS is a string, we reset prompt_data to string_data
243 * (XSTRING (specs)) every time a GC might have occurred */ 246 * (XSTRING (specs)) every time a GC might have occurred */
244 const char *prompt_data = 0; 247 CONST char *prompt_data = 0;
245 int prompt_index = 0; 248 int prompt_index = 0;
246 int argcount; 249 int argcount;
247 int set_zmacs_region_stays = 0; 250 int set_zmacs_region_stays = 0;
248 int mouse_event_count = 0; 251 int mouse_event_count = 0;
249 252
423 GCPRO2 (function, specs); 426 GCPRO2 (function, specs);
424 427
425 for (;;) 428 for (;;)
426 { 429 {
427 if (STRINGP (specs)) 430 if (STRINGP (specs))
428 prompt_data = (const char *) XSTRING_DATA (specs); 431 prompt_data = (CONST char *) XSTRING_DATA (specs);
429 432
430 if (prompt_data[prompt_index] == '+') 433 if (prompt_data[prompt_index] == '+')
431 error ("`+' is not used in `interactive' for ordinary commands"); 434 error ("`+' is not used in `interactive' for ordinary commands");
432 else if (prompt_data[prompt_index] == '*') 435 else if (prompt_data[prompt_index] == '*')
433 { 436 {
484 487
485 /* Count the number of arguments the interactive spec would have 488 /* Count the number of arguments the interactive spec would have
486 us give to the function. */ 489 us give to the function. */
487 argcount = 0; 490 argcount = 0;
488 { 491 {
489 const char *tem; 492 CONST char *tem;
490 for (tem = prompt_data + prompt_index; *tem; ) 493 for (tem = prompt_data + prompt_index; *tem; )
491 { 494 {
492 /* 'r' specifications ("point and mark as 2 numeric args") 495 /* 'r' specifications ("point and mark as 2 numeric args")
493 produce *two* arguments. */ 496 produce *two* arguments. */
494 if (*tem == 'r') 497 if (*tem == 'r')
495 argcount += 2; 498 argcount += 2;
496 else 499 else
497 argcount += 1; 500 argcount += 1;
498 tem = (const char *) strchr (tem + 1, '\n'); 501 tem = (CONST char *) strchr (tem + 1, '\n');
499 if (!tem) 502 if (!tem)
500 break; 503 break;
501 tem++; 504 tem++;
502 } 505 }
503 } 506 }
563 GCPRO2 (prefix, args[-1]); 566 GCPRO2 (prefix, args[-1]);
564 gcpro2.nvars = alloca_size; 567 gcpro2.nvars = alloca_size;
565 568
566 for (argnum = 0; ; argnum++) 569 for (argnum = 0; ; argnum++)
567 { 570 {
568 const char *prompt_start = prompt_data + prompt_index + 1; 571 CONST char *prompt_start = prompt_data + prompt_index + 1;
569 const char *prompt_limit = (const char *) strchr (prompt_start, '\n'); 572 CONST char *prompt_limit = (CONST char *) strchr (prompt_start, '\n');
570 int prompt_length; 573 int prompt_length;
571 prompt_length = ((prompt_limit) 574 prompt_length = ((prompt_limit)
572 ? (prompt_limit - prompt_start) 575 ? (prompt_limit - prompt_start)
573 : strlen (prompt_start)); 576 : strlen (prompt_start));
574 if (prompt_limit && prompt_limit[1] == 0) 577 if (prompt_limit && prompt_limit[1] == 0)
578 } 581 }
579 /* This uses `visargs' instead of `args' so that global-set-key 582 /* This uses `visargs' instead of `args' so that global-set-key
580 prompts with "Set key C-x C-f to command: "instead of printing 583 prompts with "Set key C-x C-f to command: "instead of printing
581 event objects in there. 584 event objects in there.
582 */ 585 */
583 #define PROMPT() callint_prompt ((const Bufbyte *) prompt_start, prompt_length, visargs, argnum) 586 #define PROMPT() callint_prompt ((CONST Bufbyte *) prompt_start, prompt_length, visargs, argnum)
584 switch (prompt_data[prompt_index]) 587 switch (prompt_data[prompt_index])
585 { 588 {
586 case 'a': /* Symbol defined as a function */ 589 case 'a': /* Symbol defined as a function */
587 { 590 {
588 Lisp_Object tem = call1 (Qread_function, PROMPT ()); 591 Lisp_Object tem = call1 (Qread_function, PROMPT ());
907 visargs[argnum] = args[argnum]; 910 visargs[argnum] = args[argnum];
908 911
909 if (!prompt_limit) 912 if (!prompt_limit)
910 break; 913 break;
911 if (STRINGP (specs)) 914 if (STRINGP (specs))
912 prompt_data = (const char *) XSTRING_DATA (specs); 915 prompt_data = (CONST char *) XSTRING_DATA (specs);
913 prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */ 916 prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */
914 } 917 }
915 unbind_to (speccount, Qnil); 918 unbind_to (speccount, Qnil);
916 919
917 QUIT; 920 QUIT;
990 defsymbol (&Qread_non_nil_coding_system, "read-non-nil-coding-system"); 993 defsymbol (&Qread_non_nil_coding_system, "read-non-nil-coding-system");
991 #endif 994 #endif
992 defsymbol (&Qevents_to_keys, "events-to-keys"); 995 defsymbol (&Qevents_to_keys, "events-to-keys");
993 defsymbol (&Qcommand_debug_status, "command-debug-status"); 996 defsymbol (&Qcommand_debug_status, "command-debug-status");
994 defsymbol (&Qenable_recursive_minibuffers, "enable-recursive-minibuffers"); 997 defsymbol (&Qenable_recursive_minibuffers, "enable-recursive-minibuffers");
995 998 defsymbol (&Quser_variable_p, "user-variable-p");
999 defsymbol (&Qcurrent_prefix_arg, "current-prefix-arg");
1000
1001 defsymbol (&Qlet, "let");
996 defsymbol (&QletX, "let*"); 1002 defsymbol (&QletX, "let*");
997 defsymbol (&Qsave_excursion, "save-excursion"); 1003 defsymbol (&Qsave_excursion, "save-excursion");
998 #if 0 /* ill-conceived */ 1004 #if 0 /* ill-conceived */
999 defsymbol (&Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook"); 1005 defsymbol (&Qmouse_leave_buffer_hook, "mouse-leave-buffer-hook");
1000 #endif 1006 #endif