branch: elpa/dirvish
commit bad959d7d6bd1c96dbbc5d64346b0eaa4d5041fb
Author: Alex Lu <hellosimon1...@hotmail.com>
Commit: Alex Lu <hellosimon1...@hotmail.com>
refactor: improve preview over remote hosts
- Distinguish between a local sudo connection and a real "remote" connection
- Better prompt for improperly setup remote hosts in the preview window
- Disallow peek remote files
The candidate under the cursor can belong to any remote host, which is
hard to follow
---
dirvish-tramp.el | 136 ++++++++++++++++++++++++++++++++-------------
dirvish-widgets.el | 6 +-
dirvish.el | 29 ++++++----
extensions/dirvish-fd.el | 6 +-
extensions/dirvish-peek.el | 22 +++++---
5 files changed, 133 insertions(+), 66 deletions(-)
diff --git a/dirvish-tramp.el b/dirvish-tramp.el
index a059903808..e5107a311f 100644
--- a/dirvish-tramp.el
+++ b/dirvish-tramp.el
@@ -23,30 +23,41 @@
"head -n 1000 %s 2>/dev/null || ls -Alh %s 2>/dev/null")
(defvar dirvish-tramp-hosts '())
-(defun dirvish-tramp-noselect (fn dir flags remote)
+(defun dirvish-tramp-noselect (fn dir flags remote local-dispatchers)
"Return the Dired buffer at DIR with listing FLAGS.
Save the REMOTE host to `dirvish-tramp-hosts'.
FN is the original `dired-noselect' closure."
(let* ((saved-flags (cdr (assoc remote dirvish-tramp-hosts #'equal)))
- (ftp? (tramp-ftp-file-name-p dir))
(short-flags "-Alh")
(default-directory dir)
- (buffer (cond (ftp? (funcall fn dir short-flags))
- (saved-flags (funcall fn dir saved-flags))
- ((= (process-file "ls" nil nil nil "--version") 0)
+ (vec (tramp-dissect-file-name dir))
+ (async-type (dirvish-tramp--async-p vec))
+ (gnuls "ls")
+ (buffer (cond ((eq async-type 'local) (funcall fn dir flags))
+ (saved-flags (funcall fn dir saved-flags)) ; skip
+ ((= (process-file gnuls nil nil nil "--version") 0)
(push (cons remote flags) dirvish-tramp-hosts)
(funcall fn dir flags))
- (t (push (cons remote short-flags) dirvish-tramp-hosts)
+ (t (setq gnuls nil)
+ (push (cons remote short-flags) dirvish-tramp-hosts)
(funcall fn dir short-flags)))))
(with-current-buffer buffer
- (dirvish-prop :tramp (tramp-dissect-file-name dir))
+ (dirvish-prop :gnuls gnuls)
+ (cond ((eq async-type 'local)
+ (dirvish-prop :local-sudo 1)
+ (dirvish-prop :preview-dps local-dispatchers))
+ ((eq async-type 'async)
+ (dirvish-prop :remote-async 1)
+ (dirvish-prop :preview-dps '(dirvish-tramp-dp)))
+ (t (dirvish-prop :preview-dps '(dirvish-tramp-unsupported-dp))))
+ (dirvish-prop :tramp vec)
buffer)))
(defun dirvish-tramp--async-p (vec)
"Return t if tramp connection VEC support async commands."
- (or (tramp-local-host-p vec) ; the connection is either localhost
- ;; or it's a remote host that supports `direct-async'
- (tramp-direct-async-process-p)))
+ (cond ((tramp-local-host-p vec) 'local) ; the connection is either localhost
+ ;; or it's a remote host that supports `direct-async'
+ ((tramp-direct-async-process-p) 'async)))
(defun dirvish-tramp--ls-parser (entry output)
"Parse ls OUTPUT for ENTRY and store it in `dirvish--dir-data'."
@@ -82,39 +93,88 @@ FN is the original `dired-noselect' closure."
(dirvish--kill-buffer (process-buffer proc))))
(cl-defmethod dirvish-data-for-dir
- (dir buffer inhibit-setup &context ((dirvish-prop :remote) string))
+ (dir buffer inhibit-setup &context ((dirvish-prop :local-sudo) number))
"Fetch data for DIR in BUFFER.
-It is called when DIRVISH-PROP has key `:remote' as a string, which
-means DIR is in a remote host. Run `dirvish-setup-hook' after data
+It is called when DIRVISH-PROP :local-sudo is a number, which means DIR
+is opened using `sudo-edit'. Run `dirvish-setup-hook' after data
parsing unless INHIBIT-SETUP is non-nil."
- (when (dirvish-tramp--async-p (dirvish-prop :tramp))
- (let* ((process-connection-type nil)
- (buf (get-buffer-create (make-temp-name "tramp-data-")))
- (cmd (format "ls -1lahi %s" (file-local-name dir)))
- (proc (start-file-process-shell-command (buffer-name buf) buf cmd)))
- (process-put proc 'meta (list dir buffer inhibit-setup))
- (set-process-sentinel proc #'dirvish-tramp-dir-data-proc-s))))
+ (dirvish--make-proc
+ `(prin1
+ (let ((hs (make-hash-table)))
+ (dolist (file (directory-files ,(file-local-name dir) t nil t))
+ (let* ((attrs (ignore-errors (file-attributes file)))
+ (tp (nth 0 attrs)))
+ (cond ((eq t tp) (setq tp '(dir . nil)))
+ (tp (setq tp `(,(if (file-directory-p tp) 'dir 'file) . ,tp)))
+ (t (setq tp '(file . nil))))
+ (puthash (secure-hash 'md5 file) `(:builtin ,attrs :type ,tp) hs)))
+ hs))
+ (lambda (p _)
+ (pcase-let ((`(,buf . ,inhibit-setup) (process-get p 'meta))
+ (data (with-current-buffer (process-buffer p)
+ (read (buffer-string)))))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (maphash (lambda (k v) (puthash k v dirvish--dir-data)) data)
+ (unless inhibit-setup (run-hooks 'dirvish-setup-hook))))
+ (when-let* ((win (get-buffer-window buf)) ((window-live-p win)))
+ (with-selected-window win (dirvish--update-display))))
+ (delete-process p)
+ (dirvish--kill-buffer (process-buffer p)))
+ nil 'meta (cons buffer inhibit-setup)))
+
+(cl-defmethod dirvish-data-for-dir
+ (dir buffer inhibit-setup
+ &context ((dirvish-prop :remote-async) number)
+ &context ((dirvish-prop :gnuls) string))
+ "Fetch data for DIR in BUFFER.
+It is called when DIRVISH-PROP has key `:remote-aysnc' and `:gnuls',
+which means DIR is opened over a remote host that supports
+`direct-async' and comes with valid gnuls executable. Run
+`dirvish-setup-hook' after data parsing unless INHIBIT-SETUP is non-nil."
+ (let* ((process-connection-type nil)
+ (buf (get-buffer-create (make-temp-name "tramp-data-")))
+ (cmd (format "%s -1lahi %s" (dirvish-prop :gnuls)
+ (file-local-name dir)))
+ (proc (start-file-process-shell-command (buffer-name buf) buf cmd)))
+ (process-put proc 'meta (list dir buffer inhibit-setup))
+ (set-process-sentinel proc #'dirvish-tramp-dir-data-proc-s)))
+
+(dirvish-define-preview tramp-unsupported ()
+ "Preview files with `ls' or `head' for tramp files."
+ (let ((msg "File preview is not supported in this connection.
+ 1. Please check if you have GNU ls installed over remote host.
+ 2. Adjust your `direct-async' tramp settings, for example:
+
+ ;; set `tramp-direct-async-process' locally in all ssh connections
+ (connection-local-set-profile-variables
+ 'remote-direct-async-process
+ '((tramp-direct-async-process . t)))
+ (connection-local-set-profiles
+ '(:application tramp :protocol \"ssh\")
+ 'remote-direct-async-process)
+
+ See (info \"(tramp) Improving performance of asynchronous remote
processes\") for details."))
+ `(info . ,msg)))
(dirvish-define-preview tramp (file _ dv)
"Preview files with `ls' or `head' for tramp files."
- (if (not (dirvish-tramp--async-p (dirvish-prop :tramp)))
- '(info . "File preview only supported in async connections")
- (let ((process-connection-type nil)
- (localname (file-remote-p file 'localname))
- (buf (dirvish--special-buffer 'preview dv t)) proc)
- (when-let* ((proc (get-buffer-process buf))) (delete-process proc))
- (setq proc (start-file-process-shell-command
- (buffer-name buf) buf
- (format dirvish-tramp-preview-cmd localname localname)))
- (set-process-sentinel
- proc (lambda (proc _sig)
- (when (memq (process-status proc) '(exit signal))
- (shell-command-set-point-after-cmd (process-buffer proc)))))
- (set-process-filter
- proc (lambda (proc str)
- (with-current-buffer (process-buffer proc)
- (let (buffer-read-only) (insert str)))))
- `(buffer . ,buf))))
+ (let ((process-connection-type nil)
+ (localname (file-remote-p file 'localname))
+ (buf (dirvish--special-buffer 'preview dv t)) proc)
+ (when-let* ((proc (get-buffer-process buf))) (delete-process proc))
+ (setq proc (start-file-process-shell-command
+ (buffer-name buf) buf
+ (format dirvish-tramp-preview-cmd localname localname)))
+ (set-process-sentinel
+ proc (lambda (proc _sig)
+ (when (memq (process-status proc) '(exit signal))
+ (shell-command-set-point-after-cmd (process-buffer proc)))))
+ (set-process-filter
+ proc (lambda (proc str)
+ (when-let* ((b (process-buffer proc)) ((buffer-live-p b)))
+ (with-current-buffer b (let (buffer-read-only) (insert str))))))
+ `(buffer . ,buf)))
(provide 'dirvish-tramp)
;;; dirvish-tramp.el ends here
diff --git a/dirvish-widgets.el b/dirvish-widgets.el
index cef6bf1d83..f738e61d50 100644
--- a/dirvish-widgets.el
+++ b/dirvish-widgets.el
@@ -204,7 +204,7 @@ Audio;(Audio-codec . \"\"%CodecID%\"\")(Audio-bitrate .
\"\"%BitRate/String%\"\"
(defun dirvish--file-attr-size (name attrs)
"Get file size of file NAME from ATTRS."
- (cond ((dirvish-prop :remote)
+ (cond ((and (dirvish-prop :remote) (not (dirvish-prop :local-sudo)))
(substring (format " %s%s"
(or (file-attribute-size attrs) "?")
(if (dirvish-prop :gui) " " ""))
@@ -234,7 +234,7 @@ Audio;(Audio-codec . \"\"%CodecID%\"\")(Audio-bitrate .
\"\"%BitRate/String%\"\"
(defun dirvish--file-attr-time (name attrs)
"File NAME's modified time from ATTRS."
- (if (dirvish-prop :remote)
+ (if (and (dirvish-prop :remote) (not (dirvish-prop :local-sudo)))
(format " %s " (or (file-attribute-modification-time attrs) "?"))
(format " %s " (dirvish-attribute-cache name :f-time
(format-time-string
@@ -444,7 +444,7 @@ GROUP-TITLES is a list of group titles."
"Last modification time of file."
(pcase-let ((`(,time . ,face)
(dirvish--format-file-attr 'modification-time 'time)))
- (unless (dirvish-prop :remote)
+ (unless (and (dirvish-prop :remote) (not (dirvish-prop :local-sudo)))
(setq time (format-time-string dirvish-time-format-string time)))
(propertize (format "%s" time) 'face face)))
diff --git a/dirvish.el b/dirvish.el
index b70e8a9995..ccc78506de 100644
--- a/dirvish.el
+++ b/dirvish.el
@@ -715,13 +715,14 @@ filename or a string with format of `dirvish-fd-bufname'."
(flags (or flags (dv-ls-switches dv)))
(buffer (alist-get key (dv-roots dv) nil nil #'equal))
(new-buffer-p (null buffer))
+ (dps (dv-preview-dispatchers dv))
tramp-fn dired-buffers) ; disable reuse from dired
(setf (dv-timestamp dv) (dirvish--timestamp))
(when reuse? (setf (dv-reuse dv) t))
(when new-buffer-p
(if (not remote) (setq buffer (apply fn (list dir-or-list flags)))
(setq tramp-fn (prog1 'dirvish-tramp-noselect (require 'dirvish-tramp))
- buffer (apply tramp-fn (list fn dir-or-list flags remote))))
+ buffer (apply tramp-fn (list fn dir-or-list flags remote dps))))
(with-current-buffer buffer (dirvish--setup-dired))
(push (cons key buffer) (dv-roots dv)))
(with-current-buffer buffer
@@ -736,8 +737,7 @@ filename or a string with format of `dirvish-fd-bufname'."
(dirvish-prop :gui (display-graphic-p))
(dirvish-prop :remote remote)
(dirvish-prop :root key)
- (dirvish-prop :preview-dps
- (if remote '(dirvish-tramp-dp) (dv-preview-dispatchers dv)))
+ (unless remote (dirvish-prop :preview-dps dps))
(dirvish-prop :attrs (dv-attributes dv))
(cl-loop for (k v) on dirvish--scopes by 'cddr
do (dirvish-prop k (and (functionp v) (funcall v))))
@@ -768,7 +768,7 @@ filename or a string with format of `dirvish-fd-bufname'."
(dired-move-to-filename))
(dirvish--render-attrs)
(when-let* ((filename (dired-get-filename nil t)))
- (dirvish-prop :index filename)
+ (dirvish-prop :index (file-local-name filename))
(dirvish-debounce nil
(when (dv-curr-layout dv)
(force-mode-line-update t)
@@ -890,7 +890,8 @@ filename or a string with format of `dirvish-fd-bufname'."
(setq dired-listing-switches ,dired-listing-switches)
(setq dired-omit-verbose ,(bound-and-true-p
dired-omit-verbose))
(setq dired-omit-files ,(bound-and-true-p dired-omit-files))
- (with-current-buffer (dired-noselect ,file)
+ ;; for `sudo-edit' compat
+ (with-current-buffer (dired-noselect (file-local-name ,file))
,(and dirvish-preview-dired-sync-omit
(bound-and-true-p dired-omit-mode)
`(dired-omit-mode))
@@ -994,9 +995,11 @@ When PROC finishes, fill preview buffer with process
result."
(when f-beg
(setq f-str (buffer-substring f-beg f-end)
f-wid (string-width f-str)
- f-name (concat (dired-current-directory) f-str)
+ f-name (concat (if remote (dired-current-directory)
+ (file-local-name (dired-current-directory)))
+ f-str)
f-attrs (dirvish-attribute-cache f-name :builtin
- (unless remote (file-attributes f-name)))
+ (unless remote (ignore-errors (file-attributes
f-name))))
f-type (dirvish-attribute-cache f-name :type
(let ((ch (progn (back-to-indentation) (char-after))))
(cond ; ASCII: d -> 100, l -> 108
@@ -1037,7 +1040,9 @@ When PROC finishes, fill preview buffer with process
result."
(defun dirvish--render-attrs (&optional clear)
"Render or CLEAR attributes in DV's dirvish buffer."
- (cl-loop with remote = (dirvish-prop :remote) with gui = (dirvish-prop :gui)
+ (cl-loop with remote = (and (dirvish-prop :remote)
+ (not (dirvish-prop :local-sudo)))
+ with gui = (dirvish-prop :gui)
with fns = () with height = (frame-height)
with no-hl = (dirvish--apply-hiding-p dirvish-hide-cursor)
with remain = (- (window-width) (if gui 1 2))
@@ -1301,7 +1306,8 @@ INHIBIT-SETUP is passed to `dirvish-data-for-dir'."
;; inherit from cached backend, avoid unneeded vc info in subtrees
(bk (or i-bk (unless remote? (vc-responsible-backend ,dir t)))))
(dolist (file (unless remote? (directory-files ,dir t nil t)))
- (let* ((attrs (file-attributes file)) (tp (nth 0 attrs)))
+ (let* ((attrs (ignore-errors (file-attributes file)))
+ (tp (nth 0 attrs)))
(cond ((eq t tp) (setq tp '(dir . nil)))
(tp (setq tp `(,(if (file-directory-p tp) 'dir 'file) . ,tp)))
(t (setq tp '(file . nil))))
@@ -1309,9 +1315,8 @@ INHIBIT-SETUP is passed to `dirvish-data-for-dir'."
(cons bk hs)))
(lambda (p _)
(pcase-let ((`(,buf . ,inhibit-setup) (process-get p 'meta))
- (`(,vc . ,data)
- (with-current-buffer (process-buffer p)
- (read (buffer-string)))))
+ (`(,vc . ,data) (with-current-buffer (process-buffer p)
+ (read (buffer-string)))))
(when (buffer-live-p buf)
(with-current-buffer buf
(maphash (lambda (k v) (puthash k v dirvish--dir-data)) data)
diff --git a/extensions/dirvish-fd.el b/extensions/dirvish-fd.el
index 1e05226650..4d75d30a3b 100644
--- a/extensions/dirvish-fd.el
+++ b/extensions/dirvish-fd.el
@@ -410,8 +410,7 @@ The command run is essentially:
(user-error "'fd' command requires a directory: %s" dir))
(let* ((remote (file-remote-p dir))
(fd-program (dirvish-fd--ensure-fd remote))
- (ls-program (or (and remote (dirvish-fd--find-gnu-ls remote))
- dirvish-fd-ls-program))
+ (ls-program (dirvish-fd--find-gnu-ls remote))
(dv (or (dirvish-curr)
(progn (dirvish dir) (dirvish--get-session 'type 'default))))
(fd-switches (or (dirvish-prop :fd-switches) dirvish-fd-switches ""))
@@ -435,8 +434,7 @@ The command run is essentially:
(dirvish-prop :cus-header 'dirvish-fd-header)
(dirvish-prop :remote remote)
(dirvish-prop :global-header t)
- (dirvish-prop :preview-dps
- (if remote '(dirvish-tramp-dp) (dv-preview-dispatchers dv)))
+ (dirvish-prop :preview-dps (unless remote (dv-preview-dispatchers dv)))
(dirvish-prop :attrs (dv-attributes dv))
(cl-loop for (k v) on dirvish--scopes by 'cddr
do (dirvish-prop k (and (functionp v) (funcall v))))
diff --git a/extensions/dirvish-peek.el b/extensions/dirvish-peek.el
index 3ff846200e..e3a208ebc9 100644
--- a/extensions/dirvish-peek.el
+++ b/extensions/dirvish-peek.el
@@ -52,10 +52,13 @@ all categories."
(dirvish-define-preview peek-exception (file)
"Handle exceptions when peek files."
- (when-let* (((string-prefix-p "LIB_EXCEPTION:::" file)))
- (pcase-let ((`(_ ,cand ,err) (split-string file ":::"))
- (fmt "Warning: caught exception peeking [ %s ]\n Error:
%s"))
- `(info . ,(format fmt cand err)))))
+ (cond ((string-prefix-p "LIB_EXCEPTION:::" file)
+ (pcase-let ((`(_ ,cand ,err) (split-string file ":::"))
+ (fmt "Caught exception peeking [ %s ]\n Error: %s"))
+ `(info . ,(format fmt cand err))))
+ ((string-prefix-p "FILE_REMOTE_EXCEPTION:::" file)
+ (pcase-let ((`(_ ,cand) (split-string file ":::")))
+ `(info . ,(format "Unable to peek remote file: [ %s ]" cand))))))
(defun dirvish-peek-setup-h ()
"Create dirvish minibuffer preview window.
@@ -86,10 +89,7 @@ one of categories in `dirvish-peek-categories'."
do (dirvish-prop k (and (functionp v) (funcall v))))
(dirvish-prop :dv (dv-id new-dv))
(dirvish-prop :preview-dps
- (if (file-remote-p default-directory)
- '(dirvish-peek-exception-dp dirvish-tramp-dp)
- (append '(dirvish-peek-exception-dp)
- (dv-preview-dispatchers new-dv)))))))
+ (append '(dirvish-peek-exception-dp) (dv-preview-dispatchers
new-dv))))))
(defun dirvish-peek-update-h ()
"Hook for `post-command-hook' to update peek window."
@@ -99,7 +99,11 @@ one of categories in `dirvish-peek-categories'."
((not (string= cand (dirvish-prop :peek-last)))))
(dirvish-prop :peek-last cand)
(pcase category
- ('file (setq cand (expand-file-name cand)))
+ ('file
+ (let ((fname (expand-file-name cand)))
+ (if (file-remote-p fname)
+ (setq cand (format "FILE_REMOTE_EXCEPTION:::%s" fname))
+ (setq cand fname))))
('project-file
(setq cand (expand-file-name
cand (or (dirvish--get-project-root)
