957 |
;; Also log the current function and file if not already done. |
;; Also log the current function and file if not already done. |
958 |
(defun byte-compile-log-warning (string &optional fill level) |
(defun byte-compile-log-warning (string &optional fill level) |
959 |
(let ((warning-prefix-function 'byte-compile-warning-prefix) |
(let ((warning-prefix-function 'byte-compile-warning-prefix) |
960 |
|
(warning-group-format "") |
961 |
(warning-fill-prefix (if fill " "))) |
(warning-fill-prefix (if fill " "))) |
962 |
(display-warning 'bytecomp string level "*Compile-Log*"))) |
(display-warning 'bytecomp string level "*Compile-Log*"))) |
963 |
|
|
1202 |
(delq calls byte-compile-unresolved-functions))))) |
(delq calls byte-compile-unresolved-functions))))) |
1203 |
))) |
))) |
1204 |
|
|
1205 |
|
(defvar byte-compile-cl-functions nil |
1206 |
|
"List of functions defined in CL.") |
1207 |
|
|
1208 |
|
(defun byte-compile-find-cl-functions () |
1209 |
|
(unless byte-compile-cl-functions |
1210 |
|
(dolist (elt load-history) |
1211 |
|
(when (string-match "^cl\\>" (car elt)) |
1212 |
|
(setq byte-compile-cl-functions |
1213 |
|
(append byte-compile-cl-functions |
1214 |
|
(cdr elt))))) |
1215 |
|
(let ((tail byte-compile-cl-functions)) |
1216 |
|
(while tail |
1217 |
|
(if (and (consp (car tail)) |
1218 |
|
(eq (car (car tail)) 'autoload)) |
1219 |
|
(setcar tail (cdr (car tail)))) |
1220 |
|
(setq tail (cdr tail)))))) |
1221 |
|
|
1222 |
(defun byte-compile-cl-warn (form) |
(defun byte-compile-cl-warn (form) |
1223 |
"Warn if FORM is a call of a function from the CL package." |
"Warn if FORM is a call of a function from the CL package." |
1224 |
(let* ((func (car-safe form)) |
(let ((func (car-safe form))) |
1225 |
(library |
(if (and byte-compile-cl-functions |
1226 |
(if func |
(memq func byte-compile-cl-functions) |
|
(cond ((eq (car-safe func) 'autoload) |
|
|
(nth 1 func)) |
|
|
((symbol-file func)))))) |
|
|
(if (and library |
|
|
(string-match "^cl\\>" library) |
|
1227 |
;; Aliases which won't have been expended at this point. |
;; Aliases which won't have been expended at this point. |
1228 |
;; These aren't all aliases of subrs, so not trivial to |
;; These aren't all aliases of subrs, so not trivial to |
1229 |
;; avoid hardwiring the list. |
;; avoid hardwiring the list. |
1230 |
(not (memq func |
(not (memq func |
1231 |
'(cl-block-wrapper cl-block-throw |
'(cl-block-wrapper cl-block-throw |
1232 |
multiple-value-call nth-value |
multiple-value-call nth-value |
1233 |
copy-seq first second rest endp cl-member)))) |
copy-seq first second rest endp cl-member |
1234 |
|
;; This is sometimes defined in CL |
1235 |
|
;; but that redefines a standard function, |
1236 |
|
;; so don't warn about it. |
1237 |
|
macroexpand)))) |
1238 |
(byte-compile-warn "Function `%s' from cl package called at runtime" |
(byte-compile-warn "Function `%s' from cl package called at runtime" |
1239 |
func))) |
func))) |
1240 |
form) |
form) |
1334 |
`(let (warning-series) |
`(let (warning-series) |
1335 |
;; Log the file name. Record position of that text. |
;; Log the file name. Record position of that text. |
1336 |
(setq warning-series (byte-compile-log-file)) |
(setq warning-series (byte-compile-log-file)) |
1337 |
|
(byte-compile-find-cl-functions) |
1338 |
(let ((--displaying-byte-compile-warnings-fn (lambda () |
(let ((--displaying-byte-compile-warnings-fn (lambda () |
1339 |
,@body))) |
,@body))) |
1340 |
(if byte-compile-debug |
(if byte-compile-debug |