Mercurial > hg > xemacs-beta

comparison src/callint.c @ 398:74fd4e045ea6 r21-2-29

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