annotate src/callint.c @ 5750:66d2f63df75f

Correct some spelling and formatting in behavior.el. Mentioned in tracker issue 826, the third thing mentioned there (the file name at the bottom of the file) had already been fixed. lisp/ChangeLog addition: 2013-08-05 Aidan Kehoe <kehoea@parhasard.net> * behavior.el: (override-behavior): Correct some spelling and formatting here, thank you Steven Mitchell in tracker issue 826.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 05 Aug 2013 10:05:32 +0100
parents 56144c8593a8
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Call a Lisp function interactively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
3 Copyright (C) 1995, 1996, 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4744
diff changeset
7 XEmacs is free software: you can redistribute it and/or modify it
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4744
diff changeset
9 Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4744
diff changeset
10 option) any later version.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4744
diff changeset
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 /* Synched up with: FSF 19.30, Mule 2.0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Authorship:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 FSF: long ago.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 Mly or JWZ: various changes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "bytecode.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "commands.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "events.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "insdel.h"
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 867
diff changeset
36 #include "window-impl.h" /* WINDOW_MINI_P */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
1204
e22b0213b713 [xemacs-hg @ 2003-01-12 11:07:58 by michaels]
michaels
parents: 970
diff changeset
38 extern Charcount num_input_chars;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 Lisp_Object Vcurrent_prefix_arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 Lisp_Object Qcall_interactively;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 Lisp_Object Vcommand_history;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 Lisp_Object Vcommand_debug_status, Qcommand_debug_status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 Lisp_Object Qenable_recursive_minibuffers;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 /* Non-nil means treat the mark as active
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 even if mark_active is 0. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Lisp_Object Vmark_even_if_inactive;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #if 0 /* ill-conceived */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
54 /* FSF calls Qmouse_leave_buffer_hook at all sorts of random places,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
55 including a bunch of places in their mouse.el. If this is
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
56 implemented, it has to be done cleanly. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object Vmouse_leave_buffer_hook, Qmouse_leave_buffer_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
60 Lisp_Object QletX, Qsave_excursion;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Lisp_Object Qread_from_minibuffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Lisp_Object Qread_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 Lisp_Object Qread_directory_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 Lisp_Object Qcompleting_read;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 Lisp_Object Qread_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Lisp_Object Qread_function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 Lisp_Object Qread_variable;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Lisp_Object Qread_expression;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Lisp_Object Qread_command;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Lisp_Object Qread_number;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 Lisp_Object Qread_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 Lisp_Object Qevents_to_keys;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 Lisp_Object Qread_coding_system;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 Lisp_Object Qread_non_nil_coding_system;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 /* ARGSUSED */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 DEFUN ("interactive", Finteractive, 0, UNEVALLED, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Specify a way of parsing arguments for interactive use of a function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 For example, write
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 (defun foo (arg) "Doc string" (interactive "p") ...use arg...)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 to make ARG be the prefix argument when `foo' is called as a command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 The "call" to `interactive' is actually a declaration rather than a function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 it tells `call-interactively' how to read arguments
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 to pass to the function.
4644
b0ae008bf1a0 Documentment placement restriction. <87d490jb7v.fsf@uwakimon.sk.tsukuba.ac.jp>
Stephen J. Turnbull <stephen@xemacs.org>
parents: 2367
diff changeset
87 The interactive form must appear at the top level of the function body. If
b0ae008bf1a0 Documentment placement restriction. <87d490jb7v.fsf@uwakimon.sk.tsukuba.ac.jp>
Stephen J. Turnbull <stephen@xemacs.org>
parents: 2367
diff changeset
88 it is wrapped in a `let' or `progn' or similar, Lisp will not even realize
b0ae008bf1a0 Documentment placement restriction. <87d490jb7v.fsf@uwakimon.sk.tsukuba.ac.jp>
Stephen J. Turnbull <stephen@xemacs.org>
parents: 2367
diff changeset
89 the function is an interactive command!
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 When actually called, `interactive' just returns nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 The argument of `interactive' is usually a string containing a code letter
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 followed by a prompt. (Some code letters do not use I/O to get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 the argument and do not need prompts.) To prompt for multiple arguments,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 give a code letter, its prompt, a newline, and another code letter, etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 Prompts are passed to format, and may use % escapes to print the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 arguments that have already been read.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 If the argument is not a string, it is evaluated to get a list of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 arguments to pass to the function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Just `(interactive)' means pass no args when calling interactively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Code letters available are:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 a -- Function name: symbol with a function definition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 b -- Name of existing buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 B -- Name of buffer, possibly nonexistent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 c -- Character.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 C -- Command name: symbol with interactive function definition.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 d -- Value of point as number. Does not do I/O.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 D -- Directory name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 e -- Last mouse-button or misc-user event that invoked this command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 If used more than once, the Nth `e' returns the Nth such event.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Does not do I/O.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 f -- Existing file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 F -- Possibly nonexistent file name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 i -- Always nil, ignore. Use to skip arguments when interactive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 k -- Key sequence (a vector of events).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 K -- Key sequence to be redefined (do not automatically down-case).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 m -- Value of mark as number. Does not do I/O.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 n -- Number read using minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 N -- Prefix arg converted to number, or if none, do like code `n'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 p -- Prefix arg converted to number. Does not do I/O.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 P -- Prefix arg in raw form. Does not do I/O.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 r -- Region: point and mark as 2 numeric args, smallest first. Does no I/O.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 s -- Any string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 S -- Any symbol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 v -- Variable name: symbol that is user-variable-p.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 x -- Lisp expression read but not evaluated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 X -- Lisp expression read and evaluated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 z -- Coding system. (Always nil if no Mule support.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 Z -- Coding system, nil if no prefix arg. (Always nil if no Mule support.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 In addition, if the string begins with `*'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 then an error is signaled if the buffer is read-only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 This happens before reading any arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 If the string begins with `@', then the window the mouse is over is selected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 before anything else is done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 If the string begins with `_', then this command will not cause the region
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 to be deactivated when it completes; that is, `zmacs-region-stays' will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 set to t when the command exits successfully.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 You may use any of `@', `*' and `_' at the beginning of the string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 they are processed in the order that they appear.
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
141
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
142
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
143 When writing your own interactive spec, it can be useful to know the
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
144 equivalent Lisp expressions for the various code letters. They are:
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
145
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
146 a -- (read-function "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
147 b -- (let ((def (current-buffer)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
148 (if (eq (selected-window) (active-minibuffer-window))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
149 (setq def (other-buffer def))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
150 (read-buffer "PROMPT" def t)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
151 B -- (read-buffer "PROMPT" (other-buffer (current-buffer)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
152 c -- (prog1
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
153 (let ((cursor-in-echo-area t))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
154 (message "%s" "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
155 (read-char))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
156 (message nil))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
157 C -- (read-command "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
158 d -- (point)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
159 D -- (read-directory-name "PROMPT" nil default-directory t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
160 e -- current-mouse-event ;; #### not quite right. needs access to the KEYS
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
161 ;; argument of `call-interactively', but that's
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
162 ;; currently impossible.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
163 f -- (read-file-name "PROMPT" nil nil 0)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
164 F -- (read-file-name "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
165 i -- nil
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
166 k -- (read-key-sequence "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
167 K -- (read-key-sequence "PROMPT" nil t)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
168 m -- (mark)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
169 n -- (read-number "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
170 N -- (if current-prefix-arg
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
171 (prefix-numeric-value current-prefix-arg)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
172 (read-number "PROMPT"))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
173 p -- (prefix-numeric-value current-prefix-arg)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
174 P -- current-prefix-arg
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
175 r -- (if (and zmacs-regions (not zmacs-region-active-p))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
176 (error "The region is not active now"))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
177 (let ((tem (marker-buffer (mark-marker t))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
178 (unless (and tem (eq tem (current-buffer)))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
179 (error "The mark is now set now")))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
180 (region-beginning) +
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
181 (region-end)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
182 s -- (read-string "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
183 S -- (let (tem prev-tem)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
184 (while (not tem)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
185 (setq tem (completing-read "PROMPT" obarray nil nil prev-tem))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
186 (setq prev-tem tem)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
187 (setq tem (intern tem))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
188 (if (= (length tem) 0)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
189 (setq tem nil))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
190 v -- (read-variable "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
191 x -- (read-expression "PROMPT")
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
192 X -- (eval (read-expression "PROMPT"))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
193 z -- (and (fboundp 'read-coding-system) (read-coding-system "PROMPT"))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
194 Z -- (and current-prefix-arg (fboundp 'read-coding-system)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
195 (read-coding-system "PROMPT"))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
196
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
197 `*' (barf-if-buffer-read-only)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
198 `@' (let ((event current-mouse-event)) ;; #### not quite right; needs the
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
199 (when event ;; value from the `e' spec above.
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
200 (let ((window event-window event))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
201 (when window
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
202 (if (and (window-minibuffer-p window)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
203 (not (and (> (minibuffer-depth) 0)
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
204 (eq window (active-minibuffer-window)))))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
205 (error "Attempt to select inactive minibuffer window"))
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 444
diff changeset
206 (select window)))))
4652
f3dddd098242 Fix for issue 521
Adrian Aichner <adrian@xemacs.org>
parents: 2367
diff changeset
207 `_' (setq zmacs-region-stays t) *//* FIXME: moving end of previous comment
f3dddd098242 Fix for issue 521
Adrian Aichner <adrian@xemacs.org>
parents: 2367
diff changeset
208 to a separate line causes docstring lossage! */
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 1204
diff changeset
209 (UNUSED (args)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 /* Modify EXPR by quotifying each element (except the first). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 quotify_args (Lisp_Object expr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 {
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
218 EXTERNAL_LIST_LOOP_3 (elt, expr, tail)
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
219 XSETCAR (tail, Fquote_maybe (elt));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 return expr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
223 static Charbpos
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 check_mark (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 if (zmacs_regions && !zmacs_region_active_p)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
229 invalid_operation ("The region is not active now", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 tem = Fmarker_buffer (current_buffer->mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 if (NILP (tem) || (XBUFFER (tem) != current_buffer))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
233 invalid_operation ("The mark is not set now", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 return marker_position (current_buffer->mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 static Lisp_Object
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
239 callint_prompt (const Ibyte *prompt_start, Bytecount prompt_length,
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
240 const Lisp_Object *args, int nargs)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 Lisp_Object s = make_string (prompt_start, prompt_length);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 /* Fformat no longer smashes its arg vector, so no need to copy it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 if (!strchr ((char *) XSTRING_DATA (s), '%'))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 return s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 GCPRO1 (s);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
250 RETURN_UNGCPRO (emacs_vsprintf_string_lisp (0, s, nargs, args));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 /* `lambda' for RECORD-FLAG is an XEmacs addition. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 DEFUN ("call-interactively", Fcall_interactively, 1, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 Call FUNCTION, reading args according to its interactive calling specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 Return the value FUNCTION returns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 The function contains a specification of how to do the argument reading.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 In the case of user-defined functions, this is specified by placing a call
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 to the function `interactive' at the top level of the function body.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 See `interactive'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 If optional second arg RECORD-FLAG is the symbol `lambda', the interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 calling arguments for FUNCTION are read and returned as a list,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 but the function is not called on them.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 If RECORD-FLAG is `t' then unconditionally put this command in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 command-history. Otherwise, this is done only if an arg is read using
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 the minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 The argument KEYS specifies the value to use instead of (this-command-keys)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 when reading the arguments.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (function, record_flag, keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 int speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 Lisp_Object prefix;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 Lisp_Object fun;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 Lisp_Object specs = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 Lisp_Object enable;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 #endif
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
285 /* If SPECS is a string, we reset prompt_data to XSTRING_DATA (specs)
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
286 every time a GC might have occurred */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
287 const char *prompt_data = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 int prompt_index = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 int argcount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 int set_zmacs_region_stays = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 int mouse_event_count = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 if (!NILP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 int i, len;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 CHECK_VECTOR (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 len = XVECTOR_LENGTH (keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 for (i = 0; i < len; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 CHECK_LIVE_EVENT (XVECTOR_DATA (keys)[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 /* Save this now, since use of minibuffer will clobber it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 prefix = Vcurrent_prefix_arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 retry:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 /* Marginal kludge. Use an evaluated interactive spec instead of this! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 if (SYMBOLP (function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 enable = Fget (function, Qenable_recursive_minibuffers, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 fun = indirect_function (function, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 /* Decode the kind of function. Either handle it and return,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 or go to `lose' if not interactive, or go to `retry'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 to specify a different function, or set either PROMPT_DATA or SPECS. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 if (SUBRP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 prompt_data = XSUBR (fun)->prompt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 if (!prompt_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 lose:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 function = wrong_type_argument (Qcommandp, function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 #if 0 /* FSFmacs */ /* Huh? Where is this used? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 if ((EMACS_INT) prompt_data == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 /* Let SPECS (which is nil) be used as the args. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 prompt_data = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 else if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 if (! f->flags.interactivep)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 specs = compiled_function_interactive (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 else if (!CONSP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 Lisp_Object funcar = Fcar (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 if (EQ (funcar, Qautoload))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 {
970
0dc7756a58c4 [xemacs-hg @ 2002-08-22 11:31:39 by stephent]
stephent
parents: 872
diff changeset
350 struct gcpro gcpro1;
0dc7756a58c4 [xemacs-hg @ 2002-08-22 11:31:39 by stephent]
stephent
parents: 872
diff changeset
351 GCPRO1 (prefix);
0dc7756a58c4 [xemacs-hg @ 2002-08-22 11:31:39 by stephent]
stephent
parents: 872
diff changeset
352 /* do_autoload GCPROs both arguments */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 do_autoload (fun, function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 goto retry;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 else if (EQ (funcar, Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 specs = Fassq (Qinteractive, Fcdr (Fcdr (fun)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 if (NILP (specs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 specs = Fcar (Fcdr (specs));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 goto lose;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
2367
ecf1ebac70d8 [xemacs-hg @ 2004-11-04 23:05:23 by ben]
ben
parents: 2286
diff changeset
368 /* FSFmacs makes an ALLOCA() copy of prompt_data here.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 We're more intelligent about this and just reset prompt_data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 as necessary. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 /* If either specs or prompt_data is set to a string, use it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 if (!STRINGP (specs) && prompt_data == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 struct gcpro gcpro1, gcpro2, gcpro3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 int i = num_input_chars;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 Lisp_Object input = specs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 GCPRO3 (function, specs, input);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 /* Compute the arg values using the user's expression. */
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4654
diff changeset
380 specs = IGNORE_MULTIPLE_VALUES (Feval (specs));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 if (EQ (record_flag, Qlambda)) /* XEmacs addition */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 return specs;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 if (!NILP (record_flag) || i != num_input_chars)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 /* We should record this command on the command history. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 /* #### The following is too specific; should have general
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 mechanism for doing this. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 Lisp_Object values, car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 /* Make a copy of the list of values, for the command history,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 and turn them into things we can eval. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 values = quotify_args (Fcopy_sequence (specs));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 /* If the list of args was produced with an explicit call to `list',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 look for elements that were computed with (region-beginning)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 or (region-end), and put those expressions into VALUES
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 instead of the present values. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 if (CONSP (input))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 car = XCAR (input);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 /* Skip through certain special forms. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 while (EQ (car, Qlet) || EQ (car, QletX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 || EQ (car, Qsave_excursion))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 while (CONSP (XCDR (input)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 input = XCDR (input);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 input = XCAR (input);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 if (!CONSP (input))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 car = XCAR (input);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 if (EQ (car, Qlist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 Lisp_Object intail, valtail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 for (intail = Fcdr (input), valtail = values;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 CONSP (valtail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 intail = Fcdr (intail), valtail = Fcdr (valtail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 Lisp_Object elt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 elt = Fcar (intail);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 if (CONSP (elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 Lisp_Object eltcar = Fcar (elt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 if (EQ (eltcar, Qpoint) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 EQ (eltcar, Qmark) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 EQ (eltcar, Qregion_beginning) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 EQ (eltcar, Qregion_end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 Fsetcar (valtail, Fcar (intail));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 Vcommand_history
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 = Fcons (Fcons (function, values), Vcommand_history);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 single_console_state ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 RETURN_UNGCPRO (apply1 (fun, specs));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 /* Here if function specifies a string to control parsing the defaults */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 /* Translate interactive prompt. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 if (STRINGP (specs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 Lisp_Object domain = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 if (NILP (domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 specs = Fgettext (specs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 specs = Fdgettext (domain, specs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 else if (prompt_data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 /* We do not have to worry about domains in this case because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 prompt_data is non-nil only for built-in functions, which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 always use the default domain. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 prompt_data = gettext (prompt_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 /* Handle special starting chars `*' and `@' and `_'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 /* Note that `+' is reserved for user extensions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 prompt_index = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 GCPRO2 (function, specs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 if (STRINGP (specs))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
472 prompt_data = (const char *) XSTRING_DATA (specs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 if (prompt_data[prompt_index] == '+')
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
475 syntax_error ("`+' is not used in `interactive' for ordinary commands", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 else if (prompt_data[prompt_index] == '*')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 prompt_index++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 if (!NILP (current_buffer->read_only))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 barf_if_buffer_read_only (current_buffer, -1, -1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 else if (prompt_data[prompt_index] == '@')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 prompt_index++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 if (!NILP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 event = extract_vector_nth_mouse_event (keys, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 event = extract_this_command_keys_nth_mouse_event (0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 /* Doesn't work; see below */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 event = Vcurrent_mouse_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 if (! NILP (event))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 Lisp_Object window = Fevent_window (event);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 if (!NILP (window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 if (MINI_WINDOW_P (XWINDOW (window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 && ! (minibuf_level > 0 && EQ (window,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 minibuf_window)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
504 invalid_operation ("Attempt to select inactive minibuffer window", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 #if 0 /* unclean! see event-stream.c */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 /* If the current buffer wants to clean up, let it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 if (!NILP (Vmouse_leave_buffer_hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 run_hook (Qmouse_leave_buffer_hook);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 Fselect_window (window, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 else if (prompt_data[prompt_index] == '_')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 prompt_index++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 set_zmacs_region_stays = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 /* Count the number of arguments the interactive spec would have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 us give to the function. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 argcount = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
533 const char *tem;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 for (tem = prompt_data + prompt_index; *tem; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 /* 'r' specifications ("point and mark as 2 numeric args")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 produce *two* arguments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 if (*tem == 'r')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 argcount += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 argcount += 1;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
542 tem = (const char *) strchr (tem + 1, '\n');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 if (!tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 tem++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 #ifdef IT_SEEMS_THAT_MLY_DOESNT_LIKE_THIS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 if (!NILP (enable))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 specbind (Qenable_recursive_minibuffers, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 if (argcount == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 /* Interactive function or no arguments; just call it */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 if (EQ (record_flag, Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 if (!NILP (record_flag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 Vcommand_history = Fcons (list1 (function), Vcommand_history);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 specbind (Qcommand_debug_status, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 /* XEmacs: was fun = call0 (fun), but that's backtraced wrong */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 GCPRO1 (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 fun = Ffuncall (1, &fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 if (set_zmacs_region_stays)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 zmacs_region_stays = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
574 return unbind_to_1 (speccount, fun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 /* Read interactive arguments */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 /* args[-1] is the function to call */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 /* args[n] is the n'th argument to the function */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 int alloca_size = (1 /* function to call */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 + argcount /* actual arguments */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 + argcount /* visargs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 + argcount /* varies */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 Lisp_Object *args = alloca_array (Lisp_Object, alloca_size) + 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 /* visargs is an array of either Qnil or user-friendlier versions (often
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 * strings) of previous arguments, to use in prompts for successive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 * arguments. ("Often strings" because emacs didn't used to have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 * format %S and prin1-to-string.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 Lisp_Object *visargs = args + argcount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 /* If varies[i] is non-null, the i'th argument shouldn't just have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 its value in this call quoted in the command history. It should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 recorded as a call to the function named varies[i]]. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 Lisp_Object *varies = visargs + argcount;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 int arg_from_tty = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 REGISTER int argnum;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 args[-1] = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 for (argnum = 0; argnum < alloca_size - 1; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 args[argnum] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 /* Must GC-protect args[-1] (ie function) because Ffuncall doesn't */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 /* `function' itself isn't GC-protected -- use args[-1] from here
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (actually, doesn't matter since Emacs GC doesn't relocate, sigh) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 GCPRO2 (prefix, args[-1]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 gcpro2.nvars = alloca_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 for (argnum = 0; ; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
612 const char *prompt_start = prompt_data + prompt_index + 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
613 const char *prompt_limit = (const char *) strchr (prompt_start, '\n');
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 int prompt_length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 prompt_length = ((prompt_limit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 ? (prompt_limit - prompt_start)
664
6e99cc8c6ca5 [xemacs-hg @ 2001-09-18 05:04:26 by ben]
ben
parents: 563
diff changeset
617 : (int) strlen (prompt_start));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 if (prompt_limit && prompt_limit[1] == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 prompt_limit = 0; /* "sfoo:\n" -- strip tailing return */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 prompt_length -= 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 /* This uses `visargs' instead of `args' so that global-set-key
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 prompts with "Set key C-x C-f to command: "instead of printing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 event objects in there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 853
diff changeset
627 #define PROMPT() callint_prompt ((const Ibyte *) prompt_start, prompt_length, visargs, argnum)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 switch (prompt_data[prompt_index])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 case 'a': /* Symbol defined as a function */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 Lisp_Object tem = call1 (Qread_function, PROMPT ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 args[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 case 'b': /* Name of existing buffer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 Lisp_Object def = Fcurrent_buffer ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 if (EQ (Fselected_window (Qnil), minibuf_window))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 def = Fother_buffer (def, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 /* read-buffer returns a buffer name, not a buffer! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 args[argnum] = call3 (Qread_buffer, PROMPT (), def,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 case 'B': /* Name of buffer, possibly nonexistent */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 /* read-buffer returns a buffer name, not a buffer! */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 args[argnum] = call2 (Qread_buffer, PROMPT (),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 Fother_buffer (Fcurrent_buffer (), Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 Qnil));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 case 'c': /* Character */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 int shadowing_speccount = specpdl_depth ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 specbind (Qcursor_in_echo_area, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 message ("%s", XSTRING_DATA (PROMPT ()));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 tem = (call0 (Qread_char));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 args[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 /* visargs[argnum] = Fsingle_key_description (tem); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 /* FSF has visargs[argnum] = Fchar_to_string (tem); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
669 unbind_to (shadowing_speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 /* #### `C-x / a' should not leave the prompt in the minibuffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 This isn't the right fix, because (message ...) (read-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 shouldn't leave the message there either... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 clear_message ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 case 'C': /* Command: symbol with interactive function */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 Lisp_Object tem = call1 (Qread_command, PROMPT ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 args[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 case 'd': /* Value of point. Does not do I/O. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 args[argnum] = Fcopy_marker (current_buffer->point_marker, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 varies[argnum] = Qpoint;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 case 'e':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 Lisp_Object event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 if (!NILP (keys))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 event = extract_vector_nth_mouse_event (keys,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 mouse_event_count);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 /* This doesn't quite work because this-command-keys
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 behaves in utterly counterintuitive ways. Sometimes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 it retrieves an event back in the future, e.g. when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 one command invokes another command and both are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 invoked with the mouse. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 event = (extract_this_command_keys_nth_mouse_event
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 (mouse_event_count));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 event = Vcurrent_mouse_event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 if (NILP (event))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
713 signal_error (Qinvalid_operation,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
714 "function must be bound to a mouse or misc-user event",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
715 function);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 args[argnum] = event;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 mouse_event_count++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 case 'D': /* Directory name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 args[argnum] = call4 (Qread_directory_name, PROMPT (),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 Qnil, /* dir */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 current_buffer->directory, /* default */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 Qt /* must-match */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 case 'f': /* Existing file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 Lisp_Object tem = call4 (Qread_file_name, PROMPT (),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 Qnil, /* dir */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 Qnil, /* default */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 Qzero /* must-match */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 args[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 case 'F': /* Possibly nonexistent file name. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 args[argnum] = call4 (Qread_file_name, PROMPT (),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 Qnil, /* dir */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 Qnil, /* default */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 Qnil /* must-match */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 case 'i': /* Ignore: always nil. Use to skip arguments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 args[argnum] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 case 'k': /* Key sequence (vector of events) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 Lisp_Object key_prompt = PROMPT ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 NGCPRO1(key_prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 tem = Fread_key_sequence (key_prompt, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 visargs[argnum] = Fkey_description (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 /* The following makes `describe-key' not work with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 extent-local keymaps and such; and anyway, it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 contrary to the documentation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 /* args[argnum] = call1 (Qevents_to_keys, tem); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 args[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 case 'K': /* Key sequence (vector of events),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 no automatic downcasing */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 struct gcpro ngcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 Lisp_Object key_prompt = PROMPT ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 NGCPRO1(key_prompt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 tem = Fread_key_sequence (key_prompt, Qnil, Qt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 NUNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 visargs[argnum] = Fkey_description (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 /* The following makes `describe-key' not work with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 extent-local keymaps and such; and anyway, it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 contrary to the documentation. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 /* args[argnum] = call1 (Qevents_to_keys, tem); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 args[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 case 'm': /* Value of mark. Does not do I/O. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 args[argnum] = current_buffer->mark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 varies[argnum] = Qmark;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 case 'n': /* Read number from minibuffer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 read_number:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 args[argnum] = call2 (Qread_number, PROMPT (), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 /* numbers are too boring to go on command history */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 /* arg_from_tty = 1; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 case 'N': /* Prefix arg, else number from minibuffer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 if (NILP (prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 goto read_number;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 goto prefix_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 case 'P': /* Prefix arg in raw form. Does no I/O. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 args[argnum] = prefix;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 case 'p': /* Prefix arg converted to number. No I/O. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 prefix_value:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 Lisp_Object tem = Fprefix_numeric_value (prefix);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 args[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 case 'r': /* Region, point and mark as 2 args. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 664
diff changeset
833 Charbpos tem = check_mark ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 args[argnum] = (BUF_PT (current_buffer) < tem
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 ? Fcopy_marker (current_buffer->point_marker, Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 : current_buffer->mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 varies[argnum] = Qregion_beginning;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 args[++argnum] = (BUF_PT (current_buffer) > tem
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 ? Fcopy_marker (current_buffer->point_marker,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 Qt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 : current_buffer->mark);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 varies[argnum] = Qregion_end;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 case 's': /* String read via minibuffer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 args[argnum] = call1 (Qread_string, PROMPT ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 case 'S': /* Any symbol. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 visargs[argnum] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 for (;;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 Lisp_Object tem = call5 (Qcompleting_read,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 PROMPT (),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 Vobarray,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 /* nil, or prev attempt */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 visargs[argnum]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 visargs[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 /* I could use condition-case with this loser, but why bother?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 * tem = Fread (tem); check-symbol-p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 tem = Fintern (tem, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 args[argnum] = tem;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
869 if (XSTRING_LENGTH (XSYMBOL (tem)->name) > 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 /* Don't accept the empty-named symbol. If the loser
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 really wants this s/he can call completing-read
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 directly */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 case 'v': /* Variable name: user-variable-p symbol */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 Lisp_Object tem = call1 (Qread_variable, PROMPT ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 args[argnum] = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 case 'x': /* Lisp expression read but not evaluated */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 args[argnum] = call1 (Qread_expression, PROMPT ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 /* visargs[argnum] = Fprin1_to_string (args[argnum], Qnil); */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 case 'X': /* Lisp expression read and evaluated */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 Lisp_Object tem = call1 (Qread_expression, PROMPT ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 /* visargs[argnum] = Fprin1_to_string (tem, Qnil); */
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4654
diff changeset
896 args[argnum] = IGNORE_MULTIPLE_VALUES (Feval (tem));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 case 'Z': /* Coding-system symbol or nil if no prefix */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 if (NILP (prefix))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 args[argnum] = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 args[argnum] =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 call1 (Qread_non_nil_coding_system, PROMPT ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 case 'z': /* Coding-system symbol */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 args[argnum] = call1 (Qread_coding_system, PROMPT ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 arg_from_tty = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 /* We have a case for `+' so we get an error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 if anyone tries to define one here. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 case '+':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 793
diff changeset
926 signal_ferror
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 793
diff changeset
927 (Qsyntax_error,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 793
diff changeset
928 "Invalid `interactive' control letter \"%c\" (#o%03o).",
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 793
diff changeset
929 prompt_data[prompt_index], prompt_data[prompt_index]);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 #undef PROMPT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 if (NILP (visargs[argnum]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 visargs[argnum] = args[argnum];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 if (!prompt_limit)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 if (STRINGP (specs))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 prompt_data = (const char *) XSTRING_DATA (specs);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 prompt_index += prompt_length + 1 + 1; /* +1 to skip spec, +1 for \n */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
942 unbind_to (speccount);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 if (EQ (record_flag, Qlambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 RETURN_UNGCPRO (Flist (argcount, args));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 if (arg_from_tty || !NILP (record_flag))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 /* Reuse visargs as a temporary for constructing the command history */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 for (argnum = 0; argnum < argcount; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 if (!NILP (varies[argnum]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 visargs[argnum] = list1 (varies[argnum]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 visargs[argnum] = Fquote_maybe (args[argnum]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 Vcommand_history = Fcons (Fcons (args[-1], Flist (argcount, visargs)),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 Vcommand_history);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 /* If we used a marker to hold point, mark, or an end of the region,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 temporarily, convert it to an integer now. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 for (argnum = 0; argnum < argcount; argnum++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 if (!NILP (varies[argnum]))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5402
diff changeset
969 args[argnum] = make_fixnum (marker_position (args[argnum]));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 single_console_state ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 specbind (Qcommand_debug_status, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 fun = Ffuncall (argcount + 1, args - 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 if (set_zmacs_region_stays)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 zmacs_region_stays = 1;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
977 return unbind_to_1 (speccount, fun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 DEFUN ("prefix-numeric-value", Fprefix_numeric_value, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
982 Return numeric meaning of raw prefix argument RAW.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 A raw prefix argument is what you get from `(interactive "P")'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 Its numeric meaning is what you would get from `(interactive "p")'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 (raw))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 if (NILP (raw))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5402
diff changeset
989 return make_fixnum (1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 if (EQ (raw, Qminus))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5402
diff changeset
991 return make_fixnum (-1);
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5402
diff changeset
992 if (FIXNUMP (raw))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 return raw;
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5402
diff changeset
994 if (CONSP (raw) && FIXNUMP (XCAR (raw)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 return XCAR (raw);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5402
diff changeset
997 return make_fixnum (1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 syms_of_callint (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1003 DEFSYMBOL (Qcall_interactively);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1004 DEFSYMBOL (Qread_from_minibuffer);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1005 DEFSYMBOL (Qcompleting_read);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1006 DEFSYMBOL (Qread_file_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1007 DEFSYMBOL (Qread_directory_name);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1008 DEFSYMBOL (Qread_string);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1009 DEFSYMBOL (Qread_buffer);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1010 DEFSYMBOL (Qread_variable);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1011 DEFSYMBOL (Qread_function);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1012 DEFSYMBOL (Qread_command);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1013 DEFSYMBOL (Qread_number);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1014 DEFSYMBOL (Qread_expression);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1015 DEFSYMBOL (Qread_coding_system);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1016 DEFSYMBOL (Qread_non_nil_coding_system);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1017 DEFSYMBOL (Qevents_to_keys);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1018 DEFSYMBOL (Qcommand_debug_status);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1019 DEFSYMBOL (Qenable_recursive_minibuffers);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 defsymbol (&QletX, "let*");
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1022 DEFSYMBOL (Qsave_excursion);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 #if 0 /* ill-conceived */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 502
diff changeset
1024 DEFSYMBOL (Qmouse_leave_buffer_hook);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 DEFSUBR (Finteractive);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 DEFSUBR (Fcall_interactively);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 DEFSUBR (Fprefix_numeric_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 vars_of_callint (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 DEFVAR_LISP ("current-prefix-arg", &Vcurrent_prefix_arg /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 The value of the prefix argument for this editing command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 It may be a number, or the symbol `-' for just a minus sign as arg,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 or a list whose car is a number for just one or more C-U's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 or nil if no argument has been specified.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 This is what `(interactive "P")' returns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 Vcurrent_prefix_arg = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 DEFVAR_LISP ("command-history", &Vcommand_history /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 List of recent commands that read arguments from terminal.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 Each command is represented as a form to evaluate.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 Vcommand_history = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 DEFVAR_LISP ("command-debug-status", &Vcommand_debug_status /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 Debugging status of current interactive command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 Bound each time `call-interactively' is called;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 may be set by the debugger as a reminder for itself.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 Vcommand_debug_status = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 xxDEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 *Non-nil means you can use the mark even when inactive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 This option makes a difference in Transient Mark mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 When the option is non-nil, deactivation of the mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 turns off region highlighting, but commands that use the mark
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 behave as if the mark were still active.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 Vmark_even_if_inactive = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 #if 0 /* Doesn't work and is totally ill-conceived anyway. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 xxDEFVAR_LISP ("mouse-leave-buffer-hook", &Vmouse_leave_buffer_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 Hook to run when about to switch windows with a mouse command.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 Its purpose is to give temporary modes such as Isearch mode
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 a way to turn themselves off when a mouse command switches windows.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 Vmouse_leave_buffer_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 }