(byte-compile-last-line): Deleted.

(byte-compile-delete-first): New function.
(byte-compile-read-position): New variable.
(byte-compile-last-position): New variable.
(byte-compile-current-buffer): New variable.
(byte-compile-log-1): Use it.
(byte-compile-set-symbol-position): New function.
(byte-compile-obsolete, byte-compile-callargs-warn)
(byte-compile-arglist-warn, byte-compile-arglist-warn)
(byte-compile-print-syms, byte-compile-file-form-defmumble)
(byte-compile-check-lambda-list, byte-compile-lambda)
(byte-compile-form, byte-compile-variable-ref)
(byte-compile-subr-wrong-args, byte-compile-negation-optimizer)
(byte-compile-condition-case, byte-compile-defun)
(byte-compile-defvar, byte-compile-autoload)
(byte-compile-lambda-form): Use it.
(byte-compile-from-buffer): Set it, and bind
`read-with-symbol-positions' and `read-symbol-positions-list'.
(byte-compile-debug): New variable.

2 files changed, 164 insertions, 66 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 571d66e41f5..5261d443980 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -3,8 +3,10 @@
         * textmodes/sgml-mode.el (xml-mode): New alias for `sgml-mode'.
 
         * emacs-lisp/bytecomp.el (byte-compile-last-line): Deleted.
+        (byte-compile-delete-first): New function.
         (byte-compile-read-position): New variable.
         (byte-compile-last-position): New variable.
+        (byte-compile-current-buffer): New variable.
         (byte-compile-log-1): Use it.
         (byte-compile-set-symbol-position): New function.
         (byte-compile-obsolete, byte-compile-callargs-warn)
@@ -19,6 +21,8 @@
         (byte-compile-from-buffer): Set it, and bind
         `read-with-symbol-positions' and `read-symbol-positions-list'.
 
+        * emacs-lisp/bytecomp.el (byte-compile-debug): New variable.
+
 2002-05-28  Kim F. Storm  <storm@cua.dk>
 
         * files.el (read-directory-name): New function.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f569a292816..9ec39ff339b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -10,7 +10,7 @@
 
 ;;; This version incorporates changes up to version 2.10 of the
 ;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "$Revision: 2.95 $")
+(defconst byte-compile-version "$Revision: 2.96 $")
 
 ;; This file is part of GNU Emacs.
 
@@ -380,6 +380,8 @@ specify different fields to sort on."
   :type '(choice (const name) (const callers) (const calls)
                  (const calls+callers) (const nil)))
 
