branch: externals/hyperbole
commit 1736985befc90b3e5482a365bcfbd0a87229e735
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
hyrolo.el - Add consult completion support to `hyrolo-edit'
hyrolo-yank - Fix consult completion support.
hyrolo--cache-major-mode - Fix hash table cache initialization.
---
ChangeLog | 31 ++++++++++++++++++++++++++++++
hsys-consult.el | 59 +++++++++++++++++++++++++++++++++++++++------------------
hyrolo.el | 53 +++++++++++++++++++++++++++++++++------------------
3 files changed, 107 insertions(+), 36 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index bf4b1fec53..45715515b3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,34 @@
+2025-06-02 Bob Weiner <r...@gnu.org>
+
+* hsys-consult.el (hsys-consult-selected-candidate): Rewrite to fix byte
+ compilation errors.
+
+2025-06-01 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-grep-file): Fix to handle regexp-quoted asterisks, i.e.
+ "\\*". This fixes a bug where 'hyrolo-yank' did not match to entries
+ starting with multiple asterisks.
+ (hyrolo-edit): Add consult completion support.
+
+* hsys-consult.el (hsys-consult-selected-candidate): Rewrite to allow
non-command
+ functions that take arguments (so can send a prompt) and remove
+ 'no-properties-flag'. Use 'substring-no-properties' to handle that in a
+ separate call.
+ (hsys-consult-grep-headlines-read-regexp): Add.
+ hyrolo.el (hyrolo-consult-yank-grep): Generalize and rename to
+ 'hsys-consult-grep-headlines-with-prompt' in "hsys-consult.el".
+
+* hyrolo.el (hyrolo--cache-major-mode): Initialize hash table if not done
+ already. Fixes bug when 'hyrolo-grep' is called prior to init.
+ (hyrolo-yank): Fix to get for (fboundp 'consult-grep) rather than
+ (featurep 'consult) so that the consult package can be autoloaded. Also
+ add error handling if invalid 'name' value is given.
+ (hyrolo-consult-yank-grep): Add (require 'consult) before locally
+ disabling 'consult-preview-key' so do not get this error when consult
+ is loaded lower in the call stack:
+ (error "Defining as dynamic an already lexical var")
+ custom-declare-variable(consult-preview-key)
+
2025-05-27 Bob Weiner <r...@gnu.org>
* hsys-www.el (www-url): Fix bug where "www.google.com" would not actually
diff --git a/hsys-consult.el b/hsys-consult.el
index 9435ae6173..c1b8f0635a 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: 26-May-25 at 03:30:20 by Bob Weiner
+;; Last-Mod: 2-Jun-25 at 00:29:20 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -81,7 +81,8 @@
(kill-buffer buf))))))
;;;###autoload
-(defun hsys-consult-grep (grep-includes ripgrep-globs &optional regexp
max-matches path-list prompt)
+(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
@@ -91,6 +92,7 @@ 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).
+
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)
@@ -121,6 +123,30 @@ omit any trailing colon and space in the prompt."
path-list)))
(hsys-consult--grep-paths paths regexp max-matches prompt)))
+(defun hsys-consult-grep-headlines-with-prompt (grep-function prompt
+ &optional regexp)
+ "Call Hyperbole consult GREP-FUNCTION over headlines with PROMPT.
+Optional REGEXP is the initial pattern for the grep.
+Suppress preview and return the selected \"file:line:line-contents\".
+
+GREP-FUNCTION must take these arguments: regexp max-matches path-list
+prompt."
+ (let ((consult-preview-key nil))
+ (funcall grep-function regexp 0 nil prompt)))
+
+(defun hsys-consult-grep-headlines-read-regexp (grep-function prompt
+ &optional regexp)
+ "With `consult', completing read a string with GREP-FUNCTION and PROMPT.
+Optional REGEXP is the initial pattern for the grep."
+ (if (fboundp 'consult-grep)
+ (substring-no-properties
+ (hsys-consult-selected-candidate
+ #'hsys-consult-grep-headlines-with-prompt
+ grep-function
+ prompt
+ regexp))
+ (read-regexp (concat prompt ": ") regexp)))
+
(defun hsys-consult-grep-tags (org-consult-grep-function)
"When on an Org tag, call ORG-CONSULT-GREP-FUNCTION to find matches.
If on a colon, match to sections with all tags around point;
@@ -208,21 +234,17 @@ that start with the '^[*#]+[ \t]*' regexp)."
(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))
+(defun hsys-consult-selected-candidate (consult-function &rest args)
+ "Return the input from calling CONSULT-FUNCTION, a symbol, with rest of
ARGS."
+ (unless (fboundp consult-function)
+ (user-error "(hsys-consult-selected-candidate): First arg must be a bound
function, not `%s'"
+ consult-function))
(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))))))
+ (eval `(cl-flet ((mapcar (lambda (state-function)
+ `(,state-function () cand))
+ (apropos-internal "consult--.+-state"
#'fboundp)))
+ (apply ',consult-function ',args))))))
;;; ************************************************************************
;;; Private functions
@@ -238,9 +260,10 @@ Initialize search with optional REGEXP and interactively
prompt
for changes. Limit matches per file to the absolute value of
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."
+\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)
diff --git a/hyrolo.el b/hyrolo.el
index 4eaa16b0ef..70ed3c9c3d 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-May-25 at 01:22:36 by Bob Weiner
+;; Last-Mod: 1-Jun-25 at 23:31:09 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -381,7 +381,7 @@ String search expressions are converted to regular
expressions.")
;;;###autoload
(defun hyrolo-add (name &optional file)
- "Add a new entry in personal rolo for NAME.
+ "Add a new entry for NAME in the first file from `hyrolo-file-list'.
Last name first is best, e.g. \"Smith, John\".
With prefix argument, prompts for optional FILE to add entry within.
NAME may be of the form: parent/child to insert child below a parent
@@ -397,7 +397,8 @@ entry which begins with the parent string."
(or name email))))
(list (if (and email name
(string-match (concat "\\`" (regexp-quote entry)) name))
- (format hyrolo-email-format entry email) entry)
+ (format hyrolo-email-format entry email)
+ entry)
current-prefix-arg))))
(when (or (not (stringp name)) (string-equal name ""))
(error "(hyrolo-add): Invalid name: `%s'" name))
@@ -592,12 +593,25 @@ within which to locate entry. With no NAME arg, simply
display
FILE-OR-BUF or the first entry in `hyrolo-file-list' in an editable
mode. NAME may be of the form: parent/child to edit child below
a parent entry which begins with the parent string."
- (interactive "sEdit rolo entry named: \nP")
+ (interactive (list
+ (hsys-consult-grep-headlines-read-regexp
+ #'hyrolo-consult-grep "Edit rolo entry named")
+ current-prefix-arg))
(when (string-empty-p name)
(setq name nil))
(when (and name (not (stringp name)))
(error "(hyrolo-edit): Invalid name: `%s'" name))
+ ;; With consult-grep, 'name' is the entire line matched prefixed
+ ;; by filename and line number, so remove these prefixes.
+ (when (and name
+ (fboundp 'consult-grep)
+ (string-match "\\([^ \t\n\r\"'`]*[^ \t\n\r:\"'`0-9]\\):
?\\([1-9][0-9]*\\)[ :]"
+ name))
+ (setq file-or-buf (expand-file-name (match-string 1 name))
+ name (substring name (match-end 0)))
+ (put-text-property 0 1 'hyrolo-line-entry 0 name))
+
(let* ((found-point)
(all-files-or-bufs (hyrolo-get-file-list))
(file-or-buf-list (if file-or-buf (list file-or-buf)
all-files-or-bufs)))
@@ -609,6 +623,7 @@ a parent entry which begins with the parent string."
(mapcar #'list all-files-or-bufs)))))
(unless file-or-buf
(setq file-or-buf (car file-or-buf-list)))
+
(if (or (null name)
(setq found-point (hyrolo-to name (list file-or-buf))))
(cond ((stringp file-or-buf)
@@ -1519,22 +1534,26 @@ hyrolo-file-list."
;;;###autoload
(defun hyrolo-yank (name &optional regexp-flag)
"Insert at point the first rolo entry with a headline containing NAME.
-If the `consult' package is loaded, interactively select and complete
+If the `consult' package is installed, interactively select and complete
the entry to be inserted.
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: "))
+ (hsys-consult-grep-headlines-read-regexp
+ #'hyrolo-consult-grep "Yank rolo headline matching")
current-prefix-arg))
+ (when (string-empty-p name)
+ (setq name nil))
+ (when (or (null name) (not (stringp name)))
+ (error "(hyrolo-yank): Invalid name: `%s'" name))
+
(let ((hyrolo-display-buffer (current-buffer))
(start (point))
found)
(save-excursion
(setq found
- (if (and (featurep 'consult)
+ (if (and (fboundp 'consult-grep)
(string-match "\\([^ \t\n\r\"'`]*[^ \t\n\r:\"'`0-9]\\):
?\\([1-9][0-9]*\\)[ :]"
name))
(hyrolo-grep-file (match-string-no-properties 1 name)
@@ -1542,8 +1561,8 @@ instead of a string."
-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)))
+ (when (= found 1)
+ (funcall hyrolo-yank-reformat-function start (point)))
found))
;;; ************************************************************************
@@ -2027,8 +2046,10 @@ Return number of matching entries found."
max-matches (- max-matches)))))
(set-buffer actual-buf)
+ ;; Allow for initial asterisks being regexp-quoted in
+ ;; string-match below.
(when (and headline-only
- (not (string-match (concat "\\`\\([*#]+[ \t]+\\|"
+ (not (string-match (concat "\\`\\([\\*#]+[ \t]+\\|"
"\\\\\\*+[ \t]+\\|"
"#+[ \t]+\\|"
(regexp-quote "^") "\\|"
@@ -2929,12 +2950,6 @@ 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))
@@ -3470,6 +3485,8 @@ Push (point-max) of `hyrolo-display-buffer' onto
`hyrolo--cache-loc-match-bounds'. Push hash table's index key to
`hyrolo--cache-major-mode-indexes'. Ensure MATCHED-BUF's
`major-mode' is stored in the hash table."
+ (unless (hash-table-p hyrolo--cache-major-mode-to-index-hasht)
+ (hyrolo--cache-initialize))
(with-current-buffer hyrolo-display-buffer
(let* ((matched-buf-file-name (buffer-local-value 'buffer-file-name
matched-buf))
(matched-buf-major-mode (or (hyrolo-major-mode-from-file-name
matched-buf-file-name)
