mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-25 07:28:20 +00:00
Code Issues Releases Activity

Misc fixes, and use lexical-binding in more files.

Browse Source 
* 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.
This commit is contained in:
Stefan Monnier 2011-03-11 15:04:22 -05:00
parent 9ace101ce2
commit ba83908c4b
31 changed files with 327 additions and 189 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
doc/lispref/ChangeLog
View File

@ -1,3 +1,7 @@
2011-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
* variables.texi (Converting to Lexical Binding): New node.
2011-03-01 Stefan Monnier <monnier@iro.umontreal.ca>
* variables.texi (Scope): Mention the availability of lexical scoping.

40
doc/lispref/variables.texi
View File

@ -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

3
etc/NEWS.lexbind
View File

@ -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.

32
lisp/ChangeLog
View File

@ -1,3 +1,35 @@
2011-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el: Use lexical-binding.

29
lisp/abbrev.el
View File

@ -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.

16
lisp/emacs-lisp/advice.el
View File

@ -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 "^#<subr \\([^>]+\\)>$" 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:

5
lisp/emacs-lisp/autoload.el
View File

@ -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

11
lisp/emacs-lisp/byte-opt.el
View File

@ -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<deleted>"

34
lisp/emacs-lisp/bytecomp.el
View File

@ -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)))

4
lisp/emacs-lisp/cconv.el
View File

@ -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)))

17
lisp/emacs-lisp/cl-loaddefs.el
View File

@ -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" "\

14
lisp/emacs-lisp/cl-macs.el
View File

@ -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)

9
lisp/emacs-lisp/cl.el
View File

@ -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)))

11
lisp/emacs-lisp/macroexp.el
View File

@ -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 . ,_)))

4
lisp/emacs-lisp/smie.el
View File

@ -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 <elem1> <elem2>...) 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 ())

22
lisp/help-fns.el
View File

@ -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 "")

4
lisp/mpc.el
View File

@ -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)

4
lisp/newcomment.el
View File

@ -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)))

2
lisp/reveal.el
View File

@ -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.

45
lisp/simple.el
View File

@ -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'.

61
lisp/subr.el
View File

@ -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',

4
lisp/textmodes/bibtex-style.el
View File

@ -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)))))

2
lisp/textmodes/css-mode.el
View File

@ -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.

2
lisp/uniquify.el
View File

@ -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.

42
lisp/vc/cvs-status.el
View File

@ -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-1 (trees tree prev)
;; )
(defun cvs-tree-fuzzy-merge (trees tree)
"Do the impossible: merge TREE into TREES."
())
;; (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 ()
;; "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)

53
lisp/vc/diff-mode.el
View File

@ -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)

6
lisp/vc/log-edit.el
View File

@ -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.
\\<log-edit-mode-map>The buffer will be put in mode MODE or `log-edit-mode'
if MODE is nil.

3
lisp/vc/log-view.el
View File

@ -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."

2
lisp/vc/smerge-mode.el
View File

@ -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.

6
src/ChangeLog
View File

@ -1,3 +1,9 @@
2011-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
* 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 <monnier@iro.umontreal.ca>
* bytecode.c (exec_byte_code): Remove old lexical binding slot handling

25
src/eval.c
View File

@ -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))
{