summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2007-06-12 21:03:32 +0000
committerStefan Monnier <monnier@iro.umontreal.ca>2007-06-12 21:03:32 +0000
commitb8104a2bf5bee4a07cd6f3105a980f9f3324af8f (patch)
treee5f2669269d04947a6e11943533ab1c05bfd7f31 /lisp/emacs-lisp
parent0794ad3ba336f615454e7a624cff77212fc67a2d (diff)
downloademacs-b8104a2bf5bee4a07cd6f3105a980f9f3324af8f.tar.gz
emacs-b8104a2bf5bee4a07cd6f3105a980f9f3324af8f.tar.bz2
emacs-b8104a2bf5bee4a07cd6f3105a980f9f3324af8f.zip
(byte-compile-current-group): New var.
(byte-compile-file): Bind it. (byte-compile-nogroup-warn): Use it to avoid spurious warnings when the group argument is provided implicitly. (byte-compile-format-warn, byte-compile-from-buffer) (byte-compile-insert-header): Don't hardcode point-min==1. (byte-compile-file-form-require): Remove unused var old-load-list. (byte-compile-eval): Remove unused vars old-autoloads and hist-nil-new.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/bytecomp.el62
1 files changed, 34 insertions, 28 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 619b7533ca7..6a9381d787e 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -853,13 +853,11 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(when (and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads)))))))
(when (memq 'cl-functions byte-compile-warnings)
- (let ((hist-new load-history)
- (hist-nil-new current-load-list))
+ (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)))))))))
@@ -881,6 +879,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(defvar byte-compile-current-form nil)
(defvar byte-compile-dest-file nil)
(defvar byte-compile-current-file nil)
+(defvar byte-compile-current-group nil)
(defvar byte-compile-current-buffer nil)
;; Log something that isn't a warning.
@@ -1265,7 +1264,7 @@ extra args."
(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))))
@@ -1282,20 +1281,29 @@ extra args."
;; Warn if a custom definition fails to specify :group.
(defun byte-compile-nogroup-warn (form)
- (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
- (name (cadr form)))
- (or (not (eq (car-safe name) 'quote))
- (and (eq (car form) 'custom-declare-group)
- (equal name ''emacs))
- (plist-get keyword-args :group)
- (not (and (consp name) (eq (car name) 'quote)))
- (byte-compile-warn
- "%s for `%s' fails to specify containing group"
- (cdr (assq (car form)
- '((custom-declare-group . defgroup)
- (custom-declare-face . defface)
- (custom-declare-variable . defcustom))))
- (cadr name)))))
+ (if (and (memq (car form) '(custom-declare-face custom-declare-variable))
+ byte-compile-current-group)
+ ;; The group will be provided implicitly.
+ nil
+ (let ((keyword-args (cdr (cdr (cdr (cdr form)))))
+ (name (cadr form)))
+ (or (not (eq (car-safe name) 'quote))
+ (and (eq (car form) 'custom-declare-group)
+ (equal name ''emacs))
+ (plist-get keyword-args :group)
+ (not (and (consp name) (eq (car name) 'quote)))
+ (byte-compile-warn
+ "%s for `%s' fails to specify containing group"
+ (cdr (assq (car form)
+ '((custom-declare-group . defgroup)
+ (custom-declare-face . defface)
+ (custom-declare-variable . defcustom))))
+ (cadr name)))
+ ;; Update the current group, if needed.
+ (if (and byte-compile-current-file ;Only when byte-compiling a whole file.
+ (eq (car form) 'custom-declare-group)
+ (eq (car-safe name) 'quote))
+ (setq byte-compile-current-group (cadr name))))))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
@@ -1657,6 +1665,7 @@ The value is non-nil if there were no errors, nil if errors."
;; Force logging of the file name for each file compiled.
(setq byte-compile-last-logged-file nil)
(let ((byte-compile-current-file filename)
+ (byte-compile-current-group nil)
(set-auto-coding-for-load t)
target-file input-buffer output-buffer
byte-compile-dest-file)
@@ -1834,9 +1843,8 @@ With argument, insert value in current buffer after the form."
;; 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)
@@ -1850,9 +1858,8 @@ With argument, insert value in current buffer after the form."
(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))
;; Compile the forms from the input buffer.
(while (progn
@@ -1920,7 +1927,7 @@ With argument, insert value in current buffer after the form."
(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
@@ -2241,8 +2248,7 @@ list that represents a doc string reference.
(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))