Function: tuareg-fontify-doc-comment

tuareg-fontify-doc-comment is a natively compiled function defined in tuareg.el.

Signature

(tuareg-fontify-doc-comment STATE)

Source Code

;; Defined in /nix/store/6mbh851dhnag8f92qfrlh9ckldzwf6c6-emacs-packages-deps/share/emacs/site-lisp/elpa/tuareg-20260626.936/tuareg.el
(defun tuareg-fontify-doc-comment (state)
  (let ((beg (nth 8 state))
        (end (save-excursion
               (parse-partial-sexp (point) (point-max) nil nil state
                                   'syntax-table)
               (point))))
    (put-text-property beg end 'face 'font-lock-doc-face)
    (when (and (eq (char-after (- end 2)) ?*)
               (eq (char-after (- end 1)) ?\)))
      (setq end (- end 2)))             ; stop before closing "*)"
    (save-excursion
      (let ((case-fold-search nil))
        (funcall
         (tuareg--syntax-rules
          ((rx (or "[" "{["))
           ;; Fontify opening bracket.
           (put-text-property start (point) 'face
                              'tuareg-font-lock-doc-markup-face)
           ;; Skip balanced set of brackets.
           (let ((start-end (point))
                 (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 start-end (point) 'face
                                tuareg-font-lock-doc-code-face)
             (if (> level 0)
                 ;; Highlight unbalanced opening bracket.
                 (put-text-property start start-end '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))))

          ((rx "]")
           (put-text-property start (1+ start) 'face
                              'tuareg-font-lock-error-face))

          ;; @-tag.
          ((rx "@" (group (or "author" "deprecated" "param" "raise" "return"
                              "see" "since" "before" "version"))
               word-end)
           (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 group)
                              '("param" "raise" "before"))
                      (looking-at (rx (+ space)
                                      (group
                                       (+ (in alpha "0-9" "_.'-"))))))
             (put-text-property (match-beginning 1) (match-end 1) 'face
                                tuareg-font-lock-doc-code-face)
             (goto-char (match-end 0))))

          ;; Cross-reference.
          ((rx (or "{!" "{{!")
               (? (or "tag" "module" "modtype" "class" "classtype" "val" "type"
                      "exception" "attribute" "method" "section" "const"
                      "recfield")
                  ":")
                (group (* (in alpha "0-9" "_.'"))))
           (put-text-property start (match-beginning group) 'face
                              'tuareg-font-lock-doc-markup-face)
           ;; Use code face for the reference.
           (put-text-property (match-beginning group) (match-end group) 'face
                              tuareg-font-lock-doc-code-face))

          ;; {v ... v}
          ((rx "{v" (in " \t\n"))
           (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 <..> constructs.
          ((rx (or (seq "{"
                        (or (or "-" ":" "_" "^"
                                "b" "i" "e" "C" "L" "R"
                                "ul" "ol" "%"
                                "{:")
                            ;; Section header with optional label.
                            (seq (+ digit)
                                 (? ":"
                                    (+ (in alpha "0-9" "_"))))))
                   "}"
                   ;; HTML-style tags
                   (seq "<" (? "/")
                        (or "b" "i" "code" "ul" "ol" "li"
                            "center" "left" "right"
                            (seq "h" (+ digit)))
                        ">")))
           (put-text-property start (point) 'face
                              'tuareg-font-lock-doc-markup-face))

          ;; Escaped syntax characters.
          ((rx "\\" (in "{}[]@"))))
         beg end))))
  nil)