;;; zfs.el --- ZFS management UI -*- lexical-binding: t; -*- (require 'vui) (require 'vui-components) (require 'async) (require 'zfs-cli) (declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings)) (declare-function evil-set-initial-state "evil-core" (mode state)) (defcustom zfs-buffer-name "*zfs*" "Name of the ZFS management buffer." :type 'string :group 'zfs) (defcustom zfs-targets-file (locate-user-emacs-file "zfs-targets.eld") "File where backup targets are stored as a plain elisp list." :type 'file :group 'zfs) (defcustom zfs-backup-targets nil "Seed backup targets, used when `zfs-targets-file' does not exist yet. Same plist shape as documented there." :type '(repeat sexp) :group 'zfs) (defvar-local zfs-ui--row-actions nil) (defvar-local zfs-ui--refresh-fn nil) (defvar-local zfs-ui--back-action nil) (defun zfs-ui--targets-load () (if (file-exists-p zfs-targets-file) (with-temp-buffer (insert-file-contents zfs-targets-file) (goto-char (point-min)) (read (current-buffer))) zfs-backup-targets)) (defun zfs-ui--targets-save (targets) (with-temp-file zfs-targets-file (pp targets (current-buffer)))) (defun zfs--format-bytes (bytes) (cond ((null bytes) "-") ((not (numberp bytes)) (format "%s" bytes)) (t (let ((units '((1099511627776 . "T") (1073741824 . "G") (1048576 . "M") (1024 . "K"))) (result nil)) (dolist (unit units) (when (and (not result) (>= bytes (car unit))) (let ((value (/ bytes (float (car unit))))) (setq result (if (< value 10) (format "%.1f%s" value (cdr unit)) (format "%.0f%s" value (cdr unit))))))) (or result (format "%dB" bytes)))))) (defun zfs--format-ago (epoch) (if (not (numberp epoch)) "-" (let ((delta (- (float-time) epoch))) (cond ((< delta 90) "just now") ((< delta 3600) (format "%dm ago" (truncate (/ delta 60)))) ((< delta 86400) (format "%dh ago" (truncate (/ delta 3600)))) ((< delta (* 30 86400)) (format "%dd ago" (truncate (/ delta 86400)))) ((< delta (* 365 86400)) (format "%dmo ago" (truncate (/ delta (* 30 86400))))) (t (format "%dy ago" (truncate (/ delta (* 365 86400))))))))) (defun zfs--gauge (percent &optional width) (let* ((width (or width 20)) (done (max 0 (min width (round (* width (/ (or percent 0) 100.0))))))) (concat (make-string done ?█) (make-string (- width done) ?░)))) (defun zfs--health-face (health) (pcase health ("ONLINE" 'success) ("DEGRADED" 'warning) (_ 'error))) (defun zfs--capacity-face (percent) (cond ((>= (or percent 0) 90) 'error) ((>= (or percent 0) 75) 'warning) (t 'success))) (defun zfs-ui--window-width () "Return the live ZFS window body width." (if-let* ((window (get-buffer-window (current-buffer) t))) (window-body-width window) (window-width))) (defun zfs-ui--stat-card (label value face width) "Render a ZFS stat card with LABEL, VALUE, FACE, and WIDTH." (vui-vstack :face 'fringe (vui-box (vui-text value :face `(:inherit ,face :weight bold :height 1.25)) :width width :align :center) (vui-box (vui-text label :face 'shadow) :width width :align :center))) (defun zfs--direct-children (datasets parent) (let ((prefix (concat parent "/"))) (seq-filter (lambda (entry) (and (string-prefix-p prefix (car entry)) (not (string-match-p "/" (substring (car entry) (length prefix)))))) datasets))) (defun zfs--snapshots-of (snaps dataset) (seq-filter (lambda (entry) (string-prefix-p (concat dataset "@") (car entry))) snaps)) (defun zfs--snapshot-leaf (full-name) (car (last (split-string full-name "@" t)))) (defun zfs-ui--fetch (host include-disks callback) (let ((cli-dir (file-name-directory (locate-library "zfs-cli.el")))) (async-start `(lambda () (add-to-list 'load-path ,cli-dir) (require 'zfs-cli) (list :pools (condition-case err (zfs-cli-pools ',host) (error (cons :error (error-message-string err)))) :datasets (condition-case err (zfs-cli-datasets ',host) (error (cons :error (error-message-string err)))) :snaps (condition-case err (zfs-cli-snapshots ',host) (error (cons :error (error-message-string err)))) :locked ,(if include-disks '(condition-case err (mapcar (lambda (device) (append device (list :pool (and (zfs-cli-disk-unlocked-p device) (zfs-cli-pool-on-device (concat "/dev/mapper/" (zfs-cli-disk-mapper device))))))) (zfs-cli-locked-disks)) (error (cons :error (error-message-string err)))) nil))) callback))) (defun zfs-ui--fetch-done (result) (let ((pools (plist-get result :pools)) (datasets (plist-get result :datasets)) (snaps (plist-get result :snaps)) (locked (plist-get result :locked))) (vui-batch (vui-set-state :loading nil) (vui-set-state :refreshed (format-time-string "%H:%M")) (if (and (eq (car-safe pools) :error) (eq (car-safe datasets) :error)) (vui-set-state :message (cons (format "Could not reach host: %s" (cdr pools)) 'error)) (vui-set-state :pools (and (not (eq (car-safe pools) :error)) pools)) (vui-set-state :datasets (and (not (eq (car-safe datasets) :error)) datasets)) (vui-set-state :snaps (and (not (eq (car-safe snaps) :error)) snaps)) (vui-set-state :locked (and (listp locked) (not (eq (car-safe locked) :error)) locked)))))) (defun zfs-ui--refresh (host) (vui-set-state :loading t) (zfs-ui--fetch host (null host) (vui-async-callback (result) (zfs-ui--fetch-done result)))) (defun zfs-ui--go (page &optional arg) (vui-batch (vui-set-state :page page) (vui-set-state :page-arg arg) (vui-set-state :backup-target nil) (vui-set-state :backup-preview nil) (vui-set-state :backup-progress nil) (vui-set-state :backup-done nil) (vui-set-state :create-status nil) (vui-set-state :copy-status nil) (vui-set-state :risk-status nil) (vui-set-state :format-status nil))) (defun zfs-ui--fail (err) (vui-set-state :message (cons (format "Error: %s" (error-message-string err)) 'error))) (defun zfs-ui--do-snapshot (host dataset) (let ((snap-name (read-string (format "Snapshot name for %s: " dataset) (format-time-string "manual-%Y-%m-%d_%H-%M")))) (condition-case err (progn (zfs-cli-snapshot host dataset snap-name) (vui-set-state :message (cons (format "Snapshot %s@%s created" dataset snap-name) 'success)) (zfs-ui--refresh host)) (error (zfs-ui--fail err))))) (defun zfs-ui--do-mount (host dataset) (condition-case err (progn (zfs-cli-mount host dataset) (vui-set-state :message (cons (format "Mounted %s" dataset) 'success)) (zfs-ui--refresh host)) (error (zfs-ui--fail err)))) (defun zfs-ui--do-diff (host snapshot) (let ((command (if host (format "ssh -o BatchMode=yes %s %s" (shell-quote-argument (plist-get host :ssh)) (shell-quote-argument (concat "doas -n zfs diff -H " snapshot))) (format "doas -n zfs diff -H %s" snapshot)))) (if (fboundp 'ghostel-compile) (ghostel-compile command) (compile command)))) (defun zfs-ui--do-scrub (host pool stop) (condition-case err (progn (zfs-cli-scrub host pool stop) (vui-set-state :message (cons (if stop "Scrub stopped" "Scrub started — reads all data, verifies checksums") 'success)) (zfs-ui--refresh host)) (error (zfs-ui--fail err)))) (defun zfs-ui--do-rollback (host snapshot) (condition-case err (progn (zfs-cli-rollback host snapshot) (vui-set-state :message (cons (format "Rolled back to %s" snapshot) 'success)) (zfs-ui--refresh host) (zfs-ui--go 'overview)) (error (vui-set-state :risk-status (cons (error-message-string err) 'error))))) (defun zfs-ui--do-export (host pool) (condition-case err (progn (zfs-cli-export host pool) (vui-set-state :message (cons (format "Exported %s" pool) 'success)) (zfs-ui--refresh host) (zfs-ui--go 'overview)) (error (vui-set-state :risk-status (cons (error-message-string err) 'error))))) (defun zfs-ui--do-format (device pool-name encrypted passphrase) (let ((mapper (concat "luks-" (plist-get device :name)))) (vui-set-state :format-status (cons "Formatting… this takes a moment" 'shadow)) (zfs-cli-format-disk-async (plist-get device :path) pool-name mapper (and encrypted passphrase) (vui-async-callback (status err) (if (zerop status) (vui-batch (vui-set-state :message (cons (format "Pool %s created on %s" pool-name (plist-get device :name)) 'success)) (zfs-ui--refresh nil) (zfs-ui--go 'overview)) (vui-set-state :format-status (cons (format "Format failed: %s" err) 'error))))))) (defun zfs-ui--do-unlock (device) (let ((passphrase (read-passwd (format "LUKS passphrase for %s: " (plist-get device :name))))) (condition-case err (let ((mapper (concat "luks-" (plist-get device :name)))) (zfs-cli-luks-open (plist-get device :path) mapper passphrase) (let ((pool (zfs-cli-pool-on-device (concat "/dev/mapper/" mapper)))) (if pool (progn (zfs-cli-import nil pool t) (vui-set-state :message (cons (format "Unlocked — pool %s imported" pool) 'success))) (vui-set-state :message (cons "Unlocked, but no ZFS pool found on the device" 'warning)))) (zfs-ui--refresh nil)) (error (zfs-ui--fail err))))) (defun zfs-ui--do-import (device) (condition-case err (let ((pool (zfs-cli-pool-on-device (concat "/dev/mapper/" (zfs-cli-disk-mapper device))))) (if pool (progn (zfs-cli-import nil pool t) (vui-set-state :message (cons (format "Imported %s" pool) 'success)) (zfs-ui--refresh nil)) (vui-set-state :message (cons "No ZFS pool found on the device" 'warning)))) (error (zfs-ui--fail err)))) (defun zfs-ui--common-base (snaps target-snap-names dataset) (let* ((own (zfs--snapshots-of snaps dataset)) (common (seq-filter (lambda (entry) (member (zfs--snapshot-leaf (car entry)) target-snap-names)) own)) (sorted (sort (copy-sequence common) (lambda (a b) (< (or (zfs-cli-prop a 'creation) 0) (or (zfs-cli-prop b 'creation) 0)))))) (when sorted (car (car (last sorted)))))) (defun zfs-ui--newest-snapshot (snaps dataset) (let ((sorted (sort (copy-sequence (zfs--snapshots-of snaps dataset)) (lambda (a b) (< (or (zfs-cli-prop a 'creation) 0) (or (zfs-cli-prop b 'creation) 0)))))) (car (last sorted)))) (defun zfs-ui--backup-preview (host dataset snapshot snaps entry target) (let* ((leaf (file-name-nondirectory dataset)) (target-dataset (concat (plist-get target :dataset) "/" leaf)) (target-snap-names (condition-case nil (mapcar (lambda (snap-entry) (zfs--snapshot-leaf (car snap-entry))) (zfs-cli-snapshots target target-dataset)) (error nil))) (base (zfs-ui--common-base snaps target-snap-names dataset)) (raw (and entry (not (member (zfs-cli-prop entry 'encryption) '(nil "off"))))) (preview (zfs-cli-send-preview host snapshot base))) (list :target-dataset target-dataset :base base :raw raw :kind (plist-get preview :kind) :bytes (plist-get preview :bytes)))) (defun zfs-ui--backup-event (event) (pcase (car event) (:progress (vui-set-state :backup-progress (nth 1 event))) (:done (if (zerop (nth 1 event)) (vui-batch (vui-set-state :backup-done 'success) (vui-set-state :backup-progress nil)) (vui-batch (vui-set-state :backup-done (format "%s" (nth 2 event))) (vui-set-state :backup-progress nil)))))) (defun zfs-ui--start-backup (host snapshot target preview) (vui-batch (vui-set-state :backup-progress "starting…") (vui-set-state :backup-done nil)) (zfs-cli-send-async host snapshot target (plist-get preview :target-dataset) (plist-get preview :base) (plist-get preview :raw) (vui-async-callback (event) (zfs-ui--backup-event event)))) (defun zfs-ui--field-string (key) (or (vui-field-value key) "")) (defun zfs-ui--ack-p (key) (equal (zfs-ui--field-string key) "ack")) (defun zfs-ui--start-move (host dataset mountpoint move-dir) (vui-set-state :create-status (cons "Copying… 0%" 'shadow)) (zfs-cli-rsync-async move-dir mountpoint 'contents nil (vui-async-callback (event) (pcase (car event) (:progress (when (string-match "\\([0-9]+%\\)" (nth 1 event)) (vui-set-state :create-status (cons (format "Copying… %s" (match-string 1 (nth 1 event))) 'shadow)))) (:done (if (zerop (nth 1 event)) (vui-set-state :message (cons (format "%s created, data copied — original kept in %s" dataset move-dir) 'success)) (vui-set-state :message (cons (format "%s created, but copying failed: %s" dataset (nth 2 event)) 'error))) (zfs-ui--go 'dataset dataset) (zfs-ui--refresh host)))))) (defconst zfs-ui--copy-modes '((contents "Copy folder contents" "Put a folder's contents into the target. Source stays untouched.") (item "Copy selected item" "Place the selected file or folder inside the target.") (move "Move files safely" "Copy first, then remove copied files; folders stay for review."))) (defun zfs-ui--copy-mode-title (mode) (cadr (assoc mode zfs-ui--copy-modes))) (defun zfs-ui--copy-preview-line (line) "Return LINE unchanged; the VUI container owns visual truncation." line) (defun zfs-ui--copy-preview (output) (let* ((lines (mapcar #'string-trim (split-string (or output "") "\n"))) (useful (seq-filter (lambda (line) (and (not (string-empty-p line)) (not (string-prefix-p "sending incremental file list" line)) (not (string-prefix-p "sent " line)) (not (string-prefix-p "total size" line)))) lines)) (shown (seq-take useful 14)) (more (- (length useful) (length shown)))) (if useful (concat "\n\nPreview:\n" (string-join (mapcar (lambda (line) (concat " " (zfs-ui--copy-preview-line line))) shown) "\n") (if (> more 0) (format "\n … %d more" more) "")) "\n\nPreview: rsync found no file changes."))) (defun zfs-ui--copy-event (source target dry-run event) (pcase (car event) (:progress (if (string-match "\\([0-9]+%\\)" (nth 1 event)) (vui-set-state :copy-status (cons (format "%s… %s" (if dry-run "Checking" "Copying") (match-string 1 (nth 1 event))) 'shadow)) (when dry-run (vui-set-state :copy-status (cons "Checking… building preview" 'shadow))))) (:done (if (zerop (nth 1 event)) (vui-set-state :copy-status (cons (if dry-run (concat (format "Dry run complete: %s → %s, no files changed" source target) (zfs-ui--copy-preview (nth 3 event))) (format "Transfer complete: %s → %s" source target)) 'success)) (vui-set-state :copy-status (cons (format "Transfer failed: %s" (nth 2 event)) 'error)))))) (defun zfs-ui--do-copy (&optional mode dry-run source target) (if mode nil (setq mode 'contents)) (let* ((field-source (vui-field-value :copy-source)) (field-target (vui-field-value :copy-target)) (source (if (or (null source) (string-blank-p source)) (or field-source (zfs-ui--field-string 'copy-source)) source)) (target (if (or (null target) (string-blank-p target)) (or field-target (zfs-ui--field-string 'copy-target)) target))) (cond ((string-blank-p source) (vui-set-state :copy-status (cons "Source is empty" 'error))) ((string-blank-p target) (vui-set-state :copy-status (cons "Target is empty" 'error))) (t (vui-set-state :copy-status (cons (if dry-run "Checking… reading file list" "Copying… 0%") 'shadow)) (zfs-cli-rsync-async source target mode dry-run (vui-async-callback (event) (zfs-ui--copy-event source target dry-run event))))))) (defun zfs-ui--do-create-dataset (host parent) (let* ((leaf (zfs-ui--field-string 'create-name)) (mountpoint (zfs-ui--field-string 'create-mountpoint)) (quota (zfs-ui--field-string 'create-quota)) (passphrase (zfs-ui--field-string 'create-passphrase)) (encrypted (not (string-blank-p passphrase))) (compression (zfs-ui--field-string 'create-compression)) (move-dir (zfs-ui--field-string 'create-move)) (dataset (concat parent "/" leaf))) (cond ((string-blank-p leaf) (vui-set-state :create-status (cons "Name is empty" 'error))) ((string-match-p "/" leaf) (vui-set-state :create-status (cons "Name must be a single segment, no slashes" 'error))) ((and (not (string-blank-p move-dir)) (string-blank-p mountpoint)) (vui-set-state :create-status (cons "Moving a folder in needs a mountpoint" 'error))) (t (let ((properties nil)) (when (and compression (not (equal compression "inherit"))) (push (cons "compression" compression) properties)) (when (and mountpoint (not (string-blank-p mountpoint)) (not (equal mountpoint "none"))) (push (cons "mountpoint" mountpoint) properties)) (when (and quota (not (string-blank-p quota))) (push (cons "quota" quota) properties)) (condition-case err (progn (if encrypted (zfs-cli-create-encrypted host dataset passphrase properties) (zfs-cli-create host dataset properties)) (when (and (not (string-blank-p mountpoint)) (not (equal mountpoint "none"))) (ignore-errors (zfs-cli-mount host dataset))) (if (not (string-blank-p move-dir)) (zfs-ui--start-move host dataset mountpoint move-dir) (vui-set-state :message (cons (format "Created %s" dataset) 'success)) (zfs-ui--go 'dataset dataset) (zfs-ui--refresh host))) (error (vui-set-state :create-status (cons (error-message-string err) 'error))))))))) (defconst zfs-ui--property-glossary '(("used" . "live data + snapshots + children together") ("referenced" . "live data right now, snapshots excluded") ("usedbysnapshots" . "only reachable through snapshots; freed only by snapshot removal outside this UI") ("usedbychildren" . "used by datasets below this one") ("available" . "room this dataset can still grow into") ("compressratio" . "how much smaller data is stored; 1.31x ≈ 24% saved") ("encryption" . "dataset-level encryption, independent of disk LUKS") ("keystatus" . "available = key loaded, data readable") ("mountpoint" . "where it shows up; legacy = mounted by the system, not zfs") ("recordsize" . "max block size; matters for databases and VM images") ("quota" . "hard size limit, if set") ("reservation" . "space guaranteed to this dataset, if set") ("creation" . "when the dataset was created") ("mounted" . "whether it is currently mounted"))) (defun zfs-ui--dataset-row (entry depth snap-count) (let* ((name (car entry)) (short (file-name-nondirectory name)) (label (concat (if (> snap-count 0) "▸ " "") short (when (> snap-count 0) (format " (%d)" snap-count)))) (encryption (zfs-cli-prop entry 'encryption)) (keystatus (zfs-cli-prop entry 'keystatus))) (list (vui-vstack :indent (* 2 depth) (vui-button label :no-decoration t :key (concat "ds:" name) :on-click (lambda () (zfs-ui--go 'dataset name)))) (vui-text (zfs--format-bytes (zfs-cli-prop entry 'used))) (vui-text (zfs--format-bytes (zfs-cli-prop entry 'available)) :face 'shadow) (vui-text (format "%s" (or (zfs-cli-prop entry 'compressratio) "-")) :face 'shadow) (cond ((or (null encryption) (equal encryption "off")) (vui-text "·" :face 'shadow)) ((equal keystatus "available") (vui-text "🔓" :face 'success)) (t (vui-text "🔒" :face 'warning)))))) (defun zfs-ui--dataset-rows (entry depth datasets snaps) (let* ((name (car entry)) (children (zfs--direct-children datasets name)) (own-snaps (zfs--snapshots-of snaps name))) (push (cons (concat "ds:" name) (list :open (vui-with-async-context (zfs-ui--go 'dataset name)) :backup (vui-with-async-context (zfs-ui--go 'backup name)) :create-child (vui-with-async-context (zfs-ui--go 'create name)))) zfs-ui--row-actions) (cons (zfs-ui--dataset-row entry depth (length own-snaps)) (mapcan (lambda (child) (zfs-ui--dataset-rows child (1+ depth) datasets snaps)) children)))) (defun zfs-ui--pool-row (pool) (let* ((name (car pool)) (health (zfs-cli-prop pool 'health)) (capacity (zfs-cli-prop pool 'capacity)) (size (zfs-cli-prop pool 'size)) (free (zfs-cli-prop pool 'free))) (push (cons (concat "pool:" name) (list :open (vui-with-async-context (zfs-ui--go 'pool name)) :create-child (vui-with-async-context (zfs-ui--go 'create name)))) zfs-ui--row-actions) (list (vui-button name :no-decoration t :key (concat "pool:" name) :on-click (lambda () (zfs-ui--go 'pool name))) (vui-text (or health "?") :face (zfs--health-face health)) (vui-text (zfs--gauge capacity) :face (zfs--capacity-face capacity)) (vui-text (format "%d%% · %s / %s free" (or capacity 0) (zfs--format-bytes free) (zfs--format-bytes size)) :face 'shadow)))) (defun zfs-ui--locked-disk-row (device pools) (let* ((name (plist-get device :name)) (unlocked (zfs-cli-disk-unlocked-p device)) (mapper (zfs-cli-disk-mapper device)) (pool (plist-get device :pool)) (imported (and pool (assoc pool pools)))) (push (cons (concat "lock:" name) (if unlocked (unless imported (list :import (vui-with-async-context (zfs-ui--do-import device)))) (list :unlock (vui-with-async-context (zfs-ui--do-unlock device))))) zfs-ui--row-actions) (list (vui-text (if unlocked "🔓" "🔒") :face (if unlocked 'warning 'shadow)) (vui-button name :no-decoration t :key (concat "lock:" name) :on-click (lambda () nil)) (vui-text (or (plist-get device :model) "?") :face 'shadow) (vui-text (zfs--format-bytes (plist-get device :size)) :face 'shadow) (vui-text (cond (imported (format "pool %s imported" pool)) (unlocked (format "unlocked as %s · i imports %s" mapper (or pool "?"))) (t "locked · u unlock")) :face 'shadow)))) (defun zfs-ui--page-overview (pools datasets snaps locked) (push (cons 'page (list :copy (vui-with-async-context (zfs-ui--go 'copy)) :admin (vui-with-async-context (zfs-ui--go 'admin)) :targets (vui-with-async-context (zfs-ui--go 'targets)))) zfs-ui--row-actions) (let* ((roots (seq-filter (lambda (entry) (not (string-match-p "/" (car entry)))) datasets)) (width (zfs-ui--window-width)) (card-width (max 10 (min 16 (/ (max 44 (- width 6)) 4)))) (name-width (max 18 (min 36 (- width 37))))) (vui-vstack :spacing 1 (vui-hstack :spacing 2 (zfs-ui--stat-card "pools" (number-to-string (length pools)) 'success card-width) (zfs-ui--stat-card "datasets" (number-to-string (length datasets)) 'link card-width) (zfs-ui--stat-card "snapshots" (number-to-string (length snaps)) 'warning card-width) (zfs-ui--stat-card "locked disks" (number-to-string (length locked)) (if locked 'warning 'shadow) card-width)) (vui-vstack :spacing 0 (vui-heading-3 "Utilities") (vui-hstack :spacing 2 (vui-button "Copy files" :face 'success :on-click (lambda () (zfs-ui--go 'copy))) (vui-button "Admin actions" :face 'warning :on-click (lambda () (zfs-ui--go 'admin))) (vui-button "Backup targets" :on-click (lambda () (zfs-ui--go 'targets))))) (when locked (vui-vstack :spacing 0 (vui-heading-3 "Disks") (vui-muted "LUKS disks ZFS can use once unlocked") (vui-table :sticky-header t :columns '((:header "" :width 3) (:header "Device" :width 12 :truncate t) (:header "Model" :width 24 :grow t :truncate t) (:header "Size" :width 9 :align :right) (:header "State" :width 26 :grow t :truncate t)) :rows (mapcar (lambda (device) (zfs-ui--locked-disk-row device pools)) locked)))) (vui-vstack :spacing 0 (vui-heading-3 "Pools") (vui-muted "Teams of disks; RET opens health and VDEV details") (if pools (vui-table :sticky-header t :columns '((:header "Pool" :width 12 :grow t :truncate t) (:header "Health" :width 9) (:header "Capacity" :width 20) (:header "Space" :width 26 :grow t :truncate t)) :rows (mapcar #'zfs-ui--pool-row pools)) (vui-muted "No pools found. Kernel module loaded, pools imported?"))) (vui-vstack :spacing 0 (vui-heading-3 "Datasets") (vui-muted "RET details · b backup · c create child") (vui-table :sticky-header t :columns `((:header "Dataset" :width ,name-width :grow t :truncate t) (:header "Used" :width 9 :align :right) (:header "Available" :width 9 :align :right) (:header "Ratio" :width 7 :align :right) (:header "Enc" :width 4 :align :center)) :rows (mapcan (lambda (root) (zfs-ui--dataset-rows root 0 datasets snaps)) roots)))))) (defun zfs-ui--property-row (entry property) (let* ((raw (zfs-cli-prop entry (intern property))) (value (cond ((equal property "creation") (format "%s (%s)" (format-time-string "%Y-%m-%d" raw) (zfs--format-ago raw))) ((and (member property '("quota" "reservation")) (or (null raw) (equal raw 0))) "none") ((numberp raw) (zfs--format-bytes raw)) (t (format "%s" (or raw "-"))))) (gloss (cdr (assoc property zfs-ui--property-glossary)))) (list (vui-text property :face 'shadow) (vui-text value) (vui-text (or gloss "") :face 'shadow)))) (defun zfs-ui--snapshot-row (snap dataset host) (let* ((full-name (car snap)) (leaf (zfs--snapshot-leaf full-name))) (push (cons (concat "snap:" full-name) (list :diff (vui-with-async-context (zfs-ui--do-diff host full-name)) :rollback (vui-with-async-context (zfs-ui--go 'rollback full-name)) :backup (vui-with-async-context (zfs-ui--go 'backup (cons dataset full-name))))) zfs-ui--row-actions) (list (vui-button (concat "@" leaf) :no-decoration t :face 'shadow :key (concat "snap:" full-name) :on-click (lambda () nil)) (vui-text (zfs--format-bytes (zfs-cli-prop snap 'used)) :face 'shadow) (vui-text (zfs--format-ago (zfs-cli-prop snap 'creation)) :face 'shadow)))) (defun zfs-ui--page-dataset (name host datasets snaps) (let* ((entry (assoc name datasets)) (own-snaps (zfs--snapshots-of snaps name))) (when entry (push (cons 'page (list :snapshot (vui-with-async-context (zfs-ui--do-snapshot host name)) :backup (vui-with-async-context (zfs-ui--go 'backup name)) :create-child (vui-with-async-context (zfs-ui--go 'create name)) :mount (vui-with-async-context (zfs-ui--do-mount host name)))) zfs-ui--row-actions)) (if (null entry) (vui-text (format "%s not found — g to refresh" name) :face 'error) (apply #'vui-vstack :spacing 1 (append (list (vui-hstack :spacing 2 (vui-heading-3 name) (vui-text (downcase (or (alist-get 'type (cdr entry)) "")) :face 'shadow)) (vui-muted (format "Everything in this dataset and its snapshots uses %s." (zfs--format-bytes (zfs-cli-prop entry 'used)))) (vui-text "s snapshot · b backup · c new dataset inside · m mount" :face 'shadow) (vui-table :sticky-header t :columns '((:header "Property" :width 18 :truncate t) (:header "Value" :width 22 :grow t :truncate t) (:header "Meaning" :width 48 :grow t :truncate t)) :rows (mapcar (lambda (property) (zfs-ui--property-row entry property)) '("used" "referenced" "usedbysnapshots" "usedbychildren" "available" "compressratio" "encryption" "keystatus" "mountpoint" "recordsize" "quota" "creation" "mounted")))) (list (apply #'vui-vstack :spacing 0 (append (list (vui-heading-3 (format "Snapshots (%d)" (length own-snaps))) (vui-muted "frozen moments · d diff · b backup · R rollback opens an ack page")) (if own-snaps (list (vui-table :sticky-header t :columns '((:header "Snapshot" :width 38 :grow t :truncate t) (:header "Used" :width 9 :align :right) (:header "Age" :width 12)) :rows (mapcar (lambda (snap) (zfs-ui--snapshot-row snap name host)) own-snaps))) (list (vui-muted "none yet — press s to freeze this moment"))))))))))) (defun zfs-ui--vdev-row (vdev depth) (list (vui-vstack :indent (* 2 depth) (vui-text (plist-get vdev :name))) (vui-text (or (plist-get vdev :state) "?") :face (zfs--health-face (plist-get vdev :state))) (vui-text (format "%s/%s/%s" (or (plist-get vdev :read-errors) 0) (or (plist-get vdev :write-errors) 0) (or (plist-get vdev :checksum-errors) 0)) :face 'shadow))) (defun zfs-ui--page-pool (name host) (let ((status (ignore-errors (zfs-cli-pool-status host name)))) (when status (push (cons 'page (list :scrub-start (vui-with-async-context (zfs-ui--do-scrub host name nil)) :scrub-stop (vui-with-async-context (zfs-ui--do-scrub host name t)) :export (vui-with-async-context (zfs-ui--go 'export name)))) zfs-ui--row-actions)) (if (null status) (vui-text (format "Could not read status of %s" name) :face 'error) (let ((state (alist-get 'state status)) (error-count (alist-get 'error_count status)) (scan (alist-get 'scan status)) (vdevs (zfs-cli-pool-vdevs status))) (vui-vstack :spacing 1 (vui-hstack :spacing 2 (vui-heading-3 name) (vui-text state :face (zfs--health-face state))) (vui-muted (if (> (or error-count 0) 0) (format "%d errors — check the devices below" error-count) "No known data errors.")) (vui-text (if scan (format "Scan: %s" (or (alist-get 'state scan) "recorded")) "Scrub: never run here — it reads everything and verifies checksums") :face 'shadow) (vui-text "1 scrub start · 2 scrub stop · x export opens an ack page" :face 'shadow) (vui-vstack :spacing 0 (vui-heading-3 "Devices") (vui-table :sticky-header t :columns '((:header "VDEV" :width 40 :grow t :truncate t) (:header "State" :width 9) (:header "Read/Write/Checksum" :width 20 :align :right)) :rows (mapcar (lambda (vdev) (zfs-ui--vdev-row vdev 0)) vdevs)))))))) (defun zfs-ui--form-row (label content &optional gloss) (vui-hstack (vui-box (vui-text label :face 'shadow) :width 14 :align :right) content (when gloss (vui-hstack (vui-space 2) (vui-text gloss :face 'shadow))))) (defun zfs-ui--page-create (parent host create-status) (push (cons 'page (list :submit (vui-with-async-context (zfs-ui--do-create-dataset host parent)))) zfs-ui--row-actions) (vui-vstack :spacing 1 (vui-heading-3 (format "New dataset inside %s" parent)) (vui-muted "A dataset is a drawer: its own compression, quota and snapshots.") (zfs-ui--form-row "Name" (vui-field :size 24 :key 'create-name :placeholder "music") (format "→ %s/" parent)) (zfs-ui--form-row "Mountpoint" (vui-field :size 24 :key 'create-mountpoint :placeholder (expand-file-name "~/music")) "where it appears; empty = not mounted") (zfs-ui--form-row "Compression" (vui-field :size 24 :key 'create-compression :value "zstd" :placeholder "zstd") "zstd squeezes better, lz4 is faster, off disables") (zfs-ui--form-row "Passphrase" (vui-field :size 24 :key 'create-passphrase :secret t :placeholder "empty = not encrypted") "dataset-level, on top of disk LUKS") (zfs-ui--form-row "Quota" (vui-field :size 24 :key 'create-quota :placeholder "empty = no limit") "e.g. 50G") (zfs-ui--form-row "Move folder in" (vui-field :size 24 :key 'create-move :placeholder "empty = start empty") "rsync copy with progress; original is kept") (vui-hstack (vui-box (vui-text "") :width 14) (vui-button "Create dataset" :on-click (lambda () (zfs-ui--do-create-dataset host parent)))) (when create-status (vui-text (car create-status) :face (cdr create-status))))) (defun zfs-ui--copy-field-width () (max 24 (min 58 (- (window-width) 8)))) (defun zfs-ui--copy-path-field (label key value placeholder) (vui-vstack :spacing 0 (vui-text label :face 'shadow) (vui-field :size (zfs-ui--copy-field-width) :key key :value value :placeholder placeholder :on-change (lambda (next) (vui-batch (vui-set-state key next) (vui-set-state :copy-status nil)))))) (defun zfs-ui--copy-mode-card (mode selected) (let ((entry (assoc mode zfs-ui--copy-modes))) (vui-vstack :spacing 0 (vui-button (format "%s %s" (if (eq mode selected) "●" "○") (cadr entry)) :no-decoration t :face (when (eq mode selected) 'success) :on-click (lambda () (vui-batch (vui-set-state :copy-source (zfs-ui--field-string :copy-source)) (vui-set-state :copy-target (zfs-ui--field-string :copy-target)) (vui-set-state :copy-mode mode) (vui-set-state :copy-status nil)))) (vui-box (vui-text (caddr entry) :face 'shadow) :width (max 24 (min 48 (- (window-width) 8))))))) (defun zfs-ui--page-copy (copy-status &optional copy-mode copy-dry-run copy-source copy-target) (if copy-mode nil (setq copy-mode 'contents)) (push (cons 'page (list :submit (vui-with-async-context (zfs-ui--do-copy copy-mode copy-dry-run copy-source copy-target)))) zfs-ui--row-actions) (vui-vstack :spacing 1 (vui-heading-3 "Copy files") (vui-muted "Preview or transfer files with rsync. Long paths stay on their own lines.") (zfs-ui--copy-path-field "Source" :copy-source copy-source "~/Downloads/media") (zfs-ui--copy-path-field "Target" :copy-target copy-target "/mnt/tank/media") (vui-vstack :spacing 1 (vui-text "Mode" :face 'shadow) (apply #'vui-vstack :spacing 1 (mapcar (lambda (entry) (zfs-ui--copy-mode-card (car entry) copy-mode)) zfs-ui--copy-modes))) (vui-checkbox :checked copy-dry-run :label "Dry run — preview the plan without changing files" :on-change (lambda (value) (vui-batch (vui-set-state :copy-source (zfs-ui--field-string :copy-source)) (vui-set-state :copy-target (zfs-ui--field-string :copy-target)) (vui-set-state :copy-dry-run value) (vui-set-state :copy-status nil)))) (vui-hstack :spacing 2 (vui-button (if copy-dry-run "Preview transfer" "Start transfer") :on-click (lambda () (zfs-ui--do-copy copy-mode copy-dry-run copy-source copy-target))) (vui-text (or (zfs-ui--copy-mode-title copy-mode) "") :face 'shadow)) (when copy-status (vui-text (car copy-status) :face (cdr copy-status))))) (defun zfs-ui--page-admin () (push (cons 'page (list :format (vui-with-async-context (zfs-ui--go 'format)))) zfs-ui--row-actions) (vui-vstack :spacing 1 (vui-heading-3 "Admin actions") (vui-text "These actions live one level away and require typing ack before they run." :face 'warning) (vui-hstack :spacing 2 (vui-button "Format unused disk" :face 'warning :on-click (lambda () (zfs-ui--go 'format)))) (vui-muted "Pool export is on a pool page. Snapshot rollback is on a snapshot row."))) (defun zfs-ui--page-export (pool host risk-status) (push (cons 'page (list :confirm (vui-with-async-context (if (zfs-ui--ack-p 'export-ack) (zfs-ui--do-export host pool) (vui-set-state :risk-status (cons "Type ack to export this pool" 'error)))))) zfs-ui--row-actions) (vui-vstack :spacing 1 (vui-heading-3 (format "Export %s" pool)) (vui-text "Export takes the pool offline for this system until it is imported again." :face 'warning) (zfs-ui--form-row "Confirm" (vui-field :size 10 :key 'export-ack :placeholder "ack") "type ack") (vui-hstack (vui-box (vui-text "") :width 14) (vui-button "Export pool" :face 'warning :on-click (lambda () (if (zfs-ui--ack-p 'export-ack) (zfs-ui--do-export host pool) (vui-set-state :risk-status (cons "Type ack to export this pool" 'error)))))) (when risk-status (vui-text (car risk-status) :face (cdr risk-status))))) (defun zfs-ui--page-rollback (snapshot host risk-status) (push (cons 'page (list :confirm (vui-with-async-context (if (zfs-ui--ack-p 'rollback-ack) (zfs-ui--do-rollback host snapshot) (vui-set-state :risk-status (cons "Type ack to roll back" 'error)))))) zfs-ui--row-actions) (vui-vstack :spacing 1 (vui-heading-3 (format "Rollback to @%s" (zfs--snapshot-leaf snapshot))) (vui-text "This discards live changes made after the snapshot." :face 'warning) (vui-muted "The UI calls plain zfs rollback without -r: if newer snapshots exist, ZFS refuses instead of deleting them.") (zfs-ui--form-row "Confirm" (vui-field :size 10 :key 'rollback-ack :placeholder "ack") "type ack") (vui-hstack (vui-box (vui-text "") :width 14) (vui-button "Rollback" :face 'warning :on-click (lambda () (if (zfs-ui--ack-p 'rollback-ack) (zfs-ui--do-rollback host snapshot) (vui-set-state :risk-status (cons "Type ack to roll back" 'error)))))) (when risk-status (vui-text (car risk-status) :face (cdr risk-status))))) (defun zfs-ui--page-format (format-status) (let ((candidates (zfs-cli-disk-candidates))) (apply #'vui-vstack :spacing 1 (append (list (vui-heading-3 "Format unused disk") (vui-text "Only unused disks are listed here. The next page still requires ack." :face 'warning)) (if candidates (mapcar (lambda (device) (vui-button (format "%s — %s — %s" (plist-get device :name) (or (plist-get device :model) "?") (zfs--format-bytes (plist-get device :size))) :no-decoration t :on-click (lambda () (zfs-ui--go 'format-confirm device)))) candidates) (list (vui-muted "No unused disks found. Plug one in and press g."))) (when format-status (list (vui-text (car format-status) :face (cdr format-status)))))))) (defun zfs-ui--page-format-confirm (device format-status) (vui-vstack :spacing 1 (vui-heading-3 (format "Format %s" (plist-get device :name))) (vui-text (format "%s · %s — all data on it is erased" (or (plist-get device :model) "?") (zfs--format-bytes (plist-get device :size))) :face 'error) (zfs-ui--form-row "Pool name" (vui-field :size 24 :key 'format-pool :placeholder "tank")) (zfs-ui--form-row "Passphrase" (vui-field :size 24 :key 'format-pass :secret t :placeholder "empty = no encryption") "LUKS passphrase; empty leaves the disk unencrypted") (zfs-ui--form-row "Disk name" (vui-field :size 24 :key 'format-confirm :placeholder (plist-get device :name)) "type the disk name") (zfs-ui--form-row "Confirm" (vui-field :size 10 :key 'format-ack :placeholder "ack") "type ack") (vui-hstack (vui-box (vui-text "") :width 14) (vui-button "Format" :face 'error :on-click (lambda () (let ((pool-name (zfs-ui--field-string 'format-pool)) (passphrase (zfs-ui--field-string 'format-pass))) (cond ((string-blank-p pool-name) (vui-set-state :format-status (cons "Pool name is empty" 'error))) ((not (equal (zfs-ui--field-string 'format-confirm) (plist-get device :name))) (vui-set-state :format-status (cons "Type the disk name to confirm" 'error))) ((not (zfs-ui--ack-p 'format-ack)) (vui-set-state :format-status (cons "Type ack to format this disk" 'error))) (t (zfs-ui--do-format device pool-name (not (string-blank-p passphrase)) passphrase))))))) (when format-status (vui-text (car format-status) :face (cdr format-status))))) (defun zfs-ui--page-backup (arg host datasets snaps targets backup-target backup-preview backup-progress backup-done) (let* ((dataset (if (consp arg) (car arg) arg)) (snapshot (if (consp arg) (cdr arg) (car (zfs-ui--newest-snapshot snaps dataset)))) (entry (assoc dataset datasets))) (if (null snapshot) (vui-vstack :spacing 1 (vui-heading-3 (format "Backup %s" dataset)) (vui-text "No snapshots yet — a backup sends a snapshot." :face 'warning) (vui-button "Create one now" :on-click (lambda () (zfs-ui--do-snapshot host dataset)))) (vui-vstack :spacing 1 (vui-heading-3 (format "Backup %s" dataset)) (vui-muted "Sends a snapshot to another machine or pool. After the first full copy only the changes travel.") (vui-hstack (vui-box (vui-text "Snapshot" :face 'shadow) :width 14 :align :right) (vui-text (concat "@" (zfs--snapshot-leaf snapshot))) (vui-space 2) (vui-text (format "(%s)" (zfs--format-ago (zfs-cli-prop (assoc snapshot snaps) 'creation))) :face 'shadow)) (vui-vstack :spacing 0 (vui-hstack (vui-box (vui-text "Target" :face 'shadow) :width 14 :align :right) (vui-text "")) (apply #'vui-vstack :spacing 0 (mapcar (lambda (target) (vui-hstack (vui-box (vui-text "") :width 14) (vui-button (format "%s — %s %s" (plist-get target :name) (or (plist-get target :ssh) "this machine") (plist-get target :dataset)) :no-decoration (not (equal target backup-target)) :face (when (equal target backup-target) 'success) :on-click (lambda () (vui-set-state :backup-target target) (condition-case err (vui-set-state :backup-preview (zfs-ui--backup-preview host dataset snapshot snaps entry target)) (error (vui-set-state :message (cons (format "Preview failed: %s" (error-message-string err)) 'error)))))))) targets))) (vui-hstack (vui-box (vui-text "One-off" :face 'shadow) :width 14 :align :right) (vui-field :size 18 :key 'oneoff-ssh :placeholder "user@host — empty = local") (vui-space 1) (vui-field :size 18 :key 'oneoff-prefix :placeholder "pool/prefix") (vui-space 1) (vui-button "Use once" :on-click (lambda () (let ((prefix (zfs-ui--field-string 'oneoff-prefix))) (if (string-blank-p prefix) (vui-set-state :message (cons "One-off target needs a dataset prefix" 'error)) (let ((target (list :name "one-off" :dataset prefix)) (ssh (zfs-ui--field-string 'oneoff-ssh))) (unless (string-blank-p ssh) (setq target (append target (list :ssh ssh)))) (vui-set-state :backup-target target) (condition-case err (vui-set-state :backup-preview (zfs-ui--backup-preview host dataset snapshot snaps entry target)) (error (vui-set-state :message (cons (format "Preview failed: %s" (error-message-string err)) 'error)))))))))) (when backup-target (vui-hstack (vui-box (vui-text "Will send" :face 'shadow) :width 14 :align :right) (if backup-preview (vui-text (format "%s · %s%s" (if (equal (plist-get backup-preview :kind) "incremental") (format "only changes since @%s" (zfs--snapshot-leaf (plist-get backup-preview :base))) "everything (first time)") (zfs--format-bytes (plist-get backup-preview :bytes)) (if (plist-get backup-preview :raw) " · stays encrypted" ""))) (vui-text "…" :face 'shadow)))) (when (and backup-target backup-preview (not backup-progress) (not backup-done)) (vui-hstack (vui-box (vui-text "") :width 14) (vui-button "Start backup" :on-click (lambda () (zfs-ui--start-backup host snapshot backup-target backup-preview))))) (when backup-progress (vui-hstack (vui-box (vui-text "Sending" :face 'shadow) :width 14 :align :right) (vui-text backup-progress :face 'shadow))) (when backup-done (vui-hstack (vui-box (vui-text "") :width 14) (if (eq backup-done 'success) (vui-text "Backup complete." :face 'success) (vui-text (format "Backup failed: %s" backup-done) :face 'error)))))))) (defun zfs-ui--page-targets (targets) (push (cons 'page (list :add (vui-with-async-context (let ((name (zfs-ui--field-string 'target-name)) (ssh (zfs-ui--field-string 'target-ssh)) (prefix (zfs-ui--field-string 'target-prefix))) (if (or (string-blank-p name) (string-blank-p prefix)) (vui-set-state :message (cons "Name and dataset prefix are required" 'error)) (let ((new (list :name name :dataset prefix))) (unless (string-blank-p ssh) (setq new (append new (list :ssh ssh)))) (let ((updated (append targets (list new)))) (zfs-ui--targets-save updated) (vui-set-state :targets updated) (vui-set-state :message (cons (format "Target %s saved to %s" name zfs-targets-file) 'success))))))))) zfs-ui--row-actions) (apply #'vui-vstack :spacing 1 (append (list (vui-heading-3 "Backup targets") (vui-muted (format "Stored as plain elisp data in %s — edit by hand or here." zfs-targets-file))) (if targets (list (vui-table :sticky-header t :columns '((:header "Name" :width 16 :grow t :truncate t) (:header "Host" :width 24 :grow t :truncate t) (:header "Dataset prefix" :width 32 :grow t :truncate t)) :rows (mapcar (lambda (target) (list (vui-text (plist-get target :name)) (vui-text (or (plist-get target :ssh) "this machine") :face 'shadow) (vui-text (plist-get target :dataset) :face 'shadow))) targets))) (list (vui-muted "No targets yet — add one below."))) (list (vui-vstack :spacing 1 (vui-heading-3 "Add target") (zfs-ui--form-row "Name" (vui-field :size 24 :key 'target-name :placeholder "interserver")) (zfs-ui--form-row "SSH" (vui-field :size 24 :key 'target-ssh :placeholder "user@host — empty = this machine")) (zfs-ui--form-row "Dataset prefix" (vui-field :size 24 :key 'target-prefix :placeholder "backuppool/mainframe") "must exist on the target; the dataset's leaf name is appended") (vui-hstack (vui-box (vui-text "") :width 14) (vui-button "Save target" :on-click (lambda () (when-let* ((actions (cdr (assoc 'page zfs-ui--row-actions))) (fn (plist-get actions :add))) (funcall fn)))))))))) (vui-defcomponent zfs-app () :state ((page 'overview) (page-arg nil) (host nil) (pools nil) (datasets nil) (snaps nil) (locked nil) (targets (zfs-ui--targets-load)) (loading t) (message nil) (refreshed nil) (backup-target nil) (backup-preview nil) (backup-progress nil) (backup-done nil) (create-status nil) (copy-status nil) (copy-mode 'contents) (copy-dry-run t) (copy-source "") (copy-target "") (risk-status nil) (format-status nil)) :render (progn (vui-use-effect () (zfs-ui--refresh host) nil) (setq zfs-ui--row-actions nil) (setq zfs-ui--refresh-fn (vui-with-async-context (zfs-ui--refresh host))) (setq zfs-ui--back-action (vui-with-async-context (if (eq page 'overview) (vui-quit) (zfs-ui--go 'overview)))) (let ((content (cond (loading (vui-text "Loading…" :face 'shadow)) ((eq page 'overview) (zfs-ui--page-overview (or pools nil) (or datasets nil) (or snaps nil) locked)) ((eq page 'dataset) (zfs-ui--page-dataset page-arg host datasets snaps)) ((eq page 'pool) (zfs-ui--page-pool page-arg host)) ((eq page 'create) (zfs-ui--page-create page-arg host create-status)) ((eq page 'copy) (zfs-ui--page-copy copy-status copy-mode copy-dry-run copy-source copy-target)) ((eq page 'admin) (zfs-ui--page-admin)) ((eq page 'export) (zfs-ui--page-export page-arg host risk-status)) ((eq page 'rollback) (zfs-ui--page-rollback page-arg host risk-status)) ((eq page 'format) (zfs-ui--page-format format-status)) ((eq page 'format-confirm) (zfs-ui--page-format-confirm page-arg format-status)) ((eq page 'backup) (zfs-ui--page-backup page-arg host datasets snaps targets backup-target backup-preview backup-progress backup-done)) ((eq page 'targets) (zfs-ui--page-targets targets)) (t (vui-text "unknown page" :face 'error))))) (vui-vstack :spacing 1 (vui-flex :width 'window :justify :space-between (vui-hstack :spacing 2 (vui-heading-2 "ZFS") (vui-text (cond ((eq page 'overview) (if host (format "on %s" (plist-get host :name)) "on this machine")) (t (format "› %s" (if (symbolp page) (symbol-name page) page)))) :face 'shadow)) (vui-text (format "%s pools · refreshed %s" (length pools) (or refreshed "—")) :face 'shadow)) (if message (vui-text (car message) :face (cdr message)) (vui-text " ")) content (vui-text (pcase page ('overview "j/k move · RET/l open · C copy · A admin · u unlock · T targets · g refresh · ? help · q quit") ('dataset "h/q back · s snapshot · b backup · c new dataset · d diff · R rollback · g refresh") ('pool "h/q back · 1 scrub start · 2 scrub stop · x export · g refresh") ('backup "h/q back · choose a target · g refresh") (_ "h/q back · g refresh · ? help")) :face 'shadow))))) (defun zfs-ui--key-on-line () (save-excursion (beginning-of-line) (let ((end (line-end-position)) (found nil)) (while (and (<= (point) end) (not found)) (setq found (vui-key-at)) (forward-char 1)) found))) (defun zfs-ui--invoke (action) (let* ((key (zfs-ui--key-on-line)) (row (and key (cdr (assoc key zfs-ui--row-actions)))) (page (cdr (assoc 'page zfs-ui--row-actions)))) (cond ((plist-get row action) (funcall (plist-get row action))) ((and (eq action :open) (plist-get row :open)) (funcall (plist-get row :open))) ((plist-get page action) (funcall (plist-get page action))) (t (message "Nothing here for that key"))))) (define-derived-mode zfs-mode vui-mode "ZFS" (hl-line-mode 1)) (defun zfs-ui-open () (interactive) (or (vui-activate) (zfs-ui--invoke :open))) (defun zfs-ui-back () (interactive) (if zfs-ui--back-action (funcall zfs-ui--back-action) (zfs-ui--invoke :back))) (defun zfs-ui-refresh () (interactive) (when zfs-ui--refresh-fn (funcall zfs-ui--refresh-fn))) (defun zfs-ui-snapshot () (interactive) (zfs-ui--invoke :snapshot)) (defun zfs-ui-backup () (interactive) (zfs-ui--invoke :backup)) (defun zfs-ui-create-child () (interactive) (zfs-ui--invoke :create-child)) (defun zfs-ui-copy () (interactive) (zfs-ui--invoke :copy)) (defun zfs-ui-admin () (interactive) (zfs-ui--invoke :admin)) (defun zfs-ui-diff () (interactive) (zfs-ui--invoke :diff)) (defun zfs-ui-rollback () (interactive) (zfs-ui--invoke :rollback)) (defun zfs-ui-mount () (interactive) (zfs-ui--invoke :mount)) (defun zfs-ui-unlock () (interactive) (zfs-ui--invoke :unlock)) (defun zfs-ui-import () (interactive) (zfs-ui--invoke :import)) (defun zfs-ui-targets () (interactive) (zfs-ui--invoke :targets)) (defun zfs-ui-format () (interactive) (zfs-ui--invoke :format)) (defun zfs-ui-export () (interactive) (zfs-ui--invoke :export)) (defun zfs-ui-scrub-start () (interactive) (zfs-ui--invoke :scrub-start)) (defun zfs-ui-scrub-stop () (interactive) (zfs-ui--invoke :scrub-stop)) (defun zfs-ui-help () "Show keyboard help for the ZFS interface." (interactive) (message "ZFS: j/k move, TAB/S-TAB elements, RET/l activate, h/q back or close, g refresh, s snapshot, b backup, C copy, A admin, ? help")) (define-key zfs-mode-map (kbd "RET") #'zfs-ui-open) (define-key zfs-mode-map (kbd "") #'zfs-ui-open) (define-key zfs-mode-map (kbd "l") #'zfs-ui-open) (define-key zfs-mode-map (kbd "j") #'next-line) (define-key zfs-mode-map (kbd "k") #'previous-line) (define-key zfs-mode-map (kbd "TAB") #'vui-forward) (define-key zfs-mode-map (kbd "") #'vui-backward) (define-key zfs-mode-map (kbd "q") #'zfs-ui-back) (define-key zfs-mode-map (kbd "h") #'zfs-ui-back) (define-key zfs-mode-map (kbd "") #'zfs-ui-back) (define-key zfs-mode-map (kbd "DEL") #'zfs-ui-back) (define-key zfs-mode-map (kbd "") #'zfs-ui-back) (define-key zfs-mode-map (kbd "g") #'zfs-ui-refresh) (define-key zfs-mode-map (kbd "r") #'zfs-ui-refresh) (define-key zfs-mode-map (kbd "s") #'zfs-ui-snapshot) (define-key zfs-mode-map (kbd "b") #'zfs-ui-backup) (define-key zfs-mode-map (kbd "c") #'zfs-ui-create-child) (define-key zfs-mode-map (kbd "C") #'zfs-ui-copy) (define-key zfs-mode-map (kbd "A") #'zfs-ui-admin) (define-key zfs-mode-map (kbd "d") #'zfs-ui-diff) (define-key zfs-mode-map (kbd "R") #'zfs-ui-rollback) (define-key zfs-mode-map (kbd "m") #'zfs-ui-mount) (define-key zfs-mode-map (kbd "u") #'zfs-ui-unlock) (define-key zfs-mode-map (kbd "i") #'zfs-ui-import) (define-key zfs-mode-map (kbd "T") #'zfs-ui-targets) (define-key zfs-mode-map (kbd "F") #'zfs-ui-format) (define-key zfs-mode-map (kbd "x") #'zfs-ui-export) (define-key zfs-mode-map (kbd "1") #'zfs-ui-scrub-start) (define-key zfs-mode-map (kbd "2") #'zfs-ui-scrub-stop) (define-key zfs-mode-map (kbd "?") #'zfs-ui-help) (with-eval-after-load 'evil (evil-set-initial-state 'zfs-mode 'normal) (evil-define-key* '(normal motion) zfs-mode-map (kbd "RET") #'zfs-ui-open (kbd "") #'zfs-ui-open (kbd "l") #'zfs-ui-open (kbd "j") #'next-line (kbd "k") #'previous-line (kbd "q") #'zfs-ui-back (kbd "h") #'zfs-ui-back (kbd "") #'zfs-ui-back (kbd "DEL") #'zfs-ui-back (kbd "") #'zfs-ui-back (kbd "g") #'zfs-ui-refresh (kbd "r") #'zfs-ui-refresh (kbd "s") #'zfs-ui-snapshot (kbd "b") #'zfs-ui-backup (kbd "c") #'zfs-ui-create-child (kbd "C") #'zfs-ui-copy (kbd "A") #'zfs-ui-admin (kbd "d") #'zfs-ui-diff (kbd "R") #'zfs-ui-rollback (kbd "m") #'zfs-ui-mount (kbd "u") #'zfs-ui-unlock (kbd "i") #'zfs-ui-import (kbd "T") #'zfs-ui-targets (kbd "F") #'zfs-ui-format (kbd "x") #'zfs-ui-export (kbd "1") #'zfs-ui-scrub-start (kbd "2") #'zfs-ui-scrub-stop (kbd "?") #'zfs-ui-help)) ;;;###autoload (defun zfs () (interactive) (let ((buffer (get-buffer-create zfs-buffer-name))) (with-current-buffer buffer (unless (eq major-mode 'zfs-mode) (zfs-mode) (vui-mount (vui-component 'zfs-app) buffer) (vui-rerender-on-resize))) (pop-to-buffer buffer))) (provide 'zfs) ;;; zfs.el ends here