[elpa] externals/hyperbole a06d9a4a8c 33/47: Revert "Get rid of `hyperb:stack-frame`"

[ELPA Syncer]

branch: externals/hyperbole
commit a06d9a4a8c11364b6f39844d552d0c3953254f88
Author: Mats Lidell <mats.lidell@lidells.se>
Commit: Mats Lidell <mats.lidell@lidells.se>

    Revert "Get rid of `hyperb:stack-frame`"
    
    This reverts commit 5cd4136599d606afb6f616991d92400a8dea6bea.
---
 hbut.el       | 24 ++++++++++++++++--------
 hmouse-drv.el |  4 ----
 hui.el        | 23 ++++++-----------------
 hversion.el   | 41 +++++++++++++++++++++++++++++++++++++++++
 hyperbole.el  |  2 +-
 5 files changed, 64 insertions(+), 30 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/hmouse-drv.el b/hmouse-drv.el
index d425b03348..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.")
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 982e11a213..cc0c53f304 100644
--- a/hversion.el
+++ b/hversion.el
@@ -46,6 +46,47 @@ your specific mouse.")
 ;;; Support functions
 ;;; ************************************************************************
 
+;; 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 `_'."
diff --git a/hyperbole.el b/hyperbole.el
index a0feda76c4..47f03754de 100644
--- a/hyperbole.el
+++ b/hyperbole.el
@@ -113,7 +113,7 @@
     (setq features (delq 'hload-path features)
          features (delq 'hversion features)))
 
-  ;; Defines (hyperb:window-system), and hyperb:dir,
+  ;; Defines hyperb:stack-frame, (hyperb:window-system), and hyperb:dir,
   ;; which are used later in this file.
   ;; Also adds Hyperbole to the load-path if need be.
   ;;