792 |
(let ((xs (pop hist-new)) |
(let ((xs (pop hist-new)) |
793 |
old-autoloads) |
old-autoloads) |
794 |
;; Make sure the file was not already loaded before. |
;; Make sure the file was not already loaded before. |
795 |
(unless (assoc (car xs) hist-orig) |
(unless (or (assoc (car xs) hist-orig) |
796 |
|
(equal (car xs) "cl")) |
797 |
(dolist (s xs) |
(dolist (s xs) |
798 |
(cond |
(cond |
799 |
((symbolp s) |
((symbolp s) |
810 |
(when (and (symbolp s) (not (memq s old-autoloads))) |
(when (and (symbolp s) (not (memq s old-autoloads))) |
811 |
(push s byte-compile-noruntime-functions)) |
(push s byte-compile-noruntime-functions)) |
812 |
(when (and (consp s) (eq t (car s))) |
(when (and (consp s) (eq t (car s))) |
813 |
(push (cdr s) old-autoloads)))))))))) |
(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))))))))) |
825 |
|
|
826 |
(defun byte-compile-eval-before-compile (form) |
(defun byte-compile-eval-before-compile (form) |
827 |
"Evaluate FORM for `eval-and-compile'." |
"Evaluate FORM for `eval-and-compile'." |
860 |
;; Log something that isn't a warning. |
;; Log something that isn't a warning. |
861 |
(defun byte-compile-log-1 (string) |
(defun byte-compile-log-1 (string) |
862 |
(with-current-buffer "*Compile-Log*" |
(with-current-buffer "*Compile-Log*" |
863 |
(goto-char (point-max)) |
(let ((inhibit-read-only t)) |
864 |
(byte-compile-warning-prefix nil nil) |
(goto-char (point-max)) |
865 |
(cond (noninteractive |
(byte-compile-warning-prefix nil nil) |
866 |
(message " %s" string)) |
(cond (noninteractive |
867 |
(t |
(message " %s" string)) |
868 |
(insert (format "%s\n" string)))))) |
(t |
869 |
|
(insert (format "%s\n" string))))))) |
870 |
|
|
871 |
(defvar byte-compile-read-position nil |
(defvar byte-compile-read-position nil |
872 |
"Character position we began the last `read' from.") |
"Character position we began the last `read' from.") |
917 |
;; This is used as warning-prefix for the compiler. |
;; This is used as warning-prefix for the compiler. |
918 |
;; It is always called with the warnings buffer current. |
;; It is always called with the warnings buffer current. |
919 |
(defun byte-compile-warning-prefix (level entry) |
(defun byte-compile-warning-prefix (level entry) |
920 |
(let* ((dir default-directory) |
(let* ((inhibit-read-only t) |
921 |
|
(dir default-directory) |
922 |
(file (cond ((stringp byte-compile-current-file) |
(file (cond ((stringp byte-compile-current-file) |
923 |
(format "%s:" (file-relative-name byte-compile-current-file dir))) |
(format "%s:" (file-relative-name byte-compile-current-file dir))) |
924 |
((bufferp byte-compile-current-file) |
((bufferp byte-compile-current-file) |
964 |
(save-excursion |
(save-excursion |
965 |
(set-buffer (get-buffer-create "*Compile-Log*")) |
(set-buffer (get-buffer-create "*Compile-Log*")) |
966 |
(goto-char (point-max)) |
(goto-char (point-max)) |
967 |
(let* ((dir (and byte-compile-current-file |
(let* ((inhibit-read-only t) |
968 |
|
(dir (and byte-compile-current-file |
969 |
(file-name-directory byte-compile-current-file))) |
(file-name-directory byte-compile-current-file))) |
970 |
(was-same (equal default-directory dir)) |
(was-same (equal default-directory dir)) |
971 |
pt) |
pt) |
999 |
(defun byte-compile-log-warning (string &optional fill level) |
(defun byte-compile-log-warning (string &optional fill level) |
1000 |
(let ((warning-prefix-function 'byte-compile-warning-prefix) |
(let ((warning-prefix-function 'byte-compile-warning-prefix) |
1001 |
(warning-type-format "") |
(warning-type-format "") |
1002 |
(warning-fill-prefix (if fill " "))) |
(warning-fill-prefix (if fill " ")) |
1003 |
|
(inhibit-read-only t)) |
1004 |
(display-warning 'bytecomp string level "*Compile-Log*"))) |
(display-warning 'bytecomp string level "*Compile-Log*"))) |
1005 |
|
|
1006 |
(defun byte-compile-warn (format &rest args) |
(defun byte-compile-warn (format &rest args) |
2156 |
(setq tail (cdr tail)))) |
(setq tail (cdr tail)))) |
2157 |
form) |
form) |
2158 |
|
|
2159 |
(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) |
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require) |
2160 |
(defun byte-compile-file-form-eval-boundary (form) |
(defun byte-compile-file-form-require (form) |
2161 |
(let ((old-load-list current-load-list)) |
(let ((old-load-list current-load-list) |
2162 |
(eval form) |
(args (mapcar 'eval (cdr form)))) |
2163 |
;; (require 'cl) turns off warnings for cl functions. |
(apply 'require args) |
2164 |
(let ((tem current-load-list)) |
;; Detech (require 'cl) in a way that works even if cl is already loaded. |
2165 |
(while (not (eq tem old-load-list)) |
(if (member (car args) '("cl" cl)) |
2166 |
(when (equal (car tem) '(require . cl)) |
(setq byte-compile-warnings |
2167 |
(setq byte-compile-warnings |
(remq 'cl-functions byte-compile-warnings)))) |
|
(remq 'cl-functions byte-compile-warnings))) |
|
|
(setq tem (cdr tem))))) |
|
2168 |
(byte-compile-keep-pending form 'byte-compile-normal-call)) |
(byte-compile-keep-pending form 'byte-compile-normal-call)) |
2169 |
|
|
2170 |
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) |
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) |