;; `obsolete' (obsolete variables and functions)
;; `noruntime' (calls to functions only defined
;; within `eval-when-compile')
-;; `cl-warnings' (calls to CL functions)
+;; `cl-functions' (calls to CL functions)
;; `interactive-only' (calls to commands that are
;; not good to call from Lisp)
+;; `make-local' (dubious calls to
+;; `make-variable-buffer-local')
;; byte-compile-compatibility Whether the compiler should
;; generate .elc files which can be loaded into
;; generic emacs 18.
;; The user may want to redefine this along with emacs-lisp-file-regexp,
;; so only define it if it is undefined.
(defun byte-compile-dest-file (filename)
- "Convert an Emacs Lisp source file name to a compiled file name."
+ "Convert an Emacs Lisp source file name to a compiled file name.
+If FILENAME matches `emacs-lisp-file-regexp' (by default, files
+with the extension `.el'), add `c' to it; otherwise add `.elc'."
(setq filename (byte-compiler-base-file-name filename))
(setq filename (file-name-sans-versions filename))
(cond ((eq system-type 'vax-vms)
the functions you loaded will not be able to run.")
;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
+(defvar byte-compile-disable-print-circle nil
+ "If non-nil, disable `print-circle' on printing a byte-compiled code.")
+;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
+
(defcustom byte-compile-dynamic-docstrings t
"*If non-nil, compile doc strings for lazy access.
We bury the doc strings of functions and variables
cl-functions calls to runtime functions from the CL package (as
distinguished from macros and aliases).
interactive-only
- commands that normally shouldn't be called from Lisp code."
+ commands that normally shouldn't be called from Lisp code.
+ make-local calls to make-variable-buffer-local that may be incorrect."
:group 'bytecomp
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
(const free-vars) (const unresolved)
(const callargs) (const redefine)
(const obsolete) (const noruntime)
- (const cl-functions) (const interactive-only))))
+ (const cl-functions) (const interactive-only)
+ (const make-local))))
(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
;;;###autoload
(defun byte-compile-warnings-safe-p (x)
(when (memq e '(free-vars unresolved
callargs redefine
obsolete noruntime
- cl-functions interactive-only))
+ cl-functions interactive-only make-local))
e))
x)
x))))
(defvar byte-compile-unresolved-functions nil
"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
+This variable is only significant whilst compiling an entire buffer.
+Used for warnings when a function is not known to be defined or is later
defined with incorrect args.")
(defvar byte-compile-noruntime-functions nil
(when (and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads)))))))
(when (memq 'cl-functions byte-compile-warnings)
- (let ((hist-new load-history)
- (hist-nil-new current-load-list))
+ (let ((hist-new load-history))
;; Go through load-history, look for newly loaded files
;; and mark all the functions defined therein.
(while (and hist-new (not (eq hist-new hist-orig)))
- (let ((xs (pop hist-new))
- old-autoloads)
+ (let ((xs (pop hist-new)))
;; Make sure the file was not already loaded before.
(when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
(byte-compile-find-cl-functions)))))))))
(pos (if (and byte-compile-current-file
(integerp byte-compile-read-position))
(with-current-buffer byte-compile-current-buffer
- (format "%d:%d:" (count-lines (point-min)
- byte-compile-last-position)
+ (format "%d:%d:"
+ (save-excursion
+ (goto-char byte-compile-last-position)
+ (1+ (count-lines (point-min) (point-at-bol))))
(save-excursion
(goto-char byte-compile-last-position)
(1+ (current-column)))))
(get (car form) 'byte-compile-format-like))
(let ((nfields (with-temp-buffer
(insert (nth 1 form))
- (goto-char 1)
+ (goto-char (point-min))
(let ((n 0))
(while (re-search-forward "%." nil t)
(unless (eq ?% (char-after (1+ (match-beginning 0))))
;; Warn if a custom definition fails to specify :group.
(defun byte-compile-nogroup-warn (form)
(let ((keyword-args (cdr (cdr (cdr (cdr form)))))
- (name (cadr form)))
+ (name (cadr form)))
(or (not (eq (car-safe name) 'quote))
- (and (eq (car form) 'custom-declare-group)
- (equal name ''emacs))
- (plist-get keyword-args :group)
- (not (and (consp name) (eq (car name) 'quote)))
- (byte-compile-warn
- "%s for `%s' fails to specify containing group"
- (cdr (assq (car form)
- '((custom-declare-group . defgroup)
- (custom-declare-face . defface)
- (custom-declare-variable . defcustom))))
- (cadr name)))))
+ (and (eq (car form) 'custom-declare-group)
+ (equal name ''emacs))
+ (plist-get keyword-args :group)
+ (not (and (consp name) (eq (car name) 'quote)))
+ (byte-compile-warn
+ "%s for `%s' fails to specify containing group"
+ (cdr (assq (car form)
+ '((custom-declare-group . defgroup)
+ (custom-declare-face . defface)
+ (custom-declare-variable . defcustom))))
+ (cadr name)))))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
(unless byte-compile-cl-functions
(dolist (elt load-history)
(when (and (stringp (car elt))
- (string-match "^cl\\>" (car elt)))
+ (string-match
+ "^cl\\>" (file-name-nondirectory (car elt))))
(setq byte-compile-cl-functions
(append byte-compile-cl-functions
(cdr elt)))))
;;;###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.
+The output file's name is generated by passing FILENAME to the
+`byte-compile-dest-file' function (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")
;; byte-compile-warnings))
)
(byte-compile-close-variables
- (save-excursion
- (setq outbuffer
- (set-buffer (get-buffer-create " *Compiler Output*")))
+ (with-current-buffer
+ (setq outbuffer (get-buffer-create " *Compiler Output*"))
(set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
(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)
+ (with-current-buffer inbuffer
+ (goto-char (point-min))
+ ;; Should we always do this? When calling multiple files, it
+ ;; would be useful to delay this warning until all have been
+ ;; compiled. A: Yes! b-c-u-f might contain dross from a
+ ;; previous byte-compile.
+ (setq byte-compile-unresolved-functions nil)
;; Compile the forms from the input buffer.
(while (progn
;; Make warnings about unresolved functions
;; give the end of the file as their position.
(setq byte-compile-last-position (point-max))
- (byte-compile-warn-about-unresolved-functions)
- ;; 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))
+ (byte-compile-warn-about-unresolved-functions))
;; Fix up the header at the front of the output
;; if the buffer contains multibyte characters.
(and filename (byte-compile-fix-header filename inbuffer outbuffer))))
(let ((dynamic-docstrings byte-compile-dynamic-docstrings)
(dynamic byte-compile-dynamic))
(set-buffer outbuffer)
- (goto-char 1)
+ (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
(print-level nil)
(print-quoted t)
(print-gensym t)
- (print-circle t)) ; handle circular data structures
+ (print-circle ; handle circular data structures
+ (not byte-compile-disable-print-circle)))
(princ "\n" outbuffer)
(prin1 form outbuffer)
nil)))
;; print-gensym-alist not to be cleared
;; between calls to print functions.
(print-gensym '(t))
- (print-circle t) ; handle circular data structures
+ (print-circle ; handle circular data structures
+ (not byte-compile-disable-print-circle))
print-gensym-alist ; was used before print-circle existed.
(print-continuous-numbering t)
print-number-table
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
- (let ((old-load-list current-load-list)
- (args (mapcar 'eval (cdr form))))
+ (let ((args (mapcar 'eval (cdr form))))
(apply 'require args)
;; Detect (require 'cl) in a way that works even if cl is already loaded.
(if (member (car args) '("cl" cl))
(eq (car (car (cdr tail))) 'declare))
(let ((declaration (car (cdr tail))))
(setcdr tail (cdr (cdr tail)))
- (princ `(if macro-declaration-function
+ (prin1 `(if macro-declaration-function
(funcall macro-declaration-function
',name ',declaration))
outbuffer)))))
\f
;; more complicated compiler macros
+(byte-defop-compiler char-before)
+(byte-defop-compiler backward-char)
+(byte-defop-compiler backward-word)
(byte-defop-compiler list)
(byte-defop-compiler concat)
(byte-defop-compiler fset)
(byte-defop-compiler19 (/ byte-quo) byte-compile-quo)
(byte-defop-compiler19 nconc)
+(defun byte-compile-char-before (form)
+ (cond ((= 2 (length form))
+ (byte-compile-form (list 'char-after (if (numberp (nth 1 form))
+ (1- (nth 1 form))
+ `(1- ,(nth 1 form))))))
+ ((= 1 (length form))
+ (byte-compile-form '(char-after (1- (point)))))
+ (t (byte-compile-subr-wrong-args form "0-1"))))
+
+;; backward-... ==> forward-... with negated argument.
+(defun byte-compile-backward-char (form)
+ (cond ((= 2 (length form))
+ (byte-compile-form (list 'forward-char (if (numberp (nth 1 form))
+ (- (nth 1 form))
+ `(- ,(nth 1 form))))))
+ ((= 1 (length form))
+ (byte-compile-form '(forward-char -1)))
+ (t (byte-compile-subr-wrong-args form "0-1"))))
+
+(defun byte-compile-backward-word (form)
+ (cond ((= 2 (length form))
+ (byte-compile-form (list 'forward-word (if (numberp (nth 1 form))
+ (- (nth 1 form))
+ `(- ,(nth 1 form))))))
+ ((= 1 (length form))
+ (byte-compile-form '(forward-word -1)))
+ (t (byte-compile-subr-wrong-args form "0-1"))))
+
(defun byte-compile-list (form)
(let ((count (length (cdr form))))
(cond ((= count 0)
;; Warn about misuses of make-variable-buffer-local.
(byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local)
(defun byte-compile-make-variable-buffer-local (form)
- (if (eq (car-safe (car-safe (cdr-safe form))) 'quote)
+ (if (and (eq (car-safe (car-safe (cdr-safe form))) 'quote)
+ (memq 'make-local byte-compile-warnings))
(byte-compile-warn
"`make-variable-buffer-local' should be called at toplevel"))
(byte-compile-normal-call form))
HCoop / bpt / emacs.git / blobdiff