diff --git a/ChangeLog b/ChangeLog index be01f105..0d5c9550 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,93 @@ +2026-03-16 Bob Weiner + +* hibtypes.el (action): Ensure if action name is bound only as a variable + that there are no arguments within the angle brackets. If there are, + then it is not an action button. + +* test/hywiki-tests.el (hywiki-tests--save-referent-org-id): Fix to mock + 'org-id-get' instead of 'org-id-get-create' and add call to + `hywiki-get-referent' to ensure referent is created and read back properly. + +* hywiki.el (hywiki-get-page-file): The page file may have previously been + resolved and sent as input here. If it exists, simply use it. + +* hpath.el (hpath:is-p): Remove 'file-exists-p' call because 'hpath:normalize' + handles that while accounting for path #suffixes which the 'file-exists-p' + call mistakenly nullifies. + (hpath:validate): Fix that 'suffix' was set to the whole path string + when 'suffix-start' was null. Now it is set properly to nil. + Also fix so if a file named "myfile#name", validate accepts it without + treating the #name as a suffic/section to be stripped. + +2026-03-15 Bob Weiner + +* test/demo-tests.el (fast-demo-display-kotl-starting-from-cell, + demo-implicit-button-hash-link-test) + demo-implicit-button-line-and-column-rtest): + Update these to remove 'hy-test-helpers:kill-buffer' since 'with-temp-buffer' + cleans it up. This eliminates a null buffer error. + +* hpath.el (hpath:normalize): Handle directory paths and avoid reading in the + file to handle it. + (hpath:validate): Fix to strip #suffix before validation and add + it back on return. +* hibtypes.el (hywiki-existing-word): Simplify pathname check without calling + other ibtypes. + +* hpath.el (hpath:suffixes): Remove ".org" as it triggers pathname ibtype when + it shouldn't and overrides `hywiki-existing-word'. + +* hywiki.el (hywiki-add-org-id): Remove (hmouse-choose-link-and-referent-windows) + as this is not what inserts a link but just creates the wikiword referent. + (hywiki-word-regexp): Add optional .org suffix so "WikiWord.org#section" + works. + +* hywiki.el (hywiki-referent-menu): Change from inserting a string link + to an Org link that includes the associated Org heading title. Change + format from "ID: uuid" to [[id:uuid][title]]. + (hywiki-add-org-id): + test/hywiki-tests.el (hywiki-tests--add-org-id): + (hywiki-tests--save-referent-org-id): + (hywiki-tests--add-org-id): Add reading back the org-id + referent. + (hywiki-tests--save-referent-org-id): Delete this test; + covered better by 'hywiki-tests--add-org-id'. + hui.el (hui:link-possible-types): Update id handling in all of these. + +* hywiki.el (hywiki-get-page-file, hywiki-get-existing-page-file): Add + second function and check that 'file-stem-name' does not contain + a directory, so it is not returned with the wrong dir attached. + hpath.el (hpath:at-p, hpath:find-line): + hibtypes.el (pathname-line-and-column, hib-link-to-file-line): Call + the new fuction in these four functions. + +* hywiki.el (hywiki-org-get-heading-match-regexp, + hywiki--org-set-heading-regexp): Make whitespace before + optional components optional and allow for tabs. + +* hywiki.el (hywiki-referent-menu): Change all "ID: " to "id:" to match + how Org works with the id: link type prefix when specifying ids. + +* hpath.el (hpath:find, hpath:expand): Fix to properly expand HyWiki + page references. + +* test/hywiki-tests.el (hywiki-tests--save-referent-global-button-use-menu): + Rewrite to not use mocking. Fixes this to work with latest + 'hpath:find' as well. + +* hbut.el (ibut:insert-text): Ensure line and col nums are prefixed with :L + and :C. +* hywiki.el (hywiki-org-get-heading-match-regexp): Handle both HyWiki dir + custom todo keywords when in a page and Org standard todo keywords, otherwise. +* hibtypes.el (pathname-line-and-column, hib-link-to-file-line): Expand HyWiki + page name using 'hywiki-get-page-file' before try to expand in current + directory + (pathname-line-and-column, hib-link-to-file-line): Call + 'hywiki-get-page-file' only if 'label' has no directory attached. This fixes + a problem where ".org" is attached improperly to the filename. +* hpath.el (hpath:at-p, hpath:find-line): Handle pathname expansion of HyWiki + page names. + 2026-03-15 Mats Lidell * test/hyrolo-tests.el: Prefix all tests with hyrolo-tests. Use @@ -22,6 +112,41 @@ 2026-03-14 Bob Weiner +* hpath.el (hpath:call): (file-exists-p "") returns t, so fix to check for empty + string before calling that. + hibtypes.el (hpath:is-p): Unless 'non-exist' arg is sent or path is a remote file, + return path only if it exists. + +* hui.el (require 'hsys-org): Add. + hibtypes.el (require 'hsys-org): Add. + hsys-org.el (hsys-org-uuid-is-p): Add and use in "hibtypes.el" and "hui.el". + +* hui.el (hui:link-possible-types): For Org/Org-Roam ids, send 2nd arg + of current heading string to 'link-to-org-id' call. + (hui:link-possible-types): If in a HyWiki page but not on a heading line, + use a 'link-to-wikiword' with the page name and line number. + hactypes.el (link-to-org-id): Add optional heading 'title' arg for use in + 'hbut:insert-text' where ibut links are created. + +* hbut.el (ibut:insert-text): For 'actypes::link-to-org-id', change from + a double-quoted link to a double square bracketed Org link. This allows + including the title from the Org heading linked to which is stored in + the current Hyperbole button attribute, 'lbl-key'. + +* hui.el (hui:link-possible-types): For HyWiki links, wrap a call of + 'hpath:org-normalize-title' around 'hywiki-org-format-heading' to ensure + everything but the title is removed. + +* hsys-org.el (hsys-org-link-at-p): Don't shrink label region down to just + the description part of the Org link, leave it as the entire space inside + the Org open and close brackets. Remove this code: + (when (string-match "\\]\\[" label) + (setq start (match-end 0))) + This makes link activation work better. + +* hibtypes.el (org-id, org-id:help): Fix to remove "id:" prefix so + that uuid check predicates succeed properly. + * Makefile (HYPB_BIN_WARN): Fix preceding commentary on example use. (test-all TERM=xterm-256color): Add #(LET_VARIABLES). diff --git a/hact.el b/hact.el index a4e16220..a3b45e8e 100644 --- a/hact.el +++ b/hact.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 18-Sep-91 at 02:57:09 -;; Last-Mod: 30-Dec-25 at 14:42:06 by Mats Lidell +;; Last-Mod: 16-Mar-26 at 22:11:38 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -391,7 +391,7 @@ Autoloads action function if need be to get the parameter list." ;;; ======================================================================== (defun hact (&rest args) - "Perform action formed from rest of ARGS and return the result. + "Perform action function formed from rest of ARGS and return the result. The value of `hrule:action' determines what effect this has. The default for `hrule:action' is `actype:act' which returns the result of the action unless it is nil, in which case t is returned instead, to diff --git a/hactypes.el b/hactypes.el index 31b91a57..91f5009c 100644 --- a/hactypes.el +++ b/hactypes.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 23-Sep-91 at 20:34:36 -;; Last-Mod: 28-Sep-25 at 23:27:18 by Mats Lidell +;; Last-Mod: 15-Mar-26 at 14:44:00 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -639,8 +639,9 @@ information on how to specify a mail reader to use." (hypb:error "(link-to-mail): No msg `%s' in file \"%s\"" mail-msg-id mail-file))))) -(defact link-to-org-id (id) - "Display the Org entry, if any, for ID." +(defact link-to-org-id (id &optional title) + "Display the Org entry, if any, for ID with optional TITLE. +ID is a uuid without any 'id:' prefix." (when (stringp id) (let* ((inhibit-message t) ;; Inhibit org-id-find status msgs (m (or (and (featurep 'org-roam) (org-roam-id-find id 'marker)) diff --git a/hbut.el b/hbut.el index bc9ade84..166220e0 100644 --- a/hbut.el +++ b/hbut.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 18-Sep-91 at 02:57:09 -;; Last-Mod: 28-Feb-26 at 16:33:40 by Bob Weiner +;; Last-Mod: 15-Mar-26 at 22:16:44 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -586,9 +586,7 @@ For interactive creation, use `hui:ebut-create' instead." (hattr:set 'hbut:current 'args args) (ebut:operate label nil)) (error (hattr:clear 'hbut:current) - (if (and (listp (cdr err)) (= (length (cdr err)) 1)) - (error "(ebut:program): actype arg must be a bound symbol (not a string): %S" actype) - (error "(ebut:program): %S" err))))))) + (error "(ebut:program): %S" err)))))) (defun ebut:search (string out-buf &optional match-part) "Write explicit button lines matching STRING to OUT-BUF. @@ -2723,7 +2721,12 @@ Summary of operations based on inputs (name arg from \\='hbut:current attrs): (if (string-prefix-p "<" arg1) (insert arg1) (insert "<" arg1 ">")))) - ('actypes::link-to-org-id (insert (format "\"id:%s\"" arg1))) + ;; Insert an Org-style link here so can include the Org title linked + ;; to for clarity. + ('actypes::link-to-org-id + (insert (if arg2 + (format "[[id:%s][%s]]" arg1 arg2) + (format "[[id:%s]]" arg1)))) ('actypes::link-to-rfc (insert (format "rfc%d" arg1))) ('actypes::link-to-wikiword (insert (if (and (stringp arg1) (string-match-p "\\s-" arg1)) @@ -2732,13 +2735,13 @@ Summary of operations based on inputs (name arg from \\='hbut:current attrs): arg1))) ('man (insert arg1)) ('actypes::man-show (insert arg1)) - ('actypes::link-to-file-line (insert (format "\"%s:%d\"" + ('actypes::link-to-file-line (insert (format "\"%s:L%d\"" (hpath:shorten arg1) arg2))) ('actypes::link-to-file-line-and-column (insert (if (eq arg3 0) - (format "\"%s:%d\"" (hpath:shorten arg1) arg2) - (format "\"%s:%d:%d\"" (hpath:shorten arg1) arg2 arg3)))) + (format "\"%s:L%d\"" (hpath:shorten arg1) arg2) + (format "\"%s:L%d:C%d\"" (hpath:shorten arg1) arg2 arg3)))) ('actypes::link-to-file ;; arg2 when given is a buffer position (insert "\"" diff --git a/hibtypes.el b/hibtypes.el index 3b0d3512..318e7593 100644 --- a/hibtypes.el +++ b/hibtypes.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 19-Sep-91 at 20:45:31 -;; Last-Mod: 14-Mar-26 at 03:16:36 by Bob Weiner +;; Last-Mod: 16-Mar-26 at 23:02:23 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -37,10 +37,11 @@ ;;; Other required Elisp libraries ;;; ************************************************************************ -(require 'cl-lib) ;; for cl-count +(require 'cl-lib) ;; for cl-count and cl-find (require 'find-func) ;; used by grep-msg ibtype (eval-when-compile (require 'hversion)) (require 'hactypes) +(require 'hsys-org) (require 'hypb) (require 'org-macs) ;; for org-uuid-regexp (require 'subr-x) ;; for string-trim @@ -175,17 +176,19 @@ only to prevent false matches." (start (when bounds (car bounds))) (end (when bounds (cdr bounds))) m) + ;; Remove any "ID:" or "id:" prefix + (when (and id (string-prefix-p "id:" id t)) + (setq id (substring id 3) + start (+ start 3))) ;; Ignore ID definitions or when not on a possible ID - (when (and id (if (fboundp 'org-uuidgen-p) - (org-uuidgen-p id) - (string-match org-uuid-regexp (downcase id)))) + (when (hsys-org-uuid-is-p id) (when (and start end) (ibut:label-set id start end)) (if (and (not assist-flag) (save-excursion (beginning-of-line) (re-search-forward ":\\(CUSTOM_\\)?ID:[ \t]+" (line-end-position) t))) - (hact 'message "On ID definition; use {C-u M-RET} to copy a link to an ID.") + (hact 'message "On Org ID definition; use {C-u M-RET} to copy a link to an ID.") (when (let ((inhibit-message t) ;; Inhibit org-id-find status msgs (obuf (current-buffer)) (omode major-mode)) @@ -208,6 +211,9 @@ If the referenced location is found, return non-nil." (let ((id (thing-at-point 'symbol t)) ;; Could be a uuid or some other form of id m mpos) + ;; Remove any "ID:" or "id:" prefix + (when (and id (string-prefix-p "id:" id t)) + (setq id (substring id 3))) ;; Ignore ID definitions or when not on a possible ID (when (and id (let ((inhibit-message t)) ;; Inhibit org-id-find status msgs @@ -490,7 +496,6 @@ handle any links they recognize first." ;; Prevent infinite recursion, e.g. if called via ;; `org-metareturn-hook' from `org-meta-return' invocation. (not (hyperb:stack-frame '(ibtypes::debugger-source org-meta-return)))) - (require 'hsys-org) (declare-function hsys-org-link-at-p "hsys-org" ()) (declare-function hsys-org-set-ibut-label "hsys-org" (start-end)) (let ((start-end (hsys-org-link-at-p))) @@ -985,9 +990,10 @@ See `hpath:find' function documentation for special file display options." (col-num (when (match-end 4) (string-to-number (match-string-no-properties 5 path-line-and-col)))) (label (match-string-no-properties 1 path-line-and-col)) - ;; Next variable must come last as it can overwrite the match-data - (file (hpath:expand label))) - (when (setq file (hpath:is-p file)) + ;; Next variable should come last as it can overwrite the match-data + file) + (when (setq file (or (hpath:is-p (hpath:expand label)) + (hywiki-get-existing-page-file label))) (ibut:label-set label start (+ start (length label))) (if col-num (hact 'link-to-file-line-and-column file line-num col-num) @@ -1017,8 +1023,9 @@ LINE-NUM may be an integer or string." (and (or (null (setq ext (file-name-extension file))) (member (concat "." ext) (get-load-suffixes))) (ignore-errors (find-library-name file))) - (expand-file-name file)))) - (when (file-exists-p file) + (hpath:is-p (expand-file-name file)) + (hywiki-get-existing-page-file file)))) + (when (file-exists-p (hpath:normalize file)) (actypes::link-to-file-line file line-num)))) (defib ipython-stack-frame () @@ -1624,7 +1631,7 @@ action type, function symbol to call or test to execute, i.e. (let ((hbut:max-len 0) (name (hattr:get 'hbut:current 'name)) (testing-flag (when (bound-and-true-p ert--running-tests) t)) - actype actype-sym action args lbl var-flag) + actname actype actype-sym action args is-var lbl sep var-flag) ;; Continue only if there if there is one of: ;; 1. `ert--running-tests' is non-nil @@ -1640,15 +1647,18 @@ action type, function symbol to call or test to execute, i.e. (when (string-match "\\`\\$" lbl) (setq var-flag t lbl (substring lbl 1))) - (setq actype (if (string-match-p " " lbl) (car (split-string lbl)) lbl) - actype-sym (or (actype:elisp-symbol actype) (intern-soft actype)) + (setq actname (if (setq sep (cl-position ?\ lbl)) (substring lbl 0 sep) lbl) + actype-sym (or (actype:elisp-symbol actname) (intern-soft actname)) ;; Must ignore that (boundp nil) would be t here. actype (and actype-sym - (or (fboundp actype-sym) (boundp actype-sym) + (or (fboundp actype-sym) + (setq is-var (boundp actype-sym)) (special-form-p actype-sym) (ert-test-boundp actype-sym)) actype-sym)) - (when actype + (when (and actype (or (null is-var) + ;; is a variable so can't have arguments + (equal actname lbl))) ;; For buttons, need to double quote each argument so ;; 'read' does not change the idstamp 02 to 2. (when (and (memq actype '(hy hynote)) @@ -1656,7 +1666,7 @@ action type, function symbol to call or test to execute, i.e. (setq lbl (replace-regexp-in-string "\"\\(.*\\)\\'" "\\1\"" (combine-and-quote-strings (split-string lbl) "\" \"")))) - (setq action (read (concat "(" lbl ")")) + (setq action (ignore-errors (read (concat "(" lbl ")"))) args (cdr action)) ;; Ensure action uses an fboundp symbol if executing a ;; Hyperbole actype. @@ -1762,8 +1772,7 @@ not yet existing HyWikiWords." (cl-destructuring-bind (wikiword start end) (hywiki-referent-exists-p :range) (when wikiword - (unless (or (ibtypes::pathname-line-and-column) - (ibtypes::pathname)) + (unless (file-exists-p (hywiki-word-from-reference wikiword)) (if (and start end) (ibut:label-set wikiword start end) (ibut:label-set wikiword)) diff --git a/hpath.el b/hpath.el index f8e424e1..5d6d9e91 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: 14-Mar-26 at 12:42:35 by Bob Weiner +;; Last-Mod: 16-Mar-26 at 22:35:45 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -994,7 +994,8 @@ or `~'." ;; Could be a shell command from a semicolon separated ;; list; ignore if so nil) - (t (expand-file-name subpath))) + (t (or (hywiki-get-existing-page-file subpath) + (expand-file-name subpath)))) ;; Only default to current path if know are within a PATH value (when (string-match-p hpath:path-variable-value-regexp path) "."))) @@ -1099,7 +1100,8 @@ Make any existing path within a file buffer absolute before returning." (file-name-absolute-p expanded-path) ;; absolute path (string-match-p hpath:variable-regexp expanded-path) ;; path with var (string-match-p "\\`([^\):]+)" expanded-path)))) ;; Info node - (when (or non-exist (file-exists-p expanded-path) + (when (or non-exist (and (not (string-empty-p expanded-path)) + (file-exists-p expanded-path)) (string-match-p ".+\\.info\\([.#]\\|\\'\\)" expanded-path)) (if (string-empty-p expanded-path) (concat prefix expanded-path suffix) @@ -1276,6 +1278,11 @@ only if it exists, otherwise, return nil." (string-match-p "[\\/~]" substituted-path)) ;; Don't expand if an Info path, URL, #anchor or has a directory prefix substituted-path) + ((and (null (file-name-directory substituted-path)) + ;; Could be an existing HyWikiWord + (let ((page-file (cdr (hywiki-get-referent substituted-path)))) + (when page-file + (setq substituted-path (expand-file-name page-file hywiki-directory)))))) (t (expand-file-name substituted-path)))) (if (and (stringp expanded-path) (or (file-exists-p expanded-path) @@ -1493,6 +1500,7 @@ buffer but don't display it. Any modifier prefix is ignored in such cases but locational suffixes within the file are utilized." (interactive "FFind file: ") (unless (stringp pathname) + ;; (debug) ;; Enable debugging if nil is ever sent to `hpath:find' (error "(hpath:find): pathname arg must be a string, not, %S" pathname)) ;; `pathname' ends as the whole argument sent in except for any ;; initial modifier character. @@ -1544,15 +1552,20 @@ but locational suffixes within the file are utilized." (if (string-empty-p path) (setq path "" pathname "") - ;; Never expand pathnames with modifier prepended. - (if modifier - (setq path (hpath:resolve path)) - (setq path (hpath:expand path) - pathname (hpath:absolute-to path default-directory)) - ;; Remove http file:// url prefix that`hpath:absolute-to' may have - ;; added and decode the url - (when (string-match "\\`file://" pathname) - (setq pathname (hypb:decode-url (substring pathname (match-end 0))))))) + ;; Never expand pathnames with modifier prepended + (let ((referent (hywiki-get-referent path))) + (when (eq (car referent) 'page) + ;; This replaces the page name with name.org, so can be expanded + ;; down below. + (setq path (cdr referent)))) + (cond (modifier + (setq path (hpath:resolve path))) + (t (setq path (hpath:expand path) + pathname (hpath:absolute-to path default-directory)) + ;; Remove http file:// url prefix that`hpath:absolute-to' may have + ;; added and decode the url + (when (string-match "\\`file://" pathname) + (setq pathname (hypb:decode-url (substring pathname (match-end 0)))))))) (let ((remote-pathname (hpath:remote-p path))) (or modifier remote-pathname (file-exists-p pathname) @@ -1766,7 +1779,7 @@ frame. Always return t." (setq filename (substring filename (match-end 0)))) (hpath:find (concat - filename + (or (hywiki-get-existing-page-file filename) filename) (cond ((integerp line-num) (concat ":" (int-to-string line-num))) ((stringp line-num) @@ -1920,17 +1933,19 @@ form is what is returned for PATH." (concat modifier (format rtn-path suffix))) (concat modifier (format rtn-path "")))))))))) path non-exist))) - (unless (or (null path) - (string-empty-p path) - (string-equal "-" path) - (string-match-p "#['`\"]" path) - ;; If a single character in length, must be a word or - ;; symbol character other than [.~ /]. - (and (= (length path) 1) - (not (string-match-p "\\`[.~/]\\'" path)) - (or (not (string-match-p "\\sw\\|\\s_" path)) - (string-match-p "[@#&!*]" path)))) - path))) + (unless (or (null path) + (string-empty-p path) + (string-equal "-" path) + (string-match-p "#['`\"]" path) + ;; If a single character in length, must be a word or + ;; symbol character other than [.~ /]. + (and (= (length path) 1) + (not (string-match-p "\\`[.~/]\\'" path)) + (or (not (string-match-p "\\sw\\|\\s_" path)) + (string-match-p "[@#&!*]" path)))) + (when (or non-exist (file-remote-p path) + (hpath:normalize path)) + path)))) (defun hpath:org-normalize-title (title) "Strip all priority, leading ':' or '-' separators, and stats from TITLE and return." @@ -2304,15 +2319,13 @@ point ends within the narrowed region." (setq path (string-trim path "\"" "\""))) path) -(defun hpath:normalize (filename) - "Normalize and return an existing, readable FILENAME, else signal an error. +(defun hpath:normalize (path) + "Normalize and return an existing, readable PATH, else signal an error. Replace Emacs Lisp variables and environment variables (format of -${var}) with their values in FILENAME's path. The first matching +${var}) with their values in PATH's path. The first matching value for variables like `${PATH}' is used." - (let ((buf (hpath:find-noselect filename))) - (if buf - (hpath:validate (hpath:substitute-value (hypb:buffer-file-name buf))) - (error "(hpath:normalize): '\"%s\" is not a readable filename" filename)))) + ;; `hpath:validate' ensures the path is readable or triggers an error + (hpath:validate (hpath:substitute-value path))) (defun hpath:validate (path) "Validate PATH is readable and return it in Posix format. @@ -2326,15 +2339,20 @@ to it." (unless (stringp path) (error "(hpath:validate): \"%s\" is not a pathname" path)) (setq path (hpath:mswindows-to-posix path)) - (cond ((or (string-match "[()]" path) (hpath:remote-p path)) - ;; info or remote path, so don't validate - path) - ((if (not (hpath:www-p path)) - ;; Otherwise, must not be a WWW link ref and must be a readable path. - (let ((return-path (hpath:exists-p path))) - (and return-path (file-readable-p return-path) - return-path)))) - (t (error "(hpath:validate): \"%s\" is not readable" path)))) + (if (file-readable-p path) + path + (let* ((suffix-start (cl-position ?# path)) + (path-only (substring path 0 suffix-start)) + (suffix (when suffix-start (substring path suffix-start)))) + (cond ((or (string-match "[()]" path) (hpath:remote-p path)) + ;; info or remote path, so don't validate + path) + ((unless (hpath:www-p path-only) + ;; Otherwise, must not be a WWW link ref and must be a readable path. + (let ((return-path (hpath:exists-p path-only))) + (and return-path (file-readable-p return-path) + (concat return-path suffix))))) + (t (error "(hpath:validate): \"%s\" is not a readable path" path)))))) ;;; URL Handling (defun hpath:find-file-urls-p () @@ -2656,6 +2674,10 @@ Otherwise return nil." (setq val nil))) val)) +(defun hpath:strip-suffix (path) + "Strip any suffix including and after '#' and return the remaining path." + (when (stringp path) (substring path 0 (cl-position ?# path)))) + (defun hpath:substitute-dir (path-prefix var-name rest-of-path trailing-dir-sep-flag &optional return-path-flag) "Return directory after substitutions. Return the concatenation of PATH-PREFIX, dir for VAR-NAME, diff --git a/hsys-org.el b/hsys-org.el index dbc50865..da1d9bff 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: 14-Mar-26 at 00:34:04 by Bob Weiner +;; Last-Mod: 14-Mar-26 at 18:38:59 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -508,10 +508,10 @@ 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 (start . end) iff point is on an Org mode link, else nil. + "Return (start . end) iff point is on a delimited Org mode link, else nil. Start and end are the buffer positions of the label of the link. This is either the optional description or if none, then the referent, i.e. -either [[referent][description]] or [[referent]]. +either [[referent][description]] or [[referent]], sans the outer brackets. If the link referent is to a HyWikiWord, e.g. [[hy:WikiWord]], or point is on a HyWikiWord in the link description, then ignore this as an Org @@ -540,8 +540,6 @@ Assume caller has already checked that the current buffer is in (let* ((start (nth 1 label-start-end)) (end (nth 2 label-start-end)) (label (buffer-substring-no-properties start end))) - (when (string-match "\\]\\[" label) - (setq start (match-end 0))) (cons start end)))))))) (defun hsys-org-link-label-start-end () @@ -751,6 +749,13 @@ TARGET must be a string." (goto-char (or (previous-single-property-change (point) 'face) (point-min))) (goto-char opoint))))) +(defun hsys-org-uuid-is-p (id) + "Return non-nil if ID is a uuid." + (and (stringp id) + (if (fboundp 'org-uuidgen-p) + (org-uuidgen-p id) + (string-match org-uuid-regexp (downcase id))))) + ;;; ************************************************************************ ;;; Private functions ;;; ************************************************************************ diff --git a/hui.el b/hui.el index 40edf14b..40884968 100644 --- a/hui.el +++ b/hui.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 19-Sep-91 at 21:42:03 -;; Last-Mod: 14-Mar-26 at 11:47:29 by Bob Weiner +;; Last-Mod: 15-Mar-26 at 17:46:14 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -27,6 +27,7 @@ (require 'hmail) (require 'hbut) (eval-when-compile (require 'hactypes)) +(require 'hsys-org) ;;; ************************************************************************ ;;; Public declarations @@ -2012,8 +2013,8 @@ possible types. Referent Context Possible Link Type Returned ---------------------------------------------------- -HyWikiWord Reference link-to-wikiword Org Roam or Org Id link-to-org-id +HyWikiWord Reference link-to-wikiword Global Button link-to-gbut Explicit Button link-to-ebut Implicit Button link-to-ibut @@ -2026,7 +2027,8 @@ Directory Name link-to-directory File Name link-to-file Koutline Cell link-to-kcell Single-line Region link-to-string-match -HyWiki Org Heading link-to-wikiword +HyWiki Page link-to-wikiword +Org Heading link-to-file Outline Heading link-to-file Buffer attached to File link-to-file EOL in Dired Buffer link-to-directory (Dired dir) @@ -2036,164 +2038,218 @@ Buffer without File link-to-buffer-tmp" (let (val hbut-sym - lbl-key) + id + lbl-key + heading) (prog1 (delq nil - (list (cond ((let ((ref (hywiki-referent-exists-p))) - (and ref (list 'link-to-wikiword ref)))) - ((and (featurep 'org-id) - (cond ((save-excursion - (beginning-of-line) - (when (looking-at "[ \t]*:\\(CUSTOM_\\)?ID:[ \t]+\\([^ \t\r\n\f]+\\)") - ;; Org ID definition - (list 'link-to-org-id (match-string 2))))) - (t (let* ((id (thing-at-point 'symbol t)) ;; Could be a uuid or some other form of id - (bounds (when id (bounds-of-thing-at-point 'symbol))) - (start (when bounds (car bounds))) - (case-fold-search t)) - ;; Org ID link - must have id: prefix or is ignored. - (when start + (list (cond + ;; Org id or Org Roam id + ((and (featurep 'org-id) + (if (derived-mode-p 'org-mode) + (setq heading (org-get-heading) + id (ignore-errors (org-id-get))) + t) + (cond (id) + ((save-excursion + (beginning-of-line) + (when (looking-at "[ \t]*:\\(CUSTOM_\\)?ID:[ \t]+\\([^ \t\r\n\f]+\\)") + ;; Org ID definition + (setq id (match-string 2))))) + (t (let* + ;; Could be a uuid or some other form of id. + ;; Syntax table may include or discard initial "id:". + ((possible-id (thing-at-point 'symbol t)) + (bounds (when possible-id (bounds-of-thing-at-point 'symbol))) + (start (when bounds (car bounds))) + (case-fold-search t)) + ;; Org ID link - must have id: + ;; prefix or is ignored but + ;; `thing-at-point' may have dropped it. + (when start + (cond ((string-prefix-p "id:" possible-id t) + (setq id (string-trim (substring possible-id 3)))) + ((save-excursion + (goto-char (max (- start 3) (point-min))) + (looking-at "\\bid:")) + (setq id possible-id))))))) + (when (hsys-org-uuid-is-p id) + (list 'link-to-org-id id + (when heading + (hpath:org-normalize-title + (hywiki-org-format-heading heading t t t nil t))))))) + ;; + ;; HyWiki reference + ((let ((ref (hywiki-referent-exists-p))) + (and ref (list 'link-to-wikiword ref)))) + ;; + ;; Next clause forces use of any ibut name in the link + ;; and sets hbut:current button attributes. + (t (cond ((and (not (derived-mode-p 'dired-mode)) + (prog1 (setq hbut-sym (hbut:at-p)) + (when (ibut:is-p hbut-sym) + (save-excursion (ibut:at-to-name-p hbut-sym)))) + (setq lbl-key (hattr:get hbut-sym 'lbl-key)) + (eq (current-buffer) (get-file-buffer (gbut:file)))) + (list 'link-to-gbut lbl-key)) + ((and hbut-sym lbl-key (eq (hattr:get hbut-sym 'categ) 'explicit)) + (list 'link-to-ebut lbl-key)) + ((and hbut-sym lbl-key + (not (eq (ibtype:def-symbol + (hattr:get 'hbut:current 'categ)) + 'hywiki-word))) + ;; On an implicit button other than a non-existing + ;; potential HyWikiWord, so link to it + ;; (message "%S" (hattr:list hbut-sym)) + (list 'link-to-ibut lbl-key (or (hypb:buffer-file-name) (buffer-name)))) + ((and (require 'bookmark) + (derived-mode-p 'bookmark-bmenu-mode) + (list 'link-to-bookmark (bookmark-bmenu-bookmark)))) + ((let (node) + (cond ((derived-mode-p 'Info-mode) + (if (and Info-current-node + (member Info-current-node + (Info-index-nodes Info-current-file)) + (Info-menu-item-at-p)) + (let ((hargs:reading-type 'Info-index-item)) + (list 'link-to-Info-index-item (hargs:at-p))) + (let ((hargs:reading-type 'Info-node)) + (list 'link-to-Info-node (hargs:at-p))))) + ((and (derived-mode-p 'texinfo-mode) (save-excursion - (goto-char (max (- start 3) (point-min))) - (when (looking-at "\\bid:") - (list 'link-to-org-id id))))))))) - - ;; Next clause forces use of any ibut name in the link - ;; and sets hbut:current button attributes. - (t (cond ((and (not (derived-mode-p 'dired-mode)) - (prog1 (setq hbut-sym (hbut:at-p)) - (when (ibut:is-p hbut-sym) - (save-excursion (ibut:at-to-name-p hbut-sym)))) - (setq lbl-key (hattr:get hbut-sym 'lbl-key)) - (eq (current-buffer) (get-file-buffer (gbut:file)))) - (list 'link-to-gbut lbl-key)) - ((and hbut-sym lbl-key (eq (hattr:get hbut-sym 'categ) 'explicit)) - (list 'link-to-ebut lbl-key)) - ((and hbut-sym lbl-key - (not (eq (ibtype:def-symbol - (hattr:get 'hbut:current 'categ)) - 'hywiki-word))) - ;; On an implicit button other than a non-existing - ;; potential HyWikiWord, so link to it - ;; (message "%S" (hattr:list hbut-sym)) - (list 'link-to-ibut lbl-key (or (hypb:buffer-file-name) (buffer-name)))) - ((and (require 'bookmark) - (derived-mode-p 'bookmark-bmenu-mode) - (list 'link-to-bookmark (bookmark-bmenu-bookmark)))) - ((let (node) - (cond ((derived-mode-p 'Info-mode) - (if (and Info-current-node - (member Info-current-node - (Info-index-nodes Info-current-file)) - (Info-menu-item-at-p)) - (let ((hargs:reading-type 'Info-index-item)) - (list 'link-to-Info-index-item (hargs:at-p))) - (let ((hargs:reading-type 'Info-node)) - (list 'link-to-Info-node (hargs:at-p))))) - ((and (derived-mode-p 'texinfo-mode) - (save-excursion - (beginning-of-line) - (when (or (looking-at "@node ") - (re-search-backward "^@node " nil t)) - (require 'texnfo-upd) - (setq node (texinfo-copy-node-name))))) - (list 'link-to-texinfo-node (hypb:buffer-file-name) node)) - ((hmail:reader-p) - (list 'link-to-mail - (list (rmail:msg-id-get) (hypb:buffer-file-name))))))) - (t (cond - ((let ((hargs:reading-type 'directory)) - (setq val (hargs:at-p t))) - (list 'link-to-directory val)) - ((let ((hargs:reading-type 'file)) - (setq val (hargs:at-p t))) - (list 'link-to-file val)) - ((derived-mode-p #'kotl-mode) - (list 'link-to-kcell (hypb:buffer-file-name) (kcell-view:idstamp))) - ;; - ;; If region is active in the target buffer and it is one - ;; line or less, then do a link-to-string-match to the region string. - ((let ((region (and (use-region-p) - (string-trim (buffer-substring-no-properties - (region-beginning) (region-end))))) + (beginning-of-line) + (when (or (looking-at "@node ") + (re-search-backward "^@node " nil t)) + (require 'texnfo-upd) + (setq node (texinfo-copy-node-name))))) + (list 'link-to-texinfo-node (hypb:buffer-file-name) node)) + ((hmail:reader-p) + (list 'link-to-mail + (list (rmail:msg-id-get) (hypb:buffer-file-name))))))) + (t (cond + ((let ((hargs:reading-type 'directory)) + (setq val (hargs:at-p t))) + (list 'link-to-directory val)) + ((let ((hargs:reading-type 'file)) + (setq val (hargs:at-p t))) + (list 'link-to-file val)) + ((derived-mode-p #'kotl-mode) + (list 'link-to-kcell (hypb:buffer-file-name) (kcell-view:idstamp))) + ;; + ;; If region is active in the target buffer and it is one + ;; line or less, then do a link-to-string-match to the region string. + ((let ((region (and (use-region-p) + (string-trim (buffer-substring-no-properties + (region-beginning) (region-end))))) + (instance-num 0)) + (when (and region + (not (string-empty-p region)) + ;; single line + (not (string-match "[\n\r\f]" region))) + (save-excursion + (end-of-line) + (while (search-backward region nil t) + (setq instance-num (1+ instance-num)))) + (list 'link-to-string-match region instance-num (hypb:buffer-file-name))))) + ;; + ;; If on a HyWiki page, use a link-to-wikiword + ((and hywiki-mode + (hywiki-in-page-p) + (stringp outline-regexp)) + (if (save-excursion + (beginning-of-line) + (looking-at outline-regexp)) + (let ((instance-num 0) + (title + (hpath:org-normalize-title + (hywiki-org-format-heading + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)) + t t t nil t)))) + (when (not (string-empty-p title)) + (save-excursion + (end-of-line) + (let ((exact-heading-regexp (hywiki-org-get-heading-match-regexp title))) + (while (re-search-backward exact-heading-regexp nil t) + (setq instance-num (1+ instance-num))))) + (list 'link-to-wikiword + (format "%s#%s%s" + (hywiki-get-buffer-page-name) + title + (if (> instance-num 1) (format ":I%d" instance-num) ""))))) + (list 'link-to-wikiword + (format "%s:L%d" + (hywiki-get-buffer-page-name) + (line-number-at-pos))))) + + ;; + ;; If in a non-HyWiki Org file, use a link-to-file-line + ((and (derived-mode-p 'org-mode) + (stringp outline-regexp)) + (if (save-excursion + (beginning-of-line) + (looking-at outline-regexp)) + (let ((instance-num 0) + (title + (hpath:org-normalize-title + (org-get-heading t t t)))) + (when (not (string-empty-p title)) + (save-excursion + (end-of-line) + (let ((exact-heading-regexp (hywiki-org-get-heading-match-regexp title))) + (while (re-search-backward exact-heading-regexp nil t) + (setq instance-num (1+ instance-num))))) + (list 'link-to-file + (format "%s#%s%s" + (hpath:shorten buffer-file-name) + title + (if (> instance-num 1) (format ":I%d" instance-num) ""))))) + (list 'link-to-file-line + (hpath:shorten buffer-file-name) + (line-number-at-pos)))) + ;; + ;; If current line starts with an outline-regexp prefix and + ;; has a non-empty heading, use a link-to-string-match. + ((and (hypb:buffer-file-name) + (derived-mode-p 'outline-mode 'kotl-mode) + (stringp outline-regexp) + (save-excursion + (beginning-of-line) + (looking-at outline-regexp)) + (let ((heading (string-trim + (buffer-substring-no-properties + (match-end 0) + (line-end-position)))) (instance-num 0)) - (when (and region - (not (string-empty-p region)) - ;; single line - (not (string-match "[\n\r\f]" region))) + (when (not (string-empty-p heading)) (save-excursion (end-of-line) - (while (search-backward region nil t) + (while (re-search-backward (format hpath:outline-section-pattern (regexp-quote heading)) + nil t) (setq instance-num (1+ instance-num)))) - (list 'link-to-string-match region instance-num (hypb:buffer-file-name))))) - ;; - ;; If on a HyWiki Org headline, use a link-to-wikiword - ;; - ((and hywiki-mode - (hywiki-in-page-p) - (stringp outline-regexp) - (save-excursion - (beginning-of-line) - (looking-at outline-regexp)) - (let ((title (hywiki-org-format-heading - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)) - t t t nil t)) - (instance-num 0)) - (when (not (string-empty-p title)) - (save-excursion - (end-of-line) - (let ((exact-heading-regexp (hywiki-org-get-heading-match-regexp title))) - (while (re-search-backward exact-heading-regexp nil t) - (setq instance-num (1+ instance-num))))) - (list 'link-to-wikiword - (format "%s#%s%s" - (hywiki-get-buffer-page-name) - title - (if (> instance-num 1) (format ":I%d" instance-num) ""))))))) - ;; - ;; If current line starts with an outline-regexp prefix and - ;; has a non-empty heading, use a link-to-string-match. - ((and (hypb:buffer-file-name) - (derived-mode-p 'outline-mode 'org-mode 'kotl-mode) - (stringp outline-regexp) - (save-excursion - (beginning-of-line) - (looking-at outline-regexp)) - (let ((heading (string-trim - (buffer-substring-no-properties - (match-end 0) - (line-end-position)))) - (instance-num 0)) - (when (not (string-empty-p heading)) - (save-excursion - (end-of-line) - (while (re-search-backward (format hpath:outline-section-pattern (regexp-quote heading)) - nil t) - (setq instance-num (1+ instance-num)))) - (list 'link-to-file - (format "%s#%s%s" - (hypb:buffer-file-name) - heading - (if (> instance-num 1) (format ":I%d" instance-num) ""))))))) - ((hypb:buffer-file-name) - (list 'link-to-file (hypb:buffer-file-name) (point))) - ((derived-mode-p 'dired-mode) - (list 'link-to-directory - (expand-file-name default-directory))) - (t (list 'link-to-buffer-tmp (buffer-name))))) - ;; - ;; Deleted link to elisp possibility as it can embed - ;; long elisp functions in the button data file and - ;; possibly not parse them correctly. - ;; - ;; (and (fboundp 'smart-emacs-lisp-mode-p) - ;; (smart-emacs-lisp-mode-p) - ;; (or (eq (char-syntax (following-char)) ?\() - ;; (eq (char-syntax (preceding-char)) ?\))) - ;; (setq val (hargs:sexpression-p)) - ;; (list 'eval-elisp val)) - ))))) + (list 'link-to-file + (format "%s#%s%s" + (hypb:buffer-file-name) + heading + (if (> instance-num 1) (format ":I%d" instance-num) ""))))))) + ((hypb:buffer-file-name) + (list 'link-to-file (hypb:buffer-file-name) (point))) + ((derived-mode-p 'dired-mode) + (list 'link-to-directory + (expand-file-name default-directory))) + (t (list 'link-to-buffer-tmp (buffer-name))))) + ;; + ;; Deleted link to elisp possibility as it can embed + ;; long elisp functions in the button data file and + ;; possibly not parse them correctly. + ;; + ;; (and (fboundp 'smart-emacs-lisp-mode-p) + ;; (smart-emacs-lisp-mode-p) + ;; (or (eq (char-syntax (following-char)) ?\() + ;; (eq (char-syntax (preceding-char)) ?\))) + ;; (setq val (hargs:sexpression-p)) + ;; (list 'eval-elisp val)) + ))))) ;; This is a referent button to link to, not the source button, ;; so clear it. (hattr:clear 'hbut:current)))) diff --git a/hywiki.el b/hywiki.el index 1a086474..f0805851 100644 --- a/hywiki.el +++ b/hywiki.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 21-Apr-24 at 22:41:13 -;; Last-Mod: 14-Mar-26 at 12:51:37 by Bob Weiner +;; Last-Mod: 16-Mar-26 at 21:18:30 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -319,9 +319,6 @@ Use nil for no HyWiki mode indicator." (defvar hywiki-allow-suffix-referent-types '(page path-link) "List of referent type symbols that support # and :L line number suffixes.") -(defvar hywiki-file-suffix ".org" - "File suffix string (including period) to use when creating HyWiki pages.") - ;;;###autoload (defun hywiki-let-directory (option value) (set option value) @@ -513,8 +510,12 @@ Nil by default." :initialize #'custom-initialize-default :group 'hyperbole-hywiki) +(defvar hywiki-file-suffix ".org" + "File suffix string (including period) to use when creating HyWiki pages.") + (defconst hywiki-word-regexp - "\\<\\([[:upper:]][[:alpha:]]+\\)\\>" + (format "\\<\\([[:upper:]][[:alpha:]]+\\)\\>\\(?:%s\\)?" + (regexp-quote hywiki-file-suffix)) "Regexp that matches a HyWikiWord only. Do not use a start or end line/string anchor in this regexp.") @@ -1075,14 +1076,15 @@ After successfully finding a referent, run `hywiki-display-referent-hook'." ;; "{key series}" wikiword '("Keys" (hywiki-add-key-series hkey-value) "Add a HyWikiWord that executes a key series.") + ;; "path" '("pathLink" (hywiki-add-path-link hkey-value) "Add a HyWikiWord that links to a path and possible position.") ;; "(hyperbole)Smart Keys" '("infoNode" (hywiki-add-info-node hkey-value) "Add a HyWikiWord that displays an Info node.") - ;; "ID: org-id" + ;; [[id:org-id"][Org Heading Title] '("OrgID" (hywiki-add-org-id hkey-value) - "Add a HyWikiWord that displays an Org section given its Org ID.") + "Add an Org link that displays an Org section given its Org ID.") ;; "pathname:line:col" ;; "#in-buffer-section" '("Page" (hywiki-add-page hkey-value) @@ -1363,34 +1365,32 @@ calling this function." (defun hywiki-add-org-id (wikiword) "Make WIKIWORD display an Org file or headline with an Org id. -If no id exists, it is created. Return the string \"ID: org-id-string\". +Point must be in the buffer with the id. If no id exists, it is created. +Return the referent created with the form: '(org-id . ). If WIKIWORD is invalid, trigger a `user-error' if called interactively or return nil if not. -After successfully adding the sexpression, run `hywiki-add-referent-hook'. +After successfully adding the Org id, run `hywiki-add-referent-hook'. Use `hywiki-get-referent' to determine whether WIKIWORD exists prior to calling this function." (interactive (list (or (hywiki-word-at) (hywiki-word-read-new "Add/Edit HyWikiWord: ")))) - (cl-destructuring-bind (_src-window referent-window) - (hmouse-choose-link-and-referent-windows) - (with-selected-window referent-window - (unless (hsys-org-mode-p) - (user-error "(hywiki-add-org-id): Referent buffer <%s> must be in org-mode, not %s" - (buffer-name) - major-mode)) - (let ((org-id (with-suppressed-warnings ((callargs org-id-get)) - (if (>= (action:param-count #'org-id-get) 4) - (org-id-get nil nil nil t) - (org-id-get))))) - (when (and (null org-id) buffer-read-only) - (user-error "(hywiki-add-org-id): Referent buffer <%s> point has no Org ID and buffer is read-only" - (buffer-name))) - (unless org-id - (setq org-id (org-id-get-create))) - (hywiki-add-referent wikiword (cons 'org-id (concat "ID: " org-id))))))) + (unless (hsys-org-mode-p) + (user-error "(hywiki-add-org-id): Referent buffer <%s> must be in org-mode, not %s" + (buffer-name) + major-mode)) + (let ((org-id (with-suppressed-warnings ((callargs org-id-get)) + (if (>= (action:param-count #'org-id-get) 4) + (org-id-get nil nil nil t) + (org-id-get))))) + (when (and (null org-id) buffer-read-only) + (user-error "(hywiki-add-org-id): Referent buffer <%s> point has no Org ID and buffer is read-only" + (buffer-name))) + (unless org-id + (setq org-id (org-id-get-create))) + (hywiki-add-referent wikiword (cons 'org-id org-id)))) (defun hywiki-display-org-id (_wikiword org-id) (hact 'link-to-org-id org-id)) @@ -1617,6 +1617,7 @@ or page exists." (defun hywiki-display-page (&optional wikiword file-name) "Display an optional WIKIWORD page and return the page file. Use `hywiki-display-page-function' to display the page. +Trigger an error if the page is not found. If FILE-NAME is provided, it includes any #section from the WIKIWORD. @@ -2920,16 +2921,18 @@ Always exclude minibuffer windows." (window-list frame :no-minibuf)))) (or frames (frame-list)))))) -(defun hywiki-get-page-file (file-stem-name) - "Return possibly non-existent path in `hywiki-directory' from FILE-STEM-NAME. +(defun hywiki-get-existing-page-file (file-stem-name) + "Return existing `hywiki-directory' path from FILE-STEM-NAME or nil. FILE-STEM-NAME should not contain a directory and may have or may omit `hywiki-file-suffix' and an optional trailing #section. -No validation of FILE-STEM-NAME is done except an empty string or null -value returns nil." +Checks only that FILE-STEM-NAME is not nil, not an empty string and does +not contain a directory path or returns nil." (make-directory hywiki-directory t) - (unless (or (null file-stem-name) (string-empty-p file-stem-name)) + (unless (or (null file-stem-name) (string-empty-p file-stem-name) + (file-name-directory file-stem-name)) (let (file-name + referent section) ;; Remove any suffix from `file-stem-name' and make it singular (if (string-match hywiki-word-suffix-regexp file-stem-name) @@ -2937,10 +2940,38 @@ value returns nil." file-name (hywiki-get-singular-wikiword (substring file-stem-name 0 (match-beginning 0)))) (setq file-name file-stem-name)) - (concat (expand-file-name file-name hywiki-directory) - (unless (string-suffix-p hywiki-file-suffix file-name) - hywiki-file-suffix) - section)))) + (setq referent (hywiki-get-referent file-name)) + (when (and (eq (car referent) 'page) + ;; The referent replaces the page name with name.org, so can be next. + (setq file-name (expand-file-name (cdr referent) hywiki-directory)) + (file-exists-p file-name)) + (concat file-name section))))) + +(defun hywiki-get-page-file (file-stem-name) + "Return possibly non-existent `hywiki-directory' path from FILE-STEM-NAME. +FILE-STEM-NAME may be an existing absolute file path; then, return it. +Otherwise, FILE-STEM-NAME should not contain a directory and may have or may +omit `hywiki-file-suffix' and an optional trailing #section. + +Checks only that FILE-STEM-NAME is not nil, not an empty string and does +not contain a directory path or returns nil." + (make-directory hywiki-directory t) + (if (and (stringp file-stem-name) (file-readable-p file-stem-name)) + file-stem-name + (unless (or (null file-stem-name) (string-empty-p file-stem-name) + (file-name-directory file-stem-name)) + (let (file-name + section) + ;; Remove any suffix from `file-stem-name' and make it singular + (if (string-match hywiki-word-suffix-regexp file-stem-name) + (setq section (match-string 0 file-stem-name) + file-name (hywiki-get-singular-wikiword + (substring file-stem-name 0 (match-beginning 0)))) + (setq file-name file-stem-name)) + (concat (expand-file-name file-name hywiki-directory) + (unless (string-suffix-p hywiki-file-suffix file-name) + hywiki-file-suffix) + section))))) (defun hywiki-get-page-files () "Return the list of existing HyWiki page file names. @@ -3220,7 +3251,8 @@ If such an instance is not found, trigger an error." (org-fold-show-entry)) ;; (message "Instance %d of '%s'" n title) t) - (error "(hywiki-org-to-heading-instance): Could not find %d instance(s) of '%s'" n title)))) + (error "(hywiki-org-to-heading-instance): Could not find %d instance(s) of '%s' in \"%s\"" + n title (or buffer-file-name (current-buffer)))))) (defun hywiki-make-referent-hasht () "Rebuld referent hasht from list of HyWiki page files and non-page entries." @@ -3365,15 +3397,17 @@ When NO-STATS is non-nil, don't include statistics in square brackets." (defun hywiki-org-get-heading-match-regexp (title) "Return a regexp that matches to the TITLE and start of an Org heading." ;; org-complex-heading-regexp + custom todo keywords + specific title - (format (concat "^\\(\\*+\\)" + (format (concat "^\\(\\*+[ \t]+\\)" ;; optional todo keyword - "\\(?: +" - hywiki--org-todo-regexp + "\\(?:" + (if (hywiki-in-page-p) + hywiki--org-todo-regexp + org-todo-regexp) "\\)?" ;; optional priority - "\\(?: +\\(\\[#.\\]\\)\\)?" + "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?" ;; title and optional stats - "\\(?: +\\(%s\\)\\)") + "\\(?:[ \t]*\\(%s\\)\\)") ;; exact title (regexp-quote title))) @@ -4095,8 +4129,9 @@ If point is on one, press RET immediately to use that one." (defun hywiki-page-exists-p (word) "Return HyWiki WORD iff it is an existing page reference." - (when (eq (car (hywiki-get-referent word)) 'page) - word)) + (and (stringp word) (not (file-name-directory word)) + (eq (car (hywiki-get-referent word)) 'page) + word)) (defun hywiki-page-read (&optional prompt initial) "Prompt with completion for and return an existing HyWiki page name. @@ -4573,18 +4608,19 @@ Initializes `hywiki--org-todo-regexp' and `hywiki--org-heading-regexp'." (setq hywiki--org-todo-regexp (hywiki-org-directory-todo-regexp hywiki-directory) hywiki--org-heading-regexp ;; org-complex-heading-regexp + custom todo keywords - (concat "^\\(\\*+\\)" - ;; optional todo keyword - "\\(?: +" - hywiki--org-todo-regexp - "\\)?" - ;; optional priority - "\\(?: +\\(\\[#.\\]\\)\\)?" - ;; optional title and stats - "\\(?: +\\(.*?\\)\\)??" - ;; optional tags - "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?" - "[ \t]*$"))) + (concat + ;; Make leading asterisks optional since (org-get-heading) may have + ;; already removed them. + "^\\(\\*+[ \t]+\\)?" + ;; optional todo keyword + "\\(?:" hywiki--org-todo-regexp "\\)?" + ;; optional priority + "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?" + ;; optional title and stats + "\\(?:[ \t]*\\(.*?\\)\\)??" + ;; optional tags + "\\(?:[ \t]*\\(:[[:alnum:]_@#%:]+:\\)\\)?" + "[ \t]*$"))) ;;; ************************************************************************ ;;; Private initializations diff --git a/man/hyperbole.texi b/man/hyperbole.texi index a2af9177..fcde768e 100644 --- a/man/hyperbole.texi +++ b/man/hyperbole.texi @@ -7,7 +7,7 @@ @c Author: Bob Weiner @c @c Orig-Date: 6-Nov-91 at 11:18:03 -@c Last-Mod: 7-Mar-26 at 23:32:46 by Bob Weiner +@c Last-Mod: 15-Mar-26 at 01:56:19 by Bob Weiner @c %**start of header (This is for running Texinfo on a region.) @setfilename hyperbole.info @@ -30,8 +30,8 @@ @set txicodequoteundirected @set txicodequotebacktick -@set UPDATED March 7, 2026 -@set UPDATED-MONTH Marc 2026 +@set UPDATED March 15, 2026 +@set UPDATED-MONTH March 2026 @set EDITION 9.0.2pre @set VERSION 9.0.2pre @@ -171,7 +171,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 Edition 9.0.2pre
-Printed March 7, 2026.
+Printed March 15, 2026.
 
   Published by the Free Software Foundation, Inc.
   Author:    Bob Weiner
@@ -213,7 +213,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
 @example
 Edition 9.0.2pre
-March 7, 2026 @c AUTO-REPLACE-ON-SAVE
+March 15, 2026 @c AUTO-REPLACE-ON-SAVE
 
 
   Published by the Free Software Foundation, Inc.
@@ -3887,8 +3887,8 @@ upon the referent context in which the Action Key is released.
 @example
 Referent Context         Link Type
 ----------------------------------------------------
-HyWikiWord Reference     link-to-wikiword
 Org Roam or Org Id       link-to-org-id
+HyWikiWord Reference     link-to-wikiword
 Global Button            link-to-gbut
 Explicit Button          link-to-ebut
 Implicit Button          link-to-ibut
@@ -3898,10 +3898,14 @@ Info Node                link-to-Info-node
 Texinfo Node             link-to-texinfo-node
 Mail Reader Message      link-to-mail
 Directory Name           link-to-directory
-Filename                 link-to-file
+File Name                link-to-file
 Koutline Cell            link-to-kcell
+Single-line Region       link-to-string-match
+HyWiki Page              link-to-wikiword
+Org Heading              link-to-file
 Outline Heading          link-to-file
 Buffer attached to File  link-to-file
+EOL in Dired Buffer      link-to-directory (Dired dir)
 Buffer without File      link-to-buffer-tmp
 @end example
 @end format
diff --git a/test/demo-tests.el b/test/demo-tests.el
index 66e1897c..cd2883b5 100644
--- a/test/demo-tests.el
+++ b/test/demo-tests.el
@@ -3,7 +3,7 @@
 ;; Author:       Mats Lidell 
 ;;
 ;; Orig-Date:    30-Jan-21 at 12:00:00
-;; Last-Mod:      7-Mar-26 at 17:41:33 by Bob Weiner
+;; Last-Mod:     16-Mar-26 at 00:16:06 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -243,24 +243,20 @@
       (hy-test-helpers:should-last-message "Result = nil; Boolean value = False" cap))))
 
 (ert-deftest demo-implicit-button-hash-link-test ()
-  (unwind-protect
-      (with-temp-buffer
-        (insert (format "\"%s%s\"" (expand-file-name "README.md" hyperb:dir) "#why-was-hyperbole-developed"))
-        (goto-char 5)
-        (action-key)
-        (should (string= "README.md" (buffer-name)))
-        (should (looking-at "## Why was Hyperbole developed\\?")))
-    (hy-test-helpers:kill-buffer "README.md")))
+  (with-temp-buffer
+    (insert (format "\"%s%s\"" (expand-file-name "README.md" hyperb:dir) "#why-was-hyperbole-developed"))
+    (goto-char 5)
+    (action-key)
+    (should (string= "README.md" (buffer-name)))
+    (should (looking-at "## Why was Hyperbole developed\\?"))))
 
 (ert-deftest demo-implicit-button-line-and-column-rtest ()
-  (unwind-protect
-      (with-temp-buffer
-        (insert (format "\"%s%s\"" (expand-file-name "HY-ABOUT" hyperb:dir) ":5:46"))
-        (goto-char 5)
-        (action-key)
-        (should (string= "HY-ABOUT" (buffer-name)))
-        (should (looking-at "hyperbole/")))
-    (hy-test-helpers:kill-buffer "HY-ABOUT")))
+  (with-temp-buffer
+    (insert (format "\"%s%s\"" (expand-file-name "HY-ABOUT" hyperb:dir) ":5:46"))
+    (goto-char 5)
+    (action-key)
+    (should (string= "HY-ABOUT" (buffer-name)))
+    (should (looking-at "hyperbole/"))))
 
 ;; org
 (ert-deftest demo-org-hide-header-test ()
@@ -289,9 +285,8 @@
         (action-key)
         (should (string= "DEMO" (buffer-name)))
         (should (looking-at "\* GNU Hyperbole Full Demo")))
