[elpa] scratch/hyperbole 580e459502 04/12: Get rid of `hyperb:stack-frame`

[Stefan Monnier]

branch: scratch/hyperbole
commit 580e459502fe8f62984bef385a99c1699f005e87
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   | 68 -----------------------------------------------------------
 hypb.el       |  4 ++--
 hyperbole.el  |  2 +-
 6 files changed, 38 insertions(+), 91 deletions(-)

diff --git a/hbut.el b/hbut.el
index a5b737f6db..af6af8316a 100644
--- a/hbut.el
+++ b/hbut.el
@@ -388,19 +388,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)))
@@ -458,8 +455,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
@@ -1933,6 +1931,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)))
@@ -2268,12 +2267,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)
@@ -2450,8 +2444,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 68fd6d33ab..53de75aba8 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 91a8e42bb1..a3ddf33331 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)
@@ -1639,7 +1651,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)
@@ -1664,7 +1677,8 @@ string arguments."
   (unless (and but-loc (or (equal (buffer-name) but-loc)
                           (eq (current-buffer) but-loc)))
     (hbut:key-src-set-buffer but-loc))
-  (ibut:operate (ibut:key-to-label name-key) edit-flag))
+  (let ((hui--ignore-action-key-depress-prev-point t))
+    (ibut:operate (ibut:key-to-label name-key) edit-flag)))
 
 (defun hui:link-possible-types ()
   "Return list of possible link action types during editing of a Hyperbole 
button.
diff --git a/hversion.el b/hversion.el
index 60d3f73a06..4f97b60a8e 100644
--- a/hversion.el
+++ b/hversion.el
@@ -52,74 +52,6 @@ your specific mouse.")
 ;;; Support functions
 ;;; ************************************************************************
 
-(defun hyperb:path-being-loaded ()
-  "Return the full pathname used by the innermost `load' or `require' call.
-Removes any matches for `hyperb:automount-prefixes' before returning
-the pathname."
-  (let* ((frame (hyperb:stack-frame '(load require)))
-        (function (nth 1 frame))
-        file nosuffix)
-    (cond ((eq function 'load)
-          (setq file (nth 2 frame)
-                nosuffix (nth 5 frame)))
-         ((eq function 'require)
-          (setq file (or (nth 3 frame) (symbol-name (nth 2 frame))))))
-    (when (stringp file)
-      (setq nosuffix (or nosuffix
-                        (string-match
-                         "\\.\\(elc?\\|elc?\\.gz\\|elc?\\.Z\\)$"
-                         file))
-           file (substitute-in-file-name file)
-           file (locate-file file load-path
-                             (when (null nosuffix) '(".elc" ".el" ".el.gz" 
".el.Z"))
-                             ;; accept any existing file
-                             nil)
-           file (if (and (stringp file)
-                         (string-match hyperb:automount-prefixes file))
-                    (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 `_'."
diff --git a/hypb.el b/hypb.el
index b1050e7eda..d944bcc173 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 69305ecd66..220ff8de93 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.
   ;;