Index: src/lread.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/lread.c,v
retrieving revision 1.284
diff -u -d -u -r1.284 lread.c
--- src/lread.c	20 May 2002 08:06:11 -0000	1.284
+++ src/lread.c	24 May 2002 19:11:28 -0000
@@ -133,6 +133,13 @@
 /* List of all DEFVAR_BOOL variables.  Used by the byte optimizer.  */
 Lisp_Object Vbyte_boolean_vars;
 
+/* Whether or not to add a `read-positions' property to symbols
+   read. */
+Lisp_Object Vread_with_symbol_positions;
+
+/* List of (SYMBOL . POSITION) accumulated so far. */
+Lisp_Object Vread_symbol_positions_list;
+
 /* List of descriptors now open for Fload.  */
 static Lisp_Object load_descriptor_list;
 
@@ -150,6 +157,9 @@
 /* Number of bytes left to read in the buffer character
    that `readchar' has already advanced over.  */
 static int readchar_backlog;
+/* Number of characters read in the current call to Fread or
+   Fread_from_string. */
+static int readchar_count;
 
 /* This contains the last string skipped with #@.  */
 static char *saved_doc_string;
@@ -202,8 +212,14 @@
    Write READCHAR to read a character,
    UNREAD(c) to unread c to be read again.
 
-   These macros actually read/unread a byte code, multibyte characters
-   are not handled here.  The caller should manage them if necessary.
+   The READCHAR and UNREAD macros are meant for reading/unreading a
+   byte code; they do not handle multibyte characters.  The caller
+   should manage them if necessary.
+   
+   [ Actually that seems to be a lie; READCHAR will definitely read
+     multibyte characters from buffer sources, at least.  Is the
+     comment just out of date?
+     -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
  */
 
 #define READCHAR readchar (readcharfun)
@@ -216,6 +232,8 @@
   Lisp_Object tem;
   register int c;
 
+  readchar_count++;
+  
   if (BUFFERP (readcharfun))
     {
       register struct buffer *inbuffer = XBUFFER (readcharfun);
@@ -335,6 +353,7 @@
      Lisp_Object readcharfun;
      int c;
 {
+  readchar_count--;
   if (c == -1)
     /* Don't back up the pointer if we're unreading the end-of-input mark,
        since readchar didn't advance it when we read it.  */
@@ -389,10 +408,20 @@
     call1 (readcharfun, make_number (c));
 }
 
-static Lisp_Object read0 (), read1 (), read_list (), read_vector ();
-static int read_multibyte ();
-static Lisp_Object substitute_object_recurse ();
-static void        substitute_object_in_subtree (), substitute_in_interval ();
+static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
+					    Lisp_Object));
+static Lisp_Object read0 P_ ((Lisp_Object));
+static Lisp_Object read1 P_ ((Lisp_Object, int *, int)); 
+
+static Lisp_Object read_list P_ ((int, Lisp_Object));
+static Lisp_Object read_vector P_ ((Lisp_Object, int));
+static int read_multibyte P_ ((int, Lisp_Object));
+
+static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
+						  Lisp_Object));
+static void substitute_object_in_subtree P_ ((Lisp_Object,
+					      Lisp_Object));
+static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
 
 
 /* Get a character from the tty.  */
@@ -1310,7 +1339,7 @@
 	  else if (! NILP (Vload_read_function))
 	    val = call1 (Vload_read_function, readcharfun);
 	  else
-	    val = read0 (readcharfun);
+	    val = read_internal_start (readcharfun, Qnil, Qnil);
 	}
 
       val = (*evalfun) (val);
@@ -1432,23 +1461,15 @@
      Lisp_Object stream;
 {
   extern Lisp_Object Fread_minibuffer ();
-
+  Lisp_Object tem;
   if (NILP (stream))
     stream = Vstandard_input;
   if (EQ (stream, Qt))
     stream = Qread_char;
-
-  readchar_backlog = -1;
-  new_backquote_flag = 0;
-  read_objects = Qnil;
-
   if (EQ (stream, Qread_char))
     return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
 
-  if (STRINGP (stream))
-    return Fcar (Fread_from_string (stream, Qnil, Qnil));
-
-  return read0 (stream);
+  return read_internal_start (stream, Qnil, Qnil);
 }
 
 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
