4.3BSD - /usr/src/new/emacs/src/callint.c

   1: /* Call a Lisp function interactively.
   2:    Copyright (C) 1985 Richard M. Stallman.
   3: 
   4: This file is part of GNU Emacs.
   5: 
   6: GNU Emacs is distributed in the hope that it will be useful,
   7: but WITHOUT ANY WARRANTY.  No author or distributor
   8: accepts responsibility to anyone for the consequences of using it
   9: or for whether it serves any particular purpose or works at all,
  10: unless he says so in writing.  Refer to the GNU Emacs General Public
  11: License for full details.
  12: 
  13: Everyone is granted permission to copy, modify and redistribute
  14: GNU Emacs, but only under the conditions described in the
  15: GNU Emacs General Public License.   A copy of this license is
  16: supposed to have been given to you along with GNU Emacs so you
  17: can know your rights and responsibilities.  It should be in a
  18: file named COPYING.  Among other things, the copyright notice
  19: and this notice must be preserved on all copies.  */
  20: 
  21: 
  22: #include "config.h"
  23: #include "lisp.h"
  24: #include "buffer.h"
  25: #include "commands.h"
  26: #include "window.h"
  27: 
  28: extern struct Lisp_Vector *CurrentGlobalMap;
  29: 
  30: extern int num_input_chars;
  31: 
  32: Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus;
  33: Lisp_Object Qcall_interactively;
  34: Lisp_Object Vcommand_history;
  35: 
  36: extern Lisp_Object ml_apply ();
  37: extern Lisp_Object Fread_buffer (), Fread_key_sequence (), Fread_file_name ();
  38: 
  39: /* ARGSUSED */
  40: DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
  41:   0 /* See auxdoc.c */)
  42:   (args)
  43:      Lisp_Object args;
  44: {
  45:   return Qnil;
  46: }
  47: 
  48: /* Quotify EXP: if EXP is constant, return it.
  49:    If EXP is not constant, return (quote EXP).  */
  50: Lisp_Object
  51: quotify_arg (exp)
  52:      register Lisp_Object exp;
  53: {
  54:   if (XTYPE (exp) != Lisp_Int && XTYPE (exp) != Lisp_String
  55:       && !NULL (exp) && !EQ (exp, Qt))
  56:     return Fcons (Qquote, Fcons (exp, Qnil));
  57: 
  58:   return exp;
  59: }
  60: 
  61: /* Modify EXP by quotifying each element (except the first).  */
  62: Lisp_Object
  63: quotify_args (exp)
  64:      Lisp_Object exp;
  65: {
  66:   register Lisp_Object tail;
  67:   register struct Lisp_Cons *ptr;
  68:   for (tail = exp; LISTP (tail); tail = ptr->cdr)
  69:     {
  70:       ptr = XCONS (tail);
  71:       ptr->car = quotify_arg (ptr->car);
  72:     }
  73:   return exp;
  74: }
  75: 
  76: char *callint_argfuns[]
  77:     = {"", "point", "mark", "region-beginning", "region-end"};
  78: 
  79: #define argfuns callint_argfuns
  80: 
  81: DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0,
  82:   "Call FUNCTION, reading args from the terminal,\n\
  83: if the interactive calling specs of FUNCTION request one.\n\
  84: \n\
  85: The function contains a specification of how to do the argument reading.\n\
  86: In the case of user-defined functions, this is specified by placing a call to\n\
  87: the function  interactive  at the top level of the function body.  See  interactive.")
  88:   (function, record)
  89:      Lisp_Object function, record;
  90: {
  91:   Lisp_Object *args, *visargs;
  92:   unsigned char **argstrings;
  93:   Lisp_Object fun;
  94:   Lisp_Object funcar;
  95:   Lisp_Object specs;
  96:   Lisp_Object teml;
  97: 
  98:   Lisp_Object prefix_arg;
  99:   unsigned char *string;
 100:   unsigned char *tem;
 101:   int *varies;
 102:   register int i, j;
 103:   int count, foo;
 104:   char prompt[100];
 105:   char prompt1[100];
 106:   char *tem1;
 107:   int arg_from_tty = 0;
 108:   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 109:   extern char *index ();
 110: 
 111:   /* Save this now, since use ofminibuffer will clobber it. */
 112:   prefix_arg = Vcurrent_prefix_arg;
 113: 
 114: retry:
 115: 
 116:   fun = function;
 117:   while (XTYPE (fun) == Lisp_Symbol && !EQ (fun, Qunbound)) fun = XSYMBOL (fun)->function;
 118: 
 119:   if (XTYPE (fun) == Lisp_Subr)
 120:     {
 121:       string = (unsigned char *) XSUBR (fun)->prompt;
 122:       if (!string)
 123:     {
 124:     lose:
 125:       function = wrong_type_argument (Qcommandp, function, 0);
 126:       goto retry;
 127:     }
 128:       else if ((int) string == 1)
 129:     return Fapply (function, Qnil);
 130:     }
 131:   else if (!LISTP (fun))
 132:     goto lose;
 133:   else if (funcar = Fcar (fun), EQ (funcar, Qautoload))
 134:     {
 135:       GCPRO2 (function, prefix_arg);
 136:       do_autoload (fun, function);
 137:       UNGCPRO;
 138:       goto retry;
 139:     }
 140:   else if (EQ (funcar, Qlambda))
 141:     {
 142:       specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
 143:       if (NULL (specs))
 144:     goto lose;
 145:       specs = Fcar (Fcdr (specs));
 146:       if (XTYPE (specs) == Lisp_String)
 147:     string = XSTRING (specs)->data;
 148:       else
 149:     {
 150:       i = num_input_chars;
 151:       specs = Feval (specs);
 152:       if (i != num_input_chars || !NULL (record))
 153:         Vcommand_history
 154:           = Fcons (Fcons (function, quotify_args (Fcopy_sequence (specs))),
 155:                Vcommand_history);
 156:       return Fapply (function, specs);
 157:     }
 158:     }
 159:   else if (EQ (funcar, Qmocklisp))
 160:     return ml_apply (fun, Qinteractive);
 161:   else
 162:     goto lose;
 163: 
 164:   /* Here if function specifies a string to control parsing the defaults */
 165: 
 166:   /* First character '*' means barf if buffer read-only */
 167:   if (*string == '*')
 168:     { string++;
 169:       if (!NULL (bf_cur->read_only))
 170:     Fbarf_if_buffer_read_only ();
 171:     }
 172: 
 173:   tem = string;
 174:   for (j = 0; *tem; j++)
 175:     {
 176:       if (*tem == 'r') j++;
 177:       tem = (unsigned char *) index (tem, '\n');
 178:       if (tem) tem++;
 179:       else tem = (unsigned char *) "";
 180:     }
 181:   count = j;
 182: 
 183:   args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
 184:   visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
 185:   argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
 186:   varies = (int *) alloca ((count + 1) * sizeof (int));
 187: 
 188:   for (i = 0; i < (count + 1); i++)
 189:     {
 190:       args[i] = Qnil;
 191:       visargs[i] = Qnil;
 192:       varies[i] = 0;
 193:     }
 194: 
 195:   GCPRO4 (prefix_arg, function, *args, *visargs);
 196:   gcpro3.nvars = (count + 1);
 197:   gcpro4.nvars = (count + 1);
 198: 
 199:   tem = string;
 200:    for (i = 1; *tem; i++)
 201:     {
 202:       strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
 203:       prompt1[sizeof prompt1 - 1] = 0;
 204:       tem1 = index (prompt1, '\n');
 205:       if (tem1) *tem1 = 0;
 206:       for (j = 1; j < i; j++)
 207:     argstrings[j] = XSTRING (visargs[j])->data;
 208: 
 209:       doprnt (prompt, sizeof prompt, prompt1, argstrings + 1);
 210: 
 211:       switch (*tem)
 212:     {
 213:     case 'a':       /* Symbol defined as a function */
 214:       visargs[i] = Fcompleting_read (build_string (prompt),
 215:                      Vobarray, Qfboundp, Qt, Qnil);
 216:       /* Passing args[i] directly stimulates compiler bug */
 217:       teml = visargs[i];
 218:       args[i] = Fintern (teml, Qnil);
 219:       break;
 220: 
 221:     case 'b':           /* Name of existing buffer */
 222:       args[i] = Fcurrent_buffer ();
 223:       if (EQ (selected_window, minibuf_window))
 224:         args[i] = Fother_buffer (args[i]);
 225:       args[i] = Fread_buffer (build_string (prompt), args[i], Qt);
 226:       break;
 227: 
 228:     case 'B':       /* Name of buffer, possibly nonexistent */
 229:       args[i] = Fread_buffer (build_string (prompt),
 230:                   Fother_buffer (Fcurrent_buffer ()), Qnil);
 231:       break;
 232: 
 233:         case 'c':       /* Character */
 234:       message1 (prompt);
 235:       args[i] = Fread_char ();
 236:       /* Passing args[i] directly stimulates compiler bug */
 237:       teml = args[i];
 238:       visargs[i] = Fchar_to_string (teml);
 239:       break;
 240: 
 241:     case 'C':       /* Command: symbol with interactive function */
 242:       visargs[i] = Fcompleting_read (build_string (prompt),
 243:                      Vobarray, Qcommandp, Qt, Qnil);
 244:       /* Passing args[i] directly stimulates compiler bug */
 245:       teml = visargs[i];
 246:       args[i] = Fintern (teml, Qnil);
 247:       break;
 248: 
 249:     case 'd':       /* Value of point.  Does not do I/O.  */
 250:       XFASTINT (args[i]) = point;
 251:       visargs[i] = build_string ("point");
 252:       varies[i] = 1;
 253:       break;
 254: 
 255:     case 'D':       /* Directory name. */
 256:       args[i] = Fread_file_name (build_string (prompt), Qnil,
 257:                      bf_cur->directory, Qlambda);
 258:       break;
 259: 
 260:     case 'f':       /* Existing file name. */
 261:       args[i] = Fread_file_name (build_string (prompt),
 262:                      Qnil, Qnil, Qlambda);
 263:       break;
 264: 
 265:     case 'F':       /* Possibly nonexistent file name. */
 266:       args[i] = Fread_file_name (build_string (prompt),
 267:                      Qnil, Qnil, Qnil);
 268:       break;
 269: 
 270:     case 'k':       /* Key sequence (string) */
 271:       args[i] = Fread_key_sequence (build_string (prompt));
 272:       teml = args[i];
 273:       visargs[i] = Fkey_description (teml);
 274:       break;
 275: 
 276:     case 'm':       /* Value of mark.  Does not do I/O.  */
 277:       if (NULL (bf_cur->mark))
 278:         error ("The mark is not set now");
 279:       visargs[i] = build_string ("the mark");
 280:       XFASTINT (args[i]) = marker_position (bf_cur->mark);
 281:       varies[i] = 2;
 282:       break;
 283: 
 284:     case 'n':       /* Read number from minibuffer.  */
 285:       do
 286:         args[i] = Fread_minibuffer (build_string (prompt), Qnil);
 287:       while (XTYPE (args[i]) != Lisp_Int);
 288:       visargs[i] = last_minibuf_string;
 289:       break;
 290: 
 291:     case 'P':       /* Prefix arg in raw form.  Does no I/O.  */
 292:       args[i] = prefix_arg;
 293:       XFASTINT (visargs[i]) = (int) "";
 294:       varies[i] = -1;
 295:       break;
 296: 
 297:     case 'p':       /* Prefix arg converted to number.  No I/O. */
 298:       args[i] = Fprefix_numeric_value (prefix_arg);
 299:       XFASTINT (visargs[i]) = (int) "";
 300:       varies[i] = -1;
 301:       break;
 302: 
 303:     case 'r':       /* Region, point and mark as 2 args. */
 304:       if (NULL (bf_cur->mark))
 305:         error ("The mark is not set now");
 306:       foo = marker_position (bf_cur->mark);
 307:       visargs[i] = build_string ("point");
 308:       XFASTINT (args[i]) = point < foo ? point : foo;
 309:       varies[i] = 3;
 310:       visargs[++i] = build_string ("the mark");
 311:       XFASTINT (args[i]) = point > foo ? point : foo;
 312:       varies[i] = 4;
 313:       break;
 314: 
 315:     case 's':       /* String read via minibuffer.  */
 316:       args[i] = Fread_string (build_string (prompt), Qnil);
 317:       break;
 318: 
 319:     case 'S':       /* Any symbol.  */
 320:       visargs[i] = read_minibuf_string (Vminibuffer_local_ns_map,
 321:                         Qnil,
 322:                         build_string (prompt));
 323:       /* Passing args[i] directly stimulates compiler bug */
 324:       teml = visargs[i];
 325:       args[i] = Fintern (teml, Qnil);
 326:       break;
 327: 
 328:     case 'v':       /* Variable name: symbol that is
 329: 				   user-variable-p. */
 330:       args[i] = Fread_variable (build_string (prompt));
 331:       visargs[i] = last_minibuf_string;
 332:       break;
 333: 
 334:     case 'x':       /* Lisp expression read but not evaluated */
 335:       args[i] = Fread_minibuffer (build_string (prompt), Qnil);
 336:       visargs[i] = last_minibuf_string;
 337:       break;
 338: 
 339:     case 'X':       /* Lisp expression read and evaluated */
 340:       args[i] = Feval_minibuffer (build_string (prompt), Qnil);
 341:       visargs[i] = last_minibuf_string;
 342:       break;
 343: 
 344:     default:
 345:       error ("Invalid control letter in interactive calling string");
 346:     }
 347: 
 348:       if (varies[i] == 0)
 349:     arg_from_tty = 1;
 350: 
 351:       if (NULL (visargs[i]))
 352:     visargs[i] = args[i];
 353: 
 354:       tem = (unsigned char *) index (tem, '\n');
 355:       if (tem) tem++;
 356:       else tem = (unsigned char *) "";
 357:     }
 358: 
 359:   UNGCPRO;
 360: 
 361:   QUIT;
 362: 
 363:   args[0] = function;
 364: 
 365:   if (arg_from_tty || !NULL (record))
 366:     {
 367:       visargs[0] = function;
 368:       for (i = 1; i < count + 1; i++)
 369:     if (varies[i] > 0)
 370:       visargs[i] = Fcons (intern (argfuns[varies[i]]), Qnil);
 371:     else
 372:       visargs[i] = quotify_arg (args[i]);
 373:       Vcommand_history = Fcons (Flist (count + 1, visargs),
 374:                 Vcommand_history);
 375:     }
 376: 
 377:   return Ffuncall (count + 1, args);
 378: }
 379: 
 380: DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
 381:   1, 1, 0,
 382:   "Return numeric meaning of raw prefix argument.\n\
 383: A raw prefix argument is what you get from (interactive \"P\").")
 384:   (raw)
 385:      Lisp_Object raw;
 386: {
 387:   Lisp_Object val;
 388: 
 389:   if (NULL (raw))
 390:     XFASTINT (val) = 1;
 391:   else if (XTYPE (raw) == Lisp_Symbol)
 392:     {
 393:       XFASTINT (val) = 0;
 394:       XSETINT (val, -1);
 395:     }
 396:   else if (LISTP (raw))
 397:     val = XCONS (raw)->car;
 398:   else if (XTYPE (raw) == Lisp_Int)
 399:     val = raw;
 400:   else
 401:     XFASTINT (val) = 1;
 402: 
 403:   return val;
 404: }
 405: 
 406: syms_of_callint ()
 407: {
 408:   Qminus = intern ("-");
 409:   staticpro (&Qminus);
 410: 
 411:   Qcall_interactively = intern ("call-interactively");
 412:   staticpro (&Qcall_interactively);
 413: 
 414:   DefLispVar ("prefix-arg", &Vprefix_arg,
 415:     "The value of the prefix argument for the next editing command.\n\
 416: It may be a number, or the symbol - for just a minus sign as arg,\n\
 417: or a list whose car is a number for just one or more C-U's\n\
 418: or nil if no argument has been specified.\n\
 419: \n\
 420: You cannot examine this variable to find the argument for this command\n\
 421: since it has been set to nil by the time you can look.\n\
 422: Instead, you should use the variable current-prefix-arg, although\n\
 423: normally commands can get this prefix argument with (interactive \"P\").");
 424: 
 425:   DefLispVar ("current-prefix-arg", &Vcurrent_prefix_arg,
 426:     "The value of the prefix argument for this editing command.\n\
 427: It may be a number, or the symbol - for just a minus sign as arg,\n\
 428: or a list whose car is a number for just one or more C-U's\n\
 429: or nil if no argument has been specified.\n\
 430: This is what (interactive \"P\") returns.");
 431: 
 432:   DefLispVar ("command-history", &Vcommand_history,
 433:     "List of recent commands that read arguments from terminal.\n\
 434: Each command is represented as a form to evaluate.");
 435:   Vcommand_history = Qnil;
 436: 
 437:   defsubr (&Sinteractive);
 438:   defsubr (&Scall_interactively);
 439:   defsubr (&Sprefix_numeric_value);
 440: }

Defined functions

Defined variables

Defined macros