tec
/
simple-comment-markup
1
0
Fork 0
Code Pull Requests Releases Activity

Support multiline and partial-line comments

This commit is contained in:
TEC 2023-07-07 01:26:09 +08:00
parent 3f9a71a80d
commit c7ab26c587
Signed by: tec
SSH Key Fingerprint: SHA256:eobz41Mnm0/iYWBvWThftS0ElEs1ftBr6jamutnXc/A
1 changed files with 89 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

129
simple-comment-markup.el
View File

@ -97,47 +97,96 @@ This must not include any capturing groups."
(lambda (a b) (lambda (a b)
(string-lessp (plist-get b :start) (plist-get a :start)))))) (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." "Return a font-lock construct for markup patterns from SET."
(let ((patterns (simple-comment-markup--get-patterns set))) (let ((patterns (simple-comment-markup--get-patterns set)))
(list (mapcar
(apply #'append (lambda (pattern)
(list (rx line-start (* blank) (literal comment-start))) (let* ((confounding-start-characters
(mapcar (delq nil
(lambda (pattern) (mapcar
(let* ((confounding-start-characters (lambda (pat)
(delq nil (and (> (length (plist-get pat :start))
(mapcar (length (plist-get pattern :start)))
(lambda (pat) (string= (plist-get pattern :start)
(and (> (length (plist-get pat :start)) (substring
(length (plist-get pattern :start))) (plist-get pat :start)
(string= (plist-get pattern :start) 0 (length (plist-get pattern :start))))
(substring (aref (plist-get pat :start)
(plist-get pat :start) (length (plist-get pattern :start)))))
0 (length (plist-get pattern :start)))) patterns)))
(aref (plist-get pat :start) (body-rx
(length (plist-get pattern :start))))) (or (plist-get pattern :body)
patterns))) (rx-to-string
(body-rx `(seq (not (any space ,@confounding-start-characters))
(or (plist-get pattern :body) (optional
(rx-to-string (*? not-newline)
`(seq (not (any space ,@confounding-start-characters)) (not space)))))))
(optional (cons
(*? not-newline) (rx (regexp simple-comment-markup-pre-rx)
(not space))))))) (group (literal (plist-get pattern :start)))
`((,(rx (regexp simple-comment-markup-pre-rx) (group (regexp body-rx))
(group (literal (plist-get pattern :start))) (group (literal (plist-get pattern :end)))
(group (regexp body-rx)) (regexp simple-comment-markup-post-rx))
(group (literal (plist-get pattern :end))) (plist-get pattern :face))))
(regexp simple-comment-markup-post-rx)) patterns)))
(beginning-of-line)
nil
(1 'simple-comment-markup-face t)
(2 '(face ,(plist-get pattern :face)) prepend)
(3 'simple-comment-markup-face t)))))
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 ;;;###autoload
(define-minor-mode simple-comment-markup-mode (define-minor-mode simple-comment-markup-mode
@ -146,8 +195,8 @@ This must not include any capturing groups."
:group 'simple-comment-markup :group 'simple-comment-markup
(cond (cond
(simple-comment-markup-mode (simple-comment-markup-mode
(setq simple-comment-markup--font-lock-keywords (setq simple-comment-markup--rx-patterns
(simple-comment-markup--construct-font-lock)) (simple-comment-markup--construct-rx-patterns))
(font-lock-add-keywords nil simple-comment-markup--font-lock-keywords 'append)) (font-lock-add-keywords nil simple-comment-markup--font-lock-keywords 'append))
(t (font-lock-remove-keywords nil simple-comment-markup--font-lock-keywords))) (t (font-lock-remove-keywords nil simple-comment-markup--font-lock-keywords)))
(save-restriction (save-restriction