51 |
|
|
52 |
Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; |
Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook; |
53 |
|
|
54 |
Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion; |
Lisp_Object Qlist, Qlet, Qletx, Qsave_excursion, Qprogn, Qif, Qwhen; |
55 |
static Lisp_Object preserved_fns; |
static Lisp_Object preserved_fns; |
56 |
|
|
57 |
/* Marker used within call-interactively to refer to point. */ |
/* Marker used within call-interactively to refer to point. */ |
174 |
Fsignal (Qmark_inactive, Qnil); |
Fsignal (Qmark_inactive, Qnil); |
175 |
} |
} |
176 |
|
|
177 |
|
static void |
178 |
|
fix_command (input, values) |
179 |
|
Lisp_Object input, values; |
180 |
|
{ |
181 |
|
/* If the list of args was produced with an explicit call to `list', |
182 |
|
look for elements that were computed with (region-beginning) |
183 |
|
or (region-end), and put those expressions into VALUES |
184 |
|
instead of the present values. */ |
185 |
|
if (CONSP (input)) |
186 |
|
{ |
187 |
|
Lisp_Object car; |
188 |
|
|
189 |
|
car = XCAR (input); |
190 |
|
/* Skip through certain special forms. */ |
191 |
|
while (EQ (car, Qlet) || EQ (car, Qletx) |
192 |
|
|| EQ (car, Qsave_excursion) |
193 |
|
|| EQ (car, Qprogn)) |
194 |
|
{ |
195 |
|
while (CONSP (XCDR (input))) |
196 |
|
input = XCDR (input); |
197 |
|
input = XCAR (input); |
198 |
|
if (!CONSP (input)) |
199 |
|
break; |
200 |
|
car = XCAR (input); |
201 |
|
} |
202 |
|
if (EQ (car, Qlist)) |
203 |
|
{ |
204 |
|
Lisp_Object intail, valtail; |
205 |
|
for (intail = Fcdr (input), valtail = values; |
206 |
|
CONSP (valtail); |
207 |
|
intail = Fcdr (intail), valtail = Fcdr (valtail)) |
208 |
|
{ |
209 |
|
Lisp_Object elt; |
210 |
|
elt = Fcar (intail); |
211 |
|
if (CONSP (elt)) |
212 |
|
{ |
213 |
|
Lisp_Object presflag, carelt; |
214 |
|
carelt = Fcar (elt); |
215 |
|
/* If it is (if X Y), look at Y. */ |
216 |
|
if (EQ (carelt, Qif) |
217 |
|
&& EQ (Fnthcdr (make_number (3), elt), Qnil)) |
218 |
|
elt = Fnth (make_number (2), elt); |
219 |
|
/* If it is (when ... Y), look at Y. */ |
220 |
|
else if (EQ (carelt, Qwhen)) |
221 |
|
{ |
222 |
|
while (CONSP (XCDR (elt))) |
223 |
|
elt = XCDR (elt); |
224 |
|
elt = Fcar (elt); |
225 |
|
} |
226 |
|
|
227 |
|
/* If the function call we're looking at |
228 |
|
is a special preserved one, copy the |
229 |
|
whole expression for this argument. */ |
230 |
|
if (CONSP (elt)) |
231 |
|
{ |
232 |
|
presflag = Fmemq (Fcar (elt), preserved_fns); |
233 |
|
if (!NILP (presflag)) |
234 |
|
Fsetcar (valtail, Fcar (intail)); |
235 |
|
} |
236 |
|
} |
237 |
|
} |
238 |
|
} |
239 |
|
} |
240 |
|
} |
241 |
|
|
242 |
DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, |
DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, |
243 |
doc: /* Call FUNCTION, reading args according to its interactive calling specs. |
doc: /* Call FUNCTION, reading args according to its interactive calling specs. |
260 |
Lisp_Object fun; |
Lisp_Object fun; |
261 |
Lisp_Object funcar; |
Lisp_Object funcar; |
262 |
Lisp_Object specs; |
Lisp_Object specs; |
263 |
|
Lisp_Object filter_specs; |
264 |
Lisp_Object teml; |
Lisp_Object teml; |
265 |
Lisp_Object enable; |
Lisp_Object enable; |
266 |
int speccount = specpdl_ptr - specpdl; |
int speccount = SPECPDL_INDEX (); |
267 |
|
|
268 |
/* The index of the next element of this_command_keys to examine for |
/* The index of the next element of this_command_keys to examine for |
269 |
the 'e' interactive code. */ |
the 'e' interactive code. */ |
285 |
int arg_from_tty = 0; |
int arg_from_tty = 0; |
286 |
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
287 |
int key_count; |
int key_count; |
288 |
|
int record_then_fail = 0; |
289 |
|
|
290 |
if (NILP (keys)) |
if (NILP (keys)) |
291 |
keys = this_command_keys, key_count = this_command_key_count; |
keys = this_command_keys, key_count = this_command_key_count; |
309 |
|
|
310 |
specs = Qnil; |
specs = Qnil; |
311 |
string = 0; |
string = 0; |
312 |
|
/* The idea of FILTER_SPECS is to provide away to |
313 |
|
specify how to represent the arguments in command history. |
314 |
|
The feature is not fully implemented. */ |
315 |
|
filter_specs = Qnil; |
316 |
|
|
317 |
/* Decode the kind of function. Either handle it and return, |
/* Decode the kind of function. Either handle it and return, |
318 |
or go to `lose' if not interactive, or go to `retry' |
or go to `lose' if not interactive, or go to `retry' |
348 |
specs = Fassq (Qinteractive, Fcdr (XCDR (fun))); |
specs = Fassq (Qinteractive, Fcdr (XCDR (fun))); |
349 |
if (NILP (specs)) |
if (NILP (specs)) |
350 |
goto lose; |
goto lose; |
351 |
|
filter_specs = Fnth (make_number (1), specs); |
352 |
specs = Fcar (Fcdr (specs)); |
specs = Fcar (Fcdr (specs)); |
353 |
} |
} |
354 |
else |
else |
355 |
goto lose; |
goto lose; |
356 |
|
|
357 |
/* If either specs or string is set to a string, use it. */ |
/* If either SPECS or STRING is set to a string, use it. */ |
358 |
if (STRINGP (specs)) |
if (STRINGP (specs)) |
359 |
{ |
{ |
360 |
/* Make a copy of string so that if a GC relocates specs, |
/* Make a copy of string so that if a GC relocates specs, |
361 |
`string' will still be valid. */ |
`string' will still be valid. */ |
362 |
string = (unsigned char *) alloca (STRING_BYTES (XSTRING (specs)) + 1); |
string = (unsigned char *) alloca (SBYTES (specs) + 1); |
363 |
bcopy (XSTRING (specs)->data, string, |
bcopy (SDATA (specs), string, |
364 |
STRING_BYTES (XSTRING (specs)) + 1); |
SBYTES (specs) + 1); |
365 |
} |
} |
366 |
else if (string == 0) |
else if (string == 0) |
367 |
{ |
{ |
369 |
i = num_input_events; |
i = num_input_events; |
370 |
input = specs; |
input = specs; |
371 |
/* Compute the arg values using the user's expression. */ |
/* Compute the arg values using the user's expression. */ |
372 |
|
GCPRO2 (input, filter_specs); |
373 |
specs = Feval (specs); |
specs = Feval (specs); |
374 |
|
UNGCPRO; |
375 |
if (i != num_input_events || !NILP (record_flag)) |
if (i != num_input_events || !NILP (record_flag)) |
376 |
{ |
{ |
377 |
/* We should record this command on the command history. */ |
/* We should record this command on the command history. */ |
379 |
/* Make a copy of the list of values, for the command history, |
/* Make a copy of the list of values, for the command history, |
380 |
and turn them into things we can eval. */ |
and turn them into things we can eval. */ |
381 |
values = quotify_args (Fcopy_sequence (specs)); |
values = quotify_args (Fcopy_sequence (specs)); |
382 |
/* If the list of args was produced with an explicit call to `list', |
fix_command (input, values); |
|
look for elements that were computed with (region-beginning) |
|
|
or (region-end), and put those expressions into VALUES |
|
|
instead of the present values. */ |
|
|
if (CONSP (input)) |
|
|
{ |
|
|
car = XCAR (input); |
|
|
/* Skip through certain special forms. */ |
|
|
while (EQ (car, Qlet) || EQ (car, Qletx) |
|
|
|| EQ (car, Qsave_excursion)) |
|
|
{ |
|
|
while (CONSP (XCDR (input))) |
|
|
input = XCDR (input); |
|
|
input = XCAR (input); |
|
|
if (!CONSP (input)) |
|
|
break; |
|
|
car = XCAR (input); |
|
|
} |
|
|
if (EQ (car, Qlist)) |
|
|
{ |
|
|
Lisp_Object intail, valtail; |
|
|
for (intail = Fcdr (input), valtail = values; |
|
|
CONSP (valtail); |
|
|
intail = Fcdr (intail), valtail = Fcdr (valtail)) |
|
|
{ |
|
|
Lisp_Object elt; |
|
|
elt = Fcar (intail); |
|
|
if (CONSP (elt)) |
|
|
{ |
|
|
Lisp_Object presflag; |
|
|
presflag = Fmemq (Fcar (elt), preserved_fns); |
|
|
if (!NILP (presflag)) |
|
|
Fsetcar (valtail, Fcar (intail)); |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
383 |
Vcommand_history |
Vcommand_history |
384 |
= Fcons (Fcons (function, values), Vcommand_history); |
= Fcons (Fcons (function, values), Vcommand_history); |
385 |
|
|
401 |
for (next_event = 0; next_event < key_count; next_event++) |
for (next_event = 0; next_event < key_count; next_event++) |
402 |
if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event])) |
if (EVENT_HAS_PARAMETERS (XVECTOR (keys)->contents[next_event])) |
403 |
break; |
break; |
404 |
|
|
405 |
/* Handle special starting chars `*' and `@'. Also `-'. */ |
/* Handle special starting chars `*' and `@'. Also `-'. */ |
406 |
/* Note that `+' is reserved for user extensions. */ |
/* Note that `+' is reserved for user extensions. */ |
407 |
while (1) |
while (1) |
412 |
{ |
{ |
413 |
string++; |
string++; |
414 |
if (!NILP (current_buffer->read_only)) |
if (!NILP (current_buffer->read_only)) |
415 |
Fbarf_if_buffer_read_only (); |
{ |
416 |
|
if (!NILP (record_flag)) |
417 |
|
{ |
418 |
|
unsigned char *p = string; |
419 |
|
while (*p) |
420 |
|
{ |
421 |
|
if (! (*p == 'r' || *p == 'p' || *p == 'P' |
422 |
|
|| *p == '\n')) |
423 |
|
Fbarf_if_buffer_read_only (); |
424 |
|
p++; |
425 |
|
} |
426 |
|
record_then_fail = 1; |
427 |
|
} |
428 |
|
else |
429 |
|
Fbarf_if_buffer_read_only (); |
430 |
|
} |
431 |
} |
} |
432 |
/* Ignore this for semi-compatibility with Lucid. */ |
/* Ignore this for semi-compatibility with Lucid. */ |
433 |
else if (*string == '-') |
else if (*string == '-') |
436 |
{ |
{ |
437 |
Lisp_Object event; |
Lisp_Object event; |
438 |
|
|
439 |
event = XVECTOR (keys)->contents[next_event]; |
event = (next_event < key_count |
440 |
|
? XVECTOR (keys)->contents[next_event] |
441 |
|
: Qnil); |
442 |
if (EVENT_HAS_PARAMETERS (event) |
if (EVENT_HAS_PARAMETERS (event) |
443 |
&& (event = XCDR (event), CONSP (event)) |
&& (event = XCDR (event), CONSP (event)) |
444 |
&& (event = XCAR (event), CONSP (event)) |
&& (event = XCAR (event), CONSP (event)) |
507 |
argstrings[j] |
argstrings[j] |
508 |
= (EQ (visargs[j], Qnil) |
= (EQ (visargs[j], Qnil) |
509 |
? (unsigned char *) "" |
? (unsigned char *) "" |
510 |
: XSTRING (visargs[j])->data); |
: SDATA (visargs[j])); |
511 |
|
|
512 |
/* Process the format-string in prompt1, putting the output |
/* Process the format-string in prompt1, putting the output |
513 |
into callint_message. Make callint_message bigger if necessary. |
into callint_message. Make callint_message bigger if necessary. |
518 |
int nchars = doprnt (callint_message, callint_message_size, |
int nchars = doprnt (callint_message, callint_message_size, |
519 |
prompt1, (char *)0, |
prompt1, (char *)0, |
520 |
j - 1, (char **) argstrings + 1); |
j - 1, (char **) argstrings + 1); |
521 |
if (nchars < callint_message_size) |
if (nchars < callint_message_size - 1) |
522 |
break; |
break; |
523 |
callint_message_size *= 2; |
callint_message_size *= 2; |
524 |
callint_message |
callint_message |
595 |
|
|
596 |
case 'k': /* Key sequence. */ |
case 'k': /* Key sequence. */ |
597 |
{ |
{ |
598 |
int speccount1 = specpdl_ptr - specpdl; |
int speccount1 = SPECPDL_INDEX (); |
599 |
specbind (Qcursor_in_echo_area, Qt); |
specbind (Qcursor_in_echo_area, Qt); |
600 |
args[i] = Fread_key_sequence (build_string (callint_message), |
args[i] = Fread_key_sequence (build_string (callint_message), |
601 |
Qnil, Qnil, Qnil, Qnil); |
Qnil, Qnil, Qnil, Qnil); |
623 |
|
|
624 |
case 'K': /* Key sequence to be defined. */ |
case 'K': /* Key sequence to be defined. */ |
625 |
{ |
{ |
626 |
int speccount1 = specpdl_ptr - specpdl; |
int speccount1 = SPECPDL_INDEX (); |
627 |
specbind (Qcursor_in_echo_area, Qt); |
specbind (Qcursor_in_echo_area, Qt); |
628 |
args[i] = Fread_key_sequence (build_string (callint_message), |
args[i] = Fread_key_sequence (build_string (callint_message), |
629 |
Qnil, Qt, Qnil, Qnil); |
Qnil, Qt, Qnil, Qnil); |
653 |
if (next_event >= key_count) |
if (next_event >= key_count) |
654 |
error ("%s must be bound to an event with parameters", |
error ("%s must be bound to an event with parameters", |
655 |
(SYMBOLP (function) |
(SYMBOLP (function) |
656 |
? (char *) XSTRING (SYMBOL_NAME (function))->data |
? (char *) SDATA (SYMBOL_NAME (function)) |
657 |
: "command")); |
: "command")); |
658 |
args[i] = XVECTOR (keys)->contents[next_event++]; |
args[i] = XVECTOR (keys)->contents[next_event++]; |
659 |
varies[i] = -1; |
varies[i] = -1; |
698 |
tem = Fread_from_minibuffer (build_string (callint_message), |
tem = Fread_from_minibuffer (build_string (callint_message), |
699 |
Qnil, Qnil, Qnil, Qnil, Qnil, |
Qnil, Qnil, Qnil, Qnil, Qnil, |
700 |
Qnil); |
Qnil); |
701 |
if (! STRINGP (tem) || XSTRING (tem)->size == 0) |
if (! STRINGP (tem) || SCHARS (tem) == 0) |
702 |
args[i] = Qnil; |
args[i] = Qnil; |
703 |
else |
else |
704 |
args[i] = Fread (tem); |
args[i] = Fread (tem); |
770 |
args[i] = Qnil; |
args[i] = Qnil; |
771 |
varies[i] = -1; |
varies[i] = -1; |
772 |
} |
} |
773 |
else |
else |
774 |
{ |
{ |
775 |
args[i] |
args[i] |
776 |
= Fread_non_nil_coding_system (build_string (callint_message)); |
= Fread_non_nil_coding_system (build_string (callint_message)); |
834 |
if (varies[i] >= 1 && varies[i] <= 4) |
if (varies[i] >= 1 && varies[i] <= 4) |
835 |
XSETINT (args[i], marker_position (args[i])); |
XSETINT (args[i], marker_position (args[i])); |
836 |
|
|
837 |
|
if (record_then_fail) |
838 |
|
Fbarf_if_buffer_read_only (); |
839 |
|
|
840 |
single_kboard_state (); |
single_kboard_state (); |
841 |
|
|
842 |
{ |
{ |
847 |
UNGCPRO; |
UNGCPRO; |
848 |
return unbind_to (speccount, val); |
return unbind_to (speccount, val); |
849 |
} |
} |
850 |
} |
} |
851 |
|
|
852 |
DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, |
DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, |
853 |
1, 1, 0, |
1, 1, 0, |
858 |
Lisp_Object raw; |
Lisp_Object raw; |
859 |
{ |
{ |
860 |
Lisp_Object val; |
Lisp_Object val; |
861 |
|
|
862 |
if (NILP (raw)) |
if (NILP (raw)) |
863 |
XSETFASTINT (val, 1); |
XSETFASTINT (val, 1); |
864 |
else if (EQ (raw, Qminus)) |
else if (EQ (raw, Qminus)) |
889 |
staticpro (&Qlist); |
staticpro (&Qlist); |
890 |
Qlet = intern ("let"); |
Qlet = intern ("let"); |
891 |
staticpro (&Qlet); |
staticpro (&Qlet); |
892 |
|
Qif = intern ("if"); |
893 |
|
staticpro (&Qif); |
894 |
|
Qwhen = intern ("when"); |
895 |
|
staticpro (&Qwhen); |
896 |
Qletx = intern ("let*"); |
Qletx = intern ("let*"); |
897 |
staticpro (&Qletx); |
staticpro (&Qletx); |
898 |
Qsave_excursion = intern ("save-excursion"); |
Qsave_excursion = intern ("save-excursion"); |
899 |
staticpro (&Qsave_excursion); |
staticpro (&Qsave_excursion); |
900 |
|
Qprogn = intern ("progn"); |
901 |
|
staticpro (&Qprogn); |
902 |
|
|
903 |
Qminus = intern ("-"); |
Qminus = intern ("-"); |
904 |
staticpro (&Qminus); |
staticpro (&Qminus); |