-;;; bytecomp.el --- compilation of Lisp code into byte code.
+;;; bytecomp.el --- compilation of Lisp code into byte code
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001
+;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Keywords: internal
+;; Maintainer: FSF
+;; Keywords: lisp
-;; Subsequently modified by RMS.
-
-;;; This version incorporates changes up to version 2.10 of the
+;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "FSF 2.10")
+(defconst byte-compile-version "$Revision: 2.93 $")
;; This file is part of GNU Emacs.
;;; Commentary:
;; The Emacs Lisp byte compiler. This crunches lisp source into a sort
-;; of p-code which takes up less space and can be interpreted faster.
+;; of p-code (`lapcode') which takes up less space and can be interpreted
+;; faster. [`LAP' == `Lisp Assembly Program'.]
;; The user entry points are byte-compile-file and byte-recompile-directory.
;;; Code:
;; - functions being redefined as macros, or vice-versa;
;; - functions or macros defined multiple times in the same file;
;; - functions being called with the incorrect number of arguments;
-;; - functions being called which are not defined globally, in the
+;; - functions being called which are not defined globally, in the
;; file, or as autoloads;
;; - assignment and reference of undeclared free variables;
;; - various syntax errors;
;;
;; byte-compile-verbose Whether to report the function currently being
;; compiled in the minibuffer;
-;; byte-optimize Whether to do optimizations; this may be
+;; byte-optimize Whether to do optimizations; this may be
;; t, nil, 'source, or 'byte;
-;; byte-optimize-log Whether to report (in excruciating detail)
+;; byte-optimize-log Whether to report (in excruciating detail)
;; exactly which optimizations have been made.
;; This may be t, nil, 'source, or 'byte;
;; byte-compile-error-on-warn Whether to stop compilation when a warning is
;; variable references that are side-effect-free
;; except that they may return an error.
;; byte-compile-generate-call-tree Whether to generate a histogram of
-;; function calls. This can be useful for
+;; function calls. This can be useful for
;; finding unused functions, as well as simple
;; performance metering.
;; byte-compile-warnings List of warnings to issue, or t. May contain
;; a macro to a lambda or vice versa,
;; or redefined to take other args)
;; 'obsolete (obsolete variables and functions)
+;; 'noruntime (calls to functions only defined
+;; within `eval-when-compile')
;; byte-compile-compatibility Whether the compiler should
;; generate .elc files which can be loaded into
;; generic emacs 18.
;;
;; (inline (foo 1 2 3)) ;; `foo' will be open-coded
;; or...
-;; (inline ;; `foo' and `baz' will be
+;; (inline ;; `foo' and `baz' will be
;; (foo 1 2 3 (bar 5)) ;; open-coded, but `bar' will not.
;; (baz 0))
;;
;;
;; o The command compile-defun is analogous to eval-defun.
;;
-;; o If you run byte-compile-file on a filename which is visited in a
+;; o If you run byte-compile-file on a filename which is visited in a
;; buffer, and that buffer is modified, you are asked whether you want
;; to save the buffer before compiling.
;;
;; This really ought to be loaded already!
(load-library "byte-run"))
-;;; The feature of compiling in a specific target Emacs version
-;;; has been turned off because compile time options are a bad idea.
+;; The feature of compiling in a specific target Emacs version
+;; has been turned off because compile time options are a bad idea.
(defmacro byte-compile-single-version () nil)
(defmacro byte-compile-version-cond (cond) cond)
-;;; The crud you see scattered through this file of the form
-;;; (or (and (boundp 'epoch::version) epoch::version)
-;;; (string-lessp emacs-version "19"))
-;;; is because the Epoch folks couldn't be bothered to follow the
-;;; normal emacs version numbering convention.
+;; The crud you see scattered through this file of the form
+;; (or (and (boundp 'epoch::version) epoch::version)
+;; (string-lessp emacs-version "19"))
+;; is because the Epoch folks couldn't be bothered to follow the
+;; normal emacs version numbering convention.
;; (if (byte-compile-version-cond
;; (or (and (boundp 'epoch::version) epoch::version)
;; (progn
;; ;; emacs-18 compatibility.
;; (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined
-;;
+;;
;; (if (byte-compile-single-version)
;; (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
;; (defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
-;;
+;;
;; (or (and (fboundp 'member)
;; ;; avoid using someone else's possibly bogus definition of this.
;; (subrp (symbol-function 'member)))
;; list))))
-(defvar emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
- "\\.EL\\(;[0-9]+\\)?$"
- "\\.el$")
+(defgroup bytecomp nil
+ "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 `byte-compile-dest-file' if you change this.")
+You may want to redefine the function `byte-compile-dest-file'
+if you change this variable."
+ :group 'bytecomp
+ :type 'regexp)
;; This enables file name handlers such as jka-compr
;; to remove parts of the file name that should not be copied
(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")))))
+ (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")))))
;; This can be the 'byte-compile property of any symbol.
(autoload 'byte-compile-inline-expand "byte-opt")
;; thing to do.
(autoload 'byte-decompile-bytecode "byte-opt")
-(defvar byte-compile-verbose
+(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)
-(defvar byte-compile-compatibility nil
- "*Non-nil means generate output that can run in Emacs 18.")
+(defcustom byte-compile-compatibility nil
+ "*Non-nil means generate output that can run in Emacs 18."
+ :group 'bytecomp
+ :type 'boolean)
;; (defvar byte-compile-generate-emacs19-bytecodes
;; (not (or (and (boundp 'epoch::version) epoch::version)
;; (string-lessp emacs-version "19")))
-;; "*If this is true, then the byte-compiler will generate bytecode which
+;; "*If this is true, then the byte-compiler will generate bytecode which
;; makes use of byte-ops which are present only in Emacs 19. Code generated
;; this way can never be run in Emacs 18, and may even cause it to crash.")
-(defvar byte-optimize t
+(defcustom byte-optimize t
"*Enables optimization in the byte compiler.
nil means don't do any optimization.
t means do all optimizations.
`source' means do source-level optimizations only.
-`byte' means do code-level optimizations only.")
-
-(defvar byte-compile-delete-errors t
+`byte' means do code-level optimizations only."
+ :group 'bytecomp
+ :type '(choice (const :tag "none" nil)
+ (const :tag "all" t)
+ (const :tag "source-level" source)
+ (const :tag "byte-level" byte)))
+
+(defcustom byte-compile-delete-errors t
"*If non-nil, the optimizer may delete forms that may signal an error.
-This includes variable references and calls to functions such as `car'.")
+This includes variable references and calls to functions such as `car'."
+ :group 'bytecomp
+ :type 'boolean)
(defvar byte-compile-dynamic nil
- "*If non-nil, compile function bodies so they load lazily.
-They are hidden comments in the compiled file, and brought into core when the
+ "If non-nil, compile function bodies so they load lazily.
+They are hidden in comments in the compiled file,
+and each one is brought into core when the
function is called.
To enable this option, make it a file-local variable
When this option is true, if you load the compiled file and then move it,
the functions you loaded will not be able to run.")
-(defvar byte-compile-dynamic-docstrings t
+(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
-*-byte-compile-dynamic-docstrings:nil;-*-
You can also set the variable globally.
-This option is enabled by default because it reduces Emacs memory usage.")
+This option is enabled by default because it reduces Emacs memory usage."
+ :group 'bytecomp
+ :type 'boolean)
-(defvar byte-optimize-log nil
+(defcustom byte-optimize-log nil
"*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.")
-
-(defvar byte-compile-error-on-warn nil
- "*If true, the byte-compiler reports warnings with `error'.")
+If it is 'byte, then only byte-level optimizations will be logged."
+ :group 'bytecomp
+ :type '(choice (const :tag "none" nil)
+ (const :tag "all" t)
+ (const :tag "source-level" source)
+ (const :tag "byte-level" byte)))
+
+(defcustom byte-compile-error-on-warn nil
+ "*If true, the byte-compiler reports warnings with `error'."
+ :group 'bytecomp
+ :type 'boolean)
(defconst byte-compile-warning-types
- '(redefine callargs free-vars unresolved obsolete))
-(defvar byte-compile-warnings t
+ '(redefine callargs free-vars unresolved obsolete noruntime))
+(defcustom byte-compile-warnings t
"*List of warnings that the byte-compiler should issue (t for all).
Elements of the list may be be:
callargs lambda calls with args that don't match the definition.
redefine function cell redefined from a macro to a lambda or vice
versa, or redefined to take a different number of arguments.
- obsolete obsolete variables and functions.
-
-See also the macro `byte-compiler-options'.")
-
-(defvar byte-compile-generate-call-tree nil
+ obsolete obsolete variables and functions."
+ :group 'bytecomp
+ :type '(choice (const :tag "All" t)
+ (set :menu-tag "Some"
+ (const free-vars) (const unresolved)
+ (const callargs) (const redefined)
+ (const obsolete) (const noruntime))))
+
+(defcustom byte-compile-generate-call-tree nil
"*Non-nil means collect call-graph information when compiling.
This records functions were called and from where.
If the value is t, compilation displays the call graph when it finishes.
The call tree also lists those functions which are not known to be called
\(that is, to which no calls have been compiled). Functions which can be
-invoked interactively are excluded from this list.")
+invoked interactively are excluded from this list."
+ :group 'bytecomp
+ :type '(choice (const :tag "Yes" t) (const :tag "No" nil)
+ (other :tag "Ask" lambda)))
-(defconst 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\)
is a list of functions for which calls were generated while compiling
FUNCTION.")
-(defvar byte-compile-call-tree-sort 'name
+(defcustom byte-compile-call-tree-sort 'name
"*If non-nil, sort the call tree.
The values `name', `callers', `calls', `calls+callers'
-specify different fields to sort on.")
+specify different fields to sort on."
+ :group 'bytecomp
+ :type '(choice (const name) (const callers) (const calls)
+ (const calls+callers) (const nil)))
;; (defvar byte-compile-overwrite-file t
;; "If nil, old .elc files are deleted before the new is saved, and .elc
;; files will have the same modes as the corresponding .el file. Otherwise,
;; existing .elc files will simply be overwritten, and the existing modes
-;; will not be changed. If this variable is nil, then an .elc file which
+;; will not be changed. If this variable is nil, then an .elc file which
;; is a symbolic link will be turned into a normal file, instead of the file
;; which the link points to being overwritten.")
(defvar byte-compile-constants nil
- "list of all constants encountered during compilation of this form")
+ "List of all constants encountered during compilation of this form.")
(defvar byte-compile-variables nil
- "list of all variables encountered during compilation of this form")
+ "List of all variables encountered during compilation of this form.")
(defvar byte-compile-bound-variables nil
- "list of variables bound in the context of the current form; this list
-lives partly on the stack.")
+ "List of variables bound in the context of the current form.
+This list lives partly on the stack.")
(defvar byte-compile-free-references)
(defvar byte-compile-free-assignments)
;; (byte-compiler-options . (lambda (&rest forms)
;; (apply 'byte-compiler-options-handler forms)))
(eval-when-compile . (lambda (&rest body)
- (list 'quote (eval (byte-compile-top-level
- (cons 'progn body))))))
+ (list 'quote
+ (byte-compile-eval (byte-compile-top-level
+ (cons 'progn body))))))
(eval-and-compile . (lambda (&rest body)
(eval (cons 'progn body))
(cons 'progn body))))
\(FUNCTIONNAME . nil) when a function is redefined as a macro.")
(defvar byte-compile-unresolved-functions nil
- "Alist of undefined functions to which calls have been compiled (used for
-warnings when the function is later defined with incorrect args).")
+ "Alist of undefined functions to which calls have been compiled.
+Used for warnings when the function is not known to be defined or is later
+defined with incorrect args.")
(defvar byte-compile-tag-number 0)
(defvar byte-compile-output nil
\f
;;; The byte codes; this information is duplicated in bytecomp.c
-(defconst byte-code-vector nil
+(defvar byte-code-vector nil
"An array containing byte-code names indexed by byte-code values.")
-(defconst byte-stack+-info nil
+(defvar byte-stack+-info nil
"An array with the stack adjustment for each byte-code.")
(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
(get 'byte-code-vector 'tmp-compile-time-value)
'byte-stack+-info
(get 'byte-stack+-info 'tmp-compile-time-value))
- ;; emacs-18 has no REMPROP.
(put 'byte-code-vector 'tmp-compile-time-value nil)
(put 'byte-stack+-info 'tmp-compile-time-value nil)))
(byte-defop 94 -1 byte-min)
(byte-defop 95 -1 byte-mult) ; v19 only
(byte-defop 96 1 byte-point)
-(byte-defop 97 1 byte-mark-OBSOLETE) ; no longer generated as of v18
(byte-defop 98 0 byte-goto-char)
(byte-defop 99 0 byte-insert)
(byte-defop 100 1 byte-point-max)
(byte-defop 111 1 byte-bobp)
(byte-defop 112 1 byte-current-buffer)
(byte-defop 113 0 byte-set-buffer)
-(byte-defop 114 1 byte-read-char-OBSOLETE)
+(byte-defop 114 0 byte-save-current-buffer
+ "To make a binding to record the current buffer")
(byte-defop 115 0 byte-set-mark-OBSOLETE)
(byte-defop 116 1 byte-interactive-p)
(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
(byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
(byte-defop 133 -1 byte-goto-if-nil-else-pop
- "to examine top-of-stack, jump and don't pop it if it's nil,
+ "to examine top-of-stack, jump and don't pop it if it's nil,
otherwise pop it")
(byte-defop 134 -1 byte-goto-if-not-nil-else-pop
- "to examine top-of-stack, jump and don't pop it if it's non nil,
+ "to examine top-of-stack, jump and don't pop it if it's non nil,
otherwise pop it")
(byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
(byte-defop 142 -1 byte-unwind-protect
"for unwind-protect. Takes, on stack, an expression for the unwind-action")
-;; For condition-case. Takes, on stack, the variable to bind,
+;; For condition-case. Takes, on stack, the variable to bind,
;; an expression for the body, and a list of clauses.
(byte-defop 143 -2 byte-condition-case)
(byte-extrude-byte-code-vectors)
\f
;;; lapcode generator
-;;;
-;;; the byte-compiler now does source -> lapcode -> bytecode instead of
-;;; source -> bytecode, because it's a lot easier to make optimizations
-;;; on lapcode than on bytecode.
-;;;
-;;
; Elements of the lapcode list are of the form (<instruction> . <parameter>)
-;;; where instruction is a symbol naming a byte-code instruction,
-;;; and parameter is an argument to that instruction, if any.
-;;;
-;;; The instruction can be the pseudo-op TAG, which means that this position
-;;; in the instruction stream is a target of a goto. (car PARAMETER) will be
-;;; the PC for this location, and the whole instruction "(TAG pc)" will be the
-;;; parameter for some goto op.
-;;;
-;;; If the operation is varbind, varref, varset or push-constant, then the
-;;; parameter is (variable/constant . index_in_constant_vector).
-;;;
-;;; First, the source code is macroexpanded and optimized in various ways.
-;;; Then the resultant code is compiled into lapcode. Another set of
-;;; optimizations are then run over the lapcode. Then the variables and
-;;; constants referenced by the lapcode are collected and placed in the
-;;; constants-vector. (This happens now so that variables referenced by dead
-;;; code don't consume space.) And finally, the lapcode is transformed into
-;;; compacted byte-code.
-;;;
-;;; A distinction is made between variables and constants because the variable-
-;;; referencing instructions are more sensitive to the variables being near the
-;;; front of the constants-vector than the constant-referencing instructions.
-;;; Also, this lets us notice references to free variables.
+;;
+;; the byte-compiler now does source -> lapcode -> bytecode instead of
+;; source -> bytecode, because it's a lot easier to make optimizations
+;; on lapcode than on bytecode.
+;;
+;; Elements of the lapcode list are of the form (<instruction> . <parameter>)
+;; where instruction is a symbol naming a byte-code instruction,
+;; and parameter is an argument to that instruction, if any.
+;;
+;; The instruction can be the pseudo-op TAG, which means that this position
+;; in the instruction stream is a target of a goto. (car PARAMETER) will be
+;; the PC for this location, and the whole instruction "(TAG pc)" will be the
+;; parameter for some goto op.
+;;
+;; If the operation is varbind, varref, varset or push-constant, then the
+;; parameter is (variable/constant . index_in_constant_vector).
+;;
+;; First, the source code is macroexpanded and optimized in various ways.
+;; Then the resultant code is compiled into lapcode. Another set of
+;; optimizations are then run over the lapcode. Then the variables and
+;; constants referenced by the lapcode are collected and placed in the
+;; constants-vector. (This happens now so that variables referenced by dead
+;; code don't consume space.) And finally, the lapcode is transformed into
+;; compacted byte-code.
+;;
+;; A distinction is made between variables and constants because the variable-
+;; referencing instructions are more sensitive to the variables being near the
+;; front of the constants-vector than the constant-referencing instructions.
+;; Also, this lets us notice references to free variables.
(defun byte-compile-lapcode (lap)
"Turns lapcode into bytecode. The lapcode is destroyed."
(concat (nreverse bytes))))
\f
+;;; compile-time evaluation
+
+(defun byte-compile-eval (form)
+ "Eval FORM and mark the functions defined therein.
+Each function's symbol gets marked with the `byte-compile-noruntime' property."
+ (let ((hist-orig load-history)
+ (hist-nil-orig current-load-list))
+ (prog1 (eval form)
+ (when (memq 'noruntime 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)))
+ ;; Make sure the file was not already loaded before.
+ (unless (assoc (car xs) hist-orig)
+ (dolist (s xs)
+ (cond
+ ((symbolp s) (put s 'byte-compile-noruntime t))
+ ((and (consp s) (eq 'autoload (car s)))
+ (put (cdr s) 'byte-compile-noruntime t)))))))
+ ;; Go through current-load-list for the locally defined funs.
+ (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
+ (let ((s (pop hist-nil-new)))
+ (when (symbolp s)
+ (put s 'byte-compile-noruntime t)))))))))
+
+\f
;;; byte compiler messages
(defvar byte-compile-current-form nil)
-(defvar byte-compile-current-file nil)
(defvar byte-compile-dest-file nil)
+(defvar byte-compile-current-file nil)
(defmacro byte-compile-log (format-string &rest args)
(list 'and
(cons 'format
(cons format-string
(mapcar
- '(lambda (x)
- (if (symbolp x) (list 'prin1-to-string x) x))
+ (lambda (x)
+ (if (symbolp x) (list 'prin1-to-string x) x))
args)))))))
-(defconst byte-compile-last-warned-form nil)
+(defvar byte-compile-last-warned-form nil)
+(defvar byte-compile-last-logged-file nil)
+
+(defvar byte-compile-last-line nil
+ "Last known line number in the input.")
+
+
+(defun byte-compile-display-log-head-p ()
+ (and (not (eq byte-compile-current-form :end))
+ (or (and byte-compile-current-file
+ (not (equal byte-compile-current-file
+ byte-compile-last-logged-file)))
+ (and byte-compile-last-warned-form
+ (not (eq byte-compile-current-form
+ byte-compile-last-warned-form))))))
+
+(defun byte-goto-log-buffer ()
+ (set-buffer (get-buffer-create "*Compile-Log*"))
+ (unless (eq major-mode 'compilation-mode)
+ (compilation-mode)))
;; Log a message STRING in *Compile-Log*.
;; Also log the current function and file if not already done.
(defun byte-compile-log-1 (string &optional fill)
- (cond (noninteractive
- (if (or byte-compile-current-file
- (and byte-compile-last-warned-form
- (not (eq byte-compile-current-form
- byte-compile-last-warned-form))))
- (message (format "While compiling %s%s:"
- (or byte-compile-current-form "toplevel forms")
- (if byte-compile-current-file
- (if (stringp byte-compile-current-file)
- (concat " in file " byte-compile-current-file)
- (concat " in buffer "
- (buffer-name byte-compile-current-file)))
- ""))))
- (message " %s" string))
- (t
- (save-excursion
- (set-buffer (get-buffer-create "*Compile-Log*"))
- (goto-char (point-max))
- (cond ((or byte-compile-current-file
- (and byte-compile-last-warned-form
- (not (eq byte-compile-current-form
- byte-compile-last-warned-form))))
- (if byte-compile-current-file
- (insert "\n\^L\n" (current-time-string) "\n"))
- (insert "While compiling "
- (if byte-compile-current-form
- (format "%s" byte-compile-current-form)
- "toplevel forms"))
- (if byte-compile-current-file
- (if (stringp byte-compile-current-file)
- (insert " in file " byte-compile-current-file)
- (insert " in buffer "
- (buffer-name byte-compile-current-file))))
- (insert ":\n")))
- (insert " " string "\n")
- (if (and fill (not (string-match "\n" string)))
- (let ((fill-prefix " ")
- (fill-column 78))
- (fill-paragraph nil)))
- )))
- (setq byte-compile-current-file nil
+ (let* ((file (cond ((stringp byte-compile-current-file)
+ (format "%s:" byte-compile-current-file))
+ ((bufferp byte-compile-current-file)
+ (format "Buffer %s:"
+ (buffer-name byte-compile-current-file)))
+ (t "")))
+ (pos (if (and byte-compile-current-file
+ (integerp byte-compile-last-line))
+ (format "%d:" byte-compile-last-line)
+ ""))
+ (form (or byte-compile-current-form "toplevel form")))
+ (cond (noninteractive
+ (when (byte-compile-display-log-head-p)
+ (message "%s In %s" file form))
+ (message "%s%s %s" file pos string))
+ (t
+ (save-excursion
+ (byte-goto-log-buffer)
+ (goto-char (point-max))
+ (when (byte-compile-display-log-head-p)
+ (insert (format "\nIn %s" form)))
+ (insert (format "\n%s%s\n%s\n" file pos string))
+ (when (and fill (not (string-match "\n" string)))
+ (let ((fill-prefix " ") (fill-column 78))
+ (fill-paragraph nil)))))))
+ (setq byte-compile-last-logged-file byte-compile-current-file
byte-compile-last-warned-form byte-compile-current-form))
;; Log the start of a file in *Compile-Log*, and mark it as done.
;; But do nothing in batch mode.
(defun byte-compile-log-file ()
- (and byte-compile-current-file (not noninteractive)
+ (and byte-compile-current-file
+ (not (equal byte-compile-current-file byte-compile-last-logged-file))
+ (not noninteractive)
(save-excursion
- (set-buffer (get-buffer-create "*Compile-Log*"))
+ (byte-goto-log-buffer)
(goto-char (point-max))
(insert "\n\^L\nCompiling "
(if (stringp byte-compile-current-file)
(concat "file " byte-compile-current-file)
(concat "buffer " (buffer-name byte-compile-current-file)))
" at " (current-time-string) "\n")
- (setq byte-compile-current-file nil))))
+ (setq byte-compile-last-logged-file byte-compile-current-file))))
(defun byte-compile-warn (format &rest args)
(setq format (apply 'format format args))
(if byte-compile-error-on-warn
(error "%s" format) ; byte-compile-file catches and logs it
- (byte-compile-log-1 (concat "** " format) t)
-;;; It is useless to flash warnings too fast to be read.
-;;; Besides, they will all be shown at the end.
-;;; (or noninteractive ; already written on stdout.
-;;; (message "Warning: %s" format))
+ (byte-compile-log-1 (concat "warning: " format) t)
+ ;; It is useless to flash warnings too fast to be read.
+ ;; Besides, they will all be shown at the end.
+ ;; (or noninteractive ; already written on stdout.
+ ;; (message "Warning: %s" format))
))
;;; This function should be used to report errors that have halted
(defun byte-compile-report-error (error-info)
(setq byte-compiler-error-flag t)
(byte-compile-log-1
- (concat "!! "
+ (concat "error: "
(format (if (cdr error-info) "%s (%s)" "%s")
- (get (car error-info) 'error-message)
+ (downcase (get (car error-info) 'error-message))
(prin1-to-string (cdr error-info))))))
;;; Used by make-obsolete.
(defun byte-compile-obsolete (form)
- (let ((new (get (car form) 'byte-obsolete-info)))
+ (let* ((new (get (car form) 'byte-obsolete-info))
+ (handler (nth 1 new))
+ (when (nth 2 new)))
(if (memq 'obsolete byte-compile-warnings)
- (byte-compile-warn "%s is an obsolete function; %s" (car form)
+ (byte-compile-warn "%s is an obsolete function%s; %s" (car form)
+ (if when (concat " since " when) "")
(if (stringp (car new))
(car new)
- (format "use %s instead." (car new)))))
- (funcall (or (cdr new) 'byte-compile-normal-call) form)))
+ (format "use %s instead." (car new)))))
+ (funcall (or handler 'byte-compile-normal-call) form)))
\f
;; Compiler options
;; val)))
;; Inhibit v18/v19 selectors if the version is hardcoded.
-;; #### This should print a warning if the user tries to change something
+;; #### This should print a warning if the user tries to change something
;; than can't be changed because the running compiler doesn't support it.
;; (cond
;; ((byte-compile-single-version)
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
(byte-compile-fdefinition (car form) t)))
- (sig (and def (byte-compile-arglist-signature
- (if (eq 'lambda (car-safe def))
- (nth 1 def)
- (if (byte-code-function-p def)
- (aref def 0)
- '(&rest def))))))
+ (sig (if def
+ (byte-compile-arglist-signature
+ (if (eq 'lambda (car-safe def))
+ (nth 1 def)
+ (if (byte-code-function-p def)
+ (aref def 0)
+ '(&rest def))))
+ (if (and (fboundp (car form))
+ (subrp (symbol-function (car form))))
+ (subr-arity (symbol-function (car form))))))
(ncall (length (cdr form))))
+ ;; Check many or unevalled from subr-arity.
+ (if (and (cdr-safe sig)
+ (not (numberp (cdr sig))))
+ (setcdr sig nil))
(if sig
(if (or (< ncall (car sig))
(and (cdr sig) (> ncall (cdr sig))))
"requires"
"accepts only")
(byte-compile-arglist-signature-string sig)))
- (or (fboundp (car form)) ; might be a subr or autoload.
- (eq (car form) byte-compile-current-form) ; ## this doesn't work with recursion.
- ;; It's a currently-undefined function. Remember number of args in call.
+ (or (and (fboundp (car form)) ; might be a subr or autoload.
+ (not (get (car form) 'byte-compile-noruntime)))
+ (eq (car form) byte-compile-current-form) ; ## this doesn't work
+ ; with recursion.
+ ;; It's a currently-undefined function.
+ ;; Remember number of args in call.
(let ((cons (assq (car form) byte-compile-unresolved-functions))
(n (length (cdr form))))
(if cons
(byte-compile-arglist-signature-string sig)
(if (equal sig '(1 . 1)) " arg" " args")
(byte-compile-arglist-signature-string (cons min max))))
-
+
(setq byte-compile-unresolved-functions
(delq calls byte-compile-unresolved-functions)))))
)))
-;; If we have compiled any calls to functions which are not known to be
+(defun byte-compile-print-syms (str1 strn syms)
+ (cond ((and (cdr syms) (not noninteractive))
+ (let* ((str strn)
+ (L (length str))
+ s)
+ (while syms
+ (setq s (symbol-name (pop syms))
+ L (+ L (length s) 2))
+ (if (< L (1- fill-column))
+ (setq str (concat str " " s (and syms ",")))
+ (setq str (concat str "\n " s (and syms ","))
+ L (+ (length s) 4))))
+ (byte-compile-warn "%s" str)))
+ ((cdr syms)
+ (byte-compile-warn "%s %s"
+ strn
+ (mapconcat #'symbol-name syms ", ")))
+
+ (syms
+ (byte-compile-warn str1 (car syms)))))
+
+;; If we have compiled any calls to functions which are not known to be
;; defined, issue a warning enumerating them.
;; `unresolved' in the list `byte-compile-warnings' disables this.
(defun byte-compile-warn-about-unresolved-functions ()
- (if (memq 'unresolved byte-compile-warnings)
- (let ((byte-compile-current-form "the end of the data"))
- (if (cdr byte-compile-unresolved-functions)
- (let* ((str "The following functions are not known to be defined: ")
- (L (length str))
- (rest (reverse byte-compile-unresolved-functions))
- s)
- (while rest
- (setq s (symbol-name (car (car rest)))
- L (+ L (length s) 2)
- rest (cdr rest))
- (if (< L (1- fill-column))
- (setq str (concat str " " s (and rest ",")))
- (setq str (concat str "\n " s (and rest ","))
- L (+ (length s) 4))))
- (byte-compile-warn "%s" str))
- (if byte-compile-unresolved-functions
- (byte-compile-warn "the function %s is not known to be defined."
- (car (car byte-compile-unresolved-functions)))))))
+ (when (memq 'unresolved byte-compile-warnings)
+ (let ((byte-compile-current-form :end)
+ (noruntime nil)
+ (unresolved nil))
+ ;; Separate the functions that will not be available at runtime
+ ;; from the truly unresolved ones.
+ (dolist (f byte-compile-unresolved-functions)
+ (setq f (car f))
+ (if (fboundp f) (push f noruntime) (push f unresolved)))
+ ;; Complain about the no-run-time functions
+ (byte-compile-print-syms
+ "the function `%s' might not be defined at runtime."
+ "the following functions might not be defined at runtime:"
+ noruntime)
+ ;; Complain about the unresolved functions
+ (byte-compile-print-syms
+ "the function `%s' is not known to be defined."
+ "the following functions are not known to be defined:"
+ unresolved)))
nil)
\f
+(defsubst byte-compile-const-symbol-p (symbol)
+ (or (memq symbol '(nil t))
+ (keywordp symbol)))
+
(defmacro byte-compile-constp (form)
- ;; Returns non-nil if FORM is a constant.
- (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
- ((not (symbolp (, form))))
- ((memq (, form) '(nil t))))))
+ "Return non-nil if FORM is a constant."
+ `(cond ((consp ,form) (eq (car ,form) 'quote))
+ ((not (symbolp ,form)))
+ ((byte-compile-const-symbol-p ,form))))
(defmacro byte-compile-close-variables (&rest body)
(cons 'let
(defvar byte-compile-warnings-point-max nil)
(defmacro displaying-byte-compile-warnings (&rest body)
- (list 'let
- '((byte-compile-warnings-point-max byte-compile-warnings-point-max))
+ `(let ((byte-compile-warnings-point-max byte-compile-warnings-point-max))
;; Log the file name.
- '(byte-compile-log-file)
+ (byte-compile-log-file)
;; Record how much is logged now.
;; We will display the log buffer if anything more is logged
;; before the end of BODY.
- '(or byte-compile-warnings-point-max
- (save-excursion
- (set-buffer (get-buffer-create "*Compile-Log*"))
- (setq byte-compile-warnings-point-max (point-max))))
- (list 'unwind-protect
- (list 'condition-case 'error-info
- (cons 'progn body)
- '(error
- (byte-compile-report-error error-info)))
- '(save-excursion
- ;; If there were compilation warnings, display them.
- (set-buffer "*Compile-Log*")
- (if (= byte-compile-warnings-point-max (point-max))
- nil
- (select-window
- (prog1 (selected-window)
- (select-window (display-buffer (current-buffer)))
- (goto-char byte-compile-warnings-point-max)
- (recenter 1))))))))
+ (unless byte-compile-warnings-point-max
+ (save-excursion
+ (byte-goto-log-buffer)
+ (setq byte-compile-warnings-point-max (point-max))))
+ (unwind-protect
+ (condition-case error-info
+ (progn ,@body)
+ (error (byte-compile-report-error error-info)))
+ (with-current-buffer "*Compile-Log*"
+ ;; If there were compilation warnings, display them.
+ (unless (= byte-compile-warnings-point-max (point-max))
+ (select-window
+ (prog1 (selected-window)
+ (select-window (display-buffer (current-buffer)))
+ (goto-char byte-compile-warnings-point-max)
+ (beginning-of-line)
+ (forward-line -1)
+ (recenter 0))))))))
\f
;;;###autoload
(save-some-buffers)
(force-mode-line-update))
(let ((directories (list (expand-file-name directory)))
+ (skip-count 0)
+ (fail-count 0)
(file-count 0)
(dir-count 0)
last-dir)
(displaying-byte-compile-warnings
(while directories
(setq directory (car directories))
- (or noninteractive (message "Checking %s..." directory))
+ (message "Checking %s..." directory)
(let ((files (directory-files directory))
source dest)
- (while files
- (setq source (expand-file-name (car files) directory))
- (if (and (not (member (car files) '("." ".." "RCS" "CVS")))
+ (dolist (file files)
+ (setq source (expand-file-name file directory))
+ (if (and (not (member file '("." ".." "RCS" "CVS")))
(file-directory-p source)
(not (file-symlink-p source)))
;; This file is a subdirectory. Handle them differently.
- (if (or (null arg)
- (eq 0 arg)
- (y-or-n-p (concat "Check " source "? ")))
- (setq directories
- (nconc directories (list source))))
+ (when (or (null arg)
+ (eq 0 arg)
+ (y-or-n-p (concat "Check " source "? ")))
+ (setq directories
+ (nconc directories (list 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)
(y-or-n-p (concat "Compile " source "? "))))))
(progn (if (and noninteractive (not byte-compile-verbose))
(message "Compiling %s..." source))
- (byte-compile-file source)
+ (let ((res (byte-compile-file source)))
+ (cond ((eq res 'no-byte-compile)
+ (setq skip-count (1+ skip-count)))
+ ((eq res t)
+ (setq file-count (1+ file-count)))
+ ((eq res nil)
+ (setq fail-count (1+ fail-count)))))
(or noninteractive
(message "Checking %s..." directory))
- (setq file-count (1+ file-count))
(if (not (eq last-dir directory))
(setq last-dir directory
dir-count (1+ dir-count)))
- )))
- (setq files (cdr files))))
+ )))))
(setq directories (cdr directories))))
- (message "Done (Total of %d file%s compiled%s)"
+ (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) ""))))
+(defvar no-byte-compile nil
+ "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
(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 made by appending `c' to the end of FILENAME.
-With prefix arg (noninteractively: 2nd arg), load the file after compiling."
+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)
(or noninteractive
(let ((b (get-file-buffer (expand-file-name filename))))
(if (and b (buffer-modified-p b)
- (y-or-n-p (format "save buffer %s first? " (buffer-name b))))
+ (y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
(save-excursion (set-buffer b) (save-buffer)))))
- (if byte-compile-verbose
- (message "Compiling %s..." filename))
(let ((byte-compile-current-file filename)
+ (byte-compile-last-logged-file 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 input-buffer (get-buffer-create " *Compiler Input*"))
(set-buffer input-buffer)
(erase-buffer)
+ (setq buffer-file-coding-system nil)
+ ;; 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)
+ ;; Mimic the way after-insert-file-set-buffer-file-coding-system
+ ;; can make the buffer unibyte when visiting this file.
+ (when (or (eq last-coding-system-used 'no-conversion)
+ (eq (coding-system-type last-coding-system-used) 5))
+ ;; For coding systems no-conversion and raw-text...,
+ ;; edit the buffer as unibyte.
+ (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)
(enable-local-eval nil))
(normal-mode)
- (setq filename buffer-file-name)))
- (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 (byte-compile-from-buffer input-buffer filename))
- (if byte-compiler-error-flag
- nil
+ (setq filename buffer-file-name))
+ ;; Set the default directory, in case an eval-when-compile uses it.
+ (setq default-directory (file-name-directory 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)
+ (with-current-buffer input-buffer no-byte-compile))
+ (if (file-exists-p target-file)
+ (condition-case nil (delete-file target-file) (error nil)))
+ ;; We successfully didn't compile this file.
+ 'no-byte-compile)
(if byte-compile-verbose
- (message "Compiling %s...done" filename))
- (kill-buffer input-buffer)
- (save-excursion
- (set-buffer output-buffer)
- (goto-char (point-max))
- (insert "\n") ; aaah, unix.
- (let ((vms-stmlf-recfm t))
- (if (file-writable-p target-file)
- (let ((kanji-flag nil)) ; for nemacs, from Nakagawa Takayuki
- (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
- (setq buffer-file-type t))
- (write-region 1 (point-max) target-file))
- ;; This is just to give a better error message than
- ;; write-region
- (signal 'file-error
- (list "Opening output file"
- (if (file-exists-p target-file)
- "cannot overwrite file"
- "directory not writable or nonexistent")
- 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))))
- (save-excursion
- (display-call-tree filename)))
- (if load
- (load target-file))
- t)))
+ (message "Compiling %s..." 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 (byte-compile-from-buffer input-buffer filename))
+ (if byte-compiler-error-flag
+ nil
+ (if byte-compile-verbose
+ (message "Compiling %s...done" 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 (memq system-type '(ms-dos 'windows-nt))
+ (setq buffer-file-type t))
+ (when (file-exists-p target-file)
+ ;; Remove the target before writing it, so that any
+ ;; hard-links continue to point to the old file (this makes
+ ;; it possible for installed files to share disk space with
+ ;; the build tree, without causing problems when emacs-lisp
+ ;; files in the build tree are recompiled).
+ (delete-file target-file))
+ (write-region 1 (point-max) target-file))
+ ;; This is just to give a better error message than write-region
+ (signal 'file-error
+ (list "Opening output file"
+ (if (file-exists-p target-file)
+ "cannot overwrite file"
+ "directory not writable or nonexistent")
+ 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))))
+ (save-excursion
+ (display-call-tree filename)))
+ (if load
+ (load target-file))
+ t))))
;;(defun byte-compile-and-load-file (&optional filename)
;; "Compile a file of Lisp code named FILENAME into a file of byte code,
-;;and then load it. The output file's name is made by appending \"c\" to
+;;and then load it. The output file's name is made by appending \"c\" to
;;the end of FILENAME."
;; (interactive)
;; (if filename ; I don't get it, (interactive-p) doesn't always work
(case-fold-search nil)
(print-length nil)
(print-level nil)
+ ;; Prevent edebug from interfering when we compile
+ ;; and put the output into a file.
+ (edebug-all-defs nil)
+ (edebug-all-forms nil)
;; Simulate entry to byte-compile-top-level
(byte-compile-constants nil)
(byte-compile-variables nil)
(save-excursion
(setq outbuffer
(set-buffer (get-buffer-create " *Compiler Output*")))
+ (set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
(setq case-fold-search nil)
- (and filename (byte-compile-insert-header filename inbuffer outbuffer))
-
;; This is a kludge. Some operating systems (OS/2, DOS) need to
;; write files containing binary information specially.
;; Under most circumstances, such files will be in binary
;; need to be written carefully.
(setq overwrite-mode 'overwrite-mode-binary))
(displaying-byte-compile-warnings
+ (and filename (byte-compile-insert-header filename inbuffer outbuffer))
(save-excursion
(set-buffer inbuffer)
(goto-char 1)
(looking-at ";"))
(forward-line 1))
(not (eobp)))
- (byte-compile-file-form (read inbuffer)))
+ (let ((byte-compile-last-line (count-lines (point-min) (point))))
+ (byte-compile-file-form (read inbuffer))))
;; Compile pending forms at end of file.
(byte-compile-flush-pending)
;; Should we always do this? When calling multiple files, it
;; would be useful to delay this warning until all have
;; been compiled.
- (setq byte-compile-unresolved-functions nil))))
+ (setq byte-compile-unresolved-functions nil))
+ ;; 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))
+(defun byte-compile-fix-header (filename inbuffer outbuffer)
+ (save-excursion
+ (set-buffer outbuffer)
+ ;; See if the buffer has any multibyte characters.
+ (when (< (point-max) (position-bytes (point-max)))
+ (when (byte-compile-version-cond byte-compile-compatibility)
+ (error "Version-18 compatibility not valid with multibyte characters"))
+ (goto-char (point-min))
+ ;; Find the comment that describes the version test.
+ (search-forward "\n;;; This file")
+ (beginning-of-line)
+ (narrow-to-region (point) (point-max))
+ ;; Find the line of ballast semicolons.
+ (search-forward ";;;;;;;;;;")
+ (beginning-of-line)
+
+ (narrow-to-region (point-min) (point))
+ (let ((old-header-end (point))
+ delta)
+ (goto-char (point-min))
+ (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.
+ (re-search-forward "19\\(\\.[0-9]+\\)")
+ (replace-match "20")
+ (re-search-forward "19\\(\\.[0-9]+\\)")
+ (replace-match "20")
+ ;; Now compensate for the change in size,
+ ;; to make sure all positions in the file remain valid.
+ (setq delta (- (point-max) old-header-end))
+ (goto-char (point-max))
+ (widen)
+ (delete-char delta)))))
+
(defun byte-compile-insert-header (filename inbuffer outbuffer)
(set-buffer inbuffer)
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
+ (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 or 19) 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:
- ;;
+ ;; 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 19)
+ (if (byte-compile-version-cond byte-compile-compatibility) 18 20)
"\000\000\000\n"
)
- (insert ";;; compiled by "
+ (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 ";;; emacs version " emacs-version ".\n")
- (insert ";;; bytecomp version " byte-compile-version "\n;;; "
+ (insert ";;; in Emacs version " emacs-version "\n")
+ (insert ";;; with bytecomp version "
+ (progn (string-match "[0-9.]+" byte-compile-version)
+ (match-string 0 byte-compile-version))
+ "\n;;; "
(cond
- ((eq byte-optimize 'source) "source-level optimization only")
- ((eq byte-optimize 'byte) "byte-level optimization only")
- (byte-optimize "optimization is on")
- (t "optimization is off"))
+ ((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))
- (insert ";;; this file uses opcodes which do not exist in Emacs 18.\n"
- ;; Have to check if emacs-version is bound so that this works
- ;; in files loaded early in loadup.el.
- "\n(if (and (boundp 'emacs-version)\n"
- "\t (or (and (boundp 'epoch::version) epoch::version)\n"
- (if dynamic-docstrings
- "\t (string-lessp emacs-version \"19.29\")))\n"
- "\t (string-lessp emacs-version \"19\")))\n")
- " (error \"`"
- ;; prin1-to-string is used to quote backslashes.
- (substring (prin1-to-string (file-name-nondirectory filename))
- 1 -1)
- (if dynamic-docstrings
- "' was compiled for Emacs 19.29 or later\"))\n\n"
- "' was compiled for Emacs 19\"))\n\n"))
+ (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")
+ (setq intro-string
+ ";;; This file uses opcodes which do not exist in Emacs 18.\n"
+ minimum-version "19"))
+ ;; Now insert the comment and the error check.
+ (insert
+ "\n"
+ intro-string
+ ;; Have to check if emacs-version is bound so that this works
+ ;; in files loaded early in loadup.el.
+ "(if (and (boundp 'emacs-version)\n"
+ ;; If there is a name at the end of emacs-version,
+ ;; don't try to check the version number.
+ "\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
+ "\t (or (and (boundp 'epoch::version) epoch::version)\n"
+ (format "\t (string-lessp emacs-version \"%s\")))\n"
+ minimum-version)
+ " (error \"`"
+ ;; prin1-to-string is used to quote backslashes.
+ (substring (prin1-to-string (file-name-nondirectory filename))
+ 1 -1)
+ (format "' was compiled for Emacs %s or later\"))\n\n"
+ minimum-version)
+ ;; 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"))
+ ;; 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
- ;; in defun, defmacro, defvar, defconst and autoload because make-docfile is
- ;; so amazingly stupid.
+ ;; in defun, defmacro, defvar, defconst, autoload and
+ ;; custom-declare-variable because make-docfile is so amazingly stupid.
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
- (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload))
+ (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload
+ custom-declare-variable))
(stringp (nth 3 form)))
(byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
- (eq (car form) 'autoload))
+ (memq (car form)
+ '(autoload custom-declare-variable)))
(let ((print-escape-newlines t)
(print-length nil)
(print-level nil)
- (print-readably t) ; print #[] for bytecode, 'x for (quote x)
- (print-gensym nil)) ; this is too dangerous for now
+ (print-quoted t)
+ (print-gensym t))
(princ "\n" outbuffer)
(prin1 form outbuffer)
nil)))
together, for lazy loading.
QUOTED says that we have to put a quote before the
list that represents a doc string reference.
-`autoload' needs that."
+`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))
(setq position
(byte-compile-output-as-comment
(nth (nth 1 info) form) nil))
+ (setq position (position-bytes position))
;; If the doc string starts with * (a user variable),
;; negate POSITION.
(if (and (stringp (nth (nth 1 info) form))
(prin1 name outbuffer)))
(insert (car info))
(let ((print-escape-newlines t)
- (print-readably t) ; print #[] for bytecode, 'x for (quote x)
- (print-gensym nil) ; this is too dangerous for now
+ (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-gensym-alist was used before print-circle existed.
+ print-gensym-alist
+ (print-continuous-numbering t)
+ print-number-table
(index 0))
(prin1 (car form) outbuffer)
(while (setq form (cdr form))
(byte-compile-output-as-comment
(cons (car form) (nth 1 form))
t)))
+ (setq position (position-bytes position))
(princ (format "(#$ . %d) nil" position) outbuffer)
(setq form (cdr form))
(setq index (1+ index))))
(if byte-compile-output
(let ((form (byte-compile-out-toplevel t 'file)))
(cond ((eq (car-safe form) 'progn)
- (mapcar 'byte-compile-output-file-form (cdr form)))
+ (mapc 'byte-compile-output-file-form (cdr form)))
(form
(byte-compile-output-file-form form)))
(setq byte-compile-constants nil
(null form)) ;Constants only
(eval (nth 5 form)) ;Macro
(eval form)) ;Define the autoload.
+ ;; Avoid undefined function warnings for the autoload.
+ (if (and (consp (nth 1 form))
+ (eq (car (nth 1 form)) 'quote)
+ (consp (cdr (nth 1 form)))
+ (symbolp (nth 1 (nth 1 form))))
+ (add-to-list 'byte-compile-function-environment
+ (cons (nth 1 (nth 1 form))
+ (cons 'autoload (cdr (cdr form))))))
(if (stringp (nth 3 form))
form
;; No doc string, so we can compile this as a normal form.
(byte-compile-top-level (nth 2 form) nil 'file))))
form))
+(put 'custom-declare-variable 'byte-hunk-handler
+ 'byte-compile-file-form-custom-declare-variable)
+(defun byte-compile-file-form-custom-declare-variable (form)
+ (if (memq 'free-vars byte-compile-warnings)
+ (setq byte-compile-bound-variables
+ (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
+ form)
+
(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
(defun byte-compile-file-form-eval-boundary (form)
(eval form)
(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
(defun byte-compile-file-form-progn (form)
- (mapcar 'byte-compile-file-form (cdr form))
+ (mapc 'byte-compile-file-form (cdr form))
;; Return nil so the forms are not output twice.
nil)
(symbolp (car-safe (cdr-safe body)))
(car-safe (cdr-safe body))
(stringp (car-safe (cdr-safe (cdr-safe body)))))
- (byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
+ (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
(nth 1 form))))
(let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
(code (byte-compile-byte-code-maker new-one)))
(goto-char (point-max))
(insert "\037")
(goto-char position)
- (insert "#@" (format "%d" (- (point-max) 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
(nth 3 function))))))
+(defun byte-compile-check-lambda-list (list)
+ "Check lambda-list LIST for errors."
+ (let (vars)
+ (while list
+ (let ((arg (car list)))
+ (cond ((or (not (symbolp arg))
+ (keywordp arg)
+ (memq arg '(t nil)))
+ (error "Invalid lambda variable %s" arg))
+ ((eq arg '&rest)
+ (unless (cdr list)
+ (error "&rest without variable name"))
+ (when (cddr list)
+ (error "Garbage following &rest VAR in lambda-list")))
+ ((eq arg '&optional)
+ (unless (cdr list)
+ (error "Variable name missing after &optional")))
+ ((memq arg vars)
+ (byte-compile-warn "repeated variable %s in lambda-list" arg))
+ (t
+ (push arg vars))))
+ (setq list (cdr list)))))
+
+
;; Byte-compile a lambda-expression and return a valid function.
;; The value is usually a compiled function but may be the original
;; lambda-expression.
(defun byte-compile-lambda (fun)
+ (unless (eq 'lambda (car-safe fun))
+ (error "Not a lambda list: %S" fun))
+ (byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(byte-compile-bound-variables
(nconc (and (memq 'free-vars byte-compile-warnings)
(body (cdr (cdr fun)))
(doc (if (stringp (car body))
(prog1 (car body)
- (setq body (cdr 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)))
(cond (int
;; Skip (interactive) if it is in front (the most usual location).
(if (memq byte-optimize '(t byte))
(setq byte-compile-output
(byte-optimize-lapcode byte-compile-output for-effect)))
-
+
;; Decompile trivial functions:
;; only constants and variables, or a single funcall except in lambdas.
;; Except for Lisp_Compiled objects, forms like (foo "hi")
(if (if (eq (car (car rest)) 'byte-constant)
(or (consp tmp)
(and (symbolp tmp)
- (not (memq tmp '(nil t))))))
+ (not (byte-compile-const-symbol-p tmp)))))
(if maycall
(setq body (cons (list 'quote tmp) body)))
(setq body (cons tmp body))))
(body
(list body))))
\f
-;; This is the recursive entry point for compiling each subform of an
+;; This is the recursive entry point for compiling each subform of an
;; expression.
;; If for-effect is non-nil, byte-compile-form will output a byte-discard
;; before terminating (ie no value will be left on the stack).
(defun byte-compile-form (form &optional for-effect)
(setq form (macroexpand form byte-compile-macro-environment))
(cond ((not (consp form))
- (cond ((or (not (symbolp form)) (memq form '(nil t)))
+ (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
(byte-compile-constant form))
((and for-effect byte-compile-delete-errors)
(setq for-effect nil))
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile)))
- (if (memq fn '(t nil))
+ (if (byte-compile-const-symbol-p fn)
(byte-compile-warn "%s called as a function" fn))
(if (and handler
(or (not (byte-compile-version-cond
(if byte-compile-generate-call-tree
(byte-compile-annotate-call-tree form))
(byte-compile-push-constant (car form))
- (mapcar 'byte-compile-form (cdr form)) ; wasteful, but faster.
+ (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)
- (if (or (not (symbolp var)) (memq var '(nil t)))
+ (if (or (not (symbolp var)) (byte-compile-const-symbol-p var))
(byte-compile-warn (if (eq base-op 'byte-varbind)
- "Attempt to let-bind %s %s"
- "Variable reference to %s %s")
+ "attempt to let-bind %s %s"
+ "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))
- (let ((ob (get var 'byte-obsolete-variable)))
- (byte-compile-warn "%s is an obsolete variable; %s" var
- (if (stringp ob)
- ob
- (format "use %s instead." ob)))))
+ (let* ((ob (get var 'byte-obsolete-variable))
+ (when (cdr ob)))
+ (byte-compile-warn "%s is an obsolete variable%s; %s" var
+ (if when (concat " since " when) "")
+ (if (stringp (car ob))
+ (car ob)
+ (format "use %s instead." (car ob))))))
(if (memq 'free-vars byte-compile-warnings)
(if (eq base-op 'byte-varbind)
(setq byte-compile-bound-variables
(byte-compile-out base-op tmp)))
(defmacro byte-compile-get-constant (const)
- (` (or (if (stringp (, const))
- (assoc (, const) byte-compile-constants)
- (assq (, const) byte-compile-constants))
- (car (setq byte-compile-constants
- (cons (list (, const)) byte-compile-constants))))))
+ `(or (if (stringp ,const)
+ (assoc ,const byte-compile-constants)
+ (assq ,const byte-compile-constants))
+ (car (setq byte-compile-constants
+ (cons (list ,const) byte-compile-constants)))))
;; Use this when the value of a form is a constant. This obeys for-effect.
(defun byte-compile-constant (const)
(byte-defop-compiler (1+ byte-add1) 1)
(byte-defop-compiler (1- byte-sub1) 1)
(byte-defop-compiler goto-char 1)
-(byte-defop-compiler char-after 1)
+(byte-defop-compiler char-after 0-1)
(byte-defop-compiler set-buffer 1)
;;(byte-defop-compiler set-mark 1) ;; obsolete
(byte-defop-compiler19 forward-word 1)
(byte-defop-compiler19 integerp 1)
(byte-defop-compiler19 skip-chars-forward 1-2)
(byte-defop-compiler19 skip-chars-backward 1-2)
-(byte-defop-compiler (eql byte-eq) 2)
(byte-defop-compiler eq 2)
(byte-defop-compiler memq 2)
(byte-defop-compiler cons 2)
;; Compile a function that accepts one or more args and is right-associative.
;; We do it by left-associativity so that the operations
;; are done in the same order as in interpreted code.
+;; We treat the one-arg case, as in (+ x), like (+ x 0).
+;; in order to convert markers to numbers, and trigger expected errors.
(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)))
(while args
(byte-compile-form (car args))
(byte-compile-out opcode 0)
(byte-defop-compiler-1 - byte-compile-minus)
(byte-defop-compiler19 (/ byte-quo) byte-compile-quo)
(byte-defop-compiler19 nconc)
-(byte-defop-compiler-1 beginning-of-line)
(defun byte-compile-list (form)
(let ((count (length (cdr form))))
(cond ((= count 0)
(byte-compile-constant nil))
((< count 5)
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out
(aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0))
((and (< count 256) (not (byte-compile-version-cond
byte-compile-compatibility)))
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-listN count))
(t (byte-compile-normal-call form)))))
(defun byte-compile-concat (form)
(let ((count (length (cdr form))))
(cond ((and (< 1 count) (< count 5))
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out
(aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
0))
(byte-compile-form ""))
((and (< count 256) (not (byte-compile-version-cond
byte-compile-compatibility)))
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-concatN count))
((byte-compile-normal-call form)))))
(cdr (cdr form))))
form))))
+(defun byte-compile-funarg-2 (form)
+ ;; (sort ... '(lambda (x) ..)) ==> (sort ... (function (lambda (x) ..)))
+ ;; for cases where it's guaranteed that second arg will be used as a lambda.
+ (byte-compile-normal-call
+ (let ((fn (nth 2 form)))
+ (if (and (eq (car-safe fn) 'quote)
+ (eq (car-safe (nth 1 fn)) 'lambda))
+ (cons (car form)
+ (cons (nth 1 form)
+ (cons (cons 'function (cdr fn))
+ (cdr (cdr (cdr form))))))
+ form))))
+
;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
;; Otherwise it will be incompatible with the interpreter,
;; and (funcall (function foo)) will lose with autoloads.
((and (not (byte-compile-version-cond
byte-compile-compatibility))
(<= (length form) 256))
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(if (cdr (cdr form))
(byte-compile-out 'byte-insertN (length (cdr form)))
(byte-compile-out 'byte-insert 0)))
(if (cdr form)
(byte-compile-discard))))))
-(defun byte-compile-beginning-of-line (form)
- (if (not (byte-compile-constp (nth 1 form)))
- (byte-compile-normal-call form)
- (byte-compile-form
- (list 'forward-line
- (if (integerp (setq form (or (eval (nth 1 form)) 1)))
- (1- form)
- (byte-compile-warn "Non-numeric arg to beginning-of-line: %s"
- form)
- (list '1- (list 'quote form))))
- t)
- (byte-compile-constant nil)))
-
\f
(byte-defop-compiler-1 setq)
(byte-defop-compiler-1 setq-default)
(byte-defop-compiler-1 mapcar byte-compile-funarg)
(byte-defop-compiler-1 mapatoms byte-compile-funarg)
(byte-defop-compiler-1 mapconcat byte-compile-funarg)
+(byte-defop-compiler-1 mapc byte-compile-funarg)
+(byte-defop-compiler-1 sort byte-compile-funarg-2)
(byte-defop-compiler-1 let)
(byte-defop-compiler-1 let*)
(byte-compile-body (cdr (cdr (cdr form))) t))
(defmacro byte-compile-goto-if (cond discard tag)
- (` (byte-compile-goto
- (if (, cond)
- (if (, discard) 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
- (if (, discard) 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
- (, tag))))
+ `(byte-compile-goto
+ (if ,cond
+ (if ,discard 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
+ (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
+ ,tag))
(defun byte-compile-if (form)
(byte-compile-form (car (cdr form)))
(setq for-effect nil)))
(defun byte-compile-funcall (form)
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-call (length (cdr (cdr form)))))
(byte-defop-compiler-1 unwind-protect)
(byte-defop-compiler-1 condition-case)
(byte-defop-compiler-1 save-excursion)
+(byte-defop-compiler-1 save-current-buffer)
(byte-defop-compiler-1 save-restriction)
(byte-defop-compiler-1 save-window-excursion)
(byte-defop-compiler-1 with-output-to-temp-buffer)
;; (and (stringp (get condition 'error-message))
;; (consp (get condition 'error-conditions)))))
;; (byte-compile-warn
-;; "%s is not a known condition name (in condition-case)"
+;; "%s is not a known condition name (in condition-case)"
;; condition))
)
(setq compiled-clauses
(byte-compile-body-do-effect (cdr form))
(byte-compile-out 'byte-unbind 1))
+(defun byte-compile-save-current-buffer (form)
+ (byte-compile-out 'byte-save-current-buffer 0)
+ (byte-compile-body-do-effect (cdr form))
+ (byte-compile-out 'byte-unbind 1))
+
(defun byte-compile-save-window-excursion (form)
(byte-compile-push-constant
(byte-compile-top-level-body (cdr form) for-effect))
(defun byte-compile-defun (form)
;; This is not used for file-level defuns with doc strings.
+ (unless (symbolp (car form))
+ (error "defun name must be a symbol, not %s" (car form)))
(byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
(list 'fset (list 'quote (nth 1 form))
(byte-compile-byte-code-maker
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
- (let ((var (nth 1 form))
+ (let ((fun (nth 0 form))
+ (var (nth 1 form))
(value (nth 2 form))
(string (nth 3 form)))
- (if (memq 'free-vars byte-compile-warnings)
- (setq byte-compile-bound-variables
- (cons var byte-compile-bound-variables)))
+ (when (> (length form) 4)
+ (byte-compile-warn
+ "%s %s called with %d arguments, but accepts only %s"
+ fun var (length (cdr form)) 3))
+ (when (memq 'free-vars byte-compile-warnings)
+ (setq byte-compile-bound-variables
+ (cons var byte-compile-bound-variables)))
(byte-compile-body-do-effect
- (list (if (cdr (cdr form))
- (if (eq (car form) 'defconst)
- (list 'setq var value)
- (list 'or (list 'boundp (list 'quote var))
- (list 'setq var value))))
- ;; Put the defined variable in this library's load-history entry
- ;; just as a real defvar would.
- (list 'setq 'current-load-list
- (list 'cons (list 'quote var)
- 'current-load-list))
- (if string
- (list 'put (list 'quote var) ''variable-documentation string))
- (list 'quote var)))))
+ (list
+ ;; Put the defined variable in this library's load-history entry
+ ;; just as a real defvar would, but only in top-level forms.
+ (when (and (cddr form) (null byte-compile-current-form))
+ `(push ',var current-load-list))
+ (when (> (length form) 3)
+ (when (and string (not (stringp string)))
+ (byte-compile-warn "third arg to %s %s is not a string: %s"
+ fun var string))
+ `(put ',var 'variable-documentation ,string))
+ (if (cddr form) ; `value' provided
+ (if (eq fun 'defconst)
+ ;; `defconst' sets `var' unconditionally.
+ (let ((tmp (make-symbol "defconst-tmp-var")))
+ `(let ((,tmp ,value))
+ (eval '(defconst ,var ,tmp))))
+ ;; `defvar' sets `var' only when unbound.
+ `(if (not (boundp ',var)) (setq ,var ,value))))
+ `',var))))
(defun byte-compile-autoload (form)
(and (byte-compile-constp (nth 1 form))
(eval (nth 5 form)) ; macro-p
(not (fboundp (eval (nth 1 form))))
(byte-compile-warn
- "The compiler ignores `autoload' except at top level. You should
+ "The compiler ignores `autoload' except at top level. You should
probably put the autoload of the macro `%s' at top-level."
(eval (nth 1 form))))
(byte-compile-normal-call form))
-;; Lambda's in valid places are handled as special cases by various code.
+;; Lambdas in valid places are handled as special cases by various code.
;; The ones that remain are errors.
(defun byte-compile-lambda-form (form)
(error "`lambda' used as function name is invalid"))
))
\f
+(defun batch-byte-compile-if-not-done ()
+ "Like `byte-compile-file' but doesn't recompile if already up to date.
+Use this from the command line, with `-batch';
+it won't work in an interactive Emacs."
+ (batch-byte-compile t))
+
;;; by crl@newton.purdue.edu
;;; Only works noninteractively.
;;;###autoload
-(defun batch-byte-compile ()
+(defun batch-byte-compile (&optional noforce)
"Run `byte-compile-file' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
Each file is processed even if an error occurred previously.
-For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
+For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
+If NOFORCE is non-nil, don't recompile a file that seems to be
+already up-to-date."
;; command-line-args-left is what is left of the command line (from startup.el)
(defvar command-line-args-left) ;Avoid 'free variable' warning
(if (not noninteractive)
(let ((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)
- (while files
- (if (and (string-match emacs-lisp-file-regexp (car files))
- (not (auto-save-file-name-p (car files)))
- (setq source (expand-file-name (car files)
+ (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)))
- (setq files (cdr files))))
- (if (null (batch-byte-compile-file (car command-line-args-left)))
- (setq error t)))
+ (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))))
+ (if (null (batch-byte-compile-file (car command-line-args-left)))
+ (setq error t))))
(setq command-line-args-left (cdr command-line-args-left)))
- (message "Done")
(kill-emacs (if error 1 0))))
(defun batch-byte-compile-file (file)
(condition-case err
- (progn (byte-compile-file file) t)
+ (byte-compile-file file)
(error
(message (if (cdr err)
">>Error occurred processing %s: %s (%s)"
(or command-line-args-left
(setq command-line-args-left '(".")))
(while command-line-args-left
- (byte-recompile-directory (car command-line-args-left))
+ (byte-recompile-directory (car command-line-args-left) 0)
(setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs 0))
-(make-obsolete 'dot 'point)
-(make-obsolete 'dot-max 'point-max)
-(make-obsolete 'dot-min 'point-min)
-(make-obsolete 'dot-marker 'point-marker)
+(make-obsolete 'dot 'point "before 19.15")
+(make-obsolete 'dot-max 'point-max "before 19.15")
+(make-obsolete 'dot-min 'point-min "before 19.15")
+(make-obsolete 'dot-marker 'point-marker "before 19.15")
-(make-obsolete 'buffer-flush-undo 'buffer-disable-undo)
-(make-obsolete 'baud-rate "use the baud-rate variable instead")
-(make-obsolete 'compiled-function-p 'byte-code-function-p)
-(make-obsolete-variable 'auto-fill-hook 'auto-fill-function)
-(make-obsolete-variable 'blink-paren-hook 'blink-paren-function)
-(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function)
-(make-obsolete-variable 'temp-buffer-show-hook
- 'temp-buffer-show-function)
+(make-obsolete 'buffer-flush-undo 'buffer-disable-undo "before 19.15")
+(make-obsolete 'baud-rate "use the baud-rate variable instead" "before 19.15")
+(make-obsolete 'compiled-function-p 'byte-code-function-p "before 19.15")
+(make-obsolete 'define-function 'defalias "20.1")
+(make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15")
+(make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15")
+(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15")
(make-obsolete-variable 'inhibit-local-variables
- "use enable-local-variables (with the reversed sense).")
+ "use enable-local-variables (with the reversed sense)."
+ "before 19.15")
(make-obsolete-variable 'unread-command-char
- "use unread-command-events instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1.")
+ "use unread-command-events instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1."
+ "before 19.15")
(make-obsolete-variable 'unread-command-event
- "use unread-command-events; which is a list of events rather than a single event.")
-(make-obsolete-variable 'suspend-hooks 'suspend-hook)
-(make-obsolete-variable 'comment-indent-hook 'comment-indent-function)
-(make-obsolete-variable 'meta-flag "Use the set-input-mode function instead.")
-(make-obsolete-variable 'executing-macro 'executing-kbd-macro)
+ "use unread-command-events; which is a list of events rather than a single event."
+ "before 19.15")
+(make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15")
+(make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15")
+(make-obsolete-variable 'meta-flag "Use the set-input-mode function instead." "before 19.34")
+(make-obsolete-variable 'executing-macro 'executing-kbd-macro "before 19.34")
(make-obsolete-variable 'before-change-function
- "use before-change-functions; which is a list of functions rather than a single function.")
+ "use before-change-functions; which is a list of functions rather than a single function."
+ "before 19.34")
(make-obsolete-variable 'after-change-function
- "use after-change-functions; which is a list of functions rather than a single function.")
-(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face)
+ "use after-change-functions; which is a list of functions rather than a single function."
+ "before 19.34")
+(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face "before 19.34")
+(make-obsolete-variable 'post-command-idle-hook
+ "use timers instead, with `run-with-idle-timer'." "before 19.34")
+(make-obsolete-variable 'post-command-idle-delay
+ "use timers instead, with `run-with-idle-timer'." "before 19.34")
(provide 'byte-compile)
(provide 'bytecomp)
(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)))
+ (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
byte-compile-variable-ref))))
nil)
+(run-hooks 'bytecomp-load-hook)
+
;;; bytecomp.el ends here
HCoop / bpt / emacs.git / blobdiff