+(defvar byte-compile-debug nil)
+
 ;; (defvar byte-compile-overwrite-file t
 ;;   "If nil, old .elc files are deleted before the new is saved, and .elc
 ;; files will have the same modes as the corresponding .el file.  Otherwise,
@@ -794,6 +796,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 (defvar byte-compile-current-form nil)
 (defvar byte-compile-dest-file nil)
 (defvar byte-compile-current-file nil)
+(defvar byte-compile-current-buffer nil)
 
 (defmacro byte-compile-log (format-string &rest args)
   (list 'and
@@ -813,9 +816,50 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
 (defvar byte-compile-last-warned-form nil)
 (defvar byte-compile-last-logged-file nil)
 
-(defvar byte-compile-last-line nil
-  "Last known line number in the input.")
-
+(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
+(defun 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
+;; occurence of the symbol.
+;; 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 nil))
+      (while (progn
+               (setq last byte-compile-last-position)
+               (let* ((entry (assq sym read-symbol-positions-list))
+                      (cur (cdr entry)))
+                 (setq byte-compile-last-position
+                       (if cur
+                           (+ byte-compile-read-position cur)
+                         last))
+                 (setq
+                  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)))))))
 
 (defun byte-compile-display-log-head-p ()
   (and (not (eq byte-compile-current-form :end))
@@ -841,8 +885,13 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                               (buffer-name byte-compile-current-file)))
                      (t "")))
          (pos (if (and byte-compile-current-file
-                       (integerp byte-compile-last-line))
-                  (format "%d:" byte-compile-last-line)
+                       (integerp byte-compile-read-position))
+                  (with-current-buffer byte-compile-current-buffer
+                    (format "%d:%d:" (count-lines (point-min)
+                                                  byte-compile-last-position)
+                            (save-excursion
+                              (goto-char byte-compile-last-position)
+                              (1+ (current-column)))))
                 ""))
          (form (or byte-compile-current-form "toplevel form")))
     (cond (noninteractive
@@ -904,6 +953,7 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
   (let* ((new (get (car form) 'byte-obsolete-info))
          (handler (nth 1 new))
          (when (nth 2 new)))
+    (byte-compile-set-symbol-position (car form))
     (if (memq 'obsolete byte-compile-warnings)
         (byte-compile-warn "%s is an obsolete function%s; %s" (car form)
                            (if when (concat " since " when) "")
@@ -1053,16 +1103,17 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
              (not (numberp (cdr sig))))
         (setcdr sig nil))
     (if sig
-        (if (or (< ncall (car sig))
+        (when (or (< ncall (car sig))
                 (and (cdr sig) (> ncall (cdr sig))))
-            (byte-compile-warn
-              "%s called with %d argument%s, but %s %s"
-              (car form) ncall
-              (if (= 1 ncall) "" "s")
-              (if (< ncall (car sig))
-                  "requires"
-                  "accepts only")
-              (byte-compile-arglist-signature-string sig)))
+          (byte-compile-set-symbol-position (car form))
+          (byte-compile-warn
+           "%s called with %d argument%s, but %s %s"
+           (car form) ncall
+           (if (= 1 ncall) "" "s")
+           (if (< ncall (car sig))
+               "requires"
+             "accepts only")
+           (byte-compile-arglist-signature-string sig)))
       (or (and (fboundp (car form))     ; might be a subr or autoload.
                (not (get (car form) 'byte-compile-noruntime)))
           (eq (car form) byte-compile-current-form) ; ## this doesn't work
@@ -1090,13 +1141,15 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                             (aref old 0)
                           '(&rest def)))))
               (sig2 (byte-compile-arglist-signature (nth 2 form))))
-          (or (byte-compile-arglist-signatures-congruent-p sig1 sig2)
-              (byte-compile-warn "%s %s used to take %s %s, now takes %s"
-                (if (eq (car form) 'defun) "function" "macro")
-                (nth 1 form)
-                (byte-compile-arglist-signature-string sig1)
-                (if (equal sig1 '(1 . 1)) "argument" "arguments")
-                (byte-compile-arglist-signature-string sig2))))
+          (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
+            (byte-compile-set-symbol-position (nth 1 form))
+            (byte-compile-warn
+             "%s %s used to take %s %s, now takes %s"
+             (if (eq (car form) 'defun) "function" "macro")
+             (nth 1 form)
+             (byte-compile-arglist-signature-string sig1)
+             (if (equal sig1 '(1 . 1)) "argument" "arguments")
+             (byte-compile-arglist-signature-string sig2))))
       ;; This is the first definition.  See if previous calls are compatible.
       (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
             nums sig min max)
@@ -1106,20 +1159,23 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
                     nums (sort (copy-sequence (cdr calls)) (function <))
                     min (car nums)
                     max (car (nreverse nums)))
-              (if (or (< min (car sig))
+              (when (or (< min (car sig))
                       (and (cdr sig) (> max (cdr sig))))
-                  (byte-compile-warn
-            "%s being defined to take %s%s, but was previously called with %s"
-                    (nth 1 form)
-                    (byte-compile-arglist-signature-string sig)
-                    (if (equal sig '(1 . 1)) " arg" " args")
-                    (byte-compile-arglist-signature-string (cons min max))))
+                (byte-compile-set-symbol-position (nth 1 form))
+                (byte-compile-warn
+                 "%s being defined to take %s%s, but was previously called with %s"
+                 (nth 1 form)
+                 (byte-compile-arglist-signature-string sig)
+                 (if (equal sig '(1 . 1)) " arg" " args")
+                 (byte-compile-arglist-signature-string (cons min max))))
 
               (setq byte-compile-unresolved-functions
                     (delq calls byte-compile-unresolved-functions)))))
       )))
 
 (defun byte-compile-print-syms (str1 strn syms)
+  (when syms
+    (byte-compile-set-symbol-position (car syms) t))
   (cond ((and (cdr syms) (not noninteractive))
          (let* ((str strn)
                 (L (length str))
@@ -1221,9 +1277,13 @@ Each function's symbol gets marked with the `byte-compile-noruntime' property."
          (byte-goto-log-buffer)
          (setq byte-compile-warnings-point-max (point-max))))
      (unwind-protect
-         (condition-case error-info
-             (progn ,@body)
-           (error (byte-compile-report-error error-info)))
+         (let ((--displaying-byte-compile-warnings-fn (lambda ()
+                                                        ,@body)))
+           (if byte-compile-debug
+               (funcall --displaying-byte-compile-warnings-fn)
+             (condition-case error-info
+                 (funcall --displaying-byte-compile-warnings-fn)
+               (error (byte-compile-report-error error-info)))))
        (with-current-buffer "*Compile-Log*"
          ;; If there were compilation warnings, display them.
          (unless (= byte-compile-warnings-point-max (point-max))
@@ -1403,8 +1463,8 @@ The value is non-nil if there were no errors, nil if errors."
               (condition-case nil (delete-file target-file) (error nil)))
           ;; We successfully didn't compile this file.
           'no-byte-compile)
-      (if byte-compile-verbose
-          (message "Compiling %s..." filename))
+      (when byte-compile-verbose
+        (message "Compiling %s..." filename))
       (setq byte-compiler-error-flag nil)
       ;; It is important that input-buffer not be current at this call,
       ;; so that the value of point set in input-buffer
@@ -1412,8 +1472,8 @@ The value is non-nil if there were no errors, nil if errors."
       (setq output-buffer (byte-compile-from-buffer input-buffer filename))
       (if byte-compiler-error-flag
           nil
-        (if byte-compile-verbose
-            (message "Compiling %s...done" filename))
+        (when byte-compile-verbose
+          (message "Compiling %s...done" filename))
         (kill-buffer input-buffer)
         (with-current-buffer output-buffer
           (goto-char (point-max))
@@ -1482,9 +1542,15 @@ With argument, insert value in current buffer after the form."
     (end-of-defun)
     (beginning-of-defun)
     (let* ((byte-compile-current-file nil)
+           (byte-compile-current-buffer (current-buffer))
+           (byte-compile-read-position (point))
+           (byte-compile-last-position byte-compile-read-position)
            (byte-compile-last-warned-form 'nothing)
-           (value (eval (displaying-byte-compile-warnings
-                         (byte-compile-sexp (read (current-buffer)))))))
+           (value (eval
+                   (let ((read-with-symbol-positions inbuffer)
+                         (read-symbol-positions-list nil))
+                     (displaying-byte-compile-warnings
+                      (byte-compile-sexp (read (current-buffer))))))))
       (cond (arg
              (message "Compiling from buffer... done.")
              (prin1 value (current-buffer))
@@ -1495,6 +1561,9 @@ With argument, insert value in current buffer after the form."
 (defun byte-compile-from-buffer (inbuffer &optional filename)
   ;; Filename is used for the loading-into-Emacs-18 error message.
   (let (outbuffer
+        (byte-compile-current-buffer inbuffer)
+        (byte-compile-read-position nil)
+        (byte-compile-last-position nil)
         ;; Prevent truncation of flonums and lists as we read and print them
         (float-output-format nil)
         (case-fold-search nil)
@@ -1502,8 +1571,8 @@ With argument, insert value in current buffer after the form."
         (print-level nil)
         ;; Prevent edebug from interfering when we compile
         ;; and put the output into a file.
-        (edebug-all-defs nil)
-        (edebug-all-forms nil)
+;;      (edebug-all-defs nil)
+;;      (edebug-all-forms nil)
         ;; Simulate entry to byte-compile-top-level
         (byte-compile-constants nil)
         (byte-compile-variables nil)
@@ -1511,6 +1580,10 @@ With argument, insert value in current buffer after the form."
         (byte-compile-depth 0)
         (byte-compile-maxdepth 0)
         (byte-compile-output nil)
+        ;; This allows us to get the positions of symbols read; it's
+        ;; new in Emacs 21.4.
+        (read-with-symbol-positions inbuffer)
+        (read-symbol-positions-list nil)
         ;;        #### This is bound in b-c-close-variables.
         ;;        (byte-compile-warnings (if (eq byte-compile-warnings t)
         ;;                                   byte-compile-warning-types
@@ -1543,9 +1616,10 @@ With argument, insert value in current buffer after the form."
                                (looking-at ";"))
                    (forward-line 1))
                  (not (eobp)))
-          (let ((byte-compile-last-line (count-lines (point-min) (point))))
-            (byte-compile-file-form (read inbuffer))))
-
+          (setq byte-compile-read-position (point)
+                byte-compile-last-position byte-compile-read-position)
+          (let ((form (read inbuffer)))
+            (byte-compile-file-form form)))
         ;; Compile pending forms at end of file.
         (byte-compile-flush-pending)
         (byte-compile-warn-about-unresolved-functions)
@@ -1930,7 +2004,7 @@ list that represents a doc string reference.
          (that-one (assq name (symbol-value that-kind)))
          (byte-compile-free-references nil)
          (byte-compile-free-assignments nil))
-
+    (byte-compile-set-symbol-position name)
     ;; When a function or macro is defined, add it to the call tree so that
     ;; we can tell when functions are not used.
     (if byte-compile-generate-call-tree
@@ -1953,34 +2027,35 @@ list that represents a doc string reference.
                  (nth 1 form)))
            (setcdr that-one nil))
           (this-one
-           (if (and (memq 'redefine byte-compile-warnings)
+           (when (and (memq 'redefine byte-compile-warnings)
                     ;; hack: don't warn when compiling the magic internal
                     ;; byte-compiler macros in byte-run.el...
                     (not (assq (nth 1 form)
                                byte-compile-initial-macro-environment)))
-               (byte-compile-warn "%s %s defined multiple times in this file"
-                                  (if macrop "macro" "function")
-                                  (nth 1 form))))
+             (byte-compile-warn "%s %s defined multiple times in this file"
+                                (if macrop "macro" "function")
+                                (nth 1 form))))
           ((and (fboundp name)
                 (eq (car-safe (symbol-function name))
                     (if macrop 'lambda 'macro)))
-           (if (memq 'redefine byte-compile-warnings)
-               (byte-compile-warn "%s %s being redefined as a %s"
-                                  (if macrop "function" "macro")
-                                  (nth 1 form)
-                                  (if macrop "macro" "function")))
+           (when (memq 'redefine byte-compile-warnings)
+             (byte-compile-warn "%s %s being redefined as a %s"
+                                (if macrop "function" "macro")
+                                (nth 1 form)
+                                (if macrop "macro" "function")))
            ;; shadow existing definition
            (set this-kind
                 (cons (cons name nil) (symbol-value this-kind))))
           )
     (let ((body (nthcdr 3 form)))
-      (if (and (stringp (car body))
-               (symbolp (car-safe (cdr-safe body)))
-               (car-safe (cdr-safe body))
-               (stringp (car-safe (cdr-safe (cdr-safe body)))))
-          (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
-                             (nth 1 form))))
-
+      (when (and (stringp (car body))
+                 (symbolp (car-safe (cdr-safe body)))
+                 (car-safe (cdr-safe body))
+                 (stringp (car-safe (cdr-safe (cdr-safe body)))))
+        (byte-compile-set-symbol-position (nth 1 form))
+        (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
+                           (nth 1 form))))
+    
     ;; Generate code for declarations in macro definitions.
     ;; Remove declarations from the body of the macro definition.
     (when macrop
@@ -2169,6 +2244,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (let (vars)
     (while list
       (let ((arg (car list)))
+        (when (symbolp arg)
+          (byte-compile-set-symbol-position arg))
         (cond ((or (not (symbolp arg))
                    (keywordp arg)
                    (memq arg '(t nil)))
@@ -2194,6 +2271,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-lambda (fun)
   (unless (eq 'lambda (car-safe fun))
     (error "Not a lambda list: %S" fun))
+  (byte-compile-set-symbol-position 'lambda)
   (byte-compile-check-lambda-list (nth 1 fun))
   (let* ((arglist (nth 1 fun))
          (byte-compile-bound-variables
@@ -2209,6 +2287,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                         (setq body (cdr body))))))
          (int (assq 'interactive body)))
     (cond (int
+           (byte-compile-set-symbol-position 'interactive)
            ;; Skip (interactive) if it is in front (the most usual location).
            (if (eq int (car body))
                (setq body (cdr body)))
@@ -2419,6 +2498,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-form (form &optional for-effect)
   (setq form (macroexpand form byte-compile-macro-environment))
   (cond ((not (consp form))
+         (when (symbolp form)
+           (byte-compile-set-symbol-position form))
          (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
                 (byte-compile-constant form))
                ((and for-effect byte-compile-delete-errors)
@@ -2427,8 +2508,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
         ((symbolp (car form))
          (let* ((fn (car form))
                 (handler (get fn 'byte-compile)))
-           (if (byte-compile-const-symbol-p fn)
-               (byte-compile-warn "%s called as a function" fn))
+           (byte-compile-set-symbol-position fn)
+           (when (byte-compile-const-symbol-p fn)
+             (byte-compile-warn "%s called as a function" fn))
            (if (and handler
                     (or (not (byte-compile-version-cond
                               byte-compile-compatibility))
@@ -2456,6 +2538,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (byte-compile-out 'byte-call (length (cdr form))))
 
 (defun byte-compile-variable-ref (base-op var)
+  (when (symbolp var)
+    (byte-compile-set-symbol-position var))
   (if (or (not (symbolp var)) (byte-compile-const-symbol-p var))
       (byte-compile-warn (if (eq base-op 'byte-varbind)
                              "attempt to let-bind %s %s"
@@ -2505,6 +2589,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 (defun byte-compile-constant (const)
   (if for-effect
       (setq for-effect nil)
+    (when (symbolp const)
+      (byte-compile-set-symbol-position const))
     (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
 
 ;; Use this for a constant that is not the value of its containing form.
@@ -2682,6 +2768,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 
 (defun byte-compile-subr-wrong-args (form n)
+  (byte-compile-set-symbol-position (car form))
   (byte-compile-warn "%s called with %d arg%s, but requires %s"
                      (car form) (length (cdr form))
                      (if (= 1 (length (cdr form))) "" "s") n)
@@ -3148,6 +3235,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; Even when optimization is off, /= is optimized to (not (= ...)).
 (defun byte-compile-negation-optimizer (form)
   ;; an optimizer for forms where <form1> is less efficient than (not <form2>)
+  (byte-compile-set-symbol-position (car form))
   (list 'not
     (cons (or (get (car form) 'byte-compile-negated-op)
               (error
@@ -3194,9 +3282,10 @@ If FORM is a lambda or a macro, byte-compile it as a function."
          (byte-compile-bound-variables
           (if var (cons var byte-compile-bound-variables)
             byte-compile-bound-variables)))
-    (or (symbolp var)
-        (byte-compile-warn
-         "%s is not a variable-name or nil (in condition-case)" var))
+    (byte-compile-set-symbol-position 'condition-case)
+    (unless (symbolp var)
+      (byte-compile-warn
+       "%s is not a variable-name or nil (in condition-case)" var))
     (byte-compile-push-constant var)
     (byte-compile-push-constant (byte-compile-top-level
                                  (nth 2 form) for-effect))
@@ -3272,7 +3361,9 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 
 (defun byte-compile-defun (form)
   ;; This is not used for file-level defuns with doc strings.
-  (unless (symbolp (car form))
+  (if (symbolp (car form))
+      (byte-compile-set-symbol-position (car form))
+    (byte-compile-set-symbol-position 'defun)
     (error "defun name must be a symbol, not %s" (car form)))
   (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
    (list 'fset (list 'quote (nth 1 form))
@@ -3299,6 +3390,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
         (var (nth 1 form))
         (value (nth 2 form))
         (string (nth 3 form)))
+    (byte-compile-set-symbol-position fun)
     (when (> (length form) 4)
       (byte-compile-warn
        "%s %s called with %d arguments, but accepts only %s"
@@ -3328,6 +3420,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       `',var))))
 
 (defun byte-compile-autoload (form)
+  (byte-compile-set-symbol-position 'autoload)
   (and (byte-compile-constp (nth 1 form))
        (byte-compile-constp (nth 5 form))
        (eval (nth 5 form))  ; macro-p
@@ -3341,6 +3434,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; Lambdas in valid places are handled as special cases by various code.
 ;; The ones that remain are errors.
 (defun byte-compile-lambda-form (form)
+  (byte-compile-set-symbol-position 'lambda)
   (error "`lambda' used as function name is invalid"))
 
 ;; Compile normally, but deal with warnings for the function being defined.