Support multiline and partial-line comments
This commit is contained in:
parent
3f9a71a80d
commit
c7ab26c587
SSH Key Fingerprint:
SHA256:eobz41Mnm0/iYWBvWThftS0ElEs1ftBr6jamutnXc/A
|
|
@ -97,47 +97,96 @@ This must not include any capturing groups."
|
|||
(lambda (a b)
|
||||
(string-lessp (plist-get b :start) (plist-get a :start))))))
|
||||
|
||||
(defun simple-comment-markup--construct-font-lock (&optional set)
|
||||
(defvar-local simple-comment-markup--rx-patterns nil)
|
||||
|
||||
(defun simple-comment-markup--construct-rx-patterns (&optional set)
|
||||
"Return a font-lock construct for markup patterns from SET."
|
||||
(let ((patterns (simple-comment-markup--get-patterns set)))
|
||||
(list
|
||||
(apply #'append
|
||||
(list (rx line-start (* blank) (literal comment-start)))
|
||||
(mapcar
|
||||
(lambda (pattern)
|
||||
(let* ((confounding-start-characters
|
||||
(delq nil
|
||||
(mapcar
|
||||
(lambda (pat)
|
||||
(and (> (length (plist-get pat :start))
|
||||
(length (plist-get pattern :start)))
|
||||
(string= (plist-get pattern :start)
|
||||
(substring
|
||||
(plist-get pat :start)
|
||||
0 (length (plist-get pattern :start))))
|
||||
(aref (plist-get pat :start)
|
||||
(length (plist-get pattern :start)))))
|
||||
patterns)))
|
||||
(body-rx
|
||||
(or (plist-get pattern :body)
|
||||
(rx-to-string
|
||||
`(seq (not (any space ,@confounding-start-characters))
|
||||
(optional
|
||||
(*? not-newline)
|
||||
(not space)))))))
|
||||
`((,(rx (regexp simple-comment-markup-pre-rx)
|
||||
(group (literal (plist-get pattern :start)))
|
||||
(group (regexp body-rx))
|
||||
(group (literal (plist-get pattern :end)))
|
||||
(regexp simple-comment-markup-post-rx))
|
||||
(beginning-of-line)
|
||||
nil
|
||||
(1 'simple-comment-markup-face t)
|
||||
(2 '(face ,(plist-get pattern :face)) prepend)
|
||||
(3 'simple-comment-markup-face t)))))
|
||||
patterns)))))
|
||||
(mapcar
|
||||
(lambda (pattern)
|
||||
(let* ((confounding-start-characters
|
||||
(delq nil
|
||||
(mapcar
|
||||
(lambda (pat)
|
||||
(and (> (length (plist-get pat :start))
|
||||
(length (plist-get pattern :start)))
|
||||
(string= (plist-get pattern :start)
|
||||
(substring
|
||||
(plist-get pat :start)
|
||||
0 (length (plist-get pattern :start))))
|
||||
(aref (plist-get pat :start)
|
||||
(length (plist-get pattern :start)))))
|
||||
patterns)))
|
||||
(body-rx
|
||||
(or (plist-get pattern :body)
|
||||
(rx-to-string
|
||||
`(seq (not (any space ,@confounding-start-characters))
|
||||
(optional
|
||||
(*? not-newline)
|
||||
(not space)))))))
|
||||
(cons
|
||||
(rx (regexp simple-comment-markup-pre-rx)
|
||||
(group (literal (plist-get pattern :start)))
|
||||
(group (regexp body-rx))
|
||||
(group (literal (plist-get pattern :end)))
|
||||
(regexp simple-comment-markup-post-rx))
|
||||
(plist-get pattern :face))))
|
||||
patterns)))
|
||||
|
||||
(defvar-local simple-comment-markup--font-lock-keywords nil)
|
||||
(defun simple-comment-markup--fontify (&optional limit)
|
||||
"Apply comment markup up to LIMIT, based on `simple-comment-markup--rx-patterns'."
|
||||
(let ((syntax-ppss-table (syntax-table))
|
||||
(markup-start nil)
|
||||
(markup-end 0)
|
||||
(multiline nil))
|
||||
(while (re-search-forward (rx (syntax comment-start)) limit t)
|
||||
(when (nth 8 (syntax-ppss)) ; Inside comment or string
|
||||
(unless markup-start
|
||||
(setq markup-start (point)))
|
||||
(let ((continue t))
|
||||
(while continue
|
||||
(setq markup-end
|
||||
(max markup-end
|
||||
(simple-comment-markup--fontify-line limit)))
|
||||
(if (eobp)
|
||||
(setq continue nil)
|
||||
(forward-line 1)
|
||||
(setq continue (nth 8 (syntax-ppss)))
|
||||
(when (and continue (not multiline))
|
||||
(setq multiline
|
||||
(save-excursion
|
||||
(not
|
||||
(re-search-forward
|
||||
(rx point (syntax comment-start)) nil t))))))))))
|
||||
(when multiline
|
||||
(put-text-property markup-start markup-end 'font-lock-multiline t))
|
||||
(set-match-data (and markup-start (list markup-start markup-end)))))
|
||||
|
||||
(defun simple-comment-markup--fontify-line (&optional limit)
|
||||
"Apply comment markup up to LIMIT or the end of the current line."
|
||||
(let ((start (point))
|
||||
(max-end 0)
|
||||
(line-limit (min (or limit (point-max)) (line-end-position)))
|
||||
continue)
|
||||
(dolist (pattern simple-comment-markup--rx-patterns)
|
||||
(goto-char start)
|
||||
(setq continue t)
|
||||
(while continue
|
||||
(setq continue nil)
|
||||
(when (re-search-forward (car pattern) line-limit t)
|
||||
(setq continue (nth 8 (syntax-ppss)))
|
||||
(when continue
|
||||
(add-face-text-property
|
||||
(match-beginning 1) (match-end 1) 'simple-comment-markup-face)
|
||||
(add-face-text-property
|
||||
(match-beginning 2) (match-end 2) (cdr pattern))
|
||||
(add-face-text-property
|
||||
(match-beginning 3) (match-end 3) 'simple-comment-markup-face)
|
||||
(setq max-end (max max-end (match-end 0)))))))
|
||||
max-end))
|
||||
|
||||
(defvar simple-comment-markup--font-lock-keywords
|
||||
'((simple-comment-markup--fontify)))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode simple-comment-markup-mode
|
||||
|
|
@ -146,8 +195,8 @@ This must not include any capturing groups."
|
|||
:group 'simple-comment-markup
|
||||
(cond
|
||||
(simple-comment-markup-mode
|
||||
(setq simple-comment-markup--font-lock-keywords
|
||||
(simple-comment-markup--construct-font-lock))
|
||||
(setq simple-comment-markup--rx-patterns
|
||||
(simple-comment-markup--construct-rx-patterns))
|
||||
(font-lock-add-keywords nil simple-comment-markup--font-lock-keywords 'append))
|
||||
(t (font-lock-remove-keywords nil simple-comment-markup--font-lock-keywords)))
|
||||
(save-restriction
|
||||
|
|
|
|||
Loading…
Reference in New Issue