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