diff options
| author | Richard M. Stallman | 2004-10-16 15:20:24 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 2004-10-16 15:20:24 +0000 |
| commit | 997011eb62f97c6f66d822682c7375e213ed6a2c (patch) | |
| tree | 0a2735e64e3e64e28db0c80881dd4f3f53c79c1c | |
| parent | d42c87ab5397404b76b2f3c06bf200296a363a80 (diff) | |
| download | emacs-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.el | 58 |
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) |