Function: tuareg--show-paren

tuareg--show-paren is a natively compiled function defined in tuareg.el.

Signature

(tuareg--show-paren ORIG-FUN)

Documentation

Advice for show-paren-data-function to match comment delimiters.

Source Code

;; Defined in /nix/store/6mbh851dhnag8f92qfrlh9ckldzwf6c6-emacs-packages-deps/share/emacs/site-lisp/elpa/tuareg-20260626.936/tuareg.el
(defvar show-paren-data-function); Silence the byte-compiler

(defun tuareg--show-paren (orig-fun)
  "Advice for `show-paren-data-function' to match comment delimiters."
  (cond
   ;; Immediately after "*)"
   ((and (eq (char-before) ?\))
         (eq (char-before (1- (point))) ?*))
    (let* ((here-beg (- (point) 2))
           (ppss (save-excursion (syntax-ppss here-beg)))
           (comment-nesting (nth 4 ppss)))
      (cond
       (comment-nesting ; "*)" ends a comment
        (let* ((there-beg (if (= comment-nesting 1) (nth 8 ppss)
                            (save-excursion (forward-comment -1)
                                            (point))))
               (ofs (if (eq (char-after (+ there-beg 2)) ?*) 3 2)))
          (list here-beg (point) there-beg (+ there-beg ofs) nil)))
       ((nth 3 ppss); inside a string, don't consider "*)" as a closer
        nil)
       ;; Mismatch
       (t (list here-beg (point) here-beg (point) t)))))
   ;; Immediately before "(*"
   ((and (eq (char-after) ?\()
         (eq (char-after (1+ (point))) ?*))
    (save-excursion
      (let* ((here-beg (point))
             (ofs (if (eq (char-after (+ here-beg 2)) ?*) 3 2))
             (here-end (+ here-beg ofs))
             (ppss (syntax-ppss here-end)))
        (cond
         ((nth 4 ppss); "(*" starts a comment
          (if (progn (goto-char here-beg)
                     (forward-comment 1))
              (list here-beg here-end (- (point) 2) (point) nil)
            (list here-beg here-end here-beg here-end t)))
         ((nth 3 ppss); inside a string, don't consider "(*" as an opener
          nil)
         ;; Mismatch
         (t (list here-beg here-end here-beg here-end t))))))
   (t (funcall orig-fun))))