@@ -1459,40 +1480,61 @@
      (string, start, end)
      Lisp_Object string, start, end;
 {
-  int startval, endval;
-  Lisp_Object tem;
-
   CHECK_STRING (string);
+  return Fcons (read_internal_start (string, start, end),
+		make_number (read_from_string_index));
+}
 
-  if (NILP (end))
-    endval = XSTRING (string)->size;
-  else
-    {
-      CHECK_NUMBER (end);
-      endval = XINT (end);
-      if (endval < 0 || endval > XSTRING (string)->size)
-	args_out_of_range (string, end);
-    }
-
-  if (NILP (start))
-    startval = 0;
-  else
-    {
-      CHECK_NUMBER (start);
-      startval = XINT (start);
-      if (startval < 0 || startval > endval)
-	args_out_of_range (string, start);
-    }
-
-  read_from_string_index = startval;
-  read_from_string_index_byte = string_char_to_byte (string, startval);
-  read_from_string_limit = endval;
+/* Function to set up the global context we need in toplevel read
+   calls. */
+static Lisp_Object
+read_internal_start (stream, start, end)
+     Lisp_Object stream;
+     Lisp_Object start; /* Only used when stream is a string. */
+     Lisp_Object end; /* Only used when stream is a string. */
+{
+  Lisp_Object retval;
 
+  readchar_backlog = -1;
+  readchar_count = 0;
   new_backquote_flag = 0;
   read_objects = Qnil;
+  if (EQ (Vread_with_symbol_positions, Qt)
+      || EQ (Vread_with_symbol_positions, stream))
+    Vread_symbol_positions_list = Qnil;
 
-  tem = read0 (string);
-  return Fcons (tem, make_number (read_from_string_index));
+  if (STRINGP (stream))
+    {
+      int startval, endval;
+      if (NILP (end))
+	endval = XSTRING (stream)->size;
+      else
+	{
+	  CHECK_NUMBER (end);
+	  endval = XINT (end);
+	  if (endval < 0 || endval > XSTRING (stream)->size)
+	    args_out_of_range (stream, end);
+	}
+
+      if (NILP (start))
+	startval = 0;
+      else
+	{
+	  CHECK_NUMBER (start);
+	  startval = XINT (start);
+	  if (startval < 0 || startval > endval)
+	    args_out_of_range (stream, start);
+	}
+      read_from_string_index = startval;
+      read_from_string_index_byte = string_char_to_byte (stream, startval);
+      read_from_string_limit = endval;
+    }
+      
+  retval = read0 (stream);
+  if (EQ (Vread_with_symbol_positions, Qt)
+      || EQ (Vread_with_symbol_positions, stream))
+    Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
+  return retval;
 }
 
 /* Use this for recursive reads, in contexts where internal tokens
@@ -1532,10 +1574,16 @@
   int len = 0;
   int bytes;
 
+  if (c < 0)
+    return c;
+
   str[len++] = c;
   while ((c = READCHAR) >= 0xA0
 	 && len < MAX_MULTIBYTE_LENGTH)
-    str[len++] = c;
+    {
+      str[len++] = c;
+      readchar_count--;
+    }
   UNREAD (c);
   if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))
     return STRING_CHAR (str, len);
@@ -2314,6 +2362,11 @@
 	     separate characters, treat them as separate characters now.  */
 	  ;
 
+	/* We want readchar_count to be the number of characters, not
+	   bytes.  Hence we adjust for multibyte characters in the
+	   string.  ... But it doesn't seem to be necessary, because
+	   READCHAR *does* read multibyte characters from buffers. */
+	/* readchar_count -= (p - read_buffer) - nchars; */
 	if (read_pure)
 	  return make_pure_string (read_buffer, nchars, p - read_buffer,
 				   is_multibyte);
@@ -2449,11 +2502,19 @@
 		return make_float (negative ? - value : value);
 	      }
 	  }
