From b9598260f96ddc652cd82ab64bbe922ccfc48a29 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 13 Jun 2010 16:36:17 -0400 Subject: New branch for lexbind, losing all history. This initial patch is based on 2002-06-27T22:39:10Z!storm@cua.dk of the original lexbind branch. --- lisp/emacs-lisp/lisp-mode.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 02477baf74f..1185f79806f 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -701,7 +701,15 @@ If CHAR is not a character, return nil." (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. With argument, print output into current buffer." - (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) + (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)) + ;; preserve the current lexical environment + (internal-interpreter-environment internal-interpreter-environment)) + ;; Setup the lexical environment if lexical-binding is enabled. + ;; Note that `internal-interpreter-environment' _can't_ be both + ;; assigned and let-bound above -- it's treated specially (and + ;; oddly) by the interpreter! + (when lexical-binding + (setq internal-interpreter-environment '(t))) (eval-last-sexp-print-value (eval (preceding-sexp))))) -- cgit v1.2.3 From a0ee6f2751acba71df443d4d795bb350eb6421dd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 15 Dec 2010 12:46:59 -0500 Subject: 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. --- lisp/ChangeLog | 7 ++ lisp/emacs-lisp/edebug.el | 17 +-- lisp/emacs-lisp/lisp-mode.el | 26 ++--- lisp/ielm.el | 3 +- lisp/simple.el | 4 +- src/ChangeLog | 5 + src/bytecode.c | 2 +- src/callint.c | 2 +- src/doc.c | 2 +- src/eval.c | 267 +++++++++++++++++++++---------------------- src/keyboard.c | 12 +- src/lisp.h | 2 +- src/minibuf.c | 4 +- 13 files changed, 184 insertions(+), 169 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 053eb95329c..87794ceb5d2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2010-12-15 Stefan Monnier + + * emacs-lisp/edebug.el (edebug-eval-defun, edebug-eval): + * emacs-lisp/lisp-mode.el (eval-last-sexp-1, eval-defun-1): + * ielm.el (ielm-eval-input): + * simple.el (eval-expression): Use new eval arg to obey lexical-binding. + 2010-12-14 Stefan Monnier * 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." ((and (eq (car form) 'defcustom) (default-boundp (nth 1 form))) ;; Force variable to be bound. - (set-default (nth 1 form) (eval (nth 2 form)))) + (set-default (nth 1 form) (eval (nth 2 form) lexical-binding))) ((eq (car form) 'defface) ;; Reset the face. (setq face-new-frame-defaults @@ -534,7 +534,7 @@ the minibuffer." (put ',(nth 1 form) 'customized-face ,(nth 2 form))) (put (nth 1 form) 'saved-face nil))))) - (setq edebug-result (eval form)) + (setq edebug-result (eval form lexical-binding)) (if (not edebugging) (princ edebug-result) edebug-result))) @@ -2466,6 +2466,7 @@ MSG is printed after `::::} '." (if edebug-global-break-condition (condition-case nil (setq edebug-global-break-result + ;; FIXME: lexbind. (eval edebug-global-break-condition)) (error nil)))) (edebug-break)) @@ -2477,6 +2478,7 @@ MSG is printed after `::::} '." (and edebug-break-data (or (not edebug-break-condition) (setq edebug-break-result + ;; FIXME: lexbind. (eval edebug-break-condition)))))) (if (and edebug-break (nth 2 edebug-break-data)) ; is it temporary? @@ -3637,9 +3639,10 @@ Return the result of the last expression." (defun edebug-eval (edebug-expr) ;; Are there cl lexical variables active? - (if (bound-and-true-p cl-debug-env) - (eval (cl-macroexpand-all edebug-expr cl-debug-env)) - (eval edebug-expr))) + (eval (if (bound-and-true-p cl-debug-env) + (cl-macroexpand-all edebug-expr cl-debug-env) + edebug-expr) + lexical-binding)) ;; FIXME: lexbind. (defun edebug-safe-eval (edebug-expr) ;; Evaluate EXPR safely. @@ -4241,8 +4244,8 @@ It is removed when you hit any char." ;;; Menus (defun edebug-toggle (variable) - (set variable (not (eval variable))) - (message "%s: %s" variable (eval variable))) + (set variable (not (symbol-value variable))) + (message "%s: %s" variable (symbol-value variable))) ;; We have to require easymenu (even for Emacs 18) just so ;; 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." (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. With argument, print output into current buffer." - (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)) - ;; preserve the current lexical environment - (internal-interpreter-environment internal-interpreter-environment)) + (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) ;; Setup the lexical environment if lexical-binding is enabled. - ;; Note that `internal-interpreter-environment' _can't_ be both - ;; assigned and let-bound above -- it's treated specially (and - ;; oddly) by the interpreter! - (when lexical-binding - (setq internal-interpreter-environment '(t))) - (eval-last-sexp-print-value (eval (preceding-sexp))))) + (eval-last-sexp-print-value (eval (preceding-sexp) lexical-binding)))) (defun eval-last-sexp-print-value (value) @@ -772,16 +765,18 @@ Reinitialize the face according to the `defface' specification." ;; `defcustom' is now macroexpanded to ;; `custom-declare-variable' with a quoted value arg. ((and (eq (car form) 'custom-declare-variable) - (default-boundp (eval (nth 1 form)))) + (default-boundp (eval (nth 1 form) lexical-binding))) ;; Force variable to be bound. - (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form)))) + (set-default (eval (nth 1 form) lexical-binding) + (eval (nth 1 (nth 2 form)) lexical-binding)) form) ;; `defface' is macroexpanded to `custom-declare-face'. ((eq (car form) 'custom-declare-face) ;; Reset the face. (setq face-new-frame-defaults - (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults)) - (put (eval (nth 1 form)) 'face-defface-spec nil) + (assq-delete-all (eval (nth 1 form) lexical-binding) + face-new-frame-defaults)) + (put (eval (nth 1 form) lexical-binding) 'face-defface-spec nil) ;; Setting `customized-face' to the new spec after calling ;; the form, but preserving the old saved spec in `saved-face', ;; imitates the situation when the new face spec is set @@ -792,10 +787,11 @@ Reinitialize the face according to the `defface' specification." ;; `defface' change the spec, regardless of a saved spec. (prog1 `(prog1 ,form (put ,(nth 1 form) 'saved-face - ',(get (eval (nth 1 form)) 'saved-face)) + ',(get (eval (nth 1 form) lexical-binding) + 'saved-face)) (put ,(nth 1 form) 'customized-face ,(nth 2 form))) - (put (eval (nth 1 form)) 'saved-face nil))) + (put (eval (nth 1 form) lexical-binding) 'saved-face nil))) ((eq (car form) 'progn) (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) (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." (*** *3)) (kill-buffer (current-buffer)) (set-buffer ielm-wbuf) - (setq ielm-result (eval ielm-form)) + (setq ielm-result + (eval ielm-form lexical-binding)) (setq ielm-wbuf (current-buffer)) (setq 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." current-prefix-arg)) (if (null eval-expression-debug-on-error) - (setq values (cons (eval eval-expression-arg) values)) + (push (eval eval-expression-arg lexical-binding) values) (let ((old-value (make-symbol "t")) new-value) ;; Bind debug-on-error to something unique so that we can ;; detect when evaled code changes it. (let ((debug-on-error old-value)) - (setq values (cons (eval eval-expression-arg) values)) + (push (eval eval-expression-arg lexical-binding) values) (setq new-value debug-on-error)) ;; If evaled code has changed the value of debug-on-error, ;; 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 @@ +2010-12-15 Stefan Monnier + + * eval.c (Feval): Add `lexical' argument. Adjust callers. + (Ffuncall, eval_sub): Avoid goto. + 2010-12-14 Stefan Monnier 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, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = internal_catch (TOP, Feval, v1); /* FIXME: lexbind */ + TOP = internal_catch (TOP, eval_sub, v1); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; } 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 input = specs; /* Compute the arg values using the user's expression. */ GCPRO2 (input, filter_specs); - specs = Feval (specs); /* FIXME: lexbind */ + specs = Feval (specs, Qnil); /* FIXME: lexbind */ UNGCPRO; if (i != num_input_events || !NILP (record_flag)) { diff --git a/src/doc.c b/src/doc.c index b887b3149bc..8ae152dca9a 100644 --- a/src/doc.c +++ b/src/doc.c @@ -490,7 +490,7 @@ aren't strings. */) } else if (!STRINGP (tem)) /* Feval protects its argument. */ - tem = Feval (tem); + tem = Feval (tem, Qnil); if (NILP (raw) && STRINGP (tem)) 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) } -DEFUN ("eval", Feval, Seval, 1, 1, 0, - doc: /* Evaluate FORM and return its value. */) - (Lisp_Object form) +DEFUN ("eval", Feval, Seval, 1, 2, 0, + doc: /* Evaluate FORM and return its value. +If LEXICAL is t, evaluate using lexical scoping. */) + (Lisp_Object form, Lisp_Object lexical) { int count = SPECPDL_INDEX (); - specbind (Qinternal_interpreter_environment, Qnil); + specbind (Qinternal_interpreter_environment, + NILP (lexical) ? Qnil : Fcons (Qt, Qnil)); return unbind_to (count, eval_sub (form)); } @@ -2414,10 +2416,8 @@ eval_sub (Lisp_Object form) { backtrace.evalargs = 0; val = (XSUBR (fun)->function.aUNEVALLED) (args_left); - goto done; } - - if (XSUBR (fun)->max_args == MANY) + else if (XSUBR (fun)->max_args == MANY) { /* Pass a vector of evaluated arguments */ Lisp_Object *vals; @@ -2443,73 +2443,74 @@ eval_sub (Lisp_Object form) val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); UNGCPRO; SAFE_FREE (); - goto done; } - - GCPRO3 (args_left, fun, fun); - gcpro3.var = argvals; - gcpro3.nvars = 0; - - maxargs = XSUBR (fun)->max_args; - for (i = 0; i < maxargs; args_left = Fcdr (args_left)) + else { - argvals[i] = eval_sub (Fcar (args_left)); - gcpro3.nvars = ++i; - } - - UNGCPRO; + GCPRO3 (args_left, fun, fun); + gcpro3.var = argvals; + gcpro3.nvars = 0; + + maxargs = XSUBR (fun)->max_args; + for (i = 0; i < maxargs; args_left = Fcdr (args_left)) + { + argvals[i] = eval_sub (Fcar (args_left)); + gcpro3.nvars = ++i; + } + + UNGCPRO; - backtrace.args = argvals; - backtrace.nargs = XINT (numargs); + backtrace.args = argvals; + backtrace.nargs = XINT (numargs); - switch (i) - { - case 0: - val = (XSUBR (fun)->function.a0) (); - goto done; - case 1: - val = (XSUBR (fun)->function.a1) (argvals[0]); - goto done; - case 2: - val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); - goto done; - case 3: - val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], - argvals[2]); - goto done; - case 4: - val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], - argvals[2], argvals[3]); - goto done; - case 5: - val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4]); - goto done; - case 6: - val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5]); - goto done; - case 7: - val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5], - argvals[6]); - goto done; - - case 8: - val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5], - argvals[6], argvals[7]); - goto done; - - default: - /* Someone has created a subr that takes more arguments than - is supported by this code. We need to either rewrite the - subr to use a different argument protocol, or add more - cases to this switch. */ - abort (); + switch (i) + { + case 0: + val = (XSUBR (fun)->function.a0) (); + break; + case 1: + val = (XSUBR (fun)->function.a1) (argvals[0]); + break; + case 2: + val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); + break; + case 3: + val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], + argvals[2]); + break; + case 4: + val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], + argvals[2], argvals[3]); + break; + case 5: + val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4]); + break; + case 6: + val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5]); + break; + case 7: + val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5], + argvals[6]); + + break; + case 8: + val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5], + argvals[6], argvals[7]); + + break; + default: + /* Someone has created a subr that takes more arguments than + is supported by this code. We need to either rewrite the + subr to use a different argument protocol, or add more + cases to this switch. */ + abort (); + } } } - if (FUNVECP (fun)) + else if (FUNVECP (fun)) val = apply_lambda (fun, original_args); else { @@ -2533,7 +2534,6 @@ eval_sub (Lisp_Object form) else xsignal1 (Qinvalid_function, original_fun); } - done: CHECK_CONS_LIST (); lisp_eval_depth--; @@ -3109,7 +3109,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (SUBRP (fun)) { - if (numargs < XSUBR (fun)->min_args + if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) { XSETFASTINT (lisp_numargs, numargs); @@ -3119,74 +3119,72 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (XSUBR (fun)->max_args == UNEVALLED) xsignal1 (Qinvalid_function, original_fun); - if (XSUBR (fun)->max_args == MANY) - { - val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); - goto done; - } - - if (XSUBR (fun)->max_args > numargs) - { - internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); - memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); - for (i = numargs; i < XSUBR (fun)->max_args; i++) - internal_args[i] = Qnil; - } + else if (XSUBR (fun)->max_args == MANY) + val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); else - internal_args = args + 1; - switch (XSUBR (fun)->max_args) { - case 0: - val = (XSUBR (fun)->function.a0) (); - goto done; - case 1: - val = (XSUBR (fun)->function.a1) (internal_args[0]); - goto done; - case 2: - val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); - goto done; - case 3: - val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], - internal_args[2]); - goto done; - case 4: - val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3]); - goto done; - case 5: - val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4]); - goto done; - case 6: - val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5]); - goto done; - case 7: - val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5], - internal_args[6]); - goto done; - - case 8: - val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5], - internal_args[6], internal_args[7]); - goto done; - - default: - - /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. - Until this is done, there is no way to call the function. */ - abort (); + if (XSUBR (fun)->max_args > numargs) + { + internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); + memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); + for (i = numargs; i < XSUBR (fun)->max_args; i++) + internal_args[i] = Qnil; + } + else + internal_args = args + 1; + switch (XSUBR (fun)->max_args) + { + case 0: + val = (XSUBR (fun)->function.a0) (); + break; + case 1: + val = (XSUBR (fun)->function.a1) (internal_args[0]); + break; + case 2: + val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); + break; + case 3: + val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], + internal_args[2]); + break; + case 4: + val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3]); + break; + case 5: + val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4]); + break; + case 6: + val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5]); + break; + case 7: + val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5], + internal_args[6]); + break; + + case 8: + val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5], + internal_args[6], internal_args[7]); + break; + + default: + + /* If a subr takes more than 8 arguments without using MANY + or UNEVALLED, we need to extend this function to support it. + Until this is done, there is no way to call the function. */ + abort (); + } } } - - if (FUNVECP (fun)) + else if (FUNVECP (fun)) val = funcall_lambda (fun, numargs, args + 1); else { @@ -3209,7 +3207,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) else xsignal1 (Qinvalid_function, original_fun); } - done: CHECK_CONS_LIST (); lisp_eval_depth--; 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) Lisp_Object top_level_2 (void) { - return Feval (Vtop_level); + return Feval (Vtop_level, Qnil); } Lisp_Object @@ -3255,7 +3255,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event help_form_saved_window_configs); record_unwind_protect (read_char_help_form_unwind, Qnil); - tem0 = Feval (Vhelp_form); + tem0 = Feval (Vhelp_form, Qnil); if (STRINGP (tem0)) internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); @@ -7696,6 +7696,12 @@ menu_item_eval_property_1 (Lisp_Object arg) return Qnil; } +static Lisp_Object +eval_dyn (Lisp_Object form) +{ + return Feval (form, Qnil); +} + /* Evaluate an expression and return the result (or nil if something went wrong). Used to evaluate dynamic parts of menu items. */ Lisp_Object @@ -7704,7 +7710,7 @@ menu_item_eval_property (Lisp_Object sexpr) int count = SPECPDL_INDEX (); Lisp_Object val; specbind (Qinhibit_redisplay, Qt); - val = internal_condition_case_1 (Feval, sexpr, Qerror, + val = internal_condition_case_1 (eval_dyn, sexpr, Qerror, menu_item_eval_property_1); return unbind_to (count, val); } 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 extern void signal_error (const char *, Lisp_Object) NO_RETURN; EXFUN (Fautoload, 5); EXFUN (Fcommandp, 2); -EXFUN (Feval, 1); +EXFUN (Feval, 2); extern Lisp_Object eval_sub (Lisp_Object form); EXFUN (Fapply, MANY); 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. Such arguments are used as in `read-from-minibuffer'.) */) (Lisp_Object prompt, Lisp_Object initial_contents) { - /* FIXME: lexbind. */ return Feval (read_minibuf (Vread_expression_map, initial_contents, prompt, Qnil, 1, Qread_expression_history, - make_number (0), Qnil, 0, 0)); + make_number (0), Qnil, 0, 0), + Qnil); } /* Functions that use the minibuffer to read various things. */ -- cgit v1.2.3 From e0f57e65692ed73a86926f737388b60faec92767 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 19 Feb 2011 00:10:33 -0500 Subject: * lisp/subr.el (save-window-excursion): New macro, moved from C. * lisp/emacs-lisp/lisp-mode.el (save-window-excursion): Don't touch. * lisp/emacs-lisp/cconv.el (cconv-closure-convert-rec, cconv-analyse-form): Don't handle save-window-excursion any more. * lisp/emacs-lisp/bytecomp.el (interactive-p, save-window-excursion): Don't use the byte-code any more. (byte-compile-form): Check macro expansion was done. (byte-compile-save-window-excursion): Remove. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Ignore save-window-excursion. Don't macroepand any more. * src/window.c (Fsave_window_excursion): Remove. Moved to Lisp. (syms_of_window): Don't defsubr it. * src/window.h (Fsave_window_excursion): Don't declare it. * src/bytecode.c (exec_byte_code): Inline Fsave_window_excursion. --- lisp/ChangeLog | 13 +++++++++++++ lisp/emacs-lisp/byte-opt.el | 21 +-------------------- lisp/emacs-lisp/bytecomp.el | 18 ++++-------------- lisp/emacs-lisp/cconv.el | 6 +++--- lisp/emacs-lisp/lisp-mode.el | 1 - lisp/subr.el | 19 +++++++++++++++++++ src/ChangeLog | 7 +++++++ src/bytecode.c | 32 ++++++++++++++++++++------------ src/window.c | 23 ----------------------- src/window.h | 1 - 10 files changed, 67 insertions(+), 74 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6b6555ab7e3..ae91513937c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-02-19 Stefan Monnier + + * subr.el (save-window-excursion): New macro, moved from C. + * emacs-lisp/lisp-mode.el (save-window-excursion): Don't touch. + * emacs-lisp/cconv.el (cconv-closure-convert-rec, cconv-analyse-form): + Don't handle save-window-excursion any more. + * emacs-lisp/bytecomp.el (interactive-p, save-window-excursion): + Don't use the byte-code any more. + (byte-compile-form): Check macro expansion was done. + (byte-compile-save-window-excursion): Remove. + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + Ignore save-window-excursion. Don't macroepand any more. + 2011-02-18 Stefan Monnier * emacs-lisp/pcase.el (pcase--expand, pcase--u, pcase--u1, pcase--q1): diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 12df3251267..038db292350 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -498,8 +498,7 @@ (prin1-to-string form)) nil) - ((memq fn '(defun defmacro function - condition-case save-window-excursion)) + ((memq fn '(defun defmacro function condition-case)) ;; These forms are compiled as constants or by breaking out ;; all the subexpressions and compiling them separately. form) @@ -530,24 +529,6 @@ ;; However, don't actually bother calling `ignore'. `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form)))) - ;; If optimization is on, this is the only place that macros are - ;; expanded. If optimization is off, then macroexpansion happens - ;; in byte-compile-form. Otherwise, the macros are already expanded - ;; by the time that is reached. - ((not (eq form - (setq form (macroexpand form - byte-compile-macro-environment)))) - (byte-optimize-form form for-effect)) - - ;; Support compiler macros as in cl.el. - ((and (fboundp 'compiler-macroexpand) - (symbolp (car-safe form)) - (get (car-safe form) 'cl-compiler-macro) - (not (eq form - (with-no-warnings - (setq form (compiler-macroexpand form)))))) - (byte-optimize-form form for-effect)) - ((not (symbolp fn)) (byte-compile-warn "`%s' is a malformed function" (prin1-to-string fn)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d3ac50a671a..54a1912169a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -586,7 +586,6 @@ Each element is (INDEX . VALUE)") (byte-defop 114 0 byte-save-current-buffer "To make a binding to record the current buffer") (byte-defop 115 0 byte-set-mark-OBSOLETE) -(byte-defop 116 1 byte-interactive-p) ;; These ops are new to v19 (byte-defop 117 0 byte-forward-char) @@ -622,8 +621,6 @@ otherwise pop it") (byte-defop 138 0 byte-save-excursion "to make a binding to record the buffer, point and mark") -(byte-defop 139 0 byte-save-window-excursion - "to make a binding to record entire window configuration") (byte-defop 140 0 byte-save-restriction "to make a binding to record the current buffer clipping restrictions") (byte-defop 141 -1 byte-catch @@ -2955,6 +2952,10 @@ That command is designed for interactive use only" bytecomp-fn)) custom-declare-face)) (byte-compile-nogroup-warn form)) (byte-compile-callargs-warn form)) + (if (and (fboundp (car form)) + (eq (car-safe (indirect-function (car form))) 'macro)) + (byte-compile-report-error + (format "Forgot to expand macro %s" (car form)))) (if (and bytecomp-handler ;; Make sure that function exists. This is important ;; for CL compiler macros since the symbol may be @@ -3167,7 +3168,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler bobp 0) (byte-defop-compiler current-buffer 0) ;;(byte-defop-compiler read-char 0) ;; obsolete -(byte-defop-compiler interactive-p 0) (byte-defop-compiler widen 0) (byte-defop-compiler end-of-line 0-1) (byte-defop-compiler forward-char 0-1) @@ -3946,7 +3946,6 @@ binding slots have been popped." (byte-defop-compiler-1 save-excursion) (byte-defop-compiler-1 save-current-buffer) (byte-defop-compiler-1 save-restriction) -(byte-defop-compiler-1 save-window-excursion) (byte-defop-compiler-1 with-output-to-temp-buffer) (byte-defop-compiler-1 track-mouse) @@ -4047,15 +4046,6 @@ binding slots have been popped." (byte-compile-body-do-effect (cdr form)) (byte-compile-out 'byte-unbind 1)) -(defun byte-compile-save-window-excursion (form) - (pcase (cdr form) - (`(:fun-body ,f) - (byte-compile-form `(list (list 'funcall ,f)))) - (body - (byte-compile-push-constant - (byte-compile-top-level-body body for-effect)))) - (byte-compile-out 'byte-save-window-excursion 0)) - (defun byte-compile-with-output-to-temp-buffer (form) (byte-compile-form (car (cdr form))) (byte-compile-out 'byte-temp-output-buffer-setup 0) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index d8f5a7da44d..4e42e9f3c1d 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -635,8 +635,8 @@ Returns a form where all lambdas don't have any free variables." ,(cconv-closure-convert-rec `(function (lambda () ,@body)) emvrs fvrs envs lmenvs))) - (`(,(and head (or `save-window-excursion `track-mouse)) . ,body) - `(,head + (`(track-mouse . ,body) + `(track-mouse :fun-body ,(cconv-closure-convert-rec `(function (lambda () ,@body)) emvrs fvrs envs lmenvs))) @@ -827,7 +827,7 @@ lambdas if they are suitable for lambda lifting. ;; FIXME: The bytecode for save-window-excursion and the lack of ;; bytecode for track-mouse forces us to wrap the body. - (`(,(or `save-window-excursion `track-mouse) . ,body) + (`(track-mouse . ,body) (setq inclosure (1+ inclosure)) (dolist (form body) (cconv-analyse-form form env inclosure))) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 37a86b7135d..85717408121 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1209,7 +1209,6 @@ This function also returns nil meaning don't specify the indentation." (put 'prog1 'lisp-indent-function 1) (put 'prog2 'lisp-indent-function 2) (put 'save-excursion 'lisp-indent-function 0) -(put 'save-window-excursion 'lisp-indent-function 0) (put 'save-restriction 'lisp-indent-function 0) (put 'save-match-data 'lisp-indent-function 0) (put 'save-current-buffer 'lisp-indent-function 0) diff --git a/lisp/subr.el b/lisp/subr.el index c72752eb8f2..626128c62b3 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2767,6 +2767,25 @@ nor the buffer list." (when (buffer-live-p ,old-buffer) (set-buffer ,old-buffer)))))) +(defmacro save-window-excursion (&rest body) + "Execute BODY, preserving window sizes and contents. +Return the value of the last form in BODY. +Restore which buffer appears in which window, where display starts, +and the value of point and mark for each window. +Also restore the choice of selected window. +Also restore which buffer is current. +Does not restore the value of point in current buffer. + +BEWARE: Most uses of this macro introduce bugs. +E.g. it should not be used to try and prevent some code from opening +a new window, since that window may sometimes appear in another frame, +in which case `save-window-excursion' cannot help." + (declare (indent 0) (debug t)) + (let ((c (make-symbol "wconfig"))) + `(let ((,c (current-window-configuration))) + (unwind-protect (progn ,@body) + (set-window-configuration ,c))))) + (defmacro with-temp-file (file &rest body) "Create a new buffer, evaluate BODY there, and write the buffer to FILE. The value returned is the value of the last form in BODY. diff --git a/src/ChangeLog b/src/ChangeLog index 0b2ee8550ca..6bebce0abaa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-02-19 Stefan Monnier + + * window.c (Fsave_window_excursion): Remove. Moved to Lisp. + (syms_of_window): Don't defsubr it. + * window.h (Fsave_window_excursion): Don't declare it. + * bytecode.c (exec_byte_code): Inline Fsave_window_excursion. + 2011-02-17 Stefan Monnier * eval.c (Vinternal_interpreter_environment): Remove. diff --git a/src/bytecode.c b/src/bytecode.c index 1ad01aaf8f7..ad2f7d18ade 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -138,7 +138,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bpoint 0140 /* Was Bmark in v17. */ -#define Bsave_current_buffer 0141 +#define Bsave_current_buffer 0141 /* Obsolete. */ #define Bgoto_char 0142 #define Binsert 0143 #define Bpoint_max 0144 @@ -158,7 +158,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */ #define Bread_char 0162 /* No longer generated as of v19 */ #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ -#define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ +#define Binteractive_p 0164 /* Obsolete. */ #define Bforward_char 0165 #define Bforward_word 0166 @@ -183,7 +183,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bdup 0211 #define Bsave_excursion 0212 -#define Bsave_window_excursion 0213 +#define Bsave_window_excursion 0213 /* Obsolete. */ #define Bsave_restriction 0214 #define Bcatch 0215 @@ -192,7 +192,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Btemp_output_buffer_setup 0220 #define Btemp_output_buffer_show 0221 -#define Bunbind_all 0222 +#define Bunbind_all 0222 /* Obsolete. */ #define Bset_marker 0223 #define Bmatch_beginning 0224 @@ -763,7 +763,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Bunbind_all: + case Bunbind_all: /* Obsolete. */ /* To unbind back to the beginning of this frame. Not used yet, but will be needed for tail-recursion elimination. */ BEFORE_POTENTIAL_GC (); @@ -891,16 +891,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_excursion_save ()); break; - case Bsave_current_buffer: + case Bsave_current_buffer: /* Obsolete. */ case Bsave_current_buffer_1: record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); break; - case Bsave_window_excursion: - BEFORE_POTENTIAL_GC (); - TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */ - AFTER_POTENTIAL_GC (); - break; + case Bsave_window_excursion: /* Obsolete. */ + { + register Lisp_Object val; + register int count = SPECPDL_INDEX (); + + record_unwind_protect (Fset_window_configuration, + Fcurrent_window_configuration (Qnil)); + BEFORE_POTENTIAL_GC (); + TOP = Fprogn (TOP); + unbind_to (count, TOP); + AFTER_POTENTIAL_GC (); + break; + } case Bsave_restriction: record_unwind_protect (save_restriction_restore, @@ -1412,7 +1420,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Binteractive_p: + case Binteractive_p: /* Obsolete. */ PUSH (Finteractive_p ()); break; diff --git a/src/window.c b/src/window.c index abf01758c3f..c90cc268a92 100644 --- a/src/window.c +++ b/src/window.c @@ -6400,28 +6400,6 @@ redirection (see `redirect-frame-focus'). */) return (tem); } -DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion, - 0, UNEVALLED, 0, - doc: /* Execute BODY, preserving window sizes and contents. -Return the value of the last form in BODY. -Restore which buffer appears in which window, where display starts, -and the value of point and mark for each window. -Also restore the choice of selected window. -Also restore which buffer is current. -Does not restore the value of point in current buffer. -usage: (save-window-excursion BODY...) */) - (Lisp_Object args) -{ - register Lisp_Object val; - register int count = SPECPDL_INDEX (); - - record_unwind_protect (Fset_window_configuration, - Fcurrent_window_configuration (Qnil)); - val = Fprogn (args); - return unbind_to (count, val); -} - - /*********************************************************************** Window Split Tree @@ -7195,7 +7173,6 @@ frame to be redrawn only if it is a tty frame. */); defsubr (&Swindow_configuration_frame); defsubr (&Sset_window_configuration); defsubr (&Scurrent_window_configuration); - defsubr (&Ssave_window_excursion); defsubr (&Swindow_tree); defsubr (&Sset_window_margins); defsubr (&Swindow_margins); diff --git a/src/window.h b/src/window.h index 491ffa30bd1..473a43bbc3c 100644 --- a/src/window.h +++ b/src/window.h @@ -860,7 +860,6 @@ EXFUN (Fwindow_minibuffer_p, 1); EXFUN (Fdelete_window, 1); EXFUN (Fwindow_buffer, 1); EXFUN (Fget_buffer_window, 2); -EXFUN (Fsave_window_excursion, UNEVALLED); EXFUN (Fset_window_configuration, 1); EXFUN (Fcurrent_window_configuration, 1); extern int compare_window_configurations (Lisp_Object, Lisp_Object, int); -- cgit v1.2.3 From 06788a55302c7da6566c7efe8d8d800538a22c0a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 24 Mar 2011 11:31:56 -0400 Subject: Fix C-M-x in lexbind mode. Misc tweaks. * lisp/startup.el: Convert to lexical-binding. Mark unused arguments. (command-line-1): Get rid of the "cl1-" prefix now that we use lexical scoping instead. * lisp/emacs-lisp/float-sup.el (pi): Leave it lexically scoped. * lisp/emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): New fun. (eval-last-sexp-1): Use eval-sexp-add-defvars. * lisp/emacs-lisp/edebug.el (edebug-eval-defun): Use eval-sexp-add-defvars. * lisp/emacs-lisp/cconv.el (cconv--analyse-function): Fix `report-error/log-warning' mixup. --- lisp/ChangeLog | 12 ++++ lisp/emacs-lisp/cconv.el | 2 +- lisp/emacs-lisp/edebug.el | 3 +- lisp/emacs-lisp/float-sup.el | 8 ++- lisp/emacs-lisp/lisp-mode.el | 20 +++++- lisp/startup.el | 154 +++++++++++++++++++++---------------------- 6 files changed, 117 insertions(+), 82 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d9c1e5a34da..acdb301b4f0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2011-03-24 Stefan Monnier + + * startup.el: Convert to lexical-binding. Mark unused arguments. + (command-line-1): Get rid of the "cl1-" prefix now that we use lexical + scoping instead. + * emacs-lisp/float-sup.el (pi): Leave it lexically scoped. + * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): New fun. + (eval-last-sexp-1): Use eval-sexp-add-defvars. + * emacs-lisp/edebug.el (edebug-eval-defun): Use eval-sexp-add-defvars. + * emacs-lisp/cconv.el (cconv--analyse-function): + Fix `report-error/log-warning' mixup. + 2011-03-23 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index fe5d7230fb8..46d14880a2c 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -553,7 +553,7 @@ FORM is the parent form that binds this var." (dolist (arg args) (cond ((byte-compile-not-lexical-var-p arg) - (byte-compile-report-error + (byte-compile-log-warning (format "Argument %S is not a lexical variable" arg))) ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... (t (let ((varstruct (list arg nil nil nil nil))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index d711ba59a42..dfc268421e7 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -519,6 +519,7 @@ the minibuffer." ((and (eq (car form) 'defcustom) (default-boundp (nth 1 form))) ;; Force variable to be bound. + ;; FIXME: Shouldn't this use the :setter or :initializer? (set-default (nth 1 form) (eval (nth 2 form) lexical-binding))) ((eq (car form) 'defface) ;; Reset the face. @@ -532,7 +533,7 @@ the minibuffer." (put ',(nth 1 form) 'customized-face ,(nth 2 form))) (put (nth 1 form) 'saved-face nil))))) - (setq edebug-result (eval form lexical-binding)) + (setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding)) (if (not edebugging) (princ edebug-result) edebug-result))) diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index ceb1eb3bafb..7e40fdad352 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -28,7 +28,13 @@ ;; Provide an easy hook to tell if we are running with floats or not. ;; Define pi and e via math-lib calls (much less prone to killer typos). (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).") -(defconst pi float-pi "Obsolete since Emacs-23.3. Use `float-pi' instead.") +(progn + ;; Simulate a defconst that doesn't declare the variable dynamically bound. + (setq-default pi float-pi) + (put 'pi 'variable-documentation + "Obsolete since Emacs-23.3. Use `float-pi' instead.") + (put 'pi 'risky-local-variable t) + (push 'pi current-load-list)) (defconst float-e (exp 1) "The value of e (2.7182818...).") diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 85717408121..408774fbbf1 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -700,7 +700,8 @@ If CHAR is not a character, return nil." With argument, print output into current buffer." (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) ;; Setup the lexical environment if lexical-binding is enabled. - (eval-last-sexp-print-value (eval (preceding-sexp) lexical-binding)))) + (eval-last-sexp-print-value + (eval (eval-sexp-add-defvars (preceding-sexp)) lexical-binding)))) (defun eval-last-sexp-print-value (value) @@ -728,6 +729,23 @@ With argument, print output into current buffer." (defvar eval-last-sexp-fake-value (make-symbol "t")) +(defun eval-sexp-add-defvars (exp &optional pos) + "Prepend EXP with all the `defvar's that precede it in the buffer. +POS specifies the starting position where EXP was found and defaults to point." + (if (not lexical-binding) + exp + (save-excursion + (unless pos (setq pos (point))) + (let ((vars ())) + (goto-char (point-min)) + (while (re-search-forward + "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" + pos t) + (let ((var (intern (match-string 1)))) + (unless (special-variable-p var) + (push var vars)))) + `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) + (defun eval-last-sexp (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. Interactively, with prefix argument, print output into current buffer. diff --git a/lisp/startup.el b/lisp/startup.el index 765ca1540ee..ebfed702735 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,4 +1,4 @@ -;;; startup.el --- process Emacs shell arguments +;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*- ;; Copyright (C) 1985-1986, 1992, 1994-2011 Free Software Foundation, Inc. @@ -98,6 +98,7 @@ the remaining command-line args are in the variable `command-line-args-left'.") "List of command-line args not yet processed.") (defvaralias 'argv 'command-line-args-left + ;; FIXME: Bad name for a dynamically bound variable. "List of command-line args not yet processed. This is a convenience alias, so that one can write \(pop argv\) inside of --eval command line arguments in order to access @@ -326,7 +327,7 @@ this variable usefully is to set it while building and dumping Emacs." :type '(choice (const :tag "none" nil) string) :group 'initialization :initialize 'custom-initialize-default - :set (lambda (variable value) + :set (lambda (_variable _value) (error "Customizing `site-run-file' does not work"))) (defcustom mail-host-address nil @@ -1526,7 +1527,7 @@ a face or button specification." (make-button (prog1 (point) (insert-image img)) (point) 'face 'default 'help-echo "mouse-2, RET: Browse http://www.gnu.org/" - 'action (lambda (button) (browse-url "http://www.gnu.org/")) + 'action (lambda (_button) (browse-url "http://www.gnu.org/")) 'follow-link t) (insert "\n\n"))))) @@ -1539,15 +1540,15 @@ a face or button specification." :face 'variable-pitch "\nTo start... " :link '("Open a File" - (lambda (button) (call-interactively 'find-file)) + (lambda (_button) (call-interactively 'find-file)) "Specify a new file's name, to edit the file") " " :link '("Open Home Directory" - (lambda (button) (dired "~")) + (lambda (_button) (dired "~")) "Open your home directory, to operate on its files") " " :link '("Customize Startup" - (lambda (button) (customize-group 'initialization)) + (lambda (_button) (customize-group 'initialization)) "Change initialization settings including this screen") "\n")) (fancy-splash-insert @@ -1587,7 +1588,7 @@ a face or button specification." (fancy-splash-insert :face 'variable-pitch "\n" :link '("Dismiss this startup screen" - (lambda (button) + (lambda (_button) (when startup-screen-inhibit-startup-screen (customize-set-variable 'inhibit-startup-screen t) (customize-mark-to-save 'inhibit-startup-screen) @@ -1809,37 +1810,37 @@ To quit a partially entered command, type Control-g.\n") (insert "\nImportant Help menu items:\n") (insert-button "Emacs Tutorial" - 'action (lambda (button) (help-with-tutorial)) + 'action (lambda (_button) (help-with-tutorial)) 'follow-link t) (insert "\t\tLearn basic Emacs keystroke commands\n") (insert-button "Read the Emacs Manual" - 'action (lambda (button) (info-emacs-manual)) + 'action (lambda (_button) (info-emacs-manual)) 'follow-link t) (insert "\tView the Emacs manual using Info\n") (insert-button "\(Non)Warranty" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n") (insert-button "Copying Conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert "\tConditions for redistributing and changing Emacs\n") (insert-button "More Manuals / Ordering Manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert " How to order printed manuals from the FSF\n") (insert "\nUseful tasks:\n") (insert-button "Visit New File" - 'action (lambda (button) (call-interactively 'find-file)) + 'action (lambda (_button) (call-interactively 'find-file)) 'follow-link t) (insert "\t\tSpecify a new file's name, to edit the file\n") (insert-button "Open Home Directory" - 'action (lambda (button) (dired "~")) + 'action (lambda (_button) (dired "~")) 'follow-link t) (insert "\tOpen your home directory, to operate on its files\n") (insert-button "Customize Startup" - 'action (lambda (button) (customize-group 'initialization)) + 'action (lambda (_button) (customize-group 'initialization)) 'follow-link t) (insert "\tChange initialization settings including this screen\n") @@ -1873,20 +1874,20 @@ To quit a partially entered command, type Control-g.\n") (where (key-description where)) (t "M-x help"))))) (insert-button "Emacs manual" - 'action (lambda (button) (info-emacs-manual)) + 'action (lambda (_button) (info-emacs-manual)) 'follow-link t) (insert (substitute-command-keys"\t \\[info-emacs-manual]\t")) (insert-button "Browse manuals" - 'action (lambda (button) (Info-directory)) + 'action (lambda (_button) (Info-directory)) 'follow-link t) (insert (substitute-command-keys "\t \\[info]\n")) (insert-button "Emacs tutorial" - 'action (lambda (button) (help-with-tutorial)) + 'action (lambda (_button) (help-with-tutorial)) 'follow-link t) (insert (substitute-command-keys "\t \\[help-with-tutorial]\tUndo changes\t \\[undo]\n")) (insert-button "Buy manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert (substitute-command-keys "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]"))) @@ -1894,7 +1895,7 @@ To quit a partially entered command, type Control-g.\n") ;; Say how to use the menu bar with the keyboard. (insert "\n") (insert-button "Activate menubar" - 'action (lambda (button) (tmm-menubar)) + 'action (lambda (_button) (tmm-menubar)) 'follow-link t) (if (and (eq (key-binding "\M-`") 'tmm-menubar) (eq (key-binding [f10]) 'tmm-menubar)) @@ -1910,21 +1911,21 @@ If you have no Meta key, you may instead type ESC followed by the character.)") (insert "\nUseful tasks:\n") (insert-button "Visit New File" - 'action (lambda (button) (call-interactively 'find-file)) + 'action (lambda (_button) (call-interactively 'find-file)) 'follow-link t) (insert "\t\t\t") (insert-button "Open Home Directory" - 'action (lambda (button) (dired "~")) + 'action (lambda (_button) (dired "~")) 'follow-link t) (insert "\n") (insert-button "Customize Startup" - 'action (lambda (button) (customize-group 'initialization)) + 'action (lambda (_button) (customize-group 'initialization)) 'follow-link t) (insert "\t\t") (insert-button "Open *scratch* buffer" - 'action (lambda (button) (switch-to-buffer - (get-buffer-create "*scratch*"))) + 'action (lambda (_button) (switch-to-buffer + (get-buffer-create "*scratch*"))) 'follow-link t) (insert "\n") (insert "\n" (emacs-version) "\n" emacs-copyright "\n") @@ -1977,7 +1978,7 @@ Type \\[describe-distribution] for information on ")) (insert-button "Authors" 'action - (lambda (button) + (lambda (_button) (view-file (expand-file-name "AUTHORS" data-directory)) (goto-char (point-min))) 'follow-link t) @@ -1985,34 +1986,34 @@ Type \\[describe-distribution] for information on ")) (insert-button "Contributing" 'action - (lambda (button) + (lambda (_button) (view-file (expand-file-name "CONTRIBUTE" data-directory)) (goto-char (point-min))) 'follow-link t) (insert "\tHow to contribute improvements to Emacs\n\n") (insert-button "GNU and Freedom" - 'action (lambda (button) (describe-gnu-project)) + 'action (lambda (_button) (describe-gnu-project)) 'follow-link t) (insert "\t\tWhy we developed GNU Emacs and the GNU system\n") (insert-button "Absence of Warranty" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n") (insert-button "Copying Conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert "\tConditions for redistributing and changing Emacs\n") (insert-button "Getting New Versions" - 'action (lambda (button) (describe-distribution)) + 'action (lambda (_button) (describe-distribution)) 'follow-link t) (insert "\tHow to get the latest version of GNU Emacs\n") (insert-button "More Manuals / Ordering Manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert "\tBuying printed manuals from the FSF\n")) @@ -2078,7 +2079,7 @@ A fancy display is used on graphic displays, normal otherwise." (defalias 'about-emacs 'display-about-screen) (defalias 'display-splash-screen 'display-startup-screen) -(defun command-line-1 (command-line-args-left) +(defun command-line-1 (args-left) (display-startup-echo-area-message) (when (and pure-space-overflow (not noninteractive)) @@ -2089,15 +2090,12 @@ A fancy display is used on graphic displays, normal otherwise." :warning)) (let ((file-count 0) + (command-line-args-left args-left) first-file-buffer) (when command-line-args-left ;; We have command args; process them. - ;; Note that any local variables in this function affect the - ;; ability of -f batch-byte-compile to detect free variables. - ;; So we give some of them with common names a cl1- prefix. - ;; FIXME: A better fix would be to make this file use lexical-binding. - (let ((cl1-dir command-line-default-directory) - cl1-tem + (let ((dir command-line-default-directory) + tem ;; This approach loses for "-batch -L DIR --eval "(require foo)", ;; if foo is intended to be found in DIR. ;; @@ -2120,8 +2118,8 @@ A fancy display is used on graphic displays, normal otherwise." "--find-file" "--visit" "--file" "--no-desktop") (mapcar (lambda (elt) (concat "-" (car elt))) command-switch-alist))) - (cl1-line 0) - (cl1-column 0)) + (line 0) + (column 0)) ;; Add the long X options to longopts. (dolist (tem command-line-x-option-alist) @@ -2162,12 +2160,12 @@ A fancy display is used on graphic displays, normal otherwise." argi orig-argi))))) ;; Execute the option. - (cond ((setq cl1-tem (assoc argi command-switch-alist)) + (cond ((setq tem (assoc argi command-switch-alist)) (if argval (let ((command-line-args-left (cons argval command-line-args-left))) - (funcall (cdr cl1-tem) argi)) - (funcall (cdr cl1-tem) argi))) + (funcall (cdr tem) argi)) + (funcall (cdr tem) argi))) ((equal argi "-no-splash") (setq inhibit-startup-screen t)) @@ -2176,22 +2174,22 @@ A fancy display is used on graphic displays, normal otherwise." "-funcall" "-e")) ; what the source used to say (setq inhibit-startup-screen t) - (setq cl1-tem (intern (or argval (pop command-line-args-left)))) - (if (commandp cl1-tem) - (command-execute cl1-tem) - (funcall cl1-tem))) + (setq tem (intern (or argval (pop command-line-args-left)))) + (if (commandp tem) + (command-execute tem) + (funcall tem))) ((member argi '("-eval" "-execute")) (setq inhibit-startup-screen t) (eval (read (or argval (pop command-line-args-left))))) ((member argi '("-L" "-directory")) - (setq cl1-tem (expand-file-name + (setq tem (expand-file-name (command-line-normalize-file-name (or argval (pop command-line-args-left))))) - (cond (splice (setcdr splice (cons cl1-tem (cdr splice))) + (cond (splice (setcdr splice (cons tem (cdr splice))) (setq splice (cdr splice))) - (t (setq load-path (cons cl1-tem load-path) + (t (setq load-path (cons tem load-path) splice load-path)))) ((member argi '("-l" "-load")) @@ -2215,10 +2213,10 @@ A fancy display is used on graphic displays, normal otherwise." ((equal argi "-insert") (setq inhibit-startup-screen t) - (setq cl1-tem (or argval (pop command-line-args-left))) - (or (stringp cl1-tem) + (setq tem (or argval (pop command-line-args-left))) + (or (stringp tem) (error "File name omitted from `-insert' option")) - (insert-file-contents (command-line-normalize-file-name cl1-tem))) + (insert-file-contents (command-line-normalize-file-name tem))) ((equal argi "-kill") (kill-emacs t)) @@ -2231,42 +2229,42 @@ A fancy display is used on graphic displays, normal otherwise." (message "\"--no-desktop\" ignored because the Desktop package is not loaded")) ((string-match "^\\+[0-9]+\\'" argi) - (setq cl1-line (string-to-number argi))) + (setq line (string-to-number argi))) ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) - (setq cl1-line (string-to-number (match-string 1 argi)) - cl1-column (string-to-number (match-string 2 argi)))) + (setq line (string-to-number (match-string 1 argi)) + column (string-to-number (match-string 2 argi)))) - ((setq cl1-tem (assoc orig-argi command-line-x-option-alist)) + ((setq tem (assoc orig-argi command-line-x-option-alist)) ;; Ignore X-windows options and their args if not using X. (setq command-line-args-left - (nthcdr (nth 1 cl1-tem) command-line-args-left))) + (nthcdr (nth 1 tem) command-line-args-left))) - ((setq cl1-tem (assoc orig-argi command-line-ns-option-alist)) + ((setq tem (assoc orig-argi command-line-ns-option-alist)) ;; Ignore NS-windows options and their args if not using NS. (setq command-line-args-left - (nthcdr (nth 1 cl1-tem) command-line-args-left))) + (nthcdr (nth 1 tem) command-line-args-left))) ((member argi '("-find-file" "-file" "-visit")) (setq inhibit-startup-screen t) ;; An explicit option to specify visiting a file. - (setq cl1-tem (or argval (pop command-line-args-left))) - (unless (stringp cl1-tem) + (setq tem (or argval (pop command-line-args-left))) + (unless (stringp tem) (error "File name omitted from `%s' option" argi)) (setq file-count (1+ file-count)) (let ((file (expand-file-name - (command-line-normalize-file-name cl1-tem) - cl1-dir))) + (command-line-normalize-file-name tem) + dir))) (if (= file-count 1) (setq first-file-buffer (find-file file)) (find-file-other-window file))) - (unless (zerop cl1-line) + (unless (zerop line) (goto-char (point-min)) - (forward-line (1- cl1-line))) - (setq cl1-line 0) - (unless (< cl1-column 1) - (move-to-column (1- cl1-column))) - (setq cl1-column 0)) + (forward-line (1- line))) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)) ;; These command lines now have no effect. ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi) @@ -2294,19 +2292,19 @@ A fancy display is used on graphic displays, normal otherwise." (let ((file (expand-file-name (command-line-normalize-file-name orig-argi) - cl1-dir))) + dir))) (cond ((= file-count 1) (setq first-file-buffer (find-file file))) (inhibit-startup-screen (find-file-other-window file)) (t (find-file file)))) - (unless (zerop cl1-line) + (unless (zerop line) (goto-char (point-min)) - (forward-line (1- cl1-line))) - (setq cl1-line 0) - (unless (< cl1-column 1) - (move-to-column (1- cl1-column))) - (setq cl1-column 0)))))) + (forward-line (1- line))) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)))))) ;; In unusual circumstances, the execution of Lisp code due ;; to command-line options can cause the last visible frame ;; to be deleted. In this case, kill emacs to avoid an -- cgit v1.2.3 From 7200d79c65c65686495dd95e9f6dd436cf6db55e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 1 Apr 2011 11:16:50 -0400 Subject: Miscellanous cleanups in preparation for the merge. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove debug statement. * lisp/emacs-lisp/bytecomp.el (byte-compile-single-version) (byte-compile-version-cond, byte-compile-delay-out) (byte-compile-delayed-out): Remove, unused. * src/bytecode.c (Fbyte_code): Revert to old calling convention. * src/lisp.h (COMPILED_PUSH_ARGS): Remove, unused. --- doc/lispref/variables.texi | 2 +- etc/NEWS.lexbind | 2 +- lisp/ChangeLog | 9 +++ lisp/Makefile.in | 6 +- lisp/cedet/semantic/wisent/comp.el | 3 + lisp/emacs-lisp/byte-opt.el | 16 ++-- lisp/emacs-lisp/bytecomp.el | 162 ++++++++++++------------------------- lisp/emacs-lisp/cconv.el | 8 ++ lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/cl-macs.el | 2 +- lisp/emacs-lisp/cl.el | 6 +- lisp/emacs-lisp/disass.el | 1 - lisp/emacs-lisp/edebug.el | 2 +- lisp/emacs-lisp/eieio.el | 3 +- lisp/emacs-lisp/lisp-mode.el | 2 +- src/ChangeLog | 5 ++ src/bytecode.c | 41 ++++------ src/callint.c | 4 +- src/eval.c | 15 ++-- src/lisp.h | 3 +- src/lread.c | 33 +++----- src/window.c | 1 + test/automated/lexbind-tests.el | 4 +- 23 files changed, 138 insertions(+), 194 deletions(-) (limited to 'lisp/emacs-lisp/lisp-mode.el') diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index fad76ed39f8..7e2c32334a4 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1137,7 +1137,7 @@ by @code{funcall}, and they are represented by a cons cell whose @code{car} is the symbol @code{closure}. @menu -* Converting to Lexical Binding:: How to start using lexical scoping +* Converting to Lexical Binding:: How to start using lexical scoping @end menu @node Converting to Lexical Binding diff --git a/etc/NEWS.lexbind b/etc/NEWS.lexbind index de5d9a07715..a55b8e38dcf 100644 --- a/etc/NEWS.lexbind +++ b/etc/NEWS.lexbind @@ -17,7 +17,7 @@ It is typically set via file-local variables, in which case it applies to all the code in that file. ** Lexically scoped interpreted functions are represented with a new form -of function value which looks like (closure ENV lambda ARGS &rest BODY). +of function value which looks like (closure ENV ARGS &rest BODY). ** New macro `letrec' to define recursive local functions. ---------------------------------------------------------------------- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b517c48738f..f977b976c4b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2011-04-01 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-single-version) + (byte-compile-version-cond, byte-compile-delay-out) + (byte-compile-delayed-out): Remove, unused. + + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + Remove debug statement. + 2011-03-30 Stefan Monnier * subr.el (apply-partially): Use a non-nil static environment. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index ab82c99ac33..083f312d613 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -206,8 +206,8 @@ compile-onefile: @echo Compiling $(THEFILE) @# Use byte-compile-refresh-preloaded to try and work around some of @# the most common bootstrapping problems. - @$(emacs) $(BYTE_COMPILE_FLAGS) -l bytecomp \ - -f byte-compile-refresh-preloaded \ + @$(emacs) $(BYTE_COMPILE_FLAGS) \ + -l bytecomp -f byte-compile-refresh-preloaded \ -f batch-byte-compile $(THEFILE) # Files MUST be compiled one by one. If we compile several files in a @@ -292,7 +292,7 @@ compile-always: doit compile-calc: for el in $(lisp)/calc/*.el; do \ echo Compiling $$el; \ - $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ + $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1;\ done # Backup compiled Lisp files in elc.tar.gz. If that file already diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 6b473f9ad81..f92ae88c14e 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -3484,6 +3484,9 @@ Automatically called by the Emacs Lisp byte compiler as a (macroexpand-all (wisent-automaton-lisp-form (eval form))))) +;; FIXME: We shouldn't use a `byte-compile' handler. Maybe using a hash-table +;; instead of an obarray would work around the problem that obarrays +;; aren't printable. Then (put 'wisent-compile-grammar 'side-effect-free t). (put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar) (defun wisent-automaton-lisp-form (automaton) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 35c9a5ddf45..548fcd133df 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -534,7 +534,6 @@ (cons fn (mapcar #'byte-optimize-form (cdr form)))) ((not (symbolp fn)) - (debug) (byte-compile-warn "`%s' is a malformed function" (prin1-to-string fn)) form) @@ -1455,8 +1454,7 @@ byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max byte-point-min byte-following-char byte-preceding-char byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp - byte-current-buffer byte-stack-ref ;; byte-closed-var - )) + byte-current-buffer byte-stack-ref)) (defconst byte-compile-side-effect-free-ops (nconc @@ -2029,7 +2027,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (+ (cdr lap0) (cdr lap1)))) (setq lap (delq lap0 lap)) (setcdr lap1 (+ (cdr lap1) (cdr lap0)))) - + ;; ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos ;; stack-set-M [discard/discardN ...] --> discardN @@ -2053,10 +2051,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setq lap (delq lap0 lap)) (setcar lap1 (if (= tmp2 tmp3) - ;; The value stored is the new TOS, so pop - ;; one more value (to get rid of the old - ;; value) using the TOS-preserving - ;; discard operator. + ;; The value stored is the new TOS, so pop one more + ;; value (to get rid of the old value) using the + ;; TOS-preserving discard operator. 'byte-discardN-preserve-tos ;; Otherwise, the value stored is lost, so just use a ;; normal discard. @@ -2071,8 +2068,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; discardN-(X+Y) ;; ((and (memq (car lap0) - '(byte-discard - byte-discardN + '(byte-discard byte-discardN byte-discardN-preserve-tos)) (memq (car lap1) '(byte-discard byte-discardN))) (setq lap (delq lap0 lap)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5e671d7e694..7d259cda574 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -128,10 +128,6 @@ ;; The feature of compiling in a specific target Emacs version ;; has been turned off because compile time options are a bad idea. -(defmacro byte-compile-single-version () nil) -(defmacro byte-compile-version-cond (cond) cond) - - (defgroup bytecomp nil "Emacs Lisp byte-compiler." :group 'lisp) @@ -404,9 +400,7 @@ specify different fields to sort on." :type '(choice (const name) (const callers) (const calls) (const calls+callers) (const nil))) -(defvar byte-compile-debug t) -(setq debug-on-error t) - +(defvar byte-compile-debug nil) (defvar byte-compile-constants nil "List of all constants encountered during compilation of this form.") (defvar byte-compile-variables nil @@ -465,7 +459,7 @@ Used for warnings about calling a function that is defined during compilation but won't necessarily be defined when the compiled file is loaded.") ;; Variables for lexical binding -(defvar byte-compile-lexical-environment nil +(defvar byte-compile--lexical-environment nil "The current lexical environment.") (defvar byte-compile-tag-number 0) @@ -586,6 +580,7 @@ Each element is (INDEX . VALUE)") (byte-defop 114 0 byte-save-current-buffer "To make a binding to record the current buffer") (byte-defop 115 0 byte-set-mark-OBSOLETE) +;; (byte-defop 116 1 byte-interactive-p) ;Let's not use it any more. ;; These ops are new to v19 (byte-defop 117 0 byte-forward-char) @@ -621,6 +616,8 @@ otherwise pop it") (byte-defop 138 0 byte-save-excursion "to make a binding to record the buffer, point and mark") +;; (byte-defop 139 0 byte-save-window-excursion ; Obsolete: It's a macro now. +;; "to make a binding to record entire window configuration") (byte-defop 140 0 byte-save-restriction "to make a binding to record the current buffer clipping restrictions") (byte-defop 141 -1 byte-catch @@ -632,16 +629,8 @@ otherwise pop it") ;; an expression for the body, and a list of clauses. (byte-defop 143 -2 byte-condition-case) -;; For entry to with-output-to-temp-buffer. -;; Takes, on stack, the buffer name. -;; Binds standard-output and does some other things. -;; Returns with temp buffer on the stack in place of buffer name. +;; Obsolete: `with-output-to-temp-buffer' is a macro now. ;; (byte-defop 144 0 byte-temp-output-buffer-setup) - -;; For exit from with-output-to-temp-buffer. -;; Expects the temp buffer on the stack underneath value to return. -;; Pops them both, then pushes the value back on. -;; Unbinds standard-output and makes the temp buffer visible. ;; (byte-defop 145 -1 byte-temp-output-buffer-show) ;; these ops are new to v19 @@ -675,15 +664,14 @@ otherwise pop it") (byte-defop 168 0 byte-integerp) ;; unused: 169-174 - (byte-defop 175 nil byte-listN) (byte-defop 176 nil byte-concatN) (byte-defop 177 nil byte-insertN) -(byte-defop 178 -1 byte-stack-set) ; stack offset in following one byte -(byte-defop 179 -1 byte-stack-set2) ; stack offset in following two bytes +(byte-defop 178 -1 byte-stack-set) ; Stack offset in following one byte. +(byte-defop 179 -1 byte-stack-set2) ; Stack offset in following two bytes. -;; if (following one byte & 0x80) == 0 +;; If (following one byte & 0x80) == 0 ;; discard (following one byte & 0x7F) stack entries ;; else ;; discard (following one byte & 0x7F) stack entries _underneath_ TOS @@ -776,12 +764,6 @@ CONST2 may be evaulated multiple times." (error "Non-symbolic opcode `%s'" op)) ((eq op 'TAG) (setcar off pc)) - ((null op) - ;; a no-op added by `byte-compile-delay-out' - (unless (zerop off) - (error - "Placeholder added by `byte-compile-delay-out' not filled in.") - )) (t (setq opcode (if (eq op 'byte-discardN-preserve-tos) @@ -793,13 +775,13 @@ CONST2 may be evaulated multiple times." (cond ((memq op byte-goto-ops) ;; goto (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc) - (push bytes patchlist)) + (push bytes patchlist)) ((or (and (consp off) ;; Variable or constant reference (progn (setq off (cdr off)) (eq op 'byte-constant))) - (and (eq op 'byte-constant) ;; 'byte-closed-var + (and (eq op 'byte-constant) (integerp off))) ;; constant ref (if (< off byte-constant-limit) @@ -847,10 +829,9 @@ CONST2 may be evaulated multiple times." bytes pc)))))) ;;(if (not (= pc (length bytes))) ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) - - ;; Patch tag PCs into absolute jumps + ;; Patch tag PCs into absolute jumps. (dolist (bytes-tail patchlist) - (setq pc (caar bytes-tail)) ; Pick PC from goto's tag + (setq pc (caar bytes-tail)) ; Pick PC from goto's tag. (setcar (cdr bytes-tail) (logand pc 255)) (setcar bytes-tail (lsh pc -8)) ;; FIXME: Replace this by some workaround. @@ -1861,10 +1842,10 @@ With argument ARG, insert value in current buffer after the form." ;; Dynamically bound in byte-compile-from-buffer. ;; NB also used in cl.el and cl-macs.el. -(defvar byte-compile-outbuffer) +(defvar byte-compile--outbuffer) (defun byte-compile-from-buffer (inbuffer) - (let (byte-compile-outbuffer + (let (byte-compile--outbuffer (byte-compile-current-buffer inbuffer) (byte-compile-read-position nil) (byte-compile-last-position nil) @@ -1893,7 +1874,8 @@ With argument ARG, insert value in current buffer after the form." ) (byte-compile-close-variables (with-current-buffer - (setq byte-compile-outbuffer (get-buffer-create " *Compiler Output*")) + (setq byte-compile--outbuffer + (get-buffer-create " *Compiler Output*")) (set-buffer-multibyte t) (erase-buffer) ;; (emacs-lisp-mode) @@ -1902,7 +1884,7 @@ With argument ARG, insert value in current buffer after the form." (with-current-buffer inbuffer (and byte-compile-current-file (byte-compile-insert-header byte-compile-current-file - byte-compile-outbuffer)) + byte-compile--outbuffer)) (goto-char (point-min)) ;; Should we always do this? When calling multiple files, it ;; would be useful to delay this warning until all have been @@ -1935,9 +1917,9 @@ and will be removed soon. See (elisp)Backquote in the manual.")) ;; Fix up the header at the front of the output ;; if the buffer contains multibyte characters. (and byte-compile-current-file - (with-current-buffer byte-compile-outbuffer + (with-current-buffer byte-compile--outbuffer (byte-compile-fix-header byte-compile-current-file))))) - byte-compile-outbuffer)) + byte-compile--outbuffer)) (defun byte-compile-fix-header (filename) "If the current buffer has any multibyte characters, insert a version test." @@ -2046,8 +2028,8 @@ Call from the source buffer." (print-gensym t) (print-circle ; handle circular data structures (not byte-compile-disable-print-circle))) - (princ "\n" byte-compile-outbuffer) - (prin1 form byte-compile-outbuffer) + (princ "\n" byte-compile--outbuffer) + (prin1 form byte-compile--outbuffer) nil))) (defvar print-gensym-alist) ;Used before print-circle existed. @@ -2067,7 +2049,7 @@ list that represents a doc string reference. ;; We need to examine byte-compile-dynamic-docstrings ;; in the input buffer (now current), not in the output buffer. (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (with-current-buffer byte-compile-outbuffer + (with-current-buffer byte-compile--outbuffer (let (position) ;; Insert the doc string, and make it a comment with #@LENGTH. @@ -2091,7 +2073,7 @@ list that represents a doc string reference. (if preface (progn (insert preface) - (prin1 name byte-compile-outbuffer))) + (prin1 name byte-compile--outbuffer))) (insert (car info)) (let ((print-escape-newlines t) (print-quoted t) @@ -2106,7 +2088,7 @@ list that represents a doc string reference. (print-continuous-numbering t) print-number-table (index 0)) - (prin1 (car form) byte-compile-outbuffer) + (prin1 (car form) byte-compile--outbuffer) (while (setq form (cdr form)) (setq index (1+ index)) (insert " ") @@ -2129,21 +2111,22 @@ list that represents a doc string reference. (setq position (- (position-bytes position) (point-min) -1)) (princ (format "(#$ . %d) nil" position) - byte-compile-outbuffer) + byte-compile--outbuffer) (setq form (cdr form)) (setq index (1+ index)))) ((= index (nth 1 info)) (if position (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") position) - byte-compile-outbuffer) + byte-compile--outbuffer) (let ((print-escape-newlines nil)) (goto-char (prog1 (1+ (point)) - (prin1 (car form) byte-compile-outbuffer))) + (prin1 (car form) + byte-compile--outbuffer))) (insert "\\\n") (goto-char (point-max))))) (t - (prin1 (car form) byte-compile-outbuffer))))) + (prin1 (car form) byte-compile--outbuffer))))) (insert (nth 2 info))))) nil) @@ -2428,7 +2411,7 @@ by side-effects." ;; Remove declarations from the body of the macro definition. (when macrop (dolist (decl (byte-compile-defmacro-declaration form)) - (prin1 decl byte-compile-outbuffer))) + (prin1 decl byte-compile--outbuffer))) (let* ((code (byte-compile-lambda (nthcdr 2 form) t))) (if this-one @@ -2458,7 +2441,7 @@ by side-effects." (and (atom code) byte-compile-dynamic 1) nil)) - (princ ")" byte-compile-outbuffer) + (princ ")" byte-compile--outbuffer) nil))) ;; Print Lisp object EXP in the output file, inside a comment, @@ -2466,13 +2449,13 @@ by side-effects." ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. (defun byte-compile-output-as-comment (exp quoted) (let ((position (point))) - (with-current-buffer byte-compile-outbuffer + (with-current-buffer byte-compile--outbuffer ;; Insert EXP, and make it a comment with #@LENGTH. (insert " ") (if quoted - (prin1 exp byte-compile-outbuffer) - (princ exp byte-compile-outbuffer)) + (prin1 exp byte-compile--outbuffer) + (princ exp byte-compile--outbuffer)) (goto-char position) ;; Quote certain special characters as needed. ;; get_doc_string in doc.c does the unquoting. @@ -2732,7 +2715,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-tag-number 0) (byte-compile-depth 0) (byte-compile-maxdepth 0) - (byte-compile-lexical-environment lexenv) + (byte-compile--lexical-environment lexenv) (byte-compile-reserved-constants (or reserved-csts 0)) (byte-compile-output nil)) (if (memq byte-optimize '(t source)) @@ -2743,7 +2726,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (when (and lexical-binding (eq output-type 'lambda)) ;; See how many arguments there are, and set the current stack depth ;; accordingly. - (setq byte-compile-depth (length byte-compile-lexical-environment)) + (setq byte-compile-depth (length byte-compile--lexical-environment)) ;; If there are args, output a tag to record the initial ;; stack-depth for the optimizer. (when (> byte-compile-depth 0) @@ -2789,7 +2772,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; progn -> as <> or (progn <> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. (let (rest - (byte-compile--for-effect for-effect) ;FIXME: Probably unused! (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. tmp body) (cond @@ -2975,6 +2957,7 @@ That command is designed for interactive use only" fn)) (byte-compile-out-tag endtag))) (defun byte-compile-unfold-bcf (form) + "Inline call to byte-code-functions." (let* ((byte-compile-bound-variables byte-compile-bound-variables) (fun (car form)) (fargs (aref fun 0)) @@ -3056,7 +3039,7 @@ If BINDING is non-nil, VAR is being bound." (defun byte-compile-variable-ref (var) "Generate code to push the value of the variable VAR on the stack." (byte-compile-check-variable var) - (let ((lex-binding (assq var byte-compile-lexical-environment))) + (let ((lex-binding (assq var byte-compile--lexical-environment))) (if lex-binding ;; VAR is lexically bound (byte-compile-stack-ref (cdr lex-binding)) @@ -3072,7 +3055,7 @@ If BINDING is non-nil, VAR is being bound." (defun byte-compile-variable-set (var) "Generate code to set the variable VAR from the top-of-stack value." (byte-compile-check-variable var) - (let ((lex-binding (assq var byte-compile-lexical-environment))) + (let ((lex-binding (assq var byte-compile--lexical-environment))) (if lex-binding ;; VAR is lexically bound (byte-compile-stack-set (cdr lex-binding)) @@ -3181,6 +3164,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler bobp 0) (byte-defop-compiler current-buffer 0) ;;(byte-defop-compiler read-char 0) ;; obsolete +;; (byte-defop-compiler interactive-p 0) ;; Obsolete. (byte-defop-compiler widen 0) (byte-defop-compiler end-of-line 0-1) (byte-defop-compiler forward-char 0-1) @@ -3355,6 +3339,7 @@ discarding." (defconst byte-compile--env-var (make-symbol "env")) (defun byte-compile-make-closure (form) + "Byte-compile the special `internal-make-closure' form." (if byte-compile--for-effect (setq byte-compile--for-effect nil) (let* ((vars (nth 1 form)) (env (nth 2 form)) @@ -3366,12 +3351,11 @@ discarding." ',(aref fun 0) ',(aref fun 1) (vconcat (vector . ,env) ',(aref fun 2)) ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) - (defun byte-compile-get-closed-var (form) + "Byte-compile the special `internal-get-closed-var' form." (if byte-compile--for-effect (setq byte-compile--for-effect nil) - (byte-compile-out 'byte-constant ;; byte-closed-var - (nth 1 form)))) + (byte-compile-out 'byte-constant (nth 1 form)))) ;; Compile a function that accepts one or more args and is right-associative. ;; We do it by left-associativity so that the operations @@ -3856,7 +3840,7 @@ Return the offset in the form (VAR . OFFSET)." (keywordp var))) (defun byte-compile-bind (var init-lexenv) - "Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'. + "Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'. INIT-LEXENV should be a lexical-environment alist describing the positions of the init value that have been pushed on the stack. Return non-nil if the TOS value was popped." @@ -3866,7 +3850,7 @@ Return non-nil if the TOS value was popped." (cond ((not (byte-compile-not-lexical-var-p var)) ;; VAR is a simple stack-allocated lexical variable (push (assq var init-lexenv) - byte-compile-lexical-environment) + byte-compile--lexical-environment) nil) ((eq var (caar init-lexenv)) ;; VAR is dynamic and is on the top of the @@ -3898,7 +3882,7 @@ binding slots have been popped." (let ((num-dynamic-bindings 0)) (dolist (clause clauses) (unless (assq (if (consp clause) (car clause) clause) - byte-compile-lexical-environment) + byte-compile--lexical-environment) (setq num-dynamic-bindings (1+ num-dynamic-bindings)))) (unless (zerop num-dynamic-bindings) (byte-compile-out 'byte-unbind num-dynamic-bindings))) @@ -3918,7 +3902,8 @@ binding slots have been popped." (push (byte-compile-push-binding-init var) init-lexenv))) ;; New scope. (let ((byte-compile-bound-variables byte-compile-bound-variables) - (byte-compile-lexical-environment byte-compile-lexical-environment)) + (byte-compile--lexical-environment + byte-compile--lexical-environment)) ;; Bind the variables. ;; For `let', do it in reverse order, because it makes no ;; semantic difference, but it is a lot more efficient since the @@ -3969,7 +3954,6 @@ binding slots have been popped." "Compiler error: `%s' has no `byte-compile-negated-op' property" (car form))) (cdr form)))) - ;;; other tricky macro-like special-forms @@ -3979,6 +3963,8 @@ binding slots have been popped." (byte-defop-compiler-1 save-excursion) (byte-defop-compiler-1 save-current-buffer) (byte-defop-compiler-1 save-restriction) +;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro. +;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro. (byte-defop-compiler-1 track-mouse) (defun byte-compile-catch (form) @@ -4286,7 +4272,7 @@ OP and OPERAND are as passed to `byte-compile-out'." ;; that take OPERAND values off the stack and push a result, for ;; a total of 1 - OPERAND (- 1 operand)))) - + (defun byte-compile-out (op &optional operand) (push (cons op operand) byte-compile-output) (if (eq op 'byte-return) @@ -4298,50 +4284,6 @@ OP and OPERAND are as passed to `byte-compile-out'." (setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth)) ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow")) )) - -(defun byte-compile-delay-out (&optional stack-used stack-adjust) - "Add a placeholder to the output, which can be used to later add byte-codes. -Return a position tag that can be passed to `byte-compile-delayed-out' -to add the delayed byte-codes. STACK-USED is the maximum amount of -stack-spaced used by the delayed byte-codes (defaulting to 0), and -STACK-ADJUST is the amount by which the later-added code will adjust the -stack (defaulting to 0); the byte-codes added later _must_ adjust the -stack by this amount! If STACK-ADJUST is 0, then it's not necessary to -actually add anything later; the effect as if nothing was added at all." - ;; We just add a no-op to `byte-compile-output', and return a pointer to - ;; the tail of the list; `byte-compile-delayed-out' uses list surgery - ;; to add the byte-codes. - (when stack-used - (setq byte-compile-maxdepth - (max byte-compile-depth (+ byte-compile-depth (or stack-used 0))))) - (when stack-adjust - (setq byte-compile-depth - (+ byte-compile-depth stack-adjust))) - (push (cons nil (or stack-adjust 0)) byte-compile-output)) - -(defun byte-compile-delayed-out (position op &optional operand) - "Add at POSITION the byte-operation OP, with optional numeric arg OPERAND. -POSITION should a position returned by `byte-compile-delay-out'. -Return a new position, which can be used to add further operations." - (unless (null (caar position)) - (error "Bad POSITION arg to `byte-compile-delayed-out'")) - ;; This is kind of like `byte-compile-out', but we splice into the list - ;; where POSITION is. We don't bother updating `byte-compile-maxdepth' - ;; because that was already done by `byte-compile-delay-out', but we do - ;; update the relative operand stored in the no-op marker currently at - ;; POSITION; since we insert before that marker, this means that if the - ;; caller doesn't insert a sequence of byte-codes that matches the expected - ;; operand passed to `byte-compile-delay-out', then the nop will still have - ;; a non-zero operand when `byte-compile-lapcode' is called, which will - ;; cause an error to be signaled. - - ;; Adjust the cumulative stack-adjustment stored in the cdr of the no-op - (setcdr (car position) - (- (cdar position) (byte-compile-stack-adjustment op operand))) - ;; Add the new operation onto the list tail at POSITION - (setcdr position (cons (cons op operand) (cdr position))) - position) - ;;; call tree stuff diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 46d14880a2c..5cc9ecb4cf7 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -67,15 +67,23 @@ ;; TODO: (not just for cconv but also for the lexbind changes in general) ;; - let (e)debug find the value of lexical variables from the stack. +;; - make eval-region do the eval-sexp-add-defvars danse. ;; - byte-optimize-form should be applied before cconv. ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize ;; since afterwards they can because obnoxious (warnings about an "unused ;; variable" should not be emitted when the variable use has simply been ;; optimized away). +;; - turn defun and defmacro into macros (and remove special handling of +;; `declare' afterwards). +;; - let macros specify that some let-bindings come from the same source, +;; so the unused warning takes all uses into account. +;; - let interactive specs return a function to build the args (to stash into +;; command-history). ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - new byte codes for unwind-protect, catch, and condition-case so that ;; closures aren't needed at all. +;; - inline source code of different binding mode by first compiling it. ;; - a reference to a var that is known statically to always hold a constant ;; should be turned into a byte-constant rather than a byte-stack-ref. ;; Hmm... right, that's called constant propagation and could be done here, diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 8bcbd67f46b..4c824d4a6d4 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "c4734fbda33043d967624d39d80c3304") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "fe8a5acbe14e32846a77578b2165fab5") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 7aac5bdaa01..9ce3dd6a7fe 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -497,7 +497,7 @@ The result of the body appears to the compiler as a quoted constant." (symbol-function 'byte-compile-file-form))) (list 'byte-compile-file-form (list 'quote set)) '(byte-compile-file-form form))) - (print set (symbol-value 'byte-compile-outbuffer))) + (print set (symbol-value 'byte-compile--outbuffer))) (list 'symbol-value (list 'quote temp))) (list 'quote (eval form)))) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 9c626dfcfa3..526475eb1bd 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -278,9 +278,9 @@ definitions to shadow the loaded ones for use in file byte-compilation. (defvar cl-compiling-file nil) (defun cl-compiling-file () (or cl-compiling-file - (and (boundp 'byte-compile-outbuffer) - (bufferp (symbol-value 'byte-compile-outbuffer)) - (equal (buffer-name (symbol-value 'byte-compile-outbuffer)) + (and (boundp 'byte-compile--outbuffer) + (bufferp (symbol-value 'byte-compile--outbuffer)) + (equal (buffer-name (symbol-value 'byte-compile--outbuffer)) " *Compiler Output*")))) (defvar cl-proclaims-deferred nil) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 9318876fe61..4fd10185c17 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -72,7 +72,6 @@ redefine OBJECT if it is a symbol." (let ((macro 'nil) (name 'nil) (doc 'nil) - (lexical-binding nil) args) (while (symbolp obj) (setq name obj diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8135b5c4f24..f84de0308bf 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3640,7 +3640,7 @@ Return the result of the last expression." (eval (if (bound-and-true-p cl-debug-env) (cl-macroexpand-all edebug-expr cl-debug-env) edebug-expr) - lexical-binding)) ;; FIXME: lexbind. + lexical-binding)) (defun edebug-safe-eval (edebug-expr) ;; Evaluate EXPR safely. diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 4e443452d8b..7a119e6bbc0 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -96,6 +96,7 @@ default setting for optimization purposes.") "Non-nil means to optimize the method dispatch on primary methods.") ;; State Variables +;; FIXME: These two constants below should have an `eieio-' prefix added!! (defvar this nil "Inside a method, this variable is the object in question. DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots. @@ -122,7 +123,7 @@ execute a `call-next-method'. DO NOT SET THIS YOURSELF!") ;; while it is being built itself. (defvar eieio-default-superclass nil) -;; FIXME: The constants below should have a `eieio-' prefix added!! +;; FIXME: The constants below should have an `eieio-' prefix added!! (defconst class-symbol 1 "Class's symbol (self-referencing.).") (defconst class-parent 2 "Class parent slot.") (defconst class-children 3 "Class children class slot.") diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 408774fbbf1..39bdb505039 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -745,7 +745,7 @@ POS specifies the starting position where EXP was found and defaults to point." (unless (special-variable-p var) (push var vars)))) `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) - + (defun eval-last-sexp (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. Interactively, with prefix argument, print output into current buffer. diff --git a/src/ChangeLog b/src/ChangeLog index e34cd694321..04064adbaa3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-04-01 Stefan Monnier + + * bytecode.c (Fbyte_code): Revert to old calling convention. + * lisp.h (COMPILED_PUSH_ARGS): Remove, unused. + 2011-03-16 Stefan Monnier * image.c (parse_image_spec): Use Ffunctionp. diff --git a/src/bytecode.c b/src/bytecode.c index 01ae8055ebf..5d94cb0fb39 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -#define BYTE_CODE_SAFE 1 +/* #define BYTE_CODE_SAFE */ /* #define BYTE_CODE_METER */ @@ -160,7 +160,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #ifdef BYTE_CODE_SAFE #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ #endif -#define Binteractive_p 0164 /* Obsolete. */ +#define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */ #define Bforward_char 0165 #define Bforward_word 0166 @@ -185,16 +185,16 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bdup 0211 #define Bsave_excursion 0212 -#define Bsave_window_excursion 0213 /* Obsolete. */ +#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */ #define Bsave_restriction 0214 #define Bcatch 0215 #define Bunwind_protect 0216 #define Bcondition_case 0217 -#define Btemp_output_buffer_setup 0220 /* Obsolete. */ -#define Btemp_output_buffer_show 0221 /* Obsolete. */ +#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */ +#define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */ -#define Bunbind_all 0222 /* Obsolete. */ +#define Bunbind_all 0222 /* Obsolete. Never used. */ #define Bset_marker 0223 #define Bmatch_beginning 0224 @@ -413,24 +413,15 @@ unmark_byte_stack (void) } while (0) -DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, MANY, 0, +DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, doc: /* Function used internally in byte-compiled code. The first argument, BYTESTR, is a string of byte code; the second, VECTOR, a vector of constants; the third, MAXDEPTH, the maximum stack depth used in this function. -If the third argument is incorrect, Emacs may crash. - -If ARGS-TEMPLATE is specified, it is an argument list specification, -according to which any remaining arguments are pushed on the stack -before executing BYTESTR. - -usage: (byte-code BYTESTR VECTOR MAXDEP &optional ARGS-TEMPLATE &rest ARGS) */) - (size_t nargs, Lisp_Object *args) +If the third argument is incorrect, Emacs may crash. */) + (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) { - Lisp_Object args_tmpl = nargs >= 4 ? args[3] : Qnil; - int pnargs = nargs >= 4 ? nargs - 4 : 0; - Lisp_Object *pargs = nargs >= 4 ? args + 4 : 0; - return exec_byte_code (args[0], args[1], args[2], args_tmpl, pnargs, pargs); + return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); } /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and @@ -810,7 +801,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Bunbind_all: /* Obsolete. */ + case Bunbind_all: /* Obsolete. Never used. */ /* To unbind back to the beginning of this frame. Not used yet, but will be needed for tail-recursion elimination. */ BEFORE_POTENTIAL_GC (); @@ -938,12 +929,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_excursion_save ()); break; - case Bsave_current_buffer: /* Obsolete. */ + case Bsave_current_buffer: /* Obsolete since ??. */ case Bsave_current_buffer_1: record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); break; - case Bsave_window_excursion: /* Obsolete. */ + case Bsave_window_excursion: /* Obsolete since 24.1. */ { register int count = SPECPDL_INDEX (); record_unwind_protect (Fset_window_configuration, @@ -985,7 +976,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, break; } - case Btemp_output_buffer_setup: /* Obsolete. */ + case Btemp_output_buffer_setup: /* Obsolete since 24.1. */ BEFORE_POTENTIAL_GC (); CHECK_STRING (TOP); temp_output_buffer_setup (SSDATA (TOP)); @@ -993,7 +984,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = Vstandard_output; break; - case Btemp_output_buffer_show: /* Obsolete. */ + case Btemp_output_buffer_show: /* Obsolete since 24.1. */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); @@ -1465,7 +1456,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Binteractive_p: /* Obsolete. */ + case Binteractive_p: /* Obsolete since 24.1. */ PUSH (Finteractive_p ()); break; diff --git a/src/callint.c b/src/callint.c index 489fa392e46..60570369d9e 100644 --- a/src/callint.c +++ b/src/callint.c @@ -171,8 +171,8 @@ static void fix_command (Lisp_Object input, Lisp_Object values) { /* FIXME: Instead of this ugly hack, we should provide a way for an - interactive spec to return an expression that will re-build the args - without user intervention. */ + interactive spec to return an expression/function that will re-build the + args without user intervention. */ if (CONSP (input)) { Lisp_Object car; diff --git a/src/eval.c b/src/eval.c index 9f90e6df4b5..0e47d7c757c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -117,10 +117,10 @@ Lisp_Object Vsignaling_function; int handling_signal; -static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *); static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; static int interactive_p (int); +static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); void init_eval_once (void) @@ -684,7 +684,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) tail = Fcons (lambda_list, tail); else tail = Fcons (lambda_list, Fcons (doc, tail)); - + defn = Fcons (Qlambda, tail); if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ defn = Ffunction (Fcons (defn, Qnil)); @@ -1012,11 +1012,8 @@ usage: (let* VARLIST BODY...) */) varlist = XCDR (varlist); } - UNGCPRO; - val = Fprogn (Fcdr (args)); - return unbind_to (count, val); } @@ -2083,7 +2080,8 @@ then strings and vectors are not accepted. */) return Qnil; funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) + ? Qt : if_prop); else if (EQ (funcar, Qlambda)) return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; else if (EQ (funcar, Qautoload)) @@ -2898,7 +2896,7 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, /* The caller should GCPRO all the elements of ARGS. */ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, - doc: /* Return non-nil if OBJECT is a type of object that can be called as a function. */) + doc: /* Non-nil if OBJECT is a function. */) (Lisp_Object object) { if (SYMBOLP (object) && !NILP (Ffboundp (object))) @@ -3220,7 +3218,7 @@ funcall_lambda (Lisp_Object fun, size_t nargs, xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); else val = Qnil; - + /* Bind the argument. */ if (!NILP (lexenv) && SYMBOLP (next)) /* Lexically bind NEXT by adding it to the lexenv alist. */ @@ -3501,7 +3499,6 @@ context where binding is lexical by default. */) } - DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0, doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG. The debugger is entered when that frame exits, if the flag is non-nil. */) diff --git a/src/lisp.h b/src/lisp.h index bd70dcebbdb..580dbd11013 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1483,7 +1483,6 @@ typedef unsigned char UCHAR; #define COMPILED_STACK_DEPTH 3 #define COMPILED_DOC_STRING 4 #define COMPILED_INTERACTIVE 5 -#define COMPILED_PUSH_ARGS 6 /* Flag bits in a character. These also get used in termhooks.h. Richard Stallman thinks that MULE @@ -3264,7 +3263,7 @@ extern int read_bytecode_char (int); /* Defined in bytecode.c */ extern Lisp_Object Qbytecode; -EXFUN (Fbyte_code, MANY); +EXFUN (Fbyte_code, 3); extern void syms_of_bytecode (void); extern struct byte_stack *byte_stack_list; #ifdef BYTE_MARK_STACK diff --git a/src/lread.c b/src/lread.c index 24183532527..6a24569f552 100644 --- a/src/lread.c +++ b/src/lread.c @@ -796,16 +796,16 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) } beg_end_state = NOMINAL; int in_file_vars = 0; -#define UPDATE_BEG_END_STATE(ch) \ - if (beg_end_state == NOMINAL) \ - beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \ - else if (beg_end_state == AFTER_FIRST_DASH) \ - beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \ - else if (beg_end_state == AFTER_ASTERIX) \ - { \ - if (ch == '-') \ - in_file_vars = !in_file_vars; \ - beg_end_state = NOMINAL; \ +#define UPDATE_BEG_END_STATE(ch) \ + if (beg_end_state == NOMINAL) \ + beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL); \ + else if (beg_end_state == AFTER_FIRST_DASH) \ + beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL); \ + else if (beg_end_state == AFTER_ASTERIX) \ + { \ + if (ch == '-') \ + in_file_vars = !in_file_vars; \ + beg_end_state = NOMINAL; \ } /* Skip until we get to the file vars, if any. */ @@ -834,7 +834,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) UPDATE_BEG_END_STATE (ch); ch = READCHAR; } - + while (var_end > var && (var_end[-1] == ' ' || var_end[-1] == '\t')) var_end--; @@ -880,7 +880,6 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) return rv; } } - /* Value is a version number of byte compiled code if the file associated with file descriptor FD is a compiled Lisp file that's @@ -1275,7 +1274,6 @@ Return t if the file exists and loads successfully. */) specbind (Qinhibit_file_name_operation, Qnil); load_descriptor_list = Fcons (make_number (fileno (stream)), load_descriptor_list); - specbind (Qload_in_progress, Qt); instream = stream; @@ -1863,11 +1861,9 @@ This function preserves the position of point. */) specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); specbind (Qstandard_output, tem); - specbind (Qlexical_binding, Qnil); record_unwind_protect (save_excursion_restore, save_excursion_save ()); BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); - if (lisp_file_lexically_bound_p (buf)) - Fset (Qlexical_binding, Qt); + specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil); readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); @@ -3336,7 +3332,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) for (i = 0; i < size; i++) { item = Fcar (tem); - /* If `load-force-doc-strings' is t when reading a lazily-loaded bytecode object, the docstring containing the bytecode and constants values must be treated as unibyte and passed to @@ -3394,7 +3389,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) tem = Fcdr (tem); free_cons (otem); } - return vector; } @@ -4024,7 +4018,6 @@ defvar_lisp (struct Lisp_Objfwd *o_fwd, staticpro (address); } - /* Similar but define a variable whose value is the Lisp Object stored at a particular offset in the current kboard object. */ @@ -4470,7 +4463,7 @@ to load. See also `load-dangerous-libraries'. */); doc: /* If non-nil, use lexical binding when evaluating code. This only applies to code evaluated by `eval-buffer' and `eval-region'. This variable is automatically set from the file variables of an interpreted - lisp file read using `load'. */); + Lisp file read using `load'. */); Fmake_variable_buffer_local (Qlexical_binding); DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list, diff --git a/src/window.c b/src/window.c index 4bd533c22ac..7e40cdff42b 100644 --- a/src/window.c +++ b/src/window.c @@ -3649,6 +3649,7 @@ displaying that buffer. */) return Qnil; } + void temp_output_buffer_show (register Lisp_Object buf) { diff --git a/test/automated/lexbind-tests.el b/test/automated/lexbind-tests.el index 1ff31e2422d..95b8bbe8858 100644 --- a/test/automated/lexbind-tests.el +++ b/test/automated/lexbind-tests.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2011 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Keywords: +;; Keywords: ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ ;;; Commentary: -;; +;; ;;; Code: -- cgit v1.2.3