branch: externals/hyperbole
commit 5339ee4415c7fff5b1c7d8377d16ca61e51898da
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
hyrolo.el - Add fast completion support for 'hyrolo-yank'
---
ChangeLog | 24 +++++++++++++++++
hsys-consult.el | 81 +++++++++++++++++++++++++++++++++++++--------------------
hsys-org.el | 13 ++++++---
hyrolo.el | 78 ++++++++++++++++++++++++++++++++++++------------------
hywiki.el | 13 ++++++---
5 files changed, 148 insertions(+), 61 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 624b898e65..28fbec07b3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,27 @@
+2025-05-26 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-set-display-buffer): Don't enable 'hyrolo-mode' when
+ within a `hyrolo-yank' command so that the yanked-to-buffer's mode
+ is not changed (since 'hyrolo-display-buffer' is set to this).
+ (hyrolo-add-match): Don't highlight any matches inserted by
+ 'hyrolo-yank'.
+ (hyrolo-yank): Add support for fast completion via 'consult-grep'.
+ (hyrolo-consult-yank-grep): Add to support above function.
+
+2025-05-25 Bob Weiner <r...@gnu.org>
+
+* hsys-consult.el (hsys-consult-selected-candidate): Add autoloaded function
+ to return the candidate selected from commands like 'hyrolo-consult-grep'.
+ (hsys-consult--grep-paths, hsys-consult-grep): Add
+ additional arg 'prompt' to change the first part of the 'consult-grep'
+ prompt.
+ (hsys-consult-org-roam-grep): Pass in a prompt to
+ 'hsys-consult--grep-paths' call.
+ hyrolo.el (hyrolo-consult-grep):
+ hywiki.el (hywiki-consult-grep):
+ hsys-org.el (hsys-org-consult-grep): Optionally pass in a prompt for the
+ 'hsys-consult-grep' call.
+
2025-05-23 Bob Weiner <r...@gnu.org>
* hywiki.el (hywiki-word-with-optional-suffix-regexp): Change #section
diff --git a/hsys-consult.el b/hsys-consult.el
index f894fcf0c1..9435ae6173 100644
--- a/hsys-consult.el
+++ b/hsys-consult.el
@@ -2,7 +2,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 4-Jul-24 at 09:57:18
-;; Last-Mod: 12-Jul-24 at 22:05:30 by Mats Lidell
+;; Last-Mod: 26-May-25 at 03:30:20 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -81,7 +81,7 @@
(kill-buffer buf))))))
;;;###autoload
-(defun hsys-consult-grep (grep-includes ripgrep-globs &optional regexp
max-matches path-list)
+(defun hsys-consult-grep (grep-includes ripgrep-globs &optional regexp
max-matches path-list prompt)
"Interactively search PATH-LIST with a consult package grep command.
With GREP-INCLUDES or RIPGREP-GLOBS file suffixes to include, search
@@ -90,7 +90,9 @@ for optional REGEXP up to MAX-MATCHES in PATH-LIST.
Use ripgrep (rg) if found, otherwise, plain grep. Initialize search with
optional REGEXP and interactively prompt for changes. Limit matches
per file to the absolute value of MAX-MATCHES, if given and not 0. If
-0, match to headlines only (lines that start with a '^[*#]+[ \t]+' regexp)."
+0, match to headlines only (lines that start with a '^[*#]+[ \t]+' regexp).
+With optional PROMPT string, use this as the first part of the grep prompt;
+omit any trailing colon and space in the prompt."
(unless (package-installed-p 'consult)
(package-install 'consult))
(require 'consult)
@@ -117,22 +119,7 @@ per file to the absolute value of MAX-MATCHES, if given
and not 0. If
path))
path-list)
path-list)))
- (hsys-consult--grep-paths paths regexp max-matches)))
-
-;;;###autoload
-(defun hsys-consult-org-grep-tags-p ()
- "When on an Org tag, return appropriate `consult-grep' function.
-Use `default-directory' and buffer name to determine which function to
-call."
- (when (hsys-org-at-tags-p)
- (cond ((hsys-org-directory-at-tags-p t)
- #'hsys-consult-org-grep-tags)
- ((hsys-org-roam-directory-at-tags-p t)
- #'hsys-consult-org-roam-grep-tags)
- ((hywiki-at-tags-p t)
- #'hsys-consult-hywiki-grep-tags)
- ((hyrolo-at-tags-p t)
- #'hsys-consult-hyrolo-grep-tags))))
+ (hsys-consult--grep-paths paths regexp max-matches prompt)))
(defun hsys-consult-grep-tags (org-consult-grep-function)
"When on an Org tag, call ORG-CONSULT-GREP-FUNCTION to find matches.
@@ -160,6 +147,21 @@ otherwise, just match to the single tag around point."
(interactive)
(hsys-consult-grep-tags #'hywiki-consult-grep))
+;;;###autoload
+(defun hsys-consult-org-grep-tags-p ()
+ "When on an Org tag, return appropriate `consult-grep' function.
+Use `default-directory' and buffer name to determine which function to
+call."
+ (when (hsys-org-at-tags-p)
+ (cond ((hsys-org-directory-at-tags-p t)
+ #'hsys-consult-org-grep-tags)
+ ((hsys-org-roam-directory-at-tags-p t)
+ #'hsys-consult-org-roam-grep-tags)
+ ((hywiki-at-tags-p t)
+ #'hsys-consult-hywiki-grep-tags)
+ ((hyrolo-at-tags-p t)
+ #'hsys-consult-hyrolo-grep-tags))))
+
(defun hsys-consult-org-grep-tags ()
"When on an `org-directory' tag, use `consult-grep' to list dir tag matches.
If on a colon, match to sections with all tags around point;
@@ -194,7 +196,8 @@ that start with the '^[*#]+[ \t]*' regexp)."
(if (listp consult-ripgrep-args)
(append consult-ripgrep-args (list "--glob *.org"))
(concat consult-ripgrep-args " --glob *.org"))))
- (hsys-consult--grep-paths (list org-roam-directory) regexp
max-matches)))))
+ (hsys-consult--grep-paths (list org-roam-directory) regexp max-matches
+ "Grep Org Roam Nodes")))))
;;;###autoload
(defun hsys-consult-org-roam-title ()
@@ -204,11 +207,28 @@ that start with the '^[*#]+[ \t]*' regexp)."
(lambda ()
(org-roam-node-find nil nil (lambda (node) (zerop (org-roam-node-level
node)))))))
+;;;###autoload
+(defun hsys-consult-selected-candidate (consult-command &optional
no-properties-flag)
+ "Return the input from interactively calling CONSULT-COMMAND, a symbol.
+CONSULT-COMMAND is called with no arguments. Add optional
+NO-PROPERTIES-FLAG non-nil to strip the properties from the
+returned input string."
+ (unless (commandp consult-command)
+ (user-error "(hsys-consult-selected-candidate): First arg must be a
command, not `%s'" consult-command))
+ (save-excursion
+ (save-window-excursion
+ (cl-flet ((mapcar (lambda (state-function)
+ `(,state-function () cand))
+ (apropos-internal "consult--.+-state" #'fboundp)))
+ (if no-properties-flag
+ (substring-no-properties (or (call-interactively consult-command)
""))
+ (call-interactively consult-command))))))
+
;;; ************************************************************************
;;; Private functions
;;; ************************************************************************
-(defun hsys-consult--grep-paths (paths &optional regexp max-matches)
+(defun hsys-consult--grep-paths (paths &optional regexp max-matches prompt)
"Interactively search PATHS with a consult package grep command.
Use ripgrep (rg) if found, otherwise, plain grep. Interactively
show all matches from PATHS; see the documentation for the `dir'
@@ -216,8 +236,11 @@ argument in `consult-grep' for valid values of PATHS.
Initialize search with optional REGEXP and interactively prompt
for changes. Limit matches per file to the absolute value of
-MAX-MATCHES, if given and not 0. If 0, match to the start of
-headline text only (lines that start with a '^[*#]+[ \t]*' regexp)."
+optional MAX-MATCHES, if given and not 0. If 0, match to the
+start of headline text only (lines that start with a '^[*#]+[
+\t]*' regexp). With optional PROMPT string, use this as the first
+part of the grep prompt; omit any trailing colon and space in the
+prompt."
(unless (package-installed-p 'consult)
(package-install 'consult))
(require 'consult)
@@ -245,16 +268,18 @@ headline text only (lines that start with a '^[*#]+[
\t]*' regexp)."
(list (format "-m %d" (abs
max-matches))))
(concat consult-ripgrep-args
(format " -m %d" (abs
max-matches))))
- consult-ripgrep-args))
- (grep-func (cond ((executable-find "rg")
- #'consult-ripgrep)
- (t #'consult-grep))))
+ consult-ripgrep-args)))
;; Consult split style usually uses '#' as a separator char but
;; that interferes with matching to Markdown # chars at the start
;; of a line in the regexp, so disable the separator char as it is
;; not needed for simple regexp searches.
(let ((consult-async-split-style nil))
- (funcall grep-func paths regexp))))
+ (if (executable-find "rg")
+ (consult--grep (or prompt "Ripgrep")
+ #'consult--ripgrep-make-builder paths regexp)
+ (consult--grep (or prompt "Grep")
+ #'consult--grep-make-builder paths regexp)))))
+
(defun hsys-consult--org-grep-tags-string ()
"When on or between Org tags, return a `consult-grep' match string for them.
diff --git a/hsys-org.el b/hsys-org.el
index 9a9352a4ac..e30cde0634 100644
--- a/hsys-org.el
+++ b/hsys-org.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 2-Jul-16 at 14:54:14
-;; Last-Mod: 24-Apr-25 at 15:31:03 by Mats Lidell
+;; Last-Mod: 26-May-25 at 00:15:37 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -376,19 +376,24 @@ Do nothing if called outside of `org-mode'."
(org-meta-return))))
;;;###autoload
-(defun hsys-org-consult-grep (&optional regexp max-matches path-list)
+(defun hsys-org-consult-grep (&optional regexp max-matches path-list prompt)
"Interactively search `org-directory' with a consult package grep command.
Search for optional REGEXP up to MAX-MATCHES in PATH-LIST or `org-directory'.
Use ripgrep (rg) if found, otherwise, plain grep. Initialize search with
optional REGEXP and interactively prompt for changes. Limit matches
per file to the absolute value of MAX-MATCHES, if given and not 0. If
-0, match to headlines only (lines that start with a '^[*#]+[ \t]+' regexp)."
+0, match to headlines only (lines that start with a '^[*#]+[ \t]+' regexp).
+With optional PROMPT string, use this as the first part of the grep prompt;
+omit any trailing colon and space in the prompt."
(interactive "i\nP")
(let* ((grep-includes "--include *.org")
(ripgrep-globs "--glob *.org"))
(hsys-consult-grep grep-includes ripgrep-globs
- regexp max-matches (or path-list (list org-directory)))))
+ regexp max-matches (or path-list (list org-directory))
+ (or prompt (if (eq max-matches 0)
+ "Grep Org dir headlines"
+ "Grep Org dir")))))
;;;###autoload
(defun hsys-org-mode-p ()
diff --git a/hyrolo.el b/hyrolo.el
index ee39928599..a89764fb3c 100644
--- a/hyrolo.el
+++ b/hyrolo.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 7-Jun-89 at 22:08:29
-;; Last-Mod: 27-Apr-25 at 11:12:58 by Bob Weiner
+;; Last-Mod: 26-May-25 at 03:29:26 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -531,21 +531,26 @@ entry which begins with the parent string."
t))))
;;;###autoload
-(defun hyrolo-consult-grep (&optional regexp max-matches path-list)
+(defun hyrolo-consult-grep (&optional regexp max-matches path-list prompt)
"Interactively search paths with a consult package grep command.
Search for optional REGEXP up to MAX-MATCHES in PATH-LIST or
`hyrolo-file-list'.
Use ripgrep (rg) if found, otherwise, plain grep. Initialize search with
optional REGEXP and interactively prompt for changes. Limit matches
per file to the absolute value of MAX-MATCHES, if given and not 0. If
-0, match to headlines only (lines that start with a '^[*#]+[ \t]+' regexp)."
+0, match to headlines only (lines that start with a '^[*#]+[ \t]+' regexp).
+With optional PROMPT string, use this as the first part of the grep prompt;
+omit any trailing colon and space in the prompt."
(interactive "i\nP")
(let* ((grep-includes (concat "--include *.kot --include *.kotl"
" --include *.md --include *.markdown --include
*.mkd --include *.mdown --include *.mkdn --include *.mdwn"
" --include *.org --include *.otl --include
*.outl"))
(ripgrep-globs "--glob
*.{kot,kotl,md,markdown,mkd,mdown,mkdn,mdwn,org,otl,outl}"))
(hsys-consult-grep grep-includes ripgrep-globs
- regexp max-matches (or path-list hyrolo-file-list))))
+ regexp max-matches (or path-list hyrolo-file-list)
+ (or prompt (if (eq max-matches 0)
+ "Grep HyRolo headlines"
+ "Grep HyRolo files")))))
;;;###autoload
(defun hyrolo-display-matches (&optional display-buf return-to-buffer)
@@ -803,12 +808,13 @@ HEADLINE-ONLY searches only the first line of entries,
not the
full text. Optional NO-DISPLAY non-nil retrieves entries but
does not display.
-Nil value of MAX-MATCHES means find all entries that match, t value means find
-all matching entries but omit file headers, negative values mean find up to the
-inverse of that number of matching entries and omit file headers.
+Nil value of MAX-MATCHES means find all entries that match, t
+value means find all matching entries but omit file headers,
+negative values mean find up to the inverse of that number of
+matching entries and omit file headers.
-Return number of entries matched. See also documentation for the variable
-\`hyrolo-file-list'."
+Return number of entries matched. See also documentation for the
+variable \`hyrolo-file-list'."
(interactive "sFind rolo regular expression: \nP")
(unless (or (integerp max-matches) (memq max-matches '(nil t)))
(setq max-matches (prefix-numeric-value max-matches)))
@@ -1293,7 +1299,8 @@ Raise an error if a match is not found."
(defun hyrolo-set-display-buffer ()
"Set display buffer."
(prog1 (set-buffer (get-buffer-create hyrolo-display-buffer))
- (unless (eq major-mode 'hyrolo-mode)
+ (unless (or (eq major-mode 'hyrolo-mode)
+ (hyperb:stack-frame '(hyrolo-yank)))
(hyrolo-mode))
(setq buffer-read-only nil)))
@@ -1510,18 +1517,27 @@ hyrolo-file-list."
total-matches))
;;;###autoload
-(defun hyrolo-yank (name &optional regexp-p)
- "Insert at point the first rolo entry matching NAME.
-With optional prefix arg, REGEXP-P, treats NAME as a regular expression instead
-of a string."
- (interactive "sInsert rolo entry named: \nP")
+(defun hyrolo-yank (name &optional regexp-flag)
+ "Insert at point the first rolo entry with a headline containing NAME.
+With optional prefix arg, REGEXP-FLAG, treat NAME as a regular expression
+instead of a string."
+ (interactive (list
+ (if (featurep 'consult)
+ (hsys-consult-selected-candidate 'hyrolo-consult-yank-grep
t)
+ (read-string "Yank rolo headline matching: "))
+ current-prefix-arg))
(let ((hyrolo-display-buffer (current-buffer))
(start (point))
found)
(save-excursion
- (setq found (if regexp-p
- (hyrolo-grep name -1)
- (hyrolo-grep (regexp-quote name) -1))))
+ (setq found
+ (if (and (featurep 'consult)
+ (string-match "\\([^ \t\n\r\"'`]*[^ \t\n\r:\"'`0-9]\\):
?\\([1-9][0-9]*\\)[ :]"
+ name))
+ (hyrolo-grep-file (match-string-no-properties 1 name)
+ (regexp-quote (substring name (match-end 0)))
+ -1 nil t)
+ (hyrolo-grep (if regexp-flag name (regexp-quote name)) -1 nil nil
t))))
;; Let user reformat the region just yanked.
(if (= found 1)
(funcall hyrolo-yank-reformat-function start (point)))
@@ -2009,7 +2025,12 @@ Return number of matching entries found."
(set-buffer actual-buf)
(when (and headline-only
- (not (string-match (concat "\\`\\(" (regexp-quote "^")
"\\|" (regexp-quote "\\`") "\\)") pattern)))
+ (not (string-match (concat "\\`\\([*#]+[ \t]+\\|"
+ "\\\\\\*+[ \t]+\\|"
+ "#+[ \t]+\\|"
+ (regexp-quote "^") "\\|"
+ (regexp-quote "\\`") "\\)")
+ pattern)))
;; If matching only to headlines and pattern is not already
;; anchored to the beginning of lines, add a file-type-specific
;; headline prefix regexp to the pattern to match.
@@ -2243,12 +2264,12 @@ Calls the functions given by `hyrolo-mode-hook'.
(run-mode-hooks 'hyrolo-mode-hook))
(defun hyrolo-next-regexp-match (regexp)
- "In a HyRolo source buffer, Move past next occurrence of REGEXP.
+ "In a HyRolo source buffer, move past next occurrence of REGEXP.
When found, return the match start position; otherwise, return nil."
(when (re-search-forward regexp nil t)
(match-beginning 0)))
-;; The *HyRolo* buffer uses hyrolo-org-mode and hyrolo-markdown-mode
+;; The *HyRolo* buffer uses `hyrolo-org-mode' and `hyrolo-markdown-mode'
;; on Org and Markdown files that it reads to speed loading and
;; searching. This next function switches such buffers to their
;; normal modes whenever they are displayed.
@@ -2805,10 +2826,11 @@ Entry is inserted before point. The region is between
START to END."
(set-buffer (get-buffer-create hyrolo-display-buffer))
(setq opoint (point))
(insert (funcall hyrolo-display-format-function hyrolo-entry))
- (hyrolo-highlight-matches regexp opoint
- (if headline-only
- (save-excursion (goto-char opoint)
(line-end-position))
- (point)))
+ (unless (hyperb:stack-frame '(hyrolo-yank))
+ (hyrolo-highlight-matches regexp opoint
+ (if headline-only
+ (save-excursion (goto-char opoint)
(line-end-position))
+ (point))))
(set-buffer hyrolo-buf)))
(defun hyrolo-any-file-type-problem-p ()
@@ -2904,6 +2926,12 @@ HYROLO-BUF may be a file-name, `buffer-name', or buffer."
hyrolo-buf))
(buffer-list))))
+(defun hyrolo-consult-yank-grep ()
+ "Support function for `hyrolo-yank'."
+ (interactive)
+ (let ((consult-preview-key nil))
+ (hyrolo-consult-grep nil 0 nil "Yank rolo headline matching")))
+
(defun hyrolo-current-date ()
"Return the current date (a string) in a form used for rolo entry insertion."
(format-time-string hyrolo-date-format))
diff --git a/hywiki.el b/hywiki.el
index 627bc6d376..941df7ce50 100644
--- a/hywiki.el
+++ b/hywiki.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 21-Acpr-24 at 22:41:13
-;; Last-Mod: 23-May-25 at 02:39:29 by Bob Weiner
+;; Last-Mod: 26-May-25 at 00:16:02 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1453,19 +1453,24 @@ nil, else return \\='(page . \"<page-file-path>\")."
(or (hywiki-in-page-p) (string-prefix-p "*HyWiki Tags*"
(buffer-name)))))
;;;###autoload
-(defun hywiki-consult-grep (&optional regexp max-matches path-list)
+(defun hywiki-consult-grep (&optional regexp max-matches path-list prompt)
"Interactively search with a consult package grep command.
Search for optional REGEXP up to MAX-MATCHES in PATH-LIST or
`hywiki-directory'.
Use ripgrep (rg) if found, otherwise, plain grep. Initialize search with
optional REGEXP and interactively prompt for changes. Limit matches
per file to the absolute value of MAX-MATCHES, if given and not 0. If
-0, match to headlines only (lines that start with a '^[*#]+[ \t]+' regexp)."
+0, match to headlines only (lines that start with a '^[*#]+[ \t]+' regexp).
+With optional PROMPT string, use this as the first part of the grep prompt;
+omit any trailing colon and space in the prompt."
(interactive "i\nP")
(let* ((grep-includes "--include *.org")
(ripgrep-globs "--glob *.org"))
(hsys-consult-grep grep-includes ripgrep-globs
- regexp max-matches (or path-list (list
hywiki-directory)))))
+ regexp max-matches (or path-list (list hywiki-directory))
+ (or prompt (if (eq max-matches 0)
+ "Grep HyWiki dir headlines"
+ "Grep HyWiki dir")))))
(defun hywiki-convert-words-to-org-links ()
"Convert all highlighted HyWiki words in current buffer to Org links.