-
-	if (uninterned_symbol)
-	  return make_symbol (read_buffer);
-	else
-	  return intern (read_buffer);
+	{
+	  Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
+	    : intern (read_buffer);
+	  if (EQ (Vread_with_symbol_positions, Qt)
+	      || EQ (Vread_with_symbol_positions, readcharfun))
+	    Vread_symbol_positions_list = 
+	      /* Kind of a hack; this will probably fail if characters
+		 in the symbol name were escaped.  Not really a big
+		 deal, though.  */
+	      Fcons (Fcons (result, readchar_count - Flength (Fsymbol_name (result))),
+		     Vread_symbol_positions_list);
+	  return result;
+	}
       }
     }
 }
@@ -3632,6 +3693,35 @@
 	       doc: /* Stream for read to get input from.
 See documentation of `read' for possible values.  */);
   Vstandard_input = Qt;
+
+  DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
+	       doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
+
+If this variable is a buffer, then only forms read from that buffer
+will be added to `read-symbol-positions-list'.
+If this variable is t, then all read forms will be added.
+The effect of all other values other than nil are not currently
+defined, although they may be in the future.
+
+The positions are relative to the last call to `read' or
+`read-from-string'.  It is probably a bad idea to set this variable at
+the toplevel; bind it instead. */);
+  Vread_with_symbol_positions = Qnil;
+
+  DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
+	       doc: /* An list mapping read symbols to their positions.
+This variable is modified during calls to `read' or
+`read-from-string', but only when `read-with-symbol-positions' is
+non-nil.
+
+Each element of the list looks like (SYMBOL . CHAR-POSITION), where
+CHAR-POSITION is an integer giving the offset of that occurence of the
+symbol from the position where `read' or `read-from-string' started.
+
+Note that a symbol will appear multiple times in this list, if it was
+read multiple times.  The list is in the same order as the symbols
+were read in. */);
+  Vread_symbol_positions_list = Qnil;  
 
   DEFVAR_LISP ("load-path", &Vload_path,
 	       doc: /* *List of directories to search for files to load.
Index: lisp/emacs-lisp/bytecomp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/bytecomp.el,v
retrieving revision 2.96
diff -u -d -u -r2.96 bytecomp.el
--- lisp/emacs-lisp/bytecomp.el	24 Mar 2002 19:47:26 -0000	2.96
+++ lisp/emacs-lisp/bytecomp.el	24 May 2002 19:11:29 -0000
@@ -156,6 +156,7 @@
 ;;     Some versions of `file' can be customized to recognize that.
 
 (require 'backquote)
+(require 'cl)
 
 (or (fboundp 'defsubst)
     ;; This really ought to be loaded already!
@@ -380,6 +381,8 @@
   :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 +797,7 @@
 (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 +817,29 @@
 (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.")
 
+(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
+		  ;; FIXME: cl.el usage.  I really don't want to rewrite delete*
+		  ;; though.
+		  (delete* entry read-symbol-positions-list :count 1)))
+	       (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 +865,13 @@
 			      (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 +933,7 @@
   (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 +1083,17 @@
 	     (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 +1121,15 @@
 			    (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 +1139,23 @@
 		    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 +1257,13 @@
 	 (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 +1443,8 @@
 	      (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 +1452,8 @@
       (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 +1522,15 @@
     (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 +1541,9 @@
 (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 +1551,8 @@
 	(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 +1560,10 @@
 	(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 +1596,10 @@
 			       (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 +1984,7 @@
 	 (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 +2007,35 @@
 		 (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 +2224,8 @@
   (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 +2251,7 @@
 (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 +2267,7 @@
 			(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 +2478,8 @@
 (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 +2488,9 @@
 	((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 +2518,8 @@
   (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 +2569,8 @@
 (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 +2748,7 @@
 
 
 (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 +3215,7 @@
 ;; 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 +3262,10 @@
 	 (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 +3341,9 @@
 
 (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 +3370,7 @@
 	(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 +3400,7 @@
       `',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 +3414,7 @@
 ;; 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.