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