From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Wed, 5 Oct 2005 15:03:09 +0000 (+0000)
Subject: (lambda): Add its doc-string-elt property.
X-Git-Tag: emacs-pretest-22.0.90~6807
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f8ab194748b1293ab97bc45f8a5519fa9acce569;p=emacs.git

(lambda): Add its doc-string-elt property.
(lisp-doc-string-elt-property): New var.
(lisp-font-lock-syntactic-face-function): Use it.
Rewrite to recognize docstrings even for forms not at toplevel.
---

diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index b347c136adf..c9786ad68d3 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -147,25 +147,42 @@
 (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 (get sym 'doc-string-elt)))))))
-	  font-lock-doc-face
-	font-lock-string-face)
+      ;; This might be a docstring.
+      (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 passed to a macro that has docstrings.
+                 ;; Check whether it's in docstring position.
+                 (let ((startpos (nth 8 state)))
+                   (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