md: 2026-08-21T01:12:59+02:00

1 files changed, 1283 insertions, 0 deletions

diff --git a/lisp/fossil-ui.el b/lisp/fossil-ui.el
new file mode 100644
index 0000000..0982e4b
--- /dev/null
+++ b/lisp/fossil-ui.el
@@ -0,0 +1,1283 @@
+;;; fossil-ui.el --- Small TextUI frontend for Fossil -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2026 cashmere
+
+;; Author: cashmere
+;; Version: 0.1.0
+;; Package-Requires: ((emacs "29.1") (textui "0.5.1"))
+;; Keywords: tools, vc
+
+;;; Commentary:
+
+;; A deliberately small Fossil dashboard.  It follows Fossil's own model:
+;; files may be selected for a partial commit, but there is no staging area.
+;; Local inspection is synchronous; operations which may trigger autosync run
+;; asynchronously.
+
+;;; Code:
+
+(require 'ansi-color)
+(require 'cl-lib)
+(require 'diff-mode)
+(require 'json)
+(require 'outline)
+(require 'seq)
+(require 'subr-x)
+(require 'textui)
+(require 'textui-widgets)
+
+(declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings))
+(declare-function evil-get-auxiliary-keymap "evil-core"
+                  (map state &optional create noinherit))
+(declare-function evil-make-intercept-map "evil-core" (keymap &optional state aux))
+(declare-function evil-normalize-keymaps "evil-core" (&optional state))
+(declare-function evil-set-initial-state "evil-core" (mode state))
+(declare-function general-define-key "general" (&rest args))
+(declare-function general-local-map "general" ())
+(defvar general-override-local-mode-map)
+
+(defgroup fossil-ui nil
+  "A compact TextUI frontend for Fossil."
+  :group 'tools
+  :prefix "fossil-ui-")
+
+(defcustom fossil-ui-program "fossil"
+  "Fossil executable used by the dashboard."
+  :type 'string
+  :group 'fossil-ui)
+
+(defcustom fossil-ui-timeline-limit 25
+  "Maximum number of recent check-ins loaded for the dashboard."
+  :type 'integer
+  :group 'fossil-ui)
+
+(defcustom fossil-ui-content-width nil
+  "Optional maximum width of dashboard content in columns.
+Nil, the default, uses the complete TextUI window width.  Set an integer only
+when a deliberately compact dashboard is preferred."
+  :type '(choice (const :tag "Use full window width" nil)
+                 (integer :tag "Maximum columns"))
+  :group 'fossil-ui)
+
+(defcustom fossil-ui-use-icons 'auto
+  "Whether to use Nerd Font icons in the dashboard.
+When set to `auto', use them only in graphical displays when nerd-icons is
+already loaded.  Nil always uses portable text symbols."
+  :type '(choice (const :tag "Automatically" auto)
+                 (const :tag "Always" t)
+                 (const :tag "Never" nil))
+  :group 'fossil-ui)
+
+(defcustom fossil-ui-timeline-minimum 8
+  "Minimum number of timeline entries shown when available."
+  :type 'integer
+  :group 'fossil-ui)
+
+(defcustom fossil-ui-diff-renderer 'auto
+  "Renderer used for working-tree diffs.
+`auto' uses Delta when available and otherwise keeps the plain Fossil diff.
+`delta' requires `fossil-ui-delta-program' to be executable.  `plain' never
+runs an external renderer."
+  :type '(choice (const :tag "Delta when available" auto)
+                 (const :tag "Always Delta" delta)
+                 (const :tag "Plain Fossil diff" plain))
+  :group 'fossil-ui)
+
+(defcustom fossil-ui-delta-program "delta"
+  "Delta executable used to render Fossil diffs."
+  :type 'string
+  :group 'fossil-ui)
+
+(defcustom fossil-ui-delta-arguments '("--paging=never" "--color-only")
+  "Arguments passed to Delta after the Fossil diff on standard input."
+  :type '(repeat string)
+  :group 'fossil-ui)
+
+(defface fossil-ui-strong '((t :inherit bold))
+  "Structural text."
+  :group 'fossil-ui)
+
+(defface fossil-ui-faded '((t :inherit shadow))
+  "Secondary text."
+  :group 'fossil-ui)
+
+(defface fossil-ui-salient '((t :inherit link))
+  "Selected and actionable text."
+  :group 'fossil-ui)
+
+(defface fossil-ui-warning '((t :inherit warning))
+  "Changed or noteworthy state."
+  :group 'fossil-ui)
+
+(defface fossil-ui-critical '((t :inherit error))
+  "Conflicts and command errors."
+  :group 'fossil-ui)
+
+(defface fossil-ui-selected '((t :inherit highlight :weight bold))
+  "Current file row."
+  :group 'fossil-ui)
+
+(defun fossil-ui--measure-row (widget)
+  "Return the visible single-line value of file-row WIDGET."
+  (format "%s" (or (widget-get widget :value) "")))
+
+(defun fossil-ui--attach-row (widget from to)
+  "Attach file-row WIDGET to the TextUI text between FROM and TO."
+  (textui-widgets-attach-button widget from to)
+  (add-text-properties
+   from to
+   (list 'fossil-ui-path (widget-get widget :fossil-ui-path)
+         'fossil-ui-status (widget-get widget :fossil-ui-status))))
+
+(define-widget 'fossil-ui-row 'push-button
+  "A flat, clickable Fossil file row."
+  :format "%v"
+  :button-face 'default
+  :textui-measure #'fossil-ui--measure-row
+  :textui-attach #'fossil-ui--attach-row)
+
+(define-widget 'fossil-ui-keycap 'push-button
+  "A flat keycap and label action."
+  :format "%v"
+  :button-face 'default
+  :textui-measure #'fossil-ui--measure-row
+  :textui-attach #'textui-widgets-attach-button)
+
+(defvar fossil-ui--commit-history nil)
+(defvar-local fossil-ui--process nil)
+(defvar-local fossil-ui--commit-owner nil)
+(defvar-local fossil-ui--commit-paths nil)
+(defvar-local fossil-ui--window-height nil)
+
+(defun fossil-ui--call-in (directory &rest args)
+  "Run Fossil ARGS synchronously in DIRECTORY and return (CODE OUTPUT)."
+  (with-temp-buffer
+    (let ((default-directory (file-name-as-directory directory)))
+      (list (condition-case err
+                (apply #'process-file fossil-ui-program nil (list t t) nil args)
+              (file-missing
+               (insert (error-message-string err))
+               127)
+              (error
+               (insert (error-message-string err))
+               1))
+            (string-trim-right (buffer-string))))))
+
+(defun fossil-ui--require-success (directory &rest args)
+  "Run Fossil ARGS in DIRECTORY and return output or signal a user error."
+  (pcase-let ((`(,code ,output) (apply #'fossil-ui--call-in directory args)))
+    (if (zerop code)
+        output
+      (user-error "%s" (if (string-empty-p output)
+                             (format "Fossil exited with status %d" code)
+                           output)))))
+
+(defun fossil-ui--input-directory (&optional directory)
+  "Return a usable starting directory for DIRECTORY or the current buffer."
+  (file-name-as-directory
+   (expand-file-name
+    (or directory
+        (and buffer-file-name (file-name-directory buffer-file-name))
+        default-directory))))
+
+(defun fossil-ui--checkout-info (directory)
+  "Return checkout metadata for DIRECTORY, or signal a user error."
+  (let ((output (fossil-ui--require-success directory "info"))
+        result)
+    (dolist (line (split-string output "\n" t))
+      (when (string-match "\\`\\([^:[:space:]]+\\):[[:space:]]*\\(.*\\)\\'" line)
+        (setq result
+              (plist-put result
+                         (intern (concat ":" (match-string 1 line)))
+                         (string-trim (match-string 2 line))))))
+    (unless (plist-get result :local-root)
+      (user-error "%s is not inside an open Fossil checkout" directory))
+    (plist-put result :root
+               (file-name-as-directory (plist-get result :local-root)))))
+
+(defun fossil-ui--json-command (root &rest args)
+  "Run Fossil JSON command ARGS at ROOT and return its payload."
+  (let* ((output (apply #'fossil-ui--require-success root "json" args))
+         (data (condition-case err
+                   (json-parse-string output
+                                      :object-type 'alist
+                                      :array-type 'list
+                                      :null-object nil
+                                      :false-object nil)
+                 (error
+                  (user-error "Invalid Fossil JSON: %s"
+                              (error-message-string err))))))
+    (or (alist-get 'payload data)
+        (user-error "Fossil JSON response has no payload"))))
+
+(defun fossil-ui--parse-change-line (line)
+  "Parse one Fossil changes LINE into a plist."
+  (when (string-match "\\`\\([A-Z_]+\\)[[:space:]]+\\(.*\\)\\'" line)
+    (let* ((status (match-string 1 line))
+           (raw (match-string 2 line))
+           (parts (condition-case nil
+                      (split-string-and-unquote raw)
+                    (error (list raw))))
+           (path (mapconcat #'identity parts " ")))
+      (list :status status :path path))))
+
+(defun fossil-ui--changes (root)
+  "Return changed and unmanaged files below ROOT."
+  (let ((output (fossil-ui--require-success
+                 root "changes" "--hash" "--classify" "--differ" "--rel-paths")))
+    (delq nil (mapcar #'fossil-ui--parse-change-line
+                      (split-string output "\n" t)))))
+
+(defun fossil-ui--parse-numstat-line (line)
+  "Parse one Fossil diff --numstat LINE into a plist.
+Paths may contain spaces.  A dash in either count denotes binary data."
+  (when (and
+         (string-match
+          "\\`[\t ]*\\([0-9]+\\|-\\)[\t ]+\\([0-9]+\\|-\\)[\t ]+\\(.*\\)\\'"
+          line)
+         (not (string-prefix-p "TOTAL " (match-string 3 line))))
+    (let ((insertions (match-string 1 line))
+          (deletions (match-string 2 line))
+          (path (match-string 3 line)))
+      (list :path (string-remove-prefix "./" path)
+            :insertions (unless (string= insertions "-")
+                          (string-to-number insertions))
+            :deletions (unless (string= deletions "-")
+                         (string-to-number deletions))
+            :binary (or (string= insertions "-") (string= deletions "-"))))))
+
+(defun fossil-ui--numstat (root)
+  "Return a hash table of diff statistics keyed by relative path at ROOT."
+  (let ((table (make-hash-table :test #'equal)))
+    (pcase-let ((`(,code ,output)
+                 (fossil-ui--call-in root "diff" "--numstat" "--internal")))
+      (when (zerop code)
+        (dolist (line (split-string output "\n" t))
+          (when-let* ((stat (fossil-ui--parse-numstat-line line)))
+            (puthash (plist-get stat :path) stat table)))))
+    table))
+
+(defun fossil-ui--attach-numstat (changes stats)
+  "Copy CHANGES and attach matching insertion/deletion data from STATS."
+  (mapcar
+   (lambda (change)
+     (let* ((next (copy-sequence change))
+            (stat (gethash (plist-get change :path) stats)))
+       (if stat
+           (progn
+             (setq next (plist-put next :insertions (plist-get stat :insertions)))
+             (setq next (plist-put next :deletions (plist-get stat :deletions)))
+             (when (plist-get stat :binary)
+               (setq next (plist-put next :binary t))))
+         (when (string= (plist-get change :status) "EXTRA")
+           (setq next (plist-put next :extra t))))
+       next))
+   changes))
+
+(defun fossil-ui--setting (root name)
+  "Return Fossil setting NAME at ROOT."
+  (pcase-let ((`(,code ,output) (fossil-ui--call-in root "settings")))
+    (if (not (zerop code))
+        "unknown"
+      (if-let* ((line (cl-find-if
+                       (lambda (candidate)
+                         (string-match-p
+                          (format "\\`%s\\(?:[[:space:]]\\|\\'\\)"
+                                  (regexp-quote name))
+                          candidate))
+                       (split-string output "\n" t)))
+                (parts (split-string line)))
+          (or (nth 2 parts) "on")
+        "unknown"))))
+
+(defun fossil-ui--remote (root)
+  "Return the default Fossil remote at ROOT."
+  (pcase-let ((`(,code ,output) (fossil-ui--call-in root "remote" "list")))
+    (if (or (not (zerop code)) (string-empty-p output))
+        nil
+      (let ((line (car (split-string output "\n" t))))
+        (if (string-match "^[[:space:]]*\\([^[:space:]]+\\)[[:space:]]+\\(.*\\)$" line)
+            (match-string 2 line)
+          line)))))
+
+(defun fossil-ui--timeline (root)
+  "Return recent check-ins at ROOT."
+  (let* ((payload (fossil-ui--json-command
+                   root "timeline" "checkin"
+                   "--limit" (number-to-string fossil-ui-timeline-limit)))
+         (entries (alist-get 'timeline payload)))
+    (or entries nil)))
+
+(defun fossil-ui--branches (root)
+  "Return open branch names at ROOT."
+  (let* ((payload (fossil-ui--json-command root "branch" "list"))
+         (branches (alist-get 'branches payload)))
+    (sort (copy-sequence (or branches nil)) #'string-lessp)))
+
+(defun fossil-ui--snapshot (directory &optional selected)
+  "Collect dashboard state for DIRECTORY, retaining SELECTED paths."
+  (let* ((info (fossil-ui--checkout-info directory))
+         (root (plist-get info :root))
+         (changes (fossil-ui--attach-numstat
+                   (fossil-ui--changes root) (fossil-ui--numstat root)))
+         (paths (mapcar (lambda (change) (plist-get change :path)) changes)))
+    (list :root root
+          :repository (plist-get info :repository)
+          :checkout (plist-get info :checkout)
+          :branch (or (plist-get info :tags) "trunk")
+          :user (plist-get info :user)
+          :remote (fossil-ui--remote root)
+          :autosync (fossil-ui--setting root "autosync")
+          :changes changes
+          :selected (cl-remove-if-not (lambda (path) (member path paths)) selected)
+          :timeline (condition-case err
+                        (fossil-ui--timeline root)
+                      (error (list (list (cons 'comment
+                                              (error-message-string err))))))
+          :branches (condition-case nil (fossil-ui--branches root) (error nil))
+          :height fossil-ui--window-height
+          :busy nil
+          :error nil)))
+
+(defun fossil-ui--fit (value width &optional face)
+  "Return VALUE truncated or padded to WIDTH, optionally using FACE."
+  (let* ((width (max 0 width))
+         (value (truncate-string-to-width (format "%s" (or value ""))
+                                          width nil nil "..."))
+         (result (concat value
+                         (make-string (max 0 (- width (string-width value))) ?\s))))
+    (if face (propertize result 'face face) result)))
+
+(defun fossil-ui--item (value &optional face)
+  "Return a TextUI item for VALUE with optional FACE."
+  `(:type item :format "%v"
+    :value ,(if face (propertize value 'face face) value)))
+
+(defun fossil-ui--icons-p ()
+  "Return non-nil when dashboard Nerd Font icons should be used."
+  (pcase fossil-ui-use-icons
+    ('auto (and (display-graphic-p) (featurep 'nerd-icons)))
+    ((pred null) nil)
+    (_ t)))
+
+(defun fossil-ui--icon (kind)
+  "Return a small icon for KIND, with a portable fallback."
+  (let ((icons '((repository . "󰆼") (branch . "󰘬") (sync . "󰓦")
+                 (edited . "󰏫") (added . "󰐕") (deleted . "󰍵")
+                 (extra . "󰋗") (conflict . "󰀦") (missing . "󰅖")))
+        (fallbacks '((repository . "R") (branch . "B") (sync . "S")
+                     (edited . "~") (added . "+") (deleted . "-")
+                     (extra . "?") (conflict . "!") (missing . "!"))))
+    (or (alist-get kind (if (fossil-ui--icons-p) icons fallbacks)) "·")))
+
+(defun fossil-ui--keycap (key label action focus-id &optional disabled)
+  "Return a flat KEY LABEL control for ACTION with stable FOCUS-ID.
+When DISABLED is non-nil, retain the control but render it quietly."
+  (let* ((face (if disabled 'fossil-ui-faded 'default))
+         (value (concat (propertize (format " %s " key)
+                                    'face (if disabled 'shadow 'highlight))
+                        (propertize label 'face face))))
+    `(:type fossil-ui-keycap
+      :value ,value
+      :inactive ,disabled
+      :layout (:focus-id ,focus-id)
+      :action ,(lambda (&rest _)
+                 (unless disabled (call-interactively action))))))
+
+(defun fossil-ui--status-face (status)
+  "Return a face for Fossil STATUS."
+  (cond
+   ((member status '("CONFLICT" "MISSING")) 'fossil-ui-critical)
+   ((member status '("EXTRA" "ADDED" "DELETED")) 'fossil-ui-salient)
+   (t 'fossil-ui-warning)))
+
+(defun fossil-ui--status-icon (status)
+  "Return an icon representing Fossil STATUS."
+  (fossil-ui--icon
+   (pcase status
+     ("EDITED" 'edited) ("ADDED" 'added) ("DELETED" 'deleted)
+     ("EXTRA" 'extra) ("CONFLICT" 'conflict) ("MISSING" 'missing)
+     (_ 'edited))))
+
+(defun fossil-ui--change-stat (change)
+  "Return a compact human-readable statistic for CHANGE."
+  (cond
+   ((plist-get change :extra) "untracked")
+   ((plist-get change :binary) "binary")
+   ((or (numberp (plist-get change :insertions))
+        (numberp (plist-get change :deletions)))
+    (format "+%d −%d" (or (plist-get change :insertions) 0)
+            (or (plist-get change :deletions) 0)))
+   (t "—")))
+
+(defun fossil-ui--change-row (change width selected &optional narrow)
+  "Render CHANGE at WIDTH, using SELECTED paths.
+When NARROW is non-nil return a primary row without trailing metadata."
+  (let* ((status (plist-get change :status))
+         (path (plist-get change :path))
+         (marked (member path selected))
+         (metadata (format "%s  %s" status (fossil-ui--change-stat change)))
+         (meta-width (string-width metadata))
+         (path-width (max 10 (- width meta-width 9)))
+         (line (concat (propertize "▎" 'face (fossil-ui--status-face status))
+                       (if marked "[x] " "[ ] ")
+                       (propertize (concat (fossil-ui--status-icon status) " ")
+                                   'face (fossil-ui--status-face status))
+                       (fossil-ui--fit path (if narrow (- width 7) path-width)
+                                       (if marked 'fossil-ui-salient 'default))
+                       (unless narrow
+                         (propertize metadata 'face
+                                     (fossil-ui--status-face status))))))
+    `(:type fossil-ui-row
+      :value ,line
+      :fossil-ui-path ,path
+      :fossil-ui-status ,status
+      :layout (:focus-id ,(list 'file path))
+      :action ,(lambda (&rest _) (fossil-ui-diff)))))
+
+(defun fossil-ui--change-elements (change width selected)
+  "Return responsive dashboard elements for CHANGE."
+  (if (< width 90)
+      (list (fossil-ui--change-row change width selected t)
+            (fossil-ui--item
+             (fossil-ui--fit
+              (format "      %s  ·  %s" (plist-get change :status)
+                      (fossil-ui--change-stat change)) width)
+             'fossil-ui-faded))
+    (list (fossil-ui--change-row change width selected))))
+
+(defun fossil-ui--short-checkout (checkout)
+  "Return a short check-in identifier from CHECKOUT."
+  (if (and checkout (string-match "\\`\\([[:xdigit:]]+\\)" checkout))
+      (substring (match-string 1 checkout)
+                 0 (min 10 (length (match-string 1 checkout))))
+    "unknown"))
+
+(defun fossil-ui--timeline-elements (entry width)
+  "Render timeline ENTRY at WIDTH as a two-line rail."
+  (let* ((uuid (or (alist-get 'uuid entry) ""))
+         (short (substring uuid 0 (min 10 (length uuid))))
+         (timestamp (alist-get 'timestamp entry))
+         (date (if (numberp timestamp)
+                   (format-time-string "%b %d %H:%M" (seconds-to-time timestamp))
+                 "unknown time"))
+         (user (or (alist-get 'user entry) ""))
+         (comment (or (alist-get 'comment entry) ""))
+         (tags (or (alist-get 'tags entry) (alist-get 'branch entry)))
+         (tag-text (cond ((listp tags) (mapconcat (lambda (tag) (format "%s" tag))
+                                                   tags ", "))
+                         (tags (format "%s" tags)) (t "")))
+         (author (truncate-string-to-width user 18 nil nil "…")))
+    (list
+     (fossil-ui--item
+      (concat (propertize "● " 'face 'fossil-ui-salient)
+              (fossil-ui--fit comment (max 12 (- width 16)))
+              "  "
+              (propertize date 'face 'fossil-ui-faded)))
+     (fossil-ui--item
+      (fossil-ui--fit
+       (format "│  %s  %s%s" short author
+               (if (string-empty-p tag-text) "" (concat "  ·  " tag-text))) width)
+      'fossil-ui-faded))))
+
+(defun fossil-ui--timeline-count ()
+  "Return the number of loaded timeline rows suitable for current height."
+  (let* ((height (or (plist-get textui-state :height) 32))
+         (available (max fossil-ui-timeline-minimum (floor (/ (- height 14) 2)))))
+    (min fossil-ui-timeline-limit (max fossil-ui-timeline-minimum available))))
+
+(defun fossil-ui--chip (text face)
+  "Return a compact status chip with TEXT and FACE."
+  (propertize (format " %s " text) 'face face))
+
+(defconst fossil-ui--wide-layout-width 115
+  "Minimum width for side-by-side changes and commit panels.")
+
+(defconst fossil-ui--metadata-minimum-width 24
+  "Minimum outer width of a repository metadata card.")
+
+(defun fossil-ui--column (children)
+  "Return a tightly stacked TextUI column containing CHILDREN."
+  `(:type :flex :direction :column :gap 0 :children ,children))
+
+(defun fossil-ui--card (title children width &optional minimum grow)
+  "Return a padded card named TITLE containing CHILDREN at WIDTH.
+MINIMUM and GROW are parent-facing Flex sizing hints."
+  `(:type :flex :direction :column :gap 1 :padding 1 :border t
+    :layout (:width ,width :min-width ,(or minimum width) :grow ,(or grow 0))
+    :children (,(fossil-ui--item
+                 title (unless (get-text-property 0 'face title)
+                         'fossil-ui-strong))
+               ,(fossil-ui--column children))))
+
+(defun fossil-ui--metadata-columns (width)
+  "Return the responsive metadata grid column count for WIDTH."
+  (min 3 (max 1 (/ (1+ width) (1+ fossil-ui--metadata-minimum-width)))))
+
+(defun fossil-ui--metadata-track-width (width)
+  "Return a conservative equal metadata track width for WIDTH."
+  (let ((columns (fossil-ui--metadata-columns width)))
+    (/ (- width (1- columns)) columns)))
+
+(defun fossil-ui--metadata-grid (width chips)
+  "Return repository metadata cards for WIDTH using status CHIPS."
+  (let* ((root (plist-get textui-state :root))
+         (repository (plist-get textui-state :repository))
+         (remote (plist-get textui-state :remote))
+         (track-width (fossil-ui--metadata-track-width width))
+         (inner-width (max 8 (- track-width 4)))
+         (card-layout (list track-width fossil-ui--metadata-minimum-width 1)))
+    `(:type :grid :columns 3
+      :min-column-width ,fossil-ui--metadata-minimum-width :gap 1
+      :children
+      (,(apply #'fossil-ui--card
+               "Repository"
+               (list
+                (fossil-ui--item
+                 (fossil-ui--fit (abbreviate-file-name root) inner-width))
+                (fossil-ui--item
+                 (fossil-ui--fit (abbreviate-file-name
+                                  (or repository "unknown repository"))
+                                 inner-width)
+                 'fossil-ui-faded)
+                (fossil-ui--item " "))
+               card-layout)
+       ,(apply #'fossil-ui--card
+               "Checkout"
+               (list
+                (fossil-ui--item
+                 (fossil-ui--fit
+                  (format "%s  %s" (fossil-ui--icon 'branch)
+                          (plist-get textui-state :branch)) inner-width)
+                 'fossil-ui-salient)
+                (fossil-ui--item
+                 (fossil-ui--fit
+                  (format "commit  %s"
+                          (fossil-ui--short-checkout
+                           (plist-get textui-state :checkout))) inner-width)
+                 'fossil-ui-faded)
+                (fossil-ui--item (fossil-ui--fit chips inner-width)))
+               card-layout)
+       ,(apply #'fossil-ui--card
+               "Synchronization"
+               (list
+                (fossil-ui--item
+                 (fossil-ui--fit
+                  (format "autosync  %s" (plist-get textui-state :autosync))
+                  inner-width))
+                (fossil-ui--item
+                 (fossil-ui--fit
+                  (format "%s  %s" (fossil-ui--icon 'sync)
+                          (or remote "no remote")) inner-width)
+                 (if remote 'link 'fossil-ui-faded))
+                (fossil-ui--item " "))
+               card-layout)))))
+
+(defun fossil-ui--changes-panel (outer-width changes selected)
+  "Return the changed-files card at OUTER-WIDTH."
+  (let* ((inner-width (max 8 (- outer-width 4)))
+         (title (format "Changes  %d  ·  Selected  %d"
+                        (length changes) (length selected)))
+         (body (if changes
+                   (mapcan (lambda (change)
+                             (fossil-ui--change-elements
+                              change inner-width selected)) changes)
+                 (list (fossil-ui--item "✓  Working checkout is clean"
+                                        'success)))))
+    (fossil-ui--card title body outer-width outer-width 0)))
+
+(defun fossil-ui--commits-panel (outer-width timeline)
+  "Return the recent-commits card at OUTER-WIDTH using TIMELINE."
+  (let ((inner-width (max 8 (- outer-width 4))))
+    (fossil-ui--card
+     "Recent commits"
+     (if timeline
+         (mapcan (lambda (entry)
+                   (fossil-ui--timeline-elements entry inner-width)) timeline)
+       (list (fossil-ui--item "No commits available" 'fossil-ui-faded)))
+     outer-width outer-width 0)))
+
+(defun fossil-ui--main-panels (width changes selected timeline)
+  "Return responsive work panels for WIDTH and dashboard data."
+  (if (>= width fossil-ui--wide-layout-width)
+      (let* ((available (1- width))
+             (changes-width (floor (* available 0.64)))
+             (commits-width (- available changes-width)))
+        `(:type :flex :direction :row :gap 1
+          :children (,(fossil-ui--changes-panel changes-width changes selected)
+                     ,(fossil-ui--commits-panel commits-width timeline))))
+    `(:type :flex :direction :column :gap 1
+      :children (,(fossil-ui--changes-panel width changes selected)
+                 ,(fossil-ui--commits-panel width timeline)))))
+
+(defun fossil-ui--banner (title message width face)
+  "Return a full-width status banner with TITLE, MESSAGE and FACE."
+  (fossil-ui--card
+   (propertize title 'face face)
+   (list (fossil-ui--item (fossil-ui--fit message (max 8 (- width 4))) face))
+   width width 0))
+
+(defun fossil-ui--screen-elements (width)
+  "Return dashboard elements for WIDTH."
+  (let* ((root (plist-get textui-state :root))
+         (changes (plist-get textui-state :changes))
+         (selected (plist-get textui-state :selected))
+         (busy (plist-get textui-state :busy))
+         (error-text (plist-get textui-state :error))
+         (remote-value (plist-get textui-state :remote))
+         (project (file-name-nondirectory (directory-file-name root)))
+         (timeline (seq-take (plist-get textui-state :timeline)
+                             (fossil-ui--timeline-count)))
+         (chips (concat
+                 (fossil-ui--chip (if changes (format "%d changed" (length changes))
+                                    "clean")
+                                  (if changes 'warning 'success))
+                 " "
+                 (when selected
+                   (concat (fossil-ui--chip (format "%d selected" (length selected))
+                                            'highlight) " "))
+                 (when busy (fossil-ui--chip (format "running: %s" busy) 'warning))
+                 (when error-text (fossil-ui--chip "error" 'error)))))
+    (append
+     (list
+      (fossil-ui--item
+       (fossil-ui--fit
+        (format "%s  %s" (fossil-ui--icon 'repository) project) width)
+       'fossil-ui-strong)
+      `(:type :flex :direction :row :gap 1
+        :children
+        (,(fossil-ui--keycap "g" "Refresh" #'fossil-ui-refresh 'refresh)
+         ,(fossil-ui--keycap "c" "Commit" #'fossil-ui-commit 'commit)
+         ,(fossil-ui--keycap "u" "Update" #'fossil-ui-update 'update)
+         ,(fossil-ui--keycap "s" "Sync" #'fossil-ui-sync 'sync (not remote-value))
+         ,(fossil-ui--keycap "b" "Branch" #'fossil-ui-switch-branch 'branch)))
+      (fossil-ui--metadata-grid width chips))
+     (when busy
+       (list (fossil-ui--banner "Running" (format "%s is running…" busy)
+                                width 'fossil-ui-warning)))
+     (when error-text
+       (list (fossil-ui--banner "Error" error-text width 'fossil-ui-critical)))
+     (list
+      (fossil-ui--main-panels width changes selected timeline)
+      (fossil-ui--item "? Help · q Close" 'fossil-ui-faded)))))
+
+(defun fossil-ui--frame (width)
+  "Render the Fossil dashboard at WIDTH."
+  (let ((content-width
+         (max 1 (if fossil-ui-content-width
+                    (min width fossil-ui-content-width)
+                  width))))
+    (list `(:type :flex :direction :column :gap 1
+            :layout (:width ,content-width)
+            :children ,(fossil-ui--screen-elements content-width)))))
+
+(defun fossil-ui--path-at-point ()
+  "Return the Fossil path at point."
+  (or (get-text-property (point) 'fossil-ui-path)
+      (get-text-property (line-beginning-position) 'fossil-ui-path)))
+
+(defun fossil-ui--status-at-point ()
+  "Return the Fossil status at point."
+  (or (get-text-property (point) 'fossil-ui-status)
+      (get-text-property (line-beginning-position) 'fossil-ui-status)))
+
+(defun fossil-ui--goto-path (path)
+  "Move point to PATH when it is visible."
+  (goto-char (point-min))
+  (when-let* ((match (text-property-search-forward
+                      'fossil-ui-path path #'equal)))
+    (goto-char (prop-match-beginning match))))
+
+(defun fossil-ui-next-file ()
+  "Move to the next changed file, wrapping at the bottom."
+  (interactive)
+  (let ((origin (point)))
+    (goto-char (min (point-max) (1+ (line-end-position))))
+    (if-let* ((match (text-property-search-forward
+                      'fossil-ui-path nil nil t)))
+        (goto-char (prop-match-beginning match))
+      (goto-char (point-min))
+      (if-let* ((first (text-property-search-forward
+                        'fossil-ui-path nil nil t)))
+          (goto-char (prop-match-beginning first))
+        (goto-char origin)
+        (message "No changed files")))))
+
+(defun fossil-ui-previous-file ()
+  "Move to the previous changed file, wrapping at the top."
+  (interactive)
+  (let (positions)
+    (save-excursion
+      (goto-char (point-min))
+      (while-let ((match (text-property-search-forward
+                          'fossil-ui-path nil nil t)))
+        (push (prop-match-beginning match) positions)
+        (goto-char (prop-match-end match))))
+    (setq positions (nreverse positions))
+    (if-let* ((target (or (car (last (cl-remove-if-not
+                                      (lambda (position) (< position (point)))
+                                      positions)))
+                          (car (last positions)))))
+        (goto-char target)
+      (message "No changed files"))))
+
+(defun fossil-ui-refresh ()
+  "Refresh the current Fossil dashboard."
+  (interactive)
+  (when (plist-get textui-state :busy)
+    (user-error "Fossil is busy: %s" (plist-get textui-state :busy)))
+  (let ((path (fossil-ui--path-at-point))
+        (selected (plist-get textui-state :selected))
+        (root (plist-get textui-state :root)))
+    (condition-case err
+        (let ((next (fossil-ui--snapshot root selected)))
+          (textui-update (current-buffer) (lambda (_) next))
+          (when path (fossil-ui--goto-path path)))
+      (error
+       (textui-set-state (current-buffer) :error (error-message-string err))))))
+
+(defun fossil-ui-toggle-mark ()
+  "Toggle the commit mark on the file at point."
+  (interactive)
+  (let ((path (or (fossil-ui--path-at-point) (user-error "No file at point")))
+        (status (fossil-ui--status-at-point)))
+    (when (string= status "EXTRA")
+      (user-error "Add this file before selecting it for a commit"))
+    (textui-update
+     (current-buffer)
+     (lambda (state)
+       (let* ((next (copy-sequence state))
+              (selected (copy-sequence (plist-get state :selected))))
+         (plist-put next :selected
+                    (if (member path selected)
+                        (delete path selected)
+                      (append selected (list path)))))))
+    (fossil-ui--goto-path path)))
+
+(defun fossil-ui-mark-all ()
+  "Select all managed changes for commit."
+  (interactive)
+  (textui-set-state
+   (current-buffer) :selected
+   (mapcar (lambda (change) (plist-get change :path))
+           (cl-remove-if (lambda (change)
+                           (string= (plist-get change :status) "EXTRA"))
+                         (plist-get textui-state :changes)))))
+
+(defun fossil-ui-unmark-all ()
+  "Clear all commit selections."
+  (interactive)
+  (textui-set-state (current-buffer) :selected nil))
+
+(defun fossil-ui--show-output (title output &optional mode)
+  "Show OUTPUT in a buffer named TITLE, optionally enabling MODE."
+  (let ((buffer (get-buffer-create title)))
+    (with-current-buffer buffer
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (insert output)
+        (goto-char (point-min))
+        (funcall (or mode #'special-mode))))
+    (pop-to-buffer buffer)
+    buffer))
+
+(defvar fossil-ui-diff-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map diff-mode-map)
+    (define-key map (kbd "]c") #'diff-hunk-next)
+    (define-key map (kbd "[c") #'diff-hunk-prev)
+    (define-key map (kbd "TAB") #'outline-toggle-children)
+    (define-key map (kbd "q") #'quit-window)
+    map))
+
+(defconst fossil-ui--diff-evil-bindings
+  '(("]c" . diff-hunk-next)
+    ("[c" . diff-hunk-prev)
+    ("TAB" . outline-toggle-children)
+    ("q" . quit-window))
+  "Bindings which a Fossil diff buffer owns in modal states.")
+
+(define-derived-mode fossil-ui-diff-mode diff-mode "Fossil-Diff"
+  "Mode for a Fossil working-tree diff."
+  (setq-local outline-regexp "^@@ ")
+  (outline-minor-mode 1)
+  (setq buffer-read-only t)
+  (when (fboundp 'general-define-key)
+    (fossil-ui--install-general-local-map fossil-ui--diff-evil-bindings))
+  (when (fboundp 'evil-normalize-keymaps)
+    (evil-normalize-keymaps)))
+
+(defun fossil-ui--delta-render (diff)
+  "Render unified DIFF through Delta and return propertized Emacs text.
+Return nil when Delta exits unsuccessfully."
+  (with-temp-buffer
+    (insert diff)
+    (let ((code (condition-case nil
+                    (apply #'call-process-region
+                           (point-min) (point-max)
+                           fossil-ui-delta-program t t nil
+                           fossil-ui-delta-arguments)
+                  (file-missing 127)
+                  (error 1))))
+      (when (zerop code)
+        (let* ((rendered (ansi-color-apply (buffer-string)))
+               (position 0)
+               (limit (length rendered)))
+          ;; `ansi-color-apply' uses `font-lock-face'.  Promote Delta's faces
+          ;; to ordinary `face' properties so diff-mode fontification cannot
+          ;; overwrite them later.
+          (while (< position limit)
+            (let* ((next (next-single-property-change
+                          position 'font-lock-face rendered limit))
+                   (face (get-text-property position 'font-lock-face rendered)))
+              (when face
+                (add-text-properties position next (list 'face face) rendered)
+                (remove-text-properties position next '(font-lock-face nil)
+                                        rendered))
+              (setq position next)))
+          rendered)))))
+
+(defun fossil-ui--render-diff (diff)
+  "Render unified DIFF according to `fossil-ui-diff-renderer'."
+  (pcase fossil-ui-diff-renderer
+    ('plain diff)
+    ('delta
+     (or (and (executable-find fossil-ui-delta-program)
+              (fossil-ui--delta-render diff))
+         (user-error "Delta could not render this diff")))
+    ('auto
+     (or (and (executable-find fossil-ui-delta-program)
+              (fossil-ui--delta-render diff))
+         diff))
+    (_ (user-error "Unknown Fossil diff renderer: %S"
+                   fossil-ui-diff-renderer))))
+
+(defun fossil-ui-diff ()
+  "Show the diff for the file at point."
+  (interactive)
+  (let* ((path (or (fossil-ui--path-at-point) (user-error "No file at point")))
+         (status (fossil-ui--status-at-point))
+         (root (plist-get textui-state :root))
+         (result (if (string= status "EXTRA")
+                     (fossil-ui--call-in root "xdiff" path)
+                   (fossil-ui--call-in root "diff" "--internal" "--unified" "--" path)))
+         (code (car result))
+         (output (cadr result)))
+    (unless (zerop code)
+      (user-error "%s" output))
+    (fossil-ui--show-output
+     (format "*fossil diff: %s*" path)
+     (if (string-empty-p output)
+         "No textual diff available.\n"
+       (fossil-ui--render-diff output))
+     #'fossil-ui-diff-mode)))
+
+(defun fossil-ui-visit-file ()
+  "Visit the file at point."
+  (interactive)
+  (find-file (expand-file-name
+              (or (fossil-ui--path-at-point) (user-error "No file at point"))
+              (plist-get textui-state :root))))
+
+(defun fossil-ui-add ()
+  "Add the unversioned file at point to Fossil."
+  (interactive)
+  (let ((path (or (fossil-ui--path-at-point) (user-error "No file at point"))))
+    (unless (string= (fossil-ui--status-at-point) "EXTRA")
+      (user-error "%s is already managed" path))
+    (fossil-ui--require-success (plist-get textui-state :root) "add" "--" path)
+    (fossil-ui-refresh)
+    (fossil-ui--goto-path path)
+    (message "Added %s" path)))
+
+(defun fossil-ui-forget ()
+  "Stop tracking the file at point without deleting it."
+  (interactive)
+  (let ((path (or (fossil-ui--path-at-point) (user-error "No file at point"))))
+    (when (string= (fossil-ui--status-at-point) "EXTRA")
+      (user-error "%s is not tracked" path))
+    (when (yes-or-no-p (format "Stop tracking %s? The disk file stays. " path))
+      (fossil-ui--require-success (plist-get textui-state :root) "forget" "--" path)
+      (fossil-ui-refresh)
+      (message "Stopped tracking %s" path))))
+
+(defun fossil-ui--selected-or-current ()
+  "Return selected paths, or the path at point when none are selected."
+  (or (copy-sequence (plist-get textui-state :selected))
+      (and-let* ((path (fossil-ui--path-at-point))) (list path))
+      (user-error "No files selected")))
+
+(defun fossil-ui-revert ()
+  "Revert selected files, or the file at point."
+  (interactive)
+  (let ((paths (fossil-ui--selected-or-current)))
+    (when (yes-or-no-p
+           (format "Revert %d file%s? Fossil undo can restore this once. "
+                   (length paths) (if (= (length paths) 1) "" "s")))
+      (apply #'fossil-ui--require-success
+             (plist-get textui-state :root) "revert" "--" paths)
+      (fossil-ui-refresh)
+      (message "Reverted %d file(s)" (length paths)))))
+
+(defun fossil-ui-undo ()
+  "Preview and run Fossil's one-level undo."
+  (interactive)
+  (let* ((root (plist-get textui-state :root))
+         (preview (fossil-ui--require-success root "undo" "--dry-run")))
+    (if (string-empty-p preview)
+        (message "Fossil has nothing to undo")
+      (when (yes-or-no-p (format "%s\nRun this undo? " preview))
+        (fossil-ui--require-success root "undo")
+        (fossil-ui-refresh)
+        (message "Fossil undo completed")))))
+
+(defun fossil-ui--async (label args &optional on-success)
+  "Run Fossil ARGS asynchronously, displaying LABEL while active."
+  (when (or (plist-get textui-state :busy)
+            (and fossil-ui--process (process-live-p fossil-ui--process)))
+    (user-error "Fossil is already busy"))
+  (let* ((owner (current-buffer))
+         (root (plist-get textui-state :root))
+         (output-buffer (generate-new-buffer (format " *fossil-ui:%s*" label))))
+    (textui-update owner
+                   (lambda (state)
+                     (let ((next (copy-sequence state)))
+                       (setq next (plist-put next :busy label))
+                       (plist-put next :error nil))))
+    (let ((default-directory root))
+      (setq fossil-ui--process
+            (make-process
+             :name (format "fossil-ui-%s" label)
+             :buffer output-buffer
+             :command (cons fossil-ui-program args)
+             :noquery t
+             :sentinel
+             (lambda (process _event)
+               (when (memq (process-status process) '(exit signal))
+                 (let ((code (process-exit-status process))
+                       (output (with-current-buffer (process-buffer process)
+                                 (string-trim (buffer-string)))))
+                   (when (buffer-live-p (process-buffer process))
+                     (kill-buffer (process-buffer process)))
+                   (when (buffer-live-p owner)
+                     (with-current-buffer owner
+                       (setq fossil-ui--process nil)
+                       (if (zerop code)
+                           (progn
+                             (textui-set-state owner :busy nil)
+                             (fossil-ui-refresh)
+                             (when on-success (funcall on-success output))
+                             (message "Fossil %s completed%s"
+                                      label
+                                      (if (string-empty-p output) ""
+                                        (format ": %s" output))))
+                         (textui-update
+                          owner
+                          (lambda (state)
+                            (let ((next (copy-sequence state)))
+                              (setq next (plist-put next :busy nil))
+                              (plist-put next :error
+                                         (if (string-empty-p output)
+                                             (format "%s exited %d" label code)
+                                           output)))))
+                         (fossil-ui--show-output
+                          (format "*fossil error: %s*" label)
+                          (concat output "\n")))))))))))))
+
+(defun fossil-ui--commit-with-message (message paths)
+  "Commit PATHS with MESSAGE from the current Fossil dashboard."
+  (when (string-empty-p (string-trim message))
+    (user-error "Commit message cannot be empty"))
+  (fossil-ui--async
+   "commit"
+   (append (list "commit" "--hash" "--no-prompt" "--comment" message "--") paths)
+   (lambda (_)
+     (when (buffer-live-p (current-buffer))
+       (textui-set-state (current-buffer) :selected nil)))))
+
+(defun fossil-ui-commit (&optional edit)
+  "Commit selected files; with prefix EDIT, use a multiline buffer."
+  (interactive "P")
+  (let ((paths (copy-sequence (plist-get textui-state :selected))))
+    (unless paths
+      (user-error "Select files with SPC before committing"))
+    (if edit
+        (fossil-ui--open-commit-buffer paths)
+      (let ((message (read-string "Commit message: " nil
+                                  'fossil-ui--commit-history)))
+        (fossil-ui--commit-with-message message paths)))))
+
+(defvar fossil-ui-commit-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map text-mode-map)
+    (define-key map (kbd "C-c C-c") #'fossil-ui-commit-submit)
+    (define-key map (kbd "C-c C-k") #'fossil-ui-commit-cancel)
+    map))
+
+(define-derived-mode fossil-ui-commit-mode text-mode "Fossil-Commit"
+  "Major mode for composing a Fossil check-in comment."
+  (setq-local header-line-format
+              "Write a check-in comment · C-c C-c commit · C-c C-k cancel"))
+
+(defun fossil-ui--open-commit-buffer (paths)
+  "Open a multiline commit buffer for PATHS."
+  (let ((owner (current-buffer))
+        (buffer (get-buffer-create
+                 (format "*fossil commit: %s*"
+                         (file-name-nondirectory
+                          (directory-file-name (plist-get textui-state :root)))))))
+    (with-current-buffer buffer
+      (fossil-ui-commit-mode)
+      (setq-local fossil-ui--commit-owner owner
+                  fossil-ui--commit-paths paths)
+      (erase-buffer))
+    (pop-to-buffer buffer)))
+
+(defun fossil-ui-commit-submit ()
+  "Submit the current multiline Fossil commit message."
+  (interactive)
+  (let ((message (string-trim-right (buffer-substring-no-properties
+                                     (point-min) (point-max))))
+        (owner fossil-ui--commit-owner)
+        (paths fossil-ui--commit-paths)
+        (buffer (current-buffer)))
+    (unless (buffer-live-p owner)
+      (user-error "The Fossil dashboard was closed"))
+    (when (string-empty-p (string-trim message))
+      (user-error "Commit message cannot be empty"))
+    (kill-buffer buffer)
+    (pop-to-buffer owner)
+    (with-current-buffer owner
+      (fossil-ui--commit-with-message message paths))))
+
+(defun fossil-ui-commit-cancel ()
+  "Cancel the current multiline Fossil commit."
+  (interactive)
+  (let ((owner fossil-ui--commit-owner))
+    (kill-buffer (current-buffer))
+    (when (buffer-live-p owner) (pop-to-buffer owner))
+    (message "Commit cancelled")))
+
+(defun fossil-ui-update ()
+  "Update the current Fossil branch."
+  (interactive)
+  (fossil-ui--async "update" '("update")))
+
+(defun fossil-ui-sync ()
+  "Synchronize the current Fossil repository."
+  (interactive)
+  (unless (plist-get textui-state :remote)
+    (user-error "This repository has no configured remote"))
+  (fossil-ui--async "sync" '("sync")))
+
+(defun fossil-ui-switch-branch ()
+  "Update the checkout to an existing branch."
+  (interactive)
+  (let* ((branches (or (plist-get textui-state :branches)
+                       (user-error "No branches found")))
+         (current (plist-get textui-state :branch))
+         (branch (completing-read "Update to branch: " branches nil t nil nil current)))
+    (unless (string= branch current)
+      (when (or (null (plist-get textui-state :changes))
+                (yes-or-no-p
+                 (format "Update to %s and merge your local changes into it? " branch)))
+        (fossil-ui--async (format "update %s" branch) (list "update" branch))))))
+
+(defun fossil-ui-help ()
+  "Show the compact Fossil UI key reference."
+  (interactive)
+  (fossil-ui--show-output
+   "*fossil-ui help*"
+   (concat
+    "Fossil UI\n\n"
+    "There is no staging area. [x] only means that the file will be passed\n"
+    "to the next commit from this buffer. Fossil itself is unchanged.\n\n"
+    "SPC       toggle commit selection     A / X     select all / none\n"
+    "RET       show file diff              o         visit file\n"
+    "a         add an unversioned file     f         stop tracking file\n"
+    "r         revert selected/current     U         preview and run undo\n"
+    "c         commit selected files       C-u c     multiline comment\n"
+    "u / s     update / sync               b         switch branch\n"
+    "g         refresh                     j/k,n/p   move between files\n"
+    "q         close\n\n"
+    "In a diff: [c and ]c move between hunks; TAB folds a hunk.\n")))
+
+(defun fossil-ui--card-range ()
+  "Return only the current changed-file widget span for hl-line."
+  (if-let* ((path (fossil-ui--path-at-point))
+            (match (save-excursion
+                     (goto-char (line-beginning-position))
+                     (text-property-search-forward
+                      'fossil-ui-path path #'equal))))
+      (cons (prop-match-beginning match) (prop-match-end match))
+    (cons (point) (point))))
+
+(defun fossil-ui--visible-height ()
+  "Return the smallest body height displaying the current buffer."
+  (let ((windows (get-buffer-window-list (current-buffer) nil t)))
+    (when windows
+      (apply #'min (mapcar #'window-body-height windows)))))
+
+(defun fossil-ui--window-size-changed (_window)
+  "Refresh timeline density when this dashboard's window height changes."
+  (when (and (derived-mode-p 'fossil-ui-mode)
+             (not (bound-and-true-p textui--refreshing)))
+    (when-let* ((height (fossil-ui--visible-height)))
+      (unless (equal height fossil-ui--window-height)
+        (let ((path (fossil-ui--path-at-point)))
+          (setq fossil-ui--window-height height)
+          (textui-set-state (current-buffer) :height height)
+          (when path (fossil-ui--goto-path path)))))))
+
+(defvar fossil-ui-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map textui-mode-map)
+    (define-key map (kbd "SPC") #'fossil-ui-toggle-mark)
+    (define-key map (kbd "A") #'fossil-ui-mark-all)
+    (define-key map (kbd "X") #'fossil-ui-unmark-all)
+    (define-key map (kbd "RET") #'fossil-ui-diff)
+    (define-key map (kbd "<return>") #'fossil-ui-diff)
+    (define-key map (kbd "o") #'fossil-ui-visit-file)
+    (define-key map (kbd "a") #'fossil-ui-add)
+    (define-key map (kbd "f") #'fossil-ui-forget)
+    (define-key map (kbd "r") #'fossil-ui-revert)
+    (define-key map (kbd "U") #'fossil-ui-undo)
+    (define-key map (kbd "c") #'fossil-ui-commit)
+    (define-key map (kbd "u") #'fossil-ui-update)
+    (define-key map (kbd "s") #'fossil-ui-sync)
+    (define-key map (kbd "b") #'fossil-ui-switch-branch)
+    (define-key map (kbd "g") #'fossil-ui-refresh)
+    (define-key map (kbd "?") #'fossil-ui-help)
+    (define-key map (kbd "j") #'fossil-ui-next-file)
+    (define-key map (kbd "n") #'fossil-ui-next-file)
+    (define-key map (kbd "k") #'fossil-ui-previous-file)
+    (define-key map (kbd "p") #'fossil-ui-previous-file)
+    (define-key map (kbd "q") #'quit-window)
+    map))
+
+(define-derived-mode fossil-ui-mode textui-mode "Fossil"
+  "Major mode for the compact Fossil dashboard."
+  (setq-local truncate-lines t
+              cursor-type nil
+              mode-line-format ""
+              hl-line-range-function #'fossil-ui--card-range)
+  (face-remap-set-base 'hl-line 'fossil-ui-selected)
+  (hl-line-mode 1)
+  (add-hook 'window-size-change-functions #'fossil-ui--window-size-changed nil t)
+  (when (fboundp 'general-define-key)
+    (fossil-ui--install-general-local-bindings))
+  (when (fboundp 'evil-normalize-keymaps)
+    (evil-normalize-keymaps)))
+
+(defconst fossil-ui--evil-bindings
+  '(("SPC" . fossil-ui-toggle-mark)
+    ("A" . fossil-ui-mark-all)
+    ("X" . fossil-ui-unmark-all)
+    ("RET" . fossil-ui-diff)
+    ("<return>" . fossil-ui-diff)
+    ("o" . fossil-ui-visit-file)
+    ("a" . fossil-ui-add)
+    ("f" . fossil-ui-forget)
+    ("r" . fossil-ui-revert)
+    ("U" . fossil-ui-undo)
+    ("c" . fossil-ui-commit)
+    ("u" . fossil-ui-update)
+    ("s" . fossil-ui-sync)
+    ("b" . fossil-ui-switch-branch)
+    ("g" . fossil-ui-refresh)
+    ("?" . fossil-ui-help)
+    ("j" . fossil-ui-next-file)
+    ("n" . fossil-ui-next-file)
+    ("k" . fossil-ui-previous-file)
+    ("p" . fossil-ui-previous-file)
+    ("q" . quit-window))
+  "Bindings which the Fossil dashboard owns in modal states.")
+
+(defun fossil-ui--install-general-local-bindings ()
+  "Install buffer-local General overrides for the Fossil dashboard."
+  (fossil-ui--install-general-local-map fossil-ui--evil-bindings))
+
+(defun fossil-ui--install-general-local-map (bindings)
+  "Install buffer-local General overrides from BINDINGS."
+  (general-local-map)
+  (dolist (binding bindings)
+    (general-define-key
+     :states '(normal motion)
+     :keymaps 'general-override-local-mode-map
+     (car binding) (cdr binding)))
+  ;; General marks its global override auxiliaries as Evil intercept maps, but
+  ;; not its buffer-local override auxiliaries.  Promote the latter as well so
+  ;; the local dashboard bindings precede General's global ones.
+  (when (fboundp 'evil-get-auxiliary-keymap)
+    (dolist (state '(normal motion))
+      (evil-make-intercept-map
+       (evil-get-auxiliary-keymap general-override-local-mode-map
+                                  state t t)
+       state))))
+
+(defun fossil-ui--install-evil-bindings ()
+  "Make the Fossil map win over global Evil and General maps."
+  (evil-set-initial-state 'fossil-ui-mode 'normal)
+  (evil-set-initial-state 'fossil-ui-diff-mode 'normal)
+  ;; An intercept map is deliberately used here.  A regular major-mode map is
+  ;; consulted after Evil's normal-state maps, where keys such as `g' and SPC
+  ;; are prefixes.  The dashboard must own its complete one-key vocabulary.
+  (evil-make-intercept-map fossil-ui-mode-map)
+  (dolist (binding fossil-ui--evil-bindings)
+    (evil-define-key* '(normal motion) fossil-ui-mode-map
+      (kbd (car binding)) (cdr binding)))
+  (evil-make-intercept-map fossil-ui-diff-mode-map)
+  (dolist (binding fossil-ui--diff-evil-bindings)
+    (evil-define-key* '(normal motion) fossil-ui-diff-mode-map
+      (kbd (car binding)) (cdr binding)))
+  (dolist (buffer (buffer-list))
+    (with-current-buffer buffer
+      (when (derived-mode-p 'fossil-ui-mode 'fossil-ui-diff-mode)
+        (evil-normalize-keymaps)))))
+
+(with-eval-after-load 'evil
+  (fossil-ui--install-evil-bindings))
+
+(with-eval-after-load 'general
+  (dolist (buffer (buffer-list))
+    (with-current-buffer buffer
+      (when (derived-mode-p 'fossil-ui-mode 'fossil-ui-diff-mode)
+        (fossil-ui--install-general-local-map
+         (if (derived-mode-p 'fossil-ui-diff-mode)
+             fossil-ui--diff-evil-bindings
+           fossil-ui--evil-bindings))
+        (when (fboundp 'evil-normalize-keymaps)
+          (evil-normalize-keymaps))))))
+
+;;;###autoload
+(defun fossil-ui-status (&optional directory)
+  "Open a Fossil dashboard for DIRECTORY or the current checkout."
+  (interactive)
+  (let* ((start (fossil-ui--input-directory directory))
+         (snapshot (fossil-ui--snapshot start))
+         (root (plist-get snapshot :root))
+         (name (format "*fossil: %s*"
+                       (file-name-nondirectory (directory-file-name root))))
+         (existing (get-buffer name)))
+    (when (and existing
+               (with-current-buffer existing
+                 (not (derived-mode-p 'fossil-ui-mode))))
+      (user-error "A non-Fossil buffer already uses %s" name))
+    (let ((buffer (or existing (get-buffer-create name))))
+      (with-current-buffer buffer
+        (unless (derived-mode-p 'fossil-ui-mode)
+          (fossil-ui-mode))
+        (setq-local default-directory root))
+      (textui-open name #'fossil-ui--frame snapshot)
+      (with-current-buffer buffer
+        (when-let* ((height (fossil-ui--visible-height)))
+          (setq fossil-ui--window-height height)
+          (textui-set-state buffer :height height))
+        (fossil-ui-next-file))
+      buffer)))
+
+;;;###autoload
+(defalias 'fossil-ui #'fossil-ui-status)
+
+(provide 'fossil-ui)
+;;; fossil-ui.el ends here