branch: elpa/hyperdrive
commit 16d7963b6a8195e081c2e23a157f73797f0697a5
Merge: 73006298c8 0809111811
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Merge branch 'wip/find-in-other-window'
---
hyperdrive-dir.el | 46 +++++++++++++++++++++++++++++-----------------
hyperdrive-history.el | 29 +++++++++++++++++++++++------
hyperdrive-lib.el | 27 +++++++++++++++------------
hyperdrive-menu.el | 12 +++++-------
hyperdrive.el | 10 +++++++---
5 files changed, 79 insertions(+), 45 deletions(-)
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 7de84da566..ac4ebfedb8 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -41,8 +41,7 @@
;;;###autoload
(cl-defun hyperdrive-dir-handler (directory-entry &key then)
"Show DIRECTORY-ENTRY.
-If THEN, call it in the directory buffer with no arguments after
-the metadata has been loaded."
+If THEN, call it in the directory buffer with no arguments."
;; NOTE: ENTRY is not necessarily "filled" yet.
;; TODO: Set a timer and say "Opening URL..." if entry doesn't load
;; in a couple of seconds (same in hyperdrive-handler-default)
@@ -98,9 +97,7 @@ the metadata has been loaded."
(or (when prev-entry
(goto-entry prev-entry
ewoc))
(goto-char prev-point)))
- (set-buffer-modified-p nil)
- (when then
- (funcall then)))
+ (set-buffer-modified-p nil))
;; TODO: Remove this and the
commented out `debug-start-time'
;; binding when we're done
experimenting.
;; (message "Elapsed: %s"
@@ -117,7 +114,8 @@ the metadata has been loaded."
:then (lambda (&rest _)
(update-footer (cl-incf num-filled) num-entries))))
(plz-run metadata-queue)
- (display-buffer (current-buffer)
hyperdrive-directory-display-buffer-action))))))
+ (when then
+ (funcall then)))))))
(defun hyperdrive-dir-column-headers (prefix)
"Return column headers as a string with PREFIX.
@@ -241,6 +239,7 @@ With point on header, returns directory entry."
:parent hyperdrive-ewoc-mode-map
:doc "Local keymap for `hyperdrive-dir-mode' buffers."
"RET" #'hyperdrive-dir-find-file
+ "o" #'hyperdrive-dir-find-file-other-window
"v" #'hyperdrive-dir-view-file
"j" #'imenu
"w" #'hyperdrive-dir-copy-url
@@ -271,16 +270,29 @@ With point on header, returns directory entry."
"Find entry at EVENT's position."
(interactive "e")
(mouse-set-point event)
- (call-interactively #'hyperdrive-dir-find-file))
+ (call-interactively #'hyperdrive-dir-find-file-other-window))
-(defun hyperdrive-dir-find-file (entry)
+(cl-defun hyperdrive-dir-find-file
+ (entry &key (display-buffer-action
hyperdrive-directory-display-buffer-action))
"Visit hyperdrive ENTRY at point.
Interactively, visit file or directory at point in
+`hyperdrive-dir' buffer. DISPLAY-BUFFER-ACTION is passed to
+`pop-to-buffer'."
+ (declare (modes hyperdrive-dir-mode))
+ (interactive (list (or (hyperdrive-dir--entry-at-point)
+ (hyperdrive-user-error "No file/directory at
point"))))
+ (hyperdrive-open entry
+ :then (lambda ()
+ (pop-to-buffer (current-buffer) display-buffer-action))))
+
+(defun hyperdrive-dir-find-file-other-window (entry)
+ "Visit hyperdrive ENTRY at point in other window.
+Interactively, visit file or directory at point in
`hyperdrive-dir' buffer."
(declare (modes hyperdrive-dir-mode))
- (interactive (list (hyperdrive-dir--entry-at-point)))
- (cl-assert entry nil "No file/directory at point")
- (hyperdrive-open entry))
+ (interactive (list (or (hyperdrive-dir--entry-at-point)
+ (hyperdrive-user-error "No file/directory at
point"))))
+ (hyperdrive-dir-find-file entry :display-buffer-action t))
(declare-function hyperdrive-view-file "hyperdrive")
(defun hyperdrive-dir-view-file (entry)
@@ -288,8 +300,8 @@ Interactively, visit file or directory at point in
Interactively, opens file or directory at point in
`hyperdrive-dir' buffer."
(declare (modes hyperdrive-dir-mode))
- (interactive (list (hyperdrive-dir--entry-at-point)))
- (cl-assert entry nil "No file/directory at point")
+ (interactive (list (or (hyperdrive-dir--entry-at-point)
+ (hyperdrive-user-error "No file/directory at
point"))))
(hyperdrive-view-file entry))
(declare-function hyperdrive-copy-url "hyperdrive")
@@ -297,16 +309,16 @@ Interactively, opens file or directory at point in
(defun hyperdrive-dir-copy-url (entry)
"Copy URL of ENTRY into the kill ring."
(declare (modes hyperdrive-dir-mode))
- (interactive (list (hyperdrive-dir--entry-at-point)))
- (cl-assert entry nil "No file/directory at point")
+ (interactive (list (or (hyperdrive-dir--entry-at-point)
+ (hyperdrive-user-error "No file/directory at
point"))))
(hyperdrive-copy-url entry))
(declare-function hyperdrive-history "hyperdrive-history")
(defun hyperdrive-dir-history (entry)
"Display version history for ENTRY at point."
- (interactive (list (hyperdrive-dir--entry-at-point)))
- (cl-assert entry nil "No file/directory at point")
+ (interactive (list (or (hyperdrive-dir--entry-at-point)
+ (hyperdrive-user-error "No file/directory at
point"))))
(hyperdrive-history entry))
(defun hyperdrive-create-directory-no-op ()
diff --git a/hyperdrive-history.el b/hyperdrive-history.el
index 262f0df5bf..130e6d8994 100644
--- a/hyperdrive-history.el
+++ b/hyperdrive-history.el
@@ -37,7 +37,7 @@
"Find entry at EVENT's position."
(interactive "e")
(mouse-set-point event)
- (call-interactively #'hyperdrive-history-find-file))
+ (call-interactively #'hyperdrive-history-find-file-other-window))
(defun hyperdrive-history-pp (thing)
"Pretty-print THING.
@@ -124,6 +124,7 @@ and ENTRY's version are nil."
:parent hyperdrive-ewoc-mode-map
:doc "Local keymap for `hyperdrive-history-mode' buffers."
"RET" #'hyperdrive-history-find-file
+ "o" #'hyperdrive-history-find-file-other-window
"v" #'hyperdrive-history-view-file
"=" #'hyperdrive-history-diff
"+" #'hyperdrive-history-fill-version-ranges
@@ -257,11 +258,13 @@ Interactively, diff range entry at point with previous
entry."
:then (lambda ()
(pop-to-buffer (current-buffer)))))
-(defun hyperdrive-history-find-file (range-entry)
+(cl-defun hyperdrive-history-find-file
+ (range-entry &key (then (lambda ()
+ (pop-to-buffer (current-buffer)
'(display-buffer-same-window)))))
"Visit hyperdrive entry in RANGE-ENTRY at point.
-When entry does not exist, does nothing and returns nil.
-When entry is not known to exist, attempts to load entry at
-RANGE-ENTRY's RANGE-END.
+Then call THEN. When entry does not exist, does nothing and
+returns nil. When entry is not known to exist, attempts to load
+entry at RANGE-ENTRY's RANGE-END.
Interactively, visit entry at point in `hyperdrive-history'
buffer."
@@ -270,7 +273,7 @@ buffer."
(pcase-exhaustive (hyperdrive-range-entry-exists-p range-entry)
('t
;; Known to exist: open it.
- (hyperdrive-open (cdr range-entry)))
+ (hyperdrive-open (cdr range-entry) :then then))
('nil
;; Known to not exist: warn user.
(hyperdrive-user-error "File does not exist!"))
@@ -278,6 +281,20 @@ buffer."
;; Not known to exist: fill version ranges:
(hyperdrive-history-fill-version-ranges range-entry))))
+(defun hyperdrive-history-find-file-other-window (range-entry)
+ "Visit hyperdrive entry in RANGE-ENTRY at point in other window.
+Then call THEN. When entry does not exist, does nothing and
+returns nil. When entry is not known to exist, attempts to load
+entry at RANGE-ENTRY's RANGE-END.
+
+Interactively, visit entry at point in `hyperdrive-history'
+buffer."
+ (declare (modes hyperdrive-history-mode))
+ (interactive (list (hyperdrive-history-range-entry-at-point)))
+ (hyperdrive-history-find-file
+ range-entry :then (lambda ()
+ (pop-to-buffer (current-buffer) t))))
+
(declare-function hyperdrive-view-file "hyperdrive")
(defun hyperdrive-history-view-file (range-entry)
"Open hyperdrive entry in RANGE-ENTRY at point in `view-mode'.
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index e2696160c9..7c6b24d4fa 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -488,7 +488,10 @@ Sends a request to the gateway for hyperdrive's latest
version."
('unknown 'unknown)))))
(declare-function hyperdrive-history "hyperdrive-history")
-(cl-defun hyperdrive-open (entry &key then recurse (createp t))
+(cl-defun hyperdrive-open
+ (entry &key recurse (createp t)
+ (then (lambda ()
+ (pop-to-buffer (current-buffer)
'(display-buffer-same-window)))))
"Open hyperdrive ENTRY.
If RECURSE, proceed up the directory hierarchy if given path is
not found. THEN is a function to pass to the handler which will
@@ -1242,11 +1245,6 @@ If then, then call THEN with no arguments. Default
handler."
buffer-read-only (or (not (hyperdrive-writablep
hyperdrive)) version))
(set-buffer-modified-p nil)
(set-visited-file-modtime (current-time))))
- ;; TODO: Option to defer showing buffer.
- ;; It seems that `pop-to-buffer' is moving point, even
- ;; though it shouldn't, so we call it here, before going
- ;; to a link target.
- (pop-to-buffer (current-buffer))
(when target
(pcase major-mode
('org-mode
@@ -1288,12 +1286,17 @@ If `hyperdrive-render-html' is non-nil, render HTML with
`shr-insert-document', then calls THEN if given. Otherwise, open
with `hyperdrive-handler-default'."
(if hyperdrive-render-html
- (progn
- (eww (hyperdrive-entry-url entry))
- ;; Set `hyperdrive-current-entry' and use `hyperdrive-mode'
- ;; for remapped keybindings for, e.g., `hyperdrive-up'.
- (setq-local hyperdrive-current-entry entry)
- (hyperdrive-mode)
+ (let (buffer)
+ (save-window-excursion
+ ;; Override EWW's calling `pop-to-buffer-same-window'; we
+ ;; want our callback to display the buffer.
+ (eww (hyperdrive-entry-url entry))
+ ;; Set `hyperdrive-current-entry' and use `hyperdrive-mode'
+ ;; for remapped keybindings for, e.g., `hyperdrive-up'.
+ (setq-local hyperdrive-current-entry entry)
+ (hyperdrive-mode)
+ (setq buffer (current-buffer)))
+ (set-buffer buffer)
(when then
(funcall then)))
(hyperdrive-handler-default entry :then then)))
diff --git a/hyperdrive-menu.el b/hyperdrive-menu.el
index d148523f64..70fc26c170 100644
--- a/hyperdrive-menu.el
+++ b/hyperdrive-menu.el
@@ -125,14 +125,12 @@
(propertize (hyperdrive--format-path (hyperdrive-entry-path
entry))
'face 'transient-value))))
("g" "Refresh" revert-buffer)
- ("^" "Up to parent" (lambda ()
- (interactive)
- (hyperdrive-up (oref transient-current-prefix scope)
- :then (lambda ()
- (call-interactively
#'hyperdrive-menu))))
+ ("^" "Up to parent"
+ (lambda ()
+ (interactive)
+ (hyperdrive-up (oref transient-current-prefix scope)))
:inapt-if-not (lambda ()
- (hyperdrive-parent (oref transient--prefix scope)))
- :transient t)
+ (hyperdrive-parent (oref transient--prefix scope))))
("s" "Sort" hyperdrive-dir-sort
:if (lambda ()
(eq major-mode 'hyperdrive-dir-mode))
diff --git a/hyperdrive.el b/hyperdrive.el
index aae4740529..135e2c068a 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -525,7 +525,7 @@ hyperdrive directory listing or a `hyperdrive-mode' file
buffer."
(kill-new url)
(hyperdrive-message "%s" url)))
-(cl-defun hyperdrive-up (entry &key then)
+(cl-defun hyperdrive-up (entry &key (then nil then-set-p))
"Go up to parent directory of ENTRY.
Interactively, use the `hyperdrive-current-entry'. If THEN, pass
it to `hyperdrive-open'."
@@ -536,7 +536,10 @@ it to `hyperdrive-open'."
(list hyperdrive-current-entry)))
(if-let ((parent (hyperdrive-parent entry)))
;; TODO: Go to entry in parent directory.
- (hyperdrive-open parent :then then)
+ (if then-set-p
+ (hyperdrive-open parent :then then)
+ ;; Allow default callback to be used.
+ (hyperdrive-open parent))
(hyperdrive-user-error "At root directory")))
(defvar-keymap hyperdrive-up-map
@@ -603,7 +606,8 @@ Works in `hyperdrive-mode' and `hyperdrive-dir-mode'
buffers."
;; name could change in the future, and that would make
;; the record invalid, which would cause
;; `bookmark-default-handler' to signal an error.
- (append bookmark `((buffer . ,(current-buffer))))))))
+ (append bookmark `((buffer . ,(current-buffer)))))
+ (pop-to-buffer (current-buffer) '(display-buffer-same-window)))))
(put 'hyperdrive-bookmark-handler 'bookmark-handler-type "hyperdrive")
(defun hyperdrive-bookmark-jump (bookmark)
