Commit ba83908c authored by Stefan Monnier's avatar Stefan Monnier

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.
parent 9ace101c
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.
......
......@@ -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
......
......@@ -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.
......
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.
......
;;; 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.
......
......@@ -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:
......
......@@ -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
......
......@@ -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>"
......
......@@ -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)))
......
......@@ -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)))
......
......@@ -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" "\
......
......@@ -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)
......
......@@ -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)))
......
......@@ -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 . ,_)))
......
;;; 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 ())
......
......@@ -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 "")
......
......@@ -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)
......
;;; 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)))
......
;;; 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.
......
......@@ -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'.
......
......@@ -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',
......
;;; 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)))))
......
;;; 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.
......
;;; 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.
......
;;; 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)