branch: elpa/tuareg
commit 1bd1b43c229d79136117180eedaea7ff81fa7512
Author: Mattias Engdegård <matti...@acm.org>
Commit: Mattias Engdegård <matti...@acm.org>
Rewrite doc comment fontifier as one big regexp
---
tuareg.el | 227 ++++++++++++++++++++++++++++++++------------------------------
1 file changed, 116 insertions(+), 111 deletions(-)
diff --git a/tuareg.el b/tuareg.el
index d13654d..2ce40fb 100644
--- a/tuareg.el
+++ b/tuareg.el
@@ -727,117 +727,122 @@ Regexp match data 0 points to the chars."
(save-excursion
(let ((case-fold-search nil))
(goto-char beg)
- (while (< (point) end)
- ;; Skip over plain text.
- (re-search-forward (rx point (+ (or (not (in "{}[]@\\<"))
- (seq "\\" (in "{}[]@")))))
- end t)
- (let ((start (point)))
- (cond
- ;; [...]
- ((eq (following-char) ?\[)
- ;; Fontify opening bracket.
- (put-text-property start (1+ start) 'face
- 'tuareg-font-lock-doc-markup-face)
- (forward-char)
- ;; Skip balanced set of brackets.
- (let ((level 1))
- (while (and (< (point) end)
- (re-search-forward (rx (? "\\") (in "[]"))
- end 'noerror)
- (let ((next (char-after (match-beginning 0))))
- (cond
- ((eq next ?\[)
- (setq level (1+ level))
- t)
- ((eq next ?\])
- (setq level (1- level))
- (if (> level 0)
- t
- (forward-char -1)
- nil))
- (t t)))))
- (put-text-property (1+ start) (point) 'face
- tuareg-font-lock-doc-code-face)
- (if (> level 0)
- ;; Highlight unbalanced opening bracket.
- (put-text-property start (1+ start) 'face
- 'tuareg-font-lock-error-face)
- ;; Fontify closing bracket.
- (put-text-property (point) (1+ (point)) 'face
- 'tuareg-font-lock-doc-markup-face)
- (forward-char 1))))
-
- ;; Unbalanced "]"
- ((eq (following-char) ?\])
- (put-text-property start (1+ start) 'face
- 'tuareg-font-lock-error-face)
- (forward-char 1))
-
- ;; @-tags.
- ((looking-at (rx "@" (group (+ (in "a-z" "_")))))
- (put-text-property start (match-end 0) 'face
- 'tuareg-font-lock-doc-markup-face)
- (goto-char (match-end 0))
- ;; Use code face for the first argument of some tags.
- (when (and (member (match-string 1) '("param" "raise" "before"))
- (looking-at (rx (+ space)
- (group (+ (in "a-zA-Z0-9" "_.'-"))))))
- (put-text-property (match-beginning 1) (match-end 1) 'face
- tuareg-font-lock-doc-code-face)
- (goto-char (match-end 0))))
-
- ;; Cross-reference.
- ((looking-at (rx "{!"
- (? (or "tag" "module" "modtype" "class"
- "classtype" "val" "type"
- "exception" "attribute" "method"
- "section" "const" "recfield")
- ":")
- (group (* (in "a-zA-Z0-9" "_.'")))))
- (put-text-property start (match-beginning 1) 'face
- 'tuareg-font-lock-doc-markup-face)
- ;; Use code face for the reference.
- (put-text-property (match-beginning 1) (match-end 1) 'face
- tuareg-font-lock-doc-code-face)
- (goto-char (match-end 0)))
-
- ;; {v ... v}
- ((looking-at (rx "{v" (in " \t\n")))
- (put-text-property start (+ 3 start) 'face
- 'tuareg-font-lock-doc-markup-face)
- (forward-char 3)
- (let ((verbatim-end end))
- (when (re-search-forward (rx (in " \t\n") "v}")
- end 'noerror)
- (setq verbatim-end (match-beginning 0))
- (put-text-property verbatim-end (point) 'face
- 'tuareg-font-lock-doc-markup-face))
- (put-text-property (+ 3 start) verbatim-end 'face
- 'tuareg-font-lock-doc-verbatim-face)))
-
- ;; Other {} and <> markup.
- ((looking-at
- (rx (or (seq "{"
- (or (or "-" ":" "_" "^"
- "b" "i" "e" "C" "L" "R" "ul" "ol" "%")
- ;; Section header with optional label.
- (seq (+ digit)
- (? ":" (+ (in "a-zA-Z0-9" "_"))))
- ""))
- "}"
- ;; The HTML tags recognised by ocamldoc.
- (seq "<" (? "/")
- (or "b" "i" "code" "ul" "ol" "li"
- "center" "left" "right"
- (seq "h" (+ digit)))
- ">"))))
- (put-text-property start (match-end 0) 'face
- 'tuareg-font-lock-doc-markup-face)
- (goto-char (match-end 0)))
-
- ;; Anything else, to make forward progress.
- (t (forward-char 1))))))))
+ (while
+ (and
+ (< (point) end)
+ (re-search-forward
+ (rx
+ (or
+ (group-n 1 "[")
+ (group-n 2 "]")
+ (group-n 3 "@" (group-n 4 (+ (in "a-z" "_"))))
+ (group-n 5 "{"
+ (or
+ (group-n 6 "!"
+ (? (or "tag" "module" "modtype" "class"
+ "classtype" "val" "type"
+ "exception" "attribute" "method"
+ "section" "const" "recfield")
+ ":")
+ (group-n 7 (* (in "a-zA-Z0-9" "_.'"))))
+ (group-n 8 "v" (in " \t\n"))
+ (or (or "-" ":" "_" "^"
+ "b" "i" "e" "C" "L" "R"
+ "ul" "ol" "%"
+ "")
+ ;; Section header with optional label.
+ (seq (+ digit)
+ (? ":"
+ (+ (in "a-zA-Z0-9" "_")))))))
+ (group-n 9 "}")
+ (group-n 10 "<" (? "/")
+ (or "b" "i" "code" "ul" "ol" "li"
+ "center" "left" "right"
+ (seq "h" (+ digit)))
+ ">")
+ (seq "\\" (in "{}[]@"))))
+ end t)
+ (let ((start (match-beginning 0)))
+ (cond
+ ;; [ ... ]
+ ((match-beginning 1)
+ ;; Fontify opening bracket.
+ (put-text-property start (1+ start) 'face
+ 'tuareg-font-lock-doc-markup-face)
+ ;; Skip balanced set of brackets.
+ (let ((level 1))
+ (while (and (< (point) end)
+ (re-search-forward (rx (? "\\") (in "[]"))
+ end 'noerror)
+ (let ((next (char-after (match-beginning 0))))
+ (cond
+ ((eq next ?\[)
+ (setq level (1+ level))
+ t)
+ ((eq next ?\])
+ (setq level (1- level))
+ (if (> level 0)
+ t
+ (forward-char -1)
+ nil))
+ (t t)))))
+ (put-text-property (1+ start) (point) 'face
+ tuareg-font-lock-doc-code-face)
+ (if (> level 0)
+ ;; Highlight unbalanced opening bracket.
+ (put-text-property start (1+ start) 'face
+ 'tuareg-font-lock-error-face)
+ ;; Fontify closing bracket.
+ (put-text-property (point) (1+ (point)) 'face
+ 'tuareg-font-lock-doc-markup-face)
+ (forward-char 1))))
+
+ ;; Unbalanced "]"
+ ((match-beginning 2)
+ (put-text-property start (1+ start) 'face
+ 'tuareg-font-lock-error-face))
+
+ ;; @-tags.
+ ((match-beginning 3)
+ (put-text-property start (point) 'face
+ 'tuareg-font-lock-doc-markup-face)
+ ;; Use code face for the first argument of some tags.
+ (when (and (member (match-string 4)
+ '("param" "raise" "before"))
+ (looking-at (rx (+ space)
+ (group
+ (+ (in "a-zA-Z0-9" "_.'-"))))))
+ (put-text-property (match-beginning 1) (match-end 1) 'face
+ tuareg-font-lock-doc-code-face)
+ (goto-char (match-end 0))))
+
+ ;; Cross-reference.
+ ((match-beginning 6)
+ (put-text-property start (match-beginning 7) 'face
+ 'tuareg-font-lock-doc-markup-face)
+ ;; Use code face for the reference.
+ (put-text-property (match-beginning 7) (match-end 7) 'face
+ tuareg-font-lock-doc-code-face))
+
+ ;; {v ... v}
+ ((match-beginning 8)
+ (put-text-property start (+ 3 start) 'face
+ 'tuareg-font-lock-doc-markup-face)
+ (let ((verbatim-end end))
+ (when (re-search-forward (rx (in " \t\n") "v}")
+ end 'noerror)
+ (setq verbatim-end (match-beginning 0))
+ (put-text-property verbatim-end (point) 'face
+ 'tuareg-font-lock-doc-markup-face))
+ (put-text-property (+ 3 start) verbatim-end 'face
+ 'tuareg-font-lock-doc-verbatim-face)))
+
+ ;; Other {} and <> markup.
+ ((or (match-beginning 5) (match-beginning 9)
+ (match-beginning 10))
+ (put-text-property start (point) 'face
+ 'tuareg-font-lock-doc-markup-face)))
+ t))))))
nil)
(defun tuareg-font-lock-syntactic-face-function (state)
