Merged from miles@gnu.org--gnu-2005 (patch 118-132, 551-577)

Patches applied:

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-551
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-552
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-553
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-554
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-555
   Remove CVS keywords from newsticker files

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-556
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-557
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-558
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-559
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-560
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-561
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-562
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-563
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-564
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-565
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-566
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-567
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-568
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-569
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-570
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-571
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-572
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-573
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-574
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-575
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-576
   Update from CVS

 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-577
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-118
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-119
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-120
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-121
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-122
   Update from CVS: lisp/mm-url.el (mm-url-decode-entities): Fix regexp.

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-123
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-124
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-125
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-126
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-127
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-128
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-129
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-130
   Update from CVS

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-131
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-132
   Update from CVS

git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-423

7 files changed, 108 insertions, 109 deletions

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 480c838b878..ce727c30d14 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2218,7 +2218,7 @@ which PREDICATE returns non-nil)."
   (let* ((ad-pReDiCaTe predicate)
 	 (function
 	  (completing-read
-	   (format "%s(default %s) " (or prompt "Function: ") default)
+	   (format "%s (default %s): " (or prompt "Function") default)
 	   ad-advised-functions
 	   (if predicate
 	       (function
@@ -2250,7 +2250,7 @@ class of FUNCTION)."
 		  (ad-do-return class)))
 	    (error "ad-read-advice-class: `%s' has no advices" function)))
   (let ((class (completing-read
-		(format "%s(default %s) " (or prompt "Class: ") default)
+		(format "%s (default %s): " (or prompt "Class") default)
 		ad-advice-class-completion-table nil t)))
     (if (equal class "")
 	default
@@ -2268,7 +2268,7 @@ An optional PROMPT is used to prompt for the name."
 	       (error "ad-read-advice-name: `%s' has no %s advice"
 		      function class)
 	     (car (car name-completion-table))))
-	 (prompt (format "%s(default %s) " (or prompt "Name: ") default))
+	 (prompt (format "%s (default %s): " (or prompt "Name") default))
 	 (name (completing-read prompt name-completion-table nil t)))
     (if (equal name "")
 	(intern default)
@@ -2289,9 +2289,9 @@ be used to prompt for the function."
 (defun ad-read-regexp (&optional prompt)
   "Read a regular expression from the minibuffer."
   (let ((regexp (read-from-minibuffer
-		 (concat (or prompt "Regular expression: ")
-			 (if (equal ad-last-regexp "") ""
-			   (format "(default \"%s\") " ad-last-regexp))))))
+		 (concat (or prompt "Regular expression")
+			 (if (equal ad-last-regexp "") ": "
+			   (format " (default %s): " ad-last-regexp))))))
     (setq ad-last-regexp
 	  (if (equal regexp "") ad-last-regexp regexp))))
 
