Mercurial > emacs
annotate src/callint.c @ 1687:2bee660c3046
* configure: Don't make the top-level Makefile read-only - people
may want to edit the values of the path variables.
Make path specification conform to GNU coding standards.
* configure (long_usage): Remove all traces of old arguments from
usage messages, and document the options we do accept in more
detail: -with-x... and --srcdir.
(options, boolean_opts): Deleted; we don't have enough options to
make this worthwhile.
(prefix, bindir, lisppath, datadir, libdir, lockdir): Deleted,
along with the code which supported them; these should be set as
arguments to the top-level make.
(config_h_opts): Since this no longer doubles as a list of option
names, make them upper case; this simplifies the code which uses
them to build the sed command to edit src/config.h. Change the
code which sets them.
(cc, g, O): Don't allow the user to set these using options; they
should be specified using `CC=' and `CFLAGS=' arguments to the
top-level make. Just choose reasonable default values for them,
and edit them into Makefile.in's default CC and CONFIG_CFLAGS
values.
(gnu_malloc, rel_alloc): Don't allow the user to set these using
options; use them whenever the configuration files say they're
possible.
Simplify the argument processing loop. Don't accept abbreviations
for option names; these might conflict with other configuration
options in the future.
Add some support for the `--srcdir' option. Check for the sources
in . and .. if `--srcdir' is omitted. If the directories we will
compile in don't exist yet, create them under the current directory.
Note that the rest of the build process doesn't really support
this.
Edit only the top Makefile. That should edit the others. Edit
into the makefile: `version', from lisp/version.el, `configname'
and `srcdir' from the configuration arguments, `CC' and
`CONFIG_CFLAGS' as guessed from the presence or absence of GCC in
the user's path, and LOADLIBES as gleaned from the system
description files.
Simplify the report generated; it doesn't need to include any
description of paths now.
Make `config.status' exec configure instead of just calling it, so
there's no harm in overwriting `config.status'.
* Makefile.in (version, configname): New variables, used to choose
the default values for datadir and libdir.
Path variables rearranged into two clearer groups:
- In the first group are the variables specified by the GNU coding
standards (prefix, bindir, datadir, statedir, libdir, mandir,
manext, infodir, and srcdir).
- In the second are the variables actually used for Emacs's paths
(lispdir, locallisppath, lisppath, buildlisppath, etcdir, lockdir,
archlibdir), which depend on the first category.
datadir and libdir default to directories under
${prefix}/lib/emacs instead of ${prefix}/emacs, by popular
demand.
etcdir and lispdir default to subdirectories of datadir.
archlibdir defaults to libdir.
The new installation tree is a bit deeper than it used to be, so
use the new make-path program in lib-src to build them all.
Always build a new src/paths.h.tmp and then move-if-change it to
src/paths.h, to avoid unnecessary rebuilds while responding to the
right changes.
Remove all mention of arch-lib. Run utility commands from
lib-src, and let the executables be copied into archlibdir when
Emacs is installed.
Add targets for src/Makefile, lib-src/Makefile, and
oldXMenu/Makefile, editing the values of the path variables into
them.
Let lib-src do its own installation.
(datadir): Default to putting data files under
${prefix}/lib/emacs/${version}, not /usr/local/emacs.
(emacsdir): Variable deleted; it would only be confusing to use.
(lispdir, etcdir): Default to ${datadir}/lisp.
(mkdir): Use make-path for this.
(lockdir): Do this in mkdir.
(Makefile): New target.
* configure (usage_message): Rename to long_usage.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Sat, 12 Dec 1992 15:42:53 +0000 |
parents | 098464e977d6 |
children | 4b2f399dbea2 |
rev | line source |
---|---|
407 | 1 /* Call a Lisp function interactively. |
617 | 2 Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. |
407 | 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" | |
516 | 25 #include "keyboard.h" |
407 | 26 #include "window.h" |
27 #include "mocklisp.h" | |
28 | |
29 extern char *index (); | |
30 | |
31 Lisp_Object Vprefix_arg, Vcurrent_prefix_arg, Qminus; | |
32 Lisp_Object Qcall_interactively; | |
33 Lisp_Object Vcommand_history; | |
34 | |
35 Lisp_Object Vcommand_debug_status, Qcommand_debug_status; | |
873 | 36 Lisp_Object Qenable_recursive_minibuffers; |
407 | 37 |
1498
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
38 Lisp_Object Qlist; |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
39 Lisp_Object preserved_fns; |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
40 |
407 | 41 /* This comment supplies the doc string for interactive, |
42 for make-docfile to see. We cannot put this in the real DEFUN | |
43 due to limits in the Unix cpp. | |
44 | |
45 DEFUN ("interactive", Ffoo, Sfoo, 0, 0, 0, | |
46 "Specify a way of parsing arguments for interactive use of a function.\n\ | |
47 For example, write\n\ | |
48 (defun foo (arg) \"Doc string\" (interactive \"p\") ...use arg...)\n\ | |
49 to make ARG be the prefix argument when `foo' is called as a command.\n\ | |
50 The \"call\" to `interactive' is actually a declaration rather than a function;\n\ | |
51 it tells `call-interactively' how to read arguments\n\ | |
52 to pass to the function.\n\ | |
53 When actually called, `interactive' just returns nil.\n\ | |
54 \n\ | |
55 The argument of `interactive' is usually a string containing a code letter\n\ | |
56 followed by a prompt. (Some code letters do not use I/O to get\n\ | |
57 the argument and do not need prompts.) To prompt for multiple arguments,\n\ | |
58 give a code letter, its prompt, a newline, and another code letter, etc.\n\ | |
59 Prompts are passed to format, and may use % escapes to print the\n\ | |
60 arguments that have already been read.\n\ | |
61 If the argument is not a string, it is evaluated to get a list of\n\ | |
62 arguments to pass to the function.\n\ | |
63 Just `(interactive)' means pass no args when calling interactively.\n\ | |
64 \nCode letters available are:\n\ | |
65 a -- Function name: symbol with a function definition.\n\ | |
66 b -- Name of existing buffer.\n\ | |
67 B -- Name of buffer, possibly nonexistent.\n\ | |
68 c -- Character.\n\ | |
69 C -- Command name: symbol with interactive function definition.\n\ | |
70 d -- Value of point as number. Does not do I/O.\n\ | |
71 D -- Directory name.\n\ | |
1383
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
72 e -- Event that invoked this command (value of `last-nonmenu-event').\n\ |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
73 This skips events without parameters.\n\ |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
74 If used more than once, the Nth 'e' returns the Nth parameterized event.\n\ |
407 | 75 f -- Existing file name.\n\ |
76 F -- Possibly nonexistent file name.\n\ | |
77 k -- Key sequence (string).\n\ | |
78 m -- Value of mark as number. Does not do I/O.\n\ | |
79 n -- Number read using minibuffer.\n\ | |
80 N -- Prefix arg converted to number, or if none, do like code `n'.\n\ | |
81 p -- Prefix arg converted to number. Does not do I/O.\n\ | |
82 P -- Prefix arg in raw form. Does not do I/O.\n\ | |
83 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.\n\ | |
84 s -- Any string.\n\ | |
85 S -- Any symbol.\n\ | |
86 v -- Variable name: symbol that is user-variable-p.\n\ | |
87 x -- Lisp expression read but not evaluated.\n\ | |
88 X -- Lisp expression read and evaluated.\n\ | |
89 In addition, if the string begins with `*'\n\ | |
90 then an error is signaled if the buffer is read-only.\n\ | |
91 This happens before reading any arguments.\n\ | |
92 If the string begins with `@', then the window the mouse is over is selected\n\ | |
93 before anything else is done. You may use both `@' and `*';\n\ | |
94 they are processed in the order that they appear." | |
95 */ | |
96 | |
97 /* ARGSUSED */ | |
98 DEFUN ("interactive", Finteractive, Sinteractive, 0, UNEVALLED, 0, | |
99 0 /* See immediately above */) | |
100 (args) | |
101 Lisp_Object args; | |
102 { | |
103 return Qnil; | |
104 } | |
105 | |
106 /* Quotify EXP: if EXP is constant, return it. | |
107 If EXP is not constant, return (quote EXP). */ | |
108 Lisp_Object | |
109 quotify_arg (exp) | |
110 register Lisp_Object exp; | |
111 { | |
112 if (XTYPE (exp) != Lisp_Int && XTYPE (exp) != Lisp_String | |
485 | 113 && !NILP (exp) && !EQ (exp, Qt)) |
407 | 114 return Fcons (Qquote, Fcons (exp, Qnil)); |
115 | |
116 return exp; | |
117 } | |
118 | |
119 /* Modify EXP by quotifying each element (except the first). */ | |
120 Lisp_Object | |
121 quotify_args (exp) | |
122 Lisp_Object exp; | |
123 { | |
124 register Lisp_Object tail; | |
125 register struct Lisp_Cons *ptr; | |
126 for (tail = exp; CONSP (tail); tail = ptr->cdr) | |
127 { | |
128 ptr = XCONS (tail); | |
129 ptr->car = quotify_arg (ptr->car); | |
130 } | |
131 return exp; | |
132 } | |
133 | |
134 char *callint_argfuns[] | |
135 = {"", "point", "mark", "region-beginning", "region-end"}; | |
136 | |
137 static void | |
138 check_mark () | |
139 { | |
140 Lisp_Object tem = Fmarker_buffer (current_buffer->mark); | |
485 | 141 if (NILP (tem) || (XBUFFER (tem) != current_buffer)) |
407 | 142 error ("The mark is not set now"); |
143 } | |
144 | |
145 | |
146 DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 2, 0, | |
147 "Call FUNCTION, reading args according to its interactive calling specs.\n\ | |
148 The function contains a specification of how to do the argument reading.\n\ | |
149 In the case of user-defined functions, this is specified by placing a call\n\ | |
150 to the function `interactive' at the top level of the function body.\n\ | |
151 See `interactive'.\n\ | |
152 \n\ | |
153 Optional second arg RECORD-FLAG non-nil\n\ | |
154 means unconditionally put this command in the command-history.\n\ | |
155 Otherwise, this is done only if an arg is read using the minibuffer.") | |
156 (function, record) | |
157 Lisp_Object function, record; | |
158 { | |
159 Lisp_Object *args, *visargs; | |
160 unsigned char **argstrings; | |
161 Lisp_Object fun; | |
162 Lisp_Object funcar; | |
163 Lisp_Object specs; | |
164 Lisp_Object teml; | |
873 | 165 Lisp_Object enable; |
166 int speccount = specpdl_ptr - specpdl; | |
407 | 167 |
1383
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
168 /* The index of the next element of this_command_keys to examine for |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
169 the 'e' interactive code. */ |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
170 int next_event = 0; |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
171 |
407 | 172 Lisp_Object prefix_arg; |
173 unsigned char *string; | |
174 unsigned char *tem; | |
438 | 175 |
176 /* If varies[i] > 0, the i'th argument shouldn't just have its value | |
177 in this call quoted in the command history. It should be | |
178 recorded as a call to the function named callint_argfuns[varies[i]]. */ | |
407 | 179 int *varies; |
438 | 180 |
407 | 181 register int i, j; |
182 int count, foo; | |
183 char prompt[100]; | |
184 char prompt1[100]; | |
185 char *tem1; | |
186 int arg_from_tty = 0; | |
187 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
188 | |
732 | 189 /* Save this now, since use of minibuffer will clobber it. */ |
407 | 190 prefix_arg = Vcurrent_prefix_arg; |
191 | |
617 | 192 retry: |
407 | 193 |
1115
eb7f1ab33a9d
* callint.c (Fcall_interactively): Remove the 'K' interactive
Jim Blandy <jimb@redhat.com>
parents:
1084
diff
changeset
|
194 if (XTYPE (function) == Lisp_Symbol) |
eb7f1ab33a9d
* callint.c (Fcall_interactively): Remove the 'K' interactive
Jim Blandy <jimb@redhat.com>
parents:
1084
diff
changeset
|
195 enable = Fget (function, Qenable_recursive_minibuffers); |
873 | 196 |
648 | 197 fun = indirect_function (function); |
407 | 198 |
199 specs = Qnil; | |
200 string = 0; | |
201 | |
202 /* Decode the kind of function. Either handle it and return, | |
203 or go to `lose' if not interactive, or go to `retry' | |
204 to specify a different function, or set either STRING or SPECS. */ | |
205 | |
206 if (XTYPE (fun) == Lisp_Subr) | |
207 { | |
208 string = (unsigned char *) XSUBR (fun)->prompt; | |
209 if (!string) | |
210 { | |
211 lose: | |
212 function = wrong_type_argument (Qcommandp, function, 0); | |
213 goto retry; | |
214 } | |
215 if ((int) string == 1) | |
216 /* Let SPECS (which is nil) be used as the args. */ | |
217 string = 0; | |
218 } | |
219 else if (XTYPE (fun) == Lisp_Compiled) | |
220 { | |
221 if (XVECTOR (fun)->size <= COMPILED_INTERACTIVE) | |
222 goto lose; | |
223 specs = XVECTOR (fun)->contents[COMPILED_INTERACTIVE]; | |
224 } | |
225 else if (!CONSP (fun)) | |
226 goto lose; | |
227 else if (funcar = Fcar (fun), EQ (funcar, Qautoload)) | |
228 { | |
229 GCPRO2 (function, prefix_arg); | |
230 do_autoload (fun, function); | |
231 UNGCPRO; | |
232 goto retry; | |
233 } | |
234 else if (EQ (funcar, Qlambda)) | |
235 { | |
236 specs = Fassq (Qinteractive, Fcdr (Fcdr (fun))); | |
485 | 237 if (NILP (specs)) |
407 | 238 goto lose; |
239 specs = Fcar (Fcdr (specs)); | |
240 } | |
241 else if (EQ (funcar, Qmocklisp)) | |
242 return ml_apply (fun, Qinteractive); | |
243 else | |
244 goto lose; | |
245 | |
617 | 246 /* If either specs or string is set to a string, use it. */ |
407 | 247 if (XTYPE (specs) == Lisp_String) |
617 | 248 { |
249 /* Make a copy of string so that if a GC relocates specs, | |
250 `string' will still be valid. */ | |
732 | 251 string = (unsigned char *) alloca (XSTRING (specs)->size + 1); |
617 | 252 bcopy (XSTRING (specs)->data, string, XSTRING (specs)->size + 1); |
253 } | |
407 | 254 else if (string == 0) |
255 { | |
1498
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
256 Lisp_Object input; |
407 | 257 i = num_input_chars; |
1498
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
258 input = specs; |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
259 /* Compute the arg values using the user's expression. */ |
407 | 260 specs = Feval (specs); |
485 | 261 if (i != num_input_chars || !NILP (record)) |
1498
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
262 { |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
263 /* We should record this command on the command history. */ |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
264 Lisp_Object values, car; |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
265 /* Make a copy of the list of values, for the command history, |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
266 and turn them into things we can eval. */ |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
267 values = quotify_args (Fcopy_sequence (specs)); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
268 /* If the list of args was produced with an explicit call to `list', |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
269 look for elements that were computed with (region-beginning) |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
270 or (region-end), and put those expressions into VALUES |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
271 instead of the present values. */ |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
272 car = Fcar (input); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
273 if (EQ (car, Qlist)) |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
274 { |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
275 Lisp_Object intail, valtail; |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
276 for (intail = Fcdr (input), valtail = values; |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
277 CONSP (valtail); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
278 intail = Fcdr (intail), valtail = Fcdr (valtail)) |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
279 { |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
280 Lisp_Object elt; |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
281 elt = Fcar (intail); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
282 if (CONSP (elt)) |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
283 { |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
284 Lisp_Object presflag; |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
285 presflag = Fmemq (Fcar (elt), preserved_fns); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
286 if (!NILP (presflag)) |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
287 Fsetcar (valtail, Fcar (intail)); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
288 } |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
289 } |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
290 } |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
291 Vcommand_history |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
292 = Fcons (Fcons (function, values), Vcommand_history); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
293 } |
407 | 294 return apply1 (function, specs); |
295 } | |
296 | |
297 /* Here if function specifies a string to control parsing the defaults */ | |
298 | |
299 /* Handle special starting chars `*' and `@'. */ | |
300 while (1) | |
301 { | |
302 if (*string == '*') | |
303 { | |
304 string++; | |
485 | 305 if (!NILP (current_buffer->read_only)) |
407 | 306 Fbarf_if_buffer_read_only (); |
307 } | |
308 else if (*string == '@') | |
309 { | |
310 string++; | |
485 | 311 if (!NILP (Vmouse_window)) |
407 | 312 Fselect_window (Vmouse_window); |
313 } | |
314 else break; | |
315 } | |
316 | |
317 /* Count the number of arguments the interactive spec would have | |
318 us give to the function. */ | |
319 tem = string; | |
320 for (j = 0; *tem; j++) | |
321 { | |
322 /* 'r' specifications ("point and mark as 2 numeric args") | |
323 produce *two* arguments. */ | |
324 if (*tem == 'r') j++; | |
325 tem = (unsigned char *) index (tem, '\n'); | |
326 if (tem) | |
327 tem++; | |
328 else | |
329 tem = (unsigned char *) ""; | |
330 } | |
331 count = j; | |
332 | |
333 args = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object)); | |
334 visargs = (Lisp_Object *) alloca ((count + 1) * sizeof (Lisp_Object)); | |
335 argstrings = (unsigned char **) alloca ((count + 1) * sizeof (char *)); | |
336 varies = (int *) alloca ((count + 1) * sizeof (int)); | |
337 | |
338 for (i = 0; i < (count + 1); i++) | |
339 { | |
340 args[i] = Qnil; | |
341 visargs[i] = Qnil; | |
342 varies[i] = 0; | |
343 } | |
344 | |
345 GCPRO4 (prefix_arg, function, *args, *visargs); | |
346 gcpro3.nvars = (count + 1); | |
347 gcpro4.nvars = (count + 1); | |
348 | |
873 | 349 if (!NILP (enable)) |
350 specbind (Qenable_recursive_minibuffers, Qt); | |
351 | |
407 | 352 tem = string; |
617 | 353 for (i = 1; *tem; i++) |
407 | 354 { |
355 strncpy (prompt1, tem + 1, sizeof prompt1 - 1); | |
356 prompt1[sizeof prompt1 - 1] = 0; | |
357 tem1 = index (prompt1, '\n'); | |
358 if (tem1) *tem1 = 0; | |
359 /* Fill argstrings with a vector of C strings | |
360 corresponding to the Lisp strings in visargs. */ | |
361 for (j = 1; j < i; j++) | |
362 argstrings[j] | |
363 = EQ (visargs[j], Qnil) | |
364 ? (unsigned char *) "" | |
617 | 365 : XSTRING (visargs[j])->data; |
407 | 366 |
367 doprnt (prompt, sizeof prompt, prompt1, 0, j - 1, argstrings + 1); | |
368 | |
369 switch (*tem) | |
370 { | |
371 case 'a': /* Symbol defined as a function */ | |
372 visargs[i] = Fcompleting_read (build_string (prompt), | |
373 Vobarray, Qfboundp, Qt, Qnil, Qnil); | |
374 /* Passing args[i] directly stimulates compiler bug */ | |
375 teml = visargs[i]; | |
376 args[i] = Fintern (teml, Qnil); | |
377 break; | |
378 | |
379 case 'b': /* Name of existing buffer */ | |
380 args[i] = Fcurrent_buffer (); | |
381 if (EQ (selected_window, minibuf_window)) | |
1347
ac3a893b9bb9
(Fcall_interactively): Pass 2nd arg to Fother_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1115
diff
changeset
|
382 args[i] = Fother_buffer (args[i], Qnil); |
407 | 383 args[i] = Fread_buffer (build_string (prompt), args[i], Qt); |
384 break; | |
385 | |
386 case 'B': /* Name of buffer, possibly nonexistent */ | |
387 args[i] = Fread_buffer (build_string (prompt), | |
1347
ac3a893b9bb9
(Fcall_interactively): Pass 2nd arg to Fother_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1115
diff
changeset
|
388 Fother_buffer (Fcurrent_buffer (), Qnil), |
ac3a893b9bb9
(Fcall_interactively): Pass 2nd arg to Fother_buffer.
Richard M. Stallman <rms@gnu.org>
parents:
1115
diff
changeset
|
389 Qnil); |
407 | 390 break; |
391 | |
392 case 'c': /* Character */ | |
393 message1 (prompt); | |
394 args[i] = Fread_char (); | |
395 /* Passing args[i] directly stimulates compiler bug */ | |
396 teml = args[i]; | |
397 visargs[i] = Fchar_to_string (teml); | |
398 break; | |
399 | |
400 case 'C': /* Command: symbol with interactive function */ | |
401 visargs[i] = Fcompleting_read (build_string (prompt), | |
402 Vobarray, Qcommandp, Qt, Qnil, Qnil); | |
403 /* Passing args[i] directly stimulates compiler bug */ | |
404 teml = visargs[i]; | |
405 args[i] = Fintern (teml, Qnil); | |
406 break; | |
407 | |
408 case 'd': /* Value of point. Does not do I/O. */ | |
409 XFASTINT (args[i]) = point; | |
410 /* visargs[i] = Qnil; */ | |
411 varies[i] = 1; | |
412 break; | |
413 | |
414 case 'D': /* Directory name. */ | |
415 args[i] = Fread_file_name (build_string (prompt), Qnil, | |
416 current_buffer->directory, Qlambda, Qnil); | |
417 break; | |
418 | |
419 case 'f': /* Existing file name. */ | |
420 args[i] = Fread_file_name (build_string (prompt), | |
421 Qnil, Qnil, Qlambda, Qnil); | |
422 break; | |
423 | |
424 case 'F': /* Possibly nonexistent file name. */ | |
425 args[i] = Fread_file_name (build_string (prompt), | |
426 Qnil, Qnil, Qnil, Qnil); | |
427 break; | |
428 | |
429 case 'k': /* Key sequence (string) */ | |
438 | 430 args[i] = Fread_key_sequence (build_string (prompt), Qnil); |
407 | 431 teml = args[i]; |
432 visargs[i] = Fkey_description (teml); | |
433 break; | |
434 | |
1383
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
435 case 'e': /* The invoking event. */ |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
436 /* Find the next parameterized event. */ |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
437 while (next_event < this_command_key_count |
1425
2c156e9908ad
* callint.c (Fcall_interactively): Change handling of 'e' spec;
Jim Blandy <jimb@redhat.com>
parents:
1383
diff
changeset
|
438 && ! (EVENT_HAS_PARAMETERS |
2c156e9908ad
* callint.c (Fcall_interactively): Change handling of 'e' spec;
Jim Blandy <jimb@redhat.com>
parents:
1383
diff
changeset
|
439 (XVECTOR (this_command_keys)->contents[next_event]))) |
1383
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
440 next_event++; |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
441 if (next_event >= this_command_key_count) |
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
442 error ("%s must be bound to an event with parameters", |
438 | 443 (XTYPE (function) == Lisp_Symbol |
444 ? (char *) XSYMBOL (function)->name->data | |
1383
54028d2538a4
* callint.c (Fcall_interactively): Allow multiple 'e' specs.
Jim Blandy <jimb@redhat.com>
parents:
1347
diff
changeset
|
445 : "command")); |
1425
2c156e9908ad
* callint.c (Fcall_interactively): Change handling of 'e' spec;
Jim Blandy <jimb@redhat.com>
parents:
1383
diff
changeset
|
446 args[i] = XVECTOR (this_command_keys)->contents[next_event++]; |
732 | 447 varies[i] = -1; |
438 | 448 break; |
449 | |
407 | 450 case 'm': /* Value of mark. Does not do I/O. */ |
451 check_mark (); | |
452 /* visargs[i] = Qnil; */ | |
453 XFASTINT (args[i]) = marker_position (current_buffer->mark); | |
454 varies[i] = 2; | |
455 break; | |
456 | |
457 case 'N': /* Prefix arg, else number from minibuffer */ | |
485 | 458 if (!NILP (prefix_arg)) |
407 | 459 goto have_prefix_arg; |
460 case 'n': /* Read number from minibuffer. */ | |
461 do | |
462 args[i] = Fread_minibuffer (build_string (prompt), Qnil); | |
621 | 463 while (! NUMBERP (args[i])); |
407 | 464 visargs[i] = last_minibuf_string; |
465 break; | |
466 | |
467 case 'P': /* Prefix arg in raw form. Does no I/O. */ | |
468 have_prefix_arg: | |
469 args[i] = prefix_arg; | |
470 /* visargs[i] = Qnil; */ | |
471 varies[i] = -1; | |
472 break; | |
473 | |
474 case 'p': /* Prefix arg converted to number. No I/O. */ | |
475 args[i] = Fprefix_numeric_value (prefix_arg); | |
476 /* visargs[i] = Qnil; */ | |
477 varies[i] = -1; | |
478 break; | |
479 | |
480 case 'r': /* Region, point and mark as 2 args. */ | |
481 check_mark (); | |
482 /* visargs[i+1] = Qnil; */ | |
483 foo = marker_position (current_buffer->mark); | |
484 /* visargs[i] = Qnil; */ | |
485 XFASTINT (args[i]) = point < foo ? point : foo; | |
486 varies[i] = 3; | |
487 XFASTINT (args[++i]) = point > foo ? point : foo; | |
488 varies[i] = 4; | |
489 break; | |
490 | |
491 case 's': /* String read via minibuffer. */ | |
492 args[i] = Fread_string (build_string (prompt), Qnil); | |
493 break; | |
494 | |
495 case 'S': /* Any symbol. */ | |
863
427299469901
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
819
diff
changeset
|
496 visargs[i] = Fread_no_blanks_input (build_string (prompt), Qnil); |
407 | 497 /* Passing args[i] directly stimulates compiler bug */ |
498 teml = visargs[i]; | |
499 args[i] = Fintern (teml, Qnil); | |
500 break; | |
501 | |
502 case 'v': /* Variable name: symbol that is | |
503 user-variable-p. */ | |
504 args[i] = Fread_variable (build_string (prompt)); | |
505 visargs[i] = last_minibuf_string; | |
506 break; | |
507 | |
508 case 'x': /* Lisp expression read but not evaluated */ | |
509 args[i] = Fread_minibuffer (build_string (prompt), Qnil); | |
510 visargs[i] = last_minibuf_string; | |
511 break; | |
512 | |
513 case 'X': /* Lisp expression read and evaluated */ | |
514 args[i] = Feval_minibuffer (build_string (prompt), Qnil); | |
515 visargs[i] = last_minibuf_string; | |
516 break; | |
517 | |
518 default: | |
519 error ("Invalid control letter \"%c\" (%03o) in interactive calling string", | |
520 *tem, *tem); | |
521 } | |
522 | |
523 if (varies[i] == 0) | |
524 arg_from_tty = 1; | |
525 | |
485 | 526 if (NILP (visargs[i]) && XTYPE (args[i]) == Lisp_String) |
407 | 527 visargs[i] = args[i]; |
528 | |
529 tem = (unsigned char *) index (tem, '\n'); | |
530 if (tem) tem++; | |
531 else tem = (unsigned char *) ""; | |
532 } | |
873 | 533 unbind_to (speccount, Qnil); |
407 | 534 |
535 QUIT; | |
536 | |
537 args[0] = function; | |
538 | |
485 | 539 if (arg_from_tty || !NILP (record)) |
407 | 540 { |
541 visargs[0] = function; | |
438 | 542 for (i = 1; i < count + 1; i++) |
543 if (varies[i] > 0) | |
407 | 544 visargs[i] = Fcons (intern (callint_argfuns[varies[i]]), Qnil); |
545 else | |
546 visargs[i] = quotify_arg (args[i]); | |
547 Vcommand_history = Fcons (Flist (count + 1, visargs), | |
548 Vcommand_history); | |
549 } | |
550 | |
551 { | |
552 Lisp_Object val; | |
553 specbind (Qcommand_debug_status, Qnil); | |
554 | |
555 val = Ffuncall (count + 1, args); | |
556 UNGCPRO; | |
557 return unbind_to (speccount, val); | |
558 } | |
559 } | |
560 | |
561 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, Sprefix_numeric_value, | |
562 1, 1, 0, | |
563 "Return numeric meaning of raw prefix argument ARG.\n\ | |
564 A raw prefix argument is what you get from `(interactive \"P\")'.\n\ | |
565 Its numeric meaning is what you would get from `(interactive \"p\")'.") | |
566 (raw) | |
567 Lisp_Object raw; | |
568 { | |
569 Lisp_Object val; | |
570 | |
571 /* Tag val as an integer, so the rest of the assignments | |
572 may use XSETINT. */ | |
573 XFASTINT (val) = 0; | |
574 | |
485 | 575 if (NILP (raw)) |
407 | 576 XFASTINT (val) = 1; |
819
5bbabfcef929
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
732
diff
changeset
|
577 else if (EQ (raw, Qminus)) |
407 | 578 XSETINT (val, -1); |
579 else if (CONSP (raw)) | |
580 XSETINT (val, XINT (XCONS (raw)->car)); | |
581 else if (XTYPE (raw) == Lisp_Int) | |
582 val = raw; | |
583 else | |
584 XFASTINT (val) = 1; | |
585 | |
586 return val; | |
587 } | |
588 | |
589 syms_of_callint () | |
590 { | |
1498
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
591 preserved_fns = Fcons (intern ("region-beginning"), |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
592 Fcons (intern ("region-end"), |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
593 Fcons (intern ("point"), |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
594 Fcons (intern ("mark"), Qnil)))); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
595 staticpro (&preserved_fns); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
596 |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
597 Qlist = intern ("list"); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
598 staticpro (&Qlist); |
098464e977d6
(preserved_fns): New var.
Richard M. Stallman <rms@gnu.org>
parents:
1425
diff
changeset
|
599 |
407 | 600 Qminus = intern ("-"); |
601 staticpro (&Qminus); | |
602 | |
603 Qcall_interactively = intern ("call-interactively"); | |
604 staticpro (&Qcall_interactively); | |
605 | |
606 Qcommand_debug_status = intern ("command-debug-status"); | |
607 staticpro (&Qcommand_debug_status); | |
608 | |
873 | 609 Qenable_recursive_minibuffers = intern ("enable-recursive-minibuffers"); |
610 staticpro (&Qenable_recursive_minibuffers); | |
611 | |
407 | 612 DEFVAR_LISP ("prefix-arg", &Vprefix_arg, |
613 "The value of the prefix argument for the next editing command.\n\ | |
614 It may be a number, or the symbol `-' for just a minus sign as arg,\n\ | |
615 or a list whose car is a number for just one or more C-U's\n\ | |
616 or nil if no argument has been specified.\n\ | |
617 \n\ | |
618 You cannot examine this variable to find the argument for this command\n\ | |
619 since it has been set to nil by the time you can look.\n\ | |
620 Instead, you should use the variable `current-prefix-arg', although\n\ | |
621 normally commands can get this prefix argument with (interactive \"P\")."); | |
622 Vprefix_arg = Qnil; | |
623 | |
624 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg, | |
625 "The value of the prefix argument for this editing command.\n\ | |
626 It may be a number, or the symbol `-' for just a minus sign as arg,\n\ | |
627 or a list whose car is a number for just one or more C-U's\n\ | |
628 or nil if no argument has been specified.\n\ | |
629 This is what `(interactive \"P\")' returns."); | |
630 Vcurrent_prefix_arg = Qnil; | |
631 | |
632 DEFVAR_LISP ("command-history", &Vcommand_history, | |
633 "List of recent commands that read arguments from terminal.\n\ | |
634 Each command is represented as a form to evaluate."); | |
635 Vcommand_history = Qnil; | |
636 | |
637 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status, | |
638 "Debugging status of current interactive command.\n\ | |
639 Bound each time `call-interactively' is called;\n\ | |
640 may be set by the debugger as a reminder for itself."); | |
641 Vcommand_debug_status = Qnil; | |
642 | |
643 defsubr (&Sinteractive); | |
644 defsubr (&Scall_interactively); | |
645 defsubr (&Sprefix_numeric_value); | |
646 } |