-    (progn
-      (hy-test-helpers:kill-buffer "MANIFEST")
-      (hy-test-helpers:kill-buffer "DEMO"))))
+    (hy-test-helpers:kill-buffer "MANIFEST")
+    (hy-test-helpers:kill-buffer "DEMO")))
 
 ;; Email compose
 (ert-deftest demo-mail-compose-test ()
@@ -807,19 +802,17 @@ enough files with matching mode loaded."
   "Verify a kotl file can be displayed properly from a cell ref."
   (let ((default-directory)
 	(buf))
-    (unwind-protect
-	(with-temp-buffer
-	  (setq default-directory hyperb:dir)
-          (insert (format "<%skotl/EXAMPLE.kotl#3b10|c2en>"
-			  default-directory))
-          (goto-char 5)
-          (action-key)
-	  (setq buf (current-buffer))
-          (should (string-suffix-p "EXAMPLE.kotl" buffer-file-name))
-          (should (looking-at-p "Cell Transposition:"))
-	  ;; Ensure visible cell length is cutoff at 2 lines
-	  (should (= 2 (hypb:string-count-matches "\n" (kcell-view:contents)))))
-      (hy-test-helpers:kill-buffer buf))))
+    (with-temp-buffer
+      (setq default-directory hyperb:dir)
+      (insert (format "<%skotl/EXAMPLE.kotl#3b10|c2en>"
+		      default-directory))
+      (goto-char 5)
+      (action-key)
+      (setq buf (current-buffer))
+      (should (string-suffix-p "EXAMPLE.kotl" buffer-file-name))
+      (should (looking-at-p "Cell Transposition:"))
+      ;; Ensure visible cell length is cutoff at 2 lines
+      (should (= 2 (hypb:string-count-matches "\n" (kcell-view:contents)))))))
 
 (provide 'demo-tests)
 
diff --git a/test/hibtypes-tests.el b/test/hibtypes-tests.el
index 1b75d356..dc2635ff 100644
--- a/test/hibtypes-tests.el
+++ b/test/hibtypes-tests.el
@@ -3,7 +3,7 @@
 ;; Author:       Mats Lidell 
 ;;
 ;; Orig-Date:    20-Feb-21 at 23:45:00
-;; Last-Mod:     28-Feb-26 at 18:04:06 by Bob Weiner
+;; Last-Mod:     15-Mar-26 at 17:11:01 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -416,10 +416,10 @@ file.el:10:20: Warning: Message
 :ID: %s
 :END:
 
-
+
 " id id))
           (goto-char (point-min))
-          (should (and (search-forward " t))
             (should (ibtypes::org-id))))
       (hy-delete-file-and-buffer file))))
