branch: elpa/dirvish
commit bea294543ed8f714836e1a102a06fbda09916250
Author: Alex Lu <hellosimon1...@hotmail.com>
Commit: Alex Lu <hellosimon1...@hotmail.com>
refactor(tramp): extract tramp specifics to `dirvish-tramp.el`
---
dirvish-extras.el | 94 ++++---------------------------------------------
dirvish-tramp.el | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
dirvish.el | 6 ++--
3 files changed, 112 insertions(+), 91 deletions(-)
diff --git a/dirvish-extras.el b/dirvish-extras.el
index 4f64760c43..80375e7e66 100644
--- a/dirvish-extras.el
+++ b/dirvish-extras.el
@@ -9,10 +9,7 @@
;;; Commentary:
-;; dirvish-extras.el contains the TRAMP integration for dirvish, it is only
-;; loaded after a TRAMP connection is initiated. Besides, it provides some
-;; utilities and transient prefixes. This is an optimization to avoid having
to
-;; load functions that are rarely used during start-up.
+;; Extra utilities and transient prefixes for Dirvish.
;;
;; Commands included:
;; - `dirvish-find-file-true-path'
@@ -36,7 +33,8 @@
;;; Code:
(require 'dirvish)
-(require 'tramp)
+(declare-function tramp-file-name-user "tramp")
+(declare-function tramp-file-name-host "tramp")
(defcustom dirvish-layout-recipes
'((0 0 0.4) ; | CURRENT | preview
@@ -141,10 +139,6 @@ predicate for that infix."
(dirvish--init-session (dirvish-curr))
(revert-buffer)))])))))
-(defconst dirvish-tramp-preview-cmd
- "head -n 1000 %s 2>/dev/null || ls -Alh --group-directories-first %s
2>/dev/null")
-(defvar dirvish-tramp-hosts '())
-
(defun dirvish-ls-output-parser (entry output)
"Parse ls OUTPUT for ENTRY and store it in `dirvish--attrs-hash'."
(dolist (file (and (> (length output) 2) (cl-subseq output 2 -1)))
@@ -163,83 +157,6 @@ predicate for that infix."
:type ,(cons (if f-dirp 'dir 'file) f-truename))
dirvish--attrs-hash)))))
-(defun dirvish-noselect-tramp (fn dir flags remote)
- "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)
- (dired-buffers nil)
- (buffer (cond (ftp? (funcall fn dir short-flags))
- (saved-flags (funcall fn dir saved-flags))
- ((= (process-file "ls" 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)
- (funcall fn dir short-flags)))))
- (with-current-buffer buffer
- (dirvish-prop :tramp (tramp-dissect-file-name dir))
- buffer)))
-
-(defun dirvish-tramp--async-p (vec)
- "Return t if tramp connection VEC support async commands."
- (or (tramp-local-host-p vec) ; localhost
- ;; the connection support `direct-async-process' and no password needed
- (and (stringp (tramp-get-connection-property
- vec "first-password-request" nil))
- (tramp-get-method-parameter vec 'tramp-direct-async)
- (tramp-get-connection-property vec "direct-async-process" nil))))
-
-(defun dirvish-tramp-dir-data-proc-s (proc _exit)
- "Sentinel for `dirvish-data-for-dir''s process PROC."
- (unwind-protect
- (pcase-let* ((`(,dir ,buf ,setup) (process-get proc 'meta))
- (str (with-current-buffer (process-buffer proc)
- (substring-no-properties (buffer-string))))
- (data (split-string str "\n")))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (dirvish-ls-output-parser dir data)
- (when setup (run-hooks 'dirvish-setup-hook))
- (unless (derived-mode-p 'wdired-mode) (dirvish-update-body-h)))))
- (dirvish--kill-buffer (process-buffer proc))))
-
-(cl-defmethod dirvish-data-for-dir
- (dir buffer setup &context ((dirvish-prop :remote) string))
- "DIR BUFFER SETUP DIRVISH-PROP."
- (when (dirvish-tramp--async-p (dirvish-prop :tramp))
- (let* ((process-connection-type nil)
- (buf (dirvish--util-buffer (make-temp-name "dir-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 setup))
- (set-process-sentinel proc #'dirvish-tramp-dir-data-proc-s))))
-
-(dirvish-define-preview tramp (file _ dv)
- "Preview files with `ls' or `head' for tramp files."
- (let ((vec (dirvish-prop :tramp)))
- (if (not (dirvish-tramp--async-p vec))
- '(info . "File preview is not supported in current connection")
- (let ((process-connection-type nil)
- (localname (file-remote-p file 'localname))
- (buf (dirvish--util-buffer 'preview dv nil 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)
- (fundamental-mode)
- (insert str))))
- `(buffer . ,buf)))))
-
(defun dirvish-find-file-true-path ()
"Open truename of (maybe) symlink file under the cursor."
(interactive)
@@ -278,9 +195,10 @@ If MULTI-LINE, make every path occupy a new line."
(defun dirvish-copy-remote-path (&optional multi-line)
"Copy remote path of marked files.
-If MULTI-LINE, make every path occupy a new line."
+If MULTI-LINE, every file takes a whole line."
(interactive "P")
- (let* ((tramp (or (dirvish-prop :tramp) (user-error "Not a remote folder")))
+ (let* ((tramp (or (dirvish-prop :tramp)
+ (user-error "Not a remote folder")))
(files (cl-loop for file in (dired-get-marked-files)
for user = (tramp-file-name-user tramp)
for host = (tramp-file-name-host tramp)
diff --git a/dirvish-tramp.el b/dirvish-tramp.el
new file mode 100644
index 0000000000..3c551277d8
--- /dev/null
+++ b/dirvish-tramp.el
@@ -0,0 +1,103 @@
+;;; dirvish-tramp.el --- Dirvish tramp integration -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021-2025 Alex Lu
+;; Author : Alex Lu <https://github.com/alexluigit>
+;; Version: 2.0.53
+;; Keywords: files, convenience
+;; Homepage: https://github.com/alexluigit/dirvish
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;;; Commentary:
+
+;; Handle directory opening, file attributes retrieving and file preview on
+;; TRAMP connections within Dirvish. This library is only loaded after a
TRAMP
+;; connection is initiated, which speeds up the package loading.
+
+;;; Code:
+
+(require 'dirvish)
+(require 'tramp)
+
+(defconst dirvish-tramp-preview-cmd
+ "head -n 1000 %s 2>/dev/null || ls -Alh --group-directories-first %s
2>/dev/null")
+(defvar dirvish-tramp-hosts '())
+
+(defun dirvish-tramp-noselect (fn dir flags remote)
+ "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)
+ (dired-buffers nil)
+ (buffer (cond (ftp? (funcall fn dir short-flags))
+ (saved-flags (funcall fn dir saved-flags))
+ ((= (process-file "ls" 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)
+ (funcall fn dir short-flags)))))
+ (with-current-buffer buffer
+ (dirvish-prop :tramp (tramp-dissect-file-name dir))
+ buffer)))
+
+(defun dirvish-tramp--async-p (vec)
+ "Return t if tramp connection VEC support async commands."
+ (or (tramp-local-host-p vec) ; localhost
+ ;; the connection support `direct-async-process' and no password needed
+ (and (stringp (tramp-get-connection-property
+ vec "first-password-request" nil))
+ (tramp-get-method-parameter vec 'tramp-direct-async)
+ (tramp-get-connection-property vec "direct-async-process" nil))))
+
+(defun dirvish-tramp-dir-data-proc-s (proc _exit)
+ "Sentinel for `dirvish-data-for-dir''s process PROC."
+ (unwind-protect
+ (pcase-let* ((`(,dir ,buf ,setup) (process-get proc 'meta))
+ (str (with-current-buffer (process-buffer proc)
+ (substring-no-properties (buffer-string))))
+ (data (split-string str "\n")))
+ (when (buffer-live-p buf)
+ (with-current-buffer buf
+ (dirvish-ls-output-parser dir data)
+ (when setup (run-hooks 'dirvish-setup-hook))
+ (unless (derived-mode-p 'wdired-mode) (dirvish-update-body-h)))))
+ (dirvish--kill-buffer (process-buffer proc))))
+
+(cl-defmethod dirvish-data-for-dir
+ (dir buffer setup &context ((dirvish-prop :remote) string))
+ "DIR BUFFER SETUP DIRVISH-PROP."
+ (when (dirvish-tramp--async-p (dirvish-prop :tramp))
+ (let* ((process-connection-type nil)
+ (buf (dirvish--util-buffer (make-temp-name "dir-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 setup))
+ (set-process-sentinel proc #'dirvish-tramp-dir-data-proc-s))))
+
+(dirvish-define-preview tramp (file _ dv)
+ "Preview files with `ls' or `head' for tramp files."
+ (let ((vec (dirvish-prop :tramp)))
+ (if (not (dirvish-tramp--async-p vec))
+ '(info . "File preview is not supported in current connection")
+ (let ((process-connection-type nil)
+ (localname (file-remote-p file 'localname))
+ (buf (dirvish--util-buffer 'preview dv nil 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)
+ (fundamental-mode)
+ (insert str))))
+ `(buffer . ,buf)))))
+
+(provide 'dirvish-tramp)
+;;; dirvish-tramp.el ends here
diff --git a/dirvish.el b/dirvish.el
index f53ffc1b09..6220c8c370 100644
--- a/dirvish.el
+++ b/dirvish.el
@@ -25,7 +25,7 @@
(require 'transient)
(declare-function ansi-color-apply-on-region "ansi-color")
(declare-function dirvish-fd-find "dirvish-fd")
-(declare-function dirvish-noselect-tramp "dirvish-extras")
+(declare-function dirvish-tramp-noselect "dirvish-tramp")
;;;; User Options
@@ -698,8 +698,8 @@ buffer, it defaults to filename under the cursor when it is
nil."
(if (not remote)
(let ((dired-buffers nil)) ; disable reuse from dired
(setq buffer (apply fn (list dir-or-list flags))))
- (require 'dirvish-extras)
- (setq buffer (dirvish-noselect-tramp fn dir-or-list flags remote)))
+ (require 'dirvish-tramp)
+ (setq buffer (dirvish-tramp-noselect fn dir-or-list flags remote)))
(with-current-buffer buffer (dirvish-init-dired-buffer))
(push (cons key buffer) (dv-roots dv))
(push (cons key buffer) dired-buffers))
