Return to callint.c CVS log

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

Annotation of 43BSD/contrib/emacs/src/callint.c, revision 1.1

1.1     ! root        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: }

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