comparison lisp/emacs-lisp/bytecomp.el @ 46657:04d87f195cd1

(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.

46656:ac53ae45c502

;; Maintainer: FSF
;; Keywords: lisp

;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.102 $")

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;; Log a message STRING in *Compile-Log*.
;; 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-fill-prefix (if fill "    ")))
    (display-warning 'bytecomp string level "*Compile-Log*")))

(defun byte-compile-warn (format &rest args)
  "Issue a byte compiler warning; use (format FORMAT ARGS...) for message."

	      (setq byte-compile-unresolved-functions
		    (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)

(defun byte-compile-print-syms (str1 strn syms)

(defmacro displaying-byte-compile-warnings (&rest body)
  `(let (warning-series)
     ;; Log the file name.  Record position of that text.
     (setq warning-series (byte-compile-log-file))
     (let ((--displaying-byte-compile-warnings-fn (lambda ()
						    ,@body)))
       (if byte-compile-debug
	   (funcall --displaying-byte-compile-warnings-fn)
	 (condition-case error-info

46657:04d87f195cd1

;; Maintainer: FSF
;; Keywords: lisp

;;; 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.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;; Log a message STRING in *Compile-Log*.
;; 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*")))

(defun byte-compile-warn (format &rest args)
  "Issue a byte compiler warning; use (format FORMAT ARGS...) for message."

	      (setq byte-compile-unresolved-functions
		    (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)

(defun byte-compile-print-syms (str1 strn syms)

(defmacro displaying-byte-compile-warnings (&rest body)
  `(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
	   (funcall --displaying-byte-compile-warnings-fn)
	 (condition-case error-info