summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2011-03-11 15:04:22 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2011-03-11 15:04:22 -0500
commitba83908c4b7fda12991ae9073028a60da87c1fa2 (patch)
treef3ebf09f2af4f22ee21a3af2b184181c25d69bf6 /lisp/emacs-lisp
parent9ace101ce2e22c85a4298f20702e9b79ae03ad1f (diff)
downloademacs-ba83908c4b7fda12991ae9073028a60da87c1fa2.tar.gz
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.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/advice.el16
-rw-r--r--lisp/emacs-lisp/autoload.el5
-rw-r--r--lisp/emacs-lisp/byte-opt.el11
-rw-r--r--lisp/emacs-lisp/bytecomp.el34
-rw-r--r--lisp/emacs-lisp/cconv.el4
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el17
-rw-r--r--lisp/emacs-lisp/cl-macs.el14
-rw-r--r--lisp/emacs-lisp/cl.el9
-rw-r--r--lisp/emacs-lisp/macroexp.el11
-rw-r--r--lisp/emacs-lisp/smie.el4
10 files changed, 74 insertions, 51 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 915a726ae11..39ea97aa98e 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 "^#<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:
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index d6e7ee9e3cb..5a5d6b88a2d 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 68ec2144dae..a4254bfeca1 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<deleted>"
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 77dd3408219..c661e6bea7a 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 741bc7ce74f..5be84c15d89 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 17046f1ffb4..2795b143e47 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 8b1fc9d5f53..851355e2c75 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 1d2b82f82eb..d303dab4ad3 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 168a430577d..55ca90597d1 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 e81a8b37981..2701d6b940b 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 <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 ())