初稿: 2018-08-09 Thu 11:40
最終更新日: 2018-12-14 Fri 20:44
ホーム | 文書トップ | 目次

call-interactively
interactive引数を解釈した上でコマンドを実行する

  1: DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
  2:        doc: /* Call FUNCTION, providing args according to its interactive calling specs.
  3: Return the value FUNCTION returns.
  4: The function contains a specification of how to do the argument reading.
  5: In the case of user-defined functions, this is specified by placing a call
  6: to the function `interactive' at the top level of the function body.
  7: See `interactive'.
  8: 
  9: Optional second arg RECORD-FLAG non-nil
 10: means unconditionally put this command in the command-history.
 11: Otherwise, this is done only if an arg is read using the minibuffer.
 12: 
 13: Optional third arg KEYS, if given, specifies the sequence of events to
 14: supply, as a vector, if the command inquires which events were used to
 15: invoke it.  If KEYS is omitted or nil, the return value of
 16: `this-command-keys-vector' is used.  */)
 17:   (Lisp_Object function, Lisp_Object record_flag, Lisp_Object keys)
 18: {
 19:   /* `args' will contain the array of arguments to pass to the function.
 20:      `visargs' will contain the same list but in a nicer form, so that if we
 21:      pass it to `Fformat_message' it will be understandable to a human.  */
 22:   Lisp_Object *args, *visargs;
 23:   Lisp_Object specs;
 24:   Lisp_Object filter_specs;
 25:   Lisp_Object teml;
 26:   Lisp_Object up_event;
 27:   Lisp_Object enable;
 28:   USE_SAFE_ALLOCA;
 29:   ptrdiff_t speccount = SPECPDL_INDEX ();
 30: 
 31:   /* The index of the next element of this_command_keys to examine for
 32:      the 'e' interactive code.  */
 33:   ptrdiff_t next_event;
 34: 
 35:   Lisp_Object prefix_arg;
 36:   char *string;
 37:   const char *tem;
 38: 
 39:   /* If varies[i] > 0, the i'th argument shouldn't just have its value
 40:      in this call quoted in the command history.  It should be
 41:      recorded as a call to the function named callint_argfuns[varies[i]].  */
 42:   signed char *varies;
 43: 
 44:   ptrdiff_t i, nargs;
 45:   ptrdiff_t mark;
 46:   bool arg_from_tty = 0;
 47:   ptrdiff_t key_count;
 48:   bool record_then_fail = 0;
 49: 
 50:   Lisp_Object save_this_command, save_last_command;
 51:   Lisp_Object save_this_original_command, save_real_this_command;
 52: 
 53:   save_this_command = Vthis_command;
 54:   save_this_original_command = Vthis_original_command;
 55:   save_real_this_command = Vreal_this_command;
 56:   save_last_command = KVAR (current_kboard, Vlast_command);
 57: 
 58:   if (NILP (keys))
 59:     keys = this_command_keys, key_count = this_command_key_count;
 60:   else
 61:     {
 62:       CHECK_VECTOR (keys);
 63:       key_count = ASIZE (keys);
 64:     }
 65: 
 66:   /* Save this now, since use of minibuffer will clobber it.  */
 67:   prefix_arg = Vcurrent_prefix_arg;
 68: 
 69:   if (SYMBOLP (function))
 70:     enable = Fget (function, Qenable_recursive_minibuffers);
 71:   else
 72:     enable = Qnil;
 73: 
 74:   specs = Qnil;
 75:   string = 0;
 76:   /* The idea of FILTER_SPECS is to provide a way to
 77:      specify how to represent the arguments in command history.
 78:      The feature is not fully implemented.  */
 79:   filter_specs = Qnil;
 80: 
 81:   /* If k or K discard an up-event, save it here so it can be retrieved with
 82:      U.  */
 83:   up_event = Qnil;
 84: 
 85:   /* Set SPECS to the interactive form, or barf if not interactive.  */
 86:   {
 87:     Lisp_Object form;
 88:     form = Finteractive_form (function);
 89:     if (CONSP (form))
 90:       specs = filter_specs = Fcar (XCDR (form));
 91:     else
 92:       wrong_type_argument (Qcommandp, function);
 93:   }
 94: 
 95:   /* If SPECS is not a string, invent one.  */
 96:   if (! STRINGP (specs))
 97:     {
 98:       Lisp_Object input;
 99:       Lisp_Object funval = Findirect_function (function, Qt);
100:       uintmax_t events = num_input_events;
101:       input = specs;
102:       /* Compute the arg values using the user's expression.  */
103:       specs = Feval (specs,
104:              CONSP (funval) && EQ (Qclosure, XCAR (funval))
105:              ? CAR_SAFE (XCDR (funval)) : Qnil);
106:       if (events != num_input_events || !NILP (record_flag))
107:     {
108:       /* We should record this command on the command history.  */
109:       Lisp_Object values;
110:       Lisp_Object this_cmd;
111:       /* Make a copy of the list of values, for the command history,
112:          and turn them into things we can eval.  */
113:       values = quotify_args (Fcopy_sequence (specs));
114:       fix_command (input, values);
115:       this_cmd = Fcons (function, values);
116:       if (history_delete_duplicates)
117:         Vcommand_history = Fdelete (this_cmd, Vcommand_history);
118:       Vcommand_history = Fcons (this_cmd, Vcommand_history);
119: 
120:       /* Don't keep command history around forever.  */
121:       if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
122:         {
123:           teml = Fnthcdr (Vhistory_length, Vcommand_history);
124:           if (CONSP (teml))
125:         XSETCDR (teml, Qnil);
126:         }
127:     }
128: 
129:       Vthis_command = save_this_command;
130:       Vthis_original_command = save_this_original_command;
131:       Vreal_this_command = save_real_this_command;
132:       kset_last_command (current_kboard, save_last_command);
133: 
134:       Lisp_Object result
135:     = unbind_to (speccount, CALLN (Fapply, Qfuncall_interactively,
136:                        function, specs));
137:       SAFE_FREE ();
138:       return result;
139:     }
140: 
141:   /* SPECS is set to a string; use it as an interactive prompt.
142:      Copy it so that STRING will be valid even if a GC relocates SPECS.  */
143:   SAFE_ALLOCA_STRING (string, specs);
144: 
145:   /* Here if function specifies a string to control parsing the defaults.  */
146: 
147:   /* Set next_event to point to the first event with parameters.  */
148:   for (next_event = 0; next_event < key_count; next_event++)
149:     if (EVENT_HAS_PARAMETERS (AREF (keys, next_event)))
150:       break;
151: 
152:   /* Handle special starting chars `*' and `@'.  Also `-'.  */
153:   /* Note that `+' is reserved for user extensions.  */
154:   while (1)
155:     {
156:       if (*string == '+')
157:     error ("`+' is not used in `interactive' for ordinary commands");
158:       else if (*string == '*')
159:     {
160:       string++;
161:       if (!NILP (BVAR (current_buffer, read_only)))
162:         {
163:           if (!NILP (record_flag))
164:         {
165:           char *p = string;
166:           while (*p)
167:             {
168:               if (! (*p == 'r' || *p == 'p' || *p == 'P'
169:                  || *p == '\n'))
170:             Fbarf_if_buffer_read_only (Qnil);
171:               p++;
172:             }
173:           record_then_fail = 1;
174:         }
175:           else
176:         Fbarf_if_buffer_read_only (Qnil);
177:         }
178:     }
179:       /* Ignore this for semi-compatibility with Lucid.  */
180:       else if (*string == '-')
181:     string++;
182:       else if (*string == '@')
183:     {
184:       Lisp_Object event, w;
185: 
186:       event = (next_event < key_count
187:            ? AREF (keys, next_event)
188:            : Qnil);
189:       if (EVENT_HAS_PARAMETERS (event)
190:           && (w = XCDR (event), CONSP (w))
191:           && (w = XCAR (w), CONSP (w))
192:           && (w = XCAR (w), WINDOWP (w)))
193:         {
194:           if (MINI_WINDOW_P (XWINDOW (w))
195:           && ! (minibuf_level > 0 && EQ (w, minibuf_window)))
196:         error ("Attempt to select inactive minibuffer window");
197: 
198:           /* If the current buffer wants to clean up, let it.  */
199:               run_hook (Qmouse_leave_buffer_hook);
200: 
201:           Fselect_window (w, Qnil);
202:         }
203:       string++;
204:     }
205:       else if (*string == '^')
206:     {
207:       call0 (Qhandle_shift_selection);
208:       string++;
209:     }
210:       else break;
211:     }
212: 
213:   /* Count the number of arguments, which is two (the function itself and
214:      `funcall-interactively') plus the number of arguments the interactive spec
215:      would have us give to the function.  */
216:   tem = string;
217:   for (nargs = 2; *tem; )
218:     {
219:       /* 'r' specifications ("point and mark as 2 numeric args")
220:      produce *two* arguments.  */
221:       if (*tem == 'r')
222:     nargs += 2;
223:       else
224:     nargs++;
225:       tem = strchr (tem, '\n');
226:       if (tem)
227:     ++tem;
228:       else
229:     break;
230:     }
231: 
232:   if (MOST_POSITIVE_FIXNUM < min (PTRDIFF_MAX, SIZE_MAX) / word_size
233:       && MOST_POSITIVE_FIXNUM < nargs)
234:     memory_full (SIZE_MAX);
235: 
236:   /* Allocate them all at one go.  This wastes a bit of memory, but
237:      it's OK to trade space for speed.  */
238:   SAFE_NALLOCA (args, 3, nargs);
239:   visargs = args + nargs;
240:   varies = (signed char *) (visargs + nargs);
241: 
242:   memclear (args, nargs * (2 * word_size + 1));
243: 
244:   if (!NILP (enable))
245:     specbind (Qenable_recursive_minibuffers, Qt);
246: 
247:   tem = string;
248:   for (i = 2; *tem; i++)
249:     {
250:       visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
251:       if (strchr (SSDATA (visargs[1]), '%'))
252:     callint_message = Fformat_message (i - 1, visargs + 1);
253:       else
254:     callint_message = visargs[1];
255: 
256:       switch (*tem)
257:     {
258:     case 'a':           /* Symbol defined as a function.  */
259:       visargs[i] = Fcompleting_read (callint_message,
260:                      Vobarray, Qfboundp, Qt,
261:                      Qnil, Qnil, Qnil, Qnil);
262:       /* Passing args[i] directly stimulates compiler bug.  */
263:       teml = visargs[i];
264:       args[i] = Fintern (teml, Qnil);
265:       break;
266: 
267:     case 'b':                   /* Name of existing buffer.  */
268:       args[i] = Fcurrent_buffer ();
269:       if (EQ (selected_window, minibuf_window))
270:         args[i] = Fother_buffer (args[i], Qnil, Qnil);
271:       args[i] = Fread_buffer (callint_message, args[i], Qt, Qnil);
272:       break;
273: 
274:     case 'B':           /* Name of buffer, possibly nonexistent.  */
275:       args[i] = Fread_buffer (callint_message,
276:                   Fother_buffer (Fcurrent_buffer (), Qnil, Qnil),
277:                   Qnil, Qnil);
278:       break;
279: 
280:         case 'c':               /* Character.  */
281:       /* Prompt in `minibuffer-prompt' face.  */
282:       Fput_text_property (make_number (0),
283:                   make_number (SCHARS (callint_message)),
284:                   Qface, Qminibuffer_prompt, callint_message);
285:       args[i] = Fread_char (callint_message, Qnil, Qnil);
286:       message1_nolog (0);
287:       /* Passing args[i] directly stimulates compiler bug.  */
288:       teml = args[i];
289:       /* See bug#8479.  */
290:       if (! CHARACTERP (teml)) error ("Non-character input-event");
291:       visargs[i] = Fchar_to_string (teml);
292:       break;
293: 
294:     case 'C':         /* Command: symbol with interactive function.  */
295:       visargs[i] = Fcompleting_read (callint_message,
296:                      Vobarray, Qcommandp,
297:                      Qt, Qnil, Qnil, Qnil, Qnil);
298:       /* Passing args[i] directly stimulates compiler bug.  */
299:       teml = visargs[i];
300:       args[i] = Fintern (teml, Qnil);
301:       break;
302: 
303:     case 'd':           /* Value of point.  Does not do I/O.  */
304:       set_marker_both (point_marker, Qnil, PT, PT_BYTE);
305:       args[i] = point_marker;
306:       /* visargs[i] = Qnil; */
307:       varies[i] = 1;
308:       break;
309: 
310:     case 'D':           /* Directory name.  */
311:       args[i] = read_file_name (BVAR (current_buffer, directory), Qlambda, Qnil,
312:                     Qfile_directory_p);
313:       break;
314: 
315:     case 'f':           /* Existing file name.  */
316:       args[i] = read_file_name (Qnil, Qlambda, Qnil, Qnil);
317:       break;
318: 
319:     case 'F':           /* Possibly nonexistent file name.  */
320:       args[i] = read_file_name (Qnil, Qnil, Qnil, Qnil);
321:       break;
322: 
323:     case 'G':           /* Possibly nonexistent file name,
324:                    default to directory alone.  */
325:       args[i] = read_file_name (Qnil, Qnil, empty_unibyte_string, Qnil);
326:       break;
327: 
328:     case 'i':           /* Ignore an argument -- Does not do I/O.  */
329:       varies[i] = -1;
330:       break;
331: 
332:     case 'k':           /* Key sequence.  */
333:       {
334:         ptrdiff_t speccount1 = SPECPDL_INDEX ();
335:         specbind (Qcursor_in_echo_area, Qt);
336:         /* Prompt in `minibuffer-prompt' face.  */
337:         Fput_text_property (make_number (0),
338:                 make_number (SCHARS (callint_message)),
339:                 Qface, Qminibuffer_prompt, callint_message);
340:         args[i] = Fread_key_sequence (callint_message,
341:                       Qnil, Qnil, Qnil, Qnil);
342:         unbind_to (speccount1, Qnil);
343:         teml = args[i];
344:         visargs[i] = Fkey_description (teml, Qnil);
345: 
346:         /* If the key sequence ends with a down-event,
347:            discard the following up-event.  */
348:         teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
349:         if (CONSP (teml))
350:           teml = XCAR (teml);
351:         if (SYMBOLP (teml))
352:           {
353:         Lisp_Object tem2;
354: 
355:         teml = Fget (teml, Qevent_symbol_elements);
356:         /* Ignore first element, which is the base key.  */
357:         tem2 = Fmemq (Qdown, Fcdr (teml));
358:         if (! NILP (tem2))
359:           up_event = Fread_event (Qnil, Qnil, Qnil);
360:           }
361:       }
362:       break;
363: 
364:     case 'K':           /* Key sequence to be defined.  */
365:       {
366:         ptrdiff_t speccount1 = SPECPDL_INDEX ();
367:         specbind (Qcursor_in_echo_area, Qt);
368:         /* Prompt in `minibuffer-prompt' face.  */
369:         Fput_text_property (make_number (0),
370:                 make_number (SCHARS (callint_message)),
371:                 Qface, Qminibuffer_prompt, callint_message);
372:         args[i] = Fread_key_sequence_vector (callint_message,
373:                          Qnil, Qt, Qnil, Qnil);
374:         teml = args[i];
375:         visargs[i] = Fkey_description (teml, Qnil);
376:         unbind_to (speccount1, Qnil);
377: 
378:         /* If the key sequence ends with a down-event,
379:            discard the following up-event.  */
380:         teml = Faref (args[i], make_number (XINT (Flength (args[i])) - 1));
381:         if (CONSP (teml))
382:           teml = XCAR (teml);
383:         if (SYMBOLP (teml))
384:           {
385:         Lisp_Object tem2;
386: 
387:         teml = Fget (teml, Qevent_symbol_elements);
388:         /* Ignore first element, which is the base key.  */
389:         tem2 = Fmemq (Qdown, Fcdr (teml));
390:         if (! NILP (tem2))
391:           up_event = Fread_event (Qnil, Qnil, Qnil);
392:           }
393:       }
394:       break;
395: 
396:     case 'U':           /* Up event from last k or K.  */
397:       if (!NILP (up_event))
398:         {
399:           args[i] = Fmake_vector (make_number (1), up_event);
400:           up_event = Qnil;
401:           teml = args[i];
402:           visargs[i] = Fkey_description (teml, Qnil);
403:         }
404:       break;
405: 
406:     case 'e':           /* The invoking event.  */
407:       if (next_event >= key_count)
408:         error ("%s must be bound to an event with parameters",
409:            (SYMBOLP (function)
410:             ? SSDATA (SYMBOL_NAME (function))
411:             : "command"));
412:       args[i] = AREF (keys, next_event);
413:       next_event++;
414:       varies[i] = -1;
415: 
416:       /* Find the next parameterized event.  */
417:       while (next_event < key_count
418:          && !(EVENT_HAS_PARAMETERS (AREF (keys, next_event))))
419:         next_event++;
420: 
421:       break;
422: 
423:     case 'm':           /* Value of mark.  Does not do I/O.  */
424:       check_mark (0);
425:       /* visargs[i] = Qnil; */
426:       args[i] = BVAR (current_buffer, mark);
427:       varies[i] = 2;
428:       break;
429: 
430:     case 'M':           /* String read via minibuffer with
431:                    inheriting the current input method.  */
432:       args[i] = Fread_string (callint_message,
433:                   Qnil, Qnil, Qnil, Qt);
434:       break;
435: 
436:     case 'N':     /* Prefix arg as number, else number from minibuffer.  */
437:       if (!NILP (prefix_arg))
438:         goto have_prefix_arg;
439:     case 'n':           /* Read number from minibuffer.  */
440:       args[i] = call1 (Qread_number, callint_message);
441:       /* Passing args[i] directly stimulates compiler bug.  */
442:       teml = args[i];
443:       visargs[i] = Fnumber_to_string (teml);
444:       break;
445: 
446:     case 'P':           /* Prefix arg in raw form.  Does no I/O.  */
447:       args[i] = prefix_arg;
448:       /* visargs[i] = Qnil; */
449:       varies[i] = -1;
450:       break;
451: 
452:     case 'p':           /* Prefix arg converted to number.  No I/O.  */
453:     have_prefix_arg:
454:       args[i] = Fprefix_numeric_value (prefix_arg);
455:       /* visargs[i] = Qnil; */
456:       varies[i] = -1;
457:       break;
458: 
459:     case 'r':           /* Region, point and mark as 2 args.  */
460:       check_mark (1);
461:       set_marker_both (point_marker, Qnil, PT, PT_BYTE);
462:       /* visargs[i+1] = Qnil; */
463:       mark = marker_position (BVAR (current_buffer, mark));
464:       /* visargs[i] = Qnil; */
465:       args[i] = PT < mark ? point_marker : BVAR (current_buffer, mark);
466:       varies[i] = 3;
467:       args[++i] = PT > mark ? point_marker : BVAR (current_buffer, mark);
468:       varies[i] = 4;
469:       break;
470: 
471:     case 's':           /* String read via minibuffer without
472:                    inheriting the current input method.  */
473:       args[i] = Fread_string (callint_message,
474:                   Qnil, Qnil, Qnil, Qnil);
475:       break;
476: 
477:     case 'S':           /* Any symbol.  */
478:       visargs[i] = Fread_string (callint_message,
479:                      Qnil, Qnil, Qnil, Qnil);
480:       /* Passing args[i] directly stimulates compiler bug.  */
481:       teml = visargs[i];
482:       args[i] = Fintern (teml, Qnil);
483:       break;
484: 
485:     case 'v':           /* Variable name: symbol that is
486:                    custom-variable-p.  */
487:       args[i] = Fread_variable (callint_message, Qnil);
488:       visargs[i] = last_minibuf_string;
489:       break;
490: 
491:     case 'x':           /* Lisp expression read but not evaluated.  */
492:       args[i] = call1 (intern ("read-minibuffer"), callint_message);
493:       visargs[i] = last_minibuf_string;
494:       break;
495: 
496:     case 'X':           /* Lisp expression read and evaluated.  */
497:       args[i] = call1 (intern ("eval-minibuffer"), callint_message);
498:       visargs[i] = last_minibuf_string;
499:       break;
500: 
501:     case 'Z':           /* Coding-system symbol, or ignore the
502:                    argument if no prefix.  */
503:       if (NILP (prefix_arg))
504:         {
505:           /* args[i] = Qnil; */
506:           varies[i] = -1;
507:         }
508:       else
509:         {
510:           args[i]
511:         = Fread_non_nil_coding_system (callint_message);
512:           visargs[i] = last_minibuf_string;
513:         }
514:       break;
515: 
516:     case 'z':           /* Coding-system symbol or nil.  */
517:       args[i] = Fread_coding_system (callint_message, Qnil);
518:       visargs[i] = last_minibuf_string;
519:       break;
520: 
521:       /* We have a case for `+' so we get an error
522:          if anyone tries to define one here.  */
523:     case '+':
524:     default:
525:       error ("Invalid control letter `%c' (#o%03o, #x%04x) in interactive calling string",
526:          STRING_CHAR ((unsigned char *) tem),
527:          (unsigned) STRING_CHAR ((unsigned char *) tem),
528:          (unsigned) STRING_CHAR ((unsigned char *) tem));
529:     }
530: 
531:       if (varies[i] == 0)
532:     arg_from_tty = 1;
533: 
534:       if (NILP (visargs[i]) && STRINGP (args[i]))
535:     visargs[i] = args[i];
536: 
537:       tem = strchr (tem, '\n');
538:       if (tem) tem++;
539:       else tem = "";
540:     }
541:   unbind_to (speccount, Qnil);
542: 
543:   QUIT;
544: 
545:   args[0] = Qfuncall_interactively;
546:   args[1] = function;
547: 
548:   if (arg_from_tty || !NILP (record_flag))
549:     {
550:       /* We don't need `visargs' any more, so let's recycle it since we need
551:      an array of just the same size.  */
552:       visargs[1] = function;
553:       for (i = 2; i < nargs; i++)
554:     {
555:       if (varies[i] > 0)
556:         visargs[i] = list1 (intern (callint_argfuns[varies[i]]));
557:       else
558:         visargs[i] = quotify_arg (args[i]);
559:     }
560:       Vcommand_history = Fcons (Flist (nargs - 1, visargs + 1),
561:                 Vcommand_history);
562:       /* Don't keep command history around forever.  */
563:       if (INTEGERP (Vhistory_length) && XINT (Vhistory_length) > 0)
564:     {
565:       teml = Fnthcdr (Vhistory_length, Vcommand_history);
566:       if (CONSP (teml))
567:         XSETCDR (teml, Qnil);
568:     }
569:     }
570: 
571:   /* If we used a marker to hold point, mark, or an end of the region,
572:      temporarily, convert it to an integer now.  */
573:   for (i = 2; i < nargs; i++)
574:     if (varies[i] >= 1 && varies[i] <= 4)
575:       XSETINT (args[i], marker_position (args[i]));
576: 
577:   if (record_then_fail)
578:     Fbarf_if_buffer_read_only (Qnil);
579: 
580:   Vthis_command = save_this_command;
581:   Vthis_original_command = save_this_original_command;
582:   Vreal_this_command = save_real_this_command;
583:   kset_last_command (current_kboard, save_last_command);
584: 
585:   {
586:     Lisp_Object val;
587:     specbind (Qcommand_debug_status, Qnil);
588: 
589:     val = Ffuncall (nargs, args);
590:     val = unbind_to (speccount, val);
591:     SAFE_FREE ();
592:     return val;
593:   }
594: }

日付: 2018-08-09 Thu 11:40

著者: conao

Created: 2018-12-14 Fri 21:04

Validate