[elpa] externals/hyperbole 5cd4136599 06/47: Get rid of `hyperb:stack-frame`

[ELPA Syncer]

branch: externals/hyperbole
commit 5cd4136599d606afb6f616991d92400a8dea6bea
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Mats Lidell <mats.lidell@lidells.se>

    Get rid of `hyperb:stack-frame`
    
    * hmouse-drv.el (hui--ignore-action-key-depress-prev-point): New var.
    * hui.el (hui:ebut-create, hui:ebut-edit, hui:ebut-edit-region)
    (hui:gbut-create, hui:gbut-edit, hui:link-create, hui:ibut-create)
    (hui:ibut-edit): Bind it.
    * hbut.el (ebut:program, ibut:program): Bind it.
    (ebut:operate, ibut:operate): Use it instead of `hyperb:stack-frame`.
    
    * hversion.el (hyperb:stack-frame): Delete function.
---
 hbut.el       | 26 +++++++++++---------------
 hmouse-drv.el |  5 +++++
 hui.el        | 24 +++++++++++++++++++-----
 hversion.el   | 41 -----------------------------------------
 hypb.el       |  4 ++--
 hyperbole.el  |  2 +-
 6 files changed, 38 insertions(+), 64 deletions(-)

diff --git a/hbut.el b/hbut.el
index 631c7f371e..5f30890b3a 100644
--- a/hbut.el
+++ b/hbut.el
@@ -385,19 +385,16 @@ button is found in the current buffer."
                    (insert new-label)
                    (setq end (point)))
                   ((and (hmouse-use-region-p)
-                        (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))
+                        (if hui--ignore-action-key-depress-prev-point
                             ;; 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.
+                          ;; FIXME: Can't `action-key-depress-prev-point'
+                          ;; be nil at this point?
                           (setq mark (marker-position (mark-marker)))
                           (setq prev-point (and action-key-depress-prev-point
                                                 (marker-position 
action-key-depress-prev-point)))
@@ -455,8 +452,9 @@ 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))
-          (actype-sym (actype:action actype)))
+    (let ((but-buf (current-buffer))
+         (hui--ignore-action-key-depress-prev-point t)
+         (actype-sym (actype:action actype)))
       (hui:buf-writable-err but-buf "ebut-create")
       (condition-case err
          (progn
@@ -1929,6 +1927,7 @@ Return symbol for button deleted or nil."
   "Delimit implicit button name spanning region START to END in current buffer.
 If button is already delimited or delimit fails, return nil, else t.
 Insert INSTANCE-FLAG after END, before ending delimiter."
+  ;; FIXME: Merge with `ebut:delimit'!
   (goto-char start)
   (when (looking-at (regexp-quote ibut:label-start))
     (forward-char (length ibut:label-start)))
@@ -2264,12 +2263,7 @@ Summary of operations based on inputs:
                    ;; No name to insert, just insert ibutton text below
                    )
                   ((and region-flag
-                        (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))
+                        (if hui--ignore-action-key-depress-prev-point
                             ;; Ignore action-key-depress-prev-point
                             (progn (setq mark (marker-position (mark-marker))
                                          start (region-beginning)
@@ -2441,8 +2435,10 @@ 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."
+  ;; FIXME: This code duplication between ibut:* and ebut:* is awful.
   (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 ee0a219eb8..9d22f9a1dd 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -43,6 +43,7 @@ that the release point was in its frame.
 
 See function `hmouse-window-at-absolute-pixel-position' for more details.")
 
+;; FIXME: `action-' and `assist-' do not belong to Hyperbole namespace!
 (defvar action-key-depressed-flag nil "t while Action Key is depressed.")
 (defvar assist-key-depressed-flag nil "t while Assist Key is depressed.")
 (defvar action-key-depress-args nil
@@ -87,6 +88,10 @@ 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 5057483577..88e6f575e5 100644
--- a/hui.el
+++ b/hui.el
@@ -289,7 +289,9 @@ 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) lbl but-buf actype)
+    (let ((default-lbl)
+          (hui--ignore-action-key-depress-prev-point t)
+          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"))
@@ -347,6 +349,9 @@ 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))
+        ;; FIXME: Seems redundant: don't both `hui:ebut-edit' and
+        ;; `hui:ebut-create' already bind this var?
+        (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))
@@ -373,6 +378,7 @@ 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))
@@ -515,7 +521,8 @@ See `hui:gibut-create' for details."
   (if ibut-flag
       (call-interactively #'hui:gibut-create)
     (hypb:assert-same-start-and-end-buffer
-      (let (actype
+      (let ((hui--ignore-action-key-depress-prev-point t)
+            actype
             but-buf
             src-dir)
        (save-excursion
@@ -581,6 +588,7 @@ 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)))
@@ -888,7 +896,9 @@ 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)
+          (hui--ignore-action-key-depress-prev-point t)
+          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"))
@@ -922,11 +932,13 @@ Signal an error when no such button is found in the 
current buffer."
                                          (ibut:label-p t) 'ibut)))))
   (unless (stringp lbl-key)
     (if (called-interactively-p 'interactive)
+       ;; FIXME: Move this error to the `interactive' spec?
        (error "(hui:ibut-edit): No named implicit button to edit")
       (error "(hui:ibut-edit): 'lbl-key' argument must be a string, not '%s'" 
lbl-key)))
 
   (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)
@@ -1620,7 +1632,8 @@ 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)))
+  (let ((label (hbut:key-to-label lbl-key))
+        (hui--ignore-action-key-depress-prev-point t))
     (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)
@@ -1643,7 +1656,8 @@ 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)))
+  (let ((name (hbut:key-to-label name-key))
+        (hui--ignore-action-key-depress-prev-point t))
     (ibut:operate (when edit-flag name))))
 
 (defun hui:link-possible-types ()
diff --git a/hversion.el b/hversion.el
index 6e11fa45de..e993e7c53b 100644
--- a/hversion.el
+++ b/hversion.el
@@ -52,47 +52,6 @@ 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/hypb.el b/hypb.el
index 45390d89be..86db3a23fa 100644
--- a/hypb.el
+++ b/hypb.el
@@ -172,8 +172,8 @@ 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))
   `(let ((debug-on-error t)
-        (start-buffer (current-buffer)))
-     (unless (buffer-live-p start-buffer)
+        (start-buffer (current-buffer))) ;FIXME: Name capture.
+     (unless (buffer-live-p start-buffer) ;FIXME: Impossible?
        (error "Start buffer, '%s', is not live" (current-buffer)))
      ;; `kill-buffer' can change current-buffer in some odd cases.
      (unwind-protect
diff --git a/hyperbole.el b/hyperbole.el
index 7286fa7dce..a9fc5f0cf3 100644
--- a/hyperbole.el
+++ b/hyperbole.el
@@ -113,7 +113,7 @@
     (setq features (delq 'hload-path features)
          features (delq 'hversion features)))
 
-  ;; Defines hyperb:stack-frame, (hyperb:window-system), and hyperb:dir,
+  ;; Defines (hyperb:window-system), and hyperb:dir,
   ;; which are used later in this file.
   ;; Also adds Hyperbole to the load-path if need be.
   ;;