- (list 'and
- 'byte-optimize
- '(memq byte-optimize-log '(t source))
- (list 'let '((print-escape-newlines t)
- (print-level 4)
- (print-length 4))
- (list 'byte-compile-log-1
- (cons 'format
- (cons format-string
- (mapcar
- (lambda (x)
- (if (symbolp x) (list 'prin1-to-string x) x))
- args)))))))
-
-(defconst byte-compile-last-warned-form nil)
-(defconst byte-compile-last-logged-file nil)
-
-(defvar byte-compile-last-line nil
- "Last known line number in the input.")
-
-
-(defun byte-compile-display-log-head-p ()
- (and (not (eq byte-compile-current-form :end))
- (or (and byte-compile-current-file
- (not (equal byte-compile-current-file
- byte-compile-last-logged-file)))
- (and byte-compile-last-warned-form
- (not (eq byte-compile-current-form
- byte-compile-last-warned-form))))))
-
-
-;; Log a message STRING in *Compile-Log*.
-;; Also log the current function and file if not already done.
-(defun byte-compile-log-1 (string &optional fill)
- (let* ((file (cond ((stringp byte-compile-current-file)
- (format "%s:" byte-compile-current-file))
+ `(and
+ byte-optimize
+ (memq byte-optimize-log '(t source))
+ (let ((print-escape-newlines t)
+ (print-level 4)
+ (print-length 4))
+ (byte-compile-log-1
+ (format
+ ,format-string
+ ,@(mapcar
+ (lambda (x) (if (symbolp x) (list 'prin1-to-string x) x))
+ 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.")
+
+;; copied from gnus-util.el
+(defsubst byte-compile-delete-first (elt list)
+ (if (eq (car list) elt)
+ (cdr list)
+ (let ((total list))
+ (while (and (cdr list)
+ (not (eq (cadr list) elt)))
+ (setq list (cdr list)))
+ (when (cdr list)
+ (setcdr list (cddr list)))
+ total)))
+
+;; The purpose of this function is to iterate through the
+;; `read-symbol-positions-list'. Each time we process, say, a
+;; function definition (`defun') we remove `defun' from
+;; `read-symbol-positions-list', and set `byte-compile-last-position'
+;; to that symbol's character position. Similarly, if we encounter a
+;; variable reference, like in (1+ foo), we remove `foo' from the
+;; list. If our current position is after the symbol's position, we
+;; assume we've already passed that point, and look for the next
+;; occurrence of the symbol.
+;;
+;; This function should not be called twice for the same occurrence of
+;; a symbol, and it should not be called for symbols generated by the
+;; byte compiler itself; because rather than just fail looking up the
+;; symbol, we may find an occurrence of the symbol further ahead, and
+;; then `byte-compile-last-position' as advanced too far.
+;;
+;; So your're probably asking yourself: Isn't this function a
+;; gross hack? And the answer, of course, would be yes.
+(defun byte-compile-set-symbol-position (sym &optional allow-previous)
+ (when byte-compile-read-position
+ (let (last entry)
+ (while (progn
+ (setq last byte-compile-last-position
+ entry (assq sym read-symbol-positions-list))
+ (when entry
+ (setq byte-compile-last-position
+ (+ byte-compile-read-position (cdr entry))
+ read-symbol-positions-list
+ (byte-compile-delete-first
+ entry read-symbol-positions-list)))
+ (or (and allow-previous (not (= last byte-compile-last-position)))
+ (> last byte-compile-last-position)))))))
+
+(defvar byte-compile-last-warned-form nil)
+(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)))