branch: externals/hyperbole
commit 7bbd1331448c9407c38c7c033144f23fb82ea29a
Merge: ac6e50e3ec 5999198ba6
Author: Robert Weiner <r...@gnu.org>
Commit: Robert Weiner <r...@gnu.org>
Merge branch 'rsw'
---
ChangeLog | 116 +++++++++++++++++++++++
DEMO | 23 +++--
hact.el | 36 ++++---
hactypes.el | 6 +-
hargs.el | 147 ++++++++++++++++++++++-------
hbut.el | 206 ++++++++++++++++++++++------------------
hib-social.el | 25 ++---
hibtypes.el | 17 ++--
hload-path.el | 6 +-
hmouse-drv.el | 28 +++---
hmouse-sh.el | 17 +++-
hpath.el | 8 +-
hui-menu.el | 5 +-
hui-mini.el | 3 +-
hui-mouse.el | 24 ++---
hui.el | 251 +++++++++++++++++++++++++++++++------------------
hypb.el | 4 +-
hyperbole.el | 9 +-
man/hkey-help.txt | 3 +-
man/hyperbole.texi | 94 +++++++++++++-----
man/version.texi | 4 +-
test/demo-tests.el | 6 +-
test/hactypes-tests.el | 6 +-
test/hbut-tests.el | 140 +++++++++++++++++++++++++--
24 files changed, 834 insertions(+), 350 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index d1f7eecebb..a230e0e6e0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,104 @@
+2023-07-08 Bob Weiner <r...@gnu.org>
+
+* test/demo-tests.el
(demo-implicit-button-action-button-boolean-function-call-test):
+ Rename to 'demo-implicit-button-action-button-display-boolean-test' so can
+ find when search for use of 'display-boolean'.
+
+* hactypes.el (display-boolean): Improve clarity of output message.
+ test/hactypes-tests.el (display-boolean-true-test,
display-boolean-false-test):
+ Update to new output message format.
+
+* hpath.el (hpath:absolute-arguments): Fix to process only string arguments.
+
+* hibtypes.el (action): Fix 'args' not being set right after add display-*
actypes.
+ Stop storing unneeded ibutton 'action attribute.
+
+* hact.el (actype:action): Fix doc to say may return actype's fboundp symbol.
+ Use 'actype:action-body' if always need the body of the function.
+ (symtable:actype-p): Fix to return Elisp function symbols as well
+ since 'actype:elisp-symbol' is an alias to this defsubst.
+ (symtable:hyperbole-actype-p): Add to exclude Elisp function symbols.
+ (actype:act): Use above new function.
+
+* DEMO (Completion Selection):
+ man/hkey-help.txt:
+ man/hyperbole.texi (Smart Key Argument Selection): Update to new minibuffer
+ argument handling including Vertico support.
+
+2023-07-05 Bob Weiner <r...@gnu.org>
+
+* hpath.el (hpath:markdown-section-pattern, hpath:outline-section-pattern): Fix
+ to allow for opening pair chars after matching anchor (previously had to
be a
+ :punct: character only).
+
+2023-07-04 Bob Weiner <r...@gnu.org>
+
+* hyperbole.el (hyperb:init): Activate 'vertico-mouse-mode' when
+ 'vertico-mode' is used so that the Action Key properly selects completions
+ from the candidate list. Since Vertico displays completions automatically,
+ must initialize this before Vertico is invoked so cannot wait until a Smart
+ Mouse Key is first pressed.
+ hargs.el (hargs:select-p):
+ (hargs:at-p): When 'hargs:reading-type' is nil, rather than a
+ string, return a list of (completion-so-far exact-completion-match),
+ for consumption by 'hargs:select-p'. Add feature to kill to end of
+ minibuffer line and refresh completions when not inserting a fully
+ matching completion (works for regular and vertico completions if
+ 'vertico-mouse-mode' has been enabled prior to using).
+
+* hmouse-sh.el (hmouse-posn-set-point): Avoid setting point to a read-only
+ location when vertico-mode is active.
+
+2023-07-03 Bob Weiner <r...@gnu.org>
+
+* hmouse-drv.el (hkey-help): Remove ref to XEmacs 'help-selects-help-window'.
+
+* hargs.el (hargs:select-p): Add vertico and ivy completion support.
+ (hargs:at-p): Add vertico support.
+ hui-mouse.el (hkey-alist): Remove ivy support; move above.
+
+* hact.el (actype:act): Fix error when 'args' are null.
+
+* hbut.el (hbut:action): Fix error when 'atype' is not a symbol.
+
+* hmouse-sh.el (hmouse-drag-region): Disable Hyperbole-specific functionality
+ when hyperbole-mode is nil.
+
+2023-07-02 Bob Weiner <r...@gnu.org>
+
+* hui.el (hui:ibut-create):
+ hbut.el (ibut:program): Prevent from creating a new ibut within a named
+ or labeled Hyperbole button.
+
+* hui.el (hui:ibut-create): Call (hattr:clear 'hbut:current) before creating
+ in-memory button.
+
+* hib-social.el (hibtypes-social-default-service): Pluralize defgroup name to
+ 'hyperbole-buttons' to match other files. Remove duplicate unneeded
+ :group from each defcustom.
+
+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-07-01 Mats Lidell <ma...@gnu.org>
* hui.el:
@@ -16,6 +117,15 @@
Monnier. Thanks Stefan.
Align header fields consistently with other files.
+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-29 Mats Lidell <ma...@gnu.org>
* hyrolo.el: Remove redundant `:group` args. Remove obsolete `*` in
@@ -24,6 +134,12 @@
* hbut.el (defib): Remove redundant indent property. Change by Stefan
Monnier.
+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/DEMO b/DEMO
index 5c6191fd2f..d09fa39973 100644
--- a/DEMO
+++ b/DEMO
@@ -1060,12 +1060,23 @@ Try that one by pressing between the square brackets.
** Completion Selection
-Often when Emacs or Hyperbole prompts for an argument in the minibuffer, a
-list of possible argument completions is available by pressing {?}. A single
-Action Key press on any of these completions inserts it into the minibuffer
-for your inspection. A second press on the same completion causes it to be
-used as the argument value and any succeeding argument prompt is then
-displayed. Test this technique with a {C-x C-f} (find-file) and then a {?}.
+Often when Emacs or Hyperbole prompts for an argument in the
+minibuffer, a list of possible argument completions is available by
+pressing {?} or automatically displayed. A single Action Key press on
+any of these completions inserts it into the minibuffer for your
+inspection. A second press on the same completion uses it as the
+argument value and moves on to any next minibuffer argument prompt.
+Test this technique with a {C-x C-f} (find-file) and then a {?}.
+
+Within the minibuffer itself, the Smart Keys are also
+context-sensitive. A press of the Action Key at the end of the
+argument line tries to accept the argument and when successful, exits
+the minibuffer. A press of the Assist Key at the end of the argument
+line displays matching completions for times when they are not
+automatically displayed or need updating. A press of the Action or
+Assist Key on part of the argument, deletes from point to the end of
+the line, expanding the set of available completions and redisplaying
+them.
** Hyperbole Source Buttons
diff --git a/hact.el b/hact.el
index 3d215beaf0..3fc3bfaff8 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: 29-May-23 at 21:50:42 by Bob Weiner
+;; Last-Mod: 8-Jul-23 at 13:19:37 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -115,9 +115,19 @@ with the `ibtypes::' prefix and one without. The value
for both
keys is the Elisp symbol for the type, which includes the prefix.")
(defsubst symtable:actype-p (symbol-or-name)
- "Return SYMBOL-OR-NAME if it is a Hyperbole action type, else nil."
+ "Return SYMBOL-OR-NAME if a Hyperbole action type or Elisp function, else
nil."
(when (or (symbolp symbol-or-name) (stringp symbol-or-name))
- (symtable:get symbol-or-name symtable:actypes)))
+ (or (symtable:get symbol-or-name symtable:actypes)
+ (and (stringp symbol-or-name) (fboundp (intern-soft symbol-or-name))
+ (intern-soft symbol-or-name))
+ (and (functionp symbol-or-name) symbol-or-name))))
+
+(defsubst symtable:hyperbole-actype-p (symbol-or-name)
+ "Return SYMBOL-OR-NAME if a Hyperbole action type, else nil.
+This excludes Emacs Lisp functions which may be used as action types.
+Use `actype:elisp-symbol' to include these."
+ (when (or (symbolp symbol-or-name) (stringp symbol-or-name))
+ (or (symtable:get symbol-or-name symtable:actypes))))
(defsubst symtable:ibtype-p (symbol-or-name)
"Return SYMBOL-OR-NAME if it is a Hyperbole implicit button type, else nil."
@@ -384,7 +394,7 @@ performing ACTION."
;; being used as a path. So do this only if actype is a defact
;; and not a defun to limit any potential impact. RSW - 9/22/2017
(and (symbolp action)
- (symtable:actype-p action)
+ (symtable:hyperbole-actype-p action)
(setq args (hpath:absolute-arguments actype args)))
(let ((hist-elt (hhist:element)))
(run-hooks 'action-act-hook)
@@ -413,6 +423,9 @@ is returned."
(defun actype:eval (actype &rest args)
"Perform action formed from ACTYPE and rest of ARGS and return value.
+This differs from `actype:act' in that it can return nil and does not
+expand relative pathname ARGS.
+
ACTYPE may be a string containing a Lisp expression from which ACTYPE
and ARGS are extracted. ACTYPE may be a symbol or symbol name for
either an action type or a function. Run `action-act-hook' before
@@ -424,18 +437,19 @@ performing ACTION."
(let ((hist-elt (hhist:element)))
(run-hooks 'action-act-hook)
(prog1 (if (or (symbolp action) (listp action)
- (byte-code-function-p action)
- (subrp action)
- (and (stringp action) (not (integerp action))
- (setq action (key-binding action))))
+ (byte-code-function-p action)
+ (subrp action)
+ (and (stringp action) (not (integerp action))
+ (setq action (key-binding action))))
(apply action args)
(eval action))
(hhist:add hist-elt))))))
(defun actype:action (actype)
- "Return action part (body) of ACTYPE.
-ACTYPE is a bound function symbol, symbol name or function body.
-ACTYPE may be a Hyperbole actype or Emacs Lisp function."
+ "If ACTYPE is a bound function symbol, return it.
+Otherwise, return its body. ACTYPE must be a bound function
+symbol, symbol name or function body. ACTYPE may be a Hyperbole
+actype or Emacs Lisp function."
(let (actname
action)
(cond ((stringp actype)
diff --git a/hactypes.el b/hactypes.el
index 981af765a9..02e7539db3 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: 1-Jul-23 at 23:06:38 by Mats Lidell
+;; Last-Mod: 8-Jul-23 at 16:02:44 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -67,8 +67,8 @@ inserted, delete the completions window."
Return any non-nil value or t."
(interactive "xDisplay bool expr value: ")
(let ((result (eval bool-expr t)))
- (message "Boolean result (%s) = %S; Expr: %S"
- (if result "True" "False") result bool-expr)
+ (message "Result = %S; Boolean value = %s; Expr = %S"
+ result (if result "True" "False") bool-expr)
(or result t)))
(defact display-value (value)
diff --git a/hargs.el b/hargs.el
index 4cee338726..ca1ab5a866 100644
--- a/hargs.el
+++ b/hargs.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 31-Oct-91 at 23:17:35
-;; Last-Mod: 17-Jun-23 at 13:05:33 by Bob Weiner
+;; Last-Mod: 5-Jul-23 at 00:45:15 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -328,7 +328,47 @@ default values.
Caller should have checked whether an argument is presently being read
and has set `hargs:reading-type' to an appropriate argument type.
Handles all of the interactive argument types that `hargs:iform-read' does."
- (cond ((and (eq hargs:reading-type 'kcell)
+ (cond ;; vertico-mode
+ ((and (null hargs:reading-type)
+ (bound-and-true-p vertico-mode)
+ ;; Ensure vertico is prompting for an argument
+ (vertico--command-p nil (current-buffer))
+ (active-minibuffer-window))
+ (if (and action-key-release-args
+ (fboundp #'vertico-mouse--index)
+ (eq (posn-window (event-end action-key-release-args))
+ (active-minibuffer-window)))
+ (with-selected-window (active-minibuffer-window)
+ (let ((index (vertico-mouse--index action-key-release-args))
+ mini)
+ (if index
+ (save-excursion
+ (vertico--goto index)
+ (vertico--update t)
+ (vertico--candidate))
+ ;; Assume event occurred within the
+ ;; minibufer-contents and return just the contents
+ ;; before point so that those after are deleted and
+ ;; more completions are shown.
+ (setq mini (minibuffer-contents-no-properties))
+ ;; The minibuffer may have some read-only contents
+ ;; at the beginning, e.g. M-x, not included in the 'mini'
+ ;; string, so we have to offset the max index into
+ ;; the string in such cases and protect against
+ ;; when point is set into this read-only area with
+ ;; the 'max' call below.
+ (list (substring mini 0 (max (- (point) (point-max)) (-
(length mini)))) nil))))
+ (list (vertico--candidate) t)))
+ ((and (null hargs:reading-type)
+ action-key-release-args
+ (eq (posn-window (event-end action-key-release-args))
+ (active-minibuffer-window)))
+ ;; Event occurred within the minibufer-contents and return
+ ;; just the contents before point so that those after are
+ ;; deleted and more completions are shown.
+ (setq mini (minibuffer-contents-no-properties))
+ (list (substring mini 0 (max (- (point) (point-max)) (- (length
mini)))) nil))
+ ((and (eq hargs:reading-type 'kcell)
(eq major-mode 'kotl-mode)
(not (looking-at "^$")))
(kcell-view:label))
@@ -360,7 +400,9 @@ Handles all of the interactive argument types that
`hargs:iform-read' does."
(following-char))))
;; At the end of the menu
(t 0)))))
- ((hargs:completion t))
+ ((let ((completion (hargs:completion t)))
+ (when completion
+ (list completion t))))
((eq hargs:reading-type 'ebut) (ebut:label-p 'as-label))
((eq hargs:reading-type 'ibut) (ibut:label-p 'as-label))
((eq hargs:reading-type 'gbut)
@@ -495,7 +537,9 @@ Insert in minibuffer if active or in other window if
minibuffer is inactive."
entry))))
(or no-insert
(when entry
- (erase-buffer)
+ (if (eq insert-window (minibuffer-window))
+ (delete-minibuffer-contents)
+ (erase-buffer))
(insert entry))))
;; In buffer, non-minibuffer completion.
;; Only insert entry if last buffer line does
@@ -558,7 +602,7 @@ See also documentation for `interactive'."
(while (cond
((eq (aref iform i) ?*))
((eq (aref iform i) ?@)
- (hargs:select-event-window)
+ (hargs:selectevent-window)
t)
((eq (aref iform i) ?^)
(handle-shift-selection))
@@ -663,8 +707,9 @@ of value to be read."
(beep))))
result)
(setq hargs:reading-type prev-reading-p)
- (select-window owind)
- (switch-to-buffer obuf)))))
+ (when (window-live-p owind)
+ (select-window owind)
+ (switch-to-buffer obuf))))))
(defun hargs:select-p (&optional value assist-bool)
"Return optional VALUE or value selected at point if any, else nil.
@@ -673,33 +718,69 @@ the current minibuffer argument, otherwise, the
minibuffer is erased
and value is inserted there.
Optional ASSIST-BOOL non-nil triggers display of Hyperbole menu item
help when appropriate."
- (when (and (> (minibuffer-depth) 0) (or value (setq value (hargs:at-p))))
- (let ((owind (selected-window)) (back-to)
- (str-value (and value (format "%s" value)))
- ;; This command requires recursive minibuffers.
- (enable-recursive-minibuffers t))
- (unwind-protect
- (progn
- (select-window (minibuffer-window))
- (set-buffer (window-buffer (minibuffer-window)))
+ (when (and (> (minibuffer-depth) 0) (or value (setq value (hargs:at-p))))
+ (let ((owind (selected-window)) (back-to)
+ ;; This command requires recursive minibuffers.
+ (enable-recursive-minibuffers t))
+ (when (stringp value)
+ (setq value (list value nil)))
+ (unwind-protect
+ (cl-destructuring-bind (str-value exact-completion-flag) value
+ (setq str-value (and str-value (format "%s" str-value)))
+ (select-window (minibuffer-window))
+ (set-buffer (window-buffer (minibuffer-window)))
+ (cond
+ ;;
+ ;; Selecting a Hyperbole minibuffer menu item
+ ((eq hargs:reading-type 'hmenu)
+ (when assist-bool
+ (setq hargs:reading-type 'hmenu-help))
+ (hui:menu-enter str-value))
+ ;;
+ ;; Exit minibuffer and use its existing value as the desired
parameter.
+ ((string-equal str-value (minibuffer-contents))
+ (goto-char (point-max))
+ (cond
+ ;; vertico-mode
+ ((and (bound-and-true-p vertico-mode)
+ ;; Ensure vertico is prompting for an argument
+ (vertico--command-p nil (current-buffer)))
+ (vertico-exit))
+ ;; ivy-mode
+ ((bound-and-true-p ivy-mode)
+ (if assist-bool
+ (ivy-dispatching-done)
+ (ivy-done)))
+ ;; standard minibuffer completion
+ (t (exit-minibuffer))))
+ ;;
+ ;; Clear minibuffer and insert value.
+ (t
+ (delete-minibuffer-contents)
+ (goto-char (point-max))
(cond
- ;;
- ;; Selecting a Hyperbole minibuffer menu item
- ((eq hargs:reading-type 'hmenu)
- (when assist-bool
- (setq hargs:reading-type 'hmenu-help))
- (hui:menu-enter str-value))
- ;;
- ;; Enter existing value into the minibuffer as the desired
parameter.
- ((string-equal str-value (minibuffer-contents))
- (exit-minibuffer))
- ;;
- ;; Clear minibuffer and insert value.
- (t (delete-minibuffer-contents)
- (insert str-value)
- (setq back-to t)))
- value)
- (when back-to (select-window owind))))))
+ ;; ivy-mode
+ ((bound-and-true-p ivy-mode)
+ (if assist-bool
+ (ivy-dispatching-done)
+ (ivy-done)))
+ ;; standard minibuffer completion
+ ;; vertico-mode
+ ((and (bound-and-true-p vertico-mode)
+ ;; Ensure vertico is prompting for an argument
+ (vertico--command-p nil (current-buffer)))
+ (if str-value
+ (insert str-value)
+ (vertico-insert))
+ (vertico--update t))
+ (t
+ (insert str-value)
+ (unless exact-completion-flag
+ (minibuffer-completion-help))
+ (setq back-to t)))
+ value)))
+ (when (and back-to (window-live-p owind))
+ (select-window owind))))))
;;; ************************************************************************
;;; Private variables
diff --git a/hbut.el b/hbut.el
index 10a168a7bd..10606694ec 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: 30-Jun-23 at 22:39:57 by Mats Lidell
+;; Last-Mod: 8-Jul-23 at 16:02:16 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.
@@ -470,12 +470,12 @@ For interactive creation, use `hui:ebut-create' instead."
(if (or (and actype-sym (fboundp actype-sym))
(functionp actype))
(hattr:set 'hbut:current 'actype actype)
- (error (format "(%s)" actype)))
+ (error "(%s)" actype))
(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 (format "(ebut:program): actype arg must be a bound
symbol (not a string): %S" actype))
+ (error "(ebut:program): actype arg must be a bound symbol
(not a string): %S" actype)
(error "(ebut:program): %S" err)))))))
(defun ebut:search (string out-buf &optional match-part)
@@ -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)))
@@ -982,7 +982,8 @@ Default is the symbol hbut:current."
action)
(setq action (car (hattr:get hbut 'action))
atype (hattr:get hbut 'actype))
- (if (= (length (symbol-name atype)) 2)
+ (if (and (symbolp atype)
+ (= (length (symbol-name atype)) 2))
atype
(or action (actype:action atype)))))
@@ -2171,7 +2172,7 @@ move to the first occurrence of the button."
(defun ibut:operate (&optional new-name edit-flag)
"Insert/modify an ibutton based on `hbut:current' in current buffer.
-Optional non-nil NEW-NAME is name to give button. With optional
+Optional non-nil NEW-NAME is new name to give button. With optional
EDIT-FLAG non-nil, modify an existing in-buffer ibutton rather
than creating a new one.
@@ -2182,20 +2183,28 @@ Return instance string appended to name to form a
per-buffer unique
name; nil if name is already unique or no name. Signal an error when no
such button is found in the current buffer.
-Summary of operations based on inputs:
-|-------+----------+--------+------------------------------------------------|
-| name | new-name | region | operation |
-|-------+----------+--------+------------------------------------------------|
-| nil | nil | nil | create: unnamed ibut |
-| aname | nil | nil | create/update: aname named ibut |
-| aname | nil | region | create/update: aname named ibut (skip region) |
-| nil | nil | region | create/update: region named ibut |
-| aname | newname | nil | mod: rename aname to newname |
-| aname | newname | region | mod: rename aname to newname (skip region) |
-| nil | newname | nil | mod: add newname to lbl-key ibut at point |
-| nil | newname | region | mod: add newname to lbl-key ibut (skip region) |
-|-------+----------+--------+------------------------------------------------|"
- ;; !! TODO: Code does not yet fully match what is in docstring table
+Summary of operations based on inputs (name arg comes from \\='hbut:current
attrs):
+|----+------+----------+--------+------+-----------------------------------------------|
+| # | name | new-name | region | edit | operation
|
+|----+------+----------+--------+------+-----------------------------------------------|
+| 1 | nil | nil | nil | nil | create: unnamed ibut from
hbut:current attrs |
+| 2 | nil | new-name | nil | nil | create: new-name named ibut
|
+| 3 | name | nil | nil | nil | create: aname named ibut
|
+| 4 | name | new-name | nil | nil | ERROR: create can't have name and
new-name |
+| 5 | name | new-name | region | nil | ERROR: create can't have name and
new-name |
+| 6 | name | nil | region | nil | create: aname named ibut (skip
region) |
+| 7 | nil | nil | region | nil | create: region named ibut
|
+| 8 | nil | new-name | region | nil | create: new-name named ibut (skip
region) |
+|----+------+----------+--------+------+-----------------------------------------------|
+| 9 | nil | nil | nil | t | mod: unnamed ibut from hbut:current
attrs |
+| 10 | nil | new-name | nil | t | mod: add new-name to lbl-key ibut at
point |
+| 11 | name | nil | nil | t | mod: aname named ibut from
hbut:current attrs |
+| 12 | name | new-name | nil | t | mod: rename aname to new-name
|
+| 13 | name | new-name | region | t | ERROR: Can't use region to mod
existing ibut |
+| 14 | name | nil | region | t | ERROR: Can't use region to mod
existing ibut |
+| 15 | nil | nil | region | t | ERROR: Can't use region to mod
existing ibut |
+| 16 | nil | new-name | region | t | ERROR: Can't use region to mod
existing ibut |
+|----+------+----------+--------+------+-----------------------------------------------|"
(let* ((actype (hattr:get 'hbut:current 'actype))
(name (hattr:get 'hbut:current 'name))
(name-regexp (ibut:label-regexp (ibut:label-to-key name)))
@@ -2207,6 +2216,10 @@ Summary of operations based on inputs:
(when (and new-name (or (not (stringp new-name)) (string-empty-p
new-name)))
(hypb:error "(ibut:operate): 'new-name' value must be a non-empty
string, not: '%s'"
new-name))
+ (when (and name new-name (not edit-flag))
+ (hypb:error "(ibut:operate): 'edit-flag' must be t to rename a button
(hbut:current name and new-name both given)"))
+ (when (and region-flag edit-flag)
+ (hypb:error "(ibut:operate): 'edit-flag' must be nil when region is
highlighted to use region as new button name"))
(unless new-name
(setq new-name name))
@@ -2214,14 +2227,8 @@ Summary of operations based on inputs:
(hattr:set 'hbut:current 'name new-name))
(save-excursion
(if (progn
- (if edit-flag
- (progn
- (setq instance-flag
- (hbdata:ibut-instance-last (ibut:label-to-key
new-name)))
- (run-hooks 'ibut-edit-hook))
- (setq instance-flag
- (hbdata:ibut-instance-last (ibut:label-to-key name)))
- (run-hooks 'ibut-create-hook))
+ (setq instance-flag (hbdata:ibut-instance-last (ibut:label-to-key
+ (if edit-flag
new-name name))))
(when (null instance-flag)
(setq instance-flag t))
instance-flag)
@@ -2231,43 +2238,47 @@ Summary of operations based on inputs:
(if edit-flag "modify" "create")
ibut:label-start name ibut:label-end
(buffer-name))))
- (cond (edit-flag
- (if name
- ;; Rename all occurrences of button - those with same name
- (let* ((but-key-and-pos (ibut:label-p nil nil nil 'pos))
- (at-but (equal (car but-key-and-pos)
- (ibut:label-to-key new-name))))
- (when at-but
- (ibut:delimit (nth 1 but-key-and-pos)
- (nth 2 but-key-and-pos)
+ (let (start end mark prev-point)
+ (cond (edit-flag
+ (cond (name
+ ;; Rename all occurrences of button - those with same name
+ (let* ((but-key-and-pos (ibut:label-p nil nil nil 'pos))
+ (at-but (equal (car but-key-and-pos)
+ (ibut:label-to-key new-name))))
+ (when at-but
+ (ibut:delimit (nth 1 but-key-and-pos)
+ (nth 2 but-key-and-pos)
+ instance-flag))
+ (cond ((ibut:map
+ (lambda (_lbl start end)
+ (delete-region start end)
+ (ibut:delimit
+ (point)
+ (progn (insert new-name) (point))
instance-flag))
- (cond ((ibut:map
- (lambda (_lbl start end)
- (delete-region start end)
- (ibut:delimit
- (point)
- (progn (insert new-name) (point))
- instance-flag))
- name-regexp 'include-delims))
- (at-but)
- ((hypb:error "(ibut:operate): No button matching: %s"
name))))
- ;; Add new-name to nameless button at point
- (goto-char (or (hattr:get 'hbut:current 'lbl-start) (point)))
- (ibut:delimit (point)
- (progn (insert new-name) (point))
- instance-flag)))
-
- (instance-flag
- ;; Above flag is 't when there is exactly one existing
- ;; instance of the button name
- ;;
- ;; Add a new implicit button in the buffer, recording its
- ;; start and end positions; new-name is always nil here
- (let (start end mark prev-point buf-lbl)
+ name-regexp 'include-delims))
+ (at-but)
+ ((hypb:error "(ibut:operate): No button matching:
%s" name)))))
+ (new-name
+ ;; Add new-name to nameless button at point
+ (goto-char (or (hattr:get 'hbut:current 'lbl-start)
(point)))
+ (ibut:delimit (point)
+ (progn (insert new-name) (point))
+ instance-flag))))
+
+ (instance-flag
+ ;; Above flag is 't when there is exactly one existing
+ ;; instance of the button name
+ ;;
+ ;; Add a new implicit button in the buffer, recording its
+ ;; start and end positions; new-name is always nil here
(cond ((not (or name region-flag))
;; No name to insert, just insert ibutton text below
)
((and region-flag
+ ;; ignore region when name or new-name are set
+ (not (or name new-name))
+ ;; new-name is always nil here
(if (hyperb:stack-frame
'(hui:ebut-create hui:ebut-edit
hui:ebut-edit-region
hui:ebut-link-create
hui:gbut-create
@@ -2275,43 +2286,45 @@ Summary of operations based on inputs:
hui:ibut-create hui:ibut-edit
hui:ibut-link-create
ibut:program))
;; Ignore action-key-depress-prev-point
- (progn (setq mark (marker-position (mark-marker))
- start (region-beginning)
- end (region-end)
- buf-lbl
(buffer-substring-no-properties start end))
- (equal buf-lbl name))
+ (setq start (region-beginning)
+ end (region-end)
+ name (buffer-substring-no-properties start
end))
;; Utilize any action-key-depress-prev-point
- (setq mark (marker-position (mark-marker)))
- (setq prev-point (and action-key-depress-prev-point
- (marker-position
action-key-depress-prev-point)))
- (setq start (if (and prev-point mark (<= prev-point
mark))
+ (setq mark (marker-position (mark-marker))
+ prev-point (and action-key-depress-prev-point
+ (marker-position
action-key-depress-prev-point))
+ start (if (and prev-point mark (<= prev-point
mark))
prev-point
(region-beginning))
end (if (and prev-point mark (> prev-point
mark))
prev-point
(region-end))
- buf-lbl (buffer-substring-no-properties start
end))
- (equal buf-lbl name)))
+ name (buffer-substring-no-properties start
end))))
nil)
((progn (when start (goto-char start))
- (when name (looking-at (regexp-quote name))))
+ (or (when name (looking-at (regexp-quote name)))
+ (when new-name (looking-at (regexp-quote
new-name)))))
(setq start (point)
end (match-end 0)))
(name
(setq start (point))
(insert name)
- (setq end (point))))
-
- (when (and start end)
- (ibut:delimit start end instance-flag))
- (ibut:insert-text 'hbut:current)
- (if start
- (goto-char start)
- (goto-char (max (- (point) 2) (point-min))))))
-
- (t (hypb:error
- "(ibut:operate): Operation failed. Check button attribute
permissions: %s"
- hattr:filename)))
+ (setq end (point)))
+ (new-name
+ (setq start (point))
+ (insert new-name)
+ (setq end (point)))))
+ (t (hypb:error
+ "(ibut:operate): Operation failed. Check button attribute
permissions: %s"
+ hattr:filename)))
+
+ (unless edit-flag
+ (when (and start end)
+ (ibut:delimit start end instance-flag))
+ (ibut:insert-text 'hbut:current)
+ (if start
+ (goto-char start)
+ (goto-char (max (- (point) 2) (point-min))))))
;; Append any instance-flag string to the button name
(when (stringp instance-flag)
@@ -2342,6 +2355,8 @@ Summary of operations based on inputs:
(hypb:error "(ibut:operate): hbut:current ibut lbl-key '%s' must be
non-nil"
lbl-key)))
+ (run-hooks (if edit-flag 'ibut-edit-hook 'ibut-create-hook))
+
;; instance-flag might be 't which we don't want to return.
(when (stringp instance-flag) instance-flag)))
@@ -2357,8 +2372,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))
@@ -2450,10 +2464,20 @@ function, followed by a list of arguments for the
actype, aside from
the button NAME which is automatically provided as the first argument.
For interactive creation, use `hui:ibut-create' instead."
+ ;; Throw an error if on a named or delimited Hyperbole button since
+ ;; cannot create another button within such contexts.
+ (when (hbut:at-p)
+ (let ((name (hattr:get 'hbut:current 'name))
+ (lbl (hbut:key-to-label (hattr:get 'hbut:current 'lbl-key)))
+ (lbl-start (hattr:get 'hbut:current 'lbl-start))
+ (lbl-end (hattr:get 'hbut:current 'lbl-end)))
+ (when (or name lbl (and lbl-start lbl-end))
+ (error "(ibut:program): Cannot nest an ibut within the existing button:
%s"
+ (or name lbl (buffer-substring-no-properties lbl-start
lbl-end))))))
(save-excursion
(let ((but-buf (current-buffer))
(actype-sym (actype:action actype)))
- (hui:buf-writable-err but-buf "ibut-create")
+ (hui:buf-writable-err but-buf "ibut:program")
(hattr:clear 'hbut:current)
(hattr:set 'hbut:current 'name name)
(hattr:set 'hbut:current 'categ 'implicit)
@@ -2462,7 +2486,7 @@ For interactive creation, use `hui:ibut-create' instead."
(if (or (and actype-sym (fboundp actype-sym))
(functionp actype))
(hattr:set 'hbut:current 'actype actype)
- (error (format "actype arg must be a bound symbol (not a string): %S"
actype)))
+ (error "actype arg must be a bound symbol (not a string): %S" actype))
(hattr:set 'hbut:current 'args args)
(condition-case err
(ibut:operate)
@@ -2715,7 +2739,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/hib-social.el b/hib-social.el
index 74c4bb1fd9..55d38d3531 100644
--- a/hib-social.el
+++ b/hib-social.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 20-Jul-16 at 22:41:34
-;; Last-Mod: 28-May-23 at 10:06:20 by Mats Lidell
+;; Last-Mod: 2-Jul-23 at 04:19:57 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -189,42 +189,35 @@
(const "gitlab")
(const "instagram")
(const "twitter"))
- :group 'hyperbole-button)
+ :group 'hyperbole-buttons)
(defcustom hibtypes-social-display-function #'browse-url
"Function of one arg, url, to display when activating a social media
reference."
- :type 'function
- :group 'hyperbole-button)
+ :type 'function)
(defcustom hibtypes-git-default-project nil
"Default project name to associate with any local git commit link."
- :type 'string
- :group 'hyperbole-button)
+ :type 'string)
(defcustom hibtypes-git-use-magit-flag nil
"Non-nil means use `magit' rather than `dired' for a git directory button."
- :type 'boolean
- :group 'hyperbole-button)
+ :type 'boolean)
(defcustom hibtypes-github-default-project nil
"Default project name to associate with any Github commit link."
- :type 'string
- :group 'hyperbole-button)
+ :type 'string)
(defcustom hibtypes-github-default-user nil
"Default user name to associate with any Github commit link."
- :type 'string
- :group 'hyperbole-button)
+ :type 'string)
(defcustom hibtypes-gitlab-default-project nil
"Default project name to associate with any Github commit link."
- :type 'string
- :group 'hyperbole-button)
+ :type 'string)
(defcustom hibtypes-gitlab-default-user nil
"Default user name to associate with any Github commit link."
- :type 'string
- :group 'hyperbole-button)
+ :type 'string)
;;; ************************************************************************
;;; Public declarations
diff --git a/hibtypes.el b/hibtypes.el
index 2f9814b458..629a02b23f 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: 25-Jun-23 at 23:04:09 by Bob Weiner
+;; Last-Mod: 8-Jul-23 at 14:02:33 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -1537,24 +1537,21 @@ arg1 ... argN '>'. For example, <mail nil
\"u...@somewhere.org\">."
(cond ((and (symbolp actype) (fboundp actype)
(string-match "-p\\'" (symbol-name actype)))
;; Is a function with a boolean result
- (setq args `(',args)
- action `(display-boolean ',action)
- actype #'display-boolean))
+ (setq actype #'display-boolean
+ args `(',action)))
((and (null args) (symbolp actype) (boundp actype)
(or var-flag (not (fboundp actype))))
;; Is a variable, display its value as the action
- (setq args `(',args)
- action `(display-variable ',actype)
+ (setq args `(',actype)
actype #'display-variable))
(t
;; All other expressions, display the action result in the
minibuffer
- (setq args `(',args)
- action `(display-value ',action)
- actype #'display-value))))
+ (setq actype #'display-value
+ args `(',action)))))
;; Create implicit button object and store in symbol hbut:current.
(ibut:create :lbl-key lbl-key :lbl-start start-pos :lbl-end end-pos
- :categ 'ibtypes::action :actype actype :args args :action
action)
+ :categ 'ibtypes::action :actype actype :args args)
;; Necessary so can return a null value, which actype:act cannot.
(let ((hrule:action
diff --git a/hload-path.el b/hload-path.el
index 34ad0f8115..002cc244a4 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: 2-Jul-23 at 12:25:01 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).")
@@ -173,7 +171,7 @@ This is used only when running from git source and not a
package release."
(with-current-buffer (find-file-noselect al-file)
(hload-path--make-directory-autoloads "." al-file)))
(unless (hyperb:autoloads-exist-p)
- (error (format "Hyperbole failed to generate autoload files; try running
'make src' in a shell in %s" hyperb:dir))))
+ (error "Hyperbole failed to generate autoload files; try running 'make
src' in a shell in %s" hyperb:dir)))
(defun hyperb:maybe-load-autoloads ()
"Load Hyperbole autoload files that have not already been loaded."
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 4ae38d346f..5d5cef6258 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: 4-Jul-23 at 15:36:51 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))
@@ -1072,12 +1068,10 @@ documentation is found."
(select-window (previous-window))
(display-buffer buf 'other-win))
(display-buffer buf 'other-win))
- (if (or (and (boundp 'help-window-select)
- help-window-select)
- (and (boundp 'help-selects-help-window)
- help-selects-help-window))
- (select-window (get-buffer-window buf))
- (select-window owind)))))
+ (select-window
+ (if (bound-and-true-p help-window-select)
+ (get-buffer-window buf)
+ owind)))))
(temp-buffer-show-function temp-buffer-show-hook))
(with-output-to-temp-buffer
(hypb:help-buf-name
@@ -1376,9 +1370,9 @@ and it was inactive, return its window, else nil."
(let ((window (posn-window (event-start event))))
(when (framep window)
(setq window (frame-selected-window window)))
- (and (window-minibuffer-p window)
- (not (minibuffer-window-active-p window))
- window)))
+ (and window
+ (window-minibuffer-p window)
+ (not (minibuffer-window-active-p window)))))
;; Based on code from subr.el.
(defun hmouse-vertical-line-spacing (frame)
diff --git a/hmouse-sh.el b/hmouse-sh.el
index 5c81a82f4e..f14b9b09d3 100644
--- a/hmouse-sh.el
+++ b/hmouse-sh.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 3-Sep-91 at 21:40:58
-;; Last-Mod: 16-Oct-22 at 19:32:50 by Mats Lidell
+;; Last-Mod: 4-Jul-23 at 12:26:37 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -401,13 +401,19 @@ Select the corresponding window as well."
(unless (windowp (posn-window position))
(error "Position not in text area of window"))
(select-window (posn-window position)))
- (when (numberp (posn-point position))
- (goto-char (posn-point position))))
+ (let ((pos-point (posn-point position)))
+ ;; Need all these checks for vertico-mode
+ (when (and (numberp pos-point)
+ (>= pos-point (point-min))
+ (<= pos-point (point-max)))
+ (goto-char pos-point))))
;; Based on mouse-drag-region from Emacs mouse.el.
(defun hmouse-drag-region (start-event)
"Set the region to the text that the mouse is dragged over.
-If not the start of a region drag-and-drop, then depress the Action Key.
+If not the start of a region drag-and-drop, and hyperbole-mode is
+enabled, then depress the Action Key.
+
Highlight the drag area as you move the mouse.
This must be bound to a button-down mouse event.
In Transient Mark mode, the highlighting remains as long as the mark
@@ -423,7 +429,8 @@ is dragged over to."
(mouse-drag-and-drop-region start-event)
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
- (action-key-depress start-event)
+ (when hyperbole-mode
+ (action-key-depress start-event))
(mouse-drag-track start-event)))
;; Based on a function from Emacs mouse.el.
diff --git a/hpath.el b/hpath.el
index 47cd61f2e7..c50a9bc074 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: 30-Jun-23 at 22:38:18 by Mats Lidell
+;; Last-Mod: 8-Jul-23 at 16:01:35 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -660,14 +660,14 @@ Contains a %s for replacement of a specific anchor id.")
"Regexp matching a Markdown anchor id definition.
Contains a %s for replacement of a specific anchor id.")
-(defconst hpath:markdown-section-pattern "^[ \t]*\\(#+\\|\\*+\\)[ \t]+%s\\([
\t[:punct:]]*\\)$"
+(defconst hpath:markdown-section-pattern "^[ \t]*\\(#+\\|\\*+\\)[
\t]+%s\\([\[<\({ \t[:punct:]]*\\)$"
"Regexp matching a Markdown section header.
Contains a %s for replacement of a specific section name.")
(defconst hpath:markdown-suffix-regexp "\\.[mM][dD]"
"Regexp that matches to a Markdown file suffix.")
-(defconst hpath:outline-section-pattern "^\\*+[ \t]+%s[
\t]*\\([:punct:]+\\|$\\)"
+(defconst hpath:outline-section-pattern "^\\*+[ \t]+%s[
\t]*\\([\[<\({[:punct:]]+\\|$\\)"
"Bol-anchored, no leading spaces regexp matching an Emacs outline section
header.
Contains a %s for replacement of a specific section name.")
@@ -716,7 +716,7 @@ Uses optional DEFAULT-DIRS (a list of dirs or a single dir)
or
(make-list (max 0 (- (length arg-list) (length param-list)))
(last param-list))))
(cl-mapcar (lambda (param arg)
- (if (and arg
+ (if (and (stringp param)
(or (string-match-p "file" param)
(string-match-p "dir" param)
(string-match-p "path" param)))
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-mouse.el b/hui-mouse.el
index cf7aad628d..bfbb56740f 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 04-Feb-89
-;; Last-Mod: 25-Jun-23 at 16:36:39 by Mats Lidell
+;; Last-Mod: 4-Jul-23 at 19:51:04 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -208,10 +208,6 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
(smart-org)))
. ((smart-org) . (smart-org)))
;;
- ;; Ivy minibuffer completion mode
- ((and (boundp 'ivy-mode) ivy-mode (minibuffer-window-active-p
(selected-window)))
- . ((ivy-done) . (ivy-dispatching-done)))
- ;;
;; Treemacs hierarchical file manager
((eq major-mode 'treemacs-mode)
. ((smart-treemacs) . (smart-treemacs)))
@@ -225,10 +221,15 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
. ((smart-push-button nil (mouse-event-p last-command-event))
. (smart-push-button-help nil (mouse-event-p last-command-event))))
;;
- ;; If click in the minibuffer and reading an argument,
- ;; accept argument or give completion help.
- ((and (> (minibuffer-depth) 0)
+ ;; If click in the minibuffer and reading an argument (aside from
+ ;; with vertico or ivy), accept argument or give completion help.
+ ((and hargs:reading-type
+ (> (minibuffer-depth) 0)
(eq (selected-window) (minibuffer-window))
+ (not (bound-and-true-p ivy-mode))
+ (not (and (bound-and-true-p vertico-mode)
+ ;; Ensure vertico is prompting for an argument
+ (vertico--command-p nil (current-buffer))))
(not (eq hargs:reading-type 'hmenu))
(not (smart-helm-alive-p)))
. ((funcall (key-binding (kbd "RET"))) . (smart-completion-help)))
@@ -236,8 +237,7 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
;; If reading a Hyperbole menu item or a Hyperbole completion-based
;; argument, allow selection of an item at point.
((and (> (minibuffer-depth) 0) (setq hkey-value (hargs:at-p)))
- . ((hargs:select-p hkey-value)
- . (hargs:select-p hkey-value 'assist)))
+ . ((hargs:select-p hkey-value) . (hargs:select-p hkey-value 'assist)))
;;
;; If reading a Hyperbole menu item and nothing is selected, just return.
;; Or if in a helm session with point in the minibuffer, quit the
@@ -574,8 +574,8 @@ smart keyboard keys.")
(defun smart-completion-help ()
"Offer completion help for current minibuffer argument, if any."
- (if (where-is-internal 'minibuffer-completion-help (current-local-map))
- (minibuffer-completion-help)))
+ (when (where-is-internal 'minibuffer-completion-help (current-local-map))
+ (minibuffer-completion-help)))
;;; ************************************************************************
;;; smart-buffer-menu functions
diff --git a/hui.el b/hui.el
index cf2244135d..9f33680846 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: 30-Jun-23 at 22:50:57 by Mats Lidell
+;; Last-Mod: 8-Jul-23 at 16:04:59 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")
@@ -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))
@@ -880,24 +920,36 @@ Default is any implicit button at point."
(defun hui:ibut-create (&optional start end)
"Interactively create an implicit Hyperbole button at point.
-Use any label between optional START and END (when interactive,
-active) region points. Indicate button creation by delimiting
+Use any label between optional START and END points (when interactive,
+any active region). Indicate button creation by delimiting
and adding any necessary instance number to the button label.
For programmatic creation, use `ibut:program' instead."
(interactive (list (when (use-region-p) (region-beginning))
(when (use-region-p) (region-end))))
(hypb:assert-same-start-and-end-buffer
- (let ((default-name) name but-buf actype)
+ (let (default-name name but-buf actype)
+ (setq but-buf (current-buffer))
+ (hui:buf-writable-err but-buf "ibut-create")
+ (hattr:clear 'hbut:current)
+
+ ;; Throw an error if on a named or delimited Hyperbole button since
+ ;; cannot create another button within such contexts.
+ (when (hbut:at-p)
+ (let ((name (hattr:get 'hbut:current 'name))
+ (lbl (hbut:key-to-label (hattr:get 'hbut:current 'lbl-key)))
+ (lbl-start (hattr:get 'hbut:current 'lbl-start))
+ (lbl-end (hattr:get 'hbut:current 'lbl-end)))
+ (when (or name lbl (and lbl-start lbl-end))
+ (error "(ibut-create): Cannot nest an ibut within the existing
button: '%s'"
+ (or name lbl (buffer-substring-no-properties lbl-start
lbl-end))))))
+
(save-excursion
(setq default-name (hui:hbut-label-default start end (not
(called-interactively-p 'interactive)))
name (hui:hbut-label default-name "ibut-create"))
(unless (equal name default-name)
(setq default-name nil))
- (setq but-buf (current-buffer))
- (hui:buf-writable-err but-buf "ibut-create")
-
(hattr:set 'hbut:current 'name name)
(hattr:set 'hbut:current 'categ 'implicit)
(hattr:set 'hbut:current 'loc (hui:key-src but-buf))
@@ -1055,6 +1107,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 +1121,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 +1140,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 +1195,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 +1222,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 +1242,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 +1296,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)))
;;; ************************************************************************
@@ -1248,10 +1313,8 @@ drag from a window to another window's modeline."
(params-str (and params (concat " " (prin1-to-string params)))))
(while (progn
(while (and (setq act-str
- (hargs:read
- (or prompt (concat "Action" params-str
- ": ")) nil nil
- nil 'string))
+ (hargs:read (or prompt (concat "Action"
params-str ": "))
+ nil nil nil 'string))
(not (string-equal act-str ""))
(condition-case ()
(progn (setq act (read act-str)) nil)
@@ -1271,7 +1334,7 @@ drag from a window to another window's modeline."
(and (string-match
(concat "[\( \t\n\r,']"
(regexp-quote param)
- "[\(\) \t\n\r\"]")
+ "[() \t\n\r\"]")
act-str)
t))
params-no-keywords)))))
@@ -1653,6 +1716,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 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 +1795,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/hyperbole.el b/hyperbole.el
index 7cdb137436..34a65d6143 100644
--- a/hyperbole.el
+++ b/hyperbole.el
@@ -7,7 +7,7 @@
;; Author: Bob Weiner
;; Maintainer: Bob Weiner <r...@gnu.org>, Mats Lidell <ma...@gnu.org>
;; Created: 06-Oct-92 at 11:52:51
-;; Last-Mod: 1-Jul-23 at 23:42:43 by Mats Lidell
+;; Last-Mod: 8-Jul-23 at 16:00:21 by Bob Weiner
;; Released: 03-Dec-22
;; Version: 8.0.1pre
;; Keywords: comm, convenience, files, frames, hypermedia, languages,
mail, matching, mouse, multimedia, outlines, tools, wp
@@ -196,6 +196,7 @@ Assist Key will do."
`hkey-initialize' must have already been called or the list will be empty."
hyperbole-mode-map)
+;; Use `hkey-set-key' instead.
(make-obsolete 'hkey-global-set-key 'hkey-set-key "8.0.0")
(defun hkey-global-set-key (key command &optional _no-add)
"Define a Hyperbole KEY bound to COMMAND. Optional third arg, NO-ADD is
ignored."
@@ -481,6 +482,12 @@ frame, those functions by default still return the prior
frame."
'buttons
t)))
;;
+ ;; When vertico-mode is used, vertico-mouse-mode is needed for the
+ ;; Action Key to properly select completions from the candidate list.
+ (if (bound-and-true-p vertico-mode)
+ (vertico-mouse-mode 1)
+ (add-hook 'vertico-mode-hook (lambda () (vertico-mouse-mode 1))))
+ ;;
;; Hyperbole initialization is complete.
(message "Initializing Hyperbole...done"))
diff --git a/man/hkey-help.txt b/man/hkey-help.txt
index f32ae91bed..bac0b5aef9 100644
--- a/man/hkey-help.txt
+++ b/man/hkey-help.txt
@@ -8,7 +8,8 @@ Hyperbole
Reading argument
1st press at an arg value Copies value to minibuffer <- same
2nd press at an arg value Uses value as argument <- same
- In minibuffer Accepts minibuffer arg Completion help
+ In minibuffer at eol Accepts minibuffer arg List completions
+ In minibuffer before eol Deletes rest of arg Deletes rest of arg
On an implicit button/path Activates button Button help
Within a koutline cell Collapses and expands Shows tree props
Left of a koutline cell Creates a klink Moves a tree
diff --git a/man/hyperbole.texi b/man/hyperbole.texi
index ef5b30b5b8..2ffa6fbe3a 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: 8-Jul-23 at 10:31:40 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 8, 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 8, 2023
Published by the Free Software Foundation, Inc.
Author: Bob Weiner
@@ -1223,24 +1223,45 @@ Hyperbole user interface has an extensive core of
argument types that
it recognizes. Whenever Hyperbole is prompting you for an argument,
it knows the type that it needs and provides some error checking to
help you get it right. More importantly, it allows you to press the
-Action Key within an entity that you want to use as an argument and it
-will grab the appropriate thing and show it to you at the input prompt
-within the minibuffer. If you press (click with a mouse) the Action
-Key on the same thing again, it accepts the entity as the argument
-and moves on. Thus, a double click registers a desired argument.
-Double-quoted strings, pathnames, mail messages, Info nodes, dired
-listings, buffers, numbers, completion items and so forth are all
-recognized at appropriate times. All of the argument types mentioned
-in the documentation for the Emacs Lisp @code{interactive} function
-are recognized. Experiment a little and you will quickly get used to
-this direct selection technique.
+Action Key within an entity that you want to use as an argument.
+Hyperbole will copy the appropriate thing to the minibuffer as the
+argument. If you press (click with a mouse) the Action Key on the
+same thing again, e.g. within a list of possible completions,
+Hyperbole exits the minibuffer and uses the current argument. Thus, a
+double click registers a desired argument. Double-quoted strings,
+pathnames, mail messages, Info nodes, dired listings, buffers,
+numbers, completion items and so forth are all recognized at
+appropriate times. All of the argument types mentioned in the
+documentation for the Emacs Lisp @code{interactive} function are
+recognized. Experiment a little and you will quickly get used to this
+direct selection technique.
@cindex completion
-Wherever possible, standard Emacs completion is offered, as described in
-@ref{Completion,,,emacs,the GNU Emacs Manual}. Remember to use @bkbd{?}
-to see what your possibilities for an argument are. Once you have a
-list of possible completions on screen, press the Action Key twice on
-any item to enter it as the argument.
+@cindex Vertico completion
+Wherever possible, standard Emacs completion is offered, as described
+in @ref{Completion,,,emacs,the GNU Emacs Manual}. Remember to use
+@bkbd{?} to see what your possibilities for an argument are if
+completions are not automatically shown to you. Once you have a list
+of possible completions on screen, press the Action Key twice on any
+item to enter it as the argument. If you are using the Vertico
+completion library with completions displayed in the minibuffer,
+selection of completions works the same as if they were displayed in a
+separate buffer as in standard Emacs.
+
+@cindex minibuffer completion
+@cindex minibuffer arguments
+@cindex Smart Keys in minibuffer
+@cindex Action Key in minibuffer
+@cindex Assist Key in minibuffer
+Within the minibuffer itself, the Smart Keys are also
+context-sensitive. A press of the Action Key at the end of the
+argument line tries to accept the argument and when successful, exits
+the minibuffer. A press of the Assist Key at the end of the argument
+line displays matching completions for times when they are not
+automatically displayed or need updating. A press of the Action or
+Assist Key on part of the argument, deletes from point to the end of
+the line, expanding the set of available completions and redisplaying
+them.
@node Smart Key Debugging, Smart Key Thing Selection, Smart Key Argument
Selection, Smart Keys
@section Smart Key Debugging
@@ -2001,7 +2022,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 +2047,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 +7450,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/demo-tests.el b/test/demo-tests.el
index 1431c44c1d..7278704098 100644
--- a/test/demo-tests.el
+++ b/test/demo-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 30-Jan-21 at 12:00:00
-;; Last-Mod: 22-Jun-23 at 20:35:55 by Mats Lidell
+;; Last-Mod: 8-Jul-23 at 14:16:51 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -231,12 +231,12 @@
(string-match-p "hactypes\\.el" hactypes-buf)
(string-match-p "hibtypes\\.el" hibtypes-buf))))))
-(ert-deftest demo-implicit-button-action-button-boolean-function-call-test ()
+(ert-deftest demo-implicit-button-action-button-display-boolean-test ()
(with-temp-buffer
(insert "<string-empty-p \"False\">")
(goto-char 2)
(action-key)
- (hy-test-helpers:should-last-message "Boolean result (False) = nil")))
+ (hy-test-helpers:should-last-message "Result = nil; Boolean value =
False")))
(ert-deftest demo-implicit-button-action-button-variable-display-test ()
(with-temp-buffer
diff --git a/test/hactypes-tests.el b/test/hactypes-tests.el
index e23980e11c..39a1ea098d 100644
--- a/test/hactypes-tests.el
+++ b/test/hactypes-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 30-Jan-21 at 12:00:00
-;; Last-Mod: 6-Feb-22 at 00:56:35 by Bob Weiner
+;; Last-Mod: 8-Jul-23 at 14:11:49 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -26,11 +26,11 @@
(ert-deftest display-boolean-true-test ()
(should (actypes::display-boolean t))
- (hy-test-helpers:should-last-message "Boolean result (True) = t"))
+ (hy-test-helpers:should-last-message "Result = t; Boolean value = True"))
(ert-deftest display-boolean-false-test ()
(should (actypes::display-boolean nil))
- (hy-test-helpers:should-last-message "Boolean result (False) = nil"))
+ (hy-test-helpers:should-last-message "Result = nil; Boolean value =
False"))
(provide 'hactypes-tests)
;;; hactypes-tests.el ends here
diff --git a/test/hbut-tests.el b/test/hbut-tests.el
index 0d3875a2fa..8f95038b07 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: 5-Jul-23 at 00:29:02 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -26,10 +26,10 @@
(require 'hy-test-helpers "test/hy-test-helpers")
(defun hbut-tests:should-match-tmp-folder (tmp)
- "Check that TMP matches either of \"/tmp\" or \"private/tmp\".
+ "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 ()
@@ -337,6 +337,134 @@ Needed since hyperbole expands all links to absolute
paths and
`(dolist (bd ,hbut-tests-actypes-list)
(with-temp-file "hypb.txt" ,@body))))
+;; ibut:operate tests
+
+(ert-deftest hbut-tests--ibut-operate--none ()
+ "Create unnamed ibut.
+
|------+----------+--------+-----------+-----------------------------------------------|
+ | name | new-name | region | edit-flag | operation
|
+
|------+----------+--------+-----------+-----------------------------------------------|
+ | nil | nil | nil | nil | create: unnamed ibut from
hbut:current attrs |
+
|------+----------+--------+-----------+-----------------------------------------------|"
+ (with-temp-buffer
+ (insert "/tmp")
+ (goto-char 2)
+ (should (hbut:at-p))
+ (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ (hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))
+ (erase-buffer)
+ (should-not (ibut:operate))
+ (should (hbut:at-p))
+ (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ (hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))))
+
+(ert-deftest hbut-tests--ibut-operate--aname ()
+ "Create aname ibut."
+ (with-temp-buffer
+ (insert "<[aname]> - /tmp")
+ (goto-char 2)
+ (should (hbut:at-p))
+ (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ (hbut-tests:should-match-tmp-folder (buffer-substring-no-properties
(point-min) (point-max)))
+ (erase-buffer)
+ (
+ (hattr:set 'hbut:current 'name "aname")
+ (hattr:set 'hbut:current 'name "")
+ (should-not (ibut:operate))
+ (should (hbut:at-p))
+ (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ (should (string= "<[aname]> - /tmp<[aname]> - \"/tmp\""
+ (buffer-substring-no-properties (point-min)
(point-max)))))))
+
+(ert-deftest hbut-tests--ibut-operate--aname-region-skip-region ()
+ "Create aname ibut and ignore region."
+ (with-temp-buffer
+ (insert "<[aname]> - /tmp")
+ (goto-char 2)
+ (should (hbut:at-p))
+ (end-of-buffer)
+ (insert "\n")
+ (set-mark (point))
+ (insert "abcd")
+ (should (region-active-p))
+ (should-not (ibut:operate))
+ ;; Inserted just before region which is kept
+ (should (string= "<[aname]> - /tmp\n<[aname]> - \"/tmp\"abcd"
+ (buffer-substring-no-properties (point-min)
(point-max))))))
+
+(ert-deftest hbut-tests--ibut-operate--region ()
+ "Create ibut with aname, ignore region."
+ (with-temp-buffer
+ (insert "/tmp")
+ (goto-char 2)
+ (should (hbut:at-p))
+ (end-of-buffer)
+ (insert "\n")
+ (set-mark (point))
+ (insert "name")
+ (should (region-active-p))
+ (should-not (ibut:operate))
+ (should (string= "/tmp\n<[name]>\"/tmp\""
+ (buffer-substring-no-properties (point-min)
(point-max))))))
+
+(ert-deftest hbut-tests--ibut-operate--modify-named ()
+ "Add new-name to named ibut."
+ (with-temp-buffer
+ (insert "<[name]> /tmp")
+ (goto-char 2)
+ (should (hbut:at-p))
+ (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ (should-not (ibut:operate "new-name" t))
+ (should (hbut:at-p))
+ (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ (should (string= "<[new-name]> /tmp"
+ (buffer-substring-no-properties (point-min)
(point-max))))))
+
+(ert-deftest hbut-tests--ibut-operate--modify-named-skip-region ()
+ "Add new-name to named ibut and ignore region."
+ (with-temp-buffer
+ (insert "<[name]> /tmp")
+ (goto-char 2)
+ (should (hbut:at-p))
+ (set-mark (point-max))
+ (should (region-active-p))
+ (should-not (ibut:operate "new-name" t))
+ (should (hbut:at-p))
+ (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ (should (string= "<[new-name]> /tmp"
+ (buffer-substring-no-properties (point-min)
(point-max))))))
+
+(ert-deftest hbut-tests--ibut-operate--add-new-name ()
+ "Add new-name to unnamed ibut."
+ (with-temp-buffer
+ (insert "/tmp")
+ (goto-char 2)
+ (should (hbut:at-p))
+ (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ (should-not (ibut:operate "new-name" t))
+ ;; Missing delimiter -- Not identified as a ibut after name is inserted
+ ;; (should (hbut:at-p))
+ ;; (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ ;; delimiter
+ (should (string= "<[new-name]>/tmp"
+ (buffer-substring-no-properties (point-min)
(point-max))))))
+
+(ert-deftest hbut-tests--ibut-operate--add-new-name-skip-region ()
+ "Add new-name to unnamed ibut, skip active region."
+ (with-temp-buffer
+ (insert "/tmp")
+ (goto-char 2)
+ (should (hbut:at-p))
+ (set-mark (point-max))
+ (should (region-active-p))
+ (should-not (ibut:operate "new-name" t))
+ ;; Missing delimiter -- Not identified as a ibut after name is inserted
+ ;; (should (hbut:at-p))
+ ;; (should (eq (hattr:get 'hbut:current 'actype) 'actypes::link-to-file))
+ ;; Missing delimiter
+ (should (string= "<[new-name]>/tmp"
+ ))))
+
;; This file can't be byte-compiled without the `el-mock' package (because of
;; the use of the `with-mock' macro), which is not a dependency of Hyperbole.
;; Local Variables:
