Return to callint.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src

Annotation of 43BSDReno/contrib/emacs-18.55/src/callint.c, revision 1.1

1.1     ! root        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 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: /* This comment supplies the doc string for interactive,
        !            40:    for make-docfile to see.  We cannot put this in the real DEFUN
        !            41:    due to limits in the Unix cpp.
        !            42: 
        !            43: DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0,
        !            44:  "Specify a way of parsing arguments for interactive use of a function.\n\
        !            45: For example, write\n\
        !            46:   (defun fun (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\
        !            47: to make arg be the prefix numeric argument when foo is called as a command.\n\
        !            48: This is actually a declaration rather than a function;\n\
        !            49:  it tells  call-interactively  how to read arguments\n\
        !            50:  to pass to the function.\n\
        !            51: When actually called,  interactive  just returns nil.\n\
        !            52: \n\
        !            53: The argument of  interactive  is usually a string containing a code letter\n\
        !            54:  followed by a prompt.  (Some code letters do not use I/O to get\n\
        !            55:  the argument and do not need prompts.)  To prompt for multiple arguments,\n\
        !            56:  give a code letter, its prompt, a newline, and another code letter, etc.\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: m -- Value of mark as number.  Does not do I/O.\n\
        !            72: n -- Number read using minibuffer.\n\
        !            73: N -- Prefix arg converted to number, or if none, do like code `n'.\n\
        !            74: p -- Prefix arg converted to number.  Does not do I/O.\n\
        !            75: P -- Prefix arg in raw form.  Does not do I/O.\n\
        !            76: r -- Region: point and mark as 2 numeric args, smallest first.  Does no I/O.\n\
        !            77: s -- Any string.\n\
        !            78: S -- Any symbol.\n\
        !            79: v -- Variable name: symbol that is user-variable-p.\n\
        !            80: x -- Lisp expression read but not evaluated.\n\
        !            81: X -- Lisp expression read and evaluated.\n\
        !            82: In addition, if the first character of the string is '*' then an error is\n\
        !            83:  signaled if the buffer is read-only.\n\
        !            84:  This happens before reading any arguments.")
        !            85: */
        !            86: 
        !            87: /* ARGSUSED */
        !            88: DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0,
        !            89:   0 /* See immediately above */)
        !            90:   (args)
        !            91:      Lisp_Object args;
        !            92: {
        !            93:   return Qnil;
        !            94: }
        !            95: 
        !            96: /* Quotify EXP: if EXP is constant, return it.
        !            97:    If EXP is not constant, return (quote EXP).  */
        !            98: Lisp_Object
        !            99: quotify_arg (exp)
        !           100:      register Lisp_Object exp;
        !           101: {
        !           102:   if (XTYPE (exp) != Lisp_Int && XTYPE (exp) != Lisp_String
        !           103:       && !NULL (exp) && !EQ (exp, Qt))
        !           104:     return Fcons (Qquote, Fcons (exp, Qnil));
        !           105: 
        !           106:   return exp;
        !           107: }
        !           108: 
        !           109: /* Modify EXP by quotifying each element (except the first).  */
        !           110: Lisp_Object
        !           111: quotify_args (exp)
        !           112:      Lisp_Object exp;
        !           113: {
        !           114:   register Lisp_Object tail;
        !           115:   register struct Lisp_Cons *ptr;
        !           116:   for (tail = exp; CONSP (tail); tail = ptr->cdr)
        !           117:     {
        !           118:       ptr = XCONS (tail);
        !           119:       ptr->car = quotify_arg (ptr->car);
        !           120:     }
        !           121:   return exp;
        !           122: }
        !           123: 
        !           124: char *callint_argfuns[]
        !           125:     = {"", "point", "mark", "region-beginning", "region-end"};
        !           126: 
        !           127: static void
        !           128: check_mark ()
        !           129: {
        !           130:   Lisp_Object tem = Fmarker_buffer (bf_cur->mark);
        !           131:   if (NULL (tem) || (XBUFFER (tem) != bf_cur))
        !           132:     error ("The mark is not set now");
        !           133: }
        !           134: 
        !           135: 
        !           136: DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0,
        !           137:   "Call FUNCTION, reading args according to its interactive calling specs.\n\
        !           138: The function contains a specification of how to do the argument reading.\n\
        !           139: In the case of user-defined functions, this is specified by placing a call\n\
        !           140: to the function `interactive' at the top level of the function body.\n\
        !           141: See `interactive'.\n\
        !           142: \n\
        !           143: Optional second arg RECORD-FLAG non-nil\n\
        !           144: means unconditionally put this command in the command-history.\n\
        !           145: Otherwise, this is done only if an arg is read using the minibuffer.")
        !           146:   (function, record)
        !           147:      Lisp_Object function, record;
        !           148: {
        !           149:   Lisp_Object *args, *visargs;
        !           150:   unsigned char **argstrings;
        !           151:   Lisp_Object fun;
        !           152:   Lisp_Object funcar;
        !           153:   Lisp_Object specs;
        !           154:   Lisp_Object teml;
        !           155: 
        !           156:   Lisp_Object prefix_arg;
        !           157:   unsigned char *string;
        !           158:   unsigned char *tem;
        !           159:   int *varies;
        !           160:   register int i, j;
        !           161:   int count, foo;
        !           162:   char prompt[100];
        !           163:   char prompt1[100];
        !           164:   char *tem1;
        !           165:   int arg_from_tty = 0;
        !           166:   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
        !           167:   extern char *index ();
        !           168: 
        !           169:   /* Save this now, since use ofminibuffer will clobber it. */
        !           170:   prefix_arg = Vcurrent_prefix_arg;
        !           171: 
        !           172: retry:
        !           173: 
        !           174:   fun = function;
        !           175:   while (XTYPE (fun) == Lisp_Symbol && !EQ (fun, Qunbound)) fun = XSYMBOL (fun)->function;
        !           176: 
        !           177:   if (XTYPE (fun) == Lisp_Subr)
        !           178:     {
        !           179:       string = (unsigned char *) XSUBR (fun)->prompt;
        !           180:       if (!string)
        !           181:        {
        !           182:        lose:
        !           183:          function = wrong_type_argument (Qcommandp, function, 0);
        !           184:          goto retry;
        !           185:        }
        !           186:       else if ((int) string == 1)
        !           187:        return call0 (function);
        !           188:     }
        !           189:   else if (!CONSP (fun))
        !           190:     goto lose;
        !           191:   else if (funcar = Fcar (fun), EQ (funcar, Qautoload))
        !           192:     {
        !           193:       GCPRO2 (function, prefix_arg);
        !           194:       do_autoload (fun, function);
        !           195:       UNGCPRO;
        !           196:       goto retry;
        !           197:     }
        !           198:   else if (EQ (funcar, Qlambda))
        !           199:     {
        !           200:       specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
        !           201:       if (NULL (specs))
        !           202:        goto lose;
        !           203:       specs = Fcar (Fcdr (specs));
        !           204:       if (XTYPE (specs) == Lisp_String)
        !           205:        string = XSTRING (specs)->data;
        !           206:       else
        !           207:        {
        !           208:          i = num_input_chars;
        !           209:          specs = Feval (specs);
        !           210:          if (i != num_input_chars || !NULL (record))
        !           211:            Vcommand_history
        !           212:              = Fcons (Fcons (function, quotify_args (Fcopy_sequence (specs))),
        !           213:                       Vcommand_history);
        !           214:          return apply1 (function, specs);
        !           215:        }
        !           216:     }
        !           217:   else if (EQ (funcar, Qmocklisp))
        !           218:     return ml_apply (fun, Qinteractive);
        !           219:   else
        !           220:     goto lose;
        !           221: 
        !           222:   /* Here if function specifies a string to control parsing the defaults */
        !           223: 
        !           224:   /* First character '*' means barf if buffer read-only */
        !           225:   if (*string == '*')
        !           226:     { string++;
        !           227:       if (!NULL (bf_cur->read_only))
        !           228:        Fbarf_if_buffer_read_only ();
        !           229:     }
        !           230: 
        !           231:   tem = string;
        !           232:   for (j = 0; *tem; j++)
        !           233:     {
        !           234:       if (*tem == 'r') j++;
        !           235:       tem = (unsigned char *) index (tem, '\n');
        !           236:       if (tem) tem++;
        !           237:       else tem = (unsigned char *) "";
        !           238:     }
        !           239:   count = j;
        !           240: 
        !           241:   args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
        !           242:   visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object));
        !           243:   argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *));
        !           244:   varies = (int *) alloca ((count + 1) * sizeof (int));
        !           245: 
        !           246:   for (i = 0; i < (count + 1); i++)
        !           247:     {
        !           248:       args[i] = Qnil;
        !           249:       visargs[i] = Qnil;
        !           250:       varies[i] = 0;
        !           251:     }
        !           252: 
        !           253:   GCPRO4 (prefix_arg, function, *args, *visargs);
        !           254:   gcpro3.nvars = (count + 1);
        !           255:   gcpro4.nvars = (count + 1);
        !           256: 
        !           257:   tem = string;
        !           258:    for (i = 1; *tem; i++)
        !           259:     {
        !           260:       strncpy (prompt1, tem + 1, sizeof prompt1 - 1);
        !           261:       prompt1[sizeof prompt1 - 1] = 0;
        !           262:       tem1 = index (prompt1, '\n');
        !           263:       if (tem1) *tem1 = 0;
        !           264:       /* Fill argstrings with a vector of C strings
        !           265:         corresponding to the Lisp strings in visargs.  */
        !           266:       for (j = 1; j < i; j++)
        !           267:        argstrings[j]
        !           268:          = EQ (visargs[j], Qnil)
        !           269:            ? (unsigned char *) ""
        !           270:            : XSTRING (visargs[j])->data;
        !           271: 
        !           272:       doprnt (prompt, sizeof prompt, prompt1, j - 1, argstrings + 1);
        !           273: 
        !           274:       switch (*tem)
        !           275:        {
        !           276:        case 'a':               /* Symbol defined as a function */
        !           277:          visargs[i] = Fcompleting_read (build_string (prompt),
        !           278:                                         Vobarray, Qfboundp, Qt, Qnil);
        !           279:          /* Passing args[i] directly stimulates compiler bug */
        !           280:          teml = visargs[i];
        !           281:          args[i] = Fintern (teml, Qnil);
        !           282:          break;
        !           283: 
        !           284:        case 'b':               /* Name of existing buffer */
        !           285:          args[i] = Fcurrent_buffer ();
        !           286:          if (EQ (selected_window, minibuf_window))
        !           287:            args[i] = Fother_buffer (args[i]);
        !           288:          args[i] = Fread_buffer (build_string (prompt), args[i], Qt);
        !           289:          break;
        !           290: 
        !           291:        case 'B':               /* Name of buffer, possibly nonexistent */
        !           292:          args[i] = Fread_buffer (build_string (prompt),
        !           293:                                  Fother_buffer (Fcurrent_buffer ()), Qnil);
        !           294:          break;
        !           295: 
        !           296:         case 'c':              /* Character */
        !           297:          message1 (prompt);
        !           298:          args[i] = Fread_char ();
        !           299:          /* Passing args[i] directly stimulates compiler bug */
        !           300:          teml = args[i];
        !           301:          visargs[i] = Fchar_to_string (teml);
        !           302:          break;
        !           303: 
        !           304:        case 'C':               /* Command: symbol with interactive function */
        !           305:          visargs[i] = Fcompleting_read (build_string (prompt),
        !           306:                                         Vobarray, Qcommandp, Qt, Qnil);
        !           307:          /* Passing args[i] directly stimulates compiler bug */
        !           308:          teml = visargs[i];
        !           309:          args[i] = Fintern (teml, Qnil);
        !           310:          break;
        !           311: 
        !           312:        case 'd':               /* Value of point.  Does not do I/O.  */
        !           313:          XFASTINT (args[i]) = point;
        !           314:          /* visargs[i] = Qnil; */
        !           315:          varies[i] = 1;
        !           316:          break;
        !           317: 
        !           318:        case 'D':               /* Directory name. */
        !           319:          args[i] = Fread_file_name (build_string (prompt), Qnil,
        !           320:                                     bf_cur->directory, Qlambda);
        !           321:          break;
        !           322: 
        !           323:        case 'f':               /* Existing file name. */
        !           324:          /* On VMS, treat 'f' like 'F', because 'f' fails to work
        !           325:             for multivalued logical names or for explicit versions.  */
        !           326: #ifndef VMS
        !           327:          args[i] = Fread_file_name (build_string (prompt),
        !           328:                                     Qnil, Qnil, Qlambda);
        !           329:          break;
        !           330: #endif
        !           331: 
        !           332:        case 'F':               /* Possibly nonexistent file name. */
        !           333:          args[i] = Fread_file_name (build_string (prompt),
        !           334:                                     Qnil, Qnil, Qnil);
        !           335:          break;
        !           336: 
        !           337:        case 'k':               /* Key sequence (string) */
        !           338:          args[i] = Fread_key_sequence (build_string (prompt));
        !           339:          teml = args[i];
        !           340:          visargs[i] = Fkey_description (teml);
        !           341:          break;
        !           342: 
        !           343:        case 'm':               /* Value of mark.  Does not do I/O.  */
        !           344:          check_mark ();
        !           345:          /* visargs[i] = Qnil; */
        !           346:          XFASTINT (args[i]) = marker_position (bf_cur->mark);
        !           347:          varies[i] = 2;
        !           348:          break;
        !           349: 
        !           350:        case 'N':               /* Prefix arg, else number from minibuffer */
        !           351:          if (!NULL (prefix_arg))
        !           352:            goto have_prefix_arg;
        !           353:        case 'n':               /* Read number from minibuffer.  */
        !           354:          do
        !           355:            args[i] = Fread_minibuffer (build_string (prompt), Qnil);
        !           356:          while (XTYPE (args[i]) != Lisp_Int);
        !           357:          visargs[i] = last_minibuf_string;
        !           358:          break;
        !           359: 
        !           360:        case 'P':               /* Prefix arg in raw form.  Does no I/O.  */
        !           361:          args[i] = prefix_arg;
        !           362:          /* visargs[i] = Qnil; */
        !           363:          varies[i] = -1;
        !           364:          break;
        !           365: 
        !           366:        case 'p':               /* Prefix arg converted to number.  No I/O. */
        !           367:        have_prefix_arg:
        !           368:          args[i] = Fprefix_numeric_value (prefix_arg);
        !           369:          /* visargs[i] = Qnil; */
        !           370:          varies[i] = -1;
        !           371:          break;
        !           372: 
        !           373:        case 'r':               /* Region, point and mark as 2 args. */
        !           374:          check_mark ();
        !           375:          /* visargs[i+1] = Qnil; */
        !           376:          foo = marker_position (bf_cur->mark);
        !           377:          /* visargs[i] = Qnil; */
        !           378:          XFASTINT (args[i]) = point < foo ? point : foo;
        !           379:          varies[i] = 3;
        !           380:          XFASTINT (args[++i]) = point > foo ? point : foo;
        !           381:          varies[i] = 4;
        !           382:          break;
        !           383: 
        !           384:        case 's':               /* String read via minibuffer.  */
        !           385:          args[i] = Fread_string (build_string (prompt), Qnil);
        !           386:          break;
        !           387: 
        !           388:        case 'S':               /* Any symbol.  */
        !           389:          visargs[i] = read_minibuf (Vminibuffer_local_ns_map,
        !           390:                                     Qnil,
        !           391:                                     build_string (prompt),
        !           392:                                     0);
        !           393:          /* Passing args[i] directly stimulates compiler bug */
        !           394:          teml = visargs[i];
        !           395:          args[i] = Fintern (teml, Qnil);
        !           396:          break;
        !           397: 
        !           398:        case 'v':               /* Variable name: symbol that is
        !           399:                                   user-variable-p. */
        !           400:          args[i] = Fread_variable (build_string (prompt));
        !           401:          visargs[i] = last_minibuf_string;
        !           402:          break;
        !           403: 
        !           404:        case 'x':               /* Lisp expression read but not evaluated */
        !           405:          args[i] = Fread_minibuffer (build_string (prompt), Qnil);
        !           406:          visargs[i] = last_minibuf_string;
        !           407:          break;
        !           408: 
        !           409:        case 'X':               /* Lisp expression read and evaluated */
        !           410:          args[i] = Feval_minibuffer (build_string (prompt), Qnil);
        !           411:          visargs[i] = last_minibuf_string;
        !           412:          break;
        !           413: 
        !           414:        default:
        !           415:          error ("Invalid control letter \"%c\" (%03o) in interactive calling string",
        !           416:                 *tem, *tem);
        !           417:        }
        !           418: 
        !           419:       if (varies[i] == 0)
        !           420:        arg_from_tty = 1;
        !           421: 
        !           422:       if (NULL (visargs[i]) && XTYPE (args[i]) == Lisp_String)
        !           423:        visargs[i] = args[i];
        !           424: 
        !           425:       tem = (unsigned char *) index (tem, '\n');
        !           426:       if (tem) tem++;
        !           427:       else tem = (unsigned char *) "";
        !           428:     }
        !           429: 
        !           430:   UNGCPRO;
        !           431: 
        !           432:   QUIT;
        !           433: 
        !           434:   args[0] = function;
        !           435: 
        !           436:   if (arg_from_tty || !NULL (record))
        !           437:     {
        !           438:       visargs[0] = function;
        !           439:       for (i = 1; i < count + 1; i++)
        !           440:        if (varies[i] > 0)
        !           441:          visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil);
        !           442:        else
        !           443:          visargs[i] = quotify_arg (args[i]);
        !           444:       Vcommand_history = Fcons (Flist (count + 1, visargs),
        !           445:                                Vcommand_history);
        !           446:     }
        !           447: 
        !           448:   return Ffuncall (count + 1, args);
        !           449: }  
        !           450: 
        !           451: DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value,
        !           452:   1, 1, 0,
        !           453:   "Return numeric meaning of raw prefix argument ARG.\n\
        !           454: A raw prefix argument is what you get from (interactive \"P\").")
        !           455:   (raw)
        !           456:      Lisp_Object raw;
        !           457: {
        !           458:   Lisp_Object val;
        !           459:   
        !           460:   if (NULL (raw))
        !           461:     XFASTINT (val) = 1;
        !           462:   else if (XTYPE (raw) == Lisp_Symbol)
        !           463:     {
        !           464:       XFASTINT (val) = 0;
        !           465:       XSETINT (val, -1);
        !           466:     }
        !           467:   else if (CONSP (raw))
        !           468:     val = XCONS (raw)->car;
        !           469:   else if (XTYPE (raw) == Lisp_Int)
        !           470:     val = raw;
        !           471:   else
        !           472:     XFASTINT (val) = 1;
        !           473: 
        !           474:   return val;
        !           475: }
        !           476: 
        !           477: syms_of_callint ()
        !           478: {
        !           479:   Qminus = intern ("-");
        !           480:   staticpro (&Qminus);
        !           481: 
        !           482:   Qcall_interactively = intern ("call-interactively");
        !           483:   staticpro (&Qcall_interactively);
        !           484: 
        !           485:   DEFVAR_LISP ("prefix-arg", &Vprefix_arg,
        !           486:     "The value of the prefix argument for the next editing command.\n\
        !           487: It may be a number, or the symbol - for just a minus sign as arg,\n\
        !           488: or a list whose car is a number for just one or more C-U's\n\
        !           489: or nil if no argument has been specified.\n\
        !           490: \n\
        !           491: You cannot examine this variable to find the argument for this command\n\
        !           492: since it has been set to nil by the time you can look.\n\
        !           493: Instead, you should use the variable current-prefix-arg, although\n\
        !           494: normally commands can get this prefix argument with (interactive \"P\").");
        !           495: 
        !           496:   DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg,
        !           497:     "The value of the prefix argument for this editing command.\n\
        !           498: It may be a number, or the symbol - for just a minus sign as arg,\n\
        !           499: or a list whose car is a number for just one or more C-U's\n\
        !           500: or nil if no argument has been specified.\n\
        !           501: This is what (interactive \"P\") returns.");
        !           502: 
        !           503:   DEFVAR_LISP ("command-history", &Vcommand_history,
        !           504:     "List of recent commands that read arguments from terminal.\n\
        !           505: Each command is represented as a form to evaluate.");
        !           506:   Vcommand_history = Qnil;
        !           507: 
        !           508:   defsubr (&Sinteractive);
        !           509:   defsubr (&Scall_interactively);
        !           510:   defsubr (&Sprefix_numeric_value);
        !           511: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.