[elpa] externals/hyperbole 810ee4ce5b 1/2: Fix activation and help issues with Emacs text-property push-buttons

[ELPA Syncer]

branch: externals/hyperbole
commit 810ee4ce5b943bdd5efdaaed2e2bce161c0a6674
Author: Robert Weiner <rsw@gnu.org>
Commit: Robert Weiner <rsw@gnu.org>

    Fix activation and help issues with Emacs text-property push-buttons
    
    Integrate eww ewww-browse-url command to utilize Hyperbole's setting
    of where to display URLs activated with the Action Key.
---
 ChangeLog     | 13 +++++++++++++
 HY-NEWS       |  2 +-
 hact.el       | 11 ++++++++---
 hbut.el       | 27 +++++++++++++++++----------
 hmouse-drv.el | 14 ++++++++------
 hsys-www.el   | 34 +++++++++++++++++++++++++++++++++-
 hui-mini.el   |  2 +-
 hui-mouse.el  | 22 ++++++++++++++++++----
 8 files changed, 99 insertions(+), 26 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 5524702fe2..ed3bf22ccc 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,18 @@
 2023-04-30  Bob Weiner  <rsw@gnu.org>
 
+* hsys-www.el (require 'eww): Add.
+              (eww-browse-url): Override this function so it utilizes
+    Hyperbole's choice of where to display the browser.
+
+* hui-mouse.el (smart-push-button-help, hkey-alist): Update to handle Emacs
+    text-property push-buttons, for which button-activate does not work.
+  hbut.el (hattr:emacs-button-attributes): Fix to handle Emacs
+    text-property push-button attributes.
+  hmouse-drv.el (hkey-help): Fix to handle text property push-buttons that
+    return a buffer marker object (no attributes to print then).
+               (smart-push-button): Add and reference in hkey-help to trigger
+    push-button-specific help output.
+
 * hbut.el (hbut:label-regexp): If label does not contain an instance number
     and 'no-delim' arg is nil, don't add a regexp matching to instance numbers,
     use exact label match only.
diff --git a/HY-NEWS b/HY-NEWS
index d3fd231865..59bd9069e9 100644
--- a/HY-NEWS
+++ b/HY-NEWS
@@ -396,7 +396,7 @@
 ** TEST CASES
 
   *** Hyperbole Automated Testing: Automated test cases increased to over
-      275.  Simply run 'make test-all' or 'make test' from the command-line
+      285.  Simply run 'make test-all' or 'make test' from the command-line
       when in the Hyperbole source directory and you should see all tests
       pass.  If any fail, you can press the Action Key to see the source of
       the failure.  Full testing is supported under POSIX systems only.  See
diff --git a/hact.el b/hact.el
index df3faf1380..b1910c1b66 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:      8-Apr-23 at 13:33:01 by Bob Weiner
+;; Last-Mod:     30-Apr-23 at 14:40:46 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -498,13 +498,18 @@ Return nil when no documentation."
         (act (if is-hbut
                  (and (hbut:is-p but) (or (hattr:get but 'action)
                                           (hattr:get but 'actype)))
-               (plist-get (hattr:list but) 'action)))
+               (let ((attrs (hattr:list but)))
+                 (or (plist-get attrs 'action)
+                     (when (plist-get attrs 'follow-link)
+                       (plist-get attrs 'help-echo))))))
         (but-type (if is-hbut
                       (hattr:get but 'categ)
                     act))
         (sym-p (when act (symbolp act)))
         (end-line) (doc))
-    (cond ((and (functionp but-type)
+    (cond ((stringp but-type)
+          (setq doc but-type))
+         ((and (functionp but-type)
                (setq doc (htype:doc but-type)))) ;; Is an implicit button, use 
its doc string.
          (sym-p
           (setq doc (htype:doc act))))
diff --git a/hbut.el b/hbut.el
index 839540c430..97951c439d 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-Apr-23 at 10:29:17 by Bob Weiner
+;; Last-Mod:     30-Apr-23 at 14:43:05 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -797,9 +797,16 @@ Return TO-HBUT."
 
 (defun hattr:emacs-button-attributes (button)
   "Return a property list of an Emacs BUTTON."
-  (let ((category (hattr:emacs-button-is-p button)))
-    (when category
-      (symbol-plist category))))
+  (if (markerp button)
+      ;; If on a text property button, button-at will
+      ;; return a marker pointing to the button, not a
+      ;; button with attributes.
+      (with-current-buffer (marker-buffer button)
+       (when (get-text-property button 'button)
+         (text-properties-at (point))))
+    (let ((category (hattr:emacs-button-is-p button)))
+      (when category
+       (symbol-plist category)))))
 
 (defun hattr:emacs-button-is-p (button)
   "If BUTTON is a valid Emacs button, return its category, else return nil."
@@ -812,13 +819,13 @@ Return TO-HBUT."
   "Return value of OBJ-SYMBOL's attribute ATTR-SYMBOL."
   (get obj-symbol attr-symbol))
 
-(defun    hattr:list (obj-symbol)
-  "Return a property list of OBJ-SYMBOL's attributes.
+(defun    hattr:list (obj)
+  "Return a property list of OBJ's attributes.
 Each pair of elements is: <attrib-name> <attrib-value>."
-  (cond ((hattr:emacs-button-attributes obj-symbol))
-       ((symbolp obj-symbol)
-        (symbol-plist obj-symbol))
-       (t (error "(hattr:list): Argument not a symbol: %s" obj-symbol))))
+  (cond ((hattr:emacs-button-attributes obj))
+       ((symbolp obj)
+        (symbol-plist obj))
+       (t (error "(hattr:list): Argument not a symbol: %s" obj))))
 
 (defun    hattr:memq (attr-symbol obj-symbol)
   "Return t if ATTR-SYMBOL is in OBJ-SYMBOL's attribute list, else nil."
diff --git a/hmouse-drv.el b/hmouse-drv.el
index f367577583..0d3ab06905 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    04-Feb-90
-;; Last-Mod:     23-Apr-23 at 22:36:29 by Mats Lidell
+;; Last-Mod:     30-Apr-23 at 15:49:20 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -1047,17 +1047,19 @@ documentation is found."
                                                                   nil t))))))
 
                    ;; Print Emacs push-button attributes
-                   (when (eq cmd-sym 'push-button)
+                   (when (memq cmd-sym '(smart-push-button 
smart-push-button-help))
                      (let* ((button (button-at (point)))
                             (attributes (when button (hattr:list button))))
                        (when attributes
                          (princ (format "%s BUTTON SPECIFICS:\n"
                                         (button-label button)))
                          (hattr:report attributes)
-                         (princ (format "\n%s ACTION SPECIFICS:\n%s\n"
-                                        (plist-get attributes 'action)
-                                        (replace-regexp-in-string "^" "  " 
(actype:doc button t)
-                                                                  nil t))))))
+                         ;; text-property buttons are represented as markers
+                         (unless (markerp button)
+                           (princ (format "\n%s ACTION SPECIFICS:\n%s\n"
+                                          (plist-get attributes 'action)
+                                          (replace-regexp-in-string "^" "  " 
(actype:doc button t)
+                                                                    nil 
t)))))))
 
                    (terpri)))
                "")
diff --git a/hsys-www.el b/hsys-www.el
index 7b91e6940a..5bd76289c2 100644
--- a/hsys-www.el
+++ b/hsys-www.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:     7-Apr-94 at 17:17:39 by Bob Weiner
-;; Last-Mod:     12-Mar-23 at 15:12:24 by Bob Weiner
+;; Last-Mod:     30-Apr-23 at 16:07:52 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -33,6 +33,7 @@
 (require 'hload-path)
 ;;; This does not require any particular web browser.
 (require 'browse-url)
+(require 'eww) ;; Must load to override it's function `eww-browse-url' below.
 (require 'hbut)
 
 ;;; ************************************************************************
@@ -152,6 +153,37 @@ Return http urls unchanged.  Normalize remote paths."
               (current-buffer))
       (apply #'find-file-noselect path args))))
 
+;;;###autoload
+(defun eww-browse-url (url &optional new-window)
+  "Ask the EWW browser to load URL.
+
+Interactively, if the variable `browse-url-new-window-flag' is non-nil,
+loads the document in a new buffer tab on the window tab-line.  A non-nil
+prefix argument reverses the effect of `browse-url-new-window-flag'.
+
+If `tab-bar-mode' is enabled, then whenever a document would
+otherwise be loaded in a new buffer, it is loaded in a new tab
+in the tab-bar on an existing frame.  See more options in
+`eww-browse-url-new-window-is-tab'.
+
+Non-interactively, this uses the optional second argument NEW-WINDOW
+instead of `browse-url-new-window-flag'."
+  (when (or (eq eww-browse-url-new-window-is-tab t)
+            (and (eq eww-browse-url-new-window-is-tab 'tab-bar)
+                 tab-bar-mode))
+    (let ((tab-bar-new-tab-choice t))
+      (tab-new)))
+  (let ((hpath:display-where-alist
+        (if new-window 'other-window hpath:display-where-alist)))
+    (hpath:display-buffer
+     (generate-new-buffer
+      (format "*eww-%s*" (url-host (url-generic-parse-url
+                                    (eww--dwim-expand-url url)))))))
+  (eww-mode)
+  (let ((url-allow-non-local-files t))
+    (eww url)))
+
+
 (provide 'hsys-www)
 
 ;;; hsys-www.el ends here
diff --git a/hui-mini.el b/hui-mini.el
index fd37b89e08..9489e13aaa 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:     23-Apr-23 at 10:22:53 by Bob Weiner
+;; Last-Mod:     30-Apr-23 at 15:52:41 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
diff --git a/hui-mouse.el b/hui-mouse.el
index a4b35d3ebf..d9eb783662 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    04-Feb-89
-;; Last-Mod:     23-Apr-23 at 22:31:26 by Mats Lidell
+;; Last-Mod:     30-Apr-23 at 15:50:57 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -222,7 +222,7 @@ Its default value is `smart-scroll-down'.  To disable it, 
set it to
     ;;
     ;; Handle Emacs push buttons in buffers
     ((and (fboundp 'button-at) (button-at (point))) .
-     ((push-button nil (mouse-event-p last-command-event))
+     ((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,
@@ -2011,8 +2011,22 @@ If key is pressed:
 ;;; ************************************************************************
 
 ;; Emacs push button support
+(defun smart-push-button (&optional pos use-mouse-action)
+  "Activate an Emacs push-button, including text-property follow-link buttons.
+Button is at optional POS or at point.  USE-MOUSE-ACTION prefers
+mouse-action to action property."
+  (or 
+   ;; Handle Emacs text-property buttons which don't work with 
'button-activate'.
+   ;; Use whatever command is bound to RET within the button's keymap.
+   (call-interactively (or (lookup-key (get-text-property (point) 'keymap) 
(kbd "RET"))
+                          (lambda () (interactive) nil)))
+   ;; non-text-property push-buttons
+   (push-button nil (mouse-event-p last-command-event))))
+
 (defun smart-push-button-help (&optional pos use-mouse-action)
-  "Show help about a push button's action at optional POS or at point."
+  "Show help about a push button's action.
+Button is at optional POS or at point.  USE-MOUSE-ACTION prefers
+mouse-action to action property."
   (let* ((button (button-at (or pos (point))))
         (action (or (and use-mouse-action (button-get button 'mouse-action))
                     (button-get button 'action)))
@@ -2021,7 +2035,7 @@ If key is pressed:
         (temp-buffer-show-function))
     (if (functionp action)
        (describe-function action)
-      (with-help-window (print (format "Button's action is: '%s'" action))))))
+      (hkey-help t))))
 
 ;;; ************************************************************************
 ;;; smart-tar functions