src/callint.c

   1 /* Call a Lisp function interactively.
   2    Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 1, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include "config.h"
  22 #include "lisp.h"
  23 #include "buffer.h"
  24 #include "commands.h"
  25 #include "keyboard.h"
  26 #include "window.h"
  27 #include "mocklisp.h"
  28
  29 extern char *index ();
  30
  31 Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus;
  32 Lisp_Object Qcall_interactively;
  33 Lisp_Object Vcommand_history;
  34
  35 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
  36
  37 /* This comment supplies the doc string for interactive,
  38    for make-docfile to see.  We cannot put this in the real DEFUN
  39    due to limits in the Unix cpp.
  40
  41 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
  42  "Specify a way of parsing arguments for interactive use of a function.\n\
  43 For example, write\n\
  44   (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
  45 to make ARG be the prefix argument when `foo' is called as a command.\n\
  46 The \"call\" to `interactive' is actually a declaration rather than a function;\n\
  47  it tells `call-interactively' how to read arguments\n\
  48  to pass to the function.\n\
  49 When actually called, `interactive' just returns nil.\n\
  50 \n\
  51 The argument of `interactive' is usually a string containing a code letter\n\
  52  followed by a prompt.  (Some code letters do not use I/O to get\n\
  53  the argument and do not need prompts.)  To prompt for multiple arguments,\n\
  54  give a code letter, its prompt, a newline, and another code letter, etc.\n\
  55  Prompts are passed to format, and may use % escapes to print the\n\
  56  arguments that have already been read.\n\
  57 If the argument is not a string, it is evaluated to get a list of\n\
  58  arguments to pass to the function.\n\
  59 Just `(interactive)' means pass no args when calling interactively.\n\
  60 \nCode letters available are:\n\
  61 a -- Function name: symbol with a function definition.\n\
  62 b -- Name of existing buffer.\n\
  63 B -- Name of buffer, possibly nonexistent.\n\
  64 c -- Character.\n\
  65 C -- Command name: symbol with interactive function definition.\n\
  66 d -- Value of point as number.  Does not do I/O.\n\
  67 D -- Directory name.\n\
  68 f -- Existing file name.\n\
  69 F -- Possibly nonexistent file name.\n\
  70 k -- Key sequence (string).\n\
  71 K -- Mouse click that invoked this command - last-command-char.\n\
  72 m -- Value of mark as number.  Does not do I/O.\n\
  73 n -- Number read using minibuffer.\n\
  74 N -- Prefix arg converted to number, or if none, do like code `n'.\n\
  75 p -- Prefix arg converted to number.  Does not do I/O.\n\
  76 P -- Prefix arg in raw form.  Does not do I/O.\n\
  77 r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.\n\
  78 s -- Any string.\n\
  79 S -- Any symbol.\n\
  80 v -- Variable name: symbol that is user-variable-p.\n\
  81 x -- Lisp expression read but not evaluated.\n\
  82 X -- Lisp expression read and evaluated.\n\
  83 In addition, if the string begins with `*'\n\
  84  then an error is signaled if the buffer is read-only.\n\
  85  This happens before reading any arguments.\n\
  86 If the string begins with `@', then the window the mouse is over is selected\n\
  87  before anything else is done.  You may use both `@' and `*';\n\
  88 they are processed in the order that they appear."
  89 */
  90
  91 /* ARGSUSED */
  92 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
  93   0 /* See immediately above */)
  94   (args)
  95      Lisp_Object args;
  96 {
  97   return Qnil;
  98 }
  99
 100 /* Quotify EXP: if EXP is constant, return it.
 101    If EXP is not constant, return (quote EXP).  */
 102 Lisp_Object
 103 quotify_arg (exp)
 104      register Lisp_Object exp;
 105 {
 106   if (XTYPE (exp) != Lisp_Int && XTYPE (exp) != Lisp_String
 107       && !NILP (exp) && !EQ (exp, Qt))
 108     return Fcons (Qquote, Fcons (exp, Qnil));
 109
 110   return exp;
 111 }
 112
 113 /* Modify EXP by quotifying each element (except the first).  */
 114 Lisp_Object
 115 quotify_args (exp)
 116      Lisp_Object exp;
 117 {
 118   register Lisp_Object tail;
 119   register struct Lisp_Cons *ptr;
 120   for (tail = exp; CONSP (tail); tail = ptr->cdr)
 121     {
 122       ptr = XCONS (tail);
 123       ptr->car = quotify_arg (ptr->car);
 124     }
 125   return exp;
 126 }
 127
 128 char *callint_argfuns[]
 129     = {"", "point", "mark", "region-beginning", "region-end"};
 130
 131 static void
 132 check_mark ()
 133 {
 134   Lisp_Object tem = Fmarker_buffer (current_buffer->mark);
 135   if (NILP (tem) || (XBUFFER (tem) != current_buffer))
 136     error ("The mark is not set now");
 137 }
 138
 139
 140 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0,
 141   "Call FUNCTION, reading args according to its interactive calling specs.\n\
 142 The function contains a specification of how to do the argument reading.\n\
 143 In the case of user-defined functions, this is specified by placing a call\n\
 144 to the function `interactive' at the top level of the function body.\n\
 145 See `interactive'.\n\
 146 \n\
 147 Optional second arg RECORD-FLAG non-nil\n\
 148 means unconditionally put this command in the command-history.\n\
 149 Otherwise, this is done only if an arg is read using the minibuffer.")
 150   (function, record)
 151      Lisp_Object function, record;
 152 {
 153   Lisp_Object *args, *visargs;
 154   unsigned char **argstrings;
 155   Lisp_Object fun;
 156   Lisp_Object funcar;
 157   Lisp_Object specs;
 158   Lisp_Object teml;
 159
 160   Lisp_Object prefix_arg;
 161   unsigned char *string;
 162   unsigned char *tem;
 163
 164   /* If varies[i] > 0, the i'th argument shouldn't just have its value
 165      in this call quoted in the command history.  It should be
 166      recorded as a call to the function named callint_argfuns[varies[i]].  */
 167   int *varies;
 168
 169   register int i, j;
 170   int count, foo;
 171   char prompt[100];
 172   char prompt1[100];
 173   char *tem1;
 174   int arg_from_tty = 0;
 175   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 176
 177   /* Save this now, since use ofminibuffer will clobber it. */
 178   prefix_arg = Vcurrent_prefix_arg;
 179
 180  retry:
 181
 182   fun = indirect_function (function);
 183
 184   specs = Qnil;
 185   string = 0;
 186
 187   /* Decode the kind of function.  Either handle it and return,
 188      or go to `lose' if not interactive, or go to `retry'
 189      to specify a different function, or set either STRING or SPECS.  */
 190
 191   if (XTYPE (fun) == Lisp_Subr)
 192     {
 193       string = (unsigned char *) XSUBR (fun)->prompt;
 194       if (!string)
 195         {
 196         lose:
 197           function = wrong_type_argument (Qcommandp, function, 0);
 198           goto retry;
 199         }
 200       if ((int) string == 1)
 201         /* Let SPECS (which is nil) be used as the args.  */
 202         string = 0;
 203     }
 204   else if (XTYPE (fun) == Lisp_Compiled)
 205     {
 206       if (XVECTOR (fun)->size <= COMPILED_INTERACTIVE)
 207         goto lose;
 208       specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
 209     }
 210   else if (!CONSP (fun))
 211     goto lose;
 212   else if (funcar = Fcar (fun), EQ (funcar, Qautoload))
 213     {
 214       GCPRO2 (function, prefix_arg);
 215       do_autoload (fun, function);
 216       UNGCPRO;
 217       goto retry;
 218     }
 219   else if (EQ (funcar, Qlambda))
 220     {
 221       specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
 222       if (NILP (specs))
 223         goto lose;
 224       specs = Fcar (Fcdr (specs));
 225     }
 226   else if (EQ (funcar, Qmocklisp))
 227     return ml_apply (fun, Qinteractive);
 228   else
 229     goto lose;
 230
 231   /* If either specs or string is set to a string, use it.  */
 232   if (XTYPE (specs) == Lisp_String)
 233     {
 234       /* Make a copy of string so that if a GC relocates specs,
 235          `string' will still be valid.  */
 236       string = (char *) alloca (XSTRING (specs)->size + 1);
 237       bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1);
 238     }
 239   else if (string == 0)
 240     {
 241       i = num_input_chars;
 242       specs = Feval (specs);
 243       if (i != num_input_chars || !NILP (record))
 244         Vcommand_history
 245           = Fcons (Fcons (function, quotify_args (Fcopy_sequence (specs))),
 246                    Vcommand_history);
 247       return apply1 (function, specs);
 248     }
 249
 250   /* Here if function specifies a string to control parsing the defaults */
 251
 252   /* Handle special starting chars `*' and `@'.  */
 253   while (1)
 254     {
 255       if (*string == '*')
 256         {
 257           string++;
 258           if (!NILP (current_buffer->read_only))
 259             Fbarf_if_buffer_read_only ();
 260         }
 261       else if (*string == '@')
 262         {
 263           string++;
 264           if (!NILP (Vmouse_window))
 265             Fselect_window (Vmouse_window);
 266         }
 267       else break;
 268     }
 269
 270   /* Count the number of arguments the interactive spec would have
 271      us give to the function.  */
 272   tem = string;
 273   for (j = 0; *tem; j++)
 274     {
 275       /* 'r' specifications ("point and mark as 2 numeric args")
 276          produce *two* arguments.  */
 277       if (*tem == 'r') j++;
 278       tem = (unsigned char *) index (tem, '\n');
 279       if (tem)
 280         tem++;
 281       else
 282         tem = (unsigned char *) "";
 283     }
 284   count = j;
 285
 286   args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
 287   visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
 288   argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
 289   varies = (int *) alloca ((count + 1) * sizeof (int));
 290
 291   for (i = 0; i < (count + 1); i++)
 292     {
 293       args[i] = Qnil;
 294       visargs[i] = Qnil;
 295       varies[i] = 0;
 296     }
 297
 298   GCPRO4 (prefix_arg, function, *args, *visargs);
 299   gcpro3.nvars = (count + 1);
 300   gcpro4.nvars = (count + 1);
 301
 302   tem = string;
 303   for (i = 1; *tem; i++)
 304     {
 305       strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
 306       prompt1[sizeof prompt1 - 1] = 0;
 307       tem1 = index (prompt1, '\n');
 308       if (tem1) *tem1 = 0;
 309       /* Fill argstrings with a vector of C strings
 310          corresponding to the Lisp strings in visargs.  */
 311       for (j = 1; j < i; j++)
 312         argstrings[j]
 313           = EQ (visargs[j], Qnil)
 314             ? (unsigned char *) ""
 315               : XSTRING (visargs[j])->data;
 316
 317       doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1);
 318
 319       switch (*tem)
 320         {
 321         case 'a':               /* Symbol defined as a function */
 322           visargs[i] = Fcompleting_read (build_string (prompt),
 323                                          Vobarray, Qfboundp, Qt, Qnil, Qnil);
 324           /* Passing args[i] directly stimulates compiler bug */
 325           teml = visargs[i];
 326           args[i] = Fintern (teml, Qnil);
 327           break;
 328
 329         case 'b':               /* Name of existing buffer */
 330           args[i] = Fcurrent_buffer ();
 331           if (EQ (selected_window, minibuf_window))
 332             args[i] = Fother_buffer (args[i]);
 333           args[i] = Fread_buffer (build_string (prompt), args[i], Qt);
 334           break;
 335
 336         case 'B':               /* Name of buffer, possibly nonexistent */
 337           args[i] = Fread_buffer (build_string (prompt),
 338                                   Fother_buffer (Fcurrent_buffer ()), Qnil);
 339           break;
 340
 341         case 'c':               /* Character */
 342           message1 (prompt);
 343           args[i] = Fread_char ();
 344           /* Passing args[i] directly stimulates compiler bug */
 345           teml = args[i];
 346           visargs[i] = Fchar_to_string (teml);
 347           break;
 348
 349         case 'C':               /* Command: symbol with interactive function */
 350           visargs[i] = Fcompleting_read (build_string (prompt),
 351                                          Vobarray, Qcommandp, Qt, Qnil, Qnil);
 352           /* Passing args[i] directly stimulates compiler bug */
 353           teml = visargs[i];
 354           args[i] = Fintern (teml, Qnil);
 355           break;
 356
 357         case 'd':               /* Value of point.  Does not do I/O.  */
 358           XFASTINT (args[i]) = point;
 359           /* visargs[i] = Qnil; */
 360           varies[i] = 1;
 361           break;
 362
 363         case 'D':               /* Directory name. */
 364           args[i] = Fread_file_name (build_string (prompt), Qnil,
 365                                      current_buffer->directory, Qlambda, Qnil);
 366           break;
 367
 368         case 'f':               /* Existing file name. */
 369           args[i] = Fread_file_name (build_string (prompt),
 370                                      Qnil, Qnil, Qlambda, Qnil);
 371           break;
 372
 373         case 'F':               /* Possibly nonexistent file name. */
 374           args[i] = Fread_file_name (build_string (prompt),
 375                                      Qnil, Qnil, Qnil, Qnil);
 376           break;
 377
 378         case 'k':               /* Key sequence (string) */
 379           args[i] = Fread_key_sequence (build_string (prompt), Qnil);
 380           teml = args[i];
 381           visargs[i] = Fkey_description (teml);
 382           break;
 383
 384         case 'K':               /* Mouse click.  */
 385           args[i] = last_command_char;
 386           if (NILP (Fmouse_click_p (args[i])))
 387             error ("%s must be bound to a mouse click.",
 388                    (XTYPE (function) == Lisp_Symbol
 389                     ? (char *) XSYMBOL (function)->name->data
 390                     : "Command"));
 391           break;
 392
 393         case 'm':               /* Value of mark.  Does not do I/O.  */
 394           check_mark ();
 395           /* visargs[i] = Qnil; */
 396           XFASTINT (args[i]) = marker_position (current_buffer->mark);
 397           varies[i] = 2;
 398           break;
 399
 400         case 'N':               /* Prefix arg, else number from minibuffer */
 401           if (!NILP (prefix_arg))
 402             goto have_prefix_arg;
 403         case 'n':               /* Read number from minibuffer.  */
 404           do
 405             args[i] = Fread_minibuffer (build_string (prompt), Qnil);
 406           while (! NUMBERP (args[i]));
 407           visargs[i] = last_minibuf_string;
 408           break;
 409
 410         case 'P':               /* Prefix arg in raw form.  Does no I/O.  */
 411         have_prefix_arg:
 412           args[i] = prefix_arg;
 413           /* visargs[i] = Qnil; */
 414           varies[i] = -1;
 415           break;
 416
 417         case 'p':               /* Prefix arg converted to number.  No I/O. */
 418           args[i] = Fprefix_numeric_value (prefix_arg);
 419           /* visargs[i] = Qnil; */
 420           varies[i] = -1;
 421           break;
 422
 423         case 'r':               /* Region, point and mark as 2 args. */
 424           check_mark ();
 425           /* visargs[i+1] = Qnil; */
 426           foo = marker_position (current_buffer->mark);
 427           /* visargs[i] = Qnil; */
 428           XFASTINT (args[i]) = point < foo ? point : foo;
 429           varies[i] = 3;
 430           XFASTINT (args[++i]) = point > foo ? point : foo;
 431           varies[i] = 4;
 432           break;
 433
 434         case 's':               /* String read via minibuffer.  */
 435           args[i] = Fread_string (build_string (prompt), Qnil);
 436           break;
 437
 438         case 'S':               /* Any symbol.  */
 439           visargs[i] = read_minibuf (Vminibuffer_local_ns_map,
 440                                      Qnil,
 441                                      build_string (prompt),
 442                                      0);
 443           /* Passing args[i] directly stimulates compiler bug */
 444           teml = visargs[i];
 445           args[i] = Fintern (teml, Qnil);
 446           break;
 447
 448         case 'v':               /* Variable name: symbol that is
 449                                    user-variable-p. */
 450           args[i] = Fread_variable (build_string (prompt));
 451           visargs[i] = last_minibuf_string;
 452           break;
 453
 454         case 'x':               /* Lisp expression read but not evaluated */
 455           args[i] = Fread_minibuffer (build_string (prompt), Qnil);
 456           visargs[i] = last_minibuf_string;
 457           break;
 458
 459         case 'X':               /* Lisp expression read and evaluated */
 460           args[i] = Feval_minibuffer (build_string (prompt), Qnil);
 461           visargs[i] = last_minibuf_string;
 462           break;
 463
 464         default:
 465           error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
 466                  *tem, *tem);
 467         }
 468
 469       if (varies[i] == 0)
 470         arg_from_tty = 1;
 471
 472       if (NILP (visargs[i]) && XTYPE (args[i]) == Lisp_String)
 473         visargs[i] = args[i];
 474
 475       tem = (unsigned char *) index (tem, '\n');
 476       if (tem) tem++;
 477       else tem = (unsigned char *) "";
 478     }
 479
 480   QUIT;
 481
 482   args[0] = function;
 483
 484   if (arg_from_tty || !NILP (record))
 485     {
 486       visargs[0] = function;
 487       for (i = 1; i < count + 1; i++)
 488         if (varies[i] > 0)
 489           visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
 490         else
 491           visargs[i] = quotify_arg (args[i]);
 492       Vcommand_history = Fcons (Flist (count + 1, visargs),
 493                                 Vcommand_history);
 494     }
 495
 496   {
 497     Lisp_Object val;
 498     int speccount = specpdl_ptr - specpdl;
 499     specbind (Qcommand_debug_status, Qnil);
 500
 501     val = Ffuncall (count + 1, args);
 502     UNGCPRO;
 503     return unbind_to (speccount, val);
 504   }
 505 }
 506
 507 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
 508   1, 1, 0,
 509   "Return numeric meaning of raw prefix argument ARG.\n\
 510 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
 511 Its numeric meaning is what you would get from `(interactive \"p\")'.")
 512   (raw)
 513      Lisp_Object raw;
 514 {
 515   Lisp_Object val;
 516
 517   /* Tag val as an integer, so the rest of the assignments
 518      may use XSETINT.  */
 519   XFASTINT (val) = 0;
 520
 521   if (NILP (raw))
 522     XFASTINT (val) = 1;
 523   else if (EQ (val, Qminus))
 524     XSETINT (val, -1);
 525   else if (CONSP (raw))
 526     XSETINT (val, XINT (XCONS (raw)->car));
 527   else if (XTYPE (raw) == Lisp_Int)
 528     val = raw;
 529   else
 530     XFASTINT (val) = 1;
 531
 532   return val;
 533 }
 534
 535 syms_of_callint ()
 536 {
 537   Qminus = intern ("-");
 538   staticpro (&Qminus);
 539
 540   Qcall_interactively = intern ("call-interactively");
 541   staticpro (&Qcall_interactively);
 542
 543   Qcommand_debug_status = intern ("command-debug-status");
 544   staticpro (&Qcommand_debug_status);
 545
 546   DEFVAR_LISP ("prefix-arg", &Vprefix_arg,
 547     "The value of the prefix argument for the next editing command.\n\
 548 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
 549 or a list whose car is a number for just one or more C-U's\n\
 550 or nil if no argument has been specified.\n\
 551 \n\
 552 You cannot examine this variable to find the argument for this command\n\
 553 since it has been set to nil by the time you can look.\n\
 554 Instead, you should use the variable `current-prefix-arg', although\n\
 555 normally commands can get this prefix argument with (interactive \"P\").");
 556   Vprefix_arg = Qnil;
 557
 558   DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
 559     "The value of the prefix argument for this editing command.\n\
 560 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
 561 or a list whose car is a number for just one or more C-U's\n\
 562 or nil if no argument has been specified.\n\
 563 This is what `(interactive \"P\")' returns.");
 564   Vcurrent_prefix_arg = Qnil;
 565
 566   DEFVAR_LISP ("command-history", &Vcommand_history,
 567     "List of recent commands that read arguments from terminal.\n\
 568 Each command is represented as a form to evaluate.");
 569   Vcommand_history = Qnil;
 570
 571   DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
 572     "Debugging status of current interactive command.\n\
 573 Bound each time `call-interactively' is called;\n\
 574 may be set by the debugger as a reminder for itself.");
 575   Vcommand_debug_status = Qnil;
 576
 577   defsubr (&Sinteractive);
 578   defsubr (&Scall_interactively);
 579   defsubr (&Sprefix_numeric_value);
 580 }