branch: externals/hyperbole commit 3715ff40770577be9dc8166b14004e022c75f51f Author: Bob Weiner <r...@gnu.org> Commit: Bob Weiner <r...@gnu.org>
Smart Key support for vertico-mode and interactive completion filter A number of small fixes. --- ChangeLog | 38 +++++++++++++++ hact.el | 13 +++--- hargs.el | 147 +++++++++++++++++++++++++++++++++++++++++++++------------- hload-path.el | 4 +- hmouse-drv.el | 18 ++++--- hmouse-sh.el | 17 +++++-- hui-mouse.el | 24 +++++----- hui.el | 36 ++++++++------ hyperbole.el | 9 +++- 9 files changed, 224 insertions(+), 82 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5b991816f6..f3c61ea9aa 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,43 @@ +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. + 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. diff --git a/hact.el b/hact.el index 3d215beaf0..3465e9fa2e 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: 3-Jul-23 at 18:43:27 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -388,11 +388,12 @@ performing ACTION." (setq args (hpath:absolute-arguments actype args))) (let ((hist-elt (hhist:element))) (run-hooks 'action-act-hook) - (prog1 (or (if (or (symbolp action) (listp action) - (byte-code-function-p action) - (subrp action) - (and (stringp action) (not (integerp action)) - (setq action (key-binding action)))) + (prog1 (or (if (and args + (or (symbolp action) (listp action) + (byte-code-function-p action) + (subrp action) + (and (stringp action) (not (integerp action)) + (setq action (key-binding action))))) (eval (cons action args)) (eval action)) t) 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/hload-path.el b/hload-path.el index 73ebd550a5..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: 29-Jun-23 at 18:46:17 by Bob Weiner +;; Last-Mod: 2-Jul-23 at 12:25:01 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -171,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 a0655c3a05..5d5cef6258 100644 --- a/hmouse-drv.el +++ b/hmouse-drv.el @@ -3,7 +3,7 @@ ;; Author: Bob Weiner ;; ;; Orig-Date: 04-Feb-90 -;; Last-Mod: 1-Jul-23 at 13:08:22 by Bob Weiner +;; Last-Mod: 4-Jul-23 at 15:36:51 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -1068,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 @@ -1372,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/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 37ae4043fe..8a0adcde6d 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: 2-Jul-23 at 00:23:11 by Bob Weiner +;; Last-Mod: 2-Jul-23 at 15:18:06 by Bob Weiner ;; ;; SPDX-License-Identifier: GPL-3.0-or-later ;; @@ -920,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)) @@ -1301,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) @@ -1324,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))))) @@ -1707,7 +1717,7 @@ 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 + ;; 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) diff --git a/hyperbole.el b/hyperbole.el index fb1afed7b7..158eb3d88a 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: 25-Jun-23 at 12:01:04 by Bob Weiner +;; Last-mod: 5-Jul-23 at 00:27:56 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"))