diff --git a/test/hy-test-helpers.el b/test/hy-test-helpers.el
index 5e4d534d..3418e850 100644
--- a/test/hy-test-helpers.el
+++ b/test/hy-test-helpers.el
@@ -3,7 +3,7 @@
 ;; Author:       Mats Lidell 
 ;;
 ;; Orig-Date:    30-Jan-21 at 12:00:00
-;; Last-Mod:     18-Oct-25 at 00:31:06 by Mats Lidell
+;; Last-Mod:     15-Mar-26 at 23:21:21 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -77,6 +77,7 @@ processing."
 
 (defun hy-test-helpers:kill-buffer (buffer)
   "Kill BUFFER if it exists."
+  (unless buffer (debug))
   (when (get-buffer buffer)
     (kill-buffer buffer)))
 
diff --git a/test/hywiki-tests.el b/test/hywiki-tests.el
index a9eb1e3a..40dadd04 100644
--- a/test/hywiki-tests.el
+++ b/test/hywiki-tests.el
@@ -3,7 +3,7 @@
 ;; Author:       Mats Lidell
 ;;
 ;; Orig-Date:    18-May-24 at 23:59:48
-;; Last-Mod:     14-Mar-26 at 21:49:13 by Mats Lidell
+;; Last-Mod:     16-Mar-26 at 21:52:06 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -1186,15 +1186,15 @@ Note special meaning of `hywiki-allow-plurals-flag'."
 		     (hywiki-get-referent wikiword))))))
 
 (ert-deftest hywiki-tests--add-org-id ()
-  "Verify `hywiki-add-org-id'."
+  "Verify `hywiki-add-org-id' and read back with `hywiki-get-referent'."
   ;; Error case - Non org-mode buffer
   (hywiki-tests--preserve-hywiki-mode
     (let ((wikiword "WikiWord")
           (filea (make-temp-file "hypb" nil ".txt")))
       (unwind-protect
           (with-current-buffer (find-file filea)
-            (mocklet (((hmouse-choose-link-and-referent-windows) => (list nil (get-buffer-window))))
-              (should-error (hywiki-add-org-id wikiword) :type '(error))))
+            ;; Error because not in Org mode
+            (should-error (hywiki-add-org-id wikiword) :type '(error)))
 	(hy-delete-file-and-buffer filea))
 
       (let ((filea (make-temp-file "hypb" nil ".org")))
@@ -1204,17 +1204,18 @@ Note special meaning of `hywiki-allow-plurals-flag'."
 
               ;; Error-case - No Org ID and read only
               (setq buffer-read-only t)
-              (mocklet (((hmouse-choose-link-and-referent-windows) => (list nil (get-buffer-window))))
-	        (should-error (hywiki-add-org-id wikiword) :type '(error))
-
-                ;; Normal case - Org-mode with Org ID
-                (goto-char (point-max))
-                (setq buffer-read-only nil)
-	        (let ((referent-value (cdr (hywiki-add-org-id wikiword))))
-		  (if (stringp referent-value)
-		      (should (string-prefix-p "ID: " referent-value))
-		    (error "(hywiki-tests--add-org-id): referent value is a non-string: %s" referent-value)))))
-	  (hy-delete-file-and-buffer filea))))))
+	      (should-error (hywiki-add-org-id wikiword) :type '(error))
+
+              ;; Normal case - Org-mode with Org ID
+              (goto-char (point-max))
+              (setq buffer-read-only nil)
+              (hywiki-add-org-id wikiword)
+	      (let* ((referent (hywiki-get-referent wikiword))
+                     (referent-type (car referent))
+                     (referent-value (cdr referent)))
+                (should (eq referent-type 'org-id))
+		(should (and (stringp referent-value) (not (string-empty-p referent-value))))))
+	(hy-delete-file-and-buffer filea))))))
 
 (ert-deftest hywiki-tests--add-org-roam-node ()
   "Verify `hywiki-add-org-roam-node'."
@@ -1365,21 +1366,19 @@ named WikiReferent with a non-page referent type."
   "Verify saving and loading a referent global-button works using Hyperbole's menu."
   (skip-unless (not noninteractive))
   (hywiki-tests--referent-test
-    (progn
-      (sit-for 0.2)
-      (cons 'global-button "global"))
-    (defvar test-buffer)
-    (let* ((test-file (make-temp-file "gbut" nil ".txt"))
-           (test-buffer (find-file-noselect test-file)))
+    (cons 'global-button "global")
+    (let* ((gbut-file (make-temp-file hbmap:filename nil nil))
+	   (hbmap:filename (file-name-nondirectory gbut-file))
+	   (hbmap:dir-user (file-name-directory gbut-file))
+	   (hbmap:dir-filename (expand-file-name  "HBMAP" hbmap:dir-user))
+           (gbut-buffer (find-file-noselect gbut-file)))
       (unwind-protect
-          (with-mock
-            (mock (hpath:find-noselect (expand-file-name hbmap:filename hbmap:dir-user)) => test-buffer)
-            (stub gbut:label-list => (list "global"))
-            (mock (gbut:act "global") => t)
-            (gbut:ebut-program "global" 'link-to-file test-file)
+	  (progn
+            (gbut:ebut-program "global" 'link-to-file gbut-file)
             (should (hact 'kbd-key "C-u C-h hhc WikiReferent RET g global RET"))
             (hy-test-helpers:consume-input-events))
-        (hy-delete-file-and-buffer test-file)))))
+        (hy-delete-files-and-buffers (list gbut-file hbmap:filename hbmap:dir-filename))))))
+
 
 ;; HyRolo
 (ert-deftest hywiki-tests--save-referent-hyrolo ()
@@ -1448,16 +1447,16 @@ named WikiReferent with a non-page referent type."
 (ert-deftest hywiki-tests--save-referent-org-id ()
   "Verify saving and loading a referent org id works."
   (hywiki-tests--referent-test
-    (cons 'org-id "ID: generated-org-id")
+    (cons 'org-id "generated-org-id")
     (save-excursion
       (let ((filea (make-temp-file "hypb" nil ".org")))
         (unwind-protect
             (with-current-buffer (find-file filea)
               (hywiki-tests--insert "* header\n")
-              (mocklet (((hmouse-choose-link-and-referent-windows) => (list nil (get-buffer-window)))
-                        ((org-id-get-create) => "generated-org-id"))
+              (mocklet (((org-id-get) => "generated-org-id"))
                 (goto-char (point-max))
-	        (hywiki-add-org-id wiki-word-non-page)))
+	        (hywiki-add-org-id wiki-word-non-page)
+                (hywiki-get-referent wiki-word-non-page)))
 	  (hy-delete-file-and-buffer filea))))))
 
 ;; !! FIXME: Add Org-id links tests.
@@ -2288,7 +2287,7 @@ expected result."
     (let ((hsys-org-enable-smart-keys t))
       (org-mode)
       (hywiki-tests--insert "[[file:WikiWord.org][WikiWord Description]]")
-      (font-lock-ensure)
+      ;; (font-lock-ensure)
       (search-backward "WikiWord")
       (should (eq (org-element-type (org-element-context)) 'link))
       (should (ibtype:test-p 'hywiki-existing-word)))))