From 94bb411b31af9d50bca591fed0d9cbd666348f5b Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 16 Aug 2023 10:02:59 +0200 Subject: [PATCH 1/6] hl-todo-flymake: Fix and simplify, scan whole buffer Scan the whole buffer since Flymake does not move other diagnostics outside the changed region. Flymake is executed in an idle timer so performance should be acceptable. If not, we could try to cache the locations. --- hl-todo.el | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/hl-todo.el b/hl-todo.el index f6920f7..69484f1 100644 --- a/hl-todo.el +++ b/hl-todo.el @@ -375,30 +375,25 @@ Also see option `hl-todo-keyword-faces'." (rgrep regexp files dir confirm)) ;;;###autoload -(defun hl-todo-flymake (report-fn &rest plist) +(defun hl-todo-flymake (report-fn &rest _plist) "Flymake backend for `hl-todo-mode'. -Diagnostics are reported to REPORT-FN and additional options are -given as PLIST. Use `add-hook' to register this function in -`flymake-diagnostic-functions' before enabling `flymake-mode'." - (let (diags rbeg rend) +Diagnostics are reported to REPORT-FN. Use `add-hook' to +register this function in `flymake-diagnostic-functions' before +enabling `flymake-mode'." + (let (diags) (when hl-todo-mode (save-excursion (save-restriction (save-match-data - (goto-char (or (plist-get plist :changes-start) (point-min))) - (setq rbeg (pos-bol)) - (goto-char (or (plist-get plist :changes-end) (point-max))) - (setq rend (pos-eol)) - (goto-char rbeg) - (while (hl-todo--search nil rend) + (goto-char (point-min)) + (while (hl-todo--search) (let ((beg (match-beginning 0)) (end (pos-eol))) (push (flymake-make-diagnostic (current-buffer) beg end :note (buffer-substring-no-properties beg end)) diags))))))) - (apply report-fn (nreverse diags) - (and rbeg `(:region (,rbeg . ,rend)))))) + (funcall report-fn (nreverse diags)))) ;;;###autoload (defun hl-todo-insert (keyword) From e916bb0baf0b36d9f482291edd558f9a548a1431 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 16 Aug 2023 10:46:32 +0200 Subject: [PATCH 2/6] hl-todo-flymake: Use whole line if keyword is not at start of comment Use the whole line as diagnostic text if the keyword is not directly behind a comment. This heuristic gives a good result for the common cases. ;; TODO: Some task -> "TODO: Some task" ;; Text with TODO keyword -> "Text with TODO keyword" --- hl-todo.el | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/hl-todo.el b/hl-todo.el index 69484f1..605c74c 100644 --- a/hl-todo.el +++ b/hl-todo.el @@ -380,7 +380,9 @@ Also see option `hl-todo-keyword-faces'." Diagnostics are reported to REPORT-FN. Use `add-hook' to register this function in `flymake-diagnostic-functions' before enabling `flymake-mode'." - (let (diags) + (let ((diags nil) + (buf (current-buffer)) + (comment (concat (regexp-quote comment-start) "\\s-+"))) (when hl-todo-mode (save-excursion (save-restriction @@ -388,9 +390,22 @@ enabling `flymake-mode'." (goto-char (point-min)) (while (hl-todo--search) (let ((beg (match-beginning 0)) - (end (pos-eol))) + (end (pos-eol)) + (bol (pos-bol))) + ;; Take whole line when keyword is not at the start of comment + (save-excursion + (goto-char beg) + (unless (looking-back comment bol) + (goto-char bol) + ;; Skip whitespace at the beginning of line + (when (and (not (looking-at-p "\\S-")) + (re-search-forward "\\S-" beg t)) + (forward-char -1)) + ;; Skip comment + (re-search-forward comment beg t) + (setq beg (point)))) (push (flymake-make-diagnostic - (current-buffer) beg end :note + buf beg end :note (buffer-substring-no-properties beg end)) diags))))))) (funcall report-fn (nreverse diags)))) From 396b9a615a36674080b3f924bf0fe15efe3b65d5 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 16 Aug 2023 09:53:02 +0200 Subject: [PATCH 3/6] Optimize hl-todo--get-face Avoid costly allocation during iteration. --- hl-todo.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/hl-todo.el b/hl-todo.el index 605c74c..478b243 100644 --- a/hl-todo.el +++ b/hl-todo.el @@ -248,10 +248,13 @@ including alphanumeric characters, cannot be used here." (defun hl-todo--get-face () (let ((keyword (match-string 2))) (hl-todo--combine-face - (cdr (cl-find-if (lambda (elt) - (string-match-p (format "\\`%s\\'" (car elt)) - keyword)) - hl-todo-keyword-faces))))) + (cdr (or + ;; Fast allocation free lookup for literal keywords + (assoc keyword hl-todo-keyword-faces) + ;; Slower regexp lookup + (compat-call assoc keyword hl-todo-keyword-faces + (lambda (a b) + (string-match-p (format "\\`%s\\'" a) b)))))))) (defun hl-todo--combine-face (face) (if (stringp face) From 61e0f55a8a1d7c6150834909364f5abbd0519864 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 16 Aug 2023 09:15:22 +0200 Subject: [PATCH 4/6] Require cl-lib only at compile time --- hl-todo.el | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/hl-todo.el b/hl-todo.el index 478b243..9aa1dbc 100644 --- a/hl-todo.el +++ b/hl-todo.el @@ -50,10 +50,9 @@ ;;; Code: -(require 'cl-lib) (require 'compat) - (eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'cl-lib)) (defvar grep-find-template) (declare-function grep-read-files "grep" (regexp)) @@ -423,11 +422,11 @@ current line." (interactive (list (completing-read "Insert keyword: " - (cl-mapcan (pcase-lambda (`(,keyword . ,face)) - (and (equal (regexp-quote keyword) keyword) - (list (propertize keyword 'face - (hl-todo--combine-face face))))) - hl-todo-keyword-faces)))) + (mapcan (pcase-lambda (`(,keyword . ,face)) + (and (equal (regexp-quote keyword) keyword) + (list (propertize keyword 'face + (hl-todo--combine-face face))))) + hl-todo-keyword-faces)))) (cond ((hl-todo--inside-comment-or-string-p) (insert (concat (and (not (memq (char-before) '(?\s ?\t))) " ") From 9eaed725ecb3c49bd2fa4335c845931869566017 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 16 Aug 2023 09:35:07 +0200 Subject: [PATCH 5/6] Add missing doc strings --- hl-todo.el | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/hl-todo.el b/hl-todo.el index 9aa1dbc..37844ff 100644 --- a/hl-todo.el +++ b/hl-todo.el @@ -197,9 +197,12 @@ including alphanumeric characters, cannot be used here." (defvar-local hl-todo--keywords nil) (defun hl-todo--regexp () + "Return regular expression matching TODO or similar keyword." (or hl-todo--regexp (hl-todo--setup-regexp))) (defun hl-todo--setup-regexp () + "Setup keyword regular expression. +See the function `hl-todo--regexp'." (when-let ((bomb (assoc "???" hl-todo-keyword-faces))) ;; If the user customized this variable before we started to ;; treat the strings as regexps, then the string "???" might @@ -227,6 +230,9 @@ including alphanumeric characters, cannot be used here." (defvar syntax-ppss-table) ; Silence Emacs 25's byte-compiler. (defun hl-todo--search (&optional regexp bound backward) + "Search for keyword REGEXP, optionally up to BOUND and BACKWARD. +If REGEXP is not given, it defaults to the return value of the +function `hl-todo--regexp'." (unless regexp (setq regexp hl-todo--regexp)) (cl-block nil @@ -242,9 +248,11 @@ including alphanumeric characters, cannot be used here." (cl-return nil)))))) (defun hl-todo--inside-comment-or-string-p () + "Check syntax state if point is located inside comment or string literal." (nth 8 (syntax-ppss))) (defun hl-todo--get-face () + "Return face for current keyword during font locking." (let ((keyword (match-string 2))) (hl-todo--combine-face (cdr (or @@ -255,12 +263,14 @@ including alphanumeric characters, cannot be used here." (lambda (a b) (string-match-p (format "\\`%s\\'" a) b)))))))) -(defun hl-todo--combine-face (face) - (if (stringp face) +(defun hl-todo--combine-face (color) + "Combine COLOR string with `hl-todo' default face. +If COLOR is a face symbol, do not combine, return COLOR instead." + (if (stringp color) `((,(if hl-todo-color-background :background :foreground) - ,face) + ,color) hl-todo) - face)) + color)) (defvar-keymap hl-todo-mode-map :doc "Keymap for `hl-todo-mode'.") @@ -282,6 +292,8 @@ including alphanumeric characters, cannot be used here." hl-todo-mode hl-todo--turn-on-mode-if-desired) (defun hl-todo--turn-on-mode-if-desired () + "Enable local minor mode `hl-todo-mode' if test succeeds. +Depends on `hl-todo-include-modes' and `hl-todo-exclude-modes'." (when (and (apply #'derived-mode-p hl-todo-include-modes) (not (apply #'derived-mode-p hl-todo-exclude-modes)) (not (bound-and-true-p enriched-mode))) @@ -418,7 +430,8 @@ enabling `flymake-mode'." If point is not inside a string or comment, then insert a new comment. If point is at the end of the line, then insert the comment there, otherwise insert it as a new line before the -current line." +current line. When called interactively the KEYWORD is read via +`completing-read'." (interactive (list (completing-read "Insert keyword: " From 0f943808ba8d742dd99f584ea68ca90f7659d6d3 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 16 Aug 2023 09:24:47 +0200 Subject: [PATCH 6/6] hl-todo--regexp: Use defsubst Optimization; Access the variable hl-todo--regexp only via the corresponding function, which ensures that the variable is initialized. --- hl-todo.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/hl-todo.el b/hl-todo.el index 37844ff..a073090 100644 --- a/hl-todo.el +++ b/hl-todo.el @@ -196,7 +196,7 @@ including alphanumeric characters, cannot be used here." (defvar-local hl-todo--regexp nil) (defvar-local hl-todo--keywords nil) -(defun hl-todo--regexp () +(defsubst hl-todo--regexp () "Return regular expression matching TODO or similar keyword." (or hl-todo--regexp (hl-todo--setup-regexp))) @@ -219,7 +219,6 @@ See the function `hl-todo--regexp'." "\\)"))) (defun hl-todo--setup () - (hl-todo--setup-regexp) (setq hl-todo--keywords `((,(lambda (bound) (hl-todo--search nil bound)) (1 (hl-todo--get-face) prepend t)))) @@ -234,7 +233,7 @@ See the function `hl-todo--regexp'." If REGEXP is not given, it defaults to the return value of the function `hl-todo--regexp'." (unless regexp - (setq regexp hl-todo--regexp)) + (setq regexp (hl-todo--regexp))) (cl-block nil (while (let ((case-fold-search nil) (syntax-ppss-table (syntax-table)))