![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to callint.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src|
Return to callint.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
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.