diff options
| author | Stefan Monnier | 2010-12-15 12:46:59 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2010-12-15 12:46:59 -0500 |
| commit | a0ee6f2751acba71df443d4d795bb350eb6421dd (patch) | |
| tree | e4f47d66877b1b00b9ce00a304b509dee840868a | |
| parent | defb141157dfa37c33cdcbfa4b29c702a8fc9edf (diff) | |
| download | emacs-a0ee6f2751acba71df443d4d795bb350eb6421dd.tar.gz emacs-a0ee6f2751acba71df443d4d795bb350eb6421dd.zip | |
Obey lexical-binding in interactive evaluation commands.
* lisp/emacs-lisp/edebug.el (edebug-eval-defun, edebug-eval):
* lisp/emacs-lisp/lisp-mode.el (eval-last-sexp-1, eval-defun-1):
* lisp/ielm.el (ielm-eval-input):
* lisp/simple.el (eval-expression): Use new eval arg to obey lexical-binding.
* src/eval.c (Feval): Add `lexical' argument. Adjust callers.
(Ffuncall, eval_sub): Avoid goto.
| -rw-r--r-- | lisp/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 17 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 26 | ||||
| -rw-r--r-- | lisp/ielm.el | 3 | ||||
| -rw-r--r-- | lisp/simple.el | 4 | ||||
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/bytecode.c | 2 | ||||
| -rw-r--r-- | src/callint.c | 2 | ||||
| -rw-r--r-- | src/doc.c | 2 | ||||
| -rw-r--r-- | src/eval.c | 267 | ||||
| -rw-r--r-- | src/keyboard.c | 12 | ||||
| -rw-r--r-- | src/lisp.h | 2 | ||||
| -rw-r--r-- | src/minibuf.c | 4 |
13 files changed, 184 insertions, 169 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 053eb95329c..87794ceb5d2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,10 @@ | |||
| 1 | 2010-12-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/edebug.el (edebug-eval-defun, edebug-eval): | ||
| 4 | * emacs-lisp/lisp-mode.el (eval-last-sexp-1, eval-defun-1): | ||
| 5 | * ielm.el (ielm-eval-input): | ||
| 6 | * simple.el (eval-expression): Use new eval arg to obey lexical-binding. | ||
| 7 | |||
| 1 | 2010-12-14 Stefan Monnier <monnier@iro.umontreal.ca> | 8 | 2010-12-14 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 9 | ||
| 3 | * emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push. | 10 | * emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push. |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 77953b37021..4dfccb4c5b4 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -521,7 +521,7 @@ the minibuffer." | |||
| 521 | ((and (eq (car form) 'defcustom) | 521 | ((and (eq (car form) 'defcustom) |
| 522 | (default-boundp (nth 1 form))) | 522 | (default-boundp (nth 1 form))) |
| 523 | ;; Force variable to be bound. | 523 | ;; Force variable to be bound. |
| 524 | (set-default (nth 1 form) (eval (nth 2 form)))) | 524 | (set-default (nth 1 form) (eval (nth 2 form) lexical-binding))) |
| 525 | ((eq (car form) 'defface) | 525 | ((eq (car form) 'defface) |
| 526 | ;; Reset the face. | 526 | ;; Reset the face. |
| 527 | (setq face-new-frame-defaults | 527 | (setq face-new-frame-defaults |
| @@ -534,7 +534,7 @@ the minibuffer." | |||
| 534 | (put ',(nth 1 form) 'customized-face | 534 | (put ',(nth 1 form) 'customized-face |
| 535 | ,(nth 2 form))) | 535 | ,(nth 2 form))) |
| 536 | (put (nth 1 form) 'saved-face nil))))) | 536 | (put (nth 1 form) 'saved-face nil))))) |
| 537 | (setq edebug-result (eval form)) | 537 | (setq edebug-result (eval form lexical-binding)) |
| 538 | (if (not edebugging) | 538 | (if (not edebugging) |
| 539 | (princ edebug-result) | 539 | (princ edebug-result) |
| 540 | edebug-result))) | 540 | edebug-result))) |
| @@ -2466,6 +2466,7 @@ MSG is printed after `::::} '." | |||
| 2466 | (if edebug-global-break-condition | 2466 | (if edebug-global-break-condition |
| 2467 | (condition-case nil | 2467 | (condition-case nil |
| 2468 | (setq edebug-global-break-result | 2468 | (setq edebug-global-break-result |
| 2469 | ;; FIXME: lexbind. | ||
| 2469 | (eval edebug-global-break-condition)) | 2470 | (eval edebug-global-break-condition)) |
| 2470 | (error nil)))) | 2471 | (error nil)))) |
| 2471 | (edebug-break)) | 2472 | (edebug-break)) |
| @@ -2477,6 +2478,7 @@ MSG is printed after `::::} '." | |||
| 2477 | (and edebug-break-data | 2478 | (and edebug-break-data |
| 2478 | (or (not edebug-break-condition) | 2479 | (or (not edebug-break-condition) |
| 2479 | (setq edebug-break-result | 2480 | (setq edebug-break-result |
| 2481 | ;; FIXME: lexbind. | ||
| 2480 | (eval edebug-break-condition)))))) | 2482 | (eval edebug-break-condition)))))) |
| 2481 | (if (and edebug-break | 2483 | (if (and edebug-break |
| 2482 | (nth 2 edebug-break-data)) ; is it temporary? | 2484 | (nth 2 edebug-break-data)) ; is it temporary? |
| @@ -3637,9 +3639,10 @@ Return the result of the last expression." | |||
| 3637 | 3639 | ||
| 3638 | (defun edebug-eval (edebug-expr) | 3640 | (defun edebug-eval (edebug-expr) |
| 3639 | ;; Are there cl lexical variables active? | 3641 | ;; Are there cl lexical variables active? |
| 3640 | (if (bound-and-true-p cl-debug-env) | 3642 | (eval (if (bound-and-true-p cl-debug-env) |
| 3641 | (eval (cl-macroexpand-all edebug-expr cl-debug-env)) | 3643 | (cl-macroexpand-all edebug-expr cl-debug-env) |
| 3642 | (eval edebug-expr))) | 3644 | edebug-expr) |
| 3645 | lexical-binding)) ;; FIXME: lexbind. | ||
| 3643 | 3646 | ||
| 3644 | (defun edebug-safe-eval (edebug-expr) | 3647 | (defun edebug-safe-eval (edebug-expr) |
| 3645 | ;; Evaluate EXPR safely. | 3648 | ;; Evaluate EXPR safely. |
| @@ -4241,8 +4244,8 @@ It is removed when you hit any char." | |||
| 4241 | ;;; Menus | 4244 | ;;; Menus |
| 4242 | 4245 | ||
| 4243 | (defun edebug-toggle (variable) | 4246 | (defun edebug-toggle (variable) |
| 4244 | (set variable (not (eval variable))) | 4247 | (set variable (not (symbol-value variable))) |
| 4245 | (message "%s: %s" variable (eval variable))) | 4248 | (message "%s: %s" variable (symbol-value variable))) |
| 4246 | 4249 | ||
| 4247 | ;; We have to require easymenu (even for Emacs 18) just so | 4250 | ;; We have to require easymenu (even for Emacs 18) just so |
| 4248 | ;; the easy-menu-define macro call is compiled correctly. | 4251 | ;; the easy-menu-define macro call is compiled correctly. |
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index c90d1394978..2cdbd115928 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el | |||
| @@ -699,16 +699,9 @@ If CHAR is not a character, return nil." | |||
| 699 | (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) | 699 | (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) |
| 700 | "Evaluate sexp before point; print value in minibuffer. | 700 | "Evaluate sexp before point; print value in minibuffer. |
| 701 | With argument, print output into current buffer." | 701 | With argument, print output into current buffer." |
| 702 | (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)) | 702 | (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) |
| 703 | ;; preserve the current lexical environment | ||
| 704 | (internal-interpreter-environment internal-interpreter-environment)) | ||
| 705 | ;; Setup the lexical environment if lexical-binding is enabled. | 703 | ;; Setup the lexical environment if lexical-binding is enabled. |
| 706 | ;; Note that `internal-interpreter-environment' _can't_ be both | 704 | (eval-last-sexp-print-value (eval (preceding-sexp) lexical-binding)))) |
| 707 | ;; assigned and let-bound above -- it's treated specially (and | ||
| 708 | ;; oddly) by the interpreter! | ||
| 709 | (when lexical-binding | ||
| 710 | (setq internal-interpreter-environment '(t))) | ||
| 711 | (eval-last-sexp-print-value (eval (preceding-sexp))))) | ||
| 712 | 705 | ||
| 713 | 706 | ||
| 714 | (defun eval-last-sexp-print-value (value) | 707 | (defun eval-last-sexp-print-value (value) |
| @@ -772,16 +765,18 @@ Reinitialize the face according to the `defface' specification." | |||
| 772 | ;; `defcustom' is now macroexpanded to | 765 | ;; `defcustom' is now macroexpanded to |
| 773 | ;; `custom-declare-variable' with a quoted value arg. | 766 | ;; `custom-declare-variable' with a quoted value arg. |
| 774 | ((and (eq (car form) 'custom-declare-variable) | 767 | ((and (eq (car form) 'custom-declare-variable) |
| 775 | (default-boundp (eval (nth 1 form)))) | 768 | (default-boundp (eval (nth 1 form) lexical-binding))) |
| 776 | ;; Force variable to be bound. | 769 | ;; Force variable to be bound. |
| 777 | (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form)))) | 770 | (set-default (eval (nth 1 form) lexical-binding) |
| 771 | (eval (nth 1 (nth 2 form)) lexical-binding)) | ||
| 778 | form) | 772 | form) |
| 779 | ;; `defface' is macroexpanded to `custom-declare-face'. | 773 | ;; `defface' is macroexpanded to `custom-declare-face'. |
| 780 | ((eq (car form) 'custom-declare-face) | 774 | ((eq (car form) 'custom-declare-face) |
| 781 | ;; Reset the face. | 775 | ;; Reset the face. |
| 782 | (setq face-new-frame-defaults | 776 | (setq face-new-frame-defaults |
| 783 | (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults)) | 777 | (assq-delete-all (eval (nth 1 form) lexical-binding) |
| 784 | (put (eval (nth 1 form)) 'face-defface-spec nil) | 778 | face-new-frame-defaults)) |
| 779 | (put (eval (nth 1 form) lexical-binding) 'face-defface-spec nil) | ||
| 785 | ;; Setting `customized-face' to the new spec after calling | 780 | ;; Setting `customized-face' to the new spec after calling |
| 786 | ;; the form, but preserving the old saved spec in `saved-face', | 781 | ;; the form, but preserving the old saved spec in `saved-face', |
| 787 | ;; imitates the situation when the new face spec is set | 782 | ;; imitates the situation when the new face spec is set |
| @@ -792,10 +787,11 @@ Reinitialize the face according to the `defface' specification." | |||
| 792 | ;; `defface' change the spec, regardless of a saved spec. | 787 | ;; `defface' change the spec, regardless of a saved spec. |
| 793 | (prog1 `(prog1 ,form | 788 | (prog1 `(prog1 ,form |
| 794 | (put ,(nth 1 form) 'saved-face | 789 | (put ,(nth 1 form) 'saved-face |
| 795 | ',(get (eval (nth 1 form)) 'saved-face)) | 790 | ',(get (eval (nth 1 form) lexical-binding) |
| 791 | 'saved-face)) | ||
| 796 | (put ,(nth 1 form) 'customized-face | 792 | (put ,(nth 1 form) 'customized-face |
| 797 | ,(nth 2 form))) | 793 | ,(nth 2 form))) |
| 798 | (put (eval (nth 1 form)) 'saved-face nil))) | 794 | (put (eval (nth 1 form) lexical-binding) 'saved-face nil))) |
| 799 | ((eq (car form) 'progn) | 795 | ((eq (car form) 'progn) |
| 800 | (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) | 796 | (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) |
| 801 | (t form))) | 797 | (t form))) |
diff --git a/lisp/ielm.el b/lisp/ielm.el index 40e87cd6709..e1f8dc78d32 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el | |||
| @@ -372,7 +372,8 @@ simply inserts a newline." | |||
| 372 | (*** *3)) | 372 | (*** *3)) |
| 373 | (kill-buffer (current-buffer)) | 373 | (kill-buffer (current-buffer)) |
| 374 | (set-buffer ielm-wbuf) | 374 | (set-buffer ielm-wbuf) |
| 375 | (setq ielm-result (eval ielm-form)) | 375 | (setq ielm-result |
| 376 | (eval ielm-form lexical-binding)) | ||
| 376 | (setq ielm-wbuf (current-buffer)) | 377 | (setq ielm-wbuf (current-buffer)) |
| 377 | (setq | 378 | (setq |
| 378 | ielm-temp-buffer | 379 | ielm-temp-buffer |
diff --git a/lisp/simple.el b/lisp/simple.el index da8ac55c01d..a977be7cf8e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -1212,12 +1212,12 @@ this command arranges for all errors to enter the debugger." | |||
| 1212 | current-prefix-arg)) | 1212 | current-prefix-arg)) |
| 1213 | 1213 | ||
| 1214 | (if (null eval-expression-debug-on-error) | 1214 | (if (null eval-expression-debug-on-error) |
| 1215 | (setq values (cons (eval eval-expression-arg) values)) | 1215 | (push (eval eval-expression-arg lexical-binding) values) |
| 1216 | (let ((old-value (make-symbol "t")) new-value) | 1216 | (let ((old-value (make-symbol "t")) new-value) |
| 1217 | ;; Bind debug-on-error to something unique so that we can | 1217 | ;; Bind debug-on-error to something unique so that we can |
| 1218 | ;; detect when evaled code changes it. | 1218 | ;; detect when evaled code changes it. |
| 1219 | (let ((debug-on-error old-value)) | 1219 | (let ((debug-on-error old-value)) |
| 1220 | (setq values (cons (eval eval-expression-arg) values)) | 1220 | (push (eval eval-expression-arg lexical-binding) values) |
| 1221 | (setq new-value debug-on-error)) | 1221 | (setq new-value debug-on-error)) |
| 1222 | ;; If evaled code has changed the value of debug-on-error, | 1222 | ;; If evaled code has changed the value of debug-on-error, |
| 1223 | ;; propagate that change to the global binding. | 1223 | ;; propagate that change to the global binding. |
diff --git a/src/ChangeLog b/src/ChangeLog index c333b6388c6..2de6a5ed66c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2010-12-15 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * eval.c (Feval): Add `lexical' argument. Adjust callers. | ||
| 4 | (Ffuncall, eval_sub): Avoid goto. | ||
| 5 | |||
| 1 | 2010-12-14 Stefan Monnier <monnier@iro.umontreal.ca> | 6 | 2010-12-14 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 7 | ||
| 3 | Try and be more careful about propagation of lexical environment. | 8 | Try and be more careful about propagation of lexical environment. |
diff --git a/src/bytecode.c b/src/bytecode.c index 01fce0577b0..eb12b9c4963 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -915,7 +915,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 915 | Lisp_Object v1; | 915 | Lisp_Object v1; |
| 916 | BEFORE_POTENTIAL_GC (); | 916 | BEFORE_POTENTIAL_GC (); |
| 917 | v1 = POP; | 917 | v1 = POP; |
| 918 | TOP = internal_catch (TOP, Feval, v1); /* FIXME: lexbind */ | 918 | TOP = internal_catch (TOP, eval_sub, v1); /* FIXME: lexbind */ |
| 919 | AFTER_POTENTIAL_GC (); | 919 | AFTER_POTENTIAL_GC (); |
| 920 | break; | 920 | break; |
| 921 | } | 921 | } |
diff --git a/src/callint.c b/src/callint.c index 960158029c3..5eb65b31cbf 100644 --- a/src/callint.c +++ b/src/callint.c | |||
| @@ -342,7 +342,7 @@ invoke it. If KEYS is omitted or nil, the return value of | |||
| 342 | input = specs; | 342 | input = specs; |
| 343 | /* Compute the arg values using the user's expression. */ | 343 | /* Compute the arg values using the user's expression. */ |
| 344 | GCPRO2 (input, filter_specs); | 344 | GCPRO2 (input, filter_specs); |
| 345 | specs = Feval (specs); /* FIXME: lexbind */ | 345 | specs = Feval (specs, Qnil); /* FIXME: lexbind */ |
| 346 | UNGCPRO; | 346 | UNGCPRO; |
| 347 | if (i != num_input_events || !NILP (record_flag)) | 347 | if (i != num_input_events || !NILP (record_flag)) |
| 348 | { | 348 | { |
| @@ -490,7 +490,7 @@ aren't strings. */) | |||
| 490 | } | 490 | } |
| 491 | else if (!STRINGP (tem)) | 491 | else if (!STRINGP (tem)) |
| 492 | /* Feval protects its argument. */ | 492 | /* Feval protects its argument. */ |
| 493 | tem = Feval (tem); | 493 | tem = Feval (tem, Qnil); |
| 494 | 494 | ||
| 495 | if (NILP (raw) && STRINGP (tem)) | 495 | if (NILP (raw) && STRINGP (tem)) |
| 496 | tem = Fsubstitute_command_keys (tem); | 496 | tem = Fsubstitute_command_keys (tem); |
diff --git a/src/eval.c b/src/eval.c index 485ba00c1e4..7104a8a8396 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -2311,12 +2311,14 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname) | |||
| 2311 | } | 2311 | } |
| 2312 | 2312 | ||
| 2313 | 2313 | ||
| 2314 | DEFUN ("eval", Feval, Seval, 1, 1, 0, | 2314 | DEFUN ("eval", Feval, Seval, 1, 2, 0, |
| 2315 | doc: /* Evaluate FORM and return its value. */) | 2315 | doc: /* Evaluate FORM and return its value. |
| 2316 | (Lisp_Object form) | 2316 | If LEXICAL is t, evaluate using lexical scoping. */) |
| 2317 | (Lisp_Object form, Lisp_Object lexical) | ||
| 2317 | { | 2318 | { |
| 2318 | int count = SPECPDL_INDEX (); | 2319 | int count = SPECPDL_INDEX (); |
| 2319 | specbind (Qinternal_interpreter_environment, Qnil); | 2320 | specbind (Qinternal_interpreter_environment, |
| 2321 | NILP (lexical) ? Qnil : Fcons (Qt, Qnil)); | ||
| 2320 | return unbind_to (count, eval_sub (form)); | 2322 | return unbind_to (count, eval_sub (form)); |
| 2321 | } | 2323 | } |
| 2322 | 2324 | ||
| @@ -2414,10 +2416,8 @@ eval_sub (Lisp_Object form) | |||
| 2414 | { | 2416 | { |
| 2415 | backtrace.evalargs = 0; | 2417 | backtrace.evalargs = 0; |
| 2416 | val = (XSUBR (fun)->function.aUNEVALLED) (args_left); | 2418 | val = (XSUBR (fun)->function.aUNEVALLED) (args_left); |
| 2417 | goto done; | ||
| 2418 | } | 2419 | } |
| 2419 | 2420 | else if (XSUBR (fun)->max_args == MANY) | |
| 2420 | if (XSUBR (fun)->max_args == MANY) | ||
| 2421 | { | 2421 | { |
| 2422 | /* Pass a vector of evaluated arguments */ | 2422 | /* Pass a vector of evaluated arguments */ |
| 2423 | Lisp_Object *vals; | 2423 | Lisp_Object *vals; |
| @@ -2443,73 +2443,74 @@ eval_sub (Lisp_Object form) | |||
| 2443 | val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); | 2443 | val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); |
| 2444 | UNGCPRO; | 2444 | UNGCPRO; |
| 2445 | SAFE_FREE (); | 2445 | SAFE_FREE (); |
| 2446 | goto done; | ||
| 2447 | } | 2446 | } |
| 2448 | 2447 | else | |
| 2449 | GCPRO3 (args_left, fun, fun); | ||
| 2450 | gcpro3.var = argvals; | ||
| 2451 | gcpro3.nvars = 0; | ||
| 2452 | |||
| 2453 | maxargs = XSUBR (fun)->max_args; | ||
| 2454 | for (i = 0; i < maxargs; args_left = Fcdr (args_left)) | ||
| 2455 | { | 2448 | { |
| 2456 | argvals[i] = eval_sub (Fcar (args_left)); | 2449 | GCPRO3 (args_left, fun, fun); |
| 2457 | gcpro3.nvars = ++i; | 2450 | gcpro3.var = argvals; |
| 2458 | } | 2451 | gcpro3.nvars = 0; |
| 2459 | 2452 | ||
| 2460 | UNGCPRO; | 2453 | maxargs = XSUBR (fun)->max_args; |
| 2454 | for (i = 0; i < maxargs; args_left = Fcdr (args_left)) | ||
| 2455 | { | ||
| 2456 | argvals[i] = eval_sub (Fcar (args_left)); | ||
| 2457 | gcpro3.nvars = ++i; | ||
| 2458 | } | ||
| 2459 | |||
| 2460 | UNGCPRO; | ||
| 2461 | 2461 | ||
| 2462 | backtrace.args = argvals; | 2462 | backtrace.args = argvals; |
| 2463 | backtrace.nargs = XINT (numargs); | 2463 | backtrace.nargs = XINT (numargs); |
| 2464 | 2464 | ||
| 2465 | switch (i) | 2465 | switch (i) |
| 2466 | { | 2466 | { |
| 2467 | case 0: | 2467 | case 0: |
| 2468 | val = (XSUBR (fun)->function.a0) (); | 2468 | val = (XSUBR (fun)->function.a0) (); |
| 2469 | goto done; | 2469 | break; |
| 2470 | case 1: | 2470 | case 1: |
| 2471 | val = (XSUBR (fun)->function.a1) (argvals[0]); | 2471 | val = (XSUBR (fun)->function.a1) (argvals[0]); |
| 2472 | goto done; | 2472 | break; |
| 2473 | case 2: | 2473 | case 2: |
| 2474 | val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); | 2474 | val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); |
| 2475 | goto done; | 2475 | break; |
| 2476 | case 3: | 2476 | case 3: |
| 2477 | val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], | 2477 | val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], |
| 2478 | argvals[2]); | 2478 | argvals[2]); |
| 2479 | goto done; | 2479 | break; |
| 2480 | case 4: | 2480 | case 4: |
| 2481 | val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], | 2481 | val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], |
| 2482 | argvals[2], argvals[3]); | 2482 | argvals[2], argvals[3]); |
| 2483 | goto done; | 2483 | break; |
| 2484 | case 5: | 2484 | case 5: |
| 2485 | val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], | 2485 | val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], |
| 2486 | argvals[3], argvals[4]); | 2486 | argvals[3], argvals[4]); |
| 2487 | goto done; | 2487 | break; |
| 2488 | case 6: | 2488 | case 6: |
| 2489 | val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], | 2489 | val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], |
| 2490 | argvals[3], argvals[4], argvals[5]); | 2490 | argvals[3], argvals[4], argvals[5]); |
| 2491 | goto done; | 2491 | break; |
| 2492 | case 7: | 2492 | case 7: |
| 2493 | val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], | 2493 | val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], |
| 2494 | argvals[3], argvals[4], argvals[5], | 2494 | argvals[3], argvals[4], argvals[5], |
| 2495 | argvals[6]); | 2495 | argvals[6]); |
| 2496 | goto done; | 2496 | |
| 2497 | 2497 | break; | |
| 2498 | case 8: | 2498 | case 8: |
| 2499 | val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], | 2499 | val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], |
| 2500 | argvals[3], argvals[4], argvals[5], | 2500 | argvals[3], argvals[4], argvals[5], |
| 2501 | argvals[6], argvals[7]); | 2501 | argvals[6], argvals[7]); |
| 2502 | goto done; | 2502 | |
| 2503 | 2503 | break; | |
| 2504 | default: | 2504 | default: |
| 2505 | /* Someone has created a subr that takes more arguments than | 2505 | /* Someone has created a subr that takes more arguments than |
| 2506 | is supported by this code. We need to either rewrite the | 2506 | is supported by this code. We need to either rewrite the |
| 2507 | subr to use a different argument protocol, or add more | 2507 | subr to use a different argument protocol, or add more |
| 2508 | cases to this switch. */ | 2508 | cases to this switch. */ |
| 2509 | abort (); | 2509 | abort (); |
| 2510 | } | ||
| 2510 | } | 2511 | } |
| 2511 | } | 2512 | } |
| 2512 | if (FUNVECP (fun)) | 2513 | else if (FUNVECP (fun)) |
| 2513 | val = apply_lambda (fun, original_args); | 2514 | val = apply_lambda (fun, original_args); |
| 2514 | else | 2515 | else |
| 2515 | { | 2516 | { |
| @@ -2533,7 +2534,6 @@ eval_sub (Lisp_Object form) | |||
| 2533 | else | 2534 | else |
| 2534 | xsignal1 (Qinvalid_function, original_fun); | 2535 | xsignal1 (Qinvalid_function, original_fun); |
| 2535 | } | 2536 | } |
| 2536 | done: | ||
| 2537 | CHECK_CONS_LIST (); | 2537 | CHECK_CONS_LIST (); |
| 2538 | 2538 | ||
| 2539 | lisp_eval_depth--; | 2539 | lisp_eval_depth--; |
| @@ -3109,7 +3109,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 3109 | 3109 | ||
| 3110 | if (SUBRP (fun)) | 3110 | if (SUBRP (fun)) |
| 3111 | { | 3111 | { |
| 3112 | if (numargs < XSUBR (fun)->min_args | 3112 | if (numargs < XSUBR (fun)->min_args |
| 3113 | || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) | 3113 | || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) |
| 3114 | { | 3114 | { |
| 3115 | XSETFASTINT (lisp_numargs, numargs); | 3115 | XSETFASTINT (lisp_numargs, numargs); |
| @@ -3119,74 +3119,72 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 3119 | if (XSUBR (fun)->max_args == UNEVALLED) | 3119 | if (XSUBR (fun)->max_args == UNEVALLED) |
| 3120 | xsignal1 (Qinvalid_function, original_fun); | 3120 | xsignal1 (Qinvalid_function, original_fun); |
| 3121 | 3121 | ||
| 3122 | if (XSUBR (fun)->max_args == MANY) | 3122 | else if (XSUBR (fun)->max_args == MANY) |
| 3123 | { | 3123 | val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); |
| 3124 | val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); | ||
| 3125 | goto done; | ||
| 3126 | } | ||
| 3127 | |||
| 3128 | if (XSUBR (fun)->max_args > numargs) | ||
| 3129 | { | ||
| 3130 | internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); | ||
| 3131 | memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); | ||
| 3132 | for (i = numargs; i < XSUBR (fun)->max_args; i++) | ||
| 3133 | internal_args[i] = Qnil; | ||
| 3134 | } | ||
| 3135 | else | 3124 | else |
| 3136 | internal_args = args + 1; | ||
| 3137 | switch (XSUBR (fun)->max_args) | ||
| 3138 | { | 3125 | { |
| 3139 | case 0: | 3126 | if (XSUBR (fun)->max_args > numargs) |
| 3140 | val = (XSUBR (fun)->function.a0) (); | 3127 | { |
| 3141 | goto done; | 3128 | internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); |
| 3142 | case 1: | 3129 | memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); |
| 3143 | val = (XSUBR (fun)->function.a1) (internal_args[0]); | 3130 | for (i = numargs; i < XSUBR (fun)->max_args; i++) |
| 3144 | goto done; | 3131 | internal_args[i] = Qnil; |
| 3145 | case 2: | 3132 | } |
| 3146 | val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); | 3133 | else |
| 3147 | goto done; | 3134 | internal_args = args + 1; |
| 3148 | case 3: | 3135 | switch (XSUBR (fun)->max_args) |
| 3149 | val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], | 3136 | { |
| 3150 | internal_args[2]); | 3137 | case 0: |
| 3151 | goto done; | 3138 | val = (XSUBR (fun)->function.a0) (); |
| 3152 | case 4: | 3139 | break; |
| 3153 | val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], | 3140 | case 1: |
| 3154 | internal_args[2], internal_args[3]); | 3141 | val = (XSUBR (fun)->function.a1) (internal_args[0]); |
| 3155 | goto done; | 3142 | break; |
| 3156 | case 5: | 3143 | case 2: |
| 3157 | val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], | 3144 | val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); |
| 3158 | internal_args[2], internal_args[3], | 3145 | break; |
| 3159 | internal_args[4]); | 3146 | case 3: |
| 3160 | goto done; | 3147 | val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], |
| 3161 | case 6: | 3148 | internal_args[2]); |
| 3162 | val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], | 3149 | break; |
| 3163 | internal_args[2], internal_args[3], | 3150 | case 4: |
| 3164 | internal_args[4], internal_args[5]); | 3151 | val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], |
| 3165 | goto done; | 3152 | internal_args[2], internal_args[3]); |
| 3166 | case 7: | 3153 | break; |
| 3167 | val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], | 3154 | case 5: |
| 3168 | internal_args[2], internal_args[3], | 3155 | val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], |
| 3169 | internal_args[4], internal_args[5], | 3156 | internal_args[2], internal_args[3], |
| 3170 | internal_args[6]); | 3157 | internal_args[4]); |
| 3171 | goto done; | 3158 | break; |
| 3172 | 3159 | case 6: | |
| 3173 | case 8: | 3160 | val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], |
| 3174 | val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], | 3161 | internal_args[2], internal_args[3], |
| 3175 | internal_args[2], internal_args[3], | 3162 | internal_args[4], internal_args[5]); |
| 3176 | internal_args[4], internal_args[5], | 3163 | break; |
| 3177 | internal_args[6], internal_args[7]); | 3164 | case 7: |
| 3178 | goto done; | 3165 | val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], |
| 3179 | 3166 | internal_args[2], internal_args[3], | |
| 3180 | default: | 3167 | internal_args[4], internal_args[5], |
| 3181 | 3168 | internal_args[6]); | |
| 3182 | /* If a subr takes more than 8 arguments without using MANY | 3169 | break; |
| 3183 | or UNEVALLED, we need to extend this function to support it. | 3170 | |
| 3184 | Until this is done, there is no way to call the function. */ | 3171 | case 8: |
| 3185 | abort (); | 3172 | val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], |
| 3173 | internal_args[2], internal_args[3], | ||
| 3174 | internal_args[4], internal_args[5], | ||
| 3175 | internal_args[6], internal_args[7]); | ||
| 3176 | break; | ||
| 3177 | |||
| 3178 | default: | ||
| 3179 | |||
| 3180 | /* If a subr takes more than 8 arguments without using MANY | ||
| 3181 | or UNEVALLED, we need to extend this function to support it. | ||
| 3182 | Until this is done, there is no way to call the function. */ | ||
| 3183 | abort (); | ||
| 3184 | } | ||
| 3186 | } | 3185 | } |
| 3187 | } | 3186 | } |
| 3188 | 3187 | else if (FUNVECP (fun)) | |
| 3189 | if (FUNVECP (fun)) | ||
| 3190 | val = funcall_lambda (fun, numargs, args + 1); | 3188 | val = funcall_lambda (fun, numargs, args + 1); |
| 3191 | else | 3189 | else |
| 3192 | { | 3190 | { |
| @@ -3209,7 +3207,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) | |||
| 3209 | else | 3207 | else |
| 3210 | xsignal1 (Qinvalid_function, original_fun); | 3208 | xsignal1 (Qinvalid_function, original_fun); |
| 3211 | } | 3209 | } |
| 3212 | done: | ||
| 3213 | CHECK_CONS_LIST (); | 3210 | CHECK_CONS_LIST (); |
| 3214 | lisp_eval_depth--; | 3211 | lisp_eval_depth--; |
| 3215 | if (backtrace.debug_on_exit) | 3212 | if (backtrace.debug_on_exit) |
diff --git a/src/keyboard.c b/src/keyboard.c index 17819170640..df69c526f71 100644 --- a/src/keyboard.c +++ b/src/keyboard.c | |||
| @@ -1327,7 +1327,7 @@ command_loop_2 (Lisp_Object ignore) | |||
| 1327 | Lisp_Object | 1327 | Lisp_Object |
| 1328 | top_level_2 (void) | 1328 | top_level_2 (void) |
| 1329 | { | 1329 | { |
| 1330 | return Feval (Vtop_level); | 1330 | return Feval (Vtop_level, Qnil); |
| 1331 | } | 1331 | } |
| 1332 | 1332 | ||
| 1333 | Lisp_Object | 1333 | Lisp_Object |
| @@ -3255,7 +3255,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event | |||
| 3255 | help_form_saved_window_configs); | 3255 | help_form_saved_window_configs); |
| 3256 | record_unwind_protect (read_char_help_form_unwind, Qnil); | 3256 | record_unwind_protect (read_char_help_form_unwind, Qnil); |
| 3257 | 3257 | ||
| 3258 | tem0 = Feval (Vhelp_form); | 3258 | tem0 = Feval (Vhelp_form, Qnil); |
| 3259 | if (STRINGP (tem0)) | 3259 | if (STRINGP (tem0)) |
| 3260 | internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); | 3260 | internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); |
| 3261 | 3261 | ||
| @@ -7696,6 +7696,12 @@ menu_item_eval_property_1 (Lisp_Object arg) | |||
| 7696 | return Qnil; | 7696 | return Qnil; |
| 7697 | } | 7697 | } |
| 7698 | 7698 | ||
| 7699 | static Lisp_Object | ||
| 7700 | eval_dyn (Lisp_Object form) | ||
| 7701 | { | ||
| 7702 | return Feval (form, Qnil); | ||
| 7703 | } | ||
| 7704 | |||
| 7699 | /* Evaluate an expression and return the result (or nil if something | 7705 | /* Evaluate an expression and return the result (or nil if something |
| 7700 | went wrong). Used to evaluate dynamic parts of menu items. */ | 7706 | went wrong). Used to evaluate dynamic parts of menu items. */ |
| 7701 | Lisp_Object | 7707 | Lisp_Object |
| @@ -7704,7 +7710,7 @@ menu_item_eval_property (Lisp_Object sexpr) | |||
| 7704 | int count = SPECPDL_INDEX (); | 7710 | int count = SPECPDL_INDEX (); |
| 7705 | Lisp_Object val; | 7711 | Lisp_Object val; |
| 7706 | specbind (Qinhibit_redisplay, Qt); | 7712 | specbind (Qinhibit_redisplay, Qt); |
| 7707 | val = internal_condition_case_1 (Feval, sexpr, Qerror, | 7713 | val = internal_condition_case_1 (eval_dyn, sexpr, Qerror, |
| 7708 | menu_item_eval_property_1); | 7714 | menu_item_eval_property_1); |
| 7709 | return unbind_to (count, val); | 7715 | return unbind_to (count, val); |
| 7710 | } | 7716 | } |
diff --git a/src/lisp.h b/src/lisp.h index 20b50632c49..db78996be55 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -2971,7 +2971,7 @@ extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RET | |||
| 2971 | extern void signal_error (const char *, Lisp_Object) NO_RETURN; | 2971 | extern void signal_error (const char *, Lisp_Object) NO_RETURN; |
| 2972 | EXFUN (Fautoload, 5); | 2972 | EXFUN (Fautoload, 5); |
| 2973 | EXFUN (Fcommandp, 2); | 2973 | EXFUN (Fcommandp, 2); |
| 2974 | EXFUN (Feval, 1); | 2974 | EXFUN (Feval, 2); |
| 2975 | extern Lisp_Object eval_sub (Lisp_Object form); | 2975 | extern Lisp_Object eval_sub (Lisp_Object form); |
| 2976 | EXFUN (Fapply, MANY); | 2976 | EXFUN (Fapply, MANY); |
| 2977 | EXFUN (Ffuncall, MANY); | 2977 | EXFUN (Ffuncall, MANY); |
diff --git a/src/minibuf.c b/src/minibuf.c index 409f8a9a9ef..9dd32a8bab4 100644 --- a/src/minibuf.c +++ b/src/minibuf.c | |||
| @@ -1026,10 +1026,10 @@ is a string to insert in the minibuffer before reading. | |||
| 1026 | Such arguments are used as in `read-from-minibuffer'.) */) | 1026 | Such arguments are used as in `read-from-minibuffer'.) */) |
| 1027 | (Lisp_Object prompt, Lisp_Object initial_contents) | 1027 | (Lisp_Object prompt, Lisp_Object initial_contents) |
| 1028 | { | 1028 | { |
| 1029 | /* FIXME: lexbind. */ | ||
| 1030 | return Feval (read_minibuf (Vread_expression_map, initial_contents, | 1029 | return Feval (read_minibuf (Vread_expression_map, initial_contents, |
| 1031 | prompt, Qnil, 1, Qread_expression_history, | 1030 | prompt, Qnil, 1, Qread_expression_history, |
| 1032 | make_number (0), Qnil, 0, 0)); | 1031 | make_number (0), Qnil, 0, 0), |
| 1032 | Qnil); | ||
| 1033 | } | 1033 | } |
| 1034 | 1034 | ||
| 1035 | /* Functions that use the minibuffer to read various things. */ | 1035 | /* Functions that use the minibuffer to read various things. */ |