[elpa] externals/hyperbole 0872ab55c0 36/47: Merge branch 'stefan-scratch-hyperbole-20230621-without-questions-no-fixme' into rsw_stefan-scratch-hyperbole-20230621-without-questions-no-fixme

[ELPA Syncer]

branch: externals/hyperbole
commit 0872ab55c052d6812fb9785d83a9b61fa7bd09c0
Merge: d115b6d357 a06d9a4a8c
Author: Robert Weiner <rsw@gnu.org>
Commit: GitHub <noreply@github.com>

    Merge branch 'stefan-scratch-hyperbole-20230621-without-questions-no-fixme' 
into rsw_stefan-scratch-hyperbole-20230621-without-questions-no-fixme
---
 hbut.el       | 24 ++++++++++++++++--------
 hibtypes.el   |  6 ++----
 hmouse-drv.el |  9 +--------
 hui-mouse.el  | 19 +++++++------------
 hui.el        | 23 ++++++-----------------
 hversion.el   | 41 +++++++++++++++++++++++++++++++++++++++++
 6 files changed, 73 insertions(+), 49 deletions(-)

diff --git a/hbut.el b/hbut.el
index b8a1c4747f..d315e1e7f9 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:     25-Jun-23 at 10:35:23 by Mats Lidell
+;; Last-Mod:     25-Jun-23 at 16:43:45 by Mats Lidell
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -388,14 +388,19 @@ button is found in the current buffer."
                    (insert new-label)
                    (setq end (point)))
                   ((and (hmouse-use-region-p)
-                        (if hui--ignore-action-key-depress-prev-point
+                        (if (hyperb:stack-frame
+                             '(hui:ebut-create hui:ebut-edit 
hui:ebut-edit-region
+                                               hui:ebut-link-create 
hui:gbut-create
+                                                       hui:gbut-edit 
hui:link-create ebut:program
+                                               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 curr-label))
-                          ;; Utilize any action-key-depress-prev-point.
+                          ;; 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)))
@@ -453,9 +458,8 @@ the button LABEL which is automatically provided as the 
first argument.
 
 For interactive creation, use `hui:ebut-create' instead."
   (save-excursion
-    (let ((but-buf (current-buffer))
-         (hui--ignore-action-key-depress-prev-point t)
-         (actype-sym (actype:action actype)))
+     (let ((but-buf (current-buffer))
+          (actype-sym (actype:action actype)))
       (hui:buf-writable-err but-buf "ebut-create")
       (condition-case err
          (progn
@@ -2266,7 +2270,12 @@ Summary of operations based on inputs:
                    ;; No name to insert, just insert ibutton text below
                    )
                   ((and region-flag
-                        (if hui--ignore-action-key-depress-prev-point
+                        (if (hyperb:stack-frame
+                             '(hui:ebut-create hui:ebut-edit 
hui:ebut-edit-region
+                                               hui:ebut-link-create 
hui:gbut-create
+                                                       hui:gbut-edit 
hui:link-create ebut:program
+                                               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)
@@ -2440,7 +2449,6 @@ the button NAME which is automatically provided as the 
first argument.
 For interactive creation, use `hui:ibut-create' instead."
   (save-excursion
     (let ((but-buf (current-buffer))
-         (hui--ignore-action-key-depress-prev-point t)
          (actype-sym (actype:action actype)))
       (hui:buf-writable-err but-buf "ibut-create")
       (hattr:clear 'hbut:current)
diff --git a/hibtypes.el b/hibtypes.el
index 0e74e5af68..cf952779c3 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 10:09:04 by Mats Lidell
+;; Last-Mod:     25-Jun-23 at 16:36:20 by Mats Lidell
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -255,8 +255,7 @@ display options."
           (cond ((and (string-match hpath:path-variable-regexp path)
                      (setq path (match-string 1 path))
                      (hpath:is-path-variable-p path))
-                (setq path (if (or assist-flag
-                                   (bound-and-true-p hkey--within-help))
+                (setq path (if (or assist-flag (hyperb:stack-frame 
'(hkey-help)))
                                path
                              (hpath:choose-from-path-variable path "Display")))
                 (unless (or (null path) (string-blank-p path)
@@ -360,7 +359,6 @@ in all buffers."
 
 ;; Org links in Org mode are handled at the highest priority; see the last
 ;; section at the end of this file.
-(defvar hibtypes--within-org-link-outside-org-mode nil)
 
 (defib org-link-outside-org-mode ()
   "Follow an Org link in a non-Org mode buffer.
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 1498bd3b55..a3d18c2a7c 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -87,10 +87,6 @@ This is set to nil when the depress is on an inactive 
minibuffer.")
 (defvar assist-key-release-position nil
   "The last mouse screen position at which the Assist Key was released or 
nil.")
 
-(defvar hui--ignore-action-key-depress-prev-point nil
-  "Don't use `action-key-depress-prev-point'.
-Currently only affects `*but:operate'.")
-
 (defvar action-key-depress-prev-point nil
   "Marker at point prior to last Action Key depress.
 Note that this may be a buffer different than where the depress occurs.")
@@ -1018,16 +1014,13 @@ predicate is found."
        (setq hkey-forms (cdr hkey-forms))))
     pred-value))
 
-(defvar hkey--within-help nil)
-
 (defun hkey-help (&optional assisting)
   "Display help for the Action Key command in current context.
 With optional ASSISTING prefix arg non-nil, display help for the
 Assist Key command.  Return non-nil iff associated help
 documentation is found."
   (interactive "P")
-  (let* ((hkey--within-help t)
-        (mouse-flag (when (mouse-event-p last-command-event)
+  (let* ((mouse-flag (when (mouse-event-p last-command-event)
                       (or action-key-depress-position 
assist-key-depress-position)))
         (mouse-drag-flag (hmouse-drag-p))
         (hkey-forms (if mouse-flag hmouse-alist hkey-alist))
diff --git a/hui-mouse.el b/hui-mouse.el
index 42e9523d2d..cf7aad628d 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 10:10:02 by Mats Lidell
+;; Last-Mod:     25-Jun-23 at 16:36:39 by Mats Lidell
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -144,6 +144,8 @@ Its default value is `smart-scroll-down'.  To disable it, 
set it to
 (defvar magit-root-section)
 (defvar magit-display-buffer-function)
 
+(declare-function -flatten "ext:dash")
+
 (declare-function imenu--make-index-alist "imenu")
 
 (declare-function image-dired-thumbnail-display-external "image-dired")
@@ -159,7 +161,7 @@ Its default value is `smart-scroll-down'.  To disable it, 
set it to
 (declare-function helm-pos-header-line-p "ext:helm")
 (declare-function helm-resume "ext:helm")
 (declare-function helm-window "ext:helm-lib")
-;;(declare-function with-helm-buffer "ext:helm-lib")
+(declare-function with-helm-buffer "ext:helm-lib")
 (defvar helm-action-buffer)
 (defvar helm-alive-p)
 (defvar helm-buffer)
@@ -185,12 +187,6 @@ Its default value is `smart-scroll-down'.  To disable it, 
set it to
 
 (declare-function unix-apropos-get-man "ext:man-apropos")
 
-;;; ************************************************************************
-;;; Private variables
-;;; ************************************************************************
-
-(defvar hyp--within-smart-org nil)
-
 ;;; ************************************************************************
 ;;; Hyperbole context-sensitive keys dispatch table
 ;;; ************************************************************************
@@ -207,7 +203,7 @@ Its default value is `smart-scroll-down'.  To disable it, 
set it to
     ;;
     ;; Handle any Org mode-specific contexts but give priority to Hyperbole
     ;; buttons prior to cycling Org headlines
-    ((and (not hyp--within-smart-org)
+    ((and (not (hyperb:stack-frame '(smart-org)))
          (let ((hrule:action #'actype:identity))
            (smart-org)))
      . ((smart-org) . (smart-org)))
@@ -1755,9 +1751,8 @@ will invoke `org-meta-return'.
 
 Org links may be used outside of Org mode buffers.  Such links are
 handled by the separate implicit button type, `org-link-outside-org-mode'."
-  (let ((hyp--within-smart-org t)
-        start-end)
-    (when (funcall hsys-org-mode-function)
+  (when (funcall hsys-org-mode-function)
+    (let (start-end)
       (cond ((not hsys-org-enable-smart-keys)
             (when (hsys-org-meta-return-shared-p)
               (hact 'hsys-org-meta-return))
diff --git a/hui.el b/hui.el
index 93c74089ad..8c9cd222e0 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    19-Sep-91 at 21:42:03
-;; Last-Mod:     25-Jun-23 at 10:11:04 by Mats Lidell
+;; Last-Mod:     25-Jun-23 at 16:42:21 by Mats Lidell
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -289,9 +289,7 @@ For programmatic creation, use `ebut: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-lbl)
-          (hui--ignore-action-key-depress-prev-point t)
-          lbl but-buf actype)
+    (let ((default-lbl) lbl but-buf actype)
       (save-excursion
        (setq default-lbl (hui:hbut-label-default start end (not 
(called-interactively-p 'interactive)))
              lbl (hui:hbut-label default-lbl "ebut-create"))
@@ -349,7 +347,6 @@ region is within the button, the button is interactively 
edited.  Otherwise,
 a new button is created interactively with the region as the default label."
   (interactive)
   (let ((m (mark))
-        (hui--ignore-action-key-depress-prev-point t)
        (op action-key-depress-prev-point) (p (point)) (lbl-key))
     (if (and m (eq (marker-buffer m) (marker-buffer op))
             (< op m) (<= (- m op) (hbut:max-len))
@@ -376,7 +373,6 @@ Signal an error when no such button is found in the current 
buffer."
 
   (hypb:assert-same-start-and-end-buffer
     (let ((lbl (ebut:key-to-label lbl-key))
-         (hui--ignore-action-key-depress-prev-point t)
          (but-buf (current-buffer))
          actype but new-lbl)
       (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
@@ -519,8 +515,7 @@ See `hui:gibut-create' for details."
   (if ibut-flag
       (call-interactively #'hui:gibut-create)
     (hypb:assert-same-start-and-end-buffer
-      (let ((hui--ignore-action-key-depress-prev-point t)
-            actype
+      (let (actype
             but-buf
             src-dir)
        (save-excursion
@@ -586,7 +581,6 @@ modification   Signal an error when no such button is 
found."
 
   (hypb:assert-same-start-and-end-buffer
     (let ((lbl (hbut:key-to-label lbl-key))
-          (hui--ignore-action-key-depress-prev-point t)
           (interactive-flag (called-interactively-p 'interactive))
          (but-buf (find-file-noselect (gbut:file)))
          (src-dir (file-name-directory (gbut:file)))
@@ -894,9 +888,7 @@ 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)
-          (hui--ignore-action-key-depress-prev-point t)
-          name but-buf actype)
+    (let ((default-name) name but-buf actype)
       (save-excursion
        (setq default-name (hui:hbut-label-default start end (not 
(called-interactively-p 'interactive)))
              name (hui:hbut-label default-name "ibut-create"))
@@ -935,7 +927,6 @@ Signal an error when no such button is found in the current 
buffer."
 
   (hypb:assert-same-start-and-end-buffer
     (let ((lbl (ibut:key-to-label lbl-key))
-          (hui--ignore-action-key-depress-prev-point t)
           (interactive-flag (called-interactively-p 'interactive))
          (but-buf (current-buffer))
          new-lbl)
@@ -1629,8 +1620,7 @@ arguments."
   (unless (and but-loc (or (equal (buffer-name) but-loc)
                           (eq (current-buffer) but-loc)))
     (hbut:key-src-set-buffer but-loc))
-  (let ((label (hbut:key-to-label lbl-key))
-        (hui--ignore-action-key-depress-prev-point t))
+  (let ((label (hbut:key-to-label lbl-key)))
     (ebut:operate label (when edit-flag label))))
 
 (defun hui:ibut-link-create (edit-flag but-window name-key but-loc but-dir 
type-and-args)
@@ -1653,8 +1643,7 @@ arguments."
   (unless (and but-loc (or (equal (buffer-name) but-loc)
                           (eq (current-buffer) but-loc)))
     (hbut:key-src-set-buffer but-loc))
-  (let ((name (hbut:key-to-label name-key))
-        (hui--ignore-action-key-depress-prev-point t))
+  (let ((name (hbut:key-to-label name-key)))
     (ibut:operate (when edit-flag name))))
 
 (defun hui:link-possible-types ()
diff --git a/hversion.el b/hversion.el
index f38cafbf40..60d3f73a06 100644
--- a/hversion.el
+++ b/hversion.el
@@ -79,6 +79,47 @@ the pathname."
                     (substring file (1- (match-end 0)))
                   file)))))
 
+;; Called in hyperbole.el.
+(defun hyperb:stack-frame (function-list &optional debug-flag)
+  "Return the nearest Elisp stack frame that called a function from 
FUNCTION-LIST.
+Return nil if there is no match.  FUNCTION-LIST entries must be symbols.
+If FUNCTION-LIST contains \\='load, \\='autoload or \\='require, detect 
autoloads
+not visible within the Lisp level stack frames.
+
+With optional DEBUG-FLAG non-nil, if no matching frame is found, return list
+of stack frames (from innermost to outermost)."
+  (let ((count 0)
+       (frame-list)
+       (load-flag (or (memq 'load function-list)
+                      (memq 'autoload function-list)
+                      (memq 'require function-list)))
+       fsymbol
+       fbody
+       frame)
+    (or (catch 'hyperb:stack-frame
+         (while (setq frame (backtrace-frame count))
+           (when debug-flag (setq frame-list (cons frame frame-list)))
+           (setq count (1+ count)
+                 fsymbol (nth 1 frame))
+           (and (eq fsymbol 'command-execute)
+                (not (memq 'command-execute function-list))
+                ;; Use command being executed instead because it might not
+                ;; show up in the stack anywhere else, e.g. if it is an
+                ;; autoload under Emacs.
+                (setq fsymbol (nth 2 frame)))
+           (cond ((and load-flag (symbolp fsymbol)
+                       (fboundp fsymbol)
+                       (listp (setq fbody (symbol-function fsymbol)))
+                       (eq (car fbody) 'autoload))
+                  (setq frame (list (car frame) 'load
+                                    (car (cdr fbody))
+                                    nil noninteractive nil))
+                  (throw 'hyperb:stack-frame frame))
+                 ((memq fsymbol function-list)
+                  (throw 'hyperb:stack-frame frame))))
+         nil)
+       (when debug-flag (nreverse frame-list)))))
+
 (defun hyperb:window-sys-term (&optional frame)
   "Return first part of the term-type if running under a window system, else 
nil.
 Where a part in the term-type is delimited by a `-' or  an `_'."