Return to callint.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

Annotation of GNUtools/emacs/src/callint.c, revision 1.1

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

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