;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; `obsolete' (obsolete variables and functions)
;; `noruntime' (calls to functions only defined
;; within `eval-when-compile')
-;; `cl-warnings' (calls to CL functions)
+;; `cl-functions' (calls to CL functions)
;; `interactive-only' (calls to commands that are
;; not good to call from Lisp)
+;; `make-local' (dubious calls to
+;; `make-variable-buffer-local')
+;; `mapcar' (mapcar called for effect)
;; byte-compile-compatibility Whether the compiler should
;; generate .elc files which can be loaded into
;; generic emacs 18.
;; Some versions of `file' can be customized to recognize that.
(require 'backquote)
+(eval-when-compile (require 'cl))
(or (fboundp 'defsubst)
;; This really ought to be loaded already!
"Emacs Lisp byte-compiler."
:group 'lisp)
-(defcustom emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
- "\\.EL\\(;[0-9]+\\)?$"
- "\\.el$")
- "*Regexp which matches Emacs Lisp source files.
-You may want to redefine the function `byte-compile-dest-file'
-if you change this variable."
+(defcustom emacs-lisp-file-regexp "\\.el\\'"
+ "Regexp which matches Emacs Lisp source files.
+If you change this, you might want to set `byte-compile-dest-file-function'."
:group 'bytecomp
:type 'regexp)
+(defcustom byte-compile-dest-file-function nil
+ "Function for the function `byte-compile-dest-file' to call.
+It should take one argument, the name of an Emacs Lisp source
+file name, and return the name of the compiled file."
+ :group 'bytecomp
+ :type '(choice (const nil) function)
+ :version "23.2")
+
;; This enables file name handlers such as jka-compr
;; to remove parts of the file name that should not be copied
;; through to the output file name.
(or (fboundp 'byte-compile-dest-file)
;; The user may want to redefine this along with emacs-lisp-file-regexp,
;; so only define it if it is undefined.
+ ;; Note - redefining this function is obsolete as of 23.2.
+ ;; Customize byte-compile-dest-file-function instead.
(defun byte-compile-dest-file (filename)
"Convert an Emacs Lisp source file name to a compiled file name.
-If FILENAME matches `emacs-lisp-file-regexp' (by default, files
-with the extension `.el'), add `c' to it; otherwise add `.elc'."
- (setq filename (byte-compiler-base-file-name filename))
- (setq filename (file-name-sans-versions filename))
- (cond ((eq system-type 'vax-vms)
- (concat (substring filename 0 (string-match ";" filename)) "c"))
- ((string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc"))
- (t (concat filename ".elc")))))
+If `byte-compile-dest-file-function' is non-nil, uses that
+function to do the work. Otherwise, if FILENAME matches
+`emacs-lisp-file-regexp' (by default, files with the extension `.el'),
+adds `c' to it; otherwise adds `.elc'."
+ (if byte-compile-dest-file-function
+ (funcall byte-compile-dest-file-function filename)
+ (setq filename (file-name-sans-versions
+ (byte-compiler-base-file-name filename)))
+ (cond ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc"))))))
;; This can be the 'byte-compile property of any symbol.
(autoload 'byte-compile-inline-expand "byte-opt")
(defcustom byte-compile-verbose
(and (not noninteractive) (> baud-rate search-slow-speed))
- "*Non-nil means print messages describing progress of byte-compiler."
+ "Non-nil means print messages describing progress of byte-compiler."
:group 'bytecomp
:type 'boolean)
(defcustom byte-compile-compatibility nil
- "*Non-nil means generate output that can run in Emacs 18.
+ "Non-nil means generate output that can run in Emacs 18.
This only means that it can run in principle, if it doesn't require
facilities that have been added more recently."
:group 'bytecomp
;; this way can never be run in Emacs 18, and may even cause it to crash.")
(defcustom byte-optimize t
- "*Enable optimization in the byte compiler.
+ "Enable optimization in the byte compiler.
Possible values are:
nil - no optimization
t - all optimizations
(const :tag "byte-level" byte)))
(defcustom byte-compile-delete-errors nil
- "*If non-nil, the optimizer may delete forms that may signal an error.
+ "If non-nil, the optimizer may delete forms that may signal an error.
This includes variable references and calls to functions such as `car'."
:group 'bytecomp
:type 'boolean)
;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
(defcustom byte-compile-dynamic-docstrings t
- "*If non-nil, compile doc strings for lazy access.
-We bury the doc strings of functions and variables
-inside comments in the file, and bring them into core only when they
-are actually needed.
+ "If non-nil, compile doc strings for lazy access.
+We bury the doc strings of functions and variables inside comments in
+the file, and bring them into core only when they are actually needed.
When this option is true, if you load the compiled file and then move it,
you won't be able to find the documentation of anything in that file.
;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
(defcustom byte-optimize-log nil
- "*If true, the byte-compiler will log its optimizations into *Compile-Log*.
+ "If true, the byte-compiler will log its optimizations into *Compile-Log*.
If this is 'source, then only source-level optimizations will be logged.
If it is 'byte, then only byte-level optimizations will be logged."
:group 'bytecomp
(const :tag "byte-level" byte)))
(defcustom byte-compile-error-on-warn nil
- "*If true, the byte-compiler reports warnings with `error'."
+ "If true, the byte-compiler reports warnings with `error'."
:group 'bytecomp
:type 'boolean)
(defconst byte-compile-warning-types
'(redefine callargs free-vars unresolved
- obsolete noruntime cl-functions interactive-only)
+ obsolete noruntime cl-functions interactive-only
+ make-local mapcar)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
- "*List of warnings that the byte-compiler should issue (t for all).
+ "List of warnings that the byte-compiler should issue (t for all).
Elements of the list may be:
cl-functions calls to runtime functions from the CL package (as
distinguished from macros and aliases).
interactive-only
- commands that normally shouldn't be called from Lisp code."
+ commands that normally shouldn't be called from Lisp code.
+ make-local calls to make-variable-buffer-local that may be incorrect.
+ mapcar mapcar called for effect.
+
+If the list begins with `not', then the remaining elements specify warnings to
+suppress. For example, (not mapcar) will suppress warnings about mapcar."
:group 'bytecomp
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
(const free-vars) (const unresolved)
(const callargs) (const redefine)
(const obsolete) (const noruntime)
- (const cl-functions) (const interactive-only))))
+ (const cl-functions) (const interactive-only)
+ (const make-local) (const mapcar))))
;;;###autoload(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
;;;###autoload
(defun byte-compile-warnings-safe-p (x)
+ "Return non-nil if X is valid as a value of `byte-compile-warnings'."
(or (booleanp x)
(and (listp x)
+ (if (eq (car x) 'not) (setq x (cdr x))
+ t)
(equal (mapcar
(lambda (e)
- (when (memq e '(free-vars unresolved
- callargs redefine
- obsolete noruntime
- cl-functions interactive-only))
+ (when (memq e byte-compile-warning-types)
e))
x)
x))))
+(defun byte-compile-warning-enabled-p (warning)
+ "Return non-nil if WARNING is enabled, according to `byte-compile-warnings'."
+ (or (eq byte-compile-warnings t)
+ (if (eq (car byte-compile-warnings) 'not)
+ (not (memq warning byte-compile-warnings))
+ (memq warning byte-compile-warnings))))
+
+;;;###autoload
+(defun byte-compile-disable-warning (warning)
+ "Change `byte-compile-warnings' to disable WARNING.
+If `byte-compile-warnings' is t, set it to `(not WARNING)'.
+Otherwise, if the first element is `not', add WARNING, else remove it.
+Normally you should let-bind `byte-compile-warnings' before calling this,
+else the global value will be modified."
+ (setq byte-compile-warnings
+ (cond ((eq byte-compile-warnings t)
+ (list 'not warning))
+ ((eq (car byte-compile-warnings) 'not)
+ (if (memq warning byte-compile-warnings)
+ byte-compile-warnings
+ (append byte-compile-warnings (list warning))))
+ (t
+ (delq warning byte-compile-warnings)))))
+
+;;;###autoload
+(defun byte-compile-enable-warning (warning)
+ "Change `byte-compile-warnings' to enable WARNING.
+If `byte-compile-warnings' is `t', do nothing. Otherwise, if the
+first element is `not', remove WARNING, else add it.
+Normally you should let-bind `byte-compile-warnings' before calling this,
+else the global value will be modified."
+ (or (eq byte-compile-warnings t)
+ (setq byte-compile-warnings
+ (cond ((eq (car byte-compile-warnings) 'not)
+ (delq warning byte-compile-warnings))
+ ((memq warning byte-compile-warnings)
+ byte-compile-warnings)
+ (t
+ (append byte-compile-warnings (list warning)))))))
+
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
- insert-file insert-buffer insert-file-literally)
+ insert-file insert-buffer insert-file-literally previous-line next-line
+ goto-line comint-run)
"List of commands that are not meant to be called from Lisp.")
-(defvar byte-compile-not-obsolete-var nil
- "If non-nil, this is a variable that shouldn't be reported as obsolete.")
+(defvar byte-compile-not-obsolete-vars nil
+ "If non-nil, a list of variables that shouldn't be reported as obsolete.")
+
+(defvar byte-compile-not-obsolete-funcs nil
+ "If non-nil, a list of functions that shouldn't be reported as obsolete.")
(defcustom byte-compile-generate-call-tree nil
- "*Non-nil means collect call-graph information when compiling.
+ "Non-nil means collect call-graph information when compiling.
This records which functions were called and from where.
If the value is t, compilation displays the call graph when it finishes.
If the value is neither t nor nil, compilation asks you whether to display
:type '(choice (const :tag "Yes" t) (const :tag "No" nil)
(other :tag "Ask" lambda)))
-(defvar byte-compile-call-tree nil "Alist of functions and their call tree.
+(defvar byte-compile-call-tree nil
+ "Alist of functions and their call tree.
Each element looks like
\(FUNCTION CALLERS CALLS\)
FUNCTION.")
(defcustom byte-compile-call-tree-sort 'name
- "*If non-nil, sort the call tree.
+ "If non-nil, sort the call tree.
The values `name', `callers', `calls', `calls+callers'
specify different fields to sort on."
:group 'bytecomp
Each element looks like (FUNCTIONNAME . DEFINITION). It is
\(FUNCTIONNAME . nil) when a function is redefined as a macro.
It is \(FUNCTIONNAME . t) when all we know is that it was defined,
-and we don't know the definition.")
+and we don't know the definition. For an autoloaded function, DEFINITION
+has the form (autoload . FILENAME).")
(defvar byte-compile-unresolved-functions nil
"Alist of undefined functions to which calls have been compiled.
(t ; Absolute jump
(setq pc (car (cdr (car bytes)))) ; Pick PC from tag
(setcar (cdr bytes) (logand pc 255))
- (setcar bytes (lsh pc -8))))
+ (setcar bytes (lsh pc -8))
+ ;; FIXME: Replace this by some workaround.
+ (if (> (car bytes) 255) (error "Bytecode overflow"))))
(setq patchlist (cdr patchlist))))
- (concat (nreverse bytes))))
+ (apply 'unibyte-string (nreverse bytes))))
\f
;;; compile-time evaluation
+(defun byte-compile-cl-file-p (file)
+ "Return non-nil if FILE is one of the CL files."
+ (and (stringp file)
+ (string-match "^cl\\>" (file-name-nondirectory file))))
+
(defun byte-compile-eval (form)
"Eval FORM and mark the functions defined therein.
Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let ((hist-orig load-history)
(hist-nil-orig current-load-list))
(prog1 (eval form)
- (when (memq 'noruntime byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'noruntime)
(let ((hist-new load-history)
(hist-nil-new current-load-list))
;; Go through load-history, look for newly loaded files
old-autoloads)
;; Make sure the file was not already loaded before.
(unless (or (assoc (car xs) hist-orig)
- (equal (car xs) "cl"))
+ ;; Don't give both the "noruntime" and
+ ;; "cl-functions" warning for the same function.
+ ;; FIXME This seems incorrect - these are two
+ ;; independent warnings. For example, you may be
+ ;; choosing to see the cl warnings but ignore them.
+ ;; You probably don't want to ignore noruntime in the
+ ;; same way.
+ (and (byte-compile-warning-enabled-p 'cl-functions)
+ (byte-compile-cl-file-p (car xs))))
(dolist (s xs)
(cond
((symbolp s)
(push s byte-compile-noruntime-functions))
(when (and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads)))))))
- (when (memq 'cl-functions byte-compile-warnings)
- (let ((hist-new load-history)
- (hist-nil-new current-load-list))
- ;; Go through load-history, look for newly loaded files
- ;; and mark all the functions defined therein.
- (while (and hist-new (not (eq hist-new hist-orig)))
- (let ((xs (pop hist-new))
- old-autoloads)
- ;; Make sure the file was not already loaded before.
- (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
- (byte-compile-find-cl-functions)))))))))
+ (when (byte-compile-warning-enabled-p 'cl-functions)
+ (let ((hist-new load-history))
+ ;; Go through load-history, looking for the cl files.
+ ;; Since new files are added at the start of load-history,
+ ;; we scan the new history until the tail matches the old.
+ (while (and (not byte-compile-cl-functions)
+ hist-new (not (eq hist-new hist-orig)))
+ ;; We used to check if the file had already been loaded,
+ ;; but it is better to check non-nil byte-compile-cl-functions.
+ (and (byte-compile-cl-file-p (car (pop hist-new)))
+ (byte-compile-find-cl-functions))))))))
(defun byte-compile-eval-before-compile (form)
"Evaluate FORM for `eval-and-compile'."
(let ((hist-nil-orig current-load-list))
(prog1 (eval form)
;; (eval-and-compile (require 'cl) turns off warnings for cl functions.
+ ;; FIXME Why does it do that - just as a hack?
+ ;; There are other ways to do this nowadays.
(let ((tem current-load-list))
(while (not (eq tem hist-nil-orig))
(when (equal (car tem) '(require . cl))
- (setq byte-compile-warnings
- (remq 'cl-functions byte-compile-warnings)))
+ (byte-compile-disable-warning 'cl-functions))
(setq tem (cdr tem)))))))
\f
;;; byte compiler messages
(defvar byte-compile-current-form nil)
(defvar byte-compile-dest-file nil)
(defvar byte-compile-current-file nil)
+(defvar byte-compile-current-group nil)
(defvar byte-compile-current-buffer nil)
;; Log something that isn't a warning.
(defun byte-compile-warning-series (&rest ignore)
nil)
+;; (compile-mode) will cause this to be loaded.
+(declare-function compilation-forget-errors "compile" ())
+
;; Log the start of a file in *Compile-Log*, and mark it as done.
;; Return the position of the start of the page in the log buffer.
;; But do nothing in batch mode.
(setq byte-compile-last-logged-file byte-compile-current-file
byte-compile-last-warned-form nil)
;; Do this after setting default-directory.
- (unless (eq major-mode 'compilation-mode)
- (compilation-mode))
+ (unless (derived-mode-p 'compilation-mode) (compilation-mode))
(compilation-forget-errors)
pt))))
(error "%s" format) ; byte-compile-file catches and logs it
(byte-compile-log-warning format t :warning)))
+(defun byte-compile-warn-obsolete (symbol)
+ "Warn that SYMBOL (a variable or function) is obsolete."
+ (when (byte-compile-warning-enabled-p 'obsolete)
+ (let* ((funcp (get symbol 'byte-obsolete-info))
+ (obsolete (or funcp (get symbol 'byte-obsolete-variable)))
+ (instead (car obsolete))
+ (asof (if funcp (nth 2 obsolete) (cdr obsolete))))
+ (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
+ (byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
+ (if funcp "function" "variable")
+ (if asof (concat " (as of Emacs " asof ")") "")
+ (cond ((stringp instead)
+ (concat "; " instead))
+ (instead
+ (format "; use `%s' instead." instead))
+ (t ".")))))))
+
(defun byte-compile-report-error (error-info)
"Report Lisp error in compilation. ERROR-INFO is the error data."
(setq byte-compiler-error-flag t)
;;; Used by make-obsolete.
(defun byte-compile-obsolete (form)
- (let* ((new (get (car form) 'byte-obsolete-info))
- (handler (nth 1 new))
- (when (nth 2 new)))
- (byte-compile-set-symbol-position (car form))
- (if (memq 'obsolete byte-compile-warnings)
- (byte-compile-warn "`%s' is an obsolete function%s; %s" (car form)
- (if when (concat " (as of Emacs " when ")") "")
- (if (stringp (car new))
- (car new)
- (format "use `%s' instead." (car new)))))
- (funcall (or handler 'byte-compile-normal-call) form)))
+ (byte-compile-set-symbol-position (car form))
+ (byte-compile-warn-obsolete (car form))
+ (funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler
+ 'byte-compile-normal-call) form))
\f
;; Compiler options
\f
;;; sanity-checking arglists
-;; If a function has an entry saying (FUNCTION . t).
-;; that means we know it is defined but we don't know how.
-;; If a function has an entry saying (FUNCTION . nil),
-;; that means treat it as not defined.
(defun byte-compile-fdefinition (name macro-p)
+ ;; If a function has an entry saying (FUNCTION . t).
+ ;; that means we know it is defined but we don't know how.
+ ;; If a function has an entry saying (FUNCTION . nil),
+ ;; that means treat it as not defined.
(let* ((list (if macro-p
byte-compile-macro-environment
byte-compile-function-environment))
(and (not macro-p)
(byte-code-function-p (symbol-function fn)))))
(setq fn (symbol-function fn)))
- (if (and (not macro-p) (byte-code-function-p fn))
- fn
- (and (consp fn)
- (if (eq 'macro (car fn))
- (cdr fn)
- (if macro-p
- nil
- (if (eq 'autoload (car fn))
- nil
- fn)))))))))
+ (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
+ ;; Could be a subr.
+ (symbol-function fn)
+ fn)
+ advertised-signature-table t)))
+ (cond
+ ((listp advertised)
+ (if macro-p
+ `(macro lambda ,advertised)
+ `(lambda ,advertised)))
+ ((and (not macro-p) (byte-code-function-p fn)) fn)
+ ((not (consp fn)) nil)
+ ((eq 'macro (car fn)) (cdr fn))
+ (macro-p nil)
+ ((eq 'autoload (car fn)) nil)
+ (t fn)))))))
(defun byte-compile-arglist-signature (arglist)
(let ((args 0)
(byte-compile-fdefinition (car form) t)))
(sig (if (and def (not (eq def t)))
(byte-compile-arglist-signature
- (if (eq 'lambda (car-safe def))
+ (if (memq (car-safe def) '(declared lambda))
(nth 1 def)
(if (byte-code-function-p def)
(aref def 0)
(get (car form) 'byte-compile-format-like))
(let ((nfields (with-temp-buffer
(insert (nth 1 form))
- (goto-char 1)
+ (goto-char (point-min))
(let ((n 0))
(while (re-search-forward "%." nil t)
(unless (eq ?% (char-after (1+ (match-beginning 0))))
;; Warn if a custom definition fails to specify :group.
(defun byte-compile-nogroup-warn (form)
- (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
- (name (cadr form)))
- (or (not (eq (car-safe name) 'quote))
- (and (eq (car form) 'custom-declare-group)
- (equal name ''emacs))
- (plist-get keyword-args :group)
- (not (and (consp name) (eq (car name) 'quote)))
- (byte-compile-warn
- "%s for `%s' fails to specify containing group"
- (cdr (assq (car form)
- '((custom-declare-group . defgroup)
- (custom-declare-face . defface)
- (custom-declare-variable . defcustom))))
- (cadr name)))))
+ (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
+ byte-compile-current-group)
+ ;; The group will be provided implicitly.
+ nil
+ (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
+ (name (cadr form)))
+ (or (not (eq (car-safe name) 'quote))
+ (and (eq (car form) 'custom-declare-group)
+ (equal name ''emacs))
+ (plist-get keyword-args :group)
+ (not (and (consp name) (eq (car name) 'quote)))
+ (byte-compile-warn
+ "%s for `%s' fails to specify containing group"
+ (cdr (assq (car form)
+ '((custom-declare-group . defgroup)
+ (custom-declare-face . defface)
+ (custom-declare-variable . defcustom))))
+ (cadr name)))
+ ;; Update the current group, if needed.
+ (if (and byte-compile-current-file ;Only when byte-compiling a whole file.
+ (eq (car form) 'custom-declare-group)
+ (eq (car-safe name) 'quote))
+ (setq byte-compile-current-group (cadr name))))))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(defvar byte-compile-cl-functions nil
"List of functions defined in CL.")
+;; Can't just add this to cl-load-hook, because that runs just before
+;; the forms from cl.el get added to load-history.
(defun byte-compile-find-cl-functions ()
(unless byte-compile-cl-functions
(dolist (elt load-history)
- (when (and (stringp (car elt))
- (string-match "^cl\\>" (car elt)))
- (setq byte-compile-cl-functions
- (append byte-compile-cl-functions
- (cdr elt)))))
- (let ((tail byte-compile-cl-functions))
- (while tail
- (if (and (consp (car tail))
- (eq (car (car tail)) 'autoload))
- (setcar tail (cdr (car tail))))
- (setq tail (cdr tail))))))
+ (and (byte-compile-cl-file-p (car elt))
+ (dolist (e (cdr elt))
+ ;; Includes the cl-foo functions that cl autoloads.
+ (when (memq (car-safe e) '(autoload defun))
+ (push (cdr e) byte-compile-cl-functions)))))))
(defun byte-compile-cl-warn (form)
"Warn if FORM is a call of a function from the CL package."
;; defined, issue a warning enumerating them.
;; `unresolved' in the list `byte-compile-warnings' disables this.
(defun byte-compile-warn-about-unresolved-functions ()
- (when (memq 'unresolved byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'unresolved)
(let ((byte-compile-current-form :end)
(noruntime nil)
(unresolved nil))
symbol itself."
(or (memq symbol '(nil t))
(keywordp symbol)
- (if any-value (memq symbol byte-compile-const-variables))))
+ (if any-value
+ (or (memq symbol byte-compile-const-variables)
+ ;; FIXME: We should provide a less intrusive way to find out
+ ;; is a variable is "constant".
+ (and (boundp symbol)
+ (condition-case nil
+ (progn (set symbol (symbol-value symbol)) nil)
+ (setting-constant t)))))))
(defmacro byte-compile-constp (form)
"Return non-nil if FORM is a constant."
byte-compile-dynamic-docstrings)
;; (byte-compile-generate-emacs19-bytecodes
;; byte-compile-generate-emacs19-bytecodes)
- (byte-compile-warnings (if (eq byte-compile-warnings t)
- byte-compile-warning-types
- byte-compile-warnings))
+ (byte-compile-warnings byte-compile-warnings)
)
body)))
(interactive "DByte force recompile (directory): ")
(byte-recompile-directory directory nil t))
+;; The `bytecomp-' prefix is applied to all local variables with
+;; otherwise common names in this and similar functions for the sake
+;; of the boundp test in byte-compile-variable-ref.
+;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00237.html
+;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00134.html
+;; Note that similar considerations apply to command-line-1 in startup.el.
;;;###autoload
-(defun byte-recompile-directory (directory &optional arg force)
- "Recompile every `.el' file in DIRECTORY that needs recompilation.
-This is if a `.elc' file exists but is older than the `.el' file.
-Files in subdirectories of DIRECTORY are processed also.
+(defun byte-recompile-directory (bytecomp-directory &optional bytecomp-arg
+ bytecomp-force)
+ "Recompile every `.el' file in BYTECOMP-DIRECTORY that needs recompilation.
+This happens when a `.elc' file exists but is older than the `.el' file.
+Files in subdirectories of BYTECOMP-DIRECTORY are processed also.
If the `.elc' file does not exist, normally this function *does not*
-compile the corresponding `.el' file. However,
-if ARG (the prefix argument) is 0, that means do compile all those files.
-A nonzero ARG means ask the user, for each such `.el' file,
-whether to compile it.
-
-A nonzero ARG also means ask about each subdirectory before scanning it.
-
-If the third argument FORCE is non-nil,
-recompile every `.el' file that already has a `.elc' file."
+compile the corresponding `.el' file. However, if the prefix argument
+BYTECOMP-ARG is 0, that means do compile all those files. A nonzero
+BYTECOMP-ARG means ask the user, for each such `.el' file, whether to
+compile it. A nonzero BYTECOMP-ARG also means ask about each subdirectory
+before scanning it.
+
+If the third argument BYTECOMP-FORCE is non-nil, recompile every `.el' file
+that already has a `.elc' file."
(interactive "DByte recompile directory: \nP")
- (if arg
- (setq arg (prefix-numeric-value arg)))
+ (if bytecomp-arg
+ (setq bytecomp-arg (prefix-numeric-value bytecomp-arg)))
(if noninteractive
nil
(save-some-buffers)
(force-mode-line-update))
(with-current-buffer (get-buffer-create "*Compile-Log*")
- (setq default-directory (expand-file-name directory))
+ (setq default-directory (expand-file-name bytecomp-directory))
;; compilation-mode copies value of default-directory.
(unless (eq major-mode 'compilation-mode)
(compilation-mode))
- (let ((directories (list default-directory))
+ (let ((bytecomp-directories (list default-directory))
(default-directory default-directory)
(skip-count 0)
(fail-count 0)
(dir-count 0)
last-dir)
(displaying-byte-compile-warnings
- (while directories
- (setq directory (car directories))
- (message "Checking %s..." directory)
- (let ((files (directory-files directory))
- source dest)
- (dolist (file files)
- (setq source (expand-file-name file directory))
- (if (and (not (member file '("RCS" "CVS")))
- (not (eq ?\. (aref file 0)))
- (file-directory-p source)
- (not (file-symlink-p source)))
+ (while bytecomp-directories
+ (setq bytecomp-directory (car bytecomp-directories))
+ (message "Checking %s..." bytecomp-directory)
+ (let ((bytecomp-files (directory-files bytecomp-directory))
+ bytecomp-source bytecomp-dest)
+ (dolist (bytecomp-file bytecomp-files)
+ (setq bytecomp-source
+ (expand-file-name bytecomp-file bytecomp-directory))
+ (if (and (not (member bytecomp-file '("RCS" "CVS")))
+ (not (eq ?\. (aref bytecomp-file 0)))
+ (file-directory-p bytecomp-source)
+ (not (file-symlink-p bytecomp-source)))
;; This file is a subdirectory. Handle them differently.
- (when (or (null arg)
- (eq 0 arg)
- (y-or-n-p (concat "Check " source "? ")))
- (setq directories
- (nconc directories (list source))))
+ (when (or (null bytecomp-arg)
+ (eq 0 bytecomp-arg)
+ (y-or-n-p (concat "Check " bytecomp-source "? ")))
+ (setq bytecomp-directories
+ (nconc bytecomp-directories (list bytecomp-source))))
;; It is an ordinary file. Decide whether to compile it.
- (if (and (string-match emacs-lisp-file-regexp source)
- (file-readable-p source)
- (not (auto-save-file-name-p source))
- (setq dest (byte-compile-dest-file source))
- (if (file-exists-p dest)
+ (if (and (string-match emacs-lisp-file-regexp bytecomp-source)
+ (file-readable-p bytecomp-source)
+ (not (auto-save-file-name-p bytecomp-source))
+ (setq bytecomp-dest
+ (byte-compile-dest-file bytecomp-source))
+ (if (file-exists-p bytecomp-dest)
;; File was already compiled.
- (or force (file-newer-than-file-p source dest))
+ (or bytecomp-force
+ (file-newer-than-file-p bytecomp-source
+ bytecomp-dest))
;; No compiled file exists yet.
- (and arg
- (or (eq 0 arg)
- (y-or-n-p (concat "Compile " source "? "))))))
+ (and bytecomp-arg
+ (or (eq 0 bytecomp-arg)
+ (y-or-n-p (concat "Compile "
+ bytecomp-source "? "))))))
(progn (if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." source))
- (let ((res (byte-compile-file source)))
- (cond ((eq res 'no-byte-compile)
+ (message "Compiling %s..." bytecomp-source))
+ (let ((bytecomp-res (byte-compile-file
+ bytecomp-source)))
+ (cond ((eq bytecomp-res 'no-byte-compile)
(setq skip-count (1+ skip-count)))
- ((eq res t)
+ ((eq bytecomp-res t)
(setq file-count (1+ file-count)))
- ((eq res nil)
+ ((eq bytecomp-res nil)
(setq fail-count (1+ fail-count)))))
(or noninteractive
- (message "Checking %s..." directory))
- (if (not (eq last-dir directory))
- (setq last-dir directory
+ (message "Checking %s..." bytecomp-directory))
+ (if (not (eq last-dir bytecomp-directory))
+ (setq last-dir bytecomp-directory
dir-count (1+ dir-count)))
)))))
- (setq directories (cdr directories))))
+ (setq bytecomp-directories (cdr bytecomp-directories))))
(message "Done (Total of %d file%s compiled%s%s%s)"
file-count (if (= file-count 1) "" "s")
(if (> fail-count 0) (format ", %d failed" fail-count) "")
(if (> skip-count 0) (format ", %d skipped" skip-count) "")
- (if (> dir-count 1) (format " in %d directories" dir-count) "")))))
+ (if (> dir-count 1)
+ (format " in %d directories" dir-count) "")))))
(defvar no-byte-compile nil
- "Non-nil to prevent byte-compiling of emacs-lisp code.
+ "Non-nil to prevent byte-compiling of Emacs Lisp code.
This is normally set in local file variables at the end of the elisp file:
;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)
;;;###autoload
-(defun byte-compile-file (filename &optional load)
- "Compile a file of Lisp code named FILENAME into a file of byte code.
-The output file's name is generated by passing FILENAME to the
-`byte-compile-dest-file' function (which see).
+(defun byte-compile-file (bytecomp-filename &optional load)
+ "Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code.
+The output file's name is generated by passing BYTECOMP-FILENAME to the
+function `byte-compile-dest-file' (which see).
With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling.
The value is non-nil if there were no errors, nil if errors."
;; (interactive "fByte compile file: \nP")
(interactive
- (let ((file buffer-file-name)
- (file-name nil)
- (file-dir nil))
- (and file
+ (let ((bytecomp-file buffer-file-name)
+ (bytecomp-file-name nil)
+ (bytecomp-file-dir nil))
+ (and bytecomp-file
(eq (cdr (assq 'major-mode (buffer-local-variables)))
'emacs-lisp-mode)
- (setq file-name (file-name-nondirectory file)
- file-dir (file-name-directory file)))
+ (setq bytecomp-file-name (file-name-nondirectory bytecomp-file)
+ bytecomp-file-dir (file-name-directory bytecomp-file)))
(list (read-file-name (if current-prefix-arg
"Byte compile and load file: "
"Byte compile file: ")
- file-dir file-name nil)
+ bytecomp-file-dir bytecomp-file-name nil)
current-prefix-arg)))
;; Expand now so we get the current buffer's defaults
- (setq filename (expand-file-name filename))
+ (setq bytecomp-filename (expand-file-name bytecomp-filename))
;; If we're compiling a file that's in a buffer and is modified, offer
;; to save it first.
(or noninteractive
- (let ((b (get-file-buffer (expand-file-name filename))))
+ (let ((b (get-file-buffer (expand-file-name bytecomp-filename))))
(if (and b (buffer-modified-p b)
(y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
(with-current-buffer b (save-buffer)))))
;; Force logging of the file name for each file compiled.
(setq byte-compile-last-logged-file nil)
- (let ((byte-compile-current-file filename)
+ (let ((byte-compile-current-file bytecomp-filename)
+ (byte-compile-current-group nil)
(set-auto-coding-for-load t)
target-file input-buffer output-buffer
byte-compile-dest-file)
- (setq target-file (byte-compile-dest-file filename))
+ (setq target-file (byte-compile-dest-file bytecomp-filename))
(setq byte-compile-dest-file target-file)
(with-current-buffer
(setq input-buffer (get-buffer-create " *Compiler Input*"))
;; Always compile an Emacs Lisp file as multibyte
;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
(set-buffer-multibyte t)
- (insert-file-contents filename)
+ (insert-file-contents bytecomp-filename)
;; Mimic the way after-insert-file-set-coding can make the
;; buffer unibyte when visiting this file.
(when (or (eq last-coding-system-used 'no-conversion)
(set-buffer-multibyte nil))
;; Run hooks including the uncompression hook.
;; If they change the file name, then change it for the output also.
- (let ((buffer-file-name filename)
- (default-major-mode 'emacs-lisp-mode)
- ;; Ignore unsafe local variables.
- ;; We only care about a few of them for our purposes.
- (enable-local-variables :safe)
- (enable-local-eval nil))
+ (letf ((buffer-file-name bytecomp-filename)
+ ((default-value 'major-mode) 'emacs-lisp-mode)
+ ;; Ignore unsafe local variables.
+ ;; We only care about a few of them for our purposes.
+ (enable-local-variables :safe)
+ (enable-local-eval nil))
;; Arg of t means don't alter enable-local-variables.
(normal-mode t)
- (setq filename buffer-file-name))
+ (setq bytecomp-filename buffer-file-name))
;; Set the default directory, in case an eval-when-compile uses it.
- (setq default-directory (file-name-directory filename)))
+ (setq default-directory (file-name-directory bytecomp-filename)))
;; Check if the file's local variables explicitly specify not to
;; compile this file.
(if (with-current-buffer input-buffer no-byte-compile)
(progn
;; (message "%s not compiled because of `no-byte-compile: %s'"
- ;; (file-relative-name filename)
+ ;; (file-relative-name bytecomp-filename)
;; (with-current-buffer input-buffer no-byte-compile))
(when (file-exists-p target-file)
(message "%s deleted because of `no-byte-compile: %s'"
;; We successfully didn't compile this file.
'no-byte-compile)
(when byte-compile-verbose
- (message "Compiling %s..." filename))
+ (message "Compiling %s..." bytecomp-filename))
(setq byte-compiler-error-flag nil)
;; It is important that input-buffer not be current at this call,
;; so that the value of point set in input-buffer
;; within byte-compile-from-buffer lingers in that buffer.
(setq output-buffer
(save-current-buffer
- (byte-compile-from-buffer input-buffer filename)))
+ (byte-compile-from-buffer input-buffer bytecomp-filename)))
(if byte-compiler-error-flag
nil
(when byte-compile-verbose
- (message "Compiling %s...done" filename))
+ (message "Compiling %s...done" bytecomp-filename))
(kill-buffer input-buffer)
(with-current-buffer output-buffer
(goto-char (point-max))
(insert "\n") ; aaah, unix.
- (let ((vms-stmlf-recfm t))
(if (file-writable-p target-file)
;; We must disable any code conversion here.
(let ((coding-system-for-write 'no-conversion))
(if (file-exists-p target-file)
"cannot overwrite file"
"directory not writable or nonexistent")
- target-file))))
+ target-file)))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
- (y-or-n-p (format "Report call tree for %s? " filename))))
+ (y-or-n-p (format "Report call tree for %s? "
+ bytecomp-filename))))
(save-excursion
- (display-call-tree filename)))
+ (display-call-tree bytecomp-filename)))
(if load
(load target-file))
t))))
(defun compile-defun (&optional arg)
"Compile and evaluate the current top-level form.
Print the result in the echo area.
-With argument, insert value in current buffer after the form."
+With argument ARG, insert value in current buffer after the form."
(interactive "P")
(save-excursion
(end-of-defun)
((message "%s" (prin1-to-string value)))))))
-(defun byte-compile-from-buffer (inbuffer &optional filename)
+(defun byte-compile-from-buffer (bytecomp-inbuffer &optional bytecomp-filename)
;; Filename is used for the loading-into-Emacs-18 error message.
- (let (outbuffer
- (byte-compile-current-buffer inbuffer)
+ (let (bytecomp-outbuffer
+ (byte-compile-current-buffer bytecomp-inbuffer)
(byte-compile-read-position nil)
(byte-compile-last-position nil)
;; Prevent truncation of flonums and lists as we read and print them
(byte-compile-output nil)
;; This allows us to get the positions of symbols read; it's
;; new in Emacs 22.1.
- (read-with-symbol-positions inbuffer)
+ (read-with-symbol-positions bytecomp-inbuffer)
(read-symbol-positions-list nil)
;; #### This is bound in b-c-close-variables.
- ;; (byte-compile-warnings (if (eq byte-compile-warnings t)
- ;; byte-compile-warning-types
- ;; byte-compile-warnings))
+ ;; (byte-compile-warnings byte-compile-warnings)
)
(byte-compile-close-variables
(with-current-buffer
- (setq outbuffer (get-buffer-create " *Compiler Output*"))
+ (setq bytecomp-outbuffer (get-buffer-create " *Compiler Output*"))
(set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
;; need to be written carefully.
(setq overwrite-mode 'overwrite-mode-binary))
(displaying-byte-compile-warnings
- (and filename (byte-compile-insert-header filename inbuffer outbuffer))
- (with-current-buffer inbuffer
- (goto-char 1)
+ (and bytecomp-filename
+ (byte-compile-insert-header bytecomp-filename bytecomp-inbuffer
+ bytecomp-outbuffer))
+ (with-current-buffer bytecomp-inbuffer
+ (goto-char (point-min))
;; Should we always do this? When calling multiple files, it
;; would be useful to delay this warning until all have been
;; compiled. A: Yes! b-c-u-f might contain dross from a
(setq byte-compile-read-position (point)
byte-compile-last-position byte-compile-read-position)
(let* ((old-style-backquotes nil)
- (form (read inbuffer)))
+ (form (read bytecomp-inbuffer)))
;; Warn about the use of old-style backquotes.
(when old-style-backquotes
(byte-compile-warn "!! The file uses old-style backquotes !!
(byte-compile-warn-about-unresolved-functions))
;; Fix up the header at the front of the output
;; if the buffer contains multibyte characters.
- (and filename (byte-compile-fix-header filename inbuffer outbuffer))))
- outbuffer))
+ (and bytecomp-filename
+ (byte-compile-fix-header bytecomp-filename bytecomp-inbuffer
+ bytecomp-outbuffer))))
+ bytecomp-outbuffer))
(defun byte-compile-fix-header (filename inbuffer outbuffer)
(with-current-buffer outbuffer
(delete-region (point) (progn (re-search-forward "^(")
(beginning-of-line)
(point)))
- (insert ";;; This file contains multibyte non-ASCII characters\n"
- ";;; and therefore cannot be loaded into Emacs 19.\n")
- ;; Replace "19" or "19.29" with "20", twice.
+ (insert ";;; This file contains utf-8 non-ASCII characters\n"
+ ";;; and therefore cannot be loaded into Emacs 22 or earlier.\n")
+ ;; Replace "19" or "19.29" with "23", twice.
(re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "20")
+ (replace-match "23")
(re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "20")
+ (replace-match "23")
;; Now compensate for the change in size,
;; to make sure all positions in the file remain valid.
(setq delta (- (point-max) old-header-end))
(delete-char delta)))))
(defun byte-compile-insert-header (filename inbuffer outbuffer)
- (set-buffer inbuffer)
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
- (dynamic byte-compile-dynamic))
- (set-buffer outbuffer)
- (goto-char 1)
- ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After
- ;; that is the file-format version number (18, 19 or 20) as a
- ;; byte, followed by some nulls. The primary motivation for doing
- ;; this is to get some binary characters up in the first line of
- ;; the file so that `diff' will simply say "Binary files differ"
- ;; instead of actually doing a diff of two .elc files. An extra
- ;; benefit is that you can add this to /etc/magic:
-
- ;; 0 string ;ELC GNU Emacs Lisp compiled file,
- ;; >4 byte x version %d
-
- (insert
- ";ELC"
- (if (byte-compile-version-cond byte-compile-compatibility) 18 20)
- "\000\000\000\n"
- )
- (insert ";;; Compiled by "
- (or (and (boundp 'user-mail-address) user-mail-address)
- (concat (user-login-name) "@" (system-name)))
- " on "
- (current-time-string) "\n;;; from file " filename "\n")
- (insert ";;; in Emacs version " emacs-version "\n")
- (insert ";;; "
- (cond
- ((eq byte-optimize 'source) "with source-level optimization only")
- ((eq byte-optimize 'byte) "with byte-level optimization only")
- (byte-optimize "with all optimizations")
- (t "without optimization"))
- (if (byte-compile-version-cond byte-compile-compatibility)
- "; compiled with Emacs 18 compatibility.\n"
- ".\n"))
- (if dynamic
- (insert ";;; Function definitions are lazy-loaded.\n"))
- (if (not (byte-compile-version-cond byte-compile-compatibility))
- (let (intro-string minimum-version)
- ;; Figure out which Emacs version to require,
- ;; and what comment to use to explain why.
- ;; Note that this fails to take account of whether
- ;; the buffer contains multibyte characters. We may have to
- ;; compensate at the end in byte-compile-fix-header.
- (if dynamic-docstrings
+ (with-current-buffer inbuffer
+ (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
+ (dynamic byte-compile-dynamic))
+ (set-buffer outbuffer)
+ (goto-char (point-min))
+ ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After
+ ;; that is the file-format version number (18, 19, 20, or 23) as a
+ ;; byte, followed by some nulls. The primary motivation for doing
+ ;; this is to get some binary characters up in the first line of
+ ;; the file so that `diff' will simply say "Binary files differ"
+ ;; instead of actually doing a diff of two .elc files. An extra
+ ;; benefit is that you can add this to /etc/magic:
+
+ ;; 0 string ;ELC GNU Emacs Lisp compiled file,
+ ;; >4 byte x version %d
+
+ (insert
+ ";ELC"
+ (if (byte-compile-version-cond byte-compile-compatibility) 18 23)
+ "\000\000\000\n"
+ )
+ (insert ";;; Compiled by "
+ (or (and (boundp 'user-mail-address) user-mail-address)
+ (concat (user-login-name) "@" (system-name)))
+ " on "
+ (current-time-string) "\n;;; from file " filename "\n")
+ (insert ";;; in Emacs version " emacs-version "\n")
+ (insert ";;; "
+ (cond
+ ((eq byte-optimize 'source) "with source-level optimization only")
+ ((eq byte-optimize 'byte) "with byte-level optimization only")
+ (byte-optimize "with all optimizations")
+ (t "without optimization"))
+ (if (byte-compile-version-cond byte-compile-compatibility)
+ "; compiled with Emacs 18 compatibility.\n"
+ ".\n"))
+ (if dynamic
+ (insert ";;; Function definitions are lazy-loaded.\n"))
+ (if (not (byte-compile-version-cond byte-compile-compatibility))
+ (let (intro-string minimum-version)
+ ;; Figure out which Emacs version to require,
+ ;; and what comment to use to explain why.
+ ;; Note that this fails to take account of whether
+ ;; the buffer contains multibyte characters. We may have to
+ ;; compensate at the end in byte-compile-fix-header.
+ (if dynamic-docstrings
(setq intro-string
";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
minimum-version "19.29")
;; Insert semicolons as ballast, so that byte-compile-fix-header
;; can delete them so as to keep the buffer positions
;; constant for the actual compiled code.
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))
;; Here if we want Emacs 18 compatibility.
(when dynamic-docstrings
(error "Version-18 compatibility doesn't support dynamic doc strings"))
(when byte-compile-dynamic
(error "Version-18 compatibility doesn't support dynamic byte code"))
(insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
- "\n"))))
+ "\n")))))
+
+;; Dynamically bound in byte-compile-from-buffer.
+;; NB also used in cl.el and cl-macs.el.
+(defvar bytecomp-outbuffer)
(defun byte-compile-output-file-form (form)
;; writes the given form to the output buffer, being careful of docstrings
(print-gensym t)
(print-circle ; handle circular data structures
(not byte-compile-disable-print-circle)))
- (princ "\n" outbuffer)
- (prin1 form outbuffer)
+ (princ "\n" bytecomp-outbuffer)
+ (prin1 form bytecomp-outbuffer)
nil)))
(defvar print-gensym-alist) ;Used before print-circle existed.
before INFO and the FORM but after the doc string itself.
If SPECINDEX is non-nil, it is the index in FORM
of the function bytecode string. In that case,
-we output that argument and the following argument (the constants vector)
-together, for lazy loading.
+we output that argument and the following argument
+\(the constants vector) together, for lazy loading.
QUOTED says that we have to put a quote before the
list that represents a doc string reference.
`autoload' and `custom-declare-variable' need that."
;; We need to examine byte-compile-dynamic-docstrings
;; in the input buffer (now current), not in the output buffer.
(let ((dynamic-docstrings byte-compile-dynamic-docstrings))
- ;; FIXME: What's up with those set-buffers&prog1 thingy? --Stef
- (set-buffer
- (prog1 (current-buffer)
- (set-buffer outbuffer)
- (let (position)
-
- ;; Insert the doc string, and make it a comment with #@LENGTH.
- (and (>= (nth 1 info) 0)
- dynamic-docstrings
- (not byte-compile-compatibility)
- (progn
- ;; Make the doc string start at beginning of line
- ;; for make-docfile's sake.
- (insert "\n")
- (setq position
- (byte-compile-output-as-comment
- (nth (nth 1 info) form) nil))
- (setq position (- (position-bytes position) (point-min) -1))
- ;; If the doc string starts with * (a user variable),
- ;; negate POSITION.
- (if (and (stringp (nth (nth 1 info) form))
- (> (length (nth (nth 1 info) form)) 0)
- (eq (aref (nth (nth 1 info) form) 0) ?*))
- (setq position (- position)))))
-
- (if preface
- (progn
- (insert preface)
- (prin1 name outbuffer)))
- (insert (car info))
- (let ((print-escape-newlines t)
- (print-quoted t)
- ;; For compatibility with code before print-circle,
- ;; use a cons cell to say that we want
- ;; print-gensym-alist not to be cleared
- ;; between calls to print functions.
- (print-gensym '(t))
- (print-circle ; handle circular data structures
- (not byte-compile-disable-print-circle))
- print-gensym-alist ; was used before print-circle existed.
- (print-continuous-numbering t)
- print-number-table
- (index 0))
- (prin1 (car form) outbuffer)
- (while (setq form (cdr form))
- (setq index (1+ index))
- (insert " ")
- (cond ((and (numberp specindex) (= index specindex)
- ;; Don't handle the definition dynamically
- ;; if it refers (or might refer)
- ;; to objects already output
- ;; (for instance, gensyms in the arg list).
- (let (non-nil)
- (dotimes (i (length print-number-table))
- (if (aref print-number-table i)
- (setq non-nil t)))
- (not non-nil)))
- ;; Output the byte code and constants specially
- ;; for lazy dynamic loading.
- (let ((position
- (byte-compile-output-as-comment
- (cons (car form) (nth 1 form))
- t)))
- (setq position (- (position-bytes position) (point-min) -1))
- (princ (format "(#$ . %d) nil" position) outbuffer)
- (setq form (cdr form))
- (setq index (1+ index))))
- ((= index (nth 1 info))
- (if position
- (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)")
- position)
- outbuffer)
- (let ((print-escape-newlines nil))
- (goto-char (prog1 (1+ (point))
- (prin1 (car form) outbuffer)))
- (insert "\\\n")
- (goto-char (point-max)))))
- (t
- (prin1 (car form) outbuffer)))))
- (insert (nth 2 info))))))
+ (with-current-buffer bytecomp-outbuffer
+ (let (position)
+
+ ;; Insert the doc string, and make it a comment with #@LENGTH.
+ (and (>= (nth 1 info) 0)
+ dynamic-docstrings
+ (not byte-compile-compatibility)
+ (progn
+ ;; Make the doc string start at beginning of line
+ ;; for make-docfile's sake.
+ (insert "\n")
+ (setq position
+ (byte-compile-output-as-comment
+ (nth (nth 1 info) form) nil))
+ (setq position (- (position-bytes position) (point-min) -1))
+ ;; If the doc string starts with * (a user variable),
+ ;; negate POSITION.
+ (if (and (stringp (nth (nth 1 info) form))
+ (> (length (nth (nth 1 info) form)) 0)
+ (eq (aref (nth (nth 1 info) form) 0) ?*))
+ (setq position (- position)))))
+
+ (if preface
+ (progn
+ (insert preface)
+ (prin1 name bytecomp-outbuffer)))
+ (insert (car info))
+ (let ((print-escape-newlines t)
+ (print-quoted t)
+ ;; For compatibility with code before print-circle,
+ ;; use a cons cell to say that we want
+ ;; print-gensym-alist not to be cleared
+ ;; between calls to print functions.
+ (print-gensym '(t))
+ (print-circle ; handle circular data structures
+ (not byte-compile-disable-print-circle))
+ print-gensym-alist ; was used before print-circle existed.
+ (print-continuous-numbering t)
+ print-number-table
+ (index 0))
+ (prin1 (car form) bytecomp-outbuffer)
+ (while (setq form (cdr form))
+ (setq index (1+ index))
+ (insert " ")
+ (cond ((and (numberp specindex) (= index specindex)
+ ;; Don't handle the definition dynamically
+ ;; if it refers (or might refer)
+ ;; to objects already output
+ ;; (for instance, gensyms in the arg list).
+ (let (non-nil)
+ (dotimes (i (length print-number-table))
+ (if (aref print-number-table i)
+ (setq non-nil t)))
+ (not non-nil)))
+ ;; Output the byte code and constants specially
+ ;; for lazy dynamic loading.
+ (let ((position
+ (byte-compile-output-as-comment
+ (cons (car form) (nth 1 form))
+ t)))
+ (setq position (- (position-bytes position) (point-min) -1))
+ (princ (format "(#$ . %d) nil" position) bytecomp-outbuffer)
+ (setq form (cdr form))
+ (setq index (1+ index))))
+ ((= index (nth 1 info))
+ (if position
+ (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)")
+ position)
+ bytecomp-outbuffer)
+ (let ((print-escape-newlines nil))
+ (goto-char (prog1 (1+ (point))
+ (prin1 (car form) bytecomp-outbuffer)))
+ (insert "\\\n")
+ (goto-char (point-max)))))
+ (t
+ (prin1 (car form) bytecomp-outbuffer)))))
+ (insert (nth 2 info)))))
nil)
-(defun byte-compile-keep-pending (form &optional handler)
+(defun byte-compile-keep-pending (form &optional bytecomp-handler)
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-form form t)))
- (if handler
+ (if bytecomp-handler
(let ((for-effect t))
;; To avoid consing up monstrously large forms at load time, we split
;; the output regularly.
(and (memq (car-safe form) '(fset defalias))
(nthcdr 300 byte-compile-output)
(byte-compile-flush-pending))
- (funcall handler form)
+ (funcall bytecomp-handler form)
(if for-effect
(byte-compile-discard)))
(byte-compile-form form t))
(defun byte-compile-file-form (form)
(let ((byte-compile-current-form nil) ; close over this for warnings.
- handler)
+ bytecomp-handler)
(cond
((not (consp form))
(byte-compile-keep-pending form))
((and (symbolp (car form))
- (setq handler (get (car form) 'byte-hunk-handler)))
- (cond ((setq form (funcall handler form))
+ (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
+ (cond ((setq form (funcall bytecomp-handler form))
(byte-compile-flush-pending)
(byte-compile-output-file-form form))))
((eq form (setq form (macroexpand form byte-compile-macro-environment)))
(eval (nth 5 form)) ;Macro
(eval form)) ;Define the autoload.
;; Avoid undefined function warnings for the autoload.
- (if (and (consp (nth 1 form))
+ (when (and (consp (nth 1 form))
(eq (car (nth 1 form)) 'quote)
(consp (cdr (nth 1 form)))
(symbolp (nth 1 (nth 1 form))))
- (push (cons (nth 1 (nth 1 form))
- (cons 'autoload (cdr (cdr form))))
- byte-compile-function-environment))
+ (push (cons (nth 1 (nth 1 form))
+ (cons 'autoload (cdr (cdr form))))
+ byte-compile-function-environment)
+ ;; If an autoload occurs _before_ the first call to a function,
+ ;; byte-compile-callargs-warn does not add an entry to
+ ;; byte-compile-unresolved-functions. Here we mimic the logic
+ ;; of byte-compile-callargs-warn so as not to warn if the
+ ;; autoload comes _after_ the function call.
+ ;; Alternatively, similar logic could go in
+ ;; byte-compile-warn-about-unresolved-functions.
+ (or (memq (nth 1 (nth 1 form)) byte-compile-noruntime-functions)
+ (setq byte-compile-unresolved-functions
+ (delq (assq (nth 1 (nth 1 form))
+ byte-compile-unresolved-functions)
+ byte-compile-unresolved-functions))))
(if (stringp (nth 3 form))
form
;; No doc string, so we can compile this as a normal form.
;; Since there is no doc string, we can compile this as a normal form,
;; and not do a file-boundary.
(byte-compile-keep-pending form)
- (when (memq 'free-vars byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'free-vars)
(push (nth 1 form) byte-compile-bound-variables)
(if (eq (car form) 'defconst)
(push (nth 1 form) byte-compile-const-variables)))
(byte-compile-top-level (nth 2 form) nil 'file))))
form))
+(put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-define-abbrev-table)
+(defun byte-compile-file-form-define-abbrev-table (form)
+ (when (and (byte-compile-warning-enabled-p 'free-vars)
+ (eq 'quote (car-safe (car-safe (cdr form)))))
+ (push (car-safe (cdr (cadr form))) byte-compile-bound-variables))
+ (byte-compile-keep-pending form))
+
(put 'custom-declare-variable 'byte-hunk-handler
'byte-compile-file-form-custom-declare-variable)
(defun byte-compile-file-form-custom-declare-variable (form)
- (when (memq 'callargs byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
- (when (memq 'free-vars byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'free-vars)
(push (nth 1 (nth 1 form)) byte-compile-bound-variables))
+ ;; Don't compile the expression because it may be displayed to the user.
+ ;; (when (eq (car-safe (nth 2 form)) 'quote)
+ ;; ;; (nth 2 form) is meant to evaluate to an expression, so if we have the
+ ;; ;; final value already, we can byte-compile it.
+ ;; (setcar (cdr (nth 2 form))
+ ;; (byte-compile-top-level (cadr (nth 2 form)) nil 'file)))
(let ((tail (nthcdr 4 form)))
(while tail
- ;; If there are any (function (lambda ...)) expressions, compile
- ;; those functions.
- (if (and (consp (car tail))
- (eq (car (car tail)) 'function)
- (consp (nth 1 (car tail))))
- (setcar tail (byte-compile-lambda (nth 1 (car tail))))
- ;; Likewise for a bare lambda.
- (if (and (consp (car tail))
- (eq (car (car tail)) 'lambda))
- (setcar tail (byte-compile-lambda (car tail)))))
+ (unless (keywordp (car tail)) ;No point optimizing keywords.
+ ;; Compile the keyword arguments.
+ (setcar tail (byte-compile-top-level (car tail) nil 'file)))
(setq tail (cdr tail))))
form)
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
- (let ((old-load-list current-load-list)
- (args (mapcar 'eval (cdr form))))
+ (let ((args (mapcar 'eval (cdr form)))
+ (hist-orig load-history)
+ hist-new)
(apply 'require args)
- ;; Detect (require 'cl) in a way that works even if cl is already loaded.
- (if (member (car args) '("cl" cl))
- (setq byte-compile-warnings
- (remq 'cl-functions byte-compile-warnings))))
+ (when (byte-compile-warning-enabled-p 'cl-functions)
+ ;; Detect (require 'cl) in a way that works even if cl is already loaded.
+ (if (member (car args) '("cl" cl))
+ (progn
+ (byte-compile-warn "cl package required at runtime")
+ (byte-compile-disable-warning 'cl-functions))
+ ;; We may have required something that causes cl to be loaded, eg
+ ;; the uncompiled version of a file that requires cl when compiling.
+ (setq hist-new load-history)
+ (while (and (not byte-compile-cl-functions)
+ hist-new (not (eq hist-new hist-orig)))
+ (and (byte-compile-cl-file-p (car (pop hist-new)))
+ (byte-compile-find-cl-functions))))))
(byte-compile-keep-pending form 'byte-compile-normal-call))
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
;; Return nil so the forms are not output twice.
nil)
+(put 'with-no-warnings 'byte-hunk-handler
+ 'byte-compile-file-form-with-no-warnings)
+(defun byte-compile-file-form-with-no-warnings (form)
+ ;; cf byte-compile-file-form-progn.
+ (let (byte-compile-warnings)
+ (mapc 'byte-compile-file-form (cdr form))
+ nil))
+
;; This handler is not necessary, but it makes the output from dont-compile
;; and similar macros cleaner.
(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
(defun byte-compile-file-form-defmacro (form)
(byte-compile-file-form-defmumble form t))
+(defun byte-compile-defmacro-declaration (form)
+ "Generate code for declarations in macro definitions.
+Remove declarations from the body of the macro definition
+by side-effects."
+ (let ((tail (nthcdr 2 form))
+ (res '()))
+ (when (stringp (car (cdr tail)))
+ (setq tail (cdr tail)))
+ (while (and (consp (car (cdr tail)))
+ (eq (car (car (cdr tail))) 'declare))
+ (let ((declaration (car (cdr tail))))
+ (setcdr tail (cdr (cdr tail)))
+ (push `(if macro-declaration-function
+ (funcall macro-declaration-function
+ ',(car (cdr form)) ',declaration))
+ res)))
+ res))
+
(defun byte-compile-file-form-defmumble (form macrop)
- (let* ((name (car (cdr form)))
- (this-kind (if macrop 'byte-compile-macro-environment
+ (let* ((bytecomp-name (car (cdr form)))
+ (bytecomp-this-kind (if macrop 'byte-compile-macro-environment
'byte-compile-function-environment))
- (that-kind (if macrop 'byte-compile-function-environment
+ (bytecomp-that-kind (if macrop 'byte-compile-function-environment
'byte-compile-macro-environment))
- (this-one (assq name (symbol-value this-kind)))
- (that-one (assq name (symbol-value that-kind)))
+ (bytecomp-this-one (assq bytecomp-name
+ (symbol-value bytecomp-this-kind)))
+ (bytecomp-that-one (assq bytecomp-name
+ (symbol-value bytecomp-that-kind)))
(byte-compile-free-references nil)
(byte-compile-free-assignments nil))
- (byte-compile-set-symbol-position name)
+ (byte-compile-set-symbol-position bytecomp-name)
;; When a function or macro is defined, add it to the call tree so that
;; we can tell when functions are not used.
(if byte-compile-generate-call-tree
- (or (assq name byte-compile-call-tree)
+ (or (assq bytecomp-name byte-compile-call-tree)
(setq byte-compile-call-tree
- (cons (list name nil nil) byte-compile-call-tree))))
+ (cons (list bytecomp-name nil nil) byte-compile-call-tree))))
- (setq byte-compile-current-form name) ; for warnings
- (if (memq 'redefine byte-compile-warnings)
+ (setq byte-compile-current-form bytecomp-name) ; for warnings
+ (if (byte-compile-warning-enabled-p 'redefine)
(byte-compile-arglist-warn form macrop))
(if byte-compile-verbose
- (message "Compiling %s... (%s)" (or filename "") (nth 1 form)))
- (cond (that-one
- (if (and (memq 'redefine byte-compile-warnings)
+ ;; bytecomp-filename is from byte-compile-from-buffer.
+ (message "Compiling %s... (%s)" (or bytecomp-filename "") (nth 1 form)))
+ (cond (bytecomp-that-one
+ (if (and (byte-compile-warning-enabled-p 'redefine)
;; don't warn when compiling the stubs in byte-run...
(not (assq (nth 1 form)
byte-compile-initial-macro-environment)))
(byte-compile-warn
"`%s' defined multiple times, as both function and macro"
(nth 1 form)))
- (setcdr that-one nil))
- (this-one
- (when (and (memq 'redefine byte-compile-warnings)
+ (setcdr bytecomp-that-one nil))
+ (bytecomp-this-one
+ (when (and (byte-compile-warning-enabled-p 'redefine)
;; hack: don't warn when compiling the magic internal
;; byte-compiler macros in byte-run.el...
(not (assq (nth 1 form)
(byte-compile-warn "%s `%s' defined multiple times in this file"
(if macrop "macro" "function")
(nth 1 form))))
- ((and (fboundp name)
- (eq (car-safe (symbol-function name))
+ ((and (fboundp bytecomp-name)
+ (eq (car-safe (symbol-function bytecomp-name))
(if macrop 'lambda 'macro)))
- (when (memq 'redefine byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'redefine)
(byte-compile-warn "%s `%s' being redefined as a %s"
(if macrop "function" "macro")
(nth 1 form)
(if macrop "macro" "function")))
;; shadow existing definition
- (set this-kind
- (cons (cons name nil) (symbol-value this-kind))))
+ (set bytecomp-this-kind
+ (cons (cons bytecomp-name nil)
+ (symbol-value bytecomp-this-kind))))
)
(let ((body (nthcdr 3 form)))
(when (and (stringp (car body))
;; Generate code for declarations in macro definitions.
;; Remove declarations from the body of the macro definition.
(when macrop
- (let ((tail (nthcdr 2 form)))
- (when (stringp (car (cdr tail)))
- (setq tail (cdr tail)))
- (while (and (consp (car (cdr tail)))
- (eq (car (car (cdr tail))) 'declare))
- (let ((declaration (car (cdr tail))))
- (setcdr tail (cdr (cdr tail)))
- (prin1 `(if macro-declaration-function
- (funcall macro-declaration-function
- ',name ',declaration))
- outbuffer)))))
+ (dolist (decl (byte-compile-defmacro-declaration form))
+ (prin1 decl bytecomp-outbuffer)))
(let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))
(code (byte-compile-byte-code-maker new-one)))
- (if this-one
- (setcdr this-one new-one)
- (set this-kind
- (cons (cons name new-one) (symbol-value this-kind))))
+ (if bytecomp-this-one
+ (setcdr bytecomp-this-one new-one)
+ (set bytecomp-this-kind
+ (cons (cons bytecomp-name new-one)
+ (symbol-value bytecomp-this-kind))))
(if (and (stringp (nth 3 form))
(eq 'quote (car-safe code))
(eq 'lambda (car-safe (nth 1 code))))
(cons (car form)
- (cons name (cdr (nth 1 code))))
+ (cons bytecomp-name (cdr (nth 1 code))))
(byte-compile-flush-pending)
(if (not (stringp (nth 3 form)))
;; No doc string. Provide -1 as the "doc string index"
(byte-compile-output-docform
(if (byte-compile-version-cond byte-compile-compatibility)
"\n(fset '" "\n(defalias '")
- name
+ bytecomp-name
(cond ((atom code)
(if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
((eq (car code) 'quote)
(byte-compile-output-docform
(if (byte-compile-version-cond byte-compile-compatibility)
"\n(fset '" "\n(defalias '")
- name
+ bytecomp-name
(cond ((atom code)
(if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
((eq (car code) 'quote)
(and (atom code) byte-compile-dynamic
1)
nil))
- (princ ")" outbuffer)
+ (princ ")" bytecomp-outbuffer)
nil))))
;; Print Lisp object EXP in the output file, inside a comment,
;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
(defun byte-compile-output-as-comment (exp quoted)
(let ((position (point)))
- (set-buffer
- (prog1 (current-buffer)
- (set-buffer outbuffer)
-
- ;; Insert EXP, and make it a comment with #@LENGTH.
- (insert " ")
- (if quoted
- (prin1 exp outbuffer)
- (princ exp outbuffer))
- (goto-char position)
- ;; Quote certain special characters as needed.
- ;; get_doc_string in doc.c does the unquoting.
- (while (search-forward "\^A" nil t)
- (replace-match "\^A\^A" t t))
- (goto-char position)
- (while (search-forward "\000" nil t)
- (replace-match "\^A0" t t))
- (goto-char position)
- (while (search-forward "\037" nil t)
- (replace-match "\^A_" t t))
- (goto-char (point-max))
- (insert "\037")
- (goto-char position)
- (insert "#@" (format "%d" (- (position-bytes (point-max))
- (position-bytes position))))
-
- ;; Save the file position of the object.
- ;; Note we should add 1 to skip the space
- ;; that we inserted before the actual doc string,
- ;; and subtract 1 to convert from an 1-origin Emacs position
- ;; to a file position; they cancel.
- (setq position (point))
- (goto-char (point-max))))
+ (with-current-buffer bytecomp-outbuffer
+
+ ;; Insert EXP, and make it a comment with #@LENGTH.
+ (insert " ")
+ (if quoted
+ (prin1 exp bytecomp-outbuffer)
+ (princ exp bytecomp-outbuffer))
+ (goto-char position)
+ ;; Quote certain special characters as needed.
+ ;; get_doc_string in doc.c does the unquoting.
+ (while (search-forward "\^A" nil t)
+ (replace-match "\^A\^A" t t))
+ (goto-char position)
+ (while (search-forward "\000" nil t)
+ (replace-match "\^A0" t t))
+ (goto-char position)
+ (while (search-forward "\037" nil t)
+ (replace-match "\^A_" t t))
+ (goto-char (point-max))
+ (insert "\037")
+ (goto-char position)
+ (insert "#@" (format "%d" (- (position-bytes (point-max))
+ (position-bytes position))))
+
+ ;; Save the file position of the object.
+ ;; Note we should add 1 to skip the space
+ ;; that we inserted before the actual doc string,
+ ;; and subtract 1 to convert from an 1-origin Emacs position
+ ;; to a file position; they cancel.
+ (setq position (point))
+ (goto-char (point-max)))
position))
;; of the list FUN and `byte-compile-set-symbol-position' is not called.
;; Use this feature to avoid calling `byte-compile-set-symbol-position'
;; for symbols generated by the byte compiler itself.
-(defun byte-compile-lambda (fun &optional add-lambda)
+(defun byte-compile-lambda (bytecomp-fun &optional add-lambda)
(if add-lambda
- (setq fun (cons 'lambda fun))
- (unless (eq 'lambda (car-safe fun))
- (error "Not a lambda list: %S" fun))
+ (setq bytecomp-fun (cons 'lambda bytecomp-fun))
+ (unless (eq 'lambda (car-safe bytecomp-fun))
+ (error "Not a lambda list: %S" bytecomp-fun))
(byte-compile-set-symbol-position 'lambda))
- (byte-compile-check-lambda-list (nth 1 fun))
- (let* ((arglist (nth 1 fun))
+ (byte-compile-check-lambda-list (nth 1 bytecomp-fun))
+ (let* ((bytecomp-arglist (nth 1 bytecomp-fun))
(byte-compile-bound-variables
- (nconc (and (memq 'free-vars byte-compile-warnings)
- (delq '&rest (delq '&optional (copy-sequence arglist))))
+ (nconc (and (byte-compile-warning-enabled-p 'free-vars)
+ (delq '&rest
+ (delq '&optional (copy-sequence bytecomp-arglist))))
byte-compile-bound-variables))
- (body (cdr (cdr fun)))
- (doc (if (stringp (car body))
- (prog1 (car body)
+ (bytecomp-body (cdr (cdr bytecomp-fun)))
+ (bytecomp-doc (if (stringp (car bytecomp-body))
+ (prog1 (car bytecomp-body)
;; Discard the doc string
;; unless it is the last element of the body.
- (if (cdr body)
- (setq body (cdr body))))))
- (int (assq 'interactive body)))
+ (if (cdr bytecomp-body)
+ (setq bytecomp-body (cdr bytecomp-body))))))
+ (bytecomp-int (assq 'interactive bytecomp-body)))
;; Process the interactive spec.
- (when int
+ (when bytecomp-int
(byte-compile-set-symbol-position 'interactive)
;; Skip (interactive) if it is in front (the most usual location).
- (if (eq int (car body))
- (setq body (cdr body)))
- (cond ((consp (cdr int))
- (if (cdr (cdr int))
+ (if (eq bytecomp-int (car bytecomp-body))
+ (setq bytecomp-body (cdr bytecomp-body)))
+ (cond ((consp (cdr bytecomp-int))
+ (if (cdr (cdr bytecomp-int))
(byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int)))
+ (prin1-to-string bytecomp-int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
;; args of `list'. Actually, compile it to get warnings,
;; but don't use the result.
- (let ((form (nth 1 int)))
+ (let ((form (nth 1 bytecomp-int)))
(while (memq (car-safe form) '(let let* progn save-excursion))
(while (consp (cdr form))
(setq form (cdr form)))
(setq form (car form)))
(if (eq (car-safe form) 'list)
- (byte-compile-top-level (nth 1 int))
- (setq int (list 'interactive
- (byte-compile-top-level (nth 1 int)))))))
- ((cdr int)
+ (byte-compile-top-level (nth 1 bytecomp-int))
+ (setq bytecomp-int (list 'interactive
+ (byte-compile-top-level
+ (nth 1 bytecomp-int)))))))
+ ((cdr bytecomp-int)
(byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string int)))))
+ (prin1-to-string bytecomp-int)))))
;; Process the body.
- (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
+ (let ((compiled (byte-compile-top-level
+ (cons 'progn bytecomp-body) nil 'lambda)))
;; Build the actual byte-coded function.
(if (and (eq 'byte-code (car-safe compiled))
(not (byte-compile-version-cond
byte-compile-compatibility)))
(apply 'make-byte-code
- (append (list arglist)
+ (append (list bytecomp-arglist)
;; byte-string, constants-vector, stack depth
(cdr compiled)
;; optionally, the doc string.
- (if (or doc int)
- (list doc))
+ (if (or bytecomp-doc bytecomp-int)
+ (list bytecomp-doc))
;; optionally, the interactive spec.
- (if int
- (list (nth 1 int)))))
+ (if bytecomp-int
+ (list (nth 1 bytecomp-int)))))
(setq compiled
- (nconc (if int (list int))
+ (nconc (if bytecomp-int (list bytecomp-int))
(cond ((eq (car-safe compiled) 'progn) (cdr compiled))
(compiled (list compiled)))))
- (nconc (list 'lambda arglist)
- (if (or doc (stringp (car compiled)))
- (cons doc (cond (compiled)
- (body (list nil))))
+ (nconc (list 'lambda bytecomp-arglist)
+ (if (or bytecomp-doc (stringp (car compiled)))
+ (cons bytecomp-doc (cond (compiled)
+ (bytecomp-body (list nil))))
compiled))))))
(defun byte-compile-constants-vector ()
((cdr body) (cons 'progn (nreverse body)))
((car body)))))
-;; Given BODY, compile it and return a new body.
-(defun byte-compile-top-level-body (body &optional for-effect)
- (setq body (byte-compile-top-level (cons 'progn body) for-effect t))
- (cond ((eq (car-safe body) 'progn)
- (cdr body))
- (body
- (list body))))
+;; Given BYTECOMP-BODY, compile it and return a new body.
+(defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
+ (setq bytecomp-body
+ (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
+ (cond ((eq (car-safe bytecomp-body) 'progn)
+ (cdr bytecomp-body))
+ (bytecomp-body
+ (list bytecomp-body))))
+
+(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function)
+(defun byte-compile-declare-function (form)
+ (push (cons (nth 1 form)
+ (if (and (> (length form) 3)
+ (listp (nth 3 form)))
+ (list 'declared (nth 3 form))
+ t)) ; arglist not specified
+ byte-compile-function-environment)
+ ;; We are stating that it _will_ be defined at runtime.
+ (setq byte-compile-noruntime-functions
+ (delq (nth 1 form) byte-compile-noruntime-functions))
+ nil)
+
\f
;; This is the recursive entry point for compiling each subform of an
;; expression.
(setq for-effect nil))
(t (byte-compile-variable-ref 'byte-varref form))))
((symbolp (car form))
- (let* ((fn (car form))
- (handler (get fn 'byte-compile)))
- (when (byte-compile-const-symbol-p fn)
- (byte-compile-warn "`%s' called as a function" fn))
- (and (memq 'interactive-only byte-compile-warnings)
- (memq fn byte-compile-interactive-only-functions)
+ (let* ((bytecomp-fn (car form))
+ (bytecomp-handler (get bytecomp-fn 'byte-compile)))
+ (when (byte-compile-const-symbol-p bytecomp-fn)
+ (byte-compile-warn "`%s' called as a function" bytecomp-fn))
+ (and (byte-compile-warning-enabled-p 'interactive-only)
+ (memq bytecomp-fn byte-compile-interactive-only-functions)
(byte-compile-warn "`%s' used from Lisp code\n\
-That command is designed for interactive use only" fn))
- (if (and handler
+That command is designed for interactive use only" bytecomp-fn))
+ (when (byte-compile-warning-enabled-p 'callargs)
+ (if (memq bytecomp-fn
+ '(custom-declare-group custom-declare-variable
+ custom-declare-face))
+ (byte-compile-nogroup-warn form))
+ (byte-compile-callargs-warn form))
+ (if (and bytecomp-handler
;; Make sure that function exists. This is important
;; for CL compiler macros since the symbol may be
;; `cl-byte-compile-compiler-macro' but if CL isn't
;; loaded, this function doesn't exist.
- (or (not (memq handler '(cl-byte-compile-compiler-macro)))
- (functionp handler))
+ (or (not (memq bytecomp-handler
+ '(cl-byte-compile-compiler-macro)))
+ (functionp bytecomp-handler))
(not (and (byte-compile-version-cond
byte-compile-compatibility)
- (get (get fn 'byte-opcode) 'emacs19-opcode))))
- (funcall handler form)
- (when (memq 'callargs byte-compile-warnings)
- (if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
- (byte-compile-nogroup-warn form))
- (byte-compile-callargs-warn form))
+ (get (get bytecomp-fn 'byte-opcode)
+ 'emacs19-opcode))))
+ (funcall bytecomp-handler form)
(byte-compile-normal-call form))
- (if (memq 'cl-functions byte-compile-warnings)
+ (if (byte-compile-warning-enabled-p 'cl-functions)
(byte-compile-cl-warn form))))
((and (or (byte-code-function-p (car form))
(eq (car-safe (car form)) 'lambda))
(defun byte-compile-normal-call (form)
(if byte-compile-generate-call-tree
(byte-compile-annotate-call-tree form))
+ (when (and for-effect (eq (car form) 'mapcar)
+ (byte-compile-warning-enabled-p 'mapcar))
+ (byte-compile-set-symbol-position 'mapcar)
+ (byte-compile-warn
+ "`mapcar' called for effect; use `mapc' or `dolist' instead"))
(byte-compile-push-constant (car form))
(mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
(byte-compile-out 'byte-call (length (cdr form))))
-(defun byte-compile-variable-ref (base-op var)
- (when (symbolp var)
- (byte-compile-set-symbol-position var))
- (if (or (not (symbolp var))
- (byte-compile-const-symbol-p var (not (eq base-op 'byte-varref))))
+(defun byte-compile-variable-ref (base-op bytecomp-var)
+ (when (symbolp bytecomp-var)
+ (byte-compile-set-symbol-position bytecomp-var))
+ (if (or (not (symbolp bytecomp-var))
+ (byte-compile-const-symbol-p bytecomp-var
+ (not (eq base-op 'byte-varref))))
(byte-compile-warn
(cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
((eq base-op 'byte-varset) "variable assignment to %s `%s'")
(t "variable reference to %s `%s'"))
- (if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var))
- (if (and (get var 'byte-obsolete-variable)
- (memq 'obsolete byte-compile-warnings)
- (not (eq var byte-compile-not-obsolete-var)))
- (let* ((ob (get var 'byte-obsolete-variable))
- (when (cdr ob)))
- (byte-compile-warn "`%s' is an obsolete variable%s; %s" var
- (if when (concat " (as of Emacs " when ")") "")
- (if (stringp (car ob))
- (car ob)
- (format "use `%s' instead." (car ob))))))
- (if (memq 'free-vars byte-compile-warnings)
+ (if (symbolp bytecomp-var) "constant" "nonvariable")
+ (prin1-to-string bytecomp-var))
+ (and (get bytecomp-var 'byte-obsolete-variable)
+ (not (memq bytecomp-var byte-compile-not-obsolete-vars))
+ (byte-compile-warn-obsolete bytecomp-var))
+ (if (byte-compile-warning-enabled-p 'free-vars)
(if (eq base-op 'byte-varbind)
- (push var byte-compile-bound-variables)
- (or (boundp var)
- (memq var byte-compile-bound-variables)
+ (push bytecomp-var byte-compile-bound-variables)
+ (or (boundp bytecomp-var)
+ (memq bytecomp-var byte-compile-bound-variables)
(if (eq base-op 'byte-varset)
- (or (memq var byte-compile-free-assignments)
+ (or (memq bytecomp-var byte-compile-free-assignments)
(progn
- (byte-compile-warn "assignment to free variable `%s'" var)
- (push var byte-compile-free-assignments)))
- (or (memq var byte-compile-free-references)
+ (byte-compile-warn "assignment to free variable `%s'"
+ bytecomp-var)
+ (push bytecomp-var byte-compile-free-assignments)))
+ (or (memq bytecomp-var byte-compile-free-references)
(progn
- (byte-compile-warn "reference to free variable `%s'" var)
- (push var byte-compile-free-references))))))))
- (let ((tmp (assq var byte-compile-variables)))
+ (byte-compile-warn "reference to free variable `%s'"
+ bytecomp-var)
+ (push bytecomp-var byte-compile-free-references))))))))
+ (let ((tmp (assq bytecomp-var byte-compile-variables)))
(unless tmp
- (setq tmp (list var))
+ (setq tmp (list bytecomp-var))
(push tmp byte-compile-variables))
(byte-compile-out base-op tmp)))
;; which have special byte codes just for speed.
(defmacro byte-defop-compiler (function &optional compile-handler)
- ;; add a compiler-form for FUNCTION.
- ;; If function is a symbol, then the variable "byte-SYMBOL" must name
- ;; the opcode to be used. If function is a list, the first element
- ;; is the function and the second element is the bytecode-symbol.
- ;; The second element may be nil, meaning there is no opcode.
- ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
- ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
- ;; If it is nil, then the handler is "byte-compile-SYMBOL."
+ "Add a compiler-form for FUNCTION.
+If function is a symbol, then the variable \"byte-SYMBOL\" must name
+the opcode to be used. If function is a list, the first element
+is the function and the second element is the bytecode-symbol.
+The second element may be nil, meaning there is no opcode.
+COMPILE-HANDLER is the function to use to compile this byte-op, or
+may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
+If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(let (opcode)
(if (symbolp function)
(setq opcode (intern (concat "byte-" (symbol-name function))))
(defun byte-compile-associative (form)
(if (cdr form)
(let ((opcode (get (car form) 'byte-opcode))
- (args (copy-sequence (cdr form))))
- (byte-compile-form (car args))
- (setq args (cdr args))
- (or args (setq args '(0)
- opcode (get '+ 'byte-opcode)))
- (dolist (arg args)
- (byte-compile-form arg)
- (byte-compile-out opcode 0)))
+ args)
+ (if (and (< 3 (length form))
+ (memq opcode (list (get '+ 'byte-opcode)
+ (get '* 'byte-opcode))))
+ ;; Don't use binary operations for > 2 operands, as that
+ ;; may cause overflow/truncation in float operations.
+ (byte-compile-normal-call form)
+ (setq args (copy-sequence (cdr form)))
+ (byte-compile-form (car args))
+ (setq args (cdr args))
+ (or args (setq args '(0)
+ opcode (get '+ 'byte-opcode)))
+ (dolist (arg args)
+ (byte-compile-form arg)
+ (byte-compile-out opcode 0))))
(byte-compile-constant (eval form))))
\f
((byte-compile-normal-call form)))))
(defun byte-compile-minus (form)
- (if (null (setq form (cdr form)))
- (byte-compile-constant 0)
- (byte-compile-form (car form))
- (if (cdr form)
- (while (setq form (cdr form))
- (byte-compile-form (car form))
- (byte-compile-out 'byte-diff 0))
- (byte-compile-out 'byte-negate 0))))
+ (let ((len (length form)))
+ (cond
+ ((= 1 len) (byte-compile-constant 0))
+ ((= 2 len)
+ (byte-compile-form (cadr form))
+ (byte-compile-out 'byte-negate 0))
+ ((= 3 len)
+ (byte-compile-form (nth 1 form))
+ (byte-compile-form (nth 2 form))
+ (byte-compile-out 'byte-diff 0))
+ ;; Don't use binary operations for > 2 operands, as that may
+ ;; cause overflow/truncation in float operations.
+ (t (byte-compile-normal-call form)))))
(defun byte-compile-quo (form)
(let ((len (length form)))
(cond ((<= len 2)
(byte-compile-subr-wrong-args form "2 or more"))
+ ((= len 3)
+ (byte-compile-two-args form))
(t
- (byte-compile-form (car (setq form (cdr form))))
- (while (setq form (cdr form))
- (byte-compile-form (car form))
- (byte-compile-out 'byte-quo 0))))))
+ ;; Don't use binary operations for > 2 operands, as that
+ ;; may cause overflow/truncation in float operations.
+ (byte-compile-normal-call form)))))
(defun byte-compile-nconc (form)
(let ((len (length form)))
(byte-defop-compiler-1 quote-form)
(defun byte-compile-setq (form)
- (let ((args (cdr form)))
- (if args
- (while args
- (byte-compile-form (car (cdr args)))
- (or for-effect (cdr (cdr args))
+ (let ((bytecomp-args (cdr form)))
+ (if bytecomp-args
+ (while bytecomp-args
+ (byte-compile-form (car (cdr bytecomp-args)))
+ (or for-effect (cdr (cdr bytecomp-args))
(byte-compile-out 'byte-dup 0))
- (byte-compile-variable-ref 'byte-varset (car args))
- (setq args (cdr (cdr args))))
+ (byte-compile-variable-ref 'byte-varset (car bytecomp-args))
+ (setq bytecomp-args (cdr (cdr bytecomp-args))))
;; (setq), with no arguments.
(byte-compile-form nil for-effect))
(setq for-effect nil)))
(defun byte-compile-setq-default (form)
- (let ((args (cdr form))
+ (let ((bytecomp-args (cdr form))
setters)
- (while args
- (setq setters
- (cons (list 'set-default (list 'quote (car args)) (car (cdr args)))
- setters))
- (setq args (cdr (cdr args))))
+ (while bytecomp-args
+ (let ((var (car bytecomp-args)))
+ (if (or (not (symbolp var))
+ (byte-compile-const-symbol-p var t))
+ (byte-compile-warn
+ "variable assignment to %s `%s'"
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var)))
+ (push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
+ setters))
+ (setq bytecomp-args (cdr (cdr bytecomp-args))))
(byte-compile-form (cons 'progn (nreverse setters)))))
(defun byte-compile-quote (form)
\f
;;; control structures
-(defun byte-compile-body (body &optional for-effect)
- (while (cdr body)
- (byte-compile-form (car body) t)
- (setq body (cdr body)))
- (byte-compile-form (car body) for-effect))
+(defun byte-compile-body (bytecomp-body &optional for-effect)
+ (while (cdr bytecomp-body)
+ (byte-compile-form (car bytecomp-body) t)
+ (setq bytecomp-body (cdr bytecomp-body)))
+ (byte-compile-form (car bytecomp-body) for-effect))
-(defsubst byte-compile-body-do-effect (body)
- (byte-compile-body body for-effect)
+(defsubst byte-compile-body-do-effect (bytecomp-body)
+ (byte-compile-body bytecomp-body for-effect)
(setq for-effect nil))
(defsubst byte-compile-form-do-effect (form)
(byte-defop-compiler-1 mapc byte-compile-funarg)
(byte-defop-compiler-1 maphash byte-compile-funarg)
(byte-defop-compiler-1 map-char-table byte-compile-funarg)
+(byte-defop-compiler-1 map-char-table byte-compile-funarg-2)
+;; map-charset-chars should be funarg but has optional third arg
(byte-defop-compiler-1 sort byte-compile-funarg-2)
(byte-defop-compiler-1 let)
(byte-defop-compiler-1 let*)
(if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
,tag))
+;; Return the list of items in CONDITION-PARAM that match PRED-LIST.
+;; Only return items that are not in ONLY-IF-NOT-PRESENT.
+(defun byte-compile-find-bound-condition (condition-param
+ pred-list
+ &optional only-if-not-present)
+ (let ((result nil)
+ (nth-one nil)
+ (cond-list
+ (if (memq (car-safe condition-param) pred-list)
+ ;; The condition appears by itself.
+ (list condition-param)
+ ;; If the condition is an `and', look for matches among the
+ ;; `and' arguments.
+ (when (eq 'and (car-safe condition-param))
+ (cdr condition-param)))))
+
+ (dolist (crt cond-list)
+ (when (and (memq (car-safe crt) pred-list)
+ (eq 'quote (car-safe (setq nth-one (nth 1 crt))))
+ ;; Ignore if the symbol is already on the unresolved
+ ;; list.
+ (not (assq (nth 1 nth-one) ; the relevant symbol
+ only-if-not-present)))
+ (push (nth 1 (nth 1 crt)) result)))
+ result))
+
(defmacro byte-compile-maybe-guarded (condition &rest body)
"Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is a variable whose value is a test in an `if' or `cond'.
-BODY is the code to compile first arm of the if or the body of the
-cond clause. If CONDITION's value is of the form (fboundp 'foo)
+BODY is the code to compile in the first arm of the if or the body of
+the cond clause. If CONDITION's value is of the form (fboundp 'foo)
or (boundp 'foo), the relevant warnings from BODY about foo's
-being undefined will be suppressed.
+being undefined (or obsolete) will be suppressed.
If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
that suppresses all warnings during execution of BODY."
(declare (indent 1) (debug t))
- `(let* ((fbound
- (if (eq 'fboundp (car-safe ,condition))
- (and (eq 'quote (car-safe (nth 1 ,condition)))
- ;; Ignore if the symbol is already on the
- ;; unresolved list.
- (not (assq (nth 1 (nth 1 ,condition)) ; the relevant symbol
- byte-compile-unresolved-functions))
- (nth 1 (nth 1 ,condition)))))
- (bound (if (or (eq 'boundp (car-safe ,condition))
- (eq 'default-boundp (car-safe ,condition)))
- (and (eq 'quote (car-safe (nth 1 ,condition)))
- (nth 1 (nth 1 ,condition)))))
+ `(let* ((fbound-list (byte-compile-find-bound-condition
+ ,condition (list 'fboundp)
+ byte-compile-unresolved-functions))
+ (bound-list (byte-compile-find-bound-condition
+ ,condition (list 'boundp 'default-boundp)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
- (if bound
- (cons bound byte-compile-bound-variables)
- byte-compile-bound-variables))
- ;; Suppress all warnings, for code not used in Emacs.
- (byte-compile-warnings
- (if (member ,condition '((featurep 'xemacs)
- (not (featurep 'emacs))))
- nil byte-compile-warnings)))
+ (if bound-list
+ (append bound-list byte-compile-bound-variables)
+ byte-compile-bound-variables)))
(unwind-protect
- (progn ,@body)
+ ;; If things not being bound at all is ok, so must them being obsolete.
+ ;; Note that we add to the existing lists since Tramp (ab)uses
+ ;; this feature.
+ (let ((byte-compile-not-obsolete-vars
+ (append byte-compile-not-obsolete-vars bound-list))
+ (byte-compile-not-obsolete-funcs
+ (append byte-compile-not-obsolete-funcs fbound-list)))
+ ,@body)
;; Maybe remove the function symbol from the unresolved list.
- (if fbound
+ (dolist (fbound fbound-list)
+ (when fbound
(setq byte-compile-unresolved-functions
(delq (assq fbound byte-compile-unresolved-functions)
- byte-compile-unresolved-functions))))))
+ byte-compile-unresolved-functions)))))))
(defun byte-compile-if (form)
(byte-compile-form (car (cdr form)))
(defun byte-compile-and (form)
(let ((failtag (byte-compile-make-tag))
- (args (cdr form)))
- (if (null args)
+ (bytecomp-args (cdr form)))
+ (if (null bytecomp-args)
(byte-compile-form-do-effect t)
- (byte-compile-and-recursion args failtag))))
+ (byte-compile-and-recursion bytecomp-args failtag))))
;; Handle compilation of a nontrivial `and' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(defun byte-compile-or (form)
(let ((wintag (byte-compile-make-tag))
- (args (cdr form)))
- (if (null args)
+ (bytecomp-args (cdr form)))
+ (if (null bytecomp-args)
(byte-compile-form-do-effect nil)
- (byte-compile-or-recursion args wintag))))
+ (byte-compile-or-recursion bytecomp-args wintag))))
;; Handle compilation of a nontrivial `or' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
(varlist (reverse (car (cdr form)))))
(dolist (var varlist)
- (byte-compile-variable-ref 'byte-varbind (if (consp var) (car var) var)))
+ (byte-compile-variable-ref 'byte-varbind
+ (if (consp var) (car var) var)))
(byte-compile-body-do-effect (cdr (cdr form)))
(byte-compile-out 'byte-unbind (length (car (cdr form))))))
(defun byte-compile-defmacro (form)
;; This is not used for file-level defmacros with doc strings.
(byte-compile-body-do-effect
- (list (list 'fset (list 'quote (nth 1 form))
- (let ((code (byte-compile-byte-code-maker
- (byte-compile-lambda (cdr (cdr form)) t))))
- (if (eq (car-safe code) 'make-byte-code)
- (list 'cons ''macro code)
- (list 'quote (cons 'macro (eval code))))))
- (list 'quote (nth 1 form)))))
+ (let ((decls (byte-compile-defmacro-declaration form))
+ (code (byte-compile-byte-code-maker
+ (byte-compile-lambda (cdr (cdr form)) t))))
+ `((defalias ',(nth 1 form)
+ ,(if (eq (car-safe code) 'make-byte-code)
+ `(cons 'macro ,code)
+ `'(macro . ,(eval code))))
+ ,@decls
+ ',(nth 1 form)))))
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
(if (= 1 ncall) "" "s")
(if (< ncall 2) "requires" "accepts only")
"2-3")))
- (when (memq 'free-vars byte-compile-warnings)
+ (when (byte-compile-warning-enabled-p 'free-vars)
(push var byte-compile-bound-variables)
(if (eq fun 'defconst)
(push var byte-compile-const-variables)))
fun var string))
`(put ',var 'variable-documentation ,string))
(if (cddr form) ; `value' provided
- (let ((byte-compile-not-obsolete-var var))
+ (let ((byte-compile-not-obsolete-vars (list var)))
(if (eq fun 'defconst)
;; `defconst' sets `var' unconditionally.
(let ((tmp (make-symbol "defconst-tmp-var")))
(push (cons (nth 1 (nth 1 form))
(if constant (nth 1 (nth 2 form)) t))
byte-compile-function-environment)))
- ;; We used to jus do: (byte-compile-normal-call form)
+ ;; We used to just do: (byte-compile-normal-call form)
;; But it turns out that this fails to optimize the code.
;; So instead we now do the same as what other byte-hunk-handlers do,
;; which is to call back byte-compile-file-form and then return nil.
(byte-compile-form (cons 'progn (cdr form)))))
;; Warn about misuses of make-variable-buffer-local.
-(byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local)
+(byte-defop-compiler-1 make-variable-buffer-local
+ byte-compile-make-variable-buffer-local)
(defun byte-compile-make-variable-buffer-local (form)
- (if (eq (car-safe (car-safe (cdr-safe form))) 'quote)
+ (if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote)
+ (byte-compile-warning-enabled-p 'make-local))
(byte-compile-warn
"`make-variable-buffer-local' should be called at toplevel"))
(byte-compile-normal-call form))
(defvar command-line-args-left) ;Avoid 'free variable' warning
(if (not noninteractive)
(error "`batch-byte-compile' is to be used only with -batch"))
- (let ((error nil))
+ (let ((bytecomp-error nil))
(while command-line-args-left
(if (file-directory-p (expand-file-name (car command-line-args-left)))
;; Directory as argument.
- (let ((files (directory-files (car command-line-args-left)))
- source dest)
- (dolist (file files)
- (if (and (string-match emacs-lisp-file-regexp file)
- (not (auto-save-file-name-p file))
- (setq source (expand-file-name file
- (car command-line-args-left)))
- (setq dest (byte-compile-dest-file source))
- (file-exists-p dest)
- (file-newer-than-file-p source dest))
- (if (null (batch-byte-compile-file source))
- (setq error t)))))
+ (let ((bytecomp-files (directory-files (car command-line-args-left)))
+ bytecomp-source bytecomp-dest)
+ (dolist (bytecomp-file bytecomp-files)
+ (if (and (string-match emacs-lisp-file-regexp bytecomp-file)
+ (not (auto-save-file-name-p bytecomp-file))
+ (setq bytecomp-source
+ (expand-file-name bytecomp-file
+ (car command-line-args-left)))
+ (setq bytecomp-dest (byte-compile-dest-file
+ bytecomp-source))
+ (file-exists-p bytecomp-dest)
+ (file-newer-than-file-p bytecomp-source bytecomp-dest))
+ (if (null (batch-byte-compile-file bytecomp-source))
+ (setq bytecomp-error t)))))
;; Specific file argument
(if (or (not noforce)
- (let* ((source (car command-line-args-left))
- (dest (byte-compile-dest-file source)))
- (or (not (file-exists-p dest))
- (file-newer-than-file-p source dest))))
+ (let* ((bytecomp-source (car command-line-args-left))
+ (bytecomp-dest (byte-compile-dest-file bytecomp-source)))
+ (or (not (file-exists-p bytecomp-dest))
+ (file-newer-than-file-p bytecomp-source bytecomp-dest))))
(if (null (batch-byte-compile-file (car command-line-args-left)))
- (setq error t))))
+ (setq bytecomp-error t))))
(setq command-line-args-left (cdr command-line-args-left)))
- (kill-emacs (if error 1 0))))
+ (kill-emacs (if bytecomp-error 1 0))))
-(defun batch-byte-compile-file (file)
+(defun batch-byte-compile-file (bytecomp-file)
(if debug-on-error
- (byte-compile-file file)
+ (byte-compile-file bytecomp-file)
(condition-case err
- (byte-compile-file file)
+ (byte-compile-file bytecomp-file)
(file-error
(message (if (cdr err)
">>Error occurred processing %s: %s (%s)"
">>Error occurred processing %s: %s")
- file
+ bytecomp-file
(get (car err) 'error-message)
(prin1-to-string (cdr err)))
- (let ((destfile (byte-compile-dest-file file)))
- (if (file-exists-p destfile)
- (delete-file destfile)))
+ (let ((bytecomp-destfile (byte-compile-dest-file bytecomp-file)))
+ (if (file-exists-p bytecomp-destfile)
+ (delete-file bytecomp-destfile)))
nil)
(error
(message (if (cdr err)
">>Error occurred processing %s: %s (%s)"
">>Error occurred processing %s: %s")
- file
+ bytecomp-file
(get (car err) 'error-message)
(prin1-to-string (cdr err)))
nil))))
+(defun byte-compile-refresh-preloaded ()
+ "Reload any Lisp file that was changed since Emacs was dumped.
+Use with caution."
+ (let* ((argv0 (car command-line-args))
+ (emacs-file (executable-find argv0)))
+ (if (not (and emacs-file (file-executable-p emacs-file)))
+ (message "Can't find %s to refresh preloaded Lisp files" argv0)
+ (dolist (f (reverse load-history))
+ (setq f (car f))
+ (if (string-match "elc\\'" f) (setq f (substring f 0 -1)))
+ (when (and (file-readable-p f)
+ (file-newer-than-file-p f emacs-file))
+ (message "Reloading stale %s" (file-name-nondirectory f))
+ (condition-case nil
+ (load f 'noerror nil 'nosuffix)
+ ;; Probably shouldn't happen, but in case of an error, it seems
+ ;; at least as useful to ignore it as it is to stop compilation.
+ (error nil)))))))
+
;;;###autoload
(defun batch-byte-recompile-directory (&optional arg)
"Run `byte-recompile-directory' on the dirs remaining on the command line.
(assq 'byte-code (symbol-function 'byte-compile-form))
(let ((byte-optimize nil) ; do it fast
(byte-compile-warnings nil))
- (mapcar (lambda (x)
- (or noninteractive (message "compiling %s..." x))
- (byte-compile x)
- (or noninteractive (message "compiling %s...done" x)))
- '(byte-compile-normal-call
- byte-compile-form
- byte-compile-body
- ;; Inserted some more than necessary, to speed it up.
- byte-compile-top-level
- byte-compile-out-toplevel
- byte-compile-constant
- byte-compile-variable-ref))))
+ (mapc (lambda (x)
+ (or noninteractive (message "compiling %s..." x))
+ (byte-compile x)
+ (or noninteractive (message "compiling %s...done" x)))
+ '(byte-compile-normal-call
+ byte-compile-form
+ byte-compile-body
+ ;; Inserted some more than necessary, to speed it up.
+ byte-compile-top-level
+ byte-compile-out-toplevel
+ byte-compile-constant
+ byte-compile-variable-ref))))
nil)
(run-hooks 'bytecomp-load-hook)