[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/bytecomp.el

[Richard M. Stallman]

Index: emacs/lisp/emacs-lisp/bytecomp.el
diff -c emacs/lisp/emacs-lisp/bytecomp.el:2.106 
emacs/lisp/emacs-lisp/bytecomp.el:2.107
*** emacs/lisp/emacs-lisp/bytecomp.el:2.106     Sat Jul 20 18:01:19 2002
--- emacs/lisp/emacs-lisp/bytecomp.el   Tue Jul 23 23:58:02 2002
***************
*** 10,16 ****
  
  ;;; This version incorporates changes up to version 2.10 of the
  ;;; Zawinski-Furuseth compiler.
! (defconst byte-compile-version "$Revision: 2.106 $")
  
  ;; This file is part of GNU Emacs.
  
--- 10,16 ----
  
  ;;; This version incorporates changes up to version 2.10 of the
  ;;; Zawinski-Furuseth compiler.
! (defconst byte-compile-version "$Revision: 2.107 $")
  
  ;; This file is part of GNU Emacs.
  
***************
*** 957,962 ****
--- 957,963 ----
  ;; 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,1223 ****
                    (delq calls byte-compile-unresolved-functions)))))
        )))
  
  (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)
             ;; 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))))
        (byte-compile-warn "Function `%s' from cl package called at runtime"
                           func)))
    form)
--- 1202,1240 ----
                    (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)))
!     (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
!                         ;; 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,1322 ****
--- 1334,1340 ----
    `(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