# HG changeset patch # User Richard M. Stallman # Date 1027483082 0 # Node ID 04d87f195cd127549272ffc1bf5328fab7464ebc # Parent ac53ae45c50281b56b50a8c49c175d06e9051830 (byte-compile-cl-functions): New variable. (byte-compile-cl-warn): Use that variable. (byte-compile-find-cl-functions): New function. (displaying-byte-compile-warnings): Call byte-compile-find-cl-functions. diff -r ac53ae45c502 -r 04d87f195cd1 lisp/emacs-lisp/bytecomp.el --- a/lisp/emacs-lisp/bytecomp.el Wed Jul 24 03:54:58 2002 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Wed Jul 24 03:58:02 2002 +0000 @@ -10,7 +10,7 @@ ;;; This version incorporates changes up to version 2.10 of the ;;; Zawinski-Furuseth compiler. -(defconst byte-compile-version "$Revision: 2.102 $") +(defconst byte-compile-version "$Revision: 2.106 $") ;; This file is part of GNU Emacs. @@ -957,6 +957,7 @@ ;; Also log the current function and file if not already done. (defun byte-compile-log-warning (string &optional fill level) (let ((warning-prefix-function 'byte-compile-warning-prefix) + (warning-group-format "") (warning-fill-prefix (if fill " "))) (display-warning 'bytecomp string level "*Compile-Log*"))) @@ -1201,23 +1202,39 @@ (delq calls byte-compile-unresolved-functions))))) ))) +(defvar byte-compile-cl-functions nil + "List of functions defined in CL.") + +(defun byte-compile-find-cl-functions () + (unless byte-compile-cl-functions + (dolist (elt load-history) + (when (string-match "^cl\\>" (car elt)) + (setq byte-compile-cl-functions + (append byte-compile-cl-functions + (cdr elt))))) + (let ((tail byte-compile-cl-functions)) + (while tail + (if (and (consp (car tail)) + (eq (car (car tail)) 'autoload)) + (setcar tail (cdr (car tail)))) + (setq tail (cdr tail)))))) + (defun byte-compile-cl-warn (form) "Warn if FORM is a call of a function from the CL package." - (let* ((func (car-safe form)) - (library - (if func - (cond ((eq (car-safe func) 'autoload) - (nth 1 func)) - ((symbol-file func)))))) - (if (and library - (string-match "^cl\\>" library) + (let ((func (car-safe form))) + (if (and byte-compile-cl-functions + (memq func byte-compile-cl-functions) ;; Aliases which won't have been expended at this point. ;; These aren't all aliases of subrs, so not trivial to ;; avoid hardwiring the list. (not (memq func '(cl-block-wrapper cl-block-throw multiple-value-call nth-value - copy-seq first second rest endp cl-member)))) + copy-seq first second rest endp cl-member + ;; This is sometimes defined in CL + ;; but that redefines a standard function, + ;; so don't warn about it. + macroexpand)))) (byte-compile-warn "Function `%s' from cl package called at runtime" func))) form) @@ -1317,6 +1334,7 @@ `(let (warning-series) ;; Log the file name. Record position of that text. (setq warning-series (byte-compile-log-file)) + (byte-compile-find-cl-functions) (let ((--displaying-byte-compile-warnings-fn (lambda () ,@body))) (if byte-compile-debug