;;; 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 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008 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:
;;;###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
- make-local mapcar))
+ (when (memq e byte-compile-warning-types)
e))
x)
x))))
(setcar (cdr bytes) (logand pc 255))
(setcar bytes (lsh pc -8))))
(setq patchlist (cdr patchlist))))
- (concat (nreverse bytes))))
+ (apply 'unibyte-string (nreverse bytes))))
\f
;;; compile-time evaluation
(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.
(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))))
+ (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 (byte-compile-warning-enabled-p 'obsolete)
- (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
(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)
(when (and (stringp (car elt))
(string-match
"^cl\\>" (file-name-nondirectory (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))))))
+ (dolist (e (cdr elt))
+ (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."
(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
;;;###autoload
-(defun byte-recompile-directory (directory &optional arg force)
- "Recompile every `.el' file in DIRECTORY that needs recompilation.
+(defun byte-recompile-directory (bytecomp-directory &optional bytecomp-arg
+ bytecomp-force)
+ "Recompile every `.el' file in BYTECOMP-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.
+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.
;;;###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)
(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)
+ (let ((buffer-file-name bytecomp-filename)
(default-major-mode 'emacs-lisp-mode)
;; Ignore unsafe local variables.
;; We only care about a few of them for our purposes.
(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))
(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))))
(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 21 or earlier.\n")
+ ;; Replace "19" or "19.29" with "22", 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 (point-min))
- ;; 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")))))
(defun byte-compile-output-file-form (form)
;; writes the given form to the output buffer, being careful of docstrings
(byte-compile-nogroup-warn form))
(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)
(cdr body))
(body
(list 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.
(t "variable reference to %s `%s'"))
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))
- (if (and (get var 'byte-obsolete-variable)
- (byte-compile-warning-enabled-p 'obsolete)
- (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))))))
+ (and (get var 'byte-obsolete-variable)
+ (not (eq var byte-compile-not-obsolete-var))
+ (byte-compile-warn-obsolete var))
(if (byte-compile-warning-enabled-p 'free-vars)
(if (eq base-op 'byte-varbind)
(push var byte-compile-bound-variables)
(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*)
;; 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
+(defun byte-compile-find-bound-condition (condition-param
+ pred-list
&optional only-if-not-present)
(let ((result nil)
(nth-one nil)
- (cond-list
+ (cond-list
(if (memq (car-safe condition-param) pred-list)
;; The condition appears by itself.
(list condition-param)
;; `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))))
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-list (byte-compile-find-bound-condition
- ,condition (list 'fboundp)
+ `(let* ((fbound-list (byte-compile-find-bound-condition
+ ,condition (list 'fboundp)
byte-compile-unresolved-functions))
- (bound-list (byte-compile-find-bound-condition
+ (bound-list (byte-compile-find-bound-condition
,condition (list 'boundp 'default-boundp)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
(if bound-list
(append bound-list byte-compile-bound-variables)
- byte-compile-bound-variables))
- ;; Suppress all warnings, for code not used in Emacs.
- ;; FIXME: by the time this is executed the `featurep'
- ;; emacs/xemacs tests have been optimized away, so this is
- ;; not doing anything useful here, is should probably be
- ;; moved to a different place.
- ;; (byte-compile-warnings
- ;; (if (member ,condition '((featurep 'xemacs)
- ;; (not (featurep 'emacs))))
- ;; nil byte-compile-warnings))
- )
+ byte-compile-bound-variables)))
(unwind-protect
(progn ,@body)
;; Maybe remove the function symbol from the unresolved list.
(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))
+ (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 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 command-line-args-left (cdr command-line-args-left)))
(kill-emacs (if 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))))
For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
Optional argument ARG is passed as second argument ARG to
-`batch-recompile-directory'; see there for its possible values
+`byte-recompile-directory'; see there for its possible values
and corresponding effects."
;; command-line-args-left is what is left of the command line (startup.el)
(defvar command-line-args-left) ;Avoid 'free variable' warning
HCoop / bpt / emacs.git / blobdiff