[elpa] scratch/hyperbole d1a27a6853 05/15: Get rid of `hyperb:stack-frame`

[Stefan Monnier]

branch: scratch/hyperbole
commit d1a27a68536799c90d7bb9525c5cbbd726f9955f
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    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 8a5b031198..89dca85bb6 100644
--- a/hbut.el
+++ b/hbut.el
@@ -373,19 +373,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)))
@@ -443,8 +440,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
@@ -1797,6 +1795,7 @@ Return symbol for button deleted or nil."
   "Delimit implicit button label 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)))
@@ -2071,12 +2070,7 @@ 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)
@@ -2207,8 +2201,10 @@ function, followed by a list of arguments for the 
actype, aside from
 the button LABEL 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")
       (condition-case err
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 167c28f666..3c5d3888ee 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 9c815bb79a..10415292c7 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-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 "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)
@@ -1606,7 +1618,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 lbl-key but-loc but-dir 
type-and-args)
@@ -1629,7 +1642,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))
     (ibut:operate label (when edit-flag label))))
 
 (defun hui:link-possible-types ()
diff --git a/hversion.el b/hversion.el
index 9803c9cdbe..500ab853be 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 cc28eeaa2a..ac80465f59 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.
   ;;