diff options
| -rw-r--r-- | config.org | 112 | ||||
| -rw-r--r-- | lisp/rsync-ui.el | 729 |
2 files changed, 834 insertions, 7 deletions
@@ -2589,12 +2589,7 @@ Auto switch silos (different workspaces/folders) based on preconfigured director (company-backends '(company-capf)) :config (defun my/company-limit-candidates (candidates) - (seq-take candidates 4)) - - (define-key company-mode-map [remap indent-for-tab-command] - #'company-manual-begin) - (define-key company-mode-map [remap c-indent-line-or-region] - #'company-manual-begin)) + (seq-take candidates 4))) #+end_src * which-key @@ -2679,7 +2674,7 @@ Auto switch silos (different workspaces/folders) based on preconfigured director "\\`\\*elpaca-log\\*\\'" "\\`\\*Native-compile-Log\\*\\'" "\\`\\*Async-native-compile-log\\*\\'")) - (helm-display-function #'helm-display-buffer-in-own-frame) + ;; (helm-display-function #'helm-display-buffer-in-own-frame) :bind (:map helm-map ("C-j" . helm-next-line) ("C-k" . helm-previous-line))) @@ -2775,6 +2770,17 @@ Auto switch silos (different workspaces/folders) based on preconfigured director (kbd "g b") #'citre-jump-back))) #+end_src +* nov + +#+begin_src emacs-lisp +(use-package nov + :ensure t + :mode ("\\.epub\\'" . nov-mode) + :hook (nov-mode . visual-line-mode) + :custom + (nov-text-width 100)) +#+end_src + * programming @@ -5130,6 +5136,98 @@ opening another file in same project does not re-notify." (minimal-dashboard-modeline-shown t)) ;; visibility of the modeline #+end_src +* rsync + +#+begin_src emacs-lisp +(use-package rsync-ui + :ensure nil + :commands (rsync-ui rsync-ui-dired) + :bind (:map dired-mode-map + ("C-c r" . rsync-ui-dired)) + :init + (with-eval-after-load 'general + (my-leader "or" '(rsync-ui :wk "rsync")))) +#+end_src + +* exp + +#+begin_src emacs-lisp +(defun rlr/org-export-html-to-browser () + "Export the current Org buffer to a temporary HTML file in the system temp directory, open it, and then delete it when Emacs is killed." + (interactive) + (unless (derived-mode-p 'org-mode) + (user-error "Not in an Org buffer")) + (let* ((tmp (make-temp-file "org-preview-" nil ".html")) + (org-export-in-background nil) + (org-html-head-include-default-style nil) + (org-html-head-include-scripts nil) + (org-html-head rlr/org-preview-css) + (org-html-validation-link nil)) + (org-export-to-file 'html tmp) + (add-hook 'kill-emacs-hook + (lambda () (ignore-errors (delete-file tmp)))) + (funcall browse-url-secondary-browser-function + (browse-url-file-url tmp)))) +(defvar rlr/org-preview-css " +<style> + :root { color-scheme: light dark; } + body { + max-width: 40rem; + margin: 3rem auto; + padding: 0 1.25rem; + font-family: -apple-system, BlinkMacSystemFont, 'Iowan Old Style','Palatino Linotype', Georgia, serif; + font-size: 1.125rem; + line-height: 1.65; + color: #24292f; + background: #fdfdfc; + text-rendering: optimizeLegibility; + hyphens: auto; + } + h1, h2, h3, h4 { + font-family: -apple-system, BlinkMacSystemFont, 'Helvetica Neue', sans-serif; + line-height: 1.25; + margin-top: 2.25em; + color: #14181c; + } + h1 { font-size: 1.9rem; margin-bottom: 0.2em; } + h2 { font-size: 1.45rem; } + h3 { font-size: 1.2rem; } + .title { text-align: left; margin-bottom: 2rem; } + #table-of-contents { font-size: 0.95rem; } + a { color: #0b5cad; text-underline-offset: 2px; } + blockquote { + margin: 1.5em 0; padding: 0.25em 0 0.25em 1.25em; + border-left: 3px solid #d0d7de; color: #4a5058; font-style: italic; + } + pre, code { font-family: 'SF Mono', Menlo, Consolas, monospace; font-size: 0.9rem; } + pre { + background: #f4f4f2; padding: 0.9em 1.1em; + border-radius: 6px; overflow-x: auto; line-height: 1.45; + } + code { background: #f0f0ee; padding: 0.1em 0.3em; border-radius: 3px; } + pre code { background: none; padding: 0; } + table { border-collapse: collapse; margin: 1.5em 0; font-size: 0.95rem; } + th, td { border: 1px solid #d0d7de; padding: 0.4em 0.7em; text-align: left; } + th { background: #f4f4f2; } + hr { border: none; border-top: 1px solid #d8d8d4; margin: 2.5em 0; } + .footpara { display: inline; } + #postamble { margin-top: 3rem; font-size: 0.85rem; color: #6a707a; } + @media (prefers-color-scheme: dark) { + body { color: #d6d3cd; background: #16181a; } + h1, h2, h3, h4 { color: #f0ede8; } + a { color: #6cb3f5; } + blockquote { border-left-color: #3a3f45; color: #a8a49d; } + pre { background: #1e2124; } + code { background: #24282c; } + th, td { border-color: #3a3f45; } + th { background: #1e2124; } + hr { border-top-color: #2e3236; } + } +</style>" + "Stylesheet injected into throwaway HTML previews of Org buffers.") +#+end_src + + * provide init #+begin_src emacs-lisp 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) |