From ba83908c4b7fda12991ae9073028a60da87c1fa2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 11 Mar 2011 15:04:22 -0500 Subject: [PATCH] Misc fixes, and use lexical-binding in more files. * lisp/subr.el (letrec): New macro. (with-wrapper-hook): Move from lisp/simple.el and don't use CL. * simple.el (with-wrapper-hook): Move with-wrapper-hook to subr.el. * lisp/help-fns.el (help-function-arglist): Handle subroutines as well. (describe-variable): Use special-variable-p to filter completions. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Don't expand `declare' in defmacros. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Handle `declare'. * lisp/emacs-lisp/cl.el (pushnew): Silence unfixable warning. * lisp/emacs-lisp/cl-macs.el (defstruct, define-compiler-macro): Mark unused arg as unused. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Use memq. * lisp/emacs-lisp/autoload.el (make-autoload): Don't assume the macro's first sexp is a list. (autoload-generate-file-autoloads): Improve error message. * lisp/emacs-lisp/advice.el (ad-arglist): Use help-function-arglist to understand the new byte-code arg format. * lisp/vc/smerge-mode.el: * lisp/vc/log-view.el: * lisp/vc/log-edit.el: * lisp/vc/cvs-status.el: * lisp/uniquify.el: * lisp/textmodes/css-mode.el: * lisp/textmodes/bibtex-style.el: * lisp/reveal.el: * lisp/newcomment.el: * lisp/emacs-lisp/smie.el: * lisp/abbrev.el: Use lexical-binding. * src/eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. (Fdefvar): Remove redundant SYMBOLP check. (Ffunctionp): Don't signal an error for undefined aliases. * doc/lispref/variables.texi (Converting to Lexical Binding): New node. --- doc/lispref/ChangeLog | 4 +++ doc/lispref/variables.texi | 40 +++++++++++++++++++++- etc/NEWS.lexbind | 3 +- lisp/ChangeLog | 32 ++++++++++++++++++ lisp/abbrev.el | 29 ++++++++-------- lisp/emacs-lisp/advice.el | 16 +++------ lisp/emacs-lisp/autoload.el | 5 +-- lisp/emacs-lisp/byte-opt.el | 11 +++--- lisp/emacs-lisp/bytecomp.el | 34 ++++++++++--------- lisp/emacs-lisp/cconv.el | 4 +++ lisp/emacs-lisp/cl-loaddefs.el | 17 ++++++---- lisp/emacs-lisp/cl-macs.el | 14 ++++---- lisp/emacs-lisp/cl.el | 9 ++++- lisp/emacs-lisp/macroexp.el | 11 +++++- lisp/emacs-lisp/smie.el | 4 +-- lisp/help-fns.el | 22 ++++++++++-- lisp/mpc.el | 4 +-- lisp/newcomment.el | 4 +-- lisp/reveal.el | 2 +- lisp/simple.el | 45 ------------------------- lisp/subr.el | 61 ++++++++++++++++++++++++++++++++++ lisp/textmodes/bibtex-style.el | 4 +-- lisp/textmodes/css-mode.el | 2 +- lisp/uniquify.el | 2 +- lisp/vc/cvs-status.el | 46 ++++++++++++++----------- lisp/vc/diff-mode.el | 53 +++++++++++++++-------------- lisp/vc/log-edit.el | 6 ++-- lisp/vc/log-view.el | 3 +- lisp/vc/smerge-mode.el | 2 +- src/ChangeLog | 6 ++++ src/eval.c | 25 ++++++-------- 31 files changed, 329 insertions(+), 191 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index ab993fe35a..8a1ccef335 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,7 @@ +2011-03-11 Stefan Monnier + + * variables.texi (Converting to Lexical Binding): New node. + 2011-03-01 Stefan Monnier * variables.texi (Scope): Mention the availability of lexical scoping. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 27ec4831cb..fad76ed39f 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -912,7 +912,7 @@ dynamically scoped, like all variables in Emacs Lisp. * Extent:: Extent means how long in time a value exists. * Impl of Scope:: Two ways to implement dynamic scoping. * Using Scoping:: How to use dynamic scoping carefully and avoid problems. -* Lexical Binding:: +* Lexical Binding:: Use of lexical scoping. @end menu @node Scope @@ -1136,6 +1136,44 @@ body can later be evaluated in the proper context. Those objects are called 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 +@end menu + +@node Converting to Lexical Binding +@subsubsection Converting a package to use lexical scoping + +Lexical scoping, as currently implemented, does not bring many significant +benefits, unless you are a seasoned functional programmer addicted to +higher-order functions. But its importance will increase in the future: +lexical scoping opens up a lot more opportunities for optimization, so +lexically scoped code is likely to run faster in future Emacs versions, and it +is much more friendly to concurrency, which we want to add in the near future. + +Converting a package to lexical binding is usually pretty easy and should not +break backward compatibility: just add a file-local variable setting +@code{lexical-binding} to @code{t} and add declarations of the form +@code{(defvar @var{VAR})} for every variable which still needs to use +dynamic scoping. + +To find which variables need this declaration, the simplest solution is to +check the byte-compiler's warnings. The byte-compiler will usually find those +variables either because they are used outside of a let-binding (leading to +warnings about reference or assignment to ``free variable @var{VAR}'') or +because they are let-bound but not used within the let-binding (leading to +warnings about ``unused lexical variable @var{VAR}''). + +In cases where a dynamically scoped variable was bound as a function argument, +you will also need to move this binding to a @code{let}. These cases are also +flagged by the byte-compiler. + +To silence byte-compiler warnings about unused variables, just use a variable +name that start with an underscore, which the byte-compiler interpret as an +indication that this is a variable known not to be used. + +In most cases, the resulting code will then work with either setting of +@code{lexical-binding}, so it can still be used with older Emacsen (which will +simply ignore the @code{lexical-binding} variable setting). @node Buffer-Local Variables @section Buffer-Local Variables diff --git a/etc/NEWS.lexbind b/etc/NEWS.lexbind index bcb56c313f..de5d9a0771 100644 --- a/etc/NEWS.lexbind +++ b/etc/NEWS.lexbind @@ -18,7 +18,8 @@ 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). - +** New macro `letrec' to define recursive local functions. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fd00cf70f4..0b432eb46d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,35 @@ +2011-03-11 Stefan Monnier + + * subr.el (letrec): New macro. + (with-wrapper-hook): Move from simple.el and don't use CL. + * simple.el (with-wrapper-hook): Move with-wrapper-hook to subr.el. + * help-fns.el (help-function-arglist): Handle subroutines as well. + (describe-variable): Use special-variable-p to filter completions. + * emacs-lisp/macroexp.el (macroexpand-all-1): Don't expand `declare' + in defmacros. + * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): + Handle `declare'. + * emacs-lisp/cl.el (pushnew): Silence unfixable warning. + * emacs-lisp/cl-macs.el (defstruct, define-compiler-macro): + Mark unused arg as unused. + * emacs-lisp/byte-opt.el (byte-optimize-lapcode): Use memq. + * emacs-lisp/autoload.el (make-autoload): Don't assume the macro's + first sexp is a list. + (autoload-generate-file-autoloads): Improve error message. + * emacs-lisp/advice.el (ad-arglist): Use help-function-arglist + to understand the new byte-code arg format. + * vc/smerge-mode.el: + * vc/log-view.el: + * vc/log-edit.el: + * vc/cvs-status.el: + * uniquify.el: + * textmodes/css-mode.el: + * textmodes/bibtex-style.el: + * reveal.el: + * newcomment.el: + * emacs-lisp/smie.el: + * abbrev.el: Use lexical-binding. + 2011-03-10 Stefan Monnier * emacs-lisp/bytecomp.el: Use lexical-binding. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index fbca214a64..3844391a18 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1,4 +1,4 @@ -;;; abbrev.el --- abbrev mode commands for Emacs +;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc. @@ -767,20 +767,19 @@ Returns the abbrev symbol, if expansion took place." (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym - (let ((value sym)) - (unless (or ;; executing-kbd-macro - noninteractive - (window-minibuffer-p (selected-window))) - ;; Add an undo boundary, in case we are doing this for - ;; a self-inserting command which has avoided making one so far. - (undo-boundary)) - ;; Now sym is the abbrev symbol. - (setq last-abbrev-text name) - (setq last-abbrev sym) - (setq last-abbrev-location wordstart) - ;; If this abbrev has an expansion, delete the abbrev - ;; and insert the expansion. - (abbrev-insert sym name wordstart wordend)))))) + (unless (or ;; executing-kbd-macro + noninteractive + (window-minibuffer-p (selected-window))) + ;; Add an undo boundary, in case we are doing this for + ;; a self-inserting command which has avoided making one so far. + (undo-boundary)) + ;; Now sym is the abbrev symbol. + (setq last-abbrev-text name) + (setq last-abbrev sym) + (setq last-abbrev-location wordstart) + ;; If this abbrev has an expansion, delete the abbrev + ;; and insert the expansion. + (abbrev-insert sym name wordstart wordend))))) (defun unexpand-abbrev () "Undo the expansion of the last abbrev that expanded. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 915a726ae1..39ea97aa98 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2535,17 +2535,11 @@ See Info node `(elisp)Computed Advice' for detailed documentation." "Return the argument list of DEFINITION. If DEFINITION could be from a subr then its NAME should be supplied to make subr arglist lookup more efficient." - (cond ((ad-compiled-p definition) - (aref (ad-compiled-code definition) 0)) - ((consp definition) - (car (cdr (ad-lambda-expression definition)))) - ((ad-subr-p definition) - (if name - (ad-subr-arglist name) - ;; otherwise get it from its printed representation: - (setq name (format "%s" definition)) - (string-match "^#]+\\)>$" name) - (ad-subr-arglist (intern (match-string 1 name))))))) + (require 'help-fns) + (cond + ((or (ad-macro-p definition) (ad-advice-p definition)) + (help-function-arglist (cdr definition))) + (t (help-function-arglist definition)))) ;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish ;; a defined empty arglist `(nil)' from an undefined arglist: diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index d6e7ee9e3c..5a5d6b88a2 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -137,7 +137,7 @@ or macro definition or a defcustom)." ;; Special case to autoload some of the macro's declarations. (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form)) (exps '())) - (when (eq (car decls) 'declare) + (when (eq (car-safe decls) 'declare) ;; FIXME: We'd like to reuse macro-declaration-function, ;; but we can't since it doesn't return anything. (dolist (decl decls) @@ -471,7 +471,8 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (marker-buffer output-start))) (autoload-print-form autoload))) (error - (message "Error in %s: %S" file err))) + (message "Autoload cookie error in %s:%s %S" + file (count-lines (point-min) (point)) err))) ;; Copy the rest of the line to the output. (princ (buffer-substring diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 68ec2144da..a4254bfeca 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1657,8 +1657,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; it is wrong to do the same thing for the -else-pop variants. ;; ((and (eq 'byte-not (car lap0)) - (or (eq 'byte-goto-if-nil (car lap1)) - (eq 'byte-goto-if-not-nil (car lap1)))) + (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil))) (byte-compile-log-lap " not %s\t-->\t%s" lap1 (cons @@ -1677,8 +1676,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; ;; it is wrong to do the same thing for the -else-pop variants. ;; - ((and (or (eq 'byte-goto-if-nil (car lap0)) - (eq 'byte-goto-if-not-nil (car lap0))) ; gotoX + ((and (memq (car lap0) + '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX (eq 'byte-goto (car lap1)) ; gotoY (eq (cdr lap0) lap2)) ; TAG X (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) @@ -1701,8 +1700,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; only be known when the closure will be built at ;; run-time). (consp (cdr lap0))) - (cond ((if (or (eq (car lap1) 'byte-goto-if-nil) - (eq (car lap1) 'byte-goto-if-nil-else-pop)) + (cond ((if (memq (car lap1) '(byte-goto-if-nil + byte-goto-if-nil-else-pop)) (car (cdr lap0)) (not (car (cdr lap0)))) (byte-compile-log-lap " %s %s\t-->\t" diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 77dd340821..c661e6bea7 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -432,11 +432,12 @@ This list lives partly on the stack.") (eval-when-compile . (lambda (&rest body) (list 'quote + ;; FIXME: is that right in lexbind code? (byte-compile-eval - (byte-compile-top-level - (macroexpand-all - (cons 'progn body) - byte-compile-initial-macro-environment)))))) + (byte-compile-top-level + (macroexpand-all + (cons 'progn body) + byte-compile-initial-macro-environment)))))) (eval-and-compile . (lambda (&rest body) (byte-compile-eval-before-compile (cons 'progn body)) (cons 'progn body)))) @@ -2732,16 +2733,16 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string bytecomp-int))))) ;; Process the body. - (let* ((compiled - (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda - ;; If doing lexical binding, push a new - ;; lexical environment containing just the - ;; args (since lambda expressions should be - ;; closed by now). - (and lexical-binding - (byte-compile-make-lambda-lexenv - bytecomp-fun)) - reserved-csts))) + (let ((compiled + (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda + ;; If doing lexical binding, push a new + ;; lexical environment containing just the + ;; args (since lambda expressions should be + ;; closed by now). + (and lexical-binding + (byte-compile-make-lambda-lexenv + bytecomp-fun)) + reserved-csts))) ;; Build the actual byte-coded function. (if (eq 'byte-code (car-safe compiled)) (apply 'make-byte-code @@ -3027,8 +3028,9 @@ That command is designed for interactive use only" bytecomp-fn)) (when (and (byte-compile-warning-enabled-p 'callargs) (symbolp (car form))) (if (memq (car form) - '(custom-declare-group custom-declare-variable - custom-declare-face)) + '(custom-declare-group + ;; custom-declare-variable custom-declare-face + )) (byte-compile-nogroup-warn form)) (when (get (car form) 'byte-obsolete-info) (byte-compile-warn-obsolete (car form))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 741bc7ce74..5be84c15d8 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -488,6 +488,8 @@ places where they originally did not directly appear." (cconv-convert form nil nil)) forms))) + (`(declare . ,_) form) ;The args don't contain code. + (`(,func . ,forms) ;; First element is function or whatever function-like forms are: or, and, ;; if, progn, prog1, prog2, while, until @@ -683,6 +685,8 @@ and updates the data stored in ENV." ;; variables in the function's enclosing environment, but it doesn't ;; seem worth the trouble. (dolist (form forms) (cconv-analyse-form form nil))) + + (`(declare . ,_) nil) ;The args don't contain code. (`(,_ . ,body-forms) ; First element is a function or whatever. (dolist (form body-forms) (cconv-analyse-form form env))) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 17046f1ffb..2795b143e4 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -277,12 +277,12 @@ Not documented ;;;;;; assert check-type typep deftype cl-struct-setf-expander defstruct ;;;;;; define-modify-macro callf2 callf letf* letf rotatef shiftf ;;;;;; remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method -;;;;;; declare locally multiple-value-setq multiple-value-bind lexical-let* -;;;;;; lexical-let symbol-macrolet macrolet labels 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" "5bdba3fbbcbfcf57a2c9ca87a6318150") +;;;;;; declare the locally multiple-value-setq multiple-value-bind +;;;;;; lexical-let* lexical-let symbol-macrolet macrolet labels +;;;;;; 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" "864a28dc0495ad87d39637a965387526") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ @@ -535,6 +535,11 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). \(fn &rest BODY)" nil (quote macro)) +(autoload 'the "cl-macs" "\ + + +\(fn TYPE FORM)" nil (quote macro)) + (autoload 'declare "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 8b1fc9d5f5..851355e2c7 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2428,11 +2428,13 @@ value, that slot cannot be set via `setf'. (push (cons name t) side-eff)))) (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) (if print-func - (push (list 'push - (list 'function - (list 'lambda '(cl-x cl-s cl-n) - (list 'and pred-form print-func))) - 'custom-print-functions) forms)) + (push `(push + ;; The auto-generated function does not pay attention to + ;; the depth argument cl-n. + (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n)) + (and ,pred-form ,print-func)) + custom-print-functions) + forms)) (push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms) (push (list* 'eval-when '(compile load eval) (list 'put (list 'quote name) '(quote cl-struct-slots) @@ -2586,7 +2588,7 @@ and then returning foo." (cl-transform-function-property func 'cl-compiler-macro (cons (if (memq '&whole args) (delq '&whole args) - (cons '--cl-whole-arg-- args)) body)) + (cons '_cl-whole-arg args)) body)) (list 'or (list 'get (list 'quote func) '(quote byte-compile)) (list 'progn (list 'put (list 'quote func) '(quote byte-compile) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 1d2b82f82e..d303dab4ad 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -161,7 +161,14 @@ an element already on the list. (if (symbolp place) (if (null keys) `(let ((x ,x)) - (if (memql x ,place) ,place (setq ,place (cons x ,place)))) + (if (memql x ,place) + ;; This symbol may later on expand to actual code which then + ;; trigger warnings like "value unused" since pushnew's return + ;; value is rarely used. It should not matter that other + ;; warnings may be silenced, since `place' is used earlier and + ;; should have triggered them already. + (with-no-warnings ,place) + (setq ,place (cons x ,place)))) (list 'setq place (list* 'adjoin x place keys))) (list* 'callf2 'adjoin x place keys))) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 168a430577..55ca90597d 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -131,7 +131,16 @@ Assumes the caller has bound `macroexpand-all-environment'." (`(defmacro ,name . ,args-and-body) (push (cons name (cons 'lambda args-and-body)) macroexpand-all-environment) - (macroexpand-all-forms form 3)) + (let ((n 3)) + ;; Don't macroexpand `declare' since it should really be "expanded" + ;; away when `defmacro' is expanded, but currently defmacro is not + ;; itself a macro. So both `defmacro' and `declare' need to be + ;; handled directly in bytecomp.el. + ;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote). + (while (or (stringp (nth n form)) + (eq (car-safe (nth n form)) 'declare)) + (setq n (1+ n))) + (macroexpand-all-forms form n))) (`(defun . ,_) (macroexpand-all-forms form 3)) (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2)) (`(function ,(and f `(lambda . ,_))) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index e81a8b3798..2701d6b940 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1,4 +1,4 @@ -;;; smie.el --- Simple Minded Indentation Engine +;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*- ;; Copyright (C) 2010-2011 Free Software Foundation, Inc. @@ -178,7 +178,7 @@ one of those elements share the same precedence level and associativity." ;; Maybe also add (or ...) for things like ;; (exp (exp (or "+" "*" "=" ..) exp)). ;; Basically, make it EBNF (except for the specification of a separator in - ;; the repetition). + ;; the repetition, maybe). (let ((nts (mapcar 'car bnf)) ;Non-terminals (first-ops-table ()) (last-ops-table ()) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 35f8c5e8e3..f81505c1cf 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -124,6 +124,22 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (nreverse arglist))) ((byte-code-function-p def) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) + ((subrp def) + (let ((arity (subr-arity def)) + (arglist ())) + (dotimes (i (car arity)) + (push (intern (concat "arg" (number-to-string (1+ i)))) arglist)) + (cond + ((not (numberp (cdr arglist))) + (push '&rest arglist) + (push 'rest arglist)) + ((< (car arity) (cdr arity)) + (push '&optional arglist) + (dotimes (i (- (cdr arity) (car arity))) + (push (intern (concat "arg" (number-to-string + (+ 1 i (car arity))))) + arglist)))) + (nreverse arglist))) ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) "[Arg list not available until function definition is loaded.]") (t t))) @@ -618,9 +634,9 @@ it is displayed along with the global value." "Describe variable (default %s): " v) "Describe variable: ") obarray - '(lambda (vv) - (or (boundp vv) - (get vv 'variable-documentation))) + (lambda (vv) + (or (special-variable-p vv) + (get vv 'variable-documentation))) t nil nil (if (symbolp v) (symbol-name v)))) (list (if (equal val "") diff --git a/lisp/mpc.el b/lisp/mpc.el index 10e8c9d768..b1e4d860cc 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -2452,13 +2452,13 @@ This is used so that they can be compared with `eq', which is needed for (defvar mpc-faster-speedup 8) -(defun mpc-ffwd (event) +(defun mpc-ffwd (_event) "Fast forward." (interactive (list last-nonmenu-event)) ;; (mpc--faster event 4.0 1) (mpc--faster-toggle mpc-faster-speedup 1)) -(defun mpc-rewind (event) +(defun mpc-rewind (_event) "Fast rewind." (interactive (list last-nonmenu-event)) ;; (mpc--faster event 4.0 -1) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index d88b76a775..d3530b1be3 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1,4 +1,4 @@ -;;; newcomment.el --- (un)comment regions of buffers +;;; newcomment.el --- (un)comment regions of buffers -*- lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. @@ -722,7 +722,7 @@ With any other arg, set comment column to indentation of the previous comment With prefix ARG, kill comments on that many lines starting with this one." (interactive "P") (comment-normalize-vars) - (dotimes (_ (prefix-numeric-value arg)) + (dotimes (i (prefix-numeric-value arg)) (save-excursion (beginning-of-line) (let ((cs (comment-search-forward (line-end-position) t))) diff --git a/lisp/reveal.el b/lisp/reveal.el index 574c86a0fa..bf18602379 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -1,4 +1,4 @@ -;;; reveal.el --- Automatically reveal hidden text at point +;;; reveal.el --- Automatically reveal hidden text at point -*- lexical-binding: t -*- ;; Copyright (C) 2000-2011 Free Software Foundation, Inc. diff --git a/lisp/simple.el b/lisp/simple.el index 4549a0bb33..f84812570b 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2827,51 +2827,6 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." (reset-this-command-lengths) (restore-overriding-map)) -;; This function is here rather than in subr.el because it uses CL. -(defmacro with-wrapper-hook (var args &rest body) - "Run BODY wrapped with the VAR hook. -VAR is a special hook: its functions are called with a first argument -which is the \"original\" code (the BODY), so the hook function can wrap -the original function, or call it any number of times (including not calling -it at all). This is similar to an `around' advice. -VAR is normally a symbol (a variable) in which case it is treated like -a hook, with a buffer-local and a global part. But it can also be an -arbitrary expression. -ARGS is a list of variables which will be passed as additional arguments -to each function, after the initial argument, and which the first argument -expects to receive when called." - (declare (indent 2) (debug t)) - ;; We need those two gensyms because CL's lexical scoping is not available - ;; for function arguments :-( - (let ((funs (make-symbol "funs")) - (global (make-symbol "global")) - (argssym (make-symbol "args"))) - ;; Since the hook is a wrapper, the loop has to be done via - ;; recursion: a given hook function will call its parameter in order to - ;; continue looping. - `(labels ((runrestofhook (,funs ,global ,argssym) - ;; `funs' holds the functions left on the hook and `global' - ;; holds the functions left on the global part of the hook - ;; (in case the hook is local). - (lexical-let ((funs ,funs) - (global ,global)) - (if (consp funs) - (if (eq t (car funs)) - (runrestofhook - (append global (cdr funs)) nil ,argssym) - (apply (car funs) - (lambda (&rest ,argssym) - (runrestofhook (cdr funs) global ,argssym)) - ,argssym)) - ;; Once there are no more functions on the hook, run - ;; the original body. - (apply (lambda ,args ,@body) ,argssym))))) - (runrestofhook ,var - ;; The global part of the hook, if any. - ,(if (symbolp var) - `(if (local-variable-p ',var) - (default-value ',var))) - (list ,@args))))) (defvar filter-buffer-substring-functions nil "Wrapper hook around `filter-buffer-substring'. diff --git a/lisp/subr.el b/lisp/subr.el index b7b5bec124..b6f095136f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1242,6 +1242,67 @@ the hook's buffer-local value rather than its default value." (kill-local-variable hook) (set hook hook-value)))))) +(defmacro letrec (binders &rest body) + "Bind variables according to BINDERS then eval BODY. +The value of the last form in BODY is returned. +Each element of BINDERS is a list (SYMBOL VALUEFORM) which binds +SYMBOL to the value of VALUEFORM. +All symbols are bound before the VALUEFORMs are evalled." + ;; Only useful in lexical-binding mode. + ;; As a special-form, we could implement it more efficiently (and cleanly, + ;; making the vars actually unbound during evaluation of the binders). + (declare (debug let) (indent 1)) + `(let ,(mapcar #'car binders) + ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) + ,@body)) + +(defmacro with-wrapper-hook (var args &rest body) + "Run BODY wrapped with the VAR hook. +VAR is a special hook: its functions are called with a first argument +which is the \"original\" code (the BODY), so the hook function can wrap +the original function, or call it any number of times (including not calling +it at all). This is similar to an `around' advice. +VAR is normally a symbol (a variable) in which case it is treated like +a hook, with a buffer-local and a global part. But it can also be an +arbitrary expression. +ARGS is a list of variables which will be passed as additional arguments +to each function, after the initial argument, and which the first argument +expects to receive when called." + (declare (indent 2) (debug t)) + ;; We need those two gensyms because CL's lexical scoping is not available + ;; for function arguments :-( + (let ((funs (make-symbol "funs")) + (global (make-symbol "global")) + (argssym (make-symbol "args")) + (runrestofhook (make-symbol "runrestofhook"))) + ;; Since the hook is a wrapper, the loop has to be done via + ;; recursion: a given hook function will call its parameter in order to + ;; continue looping. + `(letrec ((,runrestofhook + (lambda (,funs ,global ,argssym) + ;; `funs' holds the functions left on the hook and `global' + ;; holds the functions left on the global part of the hook + ;; (in case the hook is local). + (if (consp ,funs) + (if (eq t (car ,funs)) + (funcall ,runrestofhook + (append ,global (cdr ,funs)) nil ,argssym) + (apply (car ,funs) + (apply-partially + (lambda (,funs ,global &rest ,argssym) + (funcall ,runrestofhook ,funs ,global ,argssym)) + (cdr ,funs) ,global) + ,argssym)) + ;; Once there are no more functions on the hook, run + ;; the original body. + (apply (lambda ,args ,@body) ,argssym))))) + (funcall ,runrestofhook ,var + ;; The global part of the hook, if any. + ,(if (symbolp var) + `(if (local-variable-p ',var) + (default-value ',var))) + (list ,@args))))) + (defun add-to-list (list-var element &optional append compare-fn) "Add ELEMENT to the value of LIST-VAR if it isn't there yet. The test for presence of ELEMENT is done with `equal', diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el index 831d4e8667..bc5326240a 100644 --- a/lisp/textmodes/bibtex-style.el +++ b/lisp/textmodes/bibtex-style.el @@ -1,4 +1,4 @@ -;;; bibtex-style.el --- Major mode for BibTeX Style files +;;; bibtex-style.el --- Major mode for BibTeX Style files -*- lexical-binding: t -*- ;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc. @@ -141,7 +141,7 @@ (looking-at "if\\$")) (scan-error nil)))) (save-excursion - (condition-case err + (condition-case nil (while (progn (backward-sexp 1) (save-excursion (skip-chars-backward " \t{") (not (bolp))))) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index b611261723..ef51fb2503 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1,4 +1,4 @@ -;;; css-mode.el --- Major mode to edit CSS files +;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*- ;; Copyright (C) 2006-2011 Free Software Foundation, Inc. diff --git a/lisp/uniquify.el b/lisp/uniquify.el index e894127cdb..3153e143ba 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -1,4 +1,4 @@ -;;; uniquify.el --- unique buffer names dependent on file name +;;; uniquify.el --- unique buffer names dependent on file name -*- lexical-binding: t -*- ;; Copyright (C) 1989, 1995-1997, 2001-2011 Free Software Foundation, Inc. diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 7354e616c9..063eb41457 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -1,4 +1,4 @@ -;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*- +;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. @@ -87,6 +87,12 @@ '(cvs-status-font-lock-keywords t nil nil nil (font-lock-multiline . t))) (defvar cvs-minor-wrap-function) +(defvar cvs-force-command) +(defvar cvs-minor-current-files) +(defvar cvs-secondary-branch-prefix) +(defvar cvs-branch-prefix) +(defvar cvs-tag-print-rev) + (put 'cvs-status-mode 'mode-class 'special) ;;;###autoload (define-derived-mode cvs-status-mode fundamental-mode "CVS-Status" @@ -472,7 +478,7 @@ Optional prefix ARG chooses between two representations." (nprev (if (and cvs-tree-nomerge next (equal vlist (cvs-tag->vlist next))) prev vlist))) - (cvs-map (lambda (v p) v) nprev prev))) + (cvs-map (lambda (v _p) v) nprev prev))) (after (save-excursion (newline) (cvs-tree-tags-insert (cdr tags) nprev))) @@ -512,24 +518,24 @@ Optional prefix ARG chooses between two representations." ;;;; Merged trees from different files ;;;; -(defun cvs-tree-fuzzy-merge-1 (trees tree prev) - ) - -(defun cvs-tree-fuzzy-merge (trees tree) - "Do the impossible: merge TREE into TREES." - ()) - -(defun cvs-tree () - "Get tags from the status output and merge tham all into a big tree." - (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t) - (trees (make-vector 31 0)) tree) - (while (listp (setq tree (cvs-tags->tree (cvs-status-get-tags)))) - (cvs-tree-fuzzy-merge trees tree)) - (erase-buffer) - (let ((cvs-tag-print-rev nil)) - (cvs-tree-print tree 'cvs-tag->string 3))))) +;; (defun cvs-tree-fuzzy-merge-1 (trees tree prev) +;; ) + +;; (defun cvs-tree-fuzzy-merge (trees tree) +;; "Do the impossible: merge TREE into TREES." +;; ()) + +;; (defun cvs-tree () +;; "Get tags from the status output and merge them all into a big tree." +;; (save-excursion +;; (goto-char (point-min)) +;; (let ((inhibit-read-only t) +;; (trees (make-vector 31 0)) tree) +;; (while (listp (setq tree (cvs-tags->tree (cvs-status-get-tags)))) +;; (cvs-tree-fuzzy-merge trees tree)) +;; (erase-buffer) +;; (let ((cvs-tag-print-rev nil)) +;; (cvs-tree-print tree 'cvs-tag->string 3))))) (provide 'cvs-status) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 8e5fe27f96..f55629b3ea 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -811,7 +811,7 @@ PREFIX is only used internally: don't use it." (defun diff-ediff-patch () "Call `ediff-patch-file' on the current buffer." (interactive) - (condition-case err + (condition-case nil (ediff-patch-file nil (current-buffer)) (wrong-number-of-arguments (ediff-patch-file)))) @@ -1168,7 +1168,7 @@ else cover the whole buffer." ;; *-change-function is asking for trouble, whereas making them ;; from a post-command-hook doesn't pose much problems (defvar diff-unhandled-changes nil) -(defun diff-after-change-function (beg end len) +(defun diff-after-change-function (beg end _len) "Remember to fixup the hunk header. See `after-change-functions' for the meaning of BEG, END and LEN." ;; Ignoring changes when inhibit-read-only is set is strictly speaking @@ -1690,7 +1690,7 @@ With a prefix argument, REVERSE the hunk." "See whether it's possible to apply the current hunk. With a prefix argument, try to REVERSE the hunk." (interactive "P") - (destructuring-bind (buf line-offset pos src dst &optional switched) + (destructuring-bind (buf line-offset pos src _dst &optional switched) (diff-find-source-location nil reverse) (set-window-point (display-buffer buf) (+ (car pos) (cdr src))) (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))) @@ -1710,7 +1710,7 @@ then `diff-jump-to-old-file' is also set, for the next invocations." ;; This is a convenient detail when using smerge-diff. (if event (posn-set-point (event-end event))) (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) - (destructuring-bind (buf line-offset pos src dst &optional switched) + (destructuring-bind (buf line-offset pos src _dst &optional switched) (diff-find-source-location other-file rev) (pop-to-buffer buf) (goto-char (+ (car pos) (cdr src))) @@ -1728,7 +1728,7 @@ For use in `add-log-current-defun-function'." (when (looking-at diff-hunk-header-re) (forward-line 1) (re-search-forward "^[^ ]" nil t)) - (destructuring-bind (&optional buf line-offset pos src dst switched) + (destructuring-bind (&optional buf _line-offset pos src dst switched) ;; Use `noprompt' since this is used in which-func-mode and such. (ignore-errors ;Signals errors in place of prompting. (diff-find-source-location nil nil 'noprompt)) @@ -1876,28 +1876,27 @@ I.e. like `add-change-log-entry-other-window' but applied to all hunks." ;; good to call it for each change. (save-excursion (goto-char (point-min)) - (let ((orig-buffer (current-buffer))) - (condition-case nil - ;; Call add-change-log-entry-other-window for each hunk in - ;; the diff buffer. - (while (progn - (diff-hunk-next) - ;; Move to where the changes are, - ;; `add-change-log-entry-other-window' works better in - ;; that case. - (re-search-forward - (concat "\n[!+-<>]" - ;; If the hunk is a context hunk with an empty first - ;; half, recognize the "--- NNN,MMM ----" line - "\\(-- [0-9]+\\(,[0-9]+\\)? ----\n" - ;; and skip to the next non-context line. - "\\( .*\n\\)*[+]\\)?") - nil t)) - (save-excursion - ;; FIXME: this pops up windows of all the buffers. - (add-change-log-entry nil nil t nil t))) - ;; When there's no more hunks, diff-hunk-next signals an error. - (error nil))))) + (condition-case nil + ;; Call add-change-log-entry-other-window for each hunk in + ;; the diff buffer. + (while (progn + (diff-hunk-next) + ;; Move to where the changes are, + ;; `add-change-log-entry-other-window' works better in + ;; that case. + (re-search-forward + (concat "\n[!+-<>]" + ;; If the hunk is a context hunk with an empty first + ;; half, recognize the "--- NNN,MMM ----" line + "\\(-- [0-9]+\\(,[0-9]+\\)? ----\n" + ;; and skip to the next non-context line. + "\\( .*\n\\)*[+]\\)?") + nil t)) + (save-excursion + ;; FIXME: this pops up windows of all the buffers. + (add-change-log-entry nil nil t nil t))) + ;; When there's no more hunks, diff-hunk-next signals an error. + (error nil)))) ;; provide the package (provide 'diff-mode) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 192ab1f78d..54a2cb4f19 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -1,4 +1,4 @@ -;;; log-edit.el --- Major mode for editing CVS commit messages +;;; log-edit.el --- Major mode for editing CVS commit messages -*- lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. @@ -329,7 +329,7 @@ automatically." (defconst log-edit-header-contents-regexp "[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?") -(defun log-edit-match-to-eoh (limit) +(defun log-edit-match-to-eoh (_limit) ;; FIXME: copied from message-match-to-eoh. (let ((start (point))) (rfc822-goto-eoh) @@ -361,7 +361,7 @@ automatically." nil lax))))) ;;;###autoload -(defun log-edit (callback &optional setup params buffer mode &rest ignore) +(defun log-edit (callback &optional setup params buffer mode &rest _ignore) "Setup a buffer to enter a log message. \\The buffer will be put in mode MODE or `log-edit-mode' if MODE is nil. diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index fa731e77a6..d9a06c8a40 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -1,4 +1,4 @@ -;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output +;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output -*- lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. @@ -115,6 +115,7 @@ (autoload 'vc-diff-internal "vc") (defvar cvs-minor-wrap-function) +(defvar cvs-force-command) (defgroup log-view nil "Major mode for browsing log output of RCS/CVS/SCCS." diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 37cdd41ee5..75e3b51453 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1,4 +1,4 @@ -;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts +;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. diff --git a/src/ChangeLog b/src/ChangeLog index e8b3c57fbd..bbf7f99bb3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-03-11 Stefan Monnier + + * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. + (Fdefvar): Remove redundant SYMBOLP check. + (Ffunctionp): Don't signal an error for undefined aliases. + 2011-03-06 Stefan Monnier * bytecode.c (exec_byte_code): Remove old lexical binding slot handling diff --git a/src/eval.c b/src/eval.c index 1f6a5e4a1c..36c63a5c8a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -371,13 +371,12 @@ usage: (prog1 FIRST BODY...) */) do { + Lisp_Object tem = eval_sub (XCAR (args_left)); if (!(argnum++)) - val = eval_sub (Fcar (args_left)); - else - eval_sub (Fcar (args_left)); - args_left = Fcdr (args_left); + val = tem; + args_left = XCDR (args_left); } - while (!NILP(args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -406,13 +405,12 @@ usage: (prog2 FORM1 FORM2 BODY...) */) do { + Lisp_Object tem = eval_sub (XCAR (args_left)); if (!(argnum++)) - val = eval_sub (Fcar (args_left)); - else - eval_sub (Fcar (args_left)); - args_left = Fcdr (args_left); + val = tem; + args_left = XCDR (args_left); } - while (!NILP (args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -791,9 +789,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) tem = Fdefault_boundp (sym); if (!NILP (tail)) { - if (SYMBOLP (sym)) - /* Do it before evaluating the initial value, for self-references. */ - XSYMBOL (sym)->declared_special = 1; + /* Do it before evaluating the initial value, for self-references. */ + XSYMBOL (sym)->declared_special = 1; if (SYMBOL_CONSTANT_P (sym)) { @@ -2873,7 +2870,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, { if (SYMBOLP (object) && !NILP (Ffboundp (object))) { - object = Findirect_function (object, Qnil); + object = Findirect_function (object, Qt); if (CONSP (object) && EQ (XCAR (object), Qautoload)) { -- 2.20.1