branch: scratch/hyperbole
commit 02bf28e5cdc50e92646e78adbdcfa96b45e1dc42
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Try and avoid using `hyperb:stack-frame`
Scanning the stack frame can be useful in some unusual cases, but
should be avoided when a straightforward let-binding does the trick.
* hmouse-drv.el (hkey--within-help): New var.
(hkey-help): Bind it.
* hibtypes.el (pathname): Consult it.
(hibtypes--within-org-link-outside-org-mode): New var.
(org-link-outside-org-mode): Use it to detect recursion.
* hui-mouse.el (hyp--within-smart-org): New var.
(smart-org): Bind it.
(hkey-alist): Consult it.
(-flatten): Move declaration to where we know the function is
actually available.
---
hibtypes.el | 26 +++++++++++++++-----------
hmouse-drv.el | 7 +++++--
hui-mouse.el | 33 ++++++++++++++++++++++-----------
3 files changed, 42 insertions(+), 24 deletions(-)
diff --git a/hibtypes.el b/hibtypes.el
index b0e723261a..68cbeaddee 100644
--- a/hibtypes.el
+++ b/hibtypes.el
@@ -46,6 +46,7 @@
;;; Public variables
;;; ************************************************************************
+;; FIXME: The `mail-' prefix does not belong to Hyperbole!
(defconst mail-address-tld-regexp
(format "\\.%s\\'"
(regexp-opt
@@ -185,6 +186,7 @@ If the referenced location is found, return non-nil."
;;; ========================================================================
(defib pathname ()
+ ;; FIXME: GNU convention calls these *file* names.
"Make a valid pathname at point display the path entry.
If instead is a PATH-style variable name, .e.g. MANPATH, will prompt
@@ -254,7 +256,8 @@ display options."
(cond ((and (string-match hpath:path-variable-regexp path)
(setq path (match-string 1 path))
(hpath:is-path-variable-p path))
- (setq path (if (or assist-flag (hyperb:stack-frame
'(hkey-help)))
+ (setq path (if (or assist-flag
+ (bound-and-true-p hkey--within-help))
path
(hpath:choose-from-path-variable path "Display")))
(unless (or (null path) (string-blank-p path)
@@ -358,21 +361,22 @@ in all buffers."
;; Org links in Org mode are handled at the highest priority; see the last
;; section at the end of this file.
+(defvar hibtypes--within-org-link-outside-org-mode nil)
(defib org-link-outside-org-mode ()
"Follow an Org link in a non-Org mode buffer.
This should be a very low priority so other Hyperbole types
handle any links they recognize first."
- (with-no-warnings
- (when (and (eq hsys-org-enable-smart-keys t)
- (not (funcall hsys-org-mode-function))
- ;; Prevent infinite recursion if ever called via
org-metareturn-hook
- ;; from org-meta-return invocation.
- (not (hyperb:stack-frame '(ibtypes::debugger-source
org-meta-return))))
- (let ((start-end (hsys-org-link-at-p)))
- (when start-end
- (hsys-org-set-ibut-label start-end)
- (hact 'org-open-at-point-global))))))
+ (when (and (eq hsys-org-enable-smart-keys t)
+ (not (funcall hsys-org-mode-function))
+ ;; Prevent infinite recursion, e.g. if called via
+ ;; `org-metareturn-hook' from `org-meta-return' invocation.
+ (not hibtypes--within-org-link-outside-org-mode))
+ (let* ((hibtypes--within-org-link-outside-org-mode t)
+ (start-end (hsys-org-link-at-p)))
+ (when start-end
+ (hsys-org-set-ibut-label start-end)
+ (hact 'org-open-at-point-global)))))
;;; ========================================================================
;;; Handles internal references within an annotated bibliography, delimiters=[]
diff --git a/hmouse-drv.el b/hmouse-drv.el
index f367577583..a3d908fb4d 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -99,7 +99,7 @@ Note that this may be a buffer different than where the
release occurs.")
(defvar assist-key-help-flag nil
"When non-nil, forces display of help for next Assist Key release.")
-(defvar assist-flag nil
+(defvar assist-flag nil ;FIXME: Don't eat up others's namespace!
"Non-nil when Hyperbole's Assist Key is in use rather than the Action Key.
Never set directly. Bound as a parameter when `hkey-execute' is called
and then used as a free variable.")
@@ -922,13 +922,16 @@ predicate is found."
(setq hkey-forms (cdr hkey-forms))))
pred-value))
+(defvar hkey--within-help nil)
+
(defun hkey-help (&optional assisting)
"Display help for the Action Key command in current context.
With optional ASSISTING prefix arg non-nil, display help for the
Assist Key command. Return non-nil iff associated help
documentation is found."
(interactive "P")
- (let* ((mouse-flag (when (mouse-event-p last-command-event)
+ (let* ((hkey--within-help t)
+ (mouse-flag (when (mouse-event-p last-command-event)
(or action-key-depress-position
assist-key-depress-position)))
(mouse-drag-flag (hmouse-drag-p))
(hkey-forms (if mouse-flag hmouse-alist hkey-alist))
diff --git a/hui-mouse.el b/hui-mouse.el
index a4b35d3ebf..6b8eb13420 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -128,6 +128,9 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
;;; Public declarations
;;; ************************************************************************
+;; FIXME: What makes us think these functions will be available when we
+;; call them?
+
(declare-function todotxt-archive "ext:todotxt")
(declare-function todotxt-bury "ext:todotxt")
(declare-function todotxt-complete-toggle "ext:todotxt")
@@ -144,8 +147,6 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
(defvar magit-root-section)
(defvar magit-display-buffer-function)
-(declare-function -flatten "ext:dash")
-
(declare-function imenu--make-index-alist "imenu")
(declare-function image-dired-thumbnail-display-external "image-dired")
@@ -161,7 +162,7 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
(declare-function helm-pos-header-line-p "ext:helm")
(declare-function helm-resume "ext:helm")
(declare-function helm-window "ext:helm-lib")
-(declare-function with-helm-buffer "ext:helm-lib")
+;;(declare-function with-helm-buffer "ext:helm-lib")
(defvar helm-action-buffer)
(defvar helm-alive-p)
(defvar helm-buffer)
@@ -187,6 +188,12 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
(declare-function unix-apropos-get-man "ext:man-apropos")
+;;; ************************************************************************
+;;; Private variables
+;;; ************************************************************************
+
+(defvar hyp--within-smart-org nil)
+
;;; ************************************************************************
;;; Hyperbole context-sensitive keys dispatch table
;;; ************************************************************************
@@ -198,15 +205,15 @@ Its default value is `smart-scroll-down'. To disable it,
set it to
'(
;; Company completion mode
((and (boundp 'company-active-map)
- (memq company-active-map (current-minor-mode-maps))) .
- ((smart-company-to-definition) . (smart-company-help)))
+ (memq company-active-map (current-minor-mode-maps)))
+ . ((smart-company-to-definition) . (smart-company-help)))
;;
;; Handle any Org mode-specific contexts but give priority to Hyperbole
;; buttons prior to cycling Org headlines
- ((and (not (hyperb:stack-frame '(smart-org)))
+ ((and (not hyp--within-smart-org)
(let ((hrule:action #'actype:identity))
- (smart-org))) .
- ((smart-org) . (smart-org)))
+ (smart-org)))
+ . ((smart-org) . (smart-org)))
;;
;; Ivy minibuffer completion mode
((and (boundp 'ivy-mode) ivy-mode (minibuffer-window-active-p
(selected-window))) .
@@ -1426,7 +1433,10 @@ NO-RECURSE-FLAG non-nil prevents infinite recursions."
;; Does nothing unless the dash Emacs Lisp
;; library is available for the -flatten
function.
(and (require 'dash nil t)
- (assoc index-key (-flatten alist)))))))
+ ;; FIXME: Use Emacs-27's `flatten-tree'?
+ (progn
+ (declare-function -flatten "ext:dash")
+ (assoc index-key (-flatten alist))))))))
(when index-item
(setq index-position (when (markerp (cdr index-item))
(marker-position (cdr index-item))))
@@ -1742,8 +1752,9 @@ will invoke `org-meta-return'.
Org links may be used outside of Org mode buffers. Such links are
handled by the separate implicit button type, `org-link-outside-org-mode'."
- (when (funcall hsys-org-mode-function)
- (let (start-end)
+ (let ((hyp--within-smart-org t)
+ start-end)
+ (when (funcall hsys-org-mode-function)
(cond ((not hsys-org-enable-smart-keys)
(when (hsys-org-meta-return-shared-p)
(hact 'hsys-org-meta-return))
