[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole 4bff008242 7/9: hywiki.el - Many fixes and up
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole 4bff008242 7/9: hywiki.el - Many fixes and updates plus Smart Key fixes |
|
Date: |
Mon, 16 Dec 2024 15:58:32 -0500 (EST) |
branch: externals/hyperbole
commit 4bff008242b30a99f51c12e357e7a95430d4b11d
Author: bw <rsw@gnu.org>
Commit: bw <rsw@gnu.org>
hywiki.el - Many fixes and updates plus Smart Key fixes
Fix HyWikiWord tests with updates to support varying referent types.
Remove a number of byte-compiler warnings.
hbut.el (ibut:set-name-and-label-key-p): Add set of ibut 'loc attribute
needed by a number of tests.
hmouse-tag.el (smart-tags-file-list, smart-ancestor-tag-files): Fix to
handle a list of directories as the first argument in which to look
for TAGS files, as used by 'smart-man-c-routine-ref' in "hui-mouse.el".
hui-mouse.el (smart-man-c-routine-ref): Update to support use of newer
'Man-header-file-path' variable.
hywiki.el (hywiki-clear-pages-hasht): Add and use in defcustom :set
method of `hywiki-directory' to ensure hash table is emptied including
all non-page referents when 'hywiki-directory' is changed.
hibtypes.el (action): Add :name arg to 'ibut:create' call.
hywiki.el (hywiki-display-page): Set 'referent' attribute for
current button.
hsys-org.el (hsys-org-link-at-p): Change to ignore [[hy:MyWikiWord]]
links.
hywiki.el (hywiki-word-at): Change to handle [[hy:MyWikiWord]] links.
(hywiki-strip-org-link): Also strip hy: prefix from a link.
hywiki.el (hywiki-get-plural-wikiword): Return non-nil iff
'hywiki-allow-plurals-flag' is set.
(hywiki-allow-plurals-flag): Reset 'hywiki--any-page-regexp-list'
whenever this variable is set.
---
ChangeLog | 75 ++++++++++-
hbdata.el | 3 +-
hbut.el | 127 ++++++++----------
hibtypes.el | 17 +--
hmouse-drv.el | 33 ++---
hmouse-tag.el | 97 ++++++++------
hpath.el | 6 +-
hsys-org.el | 27 ++--
hui-mini.el | 8 +-
hui-mouse.el | 6 +-
hypb.el | 3 +-
hywiki.el | 340 +++++++++++++++++++++++++++---------------------
test/hbut-tests.el | 5 +-
test/hy-test-helpers.el | 14 +-
test/hywiki-tests.el | 30 ++++-
15 files changed, 460 insertions(+), 331 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index e96dc2dece..7c148bcf25 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,79 @@
+2024-12-15 Bob Weiner <rsw@gnu.org>
+
+* test/hywiki-tests.el (hywiki-tests--action-key-on-wikiword-displays-page):
+ Change mocklet call from 'hywiki-add-page' to newer
+ 'hywiki-display-referent' to fix the test.
+
+* test/hywiki-tests.el (hywiki-tests--active-in-current-buffer-p): Force
+ 'hywiki-mode' nil when testing that hywiki is not active.
+
+* hpath.el (hpath:shorten): Fix to normalize directory paths to end with
+ a dir separator char so compare properly to `default-directory'.
+
+* hbut.el (ebut:get): Remove unneeded local 'actype'.
+
+* test/hywiki-tests.el (hywiki-tests--assist-key-on-wikiword-displays-help):
+ Update to not use mocklet and to check WikiWord returned.
+
+* hywiki.el (hywiki-word, hywiki-word-at): Rewrite to get the proper
+ start and end buffer positions of any wikiword string, accounting for
+ Org link complexities much better than before.
+
+* hbut.el (hbut:source): Update doc to reflect that the caller must have
+ successfully searched for 'hbut:source-prefix' prior to calling this.
+ (ibut:set-name-and-label-key-p): Add set of ibut 'loc attribute
+ needed by a number of tests.
+
+* hmouse-tag.el (smart-tags-file-list, smart-ancestor-tag-files): Fix to
+ handle a list of directories as the first argument in which to look
+ for TAGS files, as used by 'smart-man-c-routine-ref' in "hui-mouse.el".
+ hui-mouse.el (smart-man-c-routine-ref): Update to support use of newer
+ 'Man-header-file-path' variable.
+
+2024-12-02 Bob Weiner <rsw@gnu.org>
+
+* hywiki.el (hywiki-clear-pages-hasht): Add and use in defcustom :set
+ method of `hywiki-directory' to ensure hash table is emptied including
+ all non-page referents when 'hywiki-directory' is changed.
+
2024-12-01 Bob Weiner <rsw@gnu.org>
+* hmouse-drv.el (action-key-depress, assist-key-depress, hkey-help): Add
+ calls to (hattr:clear 'hbut:current) to clear 'hbut:current' button
+ attributes before depress,
+
+* hbut.el (ibut:create): Move setting of 'hbut:current HyWiki 'referent
+ attribute from 'hkey-help' to this function, so works with all
+ ibutton reports. Also, remove 'name-and-lbl-key-flag' from check
+ of whether to set attributes to the current button values. Also,
+ move call of 'hbut:report' when called interactively to here from
+ 'ibut:set-name-and-label-key-p' so works with all ibutton reports.
+ (ibut:set-name-and-label-key-p): Fix to return non-nil only when
+ 'lbl-key' or 'name' are set.
+ (ebut:get): Remove Hyperbole V1 setting of 'referent' attribute
+ from (hbdata:referent) so as not to confuse new use of same attribute
+ for HyWiki referents.
+ hibtypes.el (action): Add :name arg to 'ibut:create' call.
+
+* hywiki.el (hywiki-display-page): Set 'referent' attribute for
+ current button.
+
+* hsys-org.el (hsys-org-link-at-p): Change to ignore [[hy:MyWikiWord]]
+ links.
+ hywiki.el (hywiki-word-at): Change to handle [[hy:MyWikiWord]] links.
+ (hywiki-strip-org-link): Also strip hy: prefix from a link.
+
+* hywiki.el (hywiki-get-plural-wikiword): Return non-nil iff
+ 'hywiki-allow-plurals-flag' is set.
+ (hywiki-get-page-hasht): Remove any nil return values from
+ calling 'hywiki-allow-plurals-flag'.
+ (hywiki-allow-plurals-flag): Reset 'hywiki--any-page-regexp-list'
+ whenever this variable is set.
+
+* test/hywiki-tests.el (hywiki-tests--action-key-on-wikiword-displays-page,
+ hywiki-tests--assist-key-on-wikiword-displays-help):
+ Update to test Action and Assist Key behavior.
+
* hywiki.el: Add additional require, defvar and declare-function to
remove byte-compiler warnings.
@@ -68,7 +142,6 @@
* hibtypes.el (hywiki-word:help): Add so Assist Key on a HyWikiWord
customizes its referent type and link.
- hywiki.el its referent type and link.
2024-11-24 Mats Lidell <matsl@gnu.org>
diff --git a/hbdata.el b/hbdata.el
index 02c128c10d..10253dd8f5 100644
--- a/hbdata.el
+++ b/hbdata.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 2-Apr-91
-;; Last-Mod: 18-Feb-24 at 11:32:03 by Mats Lidell
+;; Last-Mod: 2-Dec-24 at 01:48:15 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -253,7 +253,6 @@ entry, otherwise modify existing one. Nil BUT-SYM means use
(let* ((actype)
(hbdata (list (hattr:get b 'lbl-key)
(hattr:get b 'action)
- ;; Hyperbole V1 referent compatibility, always nil
in V2
(hattr:get b 'referent)
;; Save actype without class prefix.
(and (setq actype (hattr:get b 'actype))
diff --git a/hbut.el b/hbut.el
index 4cd3790bec..1968fa300e 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: 18-Nov-24 at 20:17:13 by Bob Weiner
+;; Last-Mod: 15-Dec-24 at 22:35:20 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -45,6 +45,7 @@ Use the function, (hbut:max-len), to read the proper value.")
(defvar hproperty:but-face)
(defvar hproperty:ibut-face)
+(defvar hywiki-org-link-type)
(declare-function hargs:delimited "hargs")
(declare-function hargs:read-match "hargs")
@@ -61,6 +62,7 @@ Use the function, (hbut:max-len), to read the proper value.")
(declare-function hui:ibut-rename "hui")
(declare-function hui:key-dir "hui")
(declare-function hui:key-src "hui")
+(declare-function hywiki-get-referent "hywiki")
(declare-function kbd-key:act "hib-kbd")
(declare-function kbd-key:is-p "hib-kbd")
(declare-function org-context "org")
@@ -222,8 +224,7 @@ buffer.
Return nil if no matching button is found."
(hattr:clear 'hbut:current)
(save-excursion
- (let (actype
- but-data
+ (let (but-data
key-dir
key-file
lbl-end
@@ -262,11 +263,7 @@ Return nil if no matching button is found."
(hattr:set 'hbut:current 'categ 'explicit)
(hattr:set 'hbut:current 'action nil)
(hattr:set 'hbut:current 'actype
- (intern (setq actype (hbdata:actype but-data))))
- ;; Hyperbole V1 referent compatibility
- (when (= (length actype) 2)
- (hattr:set 'hbut:current 'referent
- (hbdata:referent but-data)))
+ (intern (hbdata:actype but-data)))
(hattr:set 'hbut:current 'args (hbdata:args but-data))
(hattr:set 'hbut:current 'creator (hbdata:creator but-data))
(hattr:set 'hbut:current
@@ -1711,7 +1708,9 @@ Return number of buttons reported on or nil if none."
(defun hbut:source (&optional full-flag)
"Return Hyperbole source buffer or file given at point.
-If a file, always return a full path if optional FULL-FLAG is non-nil."
+If a file, always return a full path if optional FULL-FLAG is non-nil.
+Caller must have successfully searched for `hbut:source-prefix' prior
+to calling this."
(save-excursion
(goto-char (match-end 0))
(cond ((looking-at "#<buffer \"?\\([^\n\"]+\\)\"?>")
@@ -1855,7 +1854,6 @@ attribute unless the button text is delimited.
Any implicit button name must contain at least two characters,
excluding delimiters, not just one."
- (interactive)
(let* ((opoint (point-marker))
;; Next line finds the name only if point is on it, not on the
;; text of the button.
@@ -1876,8 +1874,8 @@ excluding delimiters, not just one."
(progn
;; Move past up to 2 possible characters of
ibut
;; delimiters; this prevents recognizing
named,
- ;; delimited ibuts of a single character
since no one
- ;; should need that.
+ ;; delimited ibuts of a single character since
+ ;; no one should need that.
(goto-char (min (+ 2 (match-end 0))
(point-max)))
(match-end 0))
(prog1 (point)
@@ -1896,7 +1894,14 @@ excluding delimiters, not just one."
(when lbl-start-end
(setq lbl-key (nth 0 lbl-start-end)
lbl-start (nth 1 lbl-start-end)
- lbl-end (nth 2 lbl-start-end)))
+ lbl-end (nth 2 lbl-start-end))
+ (when (and (stringp lbl-key)
+ (string-prefix-p (concat hywiki-org-link-type ":")
lbl-key t))
+ ;; Remove any HyWiki org-link-type prefix
+ (setq lbl-key (substring lbl-key 3)
+ lbl-start (+ lbl-start (length hywiki-org-link-type) 1))))
+ (hattr:set 'hbut:current 'loc (save-excursion
+ (hbut:to-key-src 'full)))
(when lbl-start
(hattr:set 'hbut:current 'categ 'implicit)
(hattr:set 'hbut:current 'lbl-key lbl-key)
@@ -1927,10 +1932,7 @@ excluding delimiters, not just one."
(when (and name-start name-end)
(hattr:set 'hbut:current 'name-start name-start)
(hattr:set 'hbut:current 'name-end name-end))
- (when lbl-start
- (when (called-interactively-p 'any)
- (let (help-window-select)
- (hbut:report)))
+ (when (or lbl-key name)
t))
(goto-char opoint)
(setq opoint nil))))
@@ -1951,6 +1953,7 @@ return nil if no implicit button is found at point.
If a new button is created, store its attributes in the symbol,
\\='hbut:current."
+ (interactive)
;; :args is ignored unless :categ or :action is also given.
;; `lbl-key' attribute will be set from `but-sym' if any, the button
@@ -2033,83 +2036,57 @@ If a new button is created, store its attributes in the
symbol,
name-start
name-end)
- (cond ((and but-sym-flag current-name)
- (setq name current-name))
- ((or name name-and-lbl-key-flag))
- (current-name
- (setq name current-name)))
+ (when (and current-name (or but-sym-flag (null name)))
+ (setq name current-name))
(when name
(hattr:set 'hbut:current 'name name))
- (cond ((and but-sym-flag current-name-start)
- (setq name-start current-name-start))
- ((or name-start name-and-lbl-key-flag))
- (current-name-start
- (setq name-start current-name-start)))
+ (when (and current-name-start (or but-sym-flag (null name-start)))
+ (setq name-start current-name-start))
(when name-start
(hattr:set 'hbut:current 'name-start name-start))
- (cond ((and but-sym-flag current-name-end)
- (setq name-end current-name-end))
- ((or name-end name-and-lbl-key-flag))
- (current-name-end
- (setq name-end current-name-end)))
+ (when (and current-name-end (or but-sym-flag (null name-end)))
+ (setq name-end current-name-end))
(when name-end
(hattr:set 'hbut:current 'name-end name-end))
- (cond ((and but-sym-flag current-lbl-key)
- (setq lbl-key current-lbl-key))
- ((or lbl-key name-and-lbl-key-flag))
- (current-lbl-key
- (setq lbl-key current-lbl-key)))
+ (when (and current-lbl-key (or but-sym-flag (null lbl-key)))
+ (setq lbl-key current-lbl-key))
(when lbl-key
(hattr:set 'hbut:current 'lbl-key lbl-key))
- (cond ((and but-sym-flag current-lbl-start)
- (setq lbl-start current-lbl-start))
- ((or lbl-start name-and-lbl-key-flag))
- (current-lbl-start
- (setq lbl-start current-lbl-start)))
+ (when (and current-lbl-start (or but-sym-flag (null lbl-start)))
+ (setq lbl-start current-lbl-start))
(when lbl-start
(hattr:set 'hbut:current 'lbl-start lbl-start))
- (cond ((and but-sym-flag current-lbl-end)
- (setq lbl-end current-lbl-end))
- ((or lbl-end name-and-lbl-key-flag))
- (current-lbl-end
- (setq lbl-end current-lbl-end)))
+ (when (and current-lbl-end (or but-sym-flag (null lbl-end)))
+ (setq lbl-end current-lbl-end))
(when lbl-end
(hattr:set 'hbut:current 'lbl-end lbl-end))
- (cond ((and but-sym-flag current-loc)
- (setq loc current-loc))
- ((or loc (setq loc (save-excursion
- (hbut:to-key-src 'full)))))
- (current-loc
- (setq loc current-loc)))
+ (when (and current-loc (or but-sym-flag (null loc)))
+ (setq loc (or (save-excursion
+ (hbut:to-key-src 'full))
+ current-loc)))
(when loc
(hattr:set 'hbut:current 'loc loc))
- (cond ((and but-sym-flag current-dir)
- (setq dir current-dir))
- ((or dir (setq dir (hui:key-dir (current-buffer)))))
- (current-dir
- (setq dir current-dir)))
+ (when (and current-dir (or but-sym-flag (null dir)))
+ (setq dir (or (hui:key-dir (current-buffer))
+ current-dir)))
(when dir
(hattr:set 'hbut:current 'dir dir))
- (cond ((and but-sym-flag current-action)
- (setq action current-action))
- (action)
- (current-action
- (setq action current-action)))
+ (when (and current-action (or but-sym-flag (null action)))
+ (setq action current-action))
(when action
(hattr:set 'hbut:current 'action action))
- (cond ((and but-sym-flag current-categ)
+ (cond ((and current-categ but-sym-flag)
(setq categ current-categ))
- (categ)
- (t
+ ((null categ)
(setq categ (or is-type current-categ 'implicit))))
(when categ
(hattr:set 'hbut:current 'categ categ))
@@ -2126,11 +2103,8 @@ If a new button is created, store its attributes in the
symbol,
(when (eq (car args) #'hact)
(setq args (cdr args))))
- (cond ((and but-sym-flag current-actype)
- (setq actype current-actype))
- (actype)
- (current-actype
- (setq actype current-actype)))
+ (when (and current-actype (or but-sym-flag (null actype)))
+ (setq actype current-actype))
(unless actype
(setq actype (or
;; Hyperbole action type
@@ -2140,7 +2114,16 @@ If a new button is created, store its attributes in the
symbol,
(hattr:set 'hbut:current 'actype actype)
(when args
- (hattr:set 'hbut:current 'args (if actype (cdr args) args))))
+ (hattr:set 'hbut:current 'args (if actype (cdr args) args)))
+
+ (when (and lbl-key (eq actype #'hywiki-find-referent))
+ ;; If a HyWikiWord ibut, save its referent as an attribute
+ (hattr:set 'hbut:current 'referent (hywiki-get-referent
lbl-key)))
+
+ (when lbl-key
+ (when (called-interactively-p 'any)
+ (let (help-window-select)
+ (hbut:report)))))
(hbdata:ibut-instance-next (ibut:label-to-key name))))
(set-marker opoint nil))))
diff --git a/hibtypes.el b/hibtypes.el
index 9534676d5d..061b52e32a 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: 24-Nov-24 at 14:41:45 by Bob Weiner
+;; Last-Mod: 1-Dec-24 at 20:33:59 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1571,6 +1571,7 @@ action type, function symbol to call or test to execute,
i.e.
<mail nil \"user@somewhere.org\">."
(let ((hbut:max-len 0)
(lbl-key (hattr:get 'hbut:current 'lbl-key))
+ (name (hattr:get 'hbut:current 'name))
(start-pos (hattr:get 'hbut:current 'lbl-start))
(end-pos (hattr:get 'hbut:current 'lbl-end))
actype actype-sym action args lbl var-flag)
@@ -1647,8 +1648,9 @@ action type, function symbol to call or test to execute,
i.e.
;; Create implicit button object and store in symbol hbut:current.
(ibut:label-set lbl)
- (ibut:create :lbl-key lbl-key :lbl-start start-pos :lbl-end end-pos
- :categ 'ibtypes::action :actype actype :args args)
+ (ibut:create :name name :lbl-key lbl-key :lbl-start start-pos
+ :lbl-end end-pos :categ 'ibtypes::action :actype actype
+ :args args)
;; Necessary so can return a null value, which actype:act cannot.
(let ((hrule:action
@@ -1698,15 +1700,6 @@ If a boolean function or variable, display its value."
(ibut:label-set wikiword))
(hact 'hywiki-find-referent wikiword))))
-(defun hywiki-existing-word:help (wikiword)
- "When on a HyWikiWord, customize its referent type and link."
- (interactive (list (hywiki-word-at)))
- (unless (stringp wikiword)
- (setq wikiword (hywiki-word-at)))
- (when wikiword
- (ibut:label-set wikiword (match-beginning 0) (match-end 0))
- (hywiki-find-referent wikiword t)))
-
;;; ========================================================================
;;; Inserts completion into minibuffer or other window.
;;; ========================================================================
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 590f7ee594..e9a3583353 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 24-Nov-24 at 16:27:49 by Bob Weiner
+;; Last-Mod: 15-Dec-24 at 22:38:04 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -63,14 +63,15 @@
(declare-function hkey-quit-window "hmouse-drv") ; Alias defined in this file.
-(declare-function hattr:report "hbut")
-(declare-function hattr:list "hbut")
(declare-function br-in-browser "hpath")
-(declare-function hbut:label "hbut")
+(declare-function hattr:clear "hbut")
(declare-function hattr:get "hbut")
+(declare-function hattr:list "hbut")
+(declare-function hattr:report "hbut")
+(declare-function hbut:label "hbut")
+(declare-function hkey-set-key "hyperbole")
(declare-function hui:ebut-link-directly "hui")
(declare-function hui:ibut-link-directly "hui")
-(declare-function hkey-set-key "hyperbole")
(declare-function org-todo "org")
;;; ************************************************************************
@@ -198,6 +199,8 @@ This permits the Smart Keys to behave as paste keys.")
(defun action-key-depress (&rest args)
"Register depress of the Hyperbole Action Mouse Key."
(interactive)
+ (hattr:clear 'hbut:current)
+ (action-key-clear-variables)
(cond (assist-key-depressed-flag
(or action-key-help-flag
(setq assist-key-help-flag t)))
@@ -223,6 +226,7 @@ This permits the Smart Keys to behave as paste keys.")
(defun assist-key-depress (&rest args)
"Register depress of the Hyperbole Assist Mouse Key."
(interactive)
+ (assist-key-clear-variables)
(cond (action-key-depressed-flag
(or assist-key-help-flag
(setq action-key-help-flag t)))
@@ -352,6 +356,7 @@ the `action-key-default-function' variable is run. Return t
unless the `action-key-default-function' variable is not bound to
a valid function."
(interactive)
+ (hattr:clear 'hbut:current)
(action-key-clear-variables)
(unwind-protect
(prog1 (action-key-internal)
@@ -1052,6 +1057,7 @@ With optional ASSISTING prefix arg non-nil, display help
for the
Assist Key command. Return non-nil iff associated help
documentation is found."
(interactive "P")
+ (hattr:clear 'hbut:current)
(let* ((mouse-flag (when (mouse-event-p last-command-event)
(or action-key-depress-position
assist-key-depress-position)))
(mouse-drag-flag (hmouse-drag-p))
@@ -1142,17 +1148,10 @@ documentation is found."
(when (memq cmd-sym '(hui:hbut-act hui:hbut-help))
(let ((actype (or (actype:elisp-symbol (hattr:get
'hbut:current 'actype))
(hattr:get 'hbut:current 'actype)))
- (lbl-key (hattr:get 'hbut:current 'lbl-key))
+ ;; (lbl-key (hattr:get 'hbut:current 'lbl-key))
(categ (hattr:get 'hbut:current 'categ))
(attributes (nthcdr 2 (hattr:list 'hbut:current))))
- ;; If a HyWikiWord ibut, save its referent as
- ;; an attribute.
- (when (and (featurep 'hywiki)
- (eq actype #'hywiki-find-referent))
- (hattr:set 'hbut:current 'referent
- (hywiki-get-referent lbl-key)))
-
(princ (format "%s %s BUTTON SPECIFICS:\n"
(htype:def-symbol
(if (eq categ 'explicit) actype categ))
@@ -1168,9 +1167,11 @@ documentation is found."
(replace-regexp-in-string "^" " "
(documentation categ)
nil t))))
(if assisting
- (let ((type-help-func (or (intern-soft
- (concat (htype:names
'ibtypes categ)
- ":help"))
+ (let* ((custom-help-func (intern-soft
+ (concat (htype:names
'ibtypes categ)
+ ":help")))
+ (type-help-func (or (and custom-help-func
(fboundp custom-help-func)
+ custom-help-func)
'hbut:report)))
(princ (format "\n%s ASSIST SPECIFICS:\n%s\n"
type-help-func
diff --git a/hmouse-tag.el b/hmouse-tag.el
index c003267d5e..94f1f89c6b 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 24-Aug-91
-;; Last-Mod: 16-Aug-24 at 22:30:09 by Mats Lidell
+;; Last-Mod: 16-Dec-24 at 00:34:24 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1115,24 +1115,31 @@ When optional NO-FLASH, do not flash."
;;; Private functions
;;; ************************************************************************
-(defun smart-ancestor-tag-files (&optional path name-of-tags-file)
- "Walk up PATH tree looking for NAME-OF-TAGS-FILE.
-Return list from furthest to deepest (nearest)."
- (or path (setq path default-directory))
+(defun smart-ancestor-tag-files (&optional dirs name-of-tags-file)
+ "Walk up DIRS trees looking for NAME-OF-TAGS-FILE.
+DIRS may be a list of directory or a single directory.
+Return a tags table list in DIRS order, where for each directory,
+list the found tags tables from furthest to nearest."
+ (or dirs (setq dirs default-directory))
(let ((tags-table-list)
tags-file)
- (while (and
- (stringp path)
- (setq path (file-name-directory path))
- (setq path (directory-file-name path))
- ;; Not at root directory
- (not (string-match
- (concat (file-name-as-directory ":?") "\\'")
- path)))
- (setq tags-file (expand-file-name (or name-of-tags-file "TAGS") path))
- (if (file-readable-p tags-file)
- (setq tags-table-list (cons tags-file tags-table-list))))
- tags-table-list))
+ (apply #'nconc
+ (mapcar (lambda (dir)
+ (setq tags-table-list nil
+ tags-file nil)
+ (while (and
+ (stringp dir)
+ (setq dir (file-name-directory dir))
+ (setq dir (directory-file-name dir))
+ ;; Not at root directory
+ (not (string-match
+ (concat (file-name-as-directory ":?") "\\'")
+ dir)))
+ (setq tags-file (expand-file-name (or name-of-tags-file
"TAGS") dir))
+ (if (file-readable-p tags-file)
+ (setq tags-table-list (cons tags-file
tags-table-list))))
+ tags-table-list)
+ (if (listp dirs) dirs (list dirs))))))
(defun smart-asm-include-file ()
"If point is on an include file line, try to display file.
@@ -1562,27 +1569,39 @@ cannot be expanded via a tags file."
(and (featurep 'hsys-org) (hsys-org-mode-p) (org-in-src-block-p t)))
;;;###autoload
-(defun smart-tags-file-list (&optional curr-dir-or-filename name-of-tags-file)
- "Return tag files list for optional CURR-DIR-OR-FILENAME or
`default-directory'.
-Optional NAME-OF-TAGS-FILE is the literal filename (no directory) for which
-to look. If no tags file is found, an error is signaled."
- (let* ((path (or (and (smart-tags-org-src-block-p) (hsys-org-get-value :dir))
- curr-dir-or-filename default-directory))
- (tags-table-list (smart-ancestor-tag-files path name-of-tags-file)))
- ;; If no tags files were found and the current buffer may contain Emacs
Lisp identifiers and
- ;; is in a 'load-path' directory, then use the default Emacs Lisp tag
table.
- (if (and (not tags-table-list)
- (stringp curr-dir-or-filename)
- smart-emacs-tags-file
- (smart-emacs-lisp-mode-p)
- (let ((path (file-name-directory curr-dir-or-filename)))
- (when path
- (delq nil (mapcar
- (lambda (p)
- (when p
- (equal (file-name-as-directory p) path)))
- load-path)))))
- (setq tags-table-list (list smart-emacs-tags-file)))
+(defun smart-tags-file-list (&optional curr-dirs-or-filename name-of-tags-file)
+ "Return tag files list for optional CURR-DIRS-OR-FILENAME or
`default-directory'.
+CURR-DIRS-OR-FILENAME may also be a list of directories in which to
+find tags files. Tag files returned may not yet exist.
+
+Optional NAME-OF-TAGS-FILE is the literal filename (no directory) for
+which to look; when null, use \"TAGS\". If the list returned is empty,
+signal an error."
+ (let* ((dirs (or (and (smart-tags-org-src-block-p) (hsys-org-get-value :dir))
+ curr-dirs-or-filename default-directory))
+ (tags-table-list (smart-ancestor-tag-files dirs name-of-tags-file)))
+ ;; If no tags files were found and the current buffer may contain
+ ;; Emacs Lisp identifiers and is in a 'load-path' directory, then
+ ;; use the default Emacs Lisp tag table.
+ (unless tags-table-list
+ (cond ((and (stringp curr-dirs-or-filename)
+ smart-emacs-tags-file
+ (smart-emacs-lisp-mode-p)
+ (let ((dir (file-name-directory curr-dirs-or-filename)))
+ (when dir
+ (delq nil (mapcar
+ (lambda (p)
+ (when p
+ (equal (file-name-as-directory p) dir)))
+ load-path)))))
+ (setq tags-table-list (list smart-emacs-tags-file)))
+ ((and curr-dirs-or-filename (listp curr-dirs-or-filename))
+ (setq tags-table-list
+ (delq nil (mapcar
+ (lambda (p)
+ (when (stringp p)
+ (expand-file-name "TAGS" p)))
+ curr-dirs-or-filename))))))
;; Return the appropriate tags file list.
(cond (tags-table-list
;; GNU Emacs when tags tables are found or provided by the user
@@ -1593,7 +1612,7 @@ to look. If no tags file is found, an error is signaled."
tags-table-computed-list)
((when (boundp 'tags-file-name) tags-file-name)
(list tags-file-name))
- (t (error "Needed tags file not found; see `man etags' for how to
build one")))))
+ (t (error "(smart-tags-file-list): Needed tags file not found; see
`man etags' for how to build one")))))
;;; ************************************************************************
;;; Private functions
diff --git a/hpath.el b/hpath.el
index 30a297b2d4..ec9fb619fc 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: 18-Nov-24 at 20:16:58 by Bob Weiner
+;; Last-Mod: 15-Dec-24 at 23:45:41 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -2034,6 +2034,10 @@ ${var}) with their values in PATH. The first matching
value for
variables like `${PATH}' is used. Then abbreviate any remaining
path."
(setq path (expand-file-name (hpath:substitute-value path)))
+ (when (file-directory-p path)
+ ;; Force path to have a final directory separator so comparisons
+ ;; to `default-directory' work
+ (setq path (file-name-as-directory path)))
(unless relative-to
(setq relative-to default-directory))
(when (stringp relative-to)
diff --git a/hsys-org.el b/hsys-org.el
index ebc7dbc1bd..f46fdecd86 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: 16-Sep-24 at 22:19:53 by Bob Weiner
+;; Last-Mod: 15-Dec-24 at 22:39:45 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -56,10 +56,11 @@
(defvar hywiki-org-link-type-required) ; "hywiki.el"
(defvar org-agenda-buffer-tmp-name) ; "org-agenda.el"
-(declare-function hywiki-at-tags-p "hywiki")
-(declare-function hywiki-tags-view "hywiki")
+(declare-function hycontrol-windows-grid "hycontrol")
(declare-function hyrolo-tags-view "hyrolo")
(declare-function hyrolo-at-tags-p "hyrolo")
+(declare-function hywiki-at-tags-p "hywiki")
+(declare-function hywiki-tags-view "hywiki")
(declare-function hsys-org-roam-tags-view "hsys-org")
(declare-function org-babel-get-src-block-info "org-babel")
@@ -496,25 +497,17 @@ Match to all todos if `keyword' is nil or the empty
string."
(defun hsys-org-link-at-p ()
"Return non-nil iff point is on a square-bracketed Org mode link.
-Assume caller has already checked that the current buffer is in `org-mode'
-or is looking for an Org link in another buffer type."
+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."
(unless (or (smart-eolp) (smart-eobp))
(with-suppressed-warnings nil
(let ((in-org-link (org-in-regexp org-link-bracket-re nil t)))
(when in-org-link
(save-match-data
- ;; If this Org link matches a HyWiki word, let Org handle
- ;; it with its normal internal link handling only if it
- ;; has a `hywiki-org-link-type' prefix or if
- ;; `hywiki-org-link-type-required' is non-nil. Otherwise,
- ;; return nil from this function and let ibtypes handle this
- ;; as a HyWiki word.
- (if (fboundp 'hywiki-word-at)
- (if (hywiki-word-at)
- (when (or hywiki-org-link-type-required
- (hyperb:stack-frame '(hywiki-word-at)))
- in-org-link)
- in-org-link)
+ ;; If this Org link matches a potential HyWiki word, ignore it.
+ (unless (and (fboundp 'hywiki-word-at) (hywiki-word-at))
in-org-link)))))))
;; Assume caller has already checked that the current buffer is in org-mode.
diff --git a/hui-mini.el b/hui-mini.el
index 66795e4093..b3f465fcde 100644
--- a/hui-mini.el
+++ b/hui-mini.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 15-Oct-91 at 20:13:17
-;; Last-Mod: 25-Nov-24 at 01:47:17 by Bob Weiner
+;; Last-Mod: 15-Dec-24 at 22:43:50 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -19,9 +19,11 @@
;;; Other required Elisp libraries
;;; ************************************************************************
-(require 'hypb)
-(require 'hsettings) ; For hyperbole-web-search-alist
(require 'browse-url)
+(require 'hsettings) ; For hyperbole-web-search-alist
+(require 'hypb)
+(unless (fboundp 'string-replace)
+ (load "subr")) ;; for `string-replace'
;;; ************************************************************************
;;; Public declarations
diff --git a/hui-mouse.el b/hui-mouse.el
index f852e28701..e675946165 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-89
-;; Last-Mod: 17-Nov-24 at 12:01:54 by Bob Weiner
+;; Last-Mod: 15-Dec-24 at 13:17:27 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1759,7 +1759,9 @@ locate the definition."
(match-beginning 1) (match-end 1)))))))
(if ref
(list 'smart-tags-display ref nil
- (smart-tags-file-list (and (boundp 'man-path) man-path))))))
+ (smart-tags-file-list (or (and (boundp 'Man-header-file-path)
+ Man-header-file-path)
+ (and (boundp 'man-path) man-path)))))))
(defun smart-man-file-ref ()
"Return form to eval to display file whose name is at point.
diff --git a/hypb.el b/hypb.el
index 3728198bcc..91864f00ad 100644
--- a/hypb.el
+++ b/hypb.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 6-Oct-91 at 03:42:38
-;; Last-Mod: 30-Sep-24 at 01:00:10 by Bob Weiner
+;; Last-Mod: 15-Dec-24 at 22:49:02 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -33,6 +33,7 @@
(declare-function helm-info "ext:helm")
(declare-function helm-apropos "ext:helm")
(declare-function devdocs-lookup "ext:devdocs")
+(declare-function native-comp-available-p "comp.c")
;; interaction-log
(defvar ilog-buffer-name)
diff --git a/hywiki.el b/hywiki.el
index 25d2fa3d16..4013881c52 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: 1-Dec-24 at 12:54:16 by Bob Weiner
+;; Last-Mod: 15-Dec-24 at 18:52:02 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -129,6 +129,7 @@
(require 'hui-mini) ;; For `hui:menu-act'
(require 'hypb) ;; Requires `seq'
(require 'outline) ;; For `outline-mode-syntax-table'
+(require 'subr-x) ;; For `string-clean-whitespace' and
`string-remove-prefix'
(require 'thingatpt)
(eval-and-compile
@@ -157,6 +158,61 @@
(declare-function org-publish-property "ox-publish" (property project
&optional default))
(declare-function smart-treemacs-edit "hui-treemacs" (&optional dir))
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+;; Must be set after `hywiki-get-buttonize-characters' is defined
+(defconst hywiki--buttonize-characters nil
+ "String of single character keys bound to
`hywiki-buttonize-character-commands'.
+Each such key self-inserts before highlighting any prior HyWiki word
+in `hywiki-mode'.")
+
+(defconst hywiki--buttonize-character-regexp nil
+ "Regexp matching a single separating character following a HyWiki word.")
+
+(defconst hywiki--word-and-buttonize-character-regexp nil
+ "Regexp matching HyWikiWord#section plus a valid word separating character.")
+
+(defvar hywiki--directory-checksum ""
+ "String checksum for `hywiki-directory' page names.")
+
+(defvar hywiki--directory-mod-time nil
+ "Last mod time for `hywiki-directory' or nil if the value has not been read.
+See `current-time' function for the mod time format.")
+
+;; Redefine the `org-mode-syntax-table' for use in
`hywiki-get-buttonize-characters'
+;; so do not have to load all of Org mode there.
+(defvar hywiki--org-mode-syntax-table
+ (let ((st (make-syntax-table outline-mode-syntax-table)))
+ (modify-syntax-entry ?\" "\"" st)
+ (modify-syntax-entry ?\\ "_" st)
+ (modify-syntax-entry ?~ "_" st)
+ (modify-syntax-entry ?< "(>" st)
+ (modify-syntax-entry ?> ")<" st)
+ st)
+ "Standard syntax table for Org mode buffers with HyWiki support.")
+
+(defvar hywiki--pages-directory nil)
+(defvar hywiki--pages-hasht nil)
+
+;; Globally set these values to avoid using 'let' with stack allocations
+;; within `hywiki-maybe-highlight-page-name' frequently.
+(defvar hywiki--any-page-regexp-list nil)
+(defvar hywiki--buts nil)
+(defvar hywiki--but-end nil)
+(defvar hywiki--but-start nil)
+(defvar hywiki--buttonize-end (make-marker)) ;; This must always stay a
marker
+(defvar hywiki--buttonize-start (make-marker)) ;; This must always stay a
marker
+(defvar hywiki--current-page nil)
+(defvar hywiki--end nil)
+(defvar hywiki--highlighting-done-flag t)
+(defvar hywiki--page-name nil)
+(defvar hywiki--range nil)
+(defvar hywiki--save-case-fold-search nil)
+(defvar hywiki--save-org-link-type-required nil)
+(defvar hywiki--start nil)
+
;;; ************************************************************************
;;; Public variables
;;; ************************************************************************
@@ -203,7 +259,11 @@ Use nil for no HyWiki mode indicator."
See `hywiki-org-publishing-directory' for exported pages in html format."
:initialize #'custom-initialize-default
:set (lambda (option value)
- (set option (file-name-as-directory value))
+ (unless (and (boundp 'hywiki-directory)
+ (equal hywiki-directory (file-name-as-directory value)))
+ (set option (file-name-as-directory value))
+ (hywiki-clear-pages-hasht)
+ (hywiki-make-pages-hasht))
(hywiki-org-set-publish-project))
:type 'string
:group 'hyperbole-hywiki)
@@ -380,64 +440,12 @@ Only argument is the page name concatenated with optional
#section."
(defcustom hywiki-allow-plurals-flag t
"Non-nil means plural HyWikiWords have the same referent as the singular
form."
:initialize #'custom-initialize-default
+ :set (lambda (option value)
+ (set option value)
+ (setq hywiki--any-page-regexp-list nil))
:type 'boolean
:group 'hyperbole-hywiki)
-;;; ************************************************************************
-;;; Private variables
-;;; ************************************************************************
-
-;; Must be set after `hywiki-get-buttonize-characters' is defined
-(defconst hywiki--buttonize-characters nil
- "String of single character keys bound to
`hywiki-buttonize-character-commands'.
-Each such key self-inserts before highlighting any prior HyWiki word
-in `hywiki-mode'.")
-
-(defconst hywiki--buttonize-character-regexp nil
- "Regexp matching a single separating character following a HyWiki word.")
-
-(defconst hywiki--word-and-buttonize-character-regexp nil
- "Regexp matching HyWikiWord#section plus a valid word separating character.")
-
-(defvar hywiki--directory-checksum ""
- "String checksum for `hywiki-directory' page names.")
-
-(defvar hywiki--directory-mod-time nil
- "Last mod time for `hywiki-directory' or nil if the value has not been read.
-See `current-time' function for the mod time format.")
-
-;; Redefine the `org-mode-syntax-table' for use in
`hywiki-get-buttonize-characters'
-;; so do not have to load all of Org mode there.
-(defvar hywiki--org-mode-syntax-table
- (let ((st (make-syntax-table outline-mode-syntax-table)))
- (modify-syntax-entry ?\" "\"" st)
- (modify-syntax-entry ?\\ "_" st)
- (modify-syntax-entry ?~ "_" st)
- (modify-syntax-entry ?< "(>" st)
- (modify-syntax-entry ?> ")<" st)
- st)
- "Standard syntax table for Org mode buffers with HyWiki support.")
-
-(defvar hywiki--pages-directory nil)
-(defvar hywiki--pages-hasht nil)
-
-;; Globally set these values to avoid using 'let' with stack allocations
-;; within `hywiki-maybe-highlight-page-name' frequently.
-(defvar hywiki--any-page-regexp-list nil)
-(defvar hywiki--buts nil)
-(defvar hywiki--but-end nil)
-(defvar hywiki--but-start nil)
-(defvar hywiki--buttonize-end (make-marker)) ;; This must always stay a
marker
-(defvar hywiki--buttonize-start (make-marker)) ;; This must always stay a
marker
-(defvar hywiki--current-page nil)
-(defvar hywiki--end nil)
-(defvar hywiki--highlighting-done-flag t)
-(defvar hywiki--page-name nil)
-(defvar hywiki--range nil)
-(defvar hywiki--save-case-fold-search nil)
-(defvar hywiki--save-org-link-type-required nil)
-(defvar hywiki--start nil)
-
;;; ************************************************************************
;;; hywiki minor mode
;;; ************************************************************************
@@ -566,13 +574,14 @@ If the associated HyWiki referent is a page and it does
not exist,
create it automatically unless it is the first HyWiki page to be
created, in which case, prompt the user whether to create it to
prevent any unexpected HyWiki use."
- (let ((wikiword (hywiki-word-at)))
+ (let* ((wikiword-start-end (hywiki-word-at t))
+ (wikiword (nth 0 wikiword-start-end))
+ (start (nth 1 wikiword-start-end))
+ (end (nth 2 wikiword-start-end)))
(when wikiword
- (ibut:label-set wikiword (match-beginning 0) (match-end 0))
+ (ibut:label-set wikiword start end)
(hact 'hywiki-find-referent wikiword))))
-(defalias 'hywiki-word:help 'hywiki-existing-word:help)
-
(defun hywiki-display-page (&optional wikiword)
"Display an optional WIKIWORD page and return the page file.
Use `hywiki-display-page-function' to display the page.
@@ -586,6 +595,8 @@ an existing or new HyWikiWord."
(setq wikiword (hywiki-word-read-new "Find HyWiki page: ")))
(let ((referent (hywiki-get-file wikiword)))
(funcall hywiki-display-page-function referent)
+ ;; Set 'referent attribute of current implicit button
+ (hattr:set 'hbut:current 'referent referent)
referent)))
(defun hywiki-display-referent (&optional wikiword prompt-flag)
@@ -1222,8 +1233,10 @@ After successfully finding any kind of referent, run
`hywiki-find-referent-hook'."
(interactive (list (hywiki-word-read-new "Add/Edit HyWikiWord: ")
(when current-prefix-arg t)))
- (prog1 (hywiki-display-referent wikiword prompt-flag)
- (run-hooks 'hywiki-find-referent-hook)))
+ (let ((referent (hywiki-display-referent wikiword prompt-flag)))
+ (run-hooks 'hywiki-find-referent-hook)
+
+ referent))
(defun hywiki-highlight-on-yank (_prop-value start end)
"Used in `yank-handled-properties' called with START and END pos of the text.
@@ -1976,8 +1989,8 @@ regexps of page names."
(mapcar (lambda (page-sublist)
;; Add plurals to the list
(setq page-sublist
- (nconc page-sublist
- (mapcar #'hywiki-get-plural-wikiword
page-sublist)))
+ (delq nil (nconc page-sublist
+ (mapcar #'hywiki-get-plural-wikiword
page-sublist))))
(concat (regexp-opt page-sublist 'words)
"\\("
hywiki-word-section-regexp "?\\)"
@@ -1996,23 +2009,25 @@ regexps of page names."
(cdr (hywiki-get-page-hasht)))
(defun hywiki-get-plural-wikiword (wikiword)
- "Return the pluralized version of the given WIKIWORD."
+ "Return the pluralized version of the given WIKIWORD.
+`hywiki-allow-plurals-flag' must be non-nil or nil is always returned."
;; You add "-es" to make a noun plural when the singular noun ends
;; in "s", "x", "z", "sh", or "ch". However, there are some
;; exceptions to this rule, such as words ending in "-ch" that are
;; pronounced with a hard "k", like "monarchs" and "stomachs".
- (cond ((let ((case-fold-search t))
- (string-match-p "\\(es\\|.[^es]s\\)$" wikiword))
- ;; Already plural
- wikiword)
- ((let ((case-fold-search t))
- (string-match-p "\\(ch\\|sh\\|[sxz]\\)$" wikiword))
- (concat wikiword (if (string-match-p "[[:lower:]]" wikiword)
- "es"
- "ES")))
- (t (concat wikiword (if (string-match-p "[[:lower:]]" wikiword)
- "s"
- "S")))))
+ (when hywiki-allow-plurals-flag
+ (cond ((let ((case-fold-search t))
+ (string-match-p "\\(es\\|.[^es]s\\)$" wikiword))
+ ;; Already plural
+ wikiword)
+ ((let ((case-fold-search t))
+ (string-match-p "\\(ch\\|sh\\|[sxz]\\)$" wikiword))
+ (concat wikiword (if (string-match-p "[[:lower:]]" wikiword)
+ "es"
+ "ES")))
+ (t (concat wikiword (if (string-match-p "[[:lower:]]" wikiword)
+ "s"
+ "S"))))))
(defun hywiki-get-singular-wikiword (wikiword)
"Return the singular version of the given WIKIWORD.
@@ -2042,13 +2057,30 @@ If deleted, update HyWikiWord highlighting across all
frames."
t)
nil))
-(defun hywiki-non-page-elts (val-key)
- (let ((suffix-regexp (concat (regexp-quote hywiki-file-suffix) "$"))
- value)
- (setq value (car val-key))
- (unless (and (stringp value)
- (string-match-p suffix-regexp value))
- val-key)))
+(defun hywiki-clear-pages-hasht ()
+ "Clear all elements from the HyWiki referent hash table and return it."
+ (if (hashp hywiki--pages-hasht)
+ (progn (hash-map (lambda (key) (hash-delete key hywiki--pages-hasht))
+ (hash-map #'cdr hywiki--pages-hasht))
+ hywiki--pages-hasht)
+ (hash-make (length (hywiki-get-page-files)))))
+
+(eval-and-compile
+ '(when (featurep 'company)
+ (defun hywiki-company-hasht-backend (command &optional _arg &rest ignored)
+ "A `company-mode` backend that completes from the keys of a hash table."
+ (interactive (list 'interactive))
+ (when (hywiki-word-at)
+ (pcase command
+ ('interactive (company-begin-backend 'company-hash-table-backend))
+ ('prefix (company-grab-word))
+ ('candidates
+ (let ((prefix (company-grab-word)))
+ (when prefix
+ (cl-loop for key being the hash-keys in (hywiki-get-page-list)
+ when (string-prefix-p prefix key)
+ collect key))))
+ ('sorted t))))))
(defun hywiki-make-pages-hasht ()
(let* ((page-files (hywiki-get-page-files))
@@ -2068,22 +2100,13 @@ If deleted, update HyWikiWord highlighting across all
frames."
hywiki--pages-hasht (hash-merge (hash-make non-page-elts)
(hash-make page-elts)))))
-(eval-and-compile
- '(when (featurep 'company)
- (defun hywiki-company-hasht-backend (command &optional _arg &rest ignored)
- "A `company-mode` backend that completes from the keys of a hash table."
- (interactive (list 'interactive))
- (when (hywiki-word-at)
- (pcase command
- ('interactive (company-begin-backend 'company-hash-table-backend))
- ('prefix (company-grab-word))
- ('candidates
- (let ((prefix (company-grab-word)))
- (when prefix
- (cl-loop for key being the hash-keys in (hywiki-get-page-list)
- when (string-prefix-p prefix key)
- collect key))))
- ('sorted t))))))
+(defun hywiki-non-page-elts (val-key)
+ (let ((suffix-regexp (concat (regexp-quote hywiki-file-suffix) "$"))
+ value)
+ (setq value (car val-key))
+ (unless (and (stringp value)
+ (string-match-p suffix-regexp value))
+ val-key)))
(defun hywiki-org-export-function (&rest _)
"Add to `write-contents-functions' to convert HyWikiWord links to Org links.
@@ -2269,10 +2292,14 @@ at point must return non-nil or this function will
return nil."
(defun hywiki-strip-org-link (link-str)
"Return the hy:HyWikiWord#section part of an Org link string.
-Strip any square bracket delimiters, any description and leading or
-trailing whitespace."
+Strip any square bracket delimiters, description and leading or
+trailing whitespace, and type prefix. Return nil, if no match."
(when (and (stringp link-str) (not (string-empty-p link-str)))
- (string-trim (car (delete "" (split-string link-str
"\\[\\[\\|\\]\\[\\|\\]\\]"))))))
+ (string-remove-prefix
+ (concat hywiki-org-link-type ":")
+ (string-trim (car (delete ""
+ (mapcar #'string-clean-whitespace
+ (split-string link-str
"\\[\\[\\|\\]\\[\\|\\]\\]"))))))))
;;;###autoload
(defun hywiki-tags-view (&optional todo-only match view-buffer-name)
@@ -2318,12 +2345,11 @@ Action Key press; with a prefix ARG, emulate an Assist
Key press."
(hywiki-find-referent word)
(hkey-either arg))))
-(defun hywiki-word-at ()
+(defun hywiki-word-at (&optional range-flag)
"Return HyWikiWord and optional #section at point or nil if not on one.
Point must be prior to any whitespace character within #section.
-
-Return nil if the HyWikiWord is a prefixed, typed hy:HyWikiWord, since
-these are handled by the Org mode link handler.
+With optional RANGE-FLAG, return a list of (HyWikiWord start-position
+end-position); the positions are for only the HyWikiWord itself.
Do not test whether or not a page exists for the HyWiki word; call
`hywiki-referent-exists-p' without an argument for that.
@@ -2335,47 +2361,63 @@ or this will return nil."
(hproperty:char-property-range (point) 'face hywiki-word-face))
(buffer-substring-no-properties (car hywiki--range) (cdr hywiki--range))
(save-excursion
- (let ((wikiword (progn (when (looking-at "\\[\\[")
- (goto-char (+ (point) 2)))
- (hargs:delimited "[[" "]]"))))
- (if wikiword
- ;; Handle an Org link [[HyWikiWord]] [[hy:HyWikiWord]]
- ;; or [[HyWikiWord#section][Description Text]].
- (progn
- ;; Get the HyWikiWord link reference, ignoring any
- ;; description given in the link
- (setq wikiword (hywiki-strip-org-link wikiword))
- (if (string-match (concat "\\`" hywiki-org-link-type ":")
wikiword)
- ;; Ignore prefixed, typed hy:HyWikiWord since Org mode will
- ;; display those.
- nil
- ;; Don't use next line so don't have to load all of Org
- ;; mode just to check for HyWikiWords; however, disables
- ;; support for Org mode aliases.
- ;; (setq wikiword (org-link-expand-abbrev (org-link-unescape
(string-trim wikiword))))
- (when (hywiki-word-is-p wikiword)
- wikiword)))
- ;; Handle a HyWiki word with optional #section; if it is an Org
- ;; link, it may optionally have a hy: link-type prefix.
- ;; Ignore wikiwords preceded by any non-whitespace
- ;; character, except any of these: "([\"'`'"
- (let ((case-fold-search nil)
- start
- end)
- (skip-chars-backward "-_*#[:alnum:]")
- (when (hywiki-maybe-at-wikiword-beginning)
- (cond ((looking-at hywiki--word-and-buttonize-character-regexp)
- (setq start (match-beginning 0)
- end (match-beginning 3)
- wikiword (string-trim
- (buffer-substring-no-properties start
end))))
- ((looking-at (concat
hywiki-word-with-optional-section-regexp "\\'"))
- (setq start (match-beginning 0)
- end (match-end 0)
- ;; No following char
- wikiword (string-trim
- (buffer-substring-no-properties start
end)))))
- wikiword))))))))
+ ;; Don't use `cl-destructuring-bind' here since the `hargs:delimited'
call
+ ;; can return nil rather than the 3 arg list that would be required
+ (let* ((wikiword-start-end
+ (let ((start-regexp (concat "\\[\\[\\(" hywiki-org-link-type
":\\)?")))
+ (save-excursion
+ (skip-chars-backward (concat hywiki-org-link-type ":["))
+ (when (looking-at start-regexp)
+ (goto-char (match-end 0)))
+ (hargs:delimited (concat "\\[\\[\\(" hywiki-org-link-type
":\\)?")
+ "\\(\\]\\[\\|\\]\\]\\)" t t t))))
+ (wikiword (nth 0 wikiword-start-end))
+ (start (nth 1 wikiword-start-end))
+ (end (nth 2 wikiword-start-end)))
+ (when (if wikiword
+ ;; Handle an Org link [[HyWikiWord]] [[hy:HyWikiWord]]
+ ;; or [[HyWikiWord#section][Description Text]].
+ ;; Get the HyWikiWord link reference, ignoring any
+ ;; description given in the link
+ ;; Don't use next line so don't have to load all of Org
+ ;; mode just to check for HyWikiWords; however, disables
+ ;; support for Org mode aliases.
+ ;; (setq wikiword (org-link-expand-abbrev
(org-link-unescape (string-trim wikiword))))
+ (progn
+ (setq wikiword (hywiki-strip-org-link wikiword))
+ (when (and wikiword end)
+ ;; Update start and end to newly stripped
+ ;; string positions
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (when (search-forward wikiword nil t)
+ (setq start (match-beginning 0)
+ end (match-end 0))))))
+ (hywiki-word-is-p wikiword))
+ ;; Handle a non-delimited HyWiki word with optional #section;
+ ;; if it is an Org link, it may optionally have a hy:
+ ;; link-type prefix. Ignore wikiwords preceded by any
+ ;; non-whitespace character, except any of these:
+ ;; "([\"'`'"
+ (let ((case-fold-search nil))
+ (skip-chars-backward "-_*#[:alnum:]")
+ (when (hywiki-maybe-at-wikiword-beginning)
+ (cond ((looking-at
hywiki--word-and-buttonize-character-regexp)
+ (setq start (match-beginning 0)
+ end (match-beginning 3)
+ wikiword (string-trim
+ (buffer-substring-no-properties
start end))))
+ ((looking-at (concat
hywiki-word-with-optional-section-regexp "\\'"))
+ (setq start (match-beginning 0)
+ end (match-end 0)
+ ;; No following char
+ wikiword (string-trim
+ (buffer-substring-no-properties
start end))))))))
+ (if range-flag
+ (list wikiword start end)
+ wikiword)))))))
;;;###autoload
(defun hywiki-word-consult-grep (word)
diff --git a/test/hbut-tests.el b/test/hbut-tests.el
index 2e8e5caefa..1fb0c4489d 100644
--- a/test/hbut-tests.el
+++ b/test/hbut-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <matsl@gnu.org>
;;
;; Orig-Date: 30-may-21 at 09:33:00
-;; Last-Mod: 14-Apr-24 at 21:52:52 by Mats Lidell
+;; Last-Mod: 15-Dec-24 at 23:48:34 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -239,10 +239,11 @@ Create button with link-to-directory using
`temporary-file-directory`."
(should (string= "<[name]> - \"/tmp\"" (buffer-string)))
(goto-char 3)
(let ((but (ibut:at-p)))
+ (should but)
(with-temp-buffer
(ibut:insert-text but)
;; Allow for /tmp being a link to /private/tmp on Macos
- (should (string-match "\"\\(/private\\)?/tmp\"" (buffer-string)))))))
+ (should (string-match "\"\\(/private\\)?/tmp/\"" (buffer-string)))))))
(ert-deftest hbut-tests-ibut-insert-annot-bib ()
"Insert ibut to annot-bib, which must be attached to a file."
diff --git a/test/hy-test-helpers.el b/test/hy-test-helpers.el
index 4f36f3c99e..a0f64a0920 100644
--- a/test/hy-test-helpers.el
+++ b/test/hy-test-helpers.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <matsl@gnu.org>
;;
;; Orig-Date: 30-Jan-21 at 12:00:00
-;; Last-Mod: 6-Aug-24 at 00:09:45 by Mats Lidell
+;; Last-Mod: 15-Dec-24 at 14:24:42 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -72,12 +72,12 @@
(cl-defun hy-test-helpers-verify-hattr-at-p (&key actype args loc lbl-key name)
"Verify the attribute of hbut at point.
Checks ACTYPE, ARGS, LOC, LBL-KEY and NAME."
- (let ((hbut-at-p (hbut:at-p)))
- (should (eq (hattr:get hbut-at-p 'actype) actype))
- (should (equal (hattr:get hbut-at-p 'args) args))
- (should (equal (hattr:get hbut-at-p 'loc) loc))
- (should (equal (hattr:get hbut-at-p 'lbl-key) lbl-key))
- (should (equal (hattr:get hbut-at-p 'name) name))))
+ (hbut:at-p)
+ (should (eq (hattr:get 'hbut:current 'actype) actype))
+ (should (equal (hattr:get 'hbut:current 'args) args))
+ (should (equal (hattr:get 'hbut:current 'loc) loc))
+ (should (equal (hattr:get 'hbut:current 'lbl-key) lbl-key))
+ (should (equal (hattr:get 'hbut:current 'name) name)))
(defun hy-delete-file-and-buffer (file)
"Delete FILE and buffer visiting file."
diff --git a/test/hywiki-tests.el b/test/hywiki-tests.el
index f7b5913b63..9d9020b6ad 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: 24-Nov-24 at 16:43:45 by Bob Weiner
+;; Last-Mod: 16-Dec-24 at 00:07:45 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -51,21 +51,36 @@
(should-not (hywiki-add-page "notawikiword"))
(hy-delete-dir-and-buffer hywiki-directory))))
-(ert-deftest hywiki-tests--wikiword-with-prefix-creates-a-new-page ()
+(ert-deftest hywiki-tests--action-key-on-wikiword-displays-page ()
"Verify `action-key' on a prefixed WikiWord, outside of hywiki-directory,
creates a new page."
(defvar wikifile)
(let ((hsys-org-enable-smart-keys t)
(hywiki-directory (make-temp-file "hywiki" t))
- (wikifile (make-temp-file "wikifile")))
- (hywiki-mode -1)
+ (wikifile (make-temp-file "wikifile" nil ".org")))
(unwind-protect
(with-temp-buffer
+ (hywiki-mode 1)
(insert "[[hy:WikiWord]]")
(goto-char 4)
- (mocklet (((hywiki-add-page "WikiWord") => wikifile))
+ (mocklet (((hywiki-display-referent "WikiWord" nil) => wikifile))
(action-key)))
(hy-delete-file-and-buffer wikifile))))
+(ert-deftest hywiki-tests--assist-key-on-wikiword-displays-help ()
+ "Verify `assist-key' on a prefixed WikiWord, outside of hywiki-directory,
displays help for the WikiWord link."
+ (defvar wikifile)
+ (let ((hsys-org-enable-smart-keys t)
+ (hywiki-directory (make-temp-file "hywiki" t))
+ (wikifile (make-temp-file "wikifile" nil ".org")))
+ (unwind-protect
+ (with-temp-buffer
+ (hywiki-mode 1)
+ (insert "[[hy:WikiWord]]")
+ (goto-char 4)
+ (should (string= "WikiWord" (hywiki-word-at)))
+ (assist-key))
+ (hy-delete-file-and-buffer wikifile))))
+
(ert-deftest hywiki-tests--not-a-wikiword-unless-in-hywiki-mode ()
"Verify WikiWord is not a WikiWord unless in `hywiki-mode'."
(let ((hsys-org-enable-smart-keys t)
@@ -152,8 +167,9 @@
(should-not (hywiki-active-in-current-buffer-p)))
(let ((hywiki-exclude-major-modes (list 'org-mode)))
(should-not (hywiki-active-in-current-buffer-p)))
- (mocklet ((hywiki-in-page-p => nil))
- (should-not (hywiki-active-in-current-buffer-p)))
+ (let (hywiki-mode)
+ (mocklet ((hywiki-in-page-p => nil))
+ (should-not (hywiki-active-in-current-buffer-p))))
(dired-mode)
(should-not (hywiki-active-in-current-buffer-p)))
(hy-delete-file-and-buffer wiki-page)
- [elpa] externals/hyperbole updated (e2749c6348 -> c4c5daaa08), ELPA Syncer, 2024/12/16
- [elpa] externals/hyperbole 6cd7a45434 1/9: hywiki.el - Add global HyWiki page override & custom referent types, ELPA Syncer, 2024/12/16
- [elpa] externals/hyperbole a335b73d0f 3/9: hywiki.el - Fix custom HyWikiWord referents for single session use, ELPA Syncer, 2024/12/16
- [elpa] externals/hyperbole f9df63b217 5/9: hywiki.el - Add require, defvar and declare-function for warnings, ELPA Syncer, 2024/12/16
- [elpa] externals/hyperbole 5a91e7abaa 4/9: hywiki.el - Redo hywiki-add-page-and-display and hywiki-referent-menu, ELPA Syncer, 2024/12/16
- [elpa] externals/hyperbole ebad245f63 2/9: Merge branch 'master' into rsw, ELPA Syncer, 2024/12/16
- [elpa] externals/hyperbole 4eb1d46dbc 6/9: Merge branch 'master' into rsw, ELPA Syncer, 2024/12/16
- [elpa] externals/hyperbole c4c5daaa08 9/9: Merge pull request #615 from rswgnu/rsw, ELPA Syncer, 2024/12/16
- [elpa] externals/hyperbole 4bff008242 7/9: hywiki.el - Many fixes and updates plus Smart Key fixes,
ELPA Syncer <=
- [elpa] externals/hyperbole 93874b2ec3 8/9: test/hbut-tests.el: Change most "/tmp" to "/tmp/", ELPA Syncer, 2024/12/16