[Fix #402] Font-lock protocol method docstrings

Protocol method docstrings were rendered as regular strings instead of
with font-lock-doc-face. Detect them by checking if the string is the
last element in a method form inside a defprotocol.

Author: bbatsov

CHANGELOG.md

@@ -17,6 +17,7 @@
 
 ### Bugs fixed
 
+* [#402](https://github.com/clojure-emacs/clojure-mode/issues/402): Font-lock protocol method docstrings with `font-lock-doc-face`.
 * Fix typos in `clojure-mode-extra-font-locking`: `halt-when?` -> `halt-when`, `simple-indent?` -> `simple-ident?`.
 * Fix `doc` and `find-doc` misplaced under `clojure.core` instead of `clojure.repl` in extra font-locking.
 

clojure-mode.el

@@ -1213,30 +1213,44 @@ highlighted region)."
              (docelt (and firstsym
                           (function-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)
-                   (ignore-errors
-                     (while (and (> docelt 0) (< (point) startpos)
-                                 (progn (forward-sexp 1) t))
-                       ;; ignore metadata and type hints
-                       (unless (looking-at "[ \n\t]*\\(\\^[A-Z:].+\\|\\^?{.+\\)")
-                         (setq docelt (1- docelt)))))
-                   (and (zerop docelt) (<= (point) startpos)
-                        (progn (forward-comment (point-max)) t)
-                        (= (point) (nth 8 state))))
-                 ;; In a def, at last position is not a docstring
-                 (not (and (string= "def" firstsym)
-                           (save-excursion
-                             (goto-char startpos)
-                             (goto-char (end-of-thing 'sexp))
-                             (looking-at "[ \r\n\t]*\)")))))
+        (if (or (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)
+                       (ignore-errors
+                         (while (and (> docelt 0) (< (point) startpos)
+                                     (progn (forward-sexp 1) t))
+                           ;; ignore metadata and type hints
+                           (unless (looking-at "[ \n\t]*\\(\\^[A-Z:].+\\|\\^?{.+\\)")
+                             (setq docelt (1- docelt)))))
+                       (and (zerop docelt) (<= (point) startpos)
+                            (progn (forward-comment (point-max)) t)
+                            (= (point) (nth 8 state))))
+                     ;; In a def, at last position is not a docstring
+                     (not (and (string= "def" firstsym)
+                               (save-excursion
+                                 (goto-char startpos)
+                                 (goto-char (end-of-thing 'sexp))
+                                 (looking-at "[ \r\n\t]*\)")))))
+                ;; Protocol method docstring: string is last in the
+                ;; method form and parent form is defprotocol.
+                (and listbeg
+                     (save-excursion
+                       (goto-char startpos)
+                       (ignore-errors (forward-sexp))
+                       (skip-chars-forward " \t\n\r")
+                       (eq (char-after) ?\)))
+                     (save-excursion
+                       (let ((parent-beg (nth 1 (parse-partial-sexp
+                                                 (point-min) listbeg))))
+                         (and parent-beg
+                              (goto-char parent-beg)
+                              (looking-at "([ \t\n]*defprotocol\\>"))))))
             font-lock-doc-face
           font-lock-string-face))
     font-lock-comment-face))

test/clojure-mode-font-lock-test.el

@@ -1043,6 +1043,23 @@ DESCRIPTION is the description of the spec."
     ("*some-var?*"
      (1 11 font-lock-variable-name-face))))
 
+(describe "docstring font-locking"
+  (it "should font-lock defn docstrings"
+    (expect-face-at "(defn foo\n  \"docstring\"\n  [x] x)" 14 22 font-lock-doc-face))
+
+  (it "should font-lock defprotocol docstrings"
+    (expect-face-at "(defprotocol Foo\n  \"protocol doc\")" 21 32 font-lock-doc-face))
+
+  (it "should font-lock protocol method docstrings"
+    (expect-face-at "(defprotocol Foo\n  (bar [this]\n    \"method doc\"))" 37 46 font-lock-doc-face))
+
+  (it "should font-lock protocol method docstrings with multiple arities"
+    (expect-face-at "(defprotocol Foo\n  (bar [this] [this x]\n    \"method doc\"))" 46 55 font-lock-doc-face))
+
+  (it "should not font-lock regular strings in protocol methods as docstrings"
+    (expect-face-at "(defprotocol Foo\n  (bar [this]\n    \"not a doc\" \"method doc\"))"
+                    37 45 font-lock-string-face)))
+
 (provide 'clojure-mode-font-lock-test)
 
 ;;; clojure-mode-font-lock-test.el ends here