[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] scratch/hyperbole feeb90effe 1/3: Get rid of `hyperb:stack-frame`
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] scratch/hyperbole feeb90effe 1/3: Get rid of `hyperb:stack-frame` |
|
Date: |
Mon, 3 Apr 2023 17:27:27 -0400 (EDT) |
branch: scratch/hyperbole
commit feeb90effe5385ecc2ba65707f4381741eda0542
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 | 22 +++++++++++-----------
hmouse-drv.el | 5 +++++
hui.el | 21 +++++++++++++++++----
hversion.el | 41 -----------------------------------------
hypb.el | 4 ++--
hyperbole.el | 2 +-
6 files changed, 36 insertions(+), 59 deletions(-)
diff --git a/hbut.el b/hbut.el
index 7d8a3dc986..d9440b9a7f 100644
--- a/hbut.el
+++ b/hbut.el
@@ -374,17 +374,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:gbut-create
- hui:gbut-edit
hui:link-create ebut:program
- hui:ibut-create hui:ibut-edit
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)))
@@ -444,8 +443,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
@@ -1776,6 +1776,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)))
@@ -2049,10 +2050,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:gbut-create
- hui:gbut-edit
hui:link-create ebut:program
- hui:ibut-create hui:ibut-edit
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)
@@ -2161,8 +2159,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 abad7fde4f..4749fd6e01 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -42,6 +42,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
@@ -75,6 +76,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 34cfe16bcb..81e2081ba2 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"))
@@ -346,6 +348,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))
@@ -372,6 +377,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))
@@ -509,7 +515,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
@@ -575,6 +582,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)))
@@ -882,7 +890,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"))
@@ -914,11 +924,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)
@@ -1510,7 +1522,8 @@ arguments."
(hattr:set 'hbut:current 'actype (actype:elisp-symbol (car type-and-args)))
(hattr:set 'hbut:current 'args (cdr type-and-args))
(select-window but-window)
- (let ((label (ebut:key-to-label lbl-key)))
+ (let ((label (ebut:key-to-label lbl-key))
+ (hui--ignore-action-key-depress-prev-point t))
(ebut:operate label (when edit-flag label))))
(defun hui:link-possible-types ()
diff --git a/hversion.el b/hversion.el
index a1d6645172..2216e17fc5 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))
- (if 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)
- (if 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 f52b2f1eff..b17ca9063a 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.
;;