summaryrefslogtreecommitdiff
path: root/lisp/sync-ui.el
diff options
context:
space:
mode:
authorcashmere <cashmere@autistici.org>2026-08-01 17:56:16 +0200
committercashmere <cashmere@autistici.org>2026-08-01 17:56:16 +0200
commit7dfbbebd45812d0176af3fc885972625dc2df132 (patch)
tree3187be170c70c9d933134e4b3f4004493b0fa681 /lisp/sync-ui.el
parent99457f838fc07d0c5c5fb43e692d67c39edde4c8 (diff)
downloademacs-7dfbbebd45812d0176af3fc885972625dc2df132.tar.gz
md: add sync-ui.el
Diffstat (limited to 'lisp/sync-ui.el')
-rw-r--r--lisp/sync-ui.el948
1 files changed, 948 insertions, 0 deletions
diff --git a/lisp/sync-ui.el b/lisp/sync-ui.el
new file mode 100644
index 0000000..e8ee3d7
--- /dev/null
+++ b/lisp/sync-ui.el
@@ -0,0 +1,948 @@
+;;; sync-ui.el --- Rougier-style git sync dashboard -*- lexical-binding: t -*-
+
+;; Copyright (C) 2026 cashmere
+
+;; Author: cashmere
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "28.1"))
+;; Keywords: vc, tools
+
+;;; Commentary:
+
+;; A keyboard-first, Rougier-style dashboard for keeping a set of git
+;; repos committed, rebased and pushed to all of their (redundant)
+;; remotes. Sync is manual: `s' runs one cycle.
+;;
+;; AUTO repos commit everything dirty with a "host: ISO8601" message
+;; and push without asking. ASK repos prompt once per cycle; a yes
+;; zaps you to magit, and `r' in the dashboard resumes (push) once a
+;; new commit exists. Pulls are `git rebase --autostash'; a conflict
+;; aborts the rebase, marks the repo CONFLICTED and leaves it alone.
+;;
+;; Archetype: flat stream with per-item state -> state-glyph rail
+;; over two-line cards (framework S3 + S5 + S10). The rail owns the
+;; left edge: filled chips carry the dirty count and the state, the
+;; `┊' gutter keeps it unbroken between cards. Faces are
+;; theme-agnostic (recipe 0); the only fixed hues are the AUTO/ASK
+;; category pills, which are brand colors by design.
+;;
+;; Keys (dashboard):
+;; s sync all RET magit r resume x skip
+;; t auto/ask a add repo d remove g refresh
+;; n/p next/prev q quit
+;;
+;; Evil: normal state gets j/k plus the same one-key actions.
+
+;;; Code:
+
+(require 'cl-lib)
+
+;;; § 1 Faces (theme-agnostic, recipe 0)
+
+(defface sync-ui-strong '((t :inherit bold))
+ "Structural text: repo names, title."
+ :group 'sync-ui)
+
+(defface sync-ui-faded '((t :inherit shadow))
+ "Secondary text: paths, metadata, hints."
+ :group 'sync-ui)
+
+(defface sync-ui-salient '((t :inherit link))
+ "Attention: repo names, unpushed counts."
+ :group 'sync-ui)
+
+(defface sync-ui-popout '((t :inherit (font-lock-warning-face bold)))
+ "The second hue: repos that need a decision, incoming commits."
+ :group 'sync-ui)
+
+(defface sync-ui-critical '((t :inherit (error bold)))
+ "Conflicts and errors. Used scarcely."
+ :group 'sync-ui)
+
+(defface sync-ui-chip '((t :inherit bold :inverse-video t))
+ "Rail chip, structural dark: dirty auto repo, freshly synced."
+ :group 'sync-ui)
+
+(defface sync-ui-chip-i '((t :inherit shadow :inverse-video t))
+ "Rail chip, quiet: clean repo."
+ :group 'sync-ui)
+
+(defface sync-ui-chip-active '((t :inherit link :inverse-video t))
+ "Rail chip while a sync step runs."
+ :group 'sync-ui)
+
+(defface sync-ui-chip-popout '((t :inherit (font-lock-warning-face bold) :inverse-video t))
+ "Rail chip for a repo that needs a decision (dirty ask repo, waiting)."
+ :group 'sync-ui)
+
+(defface sync-ui-chip-critical '((t :inherit (error bold) :inverse-video t))
+ "Rail chip for conflict/error."
+ :group 'sync-ui)
+
+(defface sync-ui-pill-auto '((t :background "#3a7d5d" :foreground "#ffffff"))
+ "Category pill for AUTO mode. Brand hue, white text, theme-stable."
+ :group 'sync-ui)
+
+(defface sync-ui-pill-ask '((t :background "#7451a6" :foreground "#ffffff"))
+ "Category pill for ASK mode. Brand hue, white text, theme-stable."
+ :group 'sync-ui)
+
+(defface sync-ui-selected '((t :inherit bold :inverse-video t))
+ "Selected card (hl-line remap target). Pure inverse: always theme-fresh."
+ :group 'sync-ui)
+
+(defface sync-ui-hairline
+ '((t :inherit default :strike-through t :overline nil :underline nil
+ :height 1.0 :extend t))
+ "Full-width rule drawn by a strike-through newline."
+ :group 'sync-ui)
+
+;;; § 2 Customs
+
+(defgroup sync-ui nil
+ "Dashboard for manual autosync/autopush of git repos."
+ :group 'applications
+ :prefix "sync-ui-")
+
+(defcustom sync-ui-repos
+ '(("~/org" . auto)
+ ("~/.claude/skills" . auto)
+ ("~/pass" . auto)
+ ("~/nix" . ask)
+ ("~/.emacs.d" . ask))
+ "Alist of (PATH . MODE) for managed repos.
+MODE `auto' commits and pushes without prompting; MODE `ask' offers a
+magit detour first. Edit from the dashboard with `a', `d' and `t'."
+ :type '(alist :key-type directory
+ :value-type (choice (const auto) (const ask)))
+ :group 'sync-ui)
+
+(defcustom sync-ui-hostname
+ (car (split-string (system-name) "\\."))
+ "Host label used in auto-commit messages."
+ :type 'string
+ :group 'sync-ui)
+
+;;; § 3 Data layer
+
+(cl-defstruct (sync-ui--repo (:constructor sync-ui--repo-create))
+ id path mode (state 'clean) (dirty 0) branch head head-at-wait upstream
+ remotes last-sync message process)
+
+(defvar sync-ui--repos nil
+ "Live list of `sync-ui--repo' structs, in display order.")
+
+(defconst sync-ui--buffer-name "*sync*")
+
+(defun sync-ui--load-registry ()
+ "Build `sync-ui--repos' from `sync-ui-repos'."
+ (setq sync-ui--repos
+ (mapcar (lambda (entry)
+ (sync-ui--repo-create
+ :id (expand-file-name (car entry))
+ :path (abbreviate-file-name (expand-file-name (car entry)))
+ :mode (cdr entry)))
+ sync-ui-repos)))
+
+(defun sync-ui--find (id)
+ "Repo struct with ID, or nil."
+ (cl-find id sync-ui--repos :key #'sync-ui--repo-id :test #'equal))
+
+(defun sync-ui--save-repos ()
+ "Persist the live registry back to `sync-ui-repos' via customize."
+ (customize-save-variable
+ 'sync-ui-repos
+ (mapcar (lambda (repo)
+ (cons (sync-ui--repo-path repo) (sync-ui--repo-mode repo)))
+ sync-ui--repos)))
+
+;;; § 4 Git engine
+
+;; Local operations (status, rev-parse, commit) run synchronously —
+;; they are sub-second. Network operations (fetch, rebase onto a
+;; fetched ref, push) run as async process chains so the dashboard
+;; stays live and shows per-step states.
+
+(defun sync-ui--git (repo args)
+ "Run git ARGS synchronously in REPO's directory.
+Return (EXIT-CODE OUTPUT). Never signals: a missing directory or a
+missing git binary becomes a non-zero exit code."
+ (with-temp-buffer
+ (list (condition-case nil
+ (apply #'call-process "git" nil t nil
+ "-C" (sync-ui--repo-id repo) args)
+ (error 127))
+ (buffer-string))))
+
+(defun sync-ui--git-async (repo args on-done)
+ "Run git ARGS asynchronously in REPO's directory.
+ON-DONE is called with (EXIT-CODE OUTPUT). One process per repo at a
+time; the caller's state machine guarantees that."
+ (let ((buf (generate-new-buffer
+ (format " *sync-ui:%s*" (sync-ui--repo-path repo)))))
+ (setf (sync-ui--repo-process repo)
+ (make-process
+ :name (format "sync-ui:%s" (sync-ui--repo-path repo))
+ :buffer buf
+ :command (append (list "git" "-C" (sync-ui--repo-id repo)) args)
+ :noquery t
+ :sentinel
+ (lambda (proc _event)
+ (when (memq (process-status proc) '(exit signal))
+ (let ((code (process-exit-status proc))
+ (out (with-current-buffer (process-buffer proc)
+ (buffer-string))))
+ (kill-buffer (process-buffer proc))
+ (setf (sync-ui--repo-process repo) nil)
+ (funcall on-done code out))))))))
+
+(defun sync-ui--trim (string)
+ (if (stringp string) (string-trim string) ""))
+
+(defun sync-ui--remote-names (repo)
+ "Names of REPO's configured remotes that actually have a URL.
+A bare [remote \"x\"] section in any config file (e.g. global gcrypt
+keys) makes `git remote' list x in every repository; get-url filters
+those phantoms out."
+ (pcase-let ((`(,code ,out) (sync-ui--git repo '("remote"))))
+ (if (zerop code)
+ (cl-remove-if-not
+ (lambda (name)
+ (zerop (car (sync-ui--git repo (list "remote" "get-url" name)))))
+ (cl-remove-if #'string-empty-p (split-string out "\n")))
+ nil)))
+
+(defun sync-ui--primary-remote (repo)
+ "\"origin\" when present, else the first remote."
+ (let ((names (mapcar #'car (sync-ui--repo-remotes repo))))
+ (if (member "origin" names) "origin" (car names))))
+
+(defun sync-ui--ref-exists-p (repo ref)
+ "Non-nil when REF resolves in REPO."
+ (zerop (car (sync-ui--git repo (list "rev-parse" "--verify" "--quiet" ref)))))
+
+(defun sync-ui--probe-remotes (repo names)
+ "Per-remote (NAME AHEAD BEHIND) triples against the current branch.
+AHEAD/BEHIND are nil when the remote has no branch to compare with."
+ (let ((branch (sync-ui--repo-branch repo)))
+ (mapcar
+ (lambda (name)
+ (if (and branch
+ (not (string= branch "HEAD"))
+ (sync-ui--ref-exists-p repo (concat name "/" branch)))
+ (pcase-let ((`(,code ,out)
+ (sync-ui--git repo
+ (list "rev-list" "--left-right" "--count"
+ (format "%s/%s...HEAD" name branch)))))
+ (if (zerop code)
+ (pcase-let ((`(,left ,right) (split-string out)))
+ (list name (string-to-number right) (string-to-number left)))
+ (list name nil nil)))
+ (list name nil nil)))
+ names)))
+
+(defun sync-ui--probe (repo &optional force)
+ "Local-only refresh of REPO: dirty count, branch, head, upstream, remotes.
+State is recomputed only when FORCE, or when the repo is not waiting
+and no sync step is running."
+ (cond
+ ((not (file-directory-p (sync-ui--repo-id repo)))
+ (setf (sync-ui--repo-state repo) 'missing
+ (sync-ui--repo-message repo) "directory gone"))
+ ((not (sync-ui--ref-exists-p repo "HEAD"))
+ (pcase-let ((`(,code ,_out) (sync-ui--git repo '("rev-parse" "--git-dir"))))
+ (if (not (zerop code))
+ (setf (sync-ui--repo-state repo) 'missing
+ (sync-ui--repo-message repo) "not a git repository")
+ (setf (sync-ui--repo-state repo) 'missing
+ (sync-ui--repo-message repo) "no commits yet"))))
+ (t
+ (setf (sync-ui--repo-branch repo)
+ (sync-ui--trim (cadr (sync-ui--git repo '("rev-parse" "--abbrev-ref" "HEAD"))))
+ (sync-ui--repo-head repo)
+ (sync-ui--trim (cadr (sync-ui--git repo '("rev-parse" "HEAD"))))
+ (sync-ui--repo-dirty repo)
+ (length (cl-remove-if #'string-empty-p
+ (split-string
+ (cadr (sync-ui--git repo '("status" "--porcelain")))
+ "\n")))
+ (sync-ui--repo-upstream repo)
+ (pcase-let ((`(,code ,out)
+ (sync-ui--git repo '("rev-parse" "--abbrev-ref"
+ "--symbolic-full-name" "@{u}"))))
+ (and (zerop code) (sync-ui--trim out)))
+ (sync-ui--repo-remotes repo)
+ (sync-ui--probe-remotes repo (sync-ui--remote-names repo)))
+ (when (or force
+ (not (memq (sync-ui--repo-state repo)
+ '(waiting committing fetching rebasing pushing))))
+ (setf (sync-ui--repo-state repo)
+ (if (> (sync-ui--repo-dirty repo) 0) 'dirty 'clean)
+ (sync-ui--repo-message repo) nil)))))
+
+(defun sync-ui--set-state (repo state &optional message)
+ "Move REPO to STATE with MESSAGE and repaint its card."
+ (setf (sync-ui--repo-state repo) state
+ (sync-ui--repo-message repo) message)
+ (sync-ui--update-card repo))
+
+(defun sync-ui--fail (repo step out)
+ "Mark REPO as failed during STEP; OUT is git's output."
+ (let* ((lines (cl-remove-if #'string-empty-p (split-string out "\n")))
+ (line (or (cl-find-if (lambda (l) (string-match-p "error:\|fatal:\|! \\[" l))
+ lines)
+ (car lines))))
+ (sync-ui--set-state
+ repo 'error
+ (truncate-string-to-width
+ (format "%s: %s" step
+ (replace-regexp-in-string
+ "\\`\\(fatal\\|error\\): *" "" (or line "failed")))
+ 60 nil nil "…"))))
+
+(defun sync-ui--commit-message ()
+ "Auto-commit message: \"host: ISO8601 with colon zone\"."
+ (format "%s: %s" sync-ui-hostname
+ (format-time-string "%Y-%m-%dT%H:%M:%S%:z")))
+
+(defun sync-ui--commit-all (repo)
+ "Stage everything in REPO and commit. Return non-nil on success."
+ (sync-ui--set-state repo 'committing)
+ (sync-ui--git repo '("add" "-A"))
+ (pcase-let ((`(,code ,out)
+ (sync-ui--git repo (list "commit" "-m" (sync-ui--commit-message)))))
+ (if (or (zerop code) (string-match-p "nothing to commit" out))
+ (progn
+ (setf (sync-ui--repo-head repo)
+ (sync-ui--trim (cadr (sync-ui--git repo '("rev-parse" "HEAD")))))
+ t)
+ (sync-ui--fail repo "commit" out)
+ nil)))
+
+(defun sync-ui--behind-count (repo onto)
+ "Commits in ONTO that are not in HEAD."
+ (pcase-let ((`(,code ,out)
+ (sync-ui--git repo (list "rev-list" "--count"
+ (format "HEAD..%s" onto)))))
+ (if (zerop code) (string-to-number (sync-ui--trim out)) 0)))
+
+(defun sync-ui--fetch-step (repo remotes on-done &optional quiet)
+ "Fetch each of REMOTES in turn, then call ON-DONE.
+Fetching explicitly by name (never `fetch --all') keeps phantom
+remotes from global config out of the cycle. In QUIET mode a failed
+fetch is skipped instead of failing the repo."
+ (if (null remotes)
+ (funcall on-done)
+ (unless quiet
+ (sync-ui--set-state repo 'fetching (format "fetching %s…" (car remotes))))
+ (sync-ui--git-async
+ repo (list "fetch" "--quiet" (car remotes))
+ (lambda (code out)
+ (if (and (not quiet) (not (zerop code)))
+ (sync-ui--fail repo "fetch" out)
+ (sync-ui--fetch-step repo (cdr remotes) on-done quiet))))))
+
+(defun sync-ui--network-sync (repo)
+ "Fetch, rebase if behind, then push every remote of REPO."
+ (cond
+ ((or (null (sync-ui--repo-branch repo))
+ (string= (sync-ui--repo-branch repo) "HEAD"))
+ (sync-ui--set-state repo 'error "detached HEAD — push skipped"))
+ ((null (sync-ui--repo-remotes repo))
+ (sync-ui--set-state repo 'clean "no remotes — nothing to push"))
+ (t
+ (sync-ui--fetch-step repo (mapcar #'car (sync-ui--repo-remotes repo))
+ (lambda ()
+ (sync-ui--probe repo)
+ (sync-ui--update-card repo)
+ (sync-ui--rebase-step repo))))))
+
+(defun sync-ui--rebase-step (repo)
+ "Rebase REPO onto its upstream (or primary remote branch) when behind.
+A conflict aborts the rebase and marks the repo conflicted; the
+working tree is left exactly as the fetch found it."
+ (let* ((branch (sync-ui--repo-branch repo))
+ (primary (sync-ui--primary-remote repo))
+ (onto (or (sync-ui--repo-upstream repo)
+ (and primary
+ (sync-ui--ref-exists-p repo (concat primary "/" branch))
+ (concat primary "/" branch))))
+ (behind (and onto (sync-ui--behind-count repo onto))))
+ (if (and onto (> behind 0))
+ (progn
+ (sync-ui--set-state repo 'rebasing (format "rebasing onto %s…" onto))
+ (sync-ui--git-async
+ repo (list "rebase" "--autostash" onto)
+ (lambda (code out)
+ (if (not (zerop code))
+ (progn
+ (sync-ui--git repo '("rebase" "--abort"))
+ (if (string-match-p "[Cc]onflict" out)
+ (sync-ui--set-state
+ repo 'conflicted
+ (format "conflict onto %s — resolve in magit, then s" onto))
+ (sync-ui--fail repo "rebase" out)))
+ (sync-ui--probe repo)
+ (sync-ui--push-step repo (mapcar #'car (sync-ui--repo-remotes repo)))))))
+ (sync-ui--push-step repo (mapcar #'car (sync-ui--repo-remotes repo))))))
+
+(defun sync-ui--push-step (repo remotes)
+ "Push the current branch to each of REMOTES, in order.
+A repo without upstream gets `push --set-upstream' on the primary
+remote first. A rejection stops the chain; nothing is forced."
+ (if (null remotes)
+ (sync-ui--finish repo)
+ (let* ((remote (car remotes))
+ (branch (sync-ui--repo-branch repo))
+ (args (if (and (null (sync-ui--repo-upstream repo))
+ (string= remote (sync-ui--primary-remote repo)))
+ (list "push" "--set-upstream" remote (format "HEAD:%s" branch))
+ (list "push" remote (format "HEAD:%s" branch)))))
+ (sync-ui--set-state repo 'pushing (format "pushing %s…" remote))
+ (sync-ui--git-async
+ repo args
+ (lambda (code out)
+ (if (not (zerop code))
+ (sync-ui--fail repo (format "push %s" remote) out)
+ (sync-ui--probe repo)
+ (sync-ui--push-step repo (cdr remotes))))))))
+
+(defun sync-ui--finish (repo)
+ "End of a sync cycle for REPO: re-probe and mark the outcome."
+ (sync-ui--probe repo t)
+ (when (eq (sync-ui--repo-state repo) 'clean)
+ (setf (sync-ui--repo-state repo) 'synced
+ (sync-ui--repo-last-sync repo) (current-time)))
+ (sync-ui--update-card repo))
+
+(defun sync-ui--sync-one (repo)
+ "One sync cycle for REPO, honouring its mode."
+ (cond
+ ((or (sync-ui--repo-process repo)
+ (memq (sync-ui--repo-state repo) '(waiting missing)))
+ nil)
+ ((and (eq (sync-ui--repo-mode repo) 'ask)
+ (> (sync-ui--repo-dirty repo) 0))
+ (if (y-or-n-p (format "%s: %d unstaged — commit something in magit? "
+ (sync-ui--repo-path repo)
+ (sync-ui--repo-dirty repo)))
+ (progn
+ (setf (sync-ui--repo-head-at-wait repo) (sync-ui--repo-head repo))
+ (sync-ui--set-state repo 'waiting "commit in magit — r resumes · x skips")
+ (sync-ui--open-magit repo))
+ (sync-ui--set-state repo 'dirty "skipped this cycle")))
+ ((and (> (sync-ui--repo-dirty repo) 0)
+ (not (sync-ui--commit-all repo)))
+ nil)
+ (t
+ (sync-ui--network-sync repo))))
+
+(defun sync-ui-sync-all ()
+ "Run one sync cycle over every repo."
+ (interactive)
+ (unless sync-ui--repos (sync-ui--load-registry))
+ (mapc #'sync-ui--probe sync-ui--repos)
+ (mapc #'sync-ui--update-card sync-ui--repos)
+ (mapc #'sync-ui--sync-one sync-ui--repos))
+
+(defun sync-ui-resume ()
+ "Resume the waiting repo at point: push once a new commit exists."
+ (interactive)
+ (let ((repo (sync-ui--repo-at-point)))
+ (cond
+ ((null repo)
+ (user-error "No repo at point"))
+ ((not (eq (sync-ui--repo-state repo) 'waiting))
+ (user-error "%s is not waiting" (sync-ui--repo-path repo)))
+ (t
+ (sync-ui--probe repo)
+ (sync-ui--update-card repo)
+ (if (equal (sync-ui--repo-head repo) (sync-ui--repo-head-at-wait repo))
+ (message "%s: no new commit yet — commit in magit, then r"
+ (sync-ui--repo-path repo))
+ (sync-ui--network-sync repo))))))
+
+(defun sync-ui-skip ()
+ "Take the waiting repo at point out of the cycle; it will ask again."
+ (interactive)
+ (let ((repo (sync-ui--repo-at-point)))
+ (cond
+ ((null repo)
+ (user-error "No repo at point"))
+ ((not (eq (sync-ui--repo-state repo) 'waiting))
+ (user-error "%s is not waiting" (sync-ui--repo-path repo)))
+ (t
+ (sync-ui--set-state
+ repo (if (> (sync-ui--repo-dirty repo) 0) 'dirty 'clean)
+ "skipped — asks again next sync")))))
+
+(defun sync-ui-refresh ()
+ "Re-probe every repo and fetch in the background to update ↑/↓ counts."
+ (interactive)
+ (unless sync-ui--repos (sync-ui--load-registry))
+ (mapc #'sync-ui--probe sync-ui--repos)
+ (sync-ui--render)
+ (dolist (repo sync-ui--repos)
+ (when (and (not (sync-ui--repo-process repo))
+ (not (eq (sync-ui--repo-state repo) 'missing)))
+ (sync-ui--fetch-step repo (mapcar #'car (sync-ui--repo-remotes repo))
+ (lambda ()
+ (sync-ui--probe repo)
+ (sync-ui--update-card repo))
+ t))))
+
+;;; § 5 Layout primitives
+
+(defconst sync-ui--symbols
+ '((ok . ("ok" . "✓"))
+ (bad . ("XX" . "✗"))
+ (void . ("--" . "∅"))
+ (gutter . ("|" . "┊"))
+ (up . ("^" . "↑"))
+ (down . ("v" . "↓"))
+ (new . ("+" . "⁺"))
+ (busy . ("~" . "…")))
+ "State glyphs: (ASCII-fallback . preferred).")
+
+(defun sync-ui--symbol (name)
+ "Glyph for NAME, degrading to ASCII when undisplayable."
+ (let ((pair (alist-get name sync-ui--symbols)))
+ (if (and (cdr pair) (char-displayable-p (aref (cdr pair) 0)))
+ (cdr pair)
+ (car pair))))
+
+(defun sync-ui--width ()
+ "Render width: the dashboard window when visible, else 80."
+ (if-let* ((win (get-buffer-window sync-ui--buffer-name)))
+ (window-width win)
+ 80))
+
+(defun sync-ui--justify-space (right-width &optional face)
+ "Elastic space aligning the next RIGHT-WIDTH columns to the right edge."
+ (propertize " " 'display `(space :align-to (- right ,(+ right-width 1)))
+ 'face (or face 'default)))
+
+(defun sync-ui--hairline ()
+ "A full-width rule."
+ (propertize "\n" 'face 'sync-ui-hairline))
+
+(defun sync-ui--button (text action help)
+ "Clickable TEXT running ACTION, with HELP echo."
+ (propertize text 'pointer 'hand 'mouse-face 'highlight 'follow-link t
+ 'help-echo help
+ 'keymap (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] action)
+ (define-key map (kbd "RET") action)
+ map)))
+
+(defun sync-ui--chip (repo)
+ "The rail chip for REPO: fixed width 6, face computed from state."
+ (pcase (sync-ui--repo-state repo)
+ ('clean
+ (propertize (format " %-4s " (sync-ui--symbol 'ok)) 'face 'sync-ui-chip-i))
+ ('synced
+ (propertize (format " %-4s " (sync-ui--symbol 'ok)) 'face 'sync-ui-chip))
+ ('dirty
+ (propertize (format " %-4s " (format "%02d" (sync-ui--repo-dirty repo)))
+ 'face (if (eq (sync-ui--repo-mode repo) 'ask)
+ 'sync-ui-chip-popout
+ 'sync-ui-chip)))
+ ('waiting
+ (propertize (format " %-4s " "??") 'face 'sync-ui-chip-popout))
+ ((or 'committing 'fetching 'rebasing 'pushing)
+ (propertize (format " %-4s " (sync-ui--symbol 'busy)) 'face 'sync-ui-chip-active))
+ ('conflicted
+ (propertize (format " %-4s " (sync-ui--symbol 'bad)) 'face 'sync-ui-chip-critical))
+ ('error
+ (propertize (format " %-4s " "!!") 'face 'sync-ui-chip-critical))
+ ('missing
+ (propertize (format " %-4s " (sync-ui--symbol 'void)) 'face 'sync-ui-chip-i))
+ (_
+ (propertize (format " %-4s " "?") 'face 'sync-ui-chip-i))))
+
+(defun sync-ui--state-word (repo)
+ "The faded status text beside REPO's name."
+ (pcase (sync-ui--repo-state repo)
+ ('clean "clean")
+ ('synced (format "synced · %s"
+ (format-time-string "%H:%M" (sync-ui--repo-last-sync repo))))
+ ('dirty (if (eq (sync-ui--repo-mode repo) 'ask)
+ "unstaged — s asks"
+ "unstaged"))
+ ('waiting (or (sync-ui--repo-message repo) "waiting"))
+ ('committing "committing…")
+ ('fetching "fetching…")
+ ('rebasing (or (sync-ui--repo-message repo) "rebasing…"))
+ ('pushing (or (sync-ui--repo-message repo) "pushing…"))
+ ('conflicted (or (sync-ui--repo-message repo) "conflicted"))
+ ('error (or (sync-ui--repo-message repo) "error"))
+ ('missing (or (sync-ui--repo-message repo) "missing"))
+ (_ "?")))
+
+(defun sync-ui--pill (repo)
+ "The AUTO/ASK category pill for REPO (click toggles the mode).
+On rows where the rail chip is already loud (dirty ask, waiting,
+conflict, error) the pill drops to the inactive chip face: one
+saturated fill per row."
+ (let* ((auto-p (eq (sync-ui--repo-mode repo) 'auto))
+ (loud-p (or (memq (sync-ui--repo-state repo) '(waiting conflicted error))
+ (and (eq (sync-ui--repo-state repo) 'dirty) (not auto-p))))
+ (face (cond (loud-p 'sync-ui-chip-i)
+ (auto-p 'sync-ui-pill-auto)
+ (t 'sync-ui-pill-ask))))
+ (sync-ui--button
+ (propertize (if auto-p " AUTO " " ASK ") 'face face)
+ (lambda (&rest _)
+ (interactive)
+ (sync-ui--toggle repo))
+ "mouse-2 / RET: toggle auto/ask")))
+
+;;; § 6 Dashboard rendering
+
+(defun sync-ui--insert-title ()
+ "Title line."
+ (insert (propertize " sync"
+ 'face (if (display-graphic-p)
+ '(:inherit sync-ui-strong :height 1.25)
+ 'sync-ui-strong))
+ (propertize " local & redundant repos" 'face 'sync-ui-faded)
+ "\n"))
+
+(defun sync-ui--hint (key label)
+ "One hint: bracketed KEY in faded, LABEL in default."
+ (concat (propertize "[" 'face 'sync-ui-faded)
+ (propertize key 'face 'sync-ui-strong)
+ (propertize "]" 'face 'sync-ui-faded)
+ " " label))
+
+(defun sync-ui--insert-hints ()
+ "Literal key hints, maintained with the keymap."
+ (insert "\n "
+ (mapconcat #'identity
+ (list (sync-ui--hint "s" "sync")
+ (sync-ui--hint "RET" "magit")
+ (sync-ui--hint "r" "resume")
+ (sync-ui--hint "x" "skip")
+ (sync-ui--hint "t" "auto/ask"))
+ " ")
+ "\n "
+ (mapconcat #'identity
+ (list (sync-ui--hint "a" "add")
+ (sync-ui--hint "d" "remove")
+ (sync-ui--hint "g" "fetch")
+ (sync-ui--hint "n/p" "move")
+ (sync-ui--hint "q" "quit"))
+ " ")
+ "\n"))
+
+(defun sync-ui--insert-card (repo)
+ "One two-line card for REPO: rail chip + name + pill on top,
+gutter + path + per-remote ↑/↓ counts below. One logical line, so
+navigation and hl-line treat the card as a unit."
+ (let* ((id (sync-ui--repo-id repo))
+ (band (face-background 'highlight nil t))
+ (top `(:background ,band))
+ (name-face `(:inherit (sync-ui-strong sync-ui-salient) :background ,band))
+ (faded-band `(:inherit sync-ui-faded :background ,band))
+ (pill (sync-ui--pill repo))
+ (left (concat (propertize " " 'face top)
+ (sync-ui--chip repo)
+ (propertize " " 'face top)
+ (sync-ui--button
+ (propertize (sync-ui--repo-path repo) 'face name-face)
+ (lambda (&rest _)
+ (interactive)
+ (sync-ui--open-magit repo))
+ "mouse-2 / RET: magit")
+ (propertize (concat " " (sync-ui--state-word repo))
+ 'face faded-band)))
+ (remotes (sync-ui--remotes-summary repo band))
+ (bottom (concat (propertize " " 'face top)
+ (propertize (sync-ui--symbol 'gutter) 'face faded-band)
+ (propertize " " 'face top)
+ (propertize (format "%s · %s"
+ (sync-ui--repo-path repo)
+ (or (sync-ui--repo-branch repo) "?"))
+ 'face faded-band)))
+ (left-width (string-width left))
+ (budget (- (sync-ui--width) (string-width pill) 3))
+ (left (if (> left-width budget)
+ (concat (truncate-string-to-width left (max 8 budget) nil nil "…"))
+ left)))
+ (insert
+ (propertize
+ (concat left
+ (sync-ui--justify-space (string-width pill) top)
+ pill
+ (propertize " " 'face top)
+ (propertize " " 'face top 'display "\n")
+ bottom
+ (sync-ui--justify-space (string-width remotes) top)
+ remotes
+ (propertize " " 'face top))
+ 'sync-ui-id id)
+ "\n")))
+
+(defun sync-ui--remotes-summary (repo band)
+ "Faded per-remote status: \"origin ↑2 · backup\", arrows only when non-zero.
+A ⁺ marks a remote that has no copy of the branch yet."
+ (let ((faded-band `(:inherit sync-ui-faded :background ,band))
+ (salient-band `(:inherit sync-ui-salient :background ,band))
+ (popout-band `(:inherit sync-ui-popout :background ,band)))
+ (if (null (sync-ui--repo-remotes repo))
+ (propertize "no remotes" 'face faded-band)
+ (mapconcat
+ (lambda (status)
+ (pcase-let ((`(,name ,ahead ,behind) status))
+ (concat (propertize name 'face faded-band)
+ (cond
+ ((null ahead)
+ (propertize (concat " " (sync-ui--symbol 'new)) 'face salient-band))
+ ((> ahead 0)
+ (propertize (format " %s%d" (sync-ui--symbol 'up) ahead) 'face salient-band))
+ (t ""))
+ (if (and behind (> behind 0))
+ (propertize (format " %s%d" (sync-ui--symbol 'down) behind) 'face popout-band)
+ ""))))
+ (sync-ui--repo-remotes repo)
+ (propertize " " 'face faded-band)))))
+
+(defun sync-ui--header-line ()
+ "Four-slot status bar: [ SYNC | repos (n) ... counts ]."
+ (let* ((total (length sync-ui--repos))
+ (clean (cl-count-if (lambda (r)
+ (memq (sync-ui--repo-state r) '(clean synced)))
+ sync-ui--repos))
+ (dirty (cl-count-if (lambda (r) (eq (sync-ui--repo-state r) 'dirty))
+ sync-ui--repos))
+ (waiting (cl-count-if (lambda (r) (eq (sync-ui--repo-state r) 'waiting))
+ sync-ui--repos))
+ (busy (cl-count-if (lambda (r)
+ (memq (sync-ui--repo-state r)
+ '(committing fetching rebasing pushing)))
+ sync-ui--repos))
+ (attention (cl-count-if (lambda (r)
+ (memq (sync-ui--repo-state r) '(conflicted error missing)))
+ sync-ui--repos))
+ (chip (propertize " SYNC " 'face (if (> busy 0)
+ 'sync-ui-chip-active
+ 'sync-ui-chip)))
+ (name (propertize " repos " 'face 'sync-ui-strong))
+ (prim (propertize (format "(%d repo%s)" total (if (= total 1) "" "s"))
+ 'face 'sync-ui-faded))
+ (parts (delq nil
+ (list (format "%d/%d clean" clean total)
+ (and (> dirty 0) (format "%d dirty" dirty))
+ (and (> waiting 0) (format "%d waiting" waiting))
+ (and (> attention 0) (format "%d ⚠" attention)))))
+ (right (propertize (concat (mapconcat #'identity parts " · ") " ")
+ 'face 'sync-ui-faded)))
+ (concat (propertize " " 'display '(raise 0.15))
+ chip name
+ (propertize " " 'display '(raise -0.20))
+ prim
+ (propertize " " 'display `(space :align-to (- right ,(string-width right))))
+ right)))
+
+(defun sync-ui--render ()
+ "Re-render the dashboard, restoring point by repo id."
+ (when-let* ((buf (get-buffer sync-ui--buffer-name)))
+ (with-current-buffer buf
+ (when (eq major-mode 'sync-ui-mode)
+ (let ((id (get-text-property (point) 'sync-ui-id))
+ (inhibit-read-only t))
+ (erase-buffer)
+ (sync-ui--insert-title)
+ (sync-ui--insert-hints)
+ (insert (sync-ui--hairline) "\n")
+ (if (null sync-ui--repos)
+ (insert (propertize " no repos — a adds one" 'face 'sync-ui-faded)
+ "\n")
+ (dolist (repo sync-ui--repos)
+ (sync-ui--insert-card repo)
+ (unless (eq repo (car (last sync-ui--repos)))
+ (insert (propertize (concat " " (sync-ui--symbol 'gutter))
+ 'face 'sync-ui-faded)
+ "\n"))))
+ (if-let* ((match (and id
+ (progn (goto-char (point-min))
+ (text-property-search-forward
+ 'sync-ui-id id #'equal)))))
+ (goto-char (prop-match-beginning match))
+ (goto-char (point-min))
+ (sync-ui-next)))))))
+
+(defun sync-ui--update-card (repo)
+ "In-place rewrite of REPO's card; the buffer never reflows."
+ (when-let* ((buf (get-buffer sync-ui--buffer-name)))
+ (with-current-buffer buf
+ (when (eq major-mode 'sync-ui-mode)
+ (save-excursion
+ (goto-char (point-min))
+ (when-let* ((match (text-property-search-forward
+ 'sync-ui-id (sync-ui--repo-id repo) #'equal)))
+ (let ((inhibit-read-only t)
+ (beg (prop-match-beginning match)))
+ (goto-char beg)
+ (let ((end (min (point-max) (1+ (line-end-position)))))
+ (delete-region beg end)
+ (goto-char beg)
+ (sync-ui--insert-card repo)))))))))
+
+;;; § 7 Mode and navigation
+
+(defun sync-ui--repo-at-point ()
+ "Repo struct for the card at point."
+ (when-let* ((id (get-text-property (point) 'sync-ui-id)))
+ (sync-ui--find id)))
+
+(defun sync-ui-next ()
+ "Move to the next card."
+ (interactive)
+ (let ((match (text-property-search-forward 'sync-ui-id nil nil t)))
+ (if match
+ (goto-char (prop-match-beginning match))
+ (goto-char (point-min))
+ (when-let* ((first (text-property-search-forward 'sync-ui-id nil nil)))
+ (goto-char (prop-match-beginning first))))))
+
+(defun sync-ui-previous ()
+ "Move to the previous card, wrapping to the last."
+ (interactive)
+ (let ((starts nil))
+ (save-excursion
+ (goto-char (point-min))
+ (cl-loop for m = (text-property-search-forward 'sync-ui-id nil nil)
+ while m
+ do (push (prop-match-beginning m) starts)
+ (goto-char (prop-match-end m))))
+ (let ((target (or (car (cl-remove-if-not (lambda (s) (< s (point))) starts))
+ (car starts))))
+ (if target
+ (goto-char target)
+ (message "sync-ui: no cards")))))
+
+(defun sync-ui--card-range ()
+ "hl-line range: the whole card (both visual lines), or nothing."
+ (if (get-text-property (point) 'sync-ui-id)
+ (cons (line-beginning-position)
+ (min (point-max) (1+ (line-end-position))))
+ (cons (point) (point))))
+
+(defun sync-ui--open-magit (repo)
+ "Open REPO in magit, falling back to dired when magit is absent."
+ (if (require 'magit nil t)
+ (progn
+ (declare-function magit-status "magit")
+ (magit-status (sync-ui--repo-id repo)))
+ (dired (sync-ui--repo-id repo))))
+
+(defun sync-ui-magit ()
+ "Open the repo at point in magit."
+ (interactive)
+ (if-let* ((repo (sync-ui--repo-at-point)))
+ (sync-ui--open-magit repo)
+ (user-error "No repo at point")))
+
+(defun sync-ui--toggle (repo)
+ "Flip REPO between auto and ask, persist, repaint."
+ (setf (sync-ui--repo-mode repo)
+ (if (eq (sync-ui--repo-mode repo) 'auto) 'ask 'auto))
+ (sync-ui--save-repos)
+ (sync-ui--update-card repo)
+ (message "%s: %s" (sync-ui--repo-path repo) (sync-ui--repo-mode repo)))
+
+(defun sync-ui-toggle ()
+ "Toggle auto/ask for the repo at point."
+ (interactive)
+ (when-let* ((repo (sync-ui--repo-at-point)))
+ (sync-ui--toggle repo)))
+
+(defun sync-ui-add-repo (dir mode)
+ "Register DIR as a managed repo with MODE (`auto' or `ask')."
+ (interactive
+ (list (read-directory-name "Repo: ")
+ (intern (completing-read "Mode: " '("ask" "auto") nil t nil nil "ask"))))
+ (unless sync-ui--repos (sync-ui--load-registry))
+ (let* ((id (expand-file-name dir))
+ (repo (sync-ui--repo-create
+ :id id
+ :path (abbreviate-file-name id)
+ :mode mode)))
+ (sync-ui--probe repo)
+ (if (eq (sync-ui--repo-state repo) 'missing)
+ (user-error "%s: %s" (sync-ui--repo-path repo)
+ (sync-ui--repo-message repo))
+ (when (sync-ui--find id)
+ (user-error "%s is already managed" (sync-ui--repo-path repo)))
+ (setq sync-ui--repos (append sync-ui--repos (list repo)))
+ (sync-ui--save-repos)
+ (sync-ui--render)
+ (message "%s added (%s)" (sync-ui--repo-path repo) mode))))
+
+(defun sync-ui-remove-repo ()
+ "Remove the repo at point from the managed set (the repo stays on disk)."
+ (interactive)
+ (when-let* ((repo (sync-ui--repo-at-point)))
+ (when (y-or-n-p (format "Stop managing %s? " (sync-ui--repo-path repo)))
+ (setq sync-ui--repos (delq repo sync-ui--repos))
+ (sync-ui--save-repos)
+ (sync-ui--render))))
+
+(defvar sync-ui-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "s") #'sync-ui-sync-all)
+ (define-key map (kbd "RET") #'sync-ui-magit)
+ (define-key map (kbd "r") #'sync-ui-resume)
+ (define-key map (kbd "x") #'sync-ui-skip)
+ (define-key map (kbd "t") #'sync-ui-toggle)
+ (define-key map (kbd "a") #'sync-ui-add-repo)
+ (define-key map (kbd "d") #'sync-ui-remove-repo)
+ (define-key map (kbd "g") #'sync-ui-refresh)
+ (define-key map (kbd "n") #'sync-ui-next)
+ (define-key map (kbd "p") #'sync-ui-previous)
+ map)
+ "Keymap for `sync-ui-mode'.")
+
+(define-derived-mode sync-ui-mode special-mode "sync"
+ "NΛNO-style dashboard for git repo sync."
+ (setq-local cursor-type nil
+ truncate-lines t
+ left-fringe-width 1
+ right-fringe-width 8
+ header-line-format '(:eval (sync-ui--header-line))
+ mode-line-format ""
+ hl-line-range-function #'sync-ui--card-range)
+ (face-remap-set-base 'hl-line 'sync-ui-selected)
+ (hl-line-mode 1))
+
+(declare-function evil-set-initial-state "evil")
+(declare-function evil-define-key* "evil-core")
+
+(with-eval-after-load 'evil
+ (evil-set-initial-state 'sync-ui-mode 'normal)
+ ;; `evil-define-key' is a macro: calling it from a file byte-compiled
+ ;; without evil loaded yields (invalid-function evil-define-key).
+ ;; `evil-define-key*' is the function underneath and is always safe.
+ (evil-define-key* 'normal sync-ui-mode-map
+ (kbd "j") #'sync-ui-next
+ (kbd "k") #'sync-ui-previous
+ (kbd "RET") #'sync-ui-magit))
+
+;;; § 8 Entry points
+
+;;;###autoload
+(defun sync-ui ()
+ "Open the sync dashboard."
+ (interactive)
+ (unless sync-ui--repos (sync-ui--load-registry))
+ (mapc #'sync-ui--probe sync-ui--repos)
+ (let ((buf (get-buffer-create sync-ui--buffer-name)))
+ (with-current-buffer buf
+ (unless (eq major-mode 'sync-ui-mode)
+ (sync-ui-mode))
+ (sync-ui--render))
+ (pop-to-buffer buf)))
+
+(provide 'sync-ui)
+;;; sync-ui.el ends here