branch: externals/hyperbole
commit 29674ef91ab3fee73c9943c8b6e4ad7ece938144
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
hywiki.el, hsys-org.el - Fix a bunch of predicates and tests
---
ChangeLog | 29 +++++++++++++++++++++++
hmouse-tag.el | 4 ++--
hpath.el | 6 ++---
hsys-org.el | 62 ++++++++++++++++++++++++++++++++++++++++++--------
hywiki.el | 53 +++++++++++++++++++++++++++---------------
test/hsys-org-tests.el | 7 +++---
6 files changed, 124 insertions(+), 37 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index c34f33b848..ba518fa3f9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,34 @@
+2025-04-13 Bob Weiner <r...@gnu.org>
+
+* hsys-org.el (hsys-org-thing-at-p): Fix to work outside of Org mode by
+ suppressing warnings and ignoring Org regex errors. This fixes two
+ hsys-org tests where the 'www-url' ibtype fired instead of
+ 'org-link-outside-org-mode'.
+ (hsys-org-link-at-p): Rewrite to fix sending back (start . end)
+ positions when on a link, to be used as an implicit button label.
+
+* hywiki.el (hywiki-section-to-headline-reference): Add to convert #section
+ dashes to spaces for matching to Org headlines.
+ (org-link-set-parameters): Set HyWiki's link type to call the above
+ function on HyWiki links so they properly match Org headlines.
+
2025-04-12 Bob Weiner <r...@gnu.org>
+* hywiki.el (hywiki-cache-save): Change to save any modified cache rather than
+ triggering an error (which can occur during regression testing). This
fixes
+ the `hywiki-tests--save-referent-info-node-use-menu' test.
+ (hywiki--buttonized-region-p): Add so buttonized region tests are
+ always handled correctly. Use in the functions below.
+ (hywiki-convert-words-to-org-links,
+ hywiki-maybe-dehighlight-balanced-pairs,
+ hywiki-maybe-highlight-balanced-pairs,
+ hywiki-maybe-dehighlight-page-name,
+ hywiki-maybe-highlight-page-name,
+ hywiki--maybe-dehighlight-at-point,
+ hywiki--maybe-rehighlight-at-point): Fix to avoid using region
+ markers in a buffer other than the current one. This also fixes a bug when
+ doing HyWiki exports to html and referencing the wrong buffer.
+
* test/hywiki-tests.el (hywiki-tests--wikiword-step-check): Fix to not expect
closing paren delimiter as part of the WikiWord.
diff --git a/hmouse-tag.el b/hmouse-tag.el
index 7cb755198a..d861eb9b5a 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 24-Aug-91
-;; Last-Mod: 29-Jan-25 at 20:26:54 by Mats Lidell
+;; Last-Mod: 12-Apr-25 at 18:46:48 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -90,7 +90,7 @@ should insert the implicit link type definition name.")
;; default, `xref-find-definitions', so is not dependent on TAGS
;; tables or the `default-directory' in the ERT results buffer. When
;; a test is loaded, its symbol property, `ert--test', holds the
-;; absolute path to its file, and find-function uses that when its
+;; absolute path to its file, and `find-function' uses that when its
;; entry in `find-function-regexp-alist' is a regexp.
(defconst find-ert-test-regexp "^\\s-*(ert-deftest\\s-+%s\\s-"
"The regexp used to search for an ert test definition.
diff --git a/hpath.el b/hpath.el
index f35f004b85..89e1bd60a9 100644
--- a/hpath.el
+++ b/hpath.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 1-Nov-91 at 00:44:23
-;; Last-Mod: 7-Mar-25 at 00:22:47 by Mats Lidell
+;; Last-Mod: 13-Apr-25 at 01:06:44 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1613,7 +1613,7 @@ but locational suffixes within the file are utilized."
(current-buffer)))))))))))
(defun hpath:spaces-to-dashes-markup-anchor (anchor)
- "Replace dashes with spaces in ANCHOR if not a prog mode and no existing
dashes."
+ "Replace spaces with dashes in ANCHOR if not a prog mode and no existing
dashes."
(if (or (derived-mode-p 'prog-mode)
(string-match-p "-.* \\| .*-" anchor))
anchor
@@ -1623,7 +1623,7 @@ but locational suffixes within the file are utilized."
(subst-char-in-string ?\ ?- anchor)))
(defun hpath:dashes-to-spaces-markup-anchor (anchor)
- "Replace dashes with spaces in ANCHOR if not a prog mode and no existing
dashes."
+ "Replace dashes with spaces in ANCHOR if not a prog mode and no existing
spaces."
(if (or (derived-mode-p 'prog-mode)
(string-match-p "-.* \\| .*-" anchor))
anchor
diff --git a/hsys-org.el b/hsys-org.el
index 72ca860e15..d4a74c6477 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: 9-Mar-25 at 10:47:48 by Bob Weiner
+;; Last-Mod: 13-Apr-25 at 04:30:30 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -497,16 +497,50 @@ Match to all todos if `keyword' is nil or the empty
string."
(looking-at org-babel-src-block-regexp))))
(defun hsys-org-link-at-p ()
- "Return non-nil iff point is on an Org mode link.
+ "Return (start . end) iff point is on an Org mode link, else nil.
+Start and end are the buffer positions of the label that point is on
+delimited by square brackets.
+
Ignore [[hy:HyWiki]] buttons and return nil (handle these as
implicit buttons). Assume caller has already checked that the
current buffer is in `org-mode' or is looking for an Org link in
-another buffer type."
+a non-Org buffer type."
(unless (or (smart-eolp) (smart-eobp))
- (when (eq 'link (plist-get (hsys-org-thing-at-p) :type))
- (save-match-data
- ;; If this Org link matches a potential HyWiki word, ignore it.
- (not (and (fboundp 'hywiki-word-at) (hywiki-word-at)))))))
+ (if (derived-mode-p 'org-mode)
+ (let* ((org-plist (hsys-org-thing-at-p))
+ (type (plist-get org-plist :type))
+ (path (plist-get org-plist :path))
+ label-start-end)
+ (when (eq type 'link)
+ (save-match-data
+ ;; If this Org link matches a potential HyWiki word, ignore it.
+ (when (not (and (fboundp 'hywiki-word-at) (hywiki-word-at)))
+ (if (setq label-start-end (ibut:label-p t "[" "]" t))
+ (cons (nth 1 label-start-end) (nth 2 label-start-end))
+ t)))))
+ ;; non-Org mode (can't call org-element (which
+ ;; hsys-org-thing-at-p calls) outside of Org mode
+ (when (bound-and-true-p org-link-bracket-re)
+ (let ((pos (point)))
+ (when (save-excursion
+ (or
+ ;; Check if point is inside a link
+ (and (re-search-backward org-link-bracket-re
+ (line-beginning-position) t)
+ (> pos (point))
+ (< pos (match-end 0)))
+ ;; If not found before, check if we're in the middle of a
link
+ (and (forward-line 0)
+ (re-search-forward org-link-bracket-re
+ (line-end-position 2) t)
+ (> (point) pos)
+ (< pos (match-end 0)))))
+ (save-match-data
+ ;; If this Org link matches a potential HyWiki word, ignore it.
+ (when (not (and (fboundp 'hywiki-word-at) (hywiki-word-at)))
+ (if (setq label-start-end (ibut:label-p t "[" "]" t))
+ (cons (nth 1 label-start-end) (nth 2 label-start-end))
+ t)))))))))
;; Assume caller has already checked that the current buffer is in org-mode.
(defun hsys-org-heading-at-p (&optional _)
@@ -525,6 +559,8 @@ Assume caller has already checked that the current buffer
is in
;; Derived from `org-open-at-point' in "org.el".
(defun hsys-org-thing-at-p ()
"Return a plist of properties for Org thing at point or nil if none.
+This must work on Org links outside of Org mode.
+
The plist form is: (:type <type> :value <value> :context <context>).
The thing can be a link, citation, timestamp, footnote, src-block or
tags.
@@ -533,10 +569,16 @@ On top of syntactically correct links, this function also
works
on links and timestamps in comments, node properties, and
keywords if point is on something looking like a timestamp or a
link."
- (when (derived-mode-p 'org-mode)
+ (ignore-errors
(org-load-modules-maybe)
- ;; Org's regex matching can fail in non-thing contexts; return nil then
- (let* ((context
+ ;; Org regex matching can fail in non-thing contexts, so we ignore
+ ;; these errors and return nil then. Org-element will also warn to
+ ;; not use it outside of Org mode although it works, so we suppress
+ ;; those warnings as well.
+ (let* ((warning-minimum-level :error)
+ (warning-suppress-types '(org-element rx))
+ (warning-suppress-log-types '(org-element rx))
+ (context
;; Only consider supported types, even if they are not the
;; closest one.
(org-element-lineage
diff --git a/hywiki.el b/hywiki.el
index 0178f46bae..3c9ed8dc4d 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: 12-Apr-25 at 17:04:06 by Bob Weiner
+;; Last-Mod: 13-Apr-25 at 02:03:01 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -357,7 +357,7 @@ Presently, there are no key bindings; this is for future
use.")
"HyWiki string prefix type for Org links. Excludes trailing colon.")
(defvar hywiki-org-link-type-required t
- "When non-nil, HyWiki Org links must start with `hywiki-org-link-type':.
+ "When t, [[hy:HyWiki Org links]] must start with `hywiki-org-link-type':.
Otherwise, this prefix is not needed and HyWiki word Org links
override standard Org link lookups. See \"(org)Internal Links\".")
@@ -439,6 +439,7 @@ where PATH is the un-resolvable reference."
:publishing-directory hywiki-org-publishing-directory
:publishing-function hywiki-org-publishing-function
:section-numbers t
+ :shell "shell-command"
:sitemap-filename "index.org"
;; sitemap (TOC) is stored in "sitemap.html"
:sitemap-title hywiki-org-publishing-sitemap-title
@@ -1476,7 +1477,9 @@ simplifies to:
The finalized Org link is then exported to html format by the Org
publish process."
(barf-if-buffer-read-only)
- (hywiki-maybe-highlight-page-names)
+ ;; Need to be explicit about the region here so does not use markers
+ ;; from a region pointing to another buffer
+ (hywiki-maybe-highlight-page-names (point-min) (point-max))
(let ((make-index (hywiki-org-get-publish-property :makeindex))
org-link
wikiword-and-section
@@ -1737,8 +1740,7 @@ and radio targets.
Ignore return value; it has no meaning."
(save-excursion
(save-restriction
- (if (and (marker-position hywiki--buttonize-start)
- (marker-position hywiki--buttonize-end))
+ (if (hywiki--buttonized-region-p)
(narrow-to-region hywiki--buttonize-start hywiki--buttonize-end)
;; Limit balanced pair checks to the next two lines for speed
(narrow-to-region (line-beginning-position) (line-end-position 2)))
@@ -1804,8 +1806,7 @@ and radio targets.
Return t if no errors and a pair was found, else nil."
(save-excursion
(save-restriction
- (if (and (marker-position hywiki--buttonize-start)
- (marker-position hywiki--buttonize-end))
+ (if (hywiki--buttonized-region-p)
(narrow-to-region hywiki--buttonize-start hywiki--buttonize-end)
;; Limit balanced pair checks to the next two lines for speed
(narrow-to-region (line-beginning-position) (line-end-position 2)))
@@ -1952,8 +1953,7 @@ If in a programming mode, must be within a comment. Use
(with-syntax-table hbut:syntax-table
(save-excursion
(save-restriction
- (when (and (marker-position hywiki--buttonize-start)
- (marker-position hywiki--buttonize-end))
+ (when (hywiki--buttonized-region-p)
(narrow-to-region hywiki--buttonize-start hywiki--buttonize-end)
(goto-char hywiki--buttonize-start))
@@ -2017,8 +2017,7 @@ the current page unless they have sections attached."
(setq hywiki--highlighting-done-flag nil)
(with-syntax-table hbut:syntax-table
(save-excursion
- (when (and (marker-position hywiki--buttonize-start)
- (marker-position hywiki--buttonize-end))
+ (when (hywiki--buttonized-region-p)
(goto-char hywiki--buttonize-start))
(unless on-page-name
@@ -2568,7 +2567,8 @@ save and potentially set `hywiki--directory-mod-time' and
(let ((buf (get-file-buffer save-file)))
(when buf
(if (buffer-modified-p buf)
- (error "(hywiki-cache-save): Attempt to kill modified Environment
file failed to save, \"%s\"" save-file)
+ (save-buffer)
+ ;; (error "(hywiki-cache-save): Attempt to kill modified Environment
file failed to save, \"%s\"" save-file)
(kill-buffer buf))))
(let ((dir (or (file-name-directory save-file)
default-directory)))
@@ -2791,6 +2791,7 @@ variables."
:complete #'hywiki-org-link-complete
:export #'hywiki-org-link-export
:follow #'hywiki-find-referent
+ :htmlize-link #'hywiki-section-to-headline-reference
:store #'hywiki-org-link-store))
(defun hywiki-word-strip-suffix (page-name)
@@ -2815,8 +2816,8 @@ Customize this directory with:
{M-x customize-variable RET hywiki-org-publishing-directory RET}."
(interactive "P")
;; Export Org to html with useful link ids.
- ;; Instead of random ids like \"orga1b2c3\", use heading titles,
- ;; made unique when necessary."
+ ;; Instead of random ids like "orga1b2c3", use heading titles with
+ ;; spaces replaced with dashes, made unique when necessary.
(unwind-protect
(progn
(advice-add #'org-export-get-reference :override
#'hywiki--org-export-get-reference)
@@ -2855,6 +2856,17 @@ at point must return non-nil or this function will
return nil."
(list word start end))
word))
+(defun hywiki-section-to-headline-reference ()
+ "Replace file#section dashes with spaces to match to an Org headline.
+Does replacement only when not in a programming mode and section
+contains no spaces."
+ (let ((link (get-text-property (point) 'org-link)))
+ (if (and link (string-match "#" link))
+ (let* ((file (substring link 0 (match-beginning 0)))
+ (section (substring link (match-beginning 0))))
+ (concat file (hpath:dashes-to-spaces-markup-anchor section)))
+ link)))
+
(defun hywiki-strip-org-link (link-str)
"Return the hy:HyWikiWord#section part of an Org link string.
Strip any square bracket delimiters, description and leading or
@@ -3265,6 +3277,13 @@ auto-highlighting."
;;; Private functions
;;; ************************************************************************
+(defun hywiki--buttonized-region-p ()
+ "Return non-nil when hywiki--buttonize-start/end point to the current
buffer."
+ (and (marker-position hywiki--buttonize-start)
+ (eq (marker-buffer hywiki--buttonize-start) (current-buffer))
+ (marker-position hywiki--buttonize-end)
+ (eq (marker-buffer hywiki--buttonize-end) (current-buffer))))
+
(defun hywiki--add-suffix-to-referent (suffix referent)
"Add SUFFIX to REFERENT's value and return REFERENT.
SUFFIX includes its type prefix, e.g. #. Return nil if any input is
@@ -3431,8 +3450,7 @@ the HyWikiWord reference."
(not (equal hywiki--word-pre-command
(hywiki-get-singular-wikiword
(or (car hywiki--range)
- (when (and (marker-position
hywiki--buttonize-start)
- (marker-position
hywiki--buttonize-end))
+ (when (hywiki--buttonized-region-p)
(buffer-substring hywiki--buttonize-start
hywiki--buttonize-end))
(when (and (setq hywiki--range (hywiki-word-at
:range))
@@ -3456,8 +3474,7 @@ This must be called within a `save-excursion' or it may
move point."
(when hywiki--range
(hywiki-maybe-highlight-on-page-name))
- (when (and (marker-position hywiki--buttonize-start)
- (marker-position hywiki--buttonize-end))
+ (when (hywiki--buttonized-region-p)
(hywiki--maybe-de/highlight-sexp
#'hywiki-maybe-highlight-page-names 1
hywiki--buttonize-start hywiki--buttonize-end))
diff --git a/test/hsys-org-tests.el b/test/hsys-org-tests.el
index 48117ee803..a7fa8ed9a0 100644
--- a/test/hsys-org-tests.el
+++ b/test/hsys-org-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 23-Apr-21 at 20:55:00
-;; Last-Mod: 16-Nov-24 at 09:45:51 by Mats Lidell
+;; Last-Mod: 13-Apr-25 at 03:23:46 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -139,9 +139,8 @@ This is independent of the setting of
`hsys-org-enable-smart-keys'."
(with-temp-buffer
(insert "[[file:/tmp/abc][file]]\n")
(goto-char 6)
- (mocklet (((org-open-at-point-global) => t))
- (should (equal hsys-org-enable-smart-keys v)) ; Traceability
- (should (action-key))))))))
+ (should (equal hsys-org-enable-smart-keys v)) ; Traceability
+ (should (action-key)))))))
(ert-deftest hsys-org--org-outside-org-mode-tmp-file ()
"Org links in a non `org-mode' file should work.
