src/callint.c

   1 /* Call a Lisp function interactively.
   2    Copyright (C) 1985, 1986 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   for (fun = function;
 183        XTYPE (fun) == Lisp_Symbol && !EQ (fun, Qunbound);
 184        fun = XSYMBOL (fun)->function)
 185     ;
 186
 187   specs = Qnil;
 188   string = 0;
 189
 190   /* Decode the kind of function.  Either handle it and return,
 191      or go to `lose' if not interactive, or go to `retry'
 192      to specify a different function, or set either STRING or SPECS.  */
 193
 194   if (XTYPE (fun) == Lisp_Subr)
 195     {
 196       string = (unsigned char *) XSUBR (fun)->prompt;
 197       if (!string)
 198         {
 199         lose:
 200           function = wrong_type_argument (Qcommandp, function, 0);
 201           goto retry;
 202         }
 203       if ((int) string == 1)
 204         /* Let SPECS (which is nil) be used as the args.  */
 205         string = 0;
 206     }
 207   else if (XTYPE (fun) == Lisp_Compiled)
 208     {
 209       if (XVECTOR (fun)->size <= COMPILED_INTERACTIVE)
 210         goto lose;
 211       specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE];
 212     }
 213   else if (!CONSP (fun))
 214     goto lose;
 215   else if (funcar = Fcar (fun), EQ (funcar, Qautoload))
 216     {
 217       GCPRO2 (function, prefix_arg);
 218       do_autoload (fun, function);
 219       UNGCPRO;
 220       goto retry;
 221     }
 222   else if (EQ (funcar, Qlambda))
 223     {
 224       specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
 225       if (NILP (specs))
 226         goto lose;
 227       specs = Fcar (Fcdr (specs));
 228     }
 229   else if (EQ (funcar, Qmocklisp))
 230     return ml_apply (fun, Qinteractive);
 231   else
 232     goto lose;
 233
 234   if (XTYPE (specs) == Lisp_String)
 235     string = XSTRING (specs)->data;
 236   else if (string == 0)
 237     {
 238       i = num_input_chars;
 239       specs = Feval (specs);
 240       if (i != num_input_chars || !NILP (record))
 241         Vcommand_history
 242           = Fcons (Fcons (function, quotify_args (Fcopy_sequence (specs))),
 243                    Vcommand_history);
 244       return apply1 (function, specs);
 245     }
 246
 247   /* Here if function specifies a string to control parsing the defaults */
 248
 249   /* Handle special starting chars `*' and `@'.  */
 250   while (1)
 251     {
 252       if (*string == '*')
 253         {
 254           string++;
 255           if (!NILP (current_buffer->read_only))
 256             Fbarf_if_buffer_read_only ();
 257         }
 258       else if (*string == '@')
 259         {
 260           string++;
 261           if (!NILP (Vmouse_window))
 262             Fselect_window (Vmouse_window);
 263         }
 264       else break;
 265     }
 266
 267   /* Count the number of arguments the interactive spec would have
 268      us give to the function.  */
 269   tem = string;
 270   for (j = 0; *tem; j++)
 271     {
 272       /* 'r' specifications ("point and mark as 2 numeric args")
 273          produce *two* arguments.  */
 274       if (*tem == 'r') j++;
 275       tem = (unsigned char *) index (tem, '\n');
 276       if (tem)
 277         tem++;
 278       else
 279         tem = (unsigned char *) "";
 280     }
 281   count = j;
 282
 283   args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
 284   visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
 285   argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
 286   varies = (int *) alloca ((count + 1) * sizeof (int));
 287
 288   for (i = 0; i < (count + 1); i++)
 289     {
 290       args[i] = Qnil;
 291       visargs[i] = Qnil;
 292       varies[i] = 0;
 293     }
 294
 295   GCPRO4 (prefix_arg, function, *args, *visargs);
 296   gcpro3.nvars = (count + 1);
 297   gcpro4.nvars = (count + 1);
 298
 299   tem = string;
 300    for (i = 1; *tem; i++)
 301     {
 302       strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
 303       prompt1[sizeof prompt1 - 1] = 0;
 304       tem1 = index (prompt1, '\n');
 305       if (tem1) *tem1 = 0;
 306       /* Fill argstrings with a vector of C strings
 307          corresponding to the Lisp strings in visargs.  */
 308       for (j = 1; j < i; j++)
 309         argstrings[j]
 310           = EQ (visargs[j], Qnil)
 311             ? (unsigned char *) ""
 312             : XSTRING (visargs[j])->data;
 313
 314       doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1);
 315
 316       switch (*tem)
 317         {
 318         case 'a':               /* Symbol defined as a function */
 319           visargs[i] = Fcompleting_read (build_string (prompt),
 320                                          Vobarray, Qfboundp, Qt, Qnil, Qnil);
 321           /* Passing args[i] directly stimulates compiler bug */
 322           teml = visargs[i];
 323           args[i] = Fintern (teml, Qnil);
 324           break;
 325
 326         case 'b':               /* Name of existing buffer */
 327           args[i] = Fcurrent_buffer ();
 328           if (EQ (selected_window, minibuf_window))
 329             args[i] = Fother_buffer (args[i]);
 330           args[i] = Fread_buffer (build_string (prompt), args[i], Qt);
 331           break;
 332
 333         case 'B':               /* Name of buffer, possibly nonexistent */
 334           args[i] = Fread_buffer (build_string (prompt),
 335                                   Fother_buffer (Fcurrent_buffer ()), Qnil);
 336           break;
 337
 338         case 'c':               /* Character */
 339           message1 (prompt);
 340           args[i] = Fread_char ();
 341           /* Passing args[i] directly stimulates compiler bug */
 342           teml = args[i];
 343           visargs[i] = Fchar_to_string (teml);
 344           break;
 345
 346         case 'C':               /* Command: symbol with interactive function */
 347           visargs[i] = Fcompleting_read (build_string (prompt),
 348                                          Vobarray, Qcommandp, Qt, Qnil, Qnil);
 349           /* Passing args[i] directly stimulates compiler bug */
 350           teml = visargs[i];
 351           args[i] = Fintern (teml, Qnil);
 352           break;
 353
 354         case 'd':               /* Value of point.  Does not do I/O.  */
 355           XFASTINT (args[i]) = point;
 356           /* visargs[i] = Qnil; */
 357           varies[i] = 1;
 358           break;
 359
 360         case 'D':               /* Directory name. */
 361           args[i] = Fread_file_name (build_string (prompt), Qnil,
 362                                      current_buffer->directory, Qlambda, Qnil);
 363           break;
 364
 365         case 'f':               /* Existing file name. */
 366           args[i] = Fread_file_name (build_string (prompt),
 367                                      Qnil, Qnil, Qlambda, Qnil);
 368           break;
 369
 370         case 'F':               /* Possibly nonexistent file name. */
 371           args[i] = Fread_file_name (build_string (prompt),
 372                                      Qnil, Qnil, Qnil, Qnil);
 373           break;
 374
 375         case 'k':               /* Key sequence (string) */
 376           args[i] = Fread_key_sequence (build_string (prompt), Qnil);
 377           teml = args[i];
 378           visargs[i] = Fkey_description (teml);
 379           break;
 380
 381         case 'K':               /* Mouse click.  */
 382           args[i] = last_command_char;
 383           if (NILP (Fmouse_click_p (args[i])))
 384             error ("%s must be bound to a mouse click.",
 385                    (XTYPE (function) == Lisp_Symbol
 386                     ? (char *) XSYMBOL (function)->name->data
 387                     : "Command"));
 388           break;
 389
 390         case 'm':               /* Value of mark.  Does not do I/O.  */
 391           check_mark ();
 392           /* visargs[i] = Qnil; */
 393           XFASTINT (args[i]) = marker_position (current_buffer->mark);
 394           varies[i] = 2;
 395           break;
 396
 397         case 'N':               /* Prefix arg, else number from minibuffer */
 398           if (!NILP (prefix_arg))
 399             goto have_prefix_arg;
 400         case 'n':               /* Read number from minibuffer.  */
 401           do
 402             args[i] = Fread_minibuffer (build_string (prompt), Qnil);
 403 #ifdef LISP_FLOAT_TYPE
 404           while (XTYPE (args[i]) != Lisp_Int
 405                  && XTYPE (args[i]) != Lisp_Float);
 406 #else
 407           while (XTYPE (args[i]) != Lisp_Int);
 408 #endif
 409           visargs[i] = last_minibuf_string;
 410           break;
 411
 412         case 'P':               /* Prefix arg in raw form.  Does no I/O.  */
 413         have_prefix_arg:
 414           args[i] = prefix_arg;
 415           /* visargs[i] = Qnil; */
 416           varies[i] = -1;
 417           break;
 418
 419         case 'p':               /* Prefix arg converted to number.  No I/O. */
 420           args[i] = Fprefix_numeric_value (prefix_arg);
 421           /* visargs[i] = Qnil; */
 422           varies[i] = -1;
 423           break;
 424
 425         case 'r':               /* Region, point and mark as 2 args. */
 426           check_mark ();
 427           /* visargs[i+1] = Qnil; */
 428           foo = marker_position (current_buffer->mark);
 429           /* visargs[i] = Qnil; */
 430           XFASTINT (args[i]) = point < foo ? point : foo;
 431           varies[i] = 3;
 432           XFASTINT (args[++i]) = point > foo ? point : foo;
 433           varies[i] = 4;
 434           break;
 435
 436         case 's':               /* String read via minibuffer.  */
 437           args[i] = Fread_string (build_string (prompt), Qnil);
 438           break;
 439
 440         case 'S':               /* Any symbol.  */
 441           visargs[i] = read_minibuf (Vminibuffer_local_ns_map,
 442                                      Qnil,
 443                                      build_string (prompt),
 444                                      0);
 445           /* Passing args[i] directly stimulates compiler bug */
 446           teml = visargs[i];
 447           args[i] = Fintern (teml, Qnil);
 448           break;
 449
 450         case 'v':               /* Variable name: symbol that is
 451                                    user-variable-p. */
 452           args[i] = Fread_variable (build_string (prompt));
 453           visargs[i] = last_minibuf_string;
 454           break;
 455
 456         case 'x':               /* Lisp expression read but not evaluated */
 457           args[i] = Fread_minibuffer (build_string (prompt), Qnil);
 458           visargs[i] = last_minibuf_string;
 459           break;
 460
 461         case 'X':               /* Lisp expression read and evaluated */
 462           args[i] = Feval_minibuffer (build_string (prompt), Qnil);
 463           visargs[i] = last_minibuf_string;
 464           break;
 465
 466         default:
 467           error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
 468                  *tem, *tem);
 469         }
 470
 471       if (varies[i] == 0)
 472         arg_from_tty = 1;
 473
 474       if (NILP (visargs[i]) && XTYPE (args[i]) == Lisp_String)
 475         visargs[i] = args[i];
 476
 477       tem = (unsigned char *) index (tem, '\n');
 478       if (tem) tem++;
 479       else tem = (unsigned char *) "";
 480     }
 481
 482   QUIT;
 483
 484   args[0] = function;
 485
 486   if (arg_from_tty || !NILP (record))
 487     {
 488       visargs[0] = function;
 489       for (i = 1; i < count + 1; i++)
 490         if (varies[i] > 0)
 491           visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
 492         else
 493           visargs[i] = quotify_arg (args[i]);
 494       Vcommand_history = Fcons (Flist (count + 1, visargs),
 495                                 Vcommand_history);
 496     }
 497
 498   {
 499     Lisp_Object val;
 500     int speccount = specpdl_ptr - specpdl;
 501     specbind (Qcommand_debug_status, Qnil);
 502
 503     val = Ffuncall (count + 1, args);
 504     UNGCPRO;
 505     return unbind_to (speccount, val);
 506   }
 507 }
 508
 509 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
 510   1, 1, 0,
 511   "Return numeric meaning of raw prefix argument ARG.\n\
 512 A raw prefix argument is what you get from `(interactive \"P\")'.\n\
 513 Its numeric meaning is what you would get from `(interactive \"p\")'.")
 514   (raw)
 515      Lisp_Object raw;
 516 {
 517   Lisp_Object val;
 518
 519   /* Tag val as an integer, so the rest of the assignments
 520      may use XSETINT.  */
 521   XFASTINT (val) = 0;
 522
 523   if (NILP (raw))
 524     XFASTINT (val) = 1;
 525   else if (XTYPE (raw) == Lisp_Symbol)
 526     XSETINT (val, -1);
 527   else if (CONSP (raw))
 528     XSETINT (val, XINT (XCONS (raw)->car));
 529   else if (XTYPE (raw) == Lisp_Int)
 530     val = raw;
 531   else
 532     XFASTINT (val) = 1;
 533
 534   return val;
 535 }
 536
 537 syms_of_callint ()
 538 {
 539   Qminus = intern ("-");
 540   staticpro (&Qminus);
 541
 542   Qcall_interactively = intern ("call-interactively");
 543   staticpro (&Qcall_interactively);
 544
 545   Qcommand_debug_status = intern ("command-debug-status");
 546   staticpro (&Qcommand_debug_status);
 547
 548   DEFVAR_LISP ("prefix-arg", &Vprefix_arg,
 549     "The value of the prefix argument for the next editing command.\n\
 550 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
 551 or a list whose car is a number for just one or more C-U's\n\
 552 or nil if no argument has been specified.\n\
 553 \n\
 554 You cannot examine this variable to find the argument for this command\n\
 555 since it has been set to nil by the time you can look.\n\
 556 Instead, you should use the variable `current-prefix-arg', although\n\
 557 normally commands can get this prefix argument with (interactive \"P\").");
 558   Vprefix_arg = Qnil;
 559
 560   DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
 561     "The value of the prefix argument for this editing command.\n\
 562 It may be a number, or the symbol `-' for just a minus sign as arg,\n\
 563 or a list whose car is a number for just one or more C-U's\n\
 564 or nil if no argument has been specified.\n\
 565 This is what `(interactive \"P\")' returns.");
 566   Vcurrent_prefix_arg = Qnil;
 567
 568   DEFVAR_LISP ("command-history", &Vcommand_history,
 569     "List of recent commands that read arguments from terminal.\n\
 570 Each command is represented as a form to evaluate.");
 571   Vcommand_history = Qnil;
 572
 573   DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status,
 574     "Debugging status of current interactive command.\n\
 575 Bound each time `call-interactively' is called;\n\
 576 may be set by the debugger as a reminder for itself.");
 577   Vcommand_debug_status = Qnil;
 578
 579   defsubr (&Sinteractive);
 580   defsubr (&Scall_interactively);
 581   defsubr (&Sprefix_numeric_value);
 582 }