summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorcashmere <cashmere@autistici.org>2026-08-18 21:05:13 +0200
committercashmere <cashmere@autistici.org>2026-08-18 21:05:13 +0200
commite43e4560ee21b29e0e667ac6770d28a1f8d82e06 (patch)
treef384948bca20810178d20b5437e1e026db4c8ef8 /lisp
parent14c2392b23c31558e90699a354e8145b7da4deeb (diff)
downloademacs-e43e4560ee21b29e0e667ac6770d28a1f8d82e06.tar.gz
md: 2026-08-18T21:05:19+02:00
Diffstat (limited to 'lisp')
-rw-r--r--lisp/rsync-ui.el729
1 files changed, 729 insertions, 0 deletions
diff --git a/lisp/rsync-ui.el b/lisp/rsync-ui.el
new file mode 100644
index 0000000..3282178
--- /dev/null
+++ b/lisp/rsync-ui.el
@@ -0,0 +1,729 @@
+;;; rsync-ui.el --- Clear rsync transfers with VUI -*- lexical-binding: t; -*-
+
+(require 'cl-lib)
+(require 'seq)
+(require 'subr-x)
+(require 'vui)
+(require 'vui-components)
+
+(declare-function dired-get-marked-files "dired")
+(declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings))
+(declare-function evil-set-initial-state "evil-core" (mode state))
+
+(defgroup rsync-ui nil
+ "Rsync transfers."
+ :group 'tools)
+
+(defcustom rsync-ui-program "rsync"
+ "Rsync executable."
+ :type 'string
+ :group 'rsync-ui)
+
+(defcustom rsync-ui-buffer-name "*rsync*"
+ "Transfer buffer."
+ :type 'string
+ :group 'rsync-ui)
+
+
+(defface rsync-ui-strong
+ '((t :inherit bold))
+ "Structural text."
+ :group 'rsync-ui)
+
+(defface rsync-ui-faded
+ '((t :inherit shadow))
+ "Secondary text."
+ :group 'rsync-ui)
+
+(defvar-local rsync-ui--actions nil)
+(defvar-local rsync-ui--process nil)
+
+(defun rsync-ui--remote-p (kind)
+ (equal kind "ssh"))
+
+(defun rsync-ui--source-arguments (sources mode)
+ (let ((paths (mapcar (lambda (path)
+ (expand-file-name path))
+ sources)))
+ (if (and (= (length paths) 1)
+ (file-directory-p (car paths))
+ (equal mode "contents"))
+ (list (file-name-as-directory (car paths)))
+ (mapcar #'directory-file-name paths))))
+
+(defun rsync-ui--target-argument (kind local-target ssh-host ssh-path)
+ (if (rsync-ui--remote-p kind)
+ (format "%s:%s" ssh-host (file-name-as-directory ssh-path))
+ (file-name-as-directory (expand-file-name local-target))))
+
+(defun rsync-ui--valid-host-p (host)
+ (and (not (string-empty-p host))
+ (string-match-p "\\`[-[:alnum:]_.@%]+\\'" host)))
+
+(defun rsync-ui--validate (sources kind local-target ssh-host ssh-path ssh-port)
+ (cond
+ ((null sources) "Choose at least one source.")
+ ((seq-some (lambda (path) (not (file-exists-p path))) sources)
+ "A source no longer exists.")
+ ((and (not (rsync-ui--remote-p kind)) (string-empty-p local-target))
+ "Choose a destination folder.")
+ ((and (rsync-ui--remote-p kind) (not (rsync-ui--valid-host-p ssh-host)))
+ "Enter an SSH host such as user@example.org.")
+ ((and (rsync-ui--remote-p kind) (string-empty-p ssh-path))
+ "Enter the folder on the SSH host.")
+ ((and (rsync-ui--remote-p kind)
+ (not (string-match-p "\\`[0-9]+\\'" ssh-port)))
+ "The SSH port must be a number.")
+ ((and (rsync-ui--remote-p kind)
+ (not (<= 1 (string-to-number ssh-port) 65535)))
+ "The SSH port must be between 1 and 65535.")
+ (nil nil)))
+
+(defun rsync-ui--arguments (sources kind local-target ssh-host ssh-path ssh-port remote-rsync mode compress delete preview)
+ (let ((arguments (list "-a" "--human-readable" "--protect-args" "--stats"
+ "--out-format=%i|%n%L")))
+ (if preview
+ (setq arguments (append arguments (list "--dry-run" "--itemize-changes")))
+ (setq arguments (append arguments (list "--info=progress2"))))
+ (when (and compress (rsync-ui--remote-p kind))
+ (setq arguments (append arguments (list "--compress"))))
+ (when delete
+ (setq arguments (append arguments (list "--delete"))))
+ (when (and (rsync-ui--remote-p kind) (not (equal ssh-port "22")))
+ (setq arguments
+ (append arguments (list "--rsh" (format "ssh -p %d" (string-to-number ssh-port))))))
+ (when (and (rsync-ui--remote-p kind)
+ remote-rsync
+ (not (equal remote-rsync "rsync")))
+ (setq arguments
+ (append arguments (list (concat "--rsync-path=" remote-rsync)))))
+ (append arguments
+ (rsync-ui--source-arguments sources mode)
+ (list (rsync-ui--target-argument kind local-target ssh-host ssh-path)))))
+
+(defun rsync-ui--format-bytes (text)
+ (if (string-match "\\([0-9.,]+\\)\\([KMGTPE]?\\)\\(?:B\\|[[:space:]]+bytes\\)" text)
+ (concat (match-string 1 text)
+ (if (string-empty-p (match-string 2 text))
+ " B"
+ (concat (match-string 2 text) "B")))
+ "0 B"))
+
+(defun rsync-ui--preview-summary (output)
+ (let* ((lines (split-string output "\n" t))
+ (changes (seq-filter (lambda (line)
+ (string-match-p "\\`[^|[:space:]]+|" line))
+ lines))
+ (size-line (seq-find (lambda (line)
+ (string-prefix-p "Total transferred file size:" line))
+ lines))
+ (size (if size-line (rsync-ui--format-bytes size-line) "0 B")))
+ (list :count (length changes)
+ :size size
+ :sample (seq-take changes 6))))
+
+(defun rsync-ui--progress-data (chunk)
+ (let ((start 0)
+ result)
+ (while (string-match
+ "\\([0-9.,]+[KMGTPE]?\\)[[:space:]]+\\([0-9]+\\)%[[:space:]]+\\([^[:space:]]+\\)[[:space:]]+\\([0-9:]+\\)"
+ chunk start)
+ (setq result (list :bytes (save-match-data
+ (rsync-ui--format-bytes
+ (concat (match-string 1 chunk) " bytes")))
+ :percent (string-to-number (match-string 2 chunk))
+ :speed (match-string 3 chunk)
+ :eta (match-string 4 chunk))
+ start (match-end 0)))
+ result))
+
+(defun rsync-ui--process-error (kind ssh-host output)
+ (let ((message (string-trim output)))
+ (cond
+ ((and (rsync-ui--remote-p kind)
+ (string-match-p "\\brsync: \\(?:command \\)?not found\\b" message))
+ (format "Rsync is not installed on %s. Install rsync on the SSH server, then preview again."
+ ssh-host))
+ ((and (rsync-ui--remote-p kind)
+ (string-match-p "Permission denied" message))
+ (format "SSH authentication failed for %s. Check your SSH key or agent." ssh-host))
+ ((and (rsync-ui--remote-p kind)
+ (string-match-p "Connection refused" message))
+ (format "SSH connection to %s was refused. Check the host and SSH port." ssh-host))
+ ((string-empty-p message)
+ "Rsync failed without an error message.")
+ (t message))))
+
+(defun rsync-ui--start-process (arguments on-output on-done)
+ (let* ((stderr-buffer (generate-new-buffer " *rsync-ui-stderr*"))
+ (output "")
+ (parse-tail "")
+ (process-environment (cons "LC_ALL=C" process-environment))
+ (process
+ (make-process
+ :name "rsync-ui"
+ :command (cons rsync-ui-program arguments)
+ :connection-type 'pipe
+ :noquery t
+ :stderr stderr-buffer
+ :filter (lambda (_process chunk)
+ (setq output (concat output chunk)
+ parse-tail (concat parse-tail chunk))
+ (funcall on-output parse-tail)
+ (when (> (length parse-tail) 512)
+ (setq parse-tail (substring parse-tail -512))))
+ :sentinel (lambda (finished _event)
+ (unless (process-live-p finished)
+ (let ((stderr (when (buffer-live-p stderr-buffer)
+ (with-current-buffer stderr-buffer
+ (buffer-string)))))
+ (when (buffer-live-p stderr-buffer)
+ (kill-buffer stderr-buffer))
+ (funcall on-done (process-exit-status finished)
+ (concat output stderr))))))))
+ process))
+
+(defun rsync-ui--find-remote-rsync (host port callback)
+ (let* ((buffer (generate-new-buffer " *rsync-ui-ssh-check*"))
+ (script (concat
+ "command -v rsync 2>/dev/null || "
+ "for path in /run/current-system/sw/bin/rsync "
+ "/nix/var/nix/profiles/default/bin/rsync "
+ "/usr/local/bin/rsync; do "
+ "if [ -x \"$path\" ]; then printf '%s\\n' \"$path\"; exit 0; fi; "
+ "done; exit 127"))
+ (process-environment (cons "LC_ALL=C" process-environment))
+ (process
+ (make-process
+ :name "rsync-ui-ssh-check"
+ :command (list "ssh" "-o" "BatchMode=yes" "-p" port host script)
+ :buffer buffer
+ :stderr buffer
+ :connection-type 'pipe
+ :noquery t
+ :sentinel
+ (lambda (finished _event)
+ (unless (process-live-p finished)
+ (let* ((output (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (string-trim (buffer-string)))))
+ (path (and (zerop (process-exit-status finished))
+ (car (split-string output "\n" t)))))
+ (when (buffer-live-p buffer)
+ (kill-buffer buffer))
+ (funcall callback path output)))))))
+ process))
+
+(defun rsync-ui--source-title (sources)
+ (cond
+ ((null sources) "No source selected")
+ ((= (length sources) 1) (abbreviate-file-name (car sources)))
+ (t (format "%d selected items" (length sources)))))
+
+(defun rsync-ui--destination-title (kind local-target ssh-host ssh-path)
+ (if (rsync-ui--remote-p kind)
+ (if (and (not (string-empty-p ssh-host)) (not (string-empty-p ssh-path)))
+ (format "%s:%s" ssh-host ssh-path)
+ "SSH destination incomplete")
+ (if (string-empty-p local-target)
+ "No destination selected"
+ (abbreviate-file-name local-target))))
+
+(defun rsync-ui--step-strip (stage)
+ (let ((position (pcase stage
+ ('setup 1)
+ ((or 'previewing 'ready) 2)
+ (_ 3))))
+ (vui-flex
+ :width 'fill-column
+ :justify :space-between
+ (vui-text (if (> position 1) "✓ 1 ROUTE" "● 1 ROUTE")
+ :face (if (= position 1) 'rsync-ui-strong 'success))
+ (vui-text (cond
+ ((> position 2) "✓ 2 PREVIEW")
+ ((= position 2) "● 2 PREVIEW")
+ (t "○ 2 PREVIEW"))
+ :face (cond ((> position 2) 'success)
+ ((= position 2) 'rsync-ui-strong)
+ (t 'rsync-ui-faded)))
+ (vui-text (if (= position 3) "● 3 TRANSFER" "○ 3 TRANSFER")
+ :face (if (= position 3) 'rsync-ui-strong 'rsync-ui-faded)))))
+
+(defun rsync-ui--window-width ()
+ (if-let* ((window (get-buffer-window (current-buffer) t)))
+ (window-body-width window)
+ (window-width)))
+
+(defun rsync-ui--route (sources kind local-target ssh-host ssh-path)
+ (let* ((width (max 24 (- (rsync-ui--window-width) 2)))
+ (remote (rsync-ui--remote-p kind))
+ (destination-label (if remote "SSH DESTINATION" "LOCAL DESTINATION"))
+ (destination-glyph (if remote "⌁" "◎"))
+ (destination-face (if remote 'warning 'success)))
+ (if (>= width 72)
+ (let* ((card-width (min 30 (/ (- width 8) 2)))
+ (text-width (- card-width 2))
+ (source (truncate-string-to-width
+ (rsync-ui--source-title sources) text-width nil nil "…"))
+ (destination (truncate-string-to-width
+ (rsync-ui--destination-title kind local-target ssh-host ssh-path)
+ text-width nil nil "…")))
+ (vui-vstack
+ :spacing 0
+ (vui-hstack
+ :spacing 2
+ (vui-box (vui-text "●" :face '(:inherit link :height 1.5 :weight bold))
+ :width card-width :align :center)
+ (vui-box (vui-text "") :width 4)
+ (vui-box (vui-text destination-glyph
+ :face `(:inherit ,destination-face :height 1.5 :weight bold))
+ :width card-width :align :center))
+ (vui-hstack
+ :spacing 2
+ (vui-box (vui-text "SOURCE" :face 'rsync-ui-faded)
+ :width card-width :align :center)
+ (vui-box (vui-text "") :width 4)
+ (vui-box (vui-text destination-label :face 'rsync-ui-faded)
+ :width card-width :align :center))
+ (vui-hstack
+ :spacing 2
+ (vui-box (vui-text source :face 'rsync-ui-strong)
+ :width card-width :align :center)
+ (vui-box (vui-text "→" :face 'shadow) :width 4 :align :center)
+ (vui-box (vui-text destination :face 'rsync-ui-strong)
+ :width card-width :align :center))))
+ (let* ((card-width (min 56 width))
+ (text-width (- card-width 2))
+ (source (truncate-string-to-width
+ (rsync-ui--source-title sources) text-width nil nil "…"))
+ (destination (truncate-string-to-width
+ (rsync-ui--destination-title kind local-target ssh-host ssh-path)
+ text-width nil nil "…")))
+ (vui-vstack
+ :spacing 0
+ (vui-hstack
+ (vui-text "● " :face 'link)
+ (vui-text "SOURCE" :face 'rsync-ui-faded))
+ (vui-box (vui-text source :face 'rsync-ui-strong)
+ :width card-width :align :left :padding-left 2)
+ (vui-box (vui-text "↓" :face 'shadow) :width card-width :align :center)
+ (vui-hstack
+ (vui-text (concat destination-glyph " ") :face destination-face)
+ (vui-text destination-label :face 'rsync-ui-faded))
+ (vui-box (vui-text destination :face 'rsync-ui-strong)
+ :width card-width :align :left :padding-left 2))))))
+
+(defun rsync-ui--field-row (label field)
+ (vui-hstack
+ (vui-box (vui-text label :face 'rsync-ui-faded) :width 16 :align :right)
+ field))
+
+(defun rsync-ui--gauge (progress)
+ (let* ((width 44)
+ (done (max 0 (min width (round (* width (/ progress 100.0)))))))
+ (vui-vstack
+ :spacing 0
+ (vui-box
+ (vui-hstack
+ :spacing 0
+ (vui-text (make-string done ?█) :face 'success)
+ (vui-text (make-string (- width done) ?░) :face 'shadow))
+ :width 52 :align :center)
+ (vui-box (vui-text (format "%3d%%" progress)
+ :face '(:inherit bold :height 1.6))
+ :width 52 :align :center))))
+
+(defun rsync-ui--preview-panel (preview delete)
+ (let ((count (plist-get preview :count))
+ (size (plist-get preview :size)))
+ (vui-vstack
+ :spacing 1
+ (vui-box
+ (vui-text (if (zerop count)
+ "Everything is already in sync"
+ (format "%d changes · %s to transfer" count size))
+ :face (if (zerop count) 'success 'rsync-ui-strong))
+ :width 66 :align :center)
+ (when delete
+ (vui-box (vui-text "Delete is enabled: extra files at the destination will be removed."
+ :face '(:inherit warning :weight bold))
+ :width 66 :align :center))
+ (when-let* ((sample (plist-get preview :sample)))
+ (vui-vstack
+ :spacing 0 :indent 4
+ (mapcar (lambda (line)
+ (vui-text (truncate-string-to-width line 62 nil nil "…") :face 'shadow))
+ sample))))))
+
+
+(vui-defcomponent rsync-ui-app (initial-sources initial-target)
+ :state ((sources (mapcar #'expand-file-name initial-sources))
+ (kind "local")
+ (local-target (or initial-target ""))
+ (ssh-host "")
+ (ssh-path "~/")
+ (ssh-port "22")
+ (mode "contents")
+ (compress t)
+ (delete nil)
+ (stage 'setup)
+ (preview nil)
+ (status nil)
+ (progress 0)
+ (transferred "0 B")
+ (speed "")
+ (eta "")
+ (remote-rsync nil)
+ (process nil))
+ :on-unmount
+ (when (process-live-p process)
+ (delete-process process))
+ :render
+ (let* ((invalidate
+ (lambda (key value)
+ (vui-batch
+ (vui-set-state key value)
+ (vui-set-state :stage 'setup)
+ (vui-set-state :preview nil)
+ (vui-set-state :remote-rsync nil)
+ (vui-set-state :status nil))))
+ (choose-source
+ (vui-async-callback ()
+ (when-let* ((path (read-file-name "Source file or folder: " nil nil t)))
+ (funcall invalidate :sources (list path)))))
+ (choose-target
+ (vui-async-callback ()
+ (when-let* ((path (read-directory-name "Destination folder: " nil nil nil)))
+ (funcall invalidate :local-target path))))
+ (start-preview
+ (vui-async-callback (rsync-path)
+ (let* ((arguments (rsync-ui--arguments
+ sources kind local-target ssh-host ssh-path ssh-port
+ rsync-path mode compress delete t))
+ (runner
+ (rsync-ui--start-process
+ arguments
+ (vui-async-callback (_chunk) nil)
+ (vui-async-callback (exit output)
+ (vui-set-state :process nil)
+ (setq rsync-ui--process nil)
+ (if (zerop exit)
+ (vui-batch
+ (vui-set-state :preview (rsync-ui--preview-summary output))
+ (vui-set-state :stage 'ready)
+ (vui-set-state :status nil))
+ (vui-batch
+ (vui-set-state :stage 'setup)
+ (vui-set-state :status
+ (cons (rsync-ui--process-error kind ssh-host output)
+ 'error))))))))
+ (setq rsync-ui--process runner)
+ (vui-batch
+ (vui-set-state :process runner)
+ (vui-set-state :stage 'previewing)
+ (vui-set-state :status
+ (cons "Checking the route without changing files…" 'shadow))))))
+ (run-preview
+ (vui-async-callback ()
+ (let ((problem (rsync-ui--validate sources kind local-target ssh-host ssh-path ssh-port)))
+ (cond
+ (problem
+ (vui-set-state :status (cons problem 'error)))
+ ((not (rsync-ui--remote-p kind))
+ (funcall start-preview nil))
+ (remote-rsync
+ (funcall start-preview remote-rsync))
+ (t
+ (let ((runner
+ (rsync-ui--find-remote-rsync
+ ssh-host ssh-port
+ (vui-async-callback (path output)
+ (vui-set-state :process nil)
+ (setq rsync-ui--process nil)
+ (if path
+ (progn
+ (vui-set-state :remote-rsync path)
+ (funcall start-preview path))
+ (vui-batch
+ (vui-set-state :stage 'setup)
+ (vui-set-state
+ :status
+ (cons
+ (if (string-empty-p output)
+ (format
+ "Rsync is unavailable to non-interactive SSH on %s. Add it to the remote PATH."
+ ssh-host)
+ (rsync-ui--process-error kind ssh-host output))
+ 'error))))))))
+ (setq rsync-ui--process runner)
+ (vui-batch
+ (vui-set-state :process runner)
+ (vui-set-state :stage 'previewing)
+ (vui-set-state :status
+ (cons "Locating rsync on the SSH server…" 'shadow)))))))))
+ (run-transfer
+ (vui-async-callback ()
+ (when (eq stage 'ready)
+ (let* ((arguments (rsync-ui--arguments
+ sources kind local-target ssh-host ssh-path ssh-port
+ remote-rsync mode compress delete nil))
+ (runner
+ (rsync-ui--start-process
+ arguments
+ (vui-async-callback (chunk)
+ (when-let* ((data (rsync-ui--progress-data chunk)))
+ (vui-batch
+ (vui-set-state :progress (plist-get data :percent))
+ (vui-set-state :transferred (plist-get data :bytes))
+ (vui-set-state :speed (plist-get data :speed))
+ (vui-set-state :eta (plist-get data :eta)))))
+ (vui-async-callback (exit output)
+ (setq rsync-ui--process nil)
+ (vui-set-state :process nil)
+ (if (zerop exit)
+ (vui-batch
+ (vui-set-state :progress 100)
+ (vui-set-state :stage 'done)
+ (vui-set-state :status (cons "Transfer complete." 'success)))
+ (vui-batch
+ (vui-set-state :stage 'failed)
+ (vui-set-state :status
+ (cons (rsync-ui--process-error kind ssh-host output)
+ 'error))))))))
+ (setq rsync-ui--process runner)
+ (vui-batch
+ (vui-set-state :process runner)
+ (vui-set-state :stage 'running)
+ (vui-set-state :progress 0)
+ (vui-set-state :status nil))))))
+ (cancel-transfer
+ (vui-async-callback ()
+ (when (process-live-p process)
+ (delete-process process)
+ (setq rsync-ui--process nil)
+ (vui-batch
+ (vui-set-state :process nil)
+ (vui-set-state :stage 'cancelled)
+ (vui-set-state :status (cons "Transfer cancelled. Files already copied remain valid." 'warning))))))
+ (reset
+ (vui-async-callback ()
+ (unless (process-live-p process)
+ (vui-batch
+ (vui-set-state :stage 'setup)
+ (vui-set-state :preview nil)
+ (vui-set-state :status nil)
+ (vui-set-state :progress 0)))))
+ (busy (process-live-p process))
+ (source-width (max 12 (min 42 (- (rsync-ui--window-width) 31)))))
+ (setq rsync-ui--actions
+ (list :choose-source choose-source
+ :choose-target choose-target
+ :preview run-preview
+ :start run-transfer
+ :cancel cancel-transfer
+ :reset reset))
+ (vui-vstack
+ :spacing 1
+ (rsync-ui--step-strip stage)
+ (rsync-ui--route sources kind local-target ssh-host ssh-path)
+ (cond
+ ((memq stage '(running done failed cancelled))
+ (vui-vstack
+ :spacing 1
+ (rsync-ui--gauge progress)
+ (vui-flex
+ :width 52 :justify :space-between
+ (vui-text transferred :face 'rsync-ui-strong)
+ (vui-text (if (string-empty-p speed) "Waiting for data…" speed) :face 'shadow)
+ (vui-text (if (string-empty-p eta) "" (format "ETA %s" eta)) :face 'shadow))))
+ ((eq stage 'ready)
+ (rsync-ui--preview-panel preview delete))
+ (t
+ (vui-vstack
+ :spacing 1
+ (rsync-ui--field-row
+ "Source"
+ (vui-hstack
+ :spacing 1
+ (vui-box
+ (vui-text
+ (truncate-string-to-width
+ (rsync-ui--source-title sources) (max 10 (- source-width 2)) nil nil "…"))
+ :width source-width)
+ (vui-button "Choose…" :on-click choose-source :disabled busy)))
+ (rsync-ui--field-row
+ "Destination"
+ (vui-select :value kind
+ :options '(("local" . "Local folder") ("ssh" . "SSH server"))
+ :on-change (lambda (value) (funcall invalidate :kind value))))
+ (if (rsync-ui--remote-p kind)
+ (vui-vstack
+ :spacing 1
+ (rsync-ui--field-row
+ "SSH host"
+ (vui-field :value ssh-host :size 42 :key 'ssh-host
+ :placeholder "user@example.org"
+ :on-change (lambda (value) (funcall invalidate :ssh-host value))))
+ (rsync-ui--field-row
+ "Remote folder"
+ (vui-field :value ssh-path :size 42 :key 'ssh-path
+ :placeholder "~/Backups/"
+ :on-change (lambda (value) (funcall invalidate :ssh-path value))))
+ (rsync-ui--field-row
+ "SSH port"
+ (vui-field :value ssh-port :size 8 :key 'ssh-port
+ :on-change (lambda (value) (funcall invalidate :ssh-port value))))
+ (rsync-ui--field-row
+ ""
+ (vui-muted "Uses your SSH key or agent; no password is stored.")))
+ (rsync-ui--field-row
+ "Local folder"
+ (vui-hstack
+ :spacing 1
+ (vui-field :value local-target :size 36 :key 'local-target
+ :placeholder "~/Backups/"
+ :on-change (lambda (value) (funcall invalidate :local-target value)))
+ (vui-button "Choose…" :on-click choose-target :disabled busy))))
+ (rsync-ui--field-row
+ "Folder behavior"
+ (vui-select :value mode
+ :options '(("contents" . "Copy its contents")
+ ("item" . "Copy the folder itself"))
+ :on-change (lambda (value) (funcall invalidate :mode value))))
+ (vui-collapsible
+ :title "Advanced options"
+ :initially-expanded nil
+ (vui-vstack
+ :spacing 1 :indent 16
+ (vui-checkbox :checked compress
+ :label "Compress data sent over SSH"
+ :on-change (lambda (value) (funcall invalidate :compress value)))
+ (vui-checkbox :checked delete
+ :label "Delete destination files missing from the source"
+ :on-change (lambda (value) (funcall invalidate :delete value)))
+ (when delete
+ (vui-warning "Preview deletions carefully. This option changes the destination.")))))))
+ (when status
+ (vui-box (vui-text (car status) :face (cdr status)) :width 66 :align :center))
+ (vui-flex
+ :width 'fill-column
+ :justify :space-between
+ (vui-hstack
+ :spacing 2
+ (vui-button "Preview" :on-click run-preview :disabled busy)
+ (vui-button "Start transfer" :on-click run-transfer
+ :disabled (or busy (not (eq stage 'ready)))
+ :face (when (eq stage 'ready) 'success))
+ (vui-button "Cancel" :on-click cancel-transfer :disabled (not busy) :face 'warning)
+ (vui-button "Reset" :on-click reset :disabled busy :face 'shadow))
+ (vui-muted "p preview · s start · x cancel · r reset · q close")))))
+
+(defun rsync-ui--invoke (action)
+ (if-let* ((callback (plist-get rsync-ui--actions action)))
+ (funcall callback)
+ (user-error "That action is not available")))
+
+(defun rsync-ui-preview ()
+ (interactive)
+ (rsync-ui--invoke :preview))
+
+(defun rsync-ui-start ()
+ (interactive)
+ (rsync-ui--invoke :start))
+
+(defun rsync-ui-cancel ()
+ (interactive)
+ (rsync-ui--invoke :cancel))
+
+(defun rsync-ui-reset ()
+ (interactive)
+ (rsync-ui--invoke :reset))
+
+(defun rsync-ui-choose-source ()
+ (interactive)
+ (rsync-ui--invoke :choose-source))
+
+(defun rsync-ui-choose-target ()
+ (interactive)
+ (rsync-ui--invoke :choose-target))
+
+(defun rsync-ui-next-widget ()
+ (interactive)
+ (condition-case nil
+ (widget-forward 1)
+ (error
+ (goto-char (point-min))
+ (widget-forward 1))))
+
+(defun rsync-ui-previous-widget ()
+ (interactive)
+ (condition-case nil
+ (widget-backward 1)
+ (error
+ (goto-char (point-max))
+ (widget-backward 1))))
+
+(defvar rsync-ui-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map vui-mode-map)
+ (define-key map (kbd "j") #'rsync-ui-next-widget)
+ (define-key map (kbd "k") #'rsync-ui-previous-widget)
+ (define-key map (kbd "TAB") #'rsync-ui-next-widget)
+ (define-key map (kbd "<backtab>") #'rsync-ui-previous-widget)
+ (define-key map (kbd "RET") #'vui-activate)
+ (define-key map (kbd "p") #'rsync-ui-preview)
+ (define-key map (kbd "s") #'rsync-ui-start)
+ (define-key map (kbd "x") #'rsync-ui-cancel)
+ (define-key map (kbd "r") #'rsync-ui-reset)
+ (define-key map (kbd "o") #'rsync-ui-choose-source)
+ (define-key map (kbd "d") #'rsync-ui-choose-target)
+ (define-key map (kbd "q") #'quit-window)
+ map))
+
+(define-derived-mode rsync-ui-mode vui-mode "Rsync"
+ (setq-local header-line-format nil)
+ (setq-local mode-line-format nil)
+ (setq-local truncate-lines t)
+ (setq-local cursor-type 'box))
+
+(with-eval-after-load 'evil
+ (evil-set-initial-state 'rsync-ui-mode 'normal)
+ (evil-define-key* '(normal motion) rsync-ui-mode-map
+ (kbd "j") #'rsync-ui-next-widget
+ (kbd "k") #'rsync-ui-previous-widget
+ (kbd "RET") #'vui-activate
+ (kbd "p") #'rsync-ui-preview
+ (kbd "s") #'rsync-ui-start
+ (kbd "x") #'rsync-ui-cancel
+ (kbd "r") #'rsync-ui-reset
+ (kbd "o") #'rsync-ui-choose-source
+ (kbd "d") #'rsync-ui-choose-target
+ (kbd "q") #'quit-window))
+
+(defun rsync-ui--open (sources target)
+ (let ((buffer (get-buffer-create rsync-ui-buffer-name)))
+ (if (and (buffer-local-value 'rsync-ui--process buffer)
+ (process-live-p (buffer-local-value 'rsync-ui--process buffer)))
+ (pop-to-buffer buffer)
+ (with-current-buffer buffer
+ (when (vui-get-instance buffer)
+ (vui-unmount buffer))
+ (rsync-ui-mode)
+ (vui-mount (vui-component 'rsync-ui-app
+ :initial-sources sources
+ :initial-target target)
+ buffer)
+ (vui-rerender-on-resize))
+ (pop-to-buffer buffer))))
+
+;;;###autoload
+(defun rsync-ui (&optional source target)
+ (interactive)
+ (rsync-ui--open (and source (list source)) target))
+
+;;;###autoload
+(defun rsync-ui-dired ()
+ (interactive)
+ (rsync-ui--open (dired-get-marked-files) nil))
+
+(provide 'rsync-ui)