aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2004-10-16 15:20:24 +0000
committerRichard M. Stallman2004-10-16 15:20:24 +0000
commit997011eb62f97c6f66d822682c7375e213ed6a2c (patch)
tree0a2735e64e3e64e28db0c80881dd4f3f53c79c1c
parentd42c87ab5397404b76b2f3c06bf200296a363a80 (diff)
downloademacs-997011eb62f97c6f66d822682c7375e213ed6a2c.tar.gz
emacs-997011eb62f97c6f66d822682c7375e213ed6a2c.zip
(byte-compile-eval): Don't process
"cl" like other files. Instead, call byte-compile-find-cl-functions. (byte-compile-file-form-require): Detect "cl" from the arg value. (byte-compile-log-1): Bind inhibit-read-only. (byte-compile-warning-prefix, byte-compile-log-file): Likewise. (byte-compile-log-warning): Likewise.
-rw-r--r--lisp/emacs-lisp/bytecomp.el58
1 files changed, 36 insertions, 22 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 2b0a8e698a6..118352937bd 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -792,7 +792,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
792 (let ((xs (pop hist-new)) 792 (let ((xs (pop hist-new))
793 old-autoloads) 793 old-autoloads)
794 ;; Make sure the file was not already loaded before. 794 ;; Make sure the file was not already loaded before.
795 (unless (assoc (car xs) hist-orig) 795 (unless (or (assoc (car xs) hist-orig)
796 (equal (car xs) "cl"))
796 (dolist (s xs) 797 (dolist (s xs)
797 (cond 798 (cond
798 ((symbolp s) 799 ((symbolp s)
@@ -809,7 +810,18 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
809 (when (and (symbolp s) (not (memq s old-autoloads))) 810 (when (and (symbolp s) (not (memq s old-autoloads)))
810 (push s byte-compile-noruntime-functions)) 811 (push s byte-compile-noruntime-functions))
811 (when (and (consp s) (eq t (car s))) 812 (when (and (consp s) (eq t (car s)))
812 (push (cdr s) old-autoloads)))))))))) 813 (push (cdr s) old-autoloads)))))))
814 (when (memq 'cl-functions byte-compile-warnings)
815 (let ((hist-new load-history)
816 (hist-nil-new current-load-list))
817 ;; Go through load-history, look for newly loaded files
818 ;; and mark all the functions defined therein.
819 (while (and hist-new (not (eq hist-new hist-orig)))
820 (let ((xs (pop hist-new))
821 old-autoloads)
822 ;; Make sure the file was not already loaded before.
823 (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
824 (byte-compile-find-cl-functions)))))))))
813 825
814(defun byte-compile-eval-before-compile (form) 826(defun byte-compile-eval-before-compile (form)
815 "Evaluate FORM for `eval-and-compile'." 827 "Evaluate FORM for `eval-and-compile'."
@@ -848,12 +860,13 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
848;; Log something that isn't a warning. 860;; Log something that isn't a warning.
849(defun byte-compile-log-1 (string) 861(defun byte-compile-log-1 (string)
850 (with-current-buffer "*Compile-Log*" 862 (with-current-buffer "*Compile-Log*"
851 (goto-char (point-max)) 863 (let ((inhibit-read-only t))
852 (byte-compile-warning-prefix nil nil) 864 (goto-char (point-max))
853 (cond (noninteractive 865 (byte-compile-warning-prefix nil nil)
854 (message " %s" string)) 866 (cond (noninteractive
855 (t 867 (message " %s" string))
856 (insert (format "%s\n" string)))))) 868 (t
869 (insert (format "%s\n" string)))))))
857 870
858(defvar byte-compile-read-position nil 871(defvar byte-compile-read-position nil
859 "Character position we began the last `read' from.") 872 "Character position we began the last `read' from.")
@@ -904,7 +917,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
904;; This is used as warning-prefix for the compiler. 917;; This is used as warning-prefix for the compiler.
905;; It is always called with the warnings buffer current. 918;; It is always called with the warnings buffer current.
906(defun byte-compile-warning-prefix (level entry) 919(defun byte-compile-warning-prefix (level entry)
907 (let* ((dir default-directory) 920 (let* ((inhibit-read-only t)
921 (dir default-directory)
908 (file (cond ((stringp byte-compile-current-file) 922 (file (cond ((stringp byte-compile-current-file)
909 (format "%s:" (file-relative-name byte-compile-current-file dir))) 923 (format "%s:" (file-relative-name byte-compile-current-file dir)))
910 ((bufferp byte-compile-current-file) 924 ((bufferp byte-compile-current-file)
@@ -950,7 +964,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
950 (save-excursion 964 (save-excursion
951 (set-buffer (get-buffer-create "*Compile-Log*")) 965 (set-buffer (get-buffer-create "*Compile-Log*"))
952 (goto-char (point-max)) 966 (goto-char (point-max))
953 (let* ((dir (and byte-compile-current-file 967 (let* ((inhibit-read-only t)
968 (dir (and byte-compile-current-file
954 (file-name-directory byte-compile-current-file))) 969 (file-name-directory byte-compile-current-file)))
955 (was-same (equal default-directory dir)) 970 (was-same (equal default-directory dir))
956 pt) 971 pt)
@@ -984,7 +999,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
984(defun byte-compile-log-warning (string &optional fill level) 999(defun byte-compile-log-warning (string &optional fill level)
985 (let ((warning-prefix-function 'byte-compile-warning-prefix) 1000 (let ((warning-prefix-function 'byte-compile-warning-prefix)
986 (warning-type-format "") 1001 (warning-type-format "")
987 (warning-fill-prefix (if fill " "))) 1002 (warning-fill-prefix (if fill " "))
1003 (inhibit-read-only t))
988 (display-warning 'bytecomp string level "*Compile-Log*"))) 1004 (display-warning 'bytecomp string level "*Compile-Log*")))
989 1005
990(defun byte-compile-warn (format &rest args) 1006(defun byte-compile-warn (format &rest args)
@@ -2140,17 +2156,15 @@ list that represents a doc string reference.
2140 (setq tail (cdr tail)))) 2156 (setq tail (cdr tail))))
2141 form) 2157 form)
2142 2158
2143(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) 2159(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
2144(defun byte-compile-file-form-eval-boundary (form) 2160(defun byte-compile-file-form-require (form)
2145 (let ((old-load-list current-load-list)) 2161 (let ((old-load-list current-load-list)
2146 (eval form) 2162 (args (mapcar 'eval (cdr form))))
2147 ;; (require 'cl) turns off warnings for cl functions. 2163 (apply 'require args)
2148 (let ((tem current-load-list)) 2164 ;; Detech (require 'cl) in a way that works even if cl is already loaded.
2149 (while (not (eq tem old-load-list)) 2165 (if (member (car args) '("cl" cl))
2150 (when (equal (car tem) '(require . cl)) 2166 (setq byte-compile-warnings
2151 (setq byte-compile-warnings 2167 (remq 'cl-functions byte-compile-warnings))))
2152 (remq 'cl-functions byte-compile-warnings)))
2153 (setq tem (cdr tem)))))
2154 (byte-compile-keep-pending form 'byte-compile-normal-call)) 2168 (byte-compile-keep-pending form 'byte-compile-normal-call))
2155 2169
2156(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) 2170(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)