comparison lisp/emacs-lisp/bytecomp.el @ 83221:0fc4928cc48e

Merged in changes from CVS trunk. Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-616 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-617 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-618 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-619 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-620 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-621 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-622 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-623 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-624 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-625 Update from CVS * [e-mail]--gnu-2004/gnus--rel--5.10--patch-51 Update from CVS * [e-mail]--gnu-2004/gnus--rel--5.10--patch-52 Update from CVS * [e-mail]--gnu-2004/gnus--rel--5.10--patch-53 Merge from emacs--cvs-trunk--0 git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-261

83220:fe1db7935e1a

	  ;; and mark all the functions defined therein.
	  (while (and hist-new (not (eq hist-new hist-orig)))
	    (let ((xs (pop hist-new))
		  old-autoloads)
	      ;; Make sure the file was not already loaded before.
	      (unless (assoc (car xs) hist-orig)
		(dolist (s xs)
		  (cond
		   ((symbolp s)
		    (unless (memq s old-autoloads)
		      (push s byte-compile-noruntime-functions)))

	    (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
	      (let ((s (pop hist-nil-new)))
		(when (and (symbolp s) (not (memq s old-autoloads)))
		  (push s byte-compile-noruntime-functions))
		(when (and (consp s) (eq t (car s)))
		  (push (cdr s) old-autoloads))))))))))

(defun byte-compile-eval-before-compile (form)
  "Evaluate FORM for `eval-and-compile'."
  (let ((hist-nil-orig current-load-list))
    (prog1 (eval form)

	   args))))))

;; Log something that isn't a warning.
(defun byte-compile-log-1 (string)
  (with-current-buffer "*Compile-Log*"
    (goto-char (point-max))
    (byte-compile-warning-prefix nil nil)
    (cond (noninteractive
	   (message " %s" string))
	  (t
	   (insert (format "%s\n" string))))))

(defvar byte-compile-read-position nil
  "Character position we began the last `read' from.")
(defvar byte-compile-last-position nil
  "Last known character position in the input.")

(defvar byte-compile-last-logged-file nil)

;; This is used as warning-prefix for the compiler.
;; It is always called with the warnings buffer current.
(defun byte-compile-warning-prefix (level entry)
  (let* ((dir default-directory)
	 (file (cond ((stringp byte-compile-current-file)
		      (format "%s:" (file-relative-name byte-compile-current-file dir)))
		     ((bufferp byte-compile-current-file)
		      (format "Buffer %s:"
			      (buffer-name byte-compile-current-file)))

  (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
       (not noninteractive)
       (save-excursion
	 (set-buffer (get-buffer-create "*Compile-Log*"))
	 (goto-char (point-max))
	 (let* ((dir (and byte-compile-current-file
			  (file-name-directory byte-compile-current-file)))
		(was-same (equal default-directory dir))
		pt)
	   (when dir
	     (unless was-same

;; 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-type-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 format (apply 'format format args))

		 (eq (car (car tail)) 'lambda))
	    (setcar tail (byte-compile-lambda (car tail)))))
      (setq tail (cdr tail))))
  form)

(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
(defun byte-compile-file-form-eval-boundary (form)
  (let ((old-load-list current-load-list))
    (eval form)
    ;; (require 'cl) turns off warnings for cl functions.
    (let ((tem current-load-list))
      (while (not (eq tem old-load-list))
	(when (equal (car tem) '(require . cl))
	  (setq byte-compile-warnings
		(remq 'cl-functions byte-compile-warnings)))
	(setq tem (cdr tem)))))
  (byte-compile-keep-pending form 'byte-compile-normal-call))

(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)

83221:0fc4928cc48e

	  ;; and mark all the functions defined therein.
	  (while (and hist-new (not (eq hist-new hist-orig)))
	    (let ((xs (pop hist-new))
		  old-autoloads)
	      ;; Make sure the file was not already loaded before.
	      (unless (or (assoc (car xs) hist-orig)
			  (equal (car xs) "cl"))
		(dolist (s xs)
		  (cond
		   ((symbolp s)
		    (unless (memq s old-autoloads)
		      (push s byte-compile-noruntime-functions)))

	    (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
	      (let ((s (pop hist-nil-new)))
		(when (and (symbolp s) (not (memq s old-autoloads)))
		  (push s byte-compile-noruntime-functions))
		(when (and (consp s) (eq t (car s)))
		  (push (cdr s) old-autoloads)))))))
      (when (memq 'cl-functions byte-compile-warnings)
	(let ((hist-new load-history)
	      (hist-nil-new current-load-list))
	  ;; Go through load-history, look for newly loaded files
	  ;; and mark all the functions defined therein.
	  (while (and hist-new (not (eq hist-new hist-orig)))
	    (let ((xs (pop hist-new))
		  old-autoloads)
	      ;; Make sure the file was not already loaded before.
	      (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
		(byte-compile-find-cl-functions)))))))))

(defun byte-compile-eval-before-compile (form)
  "Evaluate FORM for `eval-and-compile'."
  (let ((hist-nil-orig current-load-list))
    (prog1 (eval form)

	   args))))))

;; Log something that isn't a warning.
(defun byte-compile-log-1 (string)
  (with-current-buffer "*Compile-Log*"
    (let ((inhibit-read-only t))
      (goto-char (point-max))
      (byte-compile-warning-prefix nil nil)
      (cond (noninteractive
	     (message " %s" string))
	    (t
	     (insert (format "%s\n" string)))))))

(defvar byte-compile-read-position nil
  "Character position we began the last `read' from.")
(defvar byte-compile-last-position nil
  "Last known character position in the input.")

(defvar byte-compile-last-logged-file nil)

;; This is used as warning-prefix for the compiler.
;; It is always called with the warnings buffer current.
(defun byte-compile-warning-prefix (level entry)
  (let* ((inhibit-read-only t)
	 (dir default-directory)
	 (file (cond ((stringp byte-compile-current-file)
		      (format "%s:" (file-relative-name byte-compile-current-file dir)))
		     ((bufferp byte-compile-current-file)
		      (format "Buffer %s:"
			      (buffer-name byte-compile-current-file)))

  (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
       (not noninteractive)
       (save-excursion
	 (set-buffer (get-buffer-create "*Compile-Log*"))
	 (goto-char (point-max))
	 (let* ((inhibit-read-only t)
		(dir (and byte-compile-current-file
			  (file-name-directory byte-compile-current-file)))
		(was-same (equal default-directory dir))
		pt)
	   (when dir
	     (unless was-same

;; 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-type-format "")
	(warning-fill-prefix (if fill "    "))
	(inhibit-read-only t))
    (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 format (apply 'format format args))

		 (eq (car (car tail)) 'lambda))
	    (setcar tail (byte-compile-lambda (car tail)))))
      (setq tail (cdr tail))))
  form)

(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
  (let ((old-load-list current-load-list)
	(args (mapcar 'eval (cdr form))))
    (apply 'require args)
    ;; Detech (require 'cl) in a way that works even if cl is already loaded.
    (if (member (car args) '("cl" cl))
	(setq byte-compile-warnings
	      (remq 'cl-functions byte-compile-warnings))))
  (byte-compile-keep-pending form 'byte-compile-normal-call))

(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)