[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole 65d025a: Fix many issues with explicit links
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/hyperbole 65d025a: Fix many issues with explicit links to other Hyperbole buttons |
|
Date: |
Mon, 29 Nov 2021 00:57:18 -0500 (EST) |
branch: externals/hyperbole
commit 65d025a66793de91297b636b7744d98834c4c955
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
Fix many issues with explicit links to other Hyperbole buttons
Fix butto creation via ace-window with {M-o w <window-id}
Stop smart-org from handling Hyperbole buttons so can see the doc
for the button when using hkey-help
---
ChangeLog | 39 ++++++
hact.el | 10 +-
hbdata.el | 17 +--
hbmap.el | 53 ++++----
hbut.el | 324 ++++++++++++++++++++++++++++++------------------
hpath.el | 40 ++++--
hui-mouse.el | 16 +--
hui-window.el | 3 +-
hui.el | 33 ++---
test/smart-org-tests.el | 2 +-
10 files changed, 342 insertions(+), 195 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index a9b8731..372f857 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,42 @@
+2021-11-28 Bob Weiner <rsw@gnu.org>
+
+* hbut.el (ibut:to-name): Move to the start of the name of a given implicit
+ button if one is found.
+ (ibut:at-p): Add 'name' attribute to hbut:current if point is on
+ the name of an ibut.
+ (ibut:next-occurrence, ibut:previous-occurrence): Fix bug that
+ did not find unnamed implicit buttons matching lbl-key because name
+ delimiters were added to the regexp to match.
+ (ibut:at-to-name-p): Add this to move to the start of an ibut name
+ when point is within the ibut.
+
+* hui.el (hui:link-possible-types): Fix to properly get lbl-key for link-to
+ Hyperbole button types. This resolves a problem when using drags or
+ ace-window {M-o w <window-id>} to create link buttons.
+
+* hui-window.el (hmouse-prior-active-region): Handle when hkey-value's buffer
+ has been killed.
+
+* hbut.el (hbut:funcall): Add to call an ibut manipulation function with point
+ on the ibut (may be a different src buffer than the original source).
+ (ibut:get): Use hbut:funcall which fixes not setting source buffer
+ properly, e.g. when executing link-to-gbut or any type of button with
+ indirection.
+ (ebut:to, ibut:to): Use hbut:funcall.
+
+* hact.el (action:params): Add support for closures.
+ (actype:act):
+ hbdata.el (hbdata:build): Add actype as first arg to
hpath:absolute-arguments.
+ hpath.el (hpath:absolute-arguments): Change to make arg absolute only if it
has
+ a path-like param name. Reduces false expansions.
+
+* hbmap.el (hbmap:dir-list, hbmap:dir-member, hbmap:dir-operate): Simplify
with unless
+ and when calls.
+ (hbmap:dir-add): Fix via use of backquote to pass dir-name to progn
lexically.
+
+* hui-mouse.el (smart-org): Stop handling Hyperbole buttons here and just fall
though,
+ so hkey-help shows the help for the button rather than for smart-org.
+
2021-11-27 Bob Weiner <rsw@gnu.org>
* hpath.el (hpath:prepend-ls-directory): When in a shell buffer and on a
diff --git a/hact.el b/hact.el
index a87dbfa..1a41713 100644
--- a/hact.el
+++ b/hact.el
@@ -360,9 +360,11 @@ Autoloads action function if need be to get the parameter
list."
(setq action (hypb:indirect-function action)))
(cond ((null action) nil)
((listp action)
- (if (eq (car action) 'autoload)
- (error "(action:params): Autoload not supported: %s" action)
- (car (cdr action))))
+ (cond ((eq (car action) 'closure)
+ (nth 2 action))
+ ((eq (car action) 'autoload)
+ (error "(action:params): Autoload not supported: %s" action))
+ (t (car (cdr action)))))
((hypb:emacs-byte-code-p action)
(if (fboundp 'compiled-function-arglist)
(compiled-function-arglist action)
@@ -408,7 +410,7 @@ performing ACTION."
;; and not a defun to limit any potential impact. RSW - 9/22/2017
(and (symbolp action)
(symtable:actype-p action)
- (setq args (hpath:absolute-arguments args)))
+ (setq args (hpath:absolute-arguments actype args)))
(let ((hist-elt (hhist:element)))
(run-hooks 'action-act-hook)
(prog1 (or (if (or (symbolp action) (listp action)
diff --git a/hbdata.el b/hbdata.el
index 5725911..c8854fc 100644
--- a/hbdata.el
+++ b/hbdata.el
@@ -187,17 +187,18 @@ Nil BUT-SYM means use 'hbut:current'. If successful,
return a cons of
(hattr:set b 'lbl-key (concat new-key lbl-instance))
(hattr:set b 'loc loc)
(hattr:set b 'dir dir)
- (let ((hbdata (list (hattr:get b 'lbl-key)
+ (let ((actype)
+ (hbdata (list (hattr:get b 'lbl-key)
(hattr:get b 'action)
;; Hyperbole V1 referent compatibility, always nil
in V2
(hattr:get b 'referent)
;; Save actype without class prefix.
- (let ((actype (hattr:get b 'actype)))
- (and actype (symbolp actype)
- (setq actype (symbol-name actype))
- (intern
- (substring actype (if (string-match "::"
actype)
- (match-end 0) 0)))))
+ (and (setq actype (hattr:get b 'actype))
+ (symbolp actype)
+ (setq actype (symbol-name actype))
+ (intern
+ (substring actype (if (string-match "::"
actype)
+ (match-end 0) 0))))
(let ((mail-dir (and (fboundp 'hmail:composing-dir)
(hmail:composing-dir l)))
(args (hattr:get b 'args)))
@@ -206,7 +207,7 @@ Nil BUT-SYM means use 'hbut:current'. If successful,
return a cons of
(mapcar #'hpath:substitute-var
(if mail-dir
;; Make pathname args
absolute for outgoing mail and news messages.
- (hpath:absolute-arguments
args mail-dir)
+ (hpath:absolute-arguments
actype args mail-dir)
args))))
(hattr:set b 'creator (or creator
hyperb:user-email))
(hattr:set b 'create-time (or create-time
(htz:date-sortable-gmt)))
diff --git a/hbmap.el b/hbmap.el
index 8fbe74d..d7a8ed1 100644
--- a/hbmap.el
+++ b/hbmap.el
@@ -30,25 +30,25 @@ other value when cannot read or write map.
Optional NO-SAVE disables saving of the map after an add."
(hbmap:dir-operate (lambda (dir) (not (hbmap:dir-member dir)))
dir-name
- '(progn (prin1 (list dir-name) buf) (terpri buf))
+ `(progn (prin1 (list ,dir-name) (current-buffer))
+ (terpri (current-buffer)))
no-save))
(defun hbmap:dir-list ()
"Return list of all directories in which user has written buttons."
(save-excursion
- (let ((buf (if (and (file-exists-p hbmap:dir-filename)
- (not (file-readable-p hbmap:dir-filename)))
- nil
+ (let ((buf (unless (and (file-exists-p hbmap:dir-filename)
+ (not (file-readable-p hbmap:dir-filename)))
(find-file-noselect hbmap:dir-filename)))
- (dirs))
- (if buf
- (progn (set-buffer buf)
- (goto-char (point-min))
- (condition-case ()
- (while (setq dirs (cons (car (read (current-buffer)))
- dirs)))
- (error t))
- dirs)))))
+ dirs)
+ (when buf
+ (set-buffer buf)
+ (goto-char (point-min))
+ (condition-case ()
+ (while (setq dirs (cons (car (read (current-buffer)))
+ dirs)))
+ (error t))
+ dirs))))
(defun hbmap:dir-remove (dir-name &optional no-save)
"Remove DIR-NAME from map of all dirs in which user has written buttons.
@@ -66,12 +66,13 @@ point is left in a position appropriate for insertion of a
new entry."
(let ((obuf (current-buffer))
(buf (and (file-exists-p hbmap:dir-filename)
(find-file-noselect hbmap:dir-filename)))
- (rtn))
+ rtn)
(if buf
(progn (set-buffer buf) (widen) (goto-char 1)
(if (search-forward (concat "\n(\"" dir-name "\"") nil t)
(progn (beginning-of-line) (setq rtn t))
- (goto-char 1) (or (= (forward-line 1) 0) (insert "\n")))
+ (goto-char 1)
+ (or (= (forward-line 1) 0) (insert "\n")))
(set-buffer obuf)))
rtn))
@@ -85,20 +86,20 @@ Return t if PRED evaluation is successful and nil when not,
except when
hbmap is not readable or writable, in which case return a symbol indicating
the error. Optional NO-SAVE disables saving of the map after operation."
(save-excursion
- (let ((buf (if (and (file-exists-p hbmap:dir-filename)
- (not (file-readable-p hbmap:dir-filename)))
- nil
+ (let ((buf (unless (and (file-exists-p hbmap:dir-filename)
+ (not (file-readable-p hbmap:dir-filename)))
(find-file-noselect hbmap:dir-filename))))
(if buf
(progn (set-buffer buf)
- (if (funcall pred dir-name)
- (progn
- (setq buffer-read-only nil)
- (eval form)
- (if no-save t
- (if (file-writable-p buffer-file-name)
- (progn (save-buffer) t)
- 'hbmap-not-writable)))))
+ (when (funcall pred dir-name)
+ (setq buffer-read-only nil)
+ (eval form)
+ (cond (no-save
+ t)
+ ((file-writable-p buffer-file-name)
+ (save-buffer)
+ t)
+ (t 'hbmap-not-writable))))
'hbmap-not-readable))))
;;; ************************************************************************
diff --git a/hbut.el b/hbut.el
index db9eae1..15ba0bc 100644
--- a/hbut.el
+++ b/hbut.el
@@ -521,28 +521,32 @@ enables partial matches."
(defun ebut:to (lbl-key)
"Find the nearest explicit button with LBL-KEY (a label or label key) within
the visible portion of the current buffer.
Leave point inside the button label. Return the symbol for the button, else
nil."
- ;; Handle a label given rather than a label key
- (if (string-match-p "\\s-" lbl-key)
- (setq lbl-key (ebut:label-to-key lbl-key)))
- (let ((regexp (hbut:label-regexp lbl-key t))
- pos
- found)
- (save-excursion
- ;; Since point might be in the middle of the matching button,
- ;; move to the start of line to ensure don't miss it when
- ;; searching forward.
- (forward-line 0)
- ;; re-search forward
- (while (and (not found) (re-search-forward regexp nil t))
- (setq pos (match-beginning 0)
- found (equal (ebut:label-p nil nil nil nil t) lbl-key)))
- ;; re-search backward
- (while (and (not found) (re-search-backward regexp nil t))
- (setq pos (match-beginning 0)
- found (equal (ebut:label-p nil nil nil nil t) lbl-key))))
- (when found
- (goto-char pos)
- (ebut:at-p))))
+ (unless lbl-key
+ (setq lbl-key (ebut:label-p nil nil nil nil t)))
+ (hbut:funcall (lambda (lbl-key buffer key-src)
+ ;; Handle a label given rather than a label key
+ (if (string-match-p "\\s-" lbl-key)
+ (setq lbl-key (ebut:label-to-key lbl-key)))
+ (let ((regexp (hbut:label-regexp lbl-key t))
+ pos
+ found)
+ (save-excursion
+ ;; Since point might be in the middle of the matching
button,
+ ;; move to the start of line to ensure don't miss it when
+ ;; searching forward.
+ (forward-line 0)
+ ;; re-search forward
+ (while (and (not found) (re-search-forward regexp nil t))
+ (setq pos (match-beginning 0)
+ found (equal (ebut:label-p nil nil nil nil t)
lbl-key)))
+ ;; re-search backward
+ (while (and (not found) (re-search-backward regexp nil t))
+ (setq pos (match-beginning 0)
+ found (equal (ebut:label-p nil nil nil nil t)
lbl-key))))
+ (when found
+ (goto-char pos)
+ (ebut:at-p))))
+ lbl-key))
;;; ------------------------------------------------------------------------
(defun ebut:delimit (start end instance-flag)
@@ -987,6 +991,31 @@ BUFFER defaults to the current buffer."
(when (setq but-sym (ibut:get lbl-key buffer key-src))
(ibut:delete lbl-key)))))
+(defun hbut:funcall (func &optional lbl-key buffer key-src)
+ "Move to an implicit button and return the result of calling FUNC with
optional argument values of LBL-KEY, BUFFER and KEY-SRC.
+The implicit button used is given by LBL-KEY (a label or label key)
+within BUFFER or KEY-SRC (full path to global button file). Use
+`save-excursion' around this call to prevent permanent movement of
+point when desired."
+ (when buffer
+ (if (bufferp buffer)
+ (set-buffer buffer)
+ (error "(ibut:get): Invalid buffer argument: %s" buffer)))
+ (when (null key-src)
+ (let ((loc (hattr:get 'hbut:current 'loc)))
+ (when loc
+ (set-buffer (or (get-buffer loc) (find-file-noselect loc)))))
+ (setq key-src (hbut:key-src 'full)
+ ;; `hbut:key-src' sets current buffer to key-src buffer.
+ buffer (or buffer (current-buffer))))
+ (when (stringp lbl-key)
+ (when key-src
+ (set-buffer (if (bufferp key-src)
+ key-src
+ (find-file-noselect key-src))))
+ (when (or buffer key-src)
+ (funcall func lbl-key buffer key-src))))
+
(defun hbut:get (&optional lbl-key buffer key-src)
"Return explicit or labeled implicit Hyperbole button symbol given by
LBL-KEY and BUFFER.
KEY-SRC is given when retrieving global buttons and is the full source
pathname.
@@ -1412,8 +1441,9 @@ excluding delimiters, not just one."
;; when point is at the end of a line. -- RSW, 02-16-2020
(unless (eolp)
(let* ((opoint (point))
- (name-start-end (ibut:label-p nil nil nil t t))
- (lbl-key (or (car name-start-end)
+ (name-start-end (ibut:label-p t nil nil t t))
+ (name (car name-start-end))
+ (lbl-key (or (ibut:label-to-key name)
(ibut:label-p nil "\"" "\"" nil t))))
(unwind-protect
(progn
@@ -1451,6 +1481,8 @@ excluding delimiters, not just one."
(setq types (cdr types)))
(set-marker ibpoint nil)
(when is-type
+ (when name
+ (hattr:set 'hbut:current 'name name))
(hattr:set 'hbut:current 'categ is-type)
(when lbl-key
(hattr:set 'hbut:current 'lbl-key lbl-key))
@@ -1527,30 +1559,15 @@ nil. BUFFER defaults to the current buffer.
Return nil if no matching button is found."
(hattr:clear 'hbut:current)
+ ;; Build and return button symbol with button properties
(save-excursion
- (let ((key-file) (key-dir) (but-data) (actype))
- (unless lbl-key
- (setq lbl-key (ibut:label-p nil nil nil nil t)))
- (when buffer
- (if (bufferp buffer)
- (set-buffer buffer)
- (error "(ibut:get): Invalid buffer argument: %s" buffer)))
- (when (not key-src)
- (when (not (equal lbl-key (ibut:label-p nil nil nil nil t)))
- (goto-char (point-min))
- (ibut:next-occurrence lbl-key))
- (when (setq key-src (hbut:key-src 'full))
- ;; `hbut:key-src' sets current buffer to key-src buffer.
- (setq buffer (current-buffer))))
- (when (and (stringp lbl-key) key-src)
- (when (stringp key-src)
- (setq key-dir (file-name-directory key-src)
- key-file (file-name-nondirectory key-src)))
- (set-buffer (find-file-noselect key-src))
- (goto-char (point-min))
- (ibut:next-occurrence lbl-key)
- ;; Build and return button symbol with button properties
- (ibut:at-p)))))
+ (unless lbl-key
+ (setq lbl-key (ibut:label-p nil nil nil nil t)))
+ (hbut:funcall (lambda (lbl-key buffer key-src)
+ (goto-char (point-min))
+ (ibut:next-occurrence lbl-key)
+ (ibut:at-p))
+ lbl-key buffer key-src)))
(defun ibut:is-p (object)
"Return non-nil if OBJECT is a symbol representing an implicit Hyperbole
button."
@@ -1682,7 +1699,7 @@ include delimiters when INCLUDE-DELIMS is non-nil)."
(hbut:map but-func ibut:label-start ibut:label-end regexp-match
include-delims))
(defun ibut:next-occurrence (lbl-key &optional buffer)
- "Move point to next occurrence of a labeled implicit button with LBL-KEY in
optional BUFFER.
+ "Move point to next occurrence of an implicit button with LBL-KEY in
optional BUFFER.
BUFFER defaults to current buffer. It may be a buffer name.
Return non-nil iff occurrence is found.
@@ -1692,11 +1709,12 @@ move to the first occurrence of the button."
(if (not (or (bufferp buffer) (and (stringp buffer) (get-buffer buffer))))
(error "(ibut:next-occurrence): Invalid buffer arg: %s" buffer)
(switch-to-buffer buffer)))
- (when (re-search-forward (ibut:label-regexp lbl-key) nil t)
+ (when (or (re-search-forward (ibut:label-regexp lbl-key) nil t)
+ (re-search-forward (ibut:label-regexp lbl-key t) nil t))
(goto-char (+ (match-beginning 0) (length ibut:label-start)))))
(defun ibut:previous-occurrence (lbl-key &optional buffer)
- "Move point to previous occurrence of a labeled implicit button with LBL-KEY
in optional BUFFER.
+ "Move point to previous occurrence of an implicit button with LBL-KEY in
optional BUFFER.
BUFFER defaults to current buffer. It may be a buffer name.
Return non-nil iff occurrence is found.
@@ -1706,7 +1724,8 @@ the whole buffer."
(if (not (or (bufferp buffer) (and (stringp buffer) (get-buffer buffer))))
(error "(ibut:previous-occurrence): Invalid buffer arg: %s" buffer)
(switch-to-buffer buffer)))
- (when (re-search-backward (ibut:label-regexp lbl-key) nil t)
+ (when (or (re-search-backward (ibut:label-regexp lbl-key) nil t)
+ (re-search-backward (ibut:label-regexp lbl-key t) nil t))
(goto-char (+ (match-beginning 0) (length ibut:label-start)))))
(defalias 'ibut:summarize 'hbut:report)
@@ -1715,43 +1734,103 @@ the whole buffer."
"Find the nearest implicit button with LBL-KEY (a label or label key) within
the visible portion of the current buffer.
Leave point inside the button text or its optional label, if it has one.
Return the symbol for the button, else nil."
- (when lbl-key
- ;; Handle a label given rather than a label key
- (when (string-match-p "\\s-" lbl-key)
- (setq lbl-key (ibut:label-to-key lbl-key)))
- (let ((regexp (hbut:label-regexp lbl-key t))
- (start (point))
- at-lbl-key
- ibut
- pos
- found)
- (save-excursion
- ;; Since point might be in the middle of the matching button,
- ;; move to the start of line to ensure don't miss it when
- ;; searching forward.
- (forward-line 0)
- ;; re-search forward
- (while (and (not found) (re-search-forward regexp nil t))
- (setq pos (match-beginning 0)
- ;; Point might be on closing delimiter of ibut in which
- ;; case ibut:label-p returns nil; move back one
- ;; character to prevent this.
- found (save-excursion
- (goto-char (1- (point)))
- (setq ibut (ibut:at-p)
- at-lbl-key (hattr:get ibut 'lbl-key))
- (equal at-lbl-key lbl-key))))
- (unless found
- (goto-char start))
- ;; re-search backward
- (while (and (not found) (re-search-backward regexp nil t))
- (setq pos (match-beginning 0)
- ibut (ibut:at-p)
- at-lbl-key (hattr:get ibut 'lbl-key)
- found (equal at-lbl-key lbl-key))))
- (when found
- (goto-char pos)
- ibut))))
+ (unless lbl-key
+ (setq lbl-key (ibut:label-p nil nil nil nil t)))
+ (hbut:funcall (lambda (lbl-key buffer key-src)
+ (when lbl-key
+ ;; Handle a label given rather than a label key
+ (when (string-match-p "\\s-" lbl-key)
+ (setq lbl-key (ibut:label-to-key lbl-key)))
+ (let ((regexp (hbut:label-regexp lbl-key t))
+ (start (point))
+ at-lbl-key
+ ibut
+ pos
+ found)
+ (save-excursion
+ ;; Since point might be in the middle of the matching
button,
+ ;; move to the start of line to ensure don't miss it
when
+ ;; searching forward.
+ (forward-line 0)
+ ;; re-search forward
+ (while (and (not found) (re-search-forward regexp nil
t))
+ (setq pos (match-beginning 0)
+ ;; Point might be on closing delimiter of ibut
in which
+ ;; case ibut:label-p returns nil; move back one
+ ;; character to prevent this.
+ found (save-excursion
+ (goto-char (1- (point)))
+ (setq ibut (ibut:at-p)
+ at-lbl-key (hattr:get ibut
'lbl-key))
+ (equal at-lbl-key lbl-key))))
+ (unless found
+ (goto-char start))
+ ;; re-search backward
+ (while (and (not found) (re-search-backward regexp nil
t))
+ (setq pos (match-beginning 0)
+ ibut (ibut:at-p)
+ at-lbl-key (hattr:get ibut 'lbl-key)
+ found (equal at-lbl-key lbl-key))))
+ (when found
+ (goto-char pos)
+ ibut))))
+ lbl-key))
+
+(defun ibut:at-to-name-p (&optional ibut)
+ "If point is on an implicit button, optional IBUT, move to the start of its
name, if any (past opening delimiter).
+When found, set the name and lbl-key properties of IBUT.
+Return t if name is found, else nil."
+ (let ((opoint (point))
+ move-flag
+ name
+ start)
+ (when (or (ibut:is-p ibut)
+ (setq ibut (ibut:at-p)))
+ (setq start (hattr:get ibut 'lbl-start))
+ (goto-char start)
+ (forward-line 0)
+ (while (search-forward ibut:label-start start t)
+ (setq move-flag t))
+ (if move-flag
+ (progn (setq name (ibut:label-p t nil nil nil t))
+ (when name
+ (hattr:set ibut 'name name)
+ (hattr:set ibut 'lbl-key (ibut:label-to-key name))))
+ (setq ibut nil)
+ (goto-char opoint)))
+ move-flag))
+
+(defun ibut:to-name (lbl-key)
+ "Find the nearest implicit button with LBL-KEY (a label or label key) within
the visible portion of the current buffer and move to the start of its
delimited button name (after opening delimiter).
+This will find an implicit button if point is within its name or text
+or if LBL-KEY is a name/name-key of an existing implicit button. It
+will not find other unnamed implicit buttons.
+
+Return the symbol for the button if found, else nil."
+ (unless lbl-key
+ (setq lbl-key (ibut:label-p nil nil nil nil t)))
+ (hbut:funcall
+ (lambda (lbl-key buffer key-src)
+ (let* ((name-start-end (ibut:label-p nil nil nil t t))
+ (name-start (nth 1 name-start-end))
+ (at-name (car name-start-end))
+ (at-lbl-key (ibut:label-p nil "\"" "\"" nil t))
+ (opoint (point))
+ move-flag
+ start
+ ibut)
+ (cond ((or (and at-name (equal at-name lbl-key))
+ (and lbl-key (equal at-lbl-key lbl-key)))
+ (setq ibut 'hbut:current))
+ ((and lbl-key (setq ibut (ibut:to lbl-key)))))
+ (when (not (hbut:outside-comment-p))
+ ;; Skip past any optional name and separators
+ (cond (name-start
+ (goto-char name-start)
+ (skip-chars-forward (regexp-quote ibut:label-start)))
+ ((ibut:at-to-name-p ibut))))
+ ibut))
+ lbl-key))
(defun ibut:to-text (lbl-key)
"Find the nearest implicit button with LBL-KEY (a label or label key) within
the visible portion of the current buffer and move to within its button text.
@@ -1760,38 +1839,43 @@ or if LBL-KEY is a name/name-key of an existing
implicit button. It
will not find other unnamed implicit buttons.
Return the symbol for the button if found, else nil."
- (let* ((name-start-end (ibut:label-p nil nil nil t t))
- (name-end (nth 2 name-start-end))
- (at-name (car name-start-end))
- (at-lbl-key (ibut:label-p nil "\"" "\"" nil t))
- (opoint (point))
- move-flag
- start
- ibut)
- ;; Do not move point if it is already in the text of an
- ;; implicit button matching LBL-KEY. If on the name of
- ;; the same button, move into the text of the button.
- (cond ((and lbl-key (equal at-lbl-key lbl-key))
- (setq ibut 'hbut:current))
- ((and at-name (equal at-name lbl-key))
- (setq ibut 'hbut:current
- move-flag t))
- ((and lbl-key (setq ibut (ibut:to lbl-key)))
- (setq move-flag t)))
- (when (and move-flag (not (hbut:outside-comment-p)))
- ;; Skip past any optional name and separators
- (if (setq start (hattr:get ibut 'lbl-start))
- (goto-char start)
- (when name-end
- (goto-char name-end)
- (if (looking-at ibut:label-separator-regexp)
- ;; Move past up to 2 possible characters of ibut
- ;; delimiters; this prevents recognizing labeled,
- ;; delimited ibuts of a single character since no one
- ;; should need that.
- (goto-char (min (+ 2 (match-end 0)) (point-max)))
- (goto-char opoint)))))
- ibut))
+ (unless lbl-key
+ (setq lbl-key (ibut:label-p nil nil nil nil t)))
+ (hbut:funcall
+ (lambda (lbl-key buffer key-src)
+ (let* ((name-start-end (ibut:label-p t nil nil t t))
+ (name-end (nth 2 name-start-end))
+ (at-name (car name-start-end))
+ (at-lbl-key (ibut:label-p nil "\"" "\"" nil t))
+ (opoint (point))
+ move-flag
+ start
+ ibut)
+ ;; Do not move point if it is already in the text of an
+ ;; implicit button matching LBL-KEY. If on the name of
+ ;; the same button, move into the text of the button.
+ (cond ((and lbl-key (equal at-lbl-key lbl-key))
+ (setq ibut 'hbut:current))
+ ((and at-name (equal (ibut:label-to-key at-name) lbl-key))
+ (setq ibut 'hbut:current
+ move-flag t))
+ ((and lbl-key (setq ibut (ibut:to lbl-key)))
+ (setq move-flag t)))
+ (when (and move-flag ibut (not (hbut:outside-comment-p)))
+ ;; Skip past any optional name and separators
+ (if (setq start (hattr:get ibut 'lbl-start))
+ (goto-char start)
+ (when name-end
+ (goto-char name-end)
+ (if (looking-at ibut:label-separator-regexp)
+ ;; Move past up to 2 possible characters of ibut
+ ;; delimiters to ensure are inside the ibut name; this
+ ;; prevents recognizing labeled, delimited ibuts of a
+ ;; single character since no one should need that.
+ (goto-char (min (+ 2 (match-end 0)) (point-max)))
+ (goto-char opoint)))))
+ ibut))
+ lbl-key))
;;; ------------------------------------------------------------------------
(defconst ibut:label-start "<["
diff --git a/hpath.el b/hpath.el
index 2db26d1..f8a2062 100644
--- a/hpath.el
+++ b/hpath.el
@@ -16,6 +16,7 @@
;;; Other required Elisp libraries
;;; ************************************************************************
+(require 'cl-lib)
(require 'hact)
(require 'subr-x) ;; For string-trim
(require 'hversion) ;; for (hyperb:window-system) definition
@@ -632,12 +633,28 @@ This prevents improper processing of hargs with colons in
them, e.g. `actypes::l
(let (tramp-mode)
(abbreviate-file-name path)))
-(defun hpath:absolute-arguments (args-list &optional default-dirs)
- "Return any paths in ARGS-LIST made absolute.
-Uses optional DEFAULT-DIRS or `default-directory'.
+(defun hpath:absolute-arguments (actype arg-list &optional default-dirs)
+ "Return any paths in ACTYPE's ARG-LIST made absolute.
+Uses optional DEFAULT-DIRS (a list of dirs or a single dir) or
`default-directory'.
Other arguments are returned unchanged."
- (mapcar (lambda (arg) (hpath:absolute-to arg default-dirs))
- args-list))
+ (let ((param-list (delq nil (mapcar (lambda (param)
+ (when param
+ (setq param (symbol-name param))
+ (unless (= ?& (aref param 0))
+ param)))
+ (action:params (actype:action actype))))))
+ ;; Extend param-list to length of arg-list in case of any &rest param.
+ (setq param-list
+ (nconc param-list
+ (make-list (max 0 (- (length arg-list) (length param-list)))
+ (last param-list))))
+ (cl-mapcar (lambda (param arg)
+ (if (or (string-match-p "file" param)
+ (string-match-p "dir" param)
+ (string-match-p "path" param))
+ (hpath:absolute-to arg default-dirs)
+ arg))
+ param-list arg-list)))
(defun hpath:absolute-to (path &optional default-dirs)
"Return PATH as an absolute path relative to one directory from optional
DEFAULT-DIRS or `default-directory'.
@@ -1040,7 +1057,10 @@ window in which the buffer is displayed."
(when (and filename (re-search-backward "^$\\|\\`\\|^\\(.+\\):$"
prior-prompt-pos t)
(setq dir (match-string-no-properties 1))
(file-exists-p dir))
- (concat (file-name-as-directory dir) filename))))))
+ (unless (file-name-absolute-p filename)
+ (when (file-directory-p dir)
+ (setq dir (file-name-as-directory dir)))
+ (concat (file-name-as-directory dir) filename)))))))
(defvar hpath:compressed-suffix-regexp (concat (regexp-opt '(".gz" ".Z" ".zip"
".bz2" ".xz" ".zst")) "\\'")
"Regexp of compressed file name suffixes.")
@@ -1443,8 +1463,6 @@ returned for PATH."
(not (string-match "\\`[.~/]\\'" path))
(or (not (string-match "\\sw\\|\\s_" path))
(string-match "[@#&!*]" path))))
- (when (file-directory-p path)
- (setq path (file-name-as-directory path)))
path)))
(defun hpath:push-tag-mark ()
@@ -1461,15 +1479,15 @@ Is a no-op if the function `push-tag-mark' is not
available."
;; push old position
(push-tag-mark)))))
-(defun hpath:relative-arguments (args-list)
- "Return any paths in ARGS-LIST below button source loc directory made
relative.
+(defun hpath:relative-arguments (arg-list)
+ "Return any paths in ARG-LIST below button source loc directory made
relative.
Other paths are simply expanded. Non-path arguments are returned unchanged."
(let ((loc (hattr:get 'hbut:current 'loc)))
(mapcar (lambda (arg)
(hpath:relative-to arg (if (stringp loc)
(file-name-directory loc)
(buffer-local-value 'default-directory
loc))))
- args-list)))
+ arg-list)))
(defun hpath:relative-to (path &optional default-dir)
"Return PATH relative to optional DEFAULT-DIR or `default-directory'.
diff --git a/hui-mouse.el b/hui-mouse.el
index d0b0801..aca3ef7 100644
--- a/hui-mouse.el
+++ b/hui-mouse.el
@@ -1688,12 +1688,9 @@ handled by the separate implicit button type,
`org-link-outside-org-mode'."
(hact 'org-ctrl-c-ctrl-c)
t)
((hbut:at-p)
- ;; Activate/Assist with any Hyperbole button at point
- (if (not assist-flag)
- (hact 'hbut:act)
- (hact 'hkey-help))
- ;; Ignore any further Smart Key non-Org contexts
- t)
+ ;; Fall through until Hyperbole button context and
+ ;; activate normally.
+ nil)
((hsys-org-heading-at-p)
(if (not assist-flag)
(hact 'hsys-org-cycle)
@@ -1713,10 +1710,9 @@ handled by the separate implicit button type,
`org-link-outside-org-mode'."
(hact 'hkey-help))
t)
((hbut:at-p)
- ;; Activate/Assist with any Hyperbole button at point
- (if (not assist-flag)
- (hact 'hbut:act)
- (hact 'hkey-help)))
+ ;; Fall through until Hyperbole button context and
+ ;; activate normally.
+ nil)
(t
(when (hsys-org-meta-return-shared-p)
(hact 'org-meta-return current-prefix-arg))
diff --git a/hui-window.el b/hui-window.el
index b411c77..9200b4b 100644
--- a/hui-window.el
+++ b/hui-window.el
@@ -310,7 +310,8 @@ part of InfoDock and not a part of Hyperbole)."
(defun hmouse-prior-active-region ()
"Return t iff there is a non-empty active region in buffer of the last Smart
Mouse Key release."
- (when (setq hkey-value (if assist-flag assist-key-depress-prev-point
action-key-depress-prev-point))
+ (when (and (setq hkey-value (if assist-flag assist-key-depress-prev-point
action-key-depress-prev-point))
+ (buffer-live-p (marker-buffer hkey-value)))
(save-excursion
(with-current-buffer (marker-buffer hkey-value)
;; Store and goto any prior value of point from the region
diff --git a/hui.el b/hui.el
index 23ac2a6..7eef1d9 100644
--- a/hui.el
+++ b/hui.el
@@ -735,10 +735,7 @@ See also documentation for `hui:link-possible-types'."
(interactive (hmouse-choose-windows #'hui:link))
(let ((but-window (or depress-window action-key-depress-window))
(referent-window (or release-window action-key-release-window
(selected-window)))
- but-modify link-types num-types type-and-args lbl-key but-loc but-dir)
- (select-window referent-window)
- (setq link-types (hui:link-possible-types)
- num-types (length link-types))
+ but-name but-modify but-categ link-types num-types type-and-args
lbl-key but-loc but-dir)
(select-window but-window)
(hui:buf-writable-err (current-buffer) "link-directly")
(if (ebut:at-p)
@@ -748,16 +745,18 @@ See also documentation for `hui:link-possible-types'."
lbl-key (hattr:get 'hbut:current 'lbl-key))
(setq but-loc (hui:key-src (current-buffer))
but-dir (hui:key-dir (current-buffer))
- lbl-key (hbut:label-to-key
- (hui:hbut-label
+ but-name (hui:hbut-label
(cond ((hmouse-prior-active-region)
hkey-region)
((use-region-p)
(hui:hbut-label-default
(region-beginning) (region-end))))
"link-directly"
- "Create button named: "))))
+ "Create button named: ")
+ lbl-key (hbut:label-to-key but-name)))
(select-window referent-window)
+ (setq link-types (hui:link-possible-types)
+ num-types (length link-types))
;; num-types is the number of possible link types to choose among
(cond ((= num-types 0)
@@ -1239,14 +1238,20 @@ Buffer without File link-to-buffer-tmp"
;; Elisp Buffer at Start
;; or End of Sexpression eval-elisp
- (let (val)
+ (let (val
+ hbut-sym
+ lbl-key)
(delq nil
- (list (cond ((eq (current-buffer) (get-file-buffer gbut:file))
- (list 'link-to-gbut (hbut:label-p)))
- ((ebut:at-p)
- (list 'link-to-ebut (ebut:label-p)))
- ((setq val (ibut:at-p t))
- (list 'link-to-ibut val (or buffer-file-name
(buffer-name)))))
+ (list (cond ((and (prog1 (setq hbut-sym (hbut:at-p))
+ ;; Next line forces use of any ibut name in the
link.
+ (save-excursion (ibut:at-to-name-p hbut-sym)))
+ (setq lbl-key (hattr:get hbut-sym 'lbl-key))
+ (eq (current-buffer) (get-file-buffer gbut:file)))
+ (list 'link-to-gbut lbl-key))
+ ((and hbut-sym (eq (hattr:get hbut-sym 'categ) 'explicit))
+ (list 'link-to-ebut lbl-key))
+ (hbut-sym
+ (list 'link-to-ibut lbl-key (or buffer-file-name
(buffer-name)))))
(cond ((and (require 'bookmark)
(derived-mode-p #'bookmark-bmenu-mode))
(list 'link-to-bookmark (bookmark-bmenu-bookmark))))
diff --git a/test/smart-org-tests.el b/test/smart-org-tests.el
index 339d035..585004d 100644
--- a/test/smart-org-tests.el
+++ b/test/smart-org-tests.el
@@ -60,7 +60,7 @@
(org-mode)
(insert "/tmp")
(goto-char 1)
- (hy-test-helpers:hypb-function-should-call-hpath:find 'smart-org
"/tmp"))))
+ (hy-test-helpers:hypb-function-should-call-hpath:find 'ibtypes::pathname
"/tmp"))))
;; Org Link
(ert-deftest smart-org-mode-with-smart-keys-on-org-link-activates ()
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/hyperbole 65d025a: Fix many issues with explicit links to other Hyperbole buttons,
ELPA Syncer <=