@@ -2352,7 +2352,7 @@ FUNCTION was not advised)."
 
 (defun ad-enable-advice (function class name)
   "Enables the advice of FUNCTION with CLASS and NAME."
-  (interactive (ad-read-advice-specification "Enable advice of: "))
+  (interactive (ad-read-advice-specification "Enable advice of"))
   (if (ad-is-advised function)
       (if (eq (ad-enable-advice-internal function class name t) 0)
 	  (error "ad-enable-advice: `%s' has no %s advice matching `%s'"
@@ -2361,7 +2361,7 @@ FUNCTION was not advised)."
 
 (defun ad-disable-advice (function class name)
   "Disable the advice of FUNCTION with CLASS and NAME."
-  (interactive (ad-read-advice-specification "Disable advice of: "))
+  (interactive (ad-read-advice-specification "Disable advice of"))
   (if (ad-is-advised function)
       (if (eq (ad-enable-advice-internal function class name nil) 0)
 	  (error "ad-disable-advice: `%s' has no %s advice matching `%s'"
@@ -2385,7 +2385,7 @@ affected advices will be returned."
   "Enables all advices with names that contain a match for REGEXP.
 All currently advised functions will be considered."
   (interactive
-   (list (ad-read-regexp "Enable advices via regexp: ")))
+   (list (ad-read-regexp "Enable advices via regexp")))
   (let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
     (if (interactive-p)
 	(message "%d matching advices enabled" matched-advices))
@@ -2395,7 +2395,7 @@ All currently advised functions will be considered."
   "Disable all advices with names that contain a match for REGEXP.
 All currently advised functions will be considered."
   (interactive
-   (list (ad-read-regexp "Disable advices via regexp: ")))
+   (list (ad-read-regexp "Disable advices via regexp")))
   (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
     (if (interactive-p)
 	(message "%d matching advices disabled" matched-advices))
@@ -2405,7 +2405,7 @@ All currently advised functions will be considered."
   "Remove FUNCTION's advice with NAME from its advices in CLASS.
 If such an advice was found it will be removed from the list of advices
 in that CLASS."
-  (interactive (ad-read-advice-specification "Remove advice of: "))
+  (interactive (ad-read-advice-specification "Remove advice of"))
   (if (ad-is-advised function)
       (let* ((advice-to-remove (ad-find-advice function class name)))
 	(if advice-to-remove
@@ -3285,7 +3285,7 @@ should be modified.  The assembled function will be returned."
 Clear the cache if you want to force `ad-activate' to construct a new
 advised definition from scratch."
   (interactive
-   (list (ad-read-advised-function "Clear cached definition of: ")))
+   (list (ad-read-advised-function "Clear cached definition of")))
   (ad-set-advice-info-field function 'cache nil))
 
 (defun ad-make-cache-id (function)
@@ -3602,7 +3602,7 @@ an advised function that has actual pieces of advice but none of them are
 enabled is equivalent to a call to `ad-deactivate'.  The current advised
 definition will always be cached for later usage."
   (interactive
-   (list (ad-read-advised-function "Activate advice of: ")
+   (list (ad-read-advised-function "Activate advice of")
 	 current-prefix-arg))
   (if ad-activate-on-top-level
       ;; avoid recursive calls to `ad-activate':
@@ -3632,7 +3632,7 @@ definition of FUNCTION will be replaced with it.  All the advice
 information will still be available so it can be activated again with
 a call to `ad-activate'."
   (interactive
-   (list (ad-read-advised-function "Deactivate advice of: " 'ad-is-active)))
+   (list (ad-read-advised-function "Deactivate advice of" 'ad-is-active)))
   (if (not (ad-is-advised function))
       (error "ad-deactivate: `%s' is not advised" function)
     (cond ((ad-is-active function)
@@ -3650,7 +3650,7 @@ a call to `ad-activate'."
 See `ad-activate' for documentation on the optional COMPILE argument."
   (interactive
    (list (ad-read-advised-function
-	  "Update advised definition of: " 'ad-is-active)))
+	  "Update advised definition of" 'ad-is-active)))
   (if (ad-is-active function)
       (ad-activate function compile)))
 
@@ -3658,7 +3658,7 @@ See `ad-activate' for documentation on the optional COMPILE argument."
   "Deactivate FUNCTION and then remove all its advice information.
 If FUNCTION was not advised this will be a noop."
   (interactive
-   (list (ad-read-advised-function "Unadvise function: ")))
+   (list (ad-read-advised-function "Unadvise function")))
   (cond ((ad-is-advised function)
 	 (if (ad-is-active function)
 	     (ad-deactivate function))
@@ -3689,7 +3689,7 @@ This activates the advice for each function
 that has at least one piece of advice whose name includes a match for REGEXP.
 See `ad-activate' for documentation on the optional COMPILE argument."
   (interactive
-   (list (ad-read-regexp "Activate via advice regexp: ")
+   (list (ad-read-regexp "Activate via advice regexp")
 	 current-prefix-arg))
   (ad-do-advised-functions (function)
     (if (ad-find-some-advice function 'any regexp)
@@ -3700,7 +3700,7 @@ See `ad-activate' for documentation on the optional COMPILE argument."
 This deactivates the advice for each function
 that has at least one piece of advice whose name includes a match for REGEXP."
   (interactive
-   (list (ad-read-regexp "Deactivate via advice regexp: ")))
+   (list (ad-read-regexp "Deactivate via advice regexp")))
   (ad-do-advised-functions (function)
     (if (ad-find-some-advice function 'any regexp)
 	(ad-deactivate function))))
@@ -3711,7 +3711,7 @@ This reactivates the advice for each function
 that has at least one piece of advice whose name includes a match for REGEXP.
 See `ad-activate' for documentation on the optional COMPILE argument."
   (interactive
-   (list (ad-read-regexp "Update via advice regexp: ")
+   (list (ad-read-regexp "Update via advice regexp")
 	 current-prefix-arg))
   (ad-do-advised-functions (function)
     (if (ad-find-some-advice function 'any regexp)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 913ffcf1941..bab50a1c822 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1585,7 +1585,7 @@ mouse-[0-3]\\)\\)\\>"))
 		     ;; a prefix.
 		     (let ((disambiguate
 			    (completing-read
-			     "Disambiguating Keyword (default: variable): "
+			     "Disambiguating Keyword (default variable): "
 			     '(("function") ("command") ("variable")
 			       ("option") ("symbol"))
 			     nil t nil nil "variable")))
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 58b12376b05..2b47b139759 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -754,7 +754,7 @@ To specify a nil argument interactively, exit with an empty minibuffer."
   (interactive
    (list (let ((name
 		(completing-read
-		 "Cancel debug on entry to function (default: all functions): "
+		 "Cancel debug on entry to function (default all functions): "
 		 (mapcar 'symbol-name debug-function-list) nil t)))
 	   (when name
 	     (unless (string= name "")
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 4ae8f53a981..7712ab5af1c 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -103,37 +103,37 @@ truncated to make more of the arglist or documentation string visible."
 
 ;;; No user options below here.
 
-;; Commands after which it is appropriate to print in the echo area.
-;; Eldoc does not try to print function arglists, etc. after just any command,
-;; because some commands print their own messages in the echo area and these
-;; functions would instantly overwrite them.  But self-insert-command as well
-;; as most motion commands are good candidates.
-;; This variable contains an obarray of symbols; do not manipulate it
-;; directly.  Instead, use `eldoc-add-command' and `eldoc-remove-command'.
-(defvar eldoc-message-commands nil)
-
-;; This is used by eldoc-add-command to initialize eldoc-message-commands
-;; as an obarray.
-;; It should probably never be necessary to do so, but if you
-;; choose to increase the number of buckets, you must do so before loading
-;; this file since the obarray is initialized at load time.
-;; Remember to keep it a prime number to improve hash performance.
-(defvar eldoc-message-commands-table-size 31)
-
-;; Bookkeeping; elements are as follows:
-;;   0 - contains the last symbol read from the buffer.
-;;   1 - contains the string last displayed in the echo area for that
-;;       symbol, so it can be printed again if necessary without reconsing.
-;;   2 - 'function if function args, 'variable if variable documentation.
-(defvar eldoc-last-data (make-vector 3 nil))
+(defvar eldoc-message-commands-table-size 31
+  "This is used by eldoc-add-command to initialize eldoc-message-commands
+as an obarray.
+It should probably never be necessary to do so, but if you
+choose to increase the number of buckets, you must do so before loading
+this file since the obarray is initialized at load time.
+Remember to keep it a prime number to improve hash performance.")
+
+(defconst eldoc-message-commands
+  (make-vector eldoc-message-commands-table-size 0)
+  "Commands after which it is appropriate to print in the echo area.
+Eldoc does not try to print function arglists, etc. after just any command,
+because some commands print their own messages in the echo area and these
+functions would instantly overwrite them.  But self-insert-command as well
+as most motion commands are good candidates.
+This variable contains an obarray of symbols; do not manipulate it
+directly.  Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
+
+(defconst eldoc-last-data (make-vector 3 nil)
+  "Bookkeeping; elements are as follows:
+  0 - contains the last symbol read from the buffer.
+  1 - contains the string last displayed in the echo area for that
+      symbol, so it can be printed again if necessary without reconsing.
+  2 - 'function if function args, 'variable if variable documentation.")
 (defvar eldoc-last-message nil)
 
-;; eldoc's timer object.
-(defvar eldoc-timer nil)
+(defvar eldoc-timer nil "eldoc's timer object.")
 
-;; idle time delay currently in use by timer.
-;; This is used to determine if eldoc-idle-delay is changed by the user.
-(defvar eldoc-current-idle-delay eldoc-idle-delay)
+(defvar eldoc-current-idle-delay eldoc-idle-delay
+  "idle time delay currently in use by timer.
+This is used to determine if `eldoc-idle-delay' is changed by the user.")
 
 
 ;;;###autoload
@@ -408,53 +408,32 @@ Emacs Lisp mode) that support Eldoc.")
 ;; These functions do display-command table management.
 
 (defun eldoc-add-command (&rest cmds)
-  (or eldoc-message-commands
-      (setq eldoc-message-commands
-            (make-vector eldoc-message-commands-table-size 0)))
-
-  (let (name sym)
-    (while cmds
-      (setq name (car cmds))
-      (setq cmds (cdr cmds))
-
-      (cond ((symbolp name)
-             (setq sym name)
-             (setq name (symbol-name sym)))
-            ((stringp name)
-             (setq sym (intern-soft name))))
-
-      (and (symbolp sym)
-           (fboundp sym)
-           (set (intern name eldoc-message-commands) t)))))
+  (dolist (name cmds)
+    (and (symbolp name)
+         (setq name (symbol-name name)))
+    (set (intern name eldoc-message-commands) t)))
 
 (defun eldoc-add-command-completions (&rest names)
-  (while names
-    (apply 'eldoc-add-command
-	   (all-completions (car names) obarray 'fboundp))
-    (setq names (cdr names))))
+  (dolist (name names)
+    (apply 'eldoc-add-command (all-completions name obarray 'commandp))))
 
 (defun eldoc-remove-command (&rest cmds)
-  (let (name)
-    (while cmds
-      (setq name (car cmds))
-      (setq cmds (cdr cmds))
-
-      (and (symbolp name)
-           (setq name (symbol-name name)))
-
-      (unintern name eldoc-message-commands))))
+  (dolist (name cmds)
+    (and (symbolp name)
+         (setq name (symbol-name name)))
+    (unintern name eldoc-message-commands)))
 
 (defun eldoc-remove-command-completions (&rest names)
-  (while names
+  (dolist (name names)
     (apply 'eldoc-remove-command
-           (all-completions (car names) eldoc-message-commands))
-    (setq names (cdr names))))
+           (all-completions name eldoc-message-commands))))
 
 
 ;; Prime the command list.
 (eldoc-add-command-completions
- "backward-" "beginning-of-" "delete-other-windows" "delete-window"
- "end-of-" "exchange-point-and-mark" "forward-"
+ "backward-" "beginning-of-" "move-beginning-of-" "delete-other-windows"
+ "delete-window"
+ "end-of-" "move-end-of-" "exchange-point-and-mark" "forward-"
  "indent-for-tab-command" "goto-" "mark-page" "mark-paragraph"
  "mouse-set-point" "move-" "pop-global-mark" "next-" "other-window"
  "previous-" "recenter" "scroll-" "self-insert-command"
@@ -462,5 +441,5 @@ Emacs Lisp mode) that support Eldoc.")
 
 (provide 'eldoc)
 
-;;; arch-tag: c9a58f9d-2055-46c1-9b82-7248b71a8375
+;; arch-tag: c9a58f9d-2055-46c1-9b82-7248b71a8375
 ;;; eldoc.el ends here
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index d860bfcd598..dea72fc7567 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -260,7 +260,7 @@ in `load-path'."
       (setq function (symbol-function function)
 	    def (symbol-function function)))
     (if aliases
-	(message aliases))
+	(message "%s" aliases))
     (let ((library
 	   (cond ((eq (car-safe def) 'autoload)
 		  (nth 1 def))
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index b102b4da581..0fd49024beb 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -610,7 +610,7 @@ Prompts for bug subject TOPIC.  Leaves you in a mail buffer."
     (if version
 	(insert " version " version))
     (newline 2)
-    (message
+    (message "%s"
      (substitute-command-keys "Type \\[mail-send] to send bug report."))))
 
 (provide 'lisp-mnt)
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index e50d5bd125c..c93eb0e62c4 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -59,9 +59,9 @@
       (modify-syntax-entry ?\t "    " table)
       (modify-syntax-entry ?\f "    " table)
       (modify-syntax-entry ?\n ">   " table)
-;;; This is probably obsolete since nowadays such features use overlays.
-;;;      ;; Give CR the same syntax as newline, for selective-display.
-;;;      (modify-syntax-entry ?\^m ">   " table)
+      ;; This is probably obsolete since nowadays such features use overlays.
+      ;; ;; Give CR the same syntax as newline, for selective-display.
+      ;; (modify-syntax-entry ?\^m ">   " table)
       (modify-syntax-entry ?\; "<   " table)
       (modify-syntax-entry ?` "'   " table)
       (modify-syntax-entry ?' "'   " table)
@@ -82,8 +82,8 @@
   (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
     (modify-syntax-entry ?\[ "_   " table)
     (modify-syntax-entry ?\] "_   " table)
-    (modify-syntax-entry ?# "' 14bn" table)
-    (modify-syntax-entry ?| "\" 23b" table)
+    (modify-syntax-entry ?# "' 14b" table)
+    (modify-syntax-entry ?| "\" 23bn" table)
     table))
 
 (define-abbrev-table 'lisp-mode-abbrev-table ())
@@ -147,25 +147,45 @@
 (put 'define-ibuffer-filter 'doc-string-elt 2)
 (put 'define-ibuffer-op 'doc-string-elt 3)
 (put 'define-ibuffer-sorter 'doc-string-elt 2)
+(put 'lambda 'doc-string-elt 2)
+
+(defvar lisp-doc-string-elt-property 'doc-string-elt
+  "The symbol property that holds the docstring position info.")
 
 (defun lisp-font-lock-syntactic-face-function (state)
   (if (nth 3 state)
-      (if (and (eq (nth 0 state) 1)
-	       ;; This might be a docstring.
-	       (save-excursion
-		 (let ((n 0))
-		   (goto-char (nth 8 state))
-		   (condition-case nil
-		       (while (and (not (bobp))
-				   (progn (backward-sexp 1) (setq n (1+ n)))))
-		     (scan-error nil))
-		   (when (> n 0)
-		     (let ((sym (intern-soft
-				 (buffer-substring
-				  (point) (progn (forward-sexp 1) (point))))))
-		       (eq n (or (get sym 'doc-string-elt) 3)))))))
-	  font-lock-doc-face
-	font-lock-string-face)
+      ;; This might be a (doc)string or a |...| symbol.
+      (let ((startpos (nth 8 state)))
+        (if (eq (char-after startpos) ?|)
+            ;; This is not a string, but a |...| symbol.
+            nil
+          (let* ((listbeg (nth 1 state))
+                 (firstsym (and listbeg
+                                (save-excursion
+                                  (goto-char listbeg)
+                                  (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
+                                       (match-string 1)))))
+                 (docelt (and firstsym (get (intern-soft firstsym)
+                                            lisp-doc-string-elt-property))))
+            (if (and docelt
+                     ;; It's a string in a form that can have a docstring.
+                     ;; Check whether it's in docstring position.
+                     (save-excursion
+                       (when (functionp docelt)
+                         (goto-char (match-end 1))
+                         (setq docelt (funcall docelt)))
+                       (goto-char listbeg)
+                       (forward-char 1)
+                       (condition-case nil
+                           (while (and (> docelt 0) (< (point) startpos)
+                                       (progn (forward-sexp 1) t))
+                             (setq docelt (1- docelt)))
+                         (error nil))
+                       (and (zerop docelt) (<= (point) startpos)
+                            (progn (forward-comment (point-max)) t)
+                            (= (point) (nth 8 state)))))
+                font-lock-doc-face
+              font-lock-string-face))))
     font-lock-comment-face))
 
 ;; The LISP-SYNTAX argument is used by code in inf-lisp.el and is