branch: externals/hyperbole
commit 8aee5dff97311f72cc208830349cd508d0371e29
Merge: 8e4d0ffb70 aa3b1481cb
Author: Robert Weiner <r...@gnu.org>
Commit: GitHub <nore...@github.com>
Merge pull request #740 from rswgnu/rsw
hyrolo.el - Add consult completion support; fix www.domain.com not
displaying; add :html-prefer-user-labels for HyWiki html publishing
---
ChangeLog | 44 ++++++++++++++++++++++++++++++
hsys-consult.el | 63 ++++++++++++++++++++++++++++++-------------
hsys-www.el | 12 +++++----
hyrolo.el | 78 +++++++++++++++++++++++++++++++++++------------------
hywiki.el | 7 ++---
test/hargs-tests.el | 4 +--
6 files changed, 154 insertions(+), 54 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 9ec6944e06..86b3fd57cf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,39 @@
+2025-06-02 Bob Weiner <r...@gnu.org>
+
+* hyrolo.el (hyrolo-kill): Add consult completion support.
+ (hyrolo-to): Get 'outline-regexp' value from (current-buffer)
+ not (get-buffer hyrolo-display-buffer) to fix bug when display buffer
+ does not exist.
+
+* 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-06-01 Mats Lidell <ma...@gnu.org>
* test/hy-test-helpers.el (hy-test-helpers:should-last-message): Change
@@ -21,6 +57,14 @@
2025-05-27 Bob Weiner <r...@gnu.org>
+* hsys-www.el (www-url): Fix bug where "www.google.com" would not actually
+ be sent to the browser for display even though recognized as a url. Had
+ to add "https://"; to the front of any such url.
+
+* hywiki.el (hywiki-org-make-publish-project-alist): Add
+ :html-prefer-user-labels t to make Org use normalized headlines as href
+ IDs.
+
* hypb.el (hypb:in-string-p): Fix 'texinfo-mode' string not returning a list
when 'range-flag' is given.
test/hypb-tests.el (hypb--in-string-p): Enable this test since fixed now.
diff --git a/hsys-consult.el b/hsys-consult.el
index 375931a073..47e328565c 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: 27-May-25 at 23:40:50 by Mats Lidell
+;; Last-Mod: 2-Jun-25 at 22:18:49 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -84,7 +84,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
@@ -94,6 +95,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)
@@ -124,6 +126,34 @@ 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.
+Suppress preview and return the selected \"file:line:line-contents\".
+
+GREP-FUNCTION must take these arguments: regexp max-matches path-list
+prompt."
+ (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;
@@ -211,21 +241,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
@@ -241,9 +267,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/hsys-www.el b/hsys-www.el
index 57c173d43d..a78c3ccaee 100644
--- a/hsys-www.el
+++ b/hsys-www.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 7-Apr-94 at 17:17:39 by Bob Weiner
-;; Last-Mod: 27-May-25 at 00:57:00 by Bob Weiner
+;; Last-Mod: 28-May-25 at 01:21:16 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -112,8 +112,10 @@ The variable, `browse-url-browser-function', customizes
the url browser that
is used. Valid values of this variable include `browse-url-default-browser'
and
`browse-url-generic'."
(interactive "sURL to follow: ")
- (or (stringp url)
- (error "(www-url): URL = `%s' but must be a string" url))
+ (unless (stringp url)
+ (error "(www-url): URL = `%s' but must be a string" url))
+ (unless (seq-position url ?:)
+ (setq url (concat "https://"; url)))
(if (or (functionp browse-url-browser-function)
;; May be a predicate alist of functions from which to select
(consp browse-url-browser-function))
@@ -141,12 +143,12 @@ are included as parameters in the mailto url."
(mailto (if (string-prefix-p "mailto:"; to) to (concat "mailto:"; to))))
;; Add subject if provided
(when subject
- (setq mailto (concat mailto "?subject=" (url-encode-string subject))))
+ (setq mailto (concat mailto "?subject=" (url-encode-url subject))))
;; Add body if provided
(when body
(unless subject
(setq mailto (concat mailto "?")))
- (setq mailto (concat mailto "&body=" (url-encode-string body))))
+ (setq mailto (concat mailto "&body=" (url-encode-url body))))
(hact 'www-url mailto)))
;;;###autoload
diff --git a/hyrolo.el b/hyrolo.el
index 1512caf89e..81dd05ec9e 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 23:47:02 by Mats Lidell
+;; Last-Mod: 2-Jun-25 at 23:27:51 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -382,7 +382,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
@@ -398,7 +398,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))
@@ -593,12 +594,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)))
@@ -610,6 +624,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)
@@ -900,8 +915,11 @@ With prefix argument, prompts for optional FILE to locate
entry within.
NAME may be of the form: parent/child to kill child below a parent entry
which begins with the parent string.
Return t if entry is killed, nil otherwise."
- (interactive "sKill rolo entry named: \nP")
- (if (or (not (stringp name)) (string-equal name "") (string-match "\\*"
name))
+ (interactive (list
+ (hsys-consult-grep-headlines-read-regexp
+ #'hyrolo-consult-grep "Kill rolo entry named")
+ current-prefix-arg))
+ (if (or (not (stringp name)) (string-empty-p name))
(error "(hyrolo-kill): Invalid name: `%s'" name))
(if (and (called-interactively-p 'interactive) current-prefix-arg)
(setq file (completing-read "Entry's File: "
@@ -911,7 +929,12 @@ Return t if entry is killed, nil otherwise."
(unless file
(setq file (car file-list)))
(save-excursion
- (if (hyrolo-to name file-list)
+ (if (if (and (fboundp 'consult-grep)
+ (string-match "\\([^ \t\n\r\"'`]*[^ \t\n\r:\"'`0-9]\\):
?\\([1-9][0-9]*\\)[ :]"
+ name))
+ (hyrolo-to (substring name (match-end 0))
+ (list (setq file (match-string-no-properties 1 name))))
+ (hyrolo-to name file-list))
(progn
(setq file (hypb:buffer-file-name))
(if (file-writable-p file)
@@ -1020,7 +1043,7 @@ or NAME is invalid, return nil."
(require 'markdown-mode)
;; Don't actually derive from `markdown-mode' to avoid its costly setup
- ;; but set its parent mode property to org-mode so `derived-mode-p' checks
+ ;; but set its parent mode property to `markdown-mode' so `derived-mode-p'
checks
;; will pass.
(put 'hyrolo-markdown-mode 'derived-mode-parent 'markdown-mode)
@@ -1520,22 +1543,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)
@@ -1543,8 +1570,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))
;;; ************************************************************************
@@ -2028,8 +2055,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 "^") "\\|"
@@ -2679,7 +2708,8 @@ begins or nil if not found."
(t (error "(hyrolo-to): Second argument must be a file or buffer,
not: `%s'" file-or-buf)))
(set-buffer (if (stringp file-or-buf)
- (or (get-file-buffer file-or-buf)
(hyrolo-find-file-noselect file-or-buf))
+ (or (get-file-buffer file-or-buf)
+ (hyrolo-find-file-noselect file-or-buf))
;; must be a buffer
file-or-buf))
(let ((case-fold-search t) (real-name name) (parent "") (level)
@@ -2722,7 +2752,7 @@ begins or nil if not found."
(setq found
(when (or (looking-at (buffer-local-value
'outline-regexp
- (get-buffer
hyrolo-display-buffer)))
+ (current-buffer)))
;; Jump to non-first line within an
entry
(progn (back-to-indentation)
(looking-at (regexp-quote
name))))
@@ -2930,12 +2960,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))
@@ -3357,7 +3381,7 @@ proper major mode."
(narrow-to-region start end))
(let ((font-lock-mode))
;; (message "%s" (hyrolo-cache-get-major-mode-from-pos
- ;; (funcall (if backward-flag '1- '1+) start)))
+ ;; (funcall (if backward-flag '1- '1+)
start)))
(if (and backward-flag (looking-at hyrolo-hdr-regexp))
(hyrolo-cache-set-major-mode (max (1- start) 1))
(hyrolo-cache-set-major-mode (min (1+ start)
(point-max))))
@@ -3375,7 +3399,7 @@ proper major mode."
(when (and (fboundp 'orgtbl-mode) orgtbl-mode)
;; Disable as overrides single letter keys
(orgtbl-mode 0))
- ;; Need to leave point on a visible character or since
+ ;; !! TODO: Need to leave point on a visible character or since
;; hyrolo uses reveal-mode, redisplay will rexpand
;; hidden entries to make point visible.
;; (hyrolo-back-to-visible-point)
@@ -3472,6 +3496,8 @@ Push (point-max) of `hyrolo-display-buffer' onto
`hyrolo--cache-major-mode-indexes'. Ensure MATCHED-BUF's
`major-mode' is stored in the hash table."
(with-current-buffer hyrolo-display-buffer
+ (unless (hash-table-p hyrolo--cache-major-mode-to-index-hasht)
+ (hyrolo--cache-initialize))
(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)
(buffer-local-value 'major-mode
matched-buf)))
diff --git a/hywiki.el b/hywiki.el
index 11872f0b4f..83fc41a824 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: 27-May-25 at 02:05:56 by Bob Weiner
+;; Last-Mod: 28-May-25 at 01:15:45 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -439,6 +439,7 @@ where PATH is the un-resolvable reference."
:html-postable-format '(("en" "<p class=\"author\">Author: %a (%e)</p>
<p class=\"last-mod\">Last Modified: %C</p>
<p class=\"creator\">%c</p>"))
+ :html-prefer-user-labels t
:makeindex nil
:publishing-directory hywiki-org-publishing-directory
:publishing-function hywiki-org-publishing-function
@@ -3540,13 +3541,13 @@ This must be called within a `save-excursion' or it may
move point."
"Return a unique reference for DATUM, as a string.
Like `org-export-get-reference' but uses modified heading strings as
link ids rather than generated ids. To form an id, spaces in headings
-are replaces with dashes and to make each id unique, heading parent
+are replaced with dashes and to make each id unique, heading parent
ids are prepended separated by '--'.
DATUM is either an element or an object. INFO is the current
export state, as a plist.
-References for the current document are stored in
+References for the current document are stored in the
`:internal-references' property. Its value is an alist with
associations of the following types:
diff --git a/test/hargs-tests.el b/test/hargs-tests.el
index 17b518e4b6..1a67828a68 100644
--- a/test/hargs-tests.el
+++ b/test/hargs-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 04-Feb-22 at 23:00:00
-;; Last-Mod: 25-Apr-25 at 19:57:44 by Mats Lidell
+;; Last-Mod: 2-Jun-25 at 23:48:30 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -44,7 +44,7 @@
(ert-deftest hargs-get-verify-extension-characters-+K ()
"Verify hyperbole extension character +K is indentified."
- (cl-letf (((symbol-function 'hargs:read) (lambda (prompt &optional a b c d)
"xyz")))
+ (cl-letf (((symbol-function 'hargs:read) (lambda (_prompt &optional _a _b _c
_d) "xyz")))
(should (string= (hargs:get "+K: ") "xyz"))))
(ert-deftest hargs-tests--sexpression-p ()
