branch: externals/hyperbole
commit f064c18be6d6098b2881dfac86612953572e3351
Author: Bob Weiner <r...@gnu.org>
Commit: Bob Weiner <r...@gnu.org>
Add hui:gbut-link-directly and Gbut/Link menu item
hui:link-possible-types - In a .texi if not in a node, link-to-file-line.
hui:*but-link-directly - Clear Smart Key vars when called non-interactively.
hui:*but-edit - Fix to not allow blank labels.
---
ChangeLog | 37 +++++++++
hbut.el | 13 ++--
hload-path.el | 4 +-
hmouse-drv.el | 12 +--
hui-menu.el | 5 +-
hui-mini.el | 3 +-
hui.el | 223 +++++++++++++++++++++++++++++++++--------------------
hypb.el | 4 +-
man/hyperbole.texi | 41 ++++++++--
man/version.texi | 4 +-
test/hbut-tests.el | 10 +--
11 files changed, 234 insertions(+), 122 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 5420334362..6e06ce37a5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,40 @@
+2023-07-01 Bob Weiner <r...@gnu.org>
+
+* hui.el (hui:link-possible-types): If in a .texi but not within a node, don't
+ raise error, just use a link-to-file-line instead.
+
+* hui-menu.el (infodock-hyperbole-menu):
+ hui-mini.el (hui:menus): Add Link item calling 'hui:gbut-link-directly'.
+ man/hyperbole.texi (Global Buttons): Add doc for new Gbut/Link item.
+ hui.el (hui:gbut-link-directly): Add to create named global link buttons
based on
+ current windows.
+ (hui:gbut-create): Update to prompt for ibut name when called
interactively.
+ Also, prompt if 'lbl' arg is nil and prompt for ibut text when called with
a
+ prefix argument, 'ibut-flag'. Also check that start and end buffers are
the same
+ when creating an ibut.
+ (hui:ebut-edit, hui:gbut-edit, hui:hbut-label): Fix to not allow
blank labels.
+ (hui:ebut-link-directly, hui:ibut-link-directly): In body, clear
Smart Key
+ variables if not called interactively (since interactive clause also
clears these
+ variables). Also, if a button already exists at point, return t else nil.
This
+ lets the caller know what type of create/edit msg to display. If not
editing
+ an existing button, when prompting for a name or label, use any active and
+ highlighted region as the name or label.
+
+2023-06-30 Bob Weiner <r...@gnu.org>
+
+* hmouse-drv.el (hkey-window-link): Move action/assist-key-clear-varriables
+ calls into hui:*but-link-directly calls so happens every time they are
+ called.
+
+* man/hyperbole.texi (Glossary): Fix to note gbut:file is a function, not
+ a variable.
+
+2023-06-27 Bob Weiner <r...@gnu.org>
+
+* test/hbut-tests.el (hbut-tests:should-match-tmp-folder): Change to use
+ a regexp 'string-match-p' to a string input rather than a 'member' test
+ to a list of lists.
+
2023-06-25 Bob Weiner <r...@gnu.org>
* hbut.el (ibut:to-name, ibut:at-p, ibut:to-text): Remove test call to
'hbut:outside-comment-p' since ibuts don't have to be within programming
diff --git a/hbut.el b/hbut.el
index a5b737f6db..1771269e29 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: 26-Jun-23 at 00:04:54 by Bob Weiner
+;; Last-Mod: 2-Jul-23 at 00:22:53 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -219,7 +219,7 @@ Return nil if no matching button is found."
(defalias 'ebut:key-src-fmt #'hbut:key-src-fmt)
(defalias 'ebut:key-to-label #'hbut:key-to-label)
-(defvar hbut:max-len)
+(defvar hbut:max-len)
(defun ebut:label-p (&optional as-label start-delim end-delim pos-flag
two-lines-flag)
"Return key for the explicit button label that point is within, else nil.
@@ -807,7 +807,7 @@ Return TO-HBUT."
(setplist to-hbut (copy-sequence (symbol-plist from-hbut)))
to-hbut)
-(defun hattr:emacs-button-attributes (button)
+(defun hattr:emacs-button-attributes (button)
"Return a property list of an Emacs BUTTON."
(if (markerp button)
;; If on a text property button, button-at will
@@ -820,7 +820,7 @@ Return TO-HBUT."
(when category
(symbol-plist category)))))
-(defun hattr:emacs-button-is-p (button)
+(defun hattr:emacs-button-is-p (button)
"If BUTTON is a valid Emacs button, return its category, else return nil."
(let* ((type (when (or (overlayp button) (markerp button))
(button-get button 'type)))
@@ -2357,8 +2357,7 @@ Summary of operations based on inputs:
(args (hattr:get ibut 'args))
(arg1 (nth 0 args))
(arg2 (nth 1 args))
- (arg3 (nth 2 args))
- (arg4 (nth 3 args)))
+ (arg3 (nth 2 args)))
(pcase actype
('actypes::kbd-key
(cond ((and (stringp arg1) (string-match "\\s-*{.+}\\s-*" arg1))
@@ -2717,7 +2716,7 @@ type for ibtype is presently undefined."
(defalias 'ibtype:create #'defib)
-(defun ibtype:activate-link (referent)
+(defun ibtype:activate-link (referent)
"Activate an implicit link REFERENT, either a key series, a url or a path."
(when referent
(let ((key-series (kbd-key:is-p referent)))
diff --git a/hload-path.el b/hload-path.el
index 34ad0f8115..73ebd550a5 100644
--- a/hload-path.el
+++ b/hload-path.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 29-Jun-16 at 14:39:33
-;; Last-Mod: 25-Jun-23 at 09:58:19 by Bob Weiner
+;; Last-Mod: 29-Jun-23 at 18:46:17 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -25,14 +25,12 @@
;;; Public variables
;;; ************************************************************************
-
(defvar hyperb:microsoft-os-p
(memq system-type '(ms-windows windows-nt ms-dos win32))
"Non-nil iff Hyperbole is running under a Microsoft OS but not for WSL.
WSL is Windows Subsystem for Linux.
Use `hyperb:wsl-os-p' to test if running under WSL.")
-
(defvar hyperb:wsl-os-p
(and (eq system-type 'gnu/linux) (executable-find "wsl.exe") t)
"T iff Hyperbole is running under Microsoft Windows Subsystem for Linux
(WSL).")
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 4ae38d346f..a0655c3a05 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-90
-;; Last-Mod: 19-Jun-23 at 15:56:40 by Bob Weiner
+;; Last-Mod: 1-Jul-23 at 13:08:22 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -635,11 +635,6 @@ With a prefix argument, create an unnamed implicit button
instead."
(let ((start-window (selected-window)))
(unwind-protect
(progn
- ;; Clear Smart Key variables so `hui:*but-link-directly' does not
- ;; improperly reference values left over from a prior drag or
- ;; click. This command does not utilize the Smart Keys.
- (action-key-clear-variables)
- (assist-key-clear-variables)
(funcall (if current-prefix-arg
#'hui:ibut-link-directly
#'hui:ebut-link-directly)
@@ -787,8 +782,9 @@ buffer to the end window. The selected window does not
change."
;; Fall through to error below
)
(t
- ;; Either this frame has more than two windows or other frames
exist
- ;; that together have more than one window; choose which to use.
+ ;; Either this frame has more than two windows or other
+ ;; frames exist that together have more than one window;
+ ;; choose which to use as the referent window.
(setq referent-window
(if (fboundp #'aw-select) ;; ace-window selection
(let ((aw-scope 'global))
diff --git a/hui-menu.el b/hui-menu.el
index 4e2151c879..fab739f65b 100644
--- a/hui-menu.el
+++ b/hui-menu.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 28-Oct-94 at 10:59:44
-;; Last-Mod: 19-Jun-23 at 13:28:35 by Bob Weiner
+;; Last-Mod: 2-Jul-23 at 04:01:16 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -416,6 +416,7 @@ REBUILD-FLAG is non-nil, in which case the menu is rebuilt."
["Delete" hui:gbut-delete t]
["Edit" hui:gbut-edit t]
["Help" gbut:help t]
+ ["Link" hui:gbut-link-directly t]
["Rename" hui:gbut-rename t])
'("Implicit-Button"
["Manual" (id-info "(hyperbole)Implicit Buttons") t]
@@ -426,7 +427,7 @@ REBUILD-FLAG is non-nil, in which case the menu is rebuilt."
["Edit" hui:ibut-edit t]
["Help" hui:hbut-help t]
["Link" hui:ibut-link-directly t]
- ["Name" hui:ibut-label-create t]
+ ["Name" hui:ibut-label-create t]
["Rename" hui:ibut-rename t]
["Types" (hui:htype-help 'ibtypes 'no-sort) t])
'("Koutliner"
diff --git a/hui-mini.el b/hui-mini.el
index 3c6b716ac5..2b06bbba25 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: 19-Jun-23 at 13:26:26 by Bob Weiner
+;; Last-Mod: 1-Jul-23 at 10:57:39 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -812,6 +812,7 @@ The menu is a menu of commands from MENU-ALIST."
("Help" gbut:help "Report on a global button by name.")
("Info" (id-info "(hyperbole)Global Buttons")
"Display manual section on global buttons.")
+ ("Link" hui:gbut-link-directly "Add a named global button link to
point in other/another window.")
("Rename" hui:gbut-rename "Rename a global button.")))
'(ibut .
(("IButton>")
diff --git a/hui.el b/hui.el
index 91a8e42bb1..37ae4043fe 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: 25-Jun-23 at 09:41:45 by Bob Weiner
+;; Last-Mod: 2-Jul-23 at 00:23:11 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -389,9 +389,10 @@ Signal an error when no such button is found in the
current buffer."
(hargs:read
"Change button label to: "
(lambda (lbl)
- (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
+ (and (not (string-match-p "\\`\\s-*\\'" lbl))
+ (<= (length lbl) (hbut:max-len))))
lbl
- (format "(ebut-edit): Enter a string of at most %s chars."
+ (format "(ebut-edit): Enter a non-blank string of at most %s
chars."
(hbut:max-len))
'string))
@@ -505,16 +506,22 @@ a menu to find any of the occurrences."
total))))
(defun hui:gbut-create (lbl ibut-flag)
- "Create a Hyperbole global explicit button with LBL.
-
-With prefix arg IBUT-FLAG non-nil, create a global implicit button instead.
-See `hui:gibut-create' for details."
- (interactive (list (unless current-prefix-arg
- (read-string "Create global explicit button labeled: "))
- current-prefix-arg))
- (if ibut-flag
- (call-interactively #'hui:gibut-create)
- (hypb:assert-same-start-and-end-buffer
+ "Create a Hyperbole global button with LBL.
+By default, create an explicit button.
+
+With prefix arg IBUT-FLAG non-nil, create a global implicit
+button with LBL as its name instead. See `hui:gibut-create' for
+details."
+ (interactive (list nil current-prefix-arg))
+ (unless lbl
+ (setq lbl (hui:hbut-label nil "gbut-create"
+ (if current-prefix-arg
+ "Create global implicit button named: "
+ "Create global explicit button labeled: "))))
+ (hypb:assert-same-start-and-end-buffer
+ (if ibut-flag
+ (hui:gibut-create lbl (hui:hbut-label nil "gbut-create"
+ "Implicit button text (with any
delimiters): "))
(let (actype
but-buf
src-dir)
@@ -548,10 +555,10 @@ See `hui:gibut-create' for details."
(defun hui:gbut-delete (but-key)
"Delete global Hyperbole button given by BUT-KEY.
-Return t if button is deleted, nil if user chooses not to delete or signal
-an error otherwise. If called interactively, prompt user whether to delete
-and derive BUT-KEY from the button that point is within.
-Signal an error if point is not within a button."
+ Return t if button is deleted, nil if user chooses not to delete or
signal
+ an error otherwise. If called interactively, prompt user whether to
delete
+ and derive BUT-KEY from the button that point is within.
+ Signal an error if point is not within a button."
(interactive (list (save-excursion
(hui:buf-writable-err
(find-file-noselect (gbut:file)) "gbut-delete")
@@ -563,9 +570,9 @@ Signal an error if point is not within a button."
(defun hui:gbut-edit (lbl-key)
"Edit a global Hyperbole button given by LBL-KEY.
-The button may be explicit or a labeled implicit button.
-When called interactively, save the global button buffer after the
-modification Signal an error when no such button is found."
+ The button may be explicit or a labeled implicit button.
+ When called interactively, save the global button buffer after the
+ modification Signal an error when no such button is found."
(interactive (list (save-excursion
(hui:buf-writable-err
(find-file-noselect (gbut:file)) "gbut-edit")
@@ -597,9 +604,10 @@ modification Signal an error when no such button is
found."
(hargs:read
"Change global button label to: "
(lambda (lbl)
- (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
+ (and (not (string-match-p "\\`\\s-*\\'" lbl))
+ (<= (length lbl) (hbut:max-len))))
lbl
- (format "(gbut-edit): Enter a string of at most %s chars."
+ (format "(gbut-edit): Enter a non-blank string of at most %s
chars."
(hbut:max-len))
'string))
@@ -650,9 +658,40 @@ modification Signal an error when no such button is
found."
new-lbl
ibut:label-end))))))))))
+(defun hui:gbut-link-directly (&optional arg)
+ "Prompt for a new global link button name and add it.
+Open a blank line at the end of the global/personal button file
+and insert a new global button. By default, add an explicit
+button. With optional prefix ARG non-nil, insert a named
+implicit button. See also documentation for
+`hui:link-possible-types'."
+ (interactive "P")
+ (save-window-excursion
+ (when (or (= (count-windows) 1)
+ (= (hypb:count-visible-windows) 1))
+ (split-window-vertically))
+ (find-file (gbut:file))
+ (hui:buf-writable-err (current-buffer) "gbut-link-directly")
+ (multiple-value-bind (link-but-window referent-window)
+ (hmouse-choose-link-and-referent-windows)
+ (goto-char (point-max))
+ (beginning-of-line)
+ (unless (looking-at-p "[ \t]*$")
+ (end-of-line)
+ (newline))
+ (let ((standard-output (current-buffer))
+ edit-flag)
+ (if arg
+ (progn (setq edit-flag (hui:ibut-link-directly link-but-window
referent-window t))
+ (when (called-interactively-p 'interactive)
+ (hui:ibut-message edit-flag)))
+ (setq edit-flag (hui:ebut-link-directly link-but-window
referent-window))
+ (when (called-interactively-p 'interactive)
+ (hui:ebut-message edit-flag)))))))
+
(defun hui:gbut-rename (label)
"Interactively rename a Hyperbole global button with LABEL.
-When in the global button buffer, the default is the button at point."
+ When in the global button buffer, the default is the button at point."
(interactive (list (save-excursion
(hui:buf-writable-err
(find-file-noselect (gbut:file)) "gbut-rename")
@@ -664,9 +703,9 @@ When in the global button buffer, the default is the button
at point."
(defun hui:gibut-create (name text)
"Create a Hyperbole global implicit button with NAME and button TEXT at
point.
-Button is stored as the properties of the symbol, 'hbut:current.
+ Button is stored as the properties of the symbol, 'hbut:current.
-Use `hui:gbut-create' to create a global explicit button."
+ Use `hui:gbut-create' to create a global explicit button."
(interactive "sCreate global implicit button named: \nsButton text (with any
delimiters): ")
(let (but-buf
opoint
@@ -692,7 +731,7 @@ Use `hui:gbut-create' to create a global explicit button."
(defun hui:hbut-act (&optional but)
"Execute action for optional Hyperbole button symbol BUT in current buffer.
-The default is the current button."
+ The default is the current button."
(interactive (list (hbut:get (hargs:read-match "Activate labeled Hyperbole
button: "
(nconc (ebut:alist)
(ibut:alist))
nil t nil 'hbut))))
@@ -730,7 +769,7 @@ The default is the current button."
(cond ((null but)
(hypb:error "(hbut-act): No current button to activate"))
((not (hbut:is-p but))
- (hypb:error "(hbut-act): Button is invalid; it has no attributes"))
+ (hypb:error "(hbut-act): Button is invalid ; it has no attributes"))
(t (hui:but-flash) (hbut:act but)))))
(defun hui:hbut-delete (&optional but-key key-src)
@@ -819,9 +858,10 @@ BUT defaults to the button whose label point is within."
Optional PROMPT string replaces the standard prompt of `Button label: '."
(hargs:read (if (stringp prompt) prompt "Button label: ")
(lambda (lbl)
- (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
+ (and (not (string-match-p "\\`\\s-*\\'" lbl))
+ (<= (length lbl) (hbut:max-len))))
default-label
- (format "(%s): Enter a string of at most %s chars."
+ (format "(%s): Enter a non-blank string of at most %s chars."
func-name (hbut:max-len))
'string))
@@ -1055,6 +1095,9 @@ Signal an error when no such button is found in the
current buffer."
(defun hui:ebut-link-directly (&optional depress-window release-window)
"Create a link ebutton at Action Key depress point, linked to release point.
+If an explicit button already exists at point, replace it with the new
+link button and return t; otherwise, return nil.
+
With optional DEPRESS-WINDOW and RELEASE-WINDOW, use the points
from those instead. See also documentation for
`hui:link-possible-types'."
@@ -1066,7 +1109,12 @@ from those instead. See also documentation for
(assist-key-clear-variables)
(hmouse-choose-link-and-referent-windows)))
- (let (but-name edit-flag link-types num-types type-and-args lbl-key but-loc
but-dir)
+ (unless (called-interactively-p 'any)
+ ;; Clear smart key variables so this does not improperly reference
+ ;; values left over from a prior drag or click.
+ (action-key-clear-variables)
+ (assist-key-clear-variables))
+ (let (but-lbl edit-flag link-types num-types type-and-args lbl-key but-loc
but-dir)
(multiple-value-bind (link-but-window referent-window)
(if (and depress-window release-window)
(list depress-window release-window)
@@ -1080,30 +1128,31 @@ from those instead. See also documentation for
(not (eq (current-buffer) action-key-depress-buffer))
(buffer-live-p action-key-depress-buffer))
(switch-to-buffer action-key-depress-buffer))
- (hui:buf-writable-err (current-buffer) "link-directly")
+ (hui:buf-writable-err (current-buffer) "ebut-link-directly")
(if (ebut:at-p)
(setq edit-flag t
but-loc (hattr:get 'hbut:current 'loc)
but-dir (hattr:get 'hbut:current 'dir)
lbl-key (hattr:get 'hbut:current 'lbl-key))
(setq but-loc (hui:key-src (current-buffer))
- but-dir (hui:key-dir (current-buffer))
- but-name (hui:hbut-label
- (cond ((hmouse-prior-active-region)
- hkey-region)
- ((use-region-p)
- (hui:hbut-label-default
- (region-beginning) (region-end))))
- "link-directly"
- "Create button named: ")
- lbl-key (hbut:label-to-key but-name)))
+ but-dir (hui:key-dir (current-buffer)))
+ (unless lbl-key
+ (setq but-lbl (hui:hbut-label
+ (cond ((hmouse-prior-active-region)
+ hkey-region)
+ ((use-region-p)
+ (hui:hbut-label-default
+ (region-beginning) (region-end))))
+ "ebut-link-directly"
+ "Create button named: ")
+ lbl-key (hbut:label-to-key but-lbl))))
(select-window referent-window)
(setq link-types (hui:link-possible-types)
num-types (length link-types))
;; num-types is the number of possible link types to choose among
(cond ((= num-types 0)
- (error "(link-directly): No possible link type to create"))
+ (error "(ebut-link-directly): No possible link type to create"))
((= num-types 1)
(setq type-and-args (hui:list-remove-text-properties (car
link-types)))
(hui:ebut-link-create edit-flag link-but-window lbl-key but-loc
but-dir type-and-args))
@@ -1134,11 +1183,13 @@ from those instead. See also documentation for
(with-selected-window referent-window
(hmouse-pulse-line))
(when (called-interactively-p 'interactive)
- (hui:ebut-message edit-flag)))))
+ (hui:ebut-message edit-flag))
+ edit-flag)))
(defun hui:ibut-link-directly (&optional depress-window release-window
name-arg-flag)
"Create a link ibutton at Assist Key depress point, linked to release point.
-If ibutton exists at point, replace it with the new link button.
+If an ibutton already exists at point, replace it with the new
+link button and return t; otherwise, return nil.
With optional DEPRESS-WINDOW and RELEASE-WINDOW, use the points
from those instead. See also documentation for
@@ -1159,6 +1210,11 @@ drag from a window to another window's modeline."
(append (hmouse-choose-link-and-referent-windows)
current-prefix-arg)))
+ (unless (called-interactively-p 'any)
+ ;; Clear smart key variables so this does not improperly reference
+ ;; values left over from a prior drag or click.
+ (action-key-clear-variables)
+ (assist-key-clear-variables))
(let (but-name edit-flag link-types num-types type-and-args name-key but-loc
but-dir)
;; edit-flag when set non-nil means are editing an existing ibut at point
(multiple-value-bind (link-but-window referent-window)
@@ -1174,35 +1230,31 @@ drag from a window to another window's modeline."
(not (eq (current-buffer) assist-key-depress-buffer))
(buffer-live-p assist-key-depress-buffer))
(switch-to-buffer assist-key-depress-buffer))
- (hui:buf-writable-err (current-buffer) "link-directly")
+ (hui:buf-writable-err (current-buffer) "ibut-link-directly")
(if (ibut:at-p)
(setq edit-flag t
but-loc (hattr:get 'hbut:current 'loc)
but-dir (hattr:get 'hbut:current 'dir)
name-key (ibut:label-to-key (hattr:get 'hbut:current 'name)))
(setq but-loc (hui:key-src (current-buffer))
- but-dir (hui:key-dir (current-buffer))
- ;; Don't prompt to name implicit button
- ;; but-name (hui:hbut-label
- ;; (cond ((hmouse-prior-active-region)
- ;; hkey-region)
- ;; ((use-region-p)
- ;; (hui:hbut-label-default
- ;; (region-beginning) (region-end))))
- ;; "link-directly"
- ;; "Create button named: ")
- ;; name-key (hbut:label-to-key but-name)
- ))
- (when name-arg-flag
- (setq name-key (ibut:label-to-key (hui:hbut-label nil
"hui:ibut-link-directly"
- "Name for implicit
button: "))))
+ but-dir (hui:key-dir (current-buffer))))
+ (when (and name-arg-flag (not name-key))
+ (setq but-name (hui:hbut-label
+ (cond ((hmouse-prior-active-region)
+ hkey-region)
+ ((use-region-p)
+ (hui:hbut-label-default
+ (region-beginning) (region-end))))
+ "ibut-link-directly"
+ "Name for implicit button: ")
+ name-key (hbut:label-to-key but-name)))
(select-window referent-window)
(setq link-types (hui:link-possible-types)
num-types (length link-types))
;; num-types is the number of possible link types to choose among
(cond ((= num-types 0)
- (error "(link-directly): No possible link type to create"))
+ (error "(ibut-link-directly): No possible link type to create"))
((= num-types 1)
(setq type-and-args (hui:list-remove-text-properties (car
link-types)))
(hui:ibut-link-create edit-flag link-but-window name-key but-loc
but-dir type-and-args))
@@ -1232,7 +1284,8 @@ drag from a window to another window's modeline."
(with-selected-window referent-window
(hmouse-pulse-line))
(when (called-interactively-p 'interactive)
- (hui:ibut-message edit-flag)))))
+ (hui:ibut-message edit-flag))
+ edit-flag)))
;;; ************************************************************************
@@ -1653,6 +1706,9 @@ which to create button. BUT-DIR is the directory of
BUT-LOC.
TYPE-AND-ARGS is the action type for the button followed by any
arguments it requires. Any text properties are removed from
string arguments."
+ ;; Don't set 'name attribute here since this may be a rename where
+ ;; we need to get use the existing name attribute before renaming to
+ ;; label version of `name-key'.
(hattr:set 'hbut:current 'categ 'implicit)
(hattr:set 'hbut:current 'loc but-loc)
(hattr:set 'hbut:current 'dir but-dir)
@@ -1729,28 +1785,27 @@ Buffer without File link-to-buffer-tmp"
((and (require 'bookmark)
(derived-mode-p 'bookmark-bmenu-mode)
(list 'link-to-bookmark
(bookmark-bmenu-bookmark))))
- ((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)))))
- ((derived-mode-p #'texinfo-mode)
- (let (node)
- (save-excursion
- (beginning-of-line)
- (when (and (not (looking-at "@node
"))
- (not (re-search-backward
"^@node " nil t)))
- (hypb:error
"(hui:link-possible-types): Not within a texinfo node"))
- (require 'texnfo-upd)
- (setq node (texinfo-copy-node-name)))
- (list 'link-to-texinfo-node
buffer-file-name node)))
- ((hmail:reader-p)
- (list 'link-to-mail
- (list (rmail:msg-id-get)
buffer-file-name)))))
+ ((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)
+ (or (looking-at "@node ")
+ (re-search-backward "^@node
" nil t))))
+ (require 'texnfo-upd)
+ (setq node (texinfo-copy-node-name))
+ (list 'link-to-texinfo-node
buffer-file-name node))
+ ((hmail:reader-p)
+ (list 'link-to-mail
+ (list (rmail:msg-id-get)
buffer-file-name))))))
(t (cond
((let ((hargs:reading-type 'directory))
(setq val (hargs:at-p t)))
diff --git a/hypb.el b/hypb.el
index b1050e7eda..e617a0b0c3 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: 25-Jun-23 at 10:11:57 by Mats Lidell
+;; Last-Mod: 1-Jul-23 at 10:15:54 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -167,7 +167,7 @@ Raise and reuse any existing single window frame displaying
ilog."
(ilog-show-in-other-frame))
(defmacro hypb:assert-same-start-and-end-buffer (&rest body)
- "Assert that buffers name does not change during execution of BODY.
+ "Assert that current buffer does not change following execution of BODY.
Trigger an error with traceback if the buffer is not live or its
name differs at the start and end of BODY."
(declare (indent 0) (debug t))
diff --git a/man/hyperbole.texi b/man/hyperbole.texi
index ef5b30b5b8..28c7f0ba41 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: 22-Jun-23 at 17:39:17 by Bob Weiner
+@c Last-Mod: 1-Jul-23 at 16:32:29 by Bob Weiner
@c %**start of header (This is for running Texinfo on a region.)
@setfilename hyperbole.info
@@ -156,7 +156,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.</P>
<PRE>
Edition 8.0.1pre
-Printed June 22, 2023.
+Printed July 1, 2023.
Published by the Free Software Foundation, Inc.
Author: Bob Weiner
@@ -198,7 +198,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
@example
Edition 8.0.1pre
-June 22, 2023
+July 1, 2023
Published by the Free Software Foundation, Inc.
Author: Bob Weiner
@@ -2001,7 +2001,7 @@ asking for help on a button.
Sometimes it is useful to activate buttons without regard to the
information with which you are working. In such instances, you use
@dfn{global buttons}, which are buttons that may be activated or
-otherwise operated upon by typing their labels/names when they are
+otherwise operated upon by typing their names/labels when they are
prompted for, rather than selecting the buttons within a buffer. In
contrast, activation of explicit buttons depends upon the information on
your screen since they are accessible only from within their particular
@@ -2026,6 +2026,30 @@ you for its action type and associated arguments.
@bkbd{C-h h g e} to
edit an existing global button. To remove a button, use the Delete menu
item, @bkbd{C-h h g d}; @pxref{Deletion}.
+@cindex global link creation
+@cindex creating global links
+@cindex menu item, Gbut/Link
+@kindex C-h h g l
+To create a global button that links to point in one of your Emacs
+windows, use the Link menu item, @bkbd{C-h h g l}.
+
+By default this will create a global explicit link button. Give it a
+prefix argument to create a global implicit link button.
+
+With a single window visible on-screen or a single window within your
+current frame, this will prompt you for a button name or label
+(temporarily showing you your global/personal button file) and then
+will insert a button that links to the current point within that window.
+
+If you have exactly two Emacs windows in your current frame or exactly
+two windows visible across two Emacs frames, then the link referent will
+be to the point in the other, non-selected window.
+
+With more than two windows on screen, Hyperbole will prompt you to choose
+the referent window and its associated point to which to link. If the
+Ace Window package is installed and active, this will be used to choose
+the window; otherwise, you will be prompted to select it by mouse.
+
Global buttons are actually explicit buttons stored at the end of your
personal button file, @pxref{Button Files}. You can always go into that
file and activate, edit or annotate these buttons with comments.
@@ -7405,16 +7429,17 @@ frame is visible at a time as each frame generally
fills the whole
terminal display, providing a virtual screen capability. Emacs
windows exist within a frame.
-@vindex gbut:file
+@findex gbut:file
@item Global Button
A Hyperbole button which is accessed by name rather than direct
selection. Global buttons are useful when one wants quick access to
actions such as jumping to common file locations or for performing
sequences of operations. One need not locate them since they are
always available by name, with full completion offered. All global
-buttons are stored in the file given by the variable @code{gbut:file}
-and may be activated with the Action Key when editing this file. By
-default, this is the same as the user's personal button file.
+buttons are stored in the file returned by the function call,
+@code{(gbut:file)}, and may be activated with the Action Key when
+editing this file. By default, this is the same as the user's
+personal button file.
@item Glink
@itemx link-to-gbut
diff --git a/man/version.texi b/man/version.texi
index 83a9274080..b2e483a613 100644
--- a/man/version.texi
+++ b/man/version.texi
@@ -1,4 +1,4 @@
-@set UPDATED June, 2023
-@set UPDATED-MONTH June 2023
+@set UPDATED July, 2023
+@set UPDATED-MONTH July 2023
@set EDITION 8.0.1pre
@set VERSION 8.0.1pre
diff --git a/test/hbut-tests.el b/test/hbut-tests.el
index 0d3875a2fa..751b041e44 100644
--- a/test/hbut-tests.el
+++ b/test/hbut-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 30-may-21 at 09:33:00
-;; Last-Mod: 17-Jun-23 at 23:02:50 by Bob Weiner
+;; Last-Mod: 1-Jul-23 at 13:41:36 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -29,7 +29,7 @@
"Check that TMP matches either of \"/tmp\" or \"private/tmp\".
Needed since hyperbole expands all links to absolute paths and
/tmp can be a symbolic link."
- (should (member tmp '(("/tmp") ("./tmp") ("/private/tmp")))))
+ (should (and (stringp tmp) (string-match-p
"\\`\"?\\(/\\|./\\|/private/\\)tmp\"?\\'" tmp) t)))
(ert-deftest ebut-program-link-to-directory ()
"Programatically create ebut with link-to-directory."
@@ -39,7 +39,7 @@ Needed since hyperbole expands all links to absolute paths and
(find-file file)
(ebut:program "label" 'link-to-directory "/tmp")
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-directory))
- (hbut-tests:should-match-tmp-folder (hattr:get (hbut:at-p) 'args))
+ (hbut-tests:should-match-tmp-folder (car (hattr:get (hbut:at-p)
'args)))
(should (equal (hattr:get (hbut:at-p) 'loc) file))
(should (equal (hattr:get (hbut:at-p) 'lbl-key) "label")))
(hy-delete-file-and-buffer file))))
@@ -99,7 +99,7 @@ Needed since hyperbole expands all links to absolute paths and
(gbut:ebut-program "global" 'link-to-directory "/tmp"))
(with-current-buffer test-buffer
(should (eq (hattr:get (hbut:at-p) 'actype)
'actypes::link-to-directory))
- (hbut-tests:should-match-tmp-folder (hattr:get (hbut:at-p) 'args))
+ (hbut-tests:should-match-tmp-folder (car (hattr:get (hbut:at-p)
'args)))
(should (equal (hattr:get (hbut:at-p) 'loc) test-file))
(should (equal (hattr:get (hbut:at-p) 'lbl-key) "global"))))
(hy-delete-file-and-buffer test-file))))
@@ -161,7 +161,7 @@ Needed since hyperbole expands all links to absolute paths
and
(with-temp-buffer
(ebut:program "label" 'link-to-directory "/tmp")
(should (eq (hattr:get (hbut:at-p) 'actype) 'actypes::link-to-directory))
- (hbut-tests:should-match-tmp-folder (hattr:get (hbut:at-p) 'args))
+ (hbut-tests:should-match-tmp-folder (car (hattr:get (hbut:at-p) 'args)))
(should (equal (hattr:get (hbut:at-p) 'lbl-key) "label"))))
(ert-deftest hypb:program-create-ebut-in-buffer-with-same-label ()
