From 15def4cc1edbd5a80973fa9c5bba35d5eb32c340 Mon Sep 17 00:00:00 2001 From: cashmere Date: Sun, 23 Aug 2026 19:19:17 +0200 Subject: feat: refresh Emacs UI and lock Elpaca packages --- lisp/denote-menu.el | 297 +++++++++++++++++++----------- lisp/garden-connect.el | 365 +++++++++++++++++++++++++++++++++++++ lisp/garden-core.el | 372 +++++++++++++++++++++++++++++++++++++ lisp/garden-dashboard.el | 461 ++++++++++++++++++++++++++++++++++++++++++++++ lisp/garden-fleet.el | 464 +++++++++++++++++++++++++++++++++++++++++++++++ lisp/garden-icons.el | 64 +++++++ lisp/garden-links.el | 29 +++ lisp/garden-preview.el | 111 ++++++++++++ lisp/garden-publish.el | 450 +++++++++++++++++++++++++++++++++++++++++++++ lisp/my-mode-line.el | 99 ++++++++-- lisp/rsync-ui.el | 142 ++++++++------- lisp/zfs.el | 292 +++++++++++++++++------------ 12 files changed, 2841 insertions(+), 305 deletions(-) create mode 100644 lisp/garden-connect.el create mode 100644 lisp/garden-core.el create mode 100644 lisp/garden-dashboard.el create mode 100644 lisp/garden-fleet.el create mode 100644 lisp/garden-icons.el create mode 100644 lisp/garden-links.el create mode 100644 lisp/garden-preview.el create mode 100644 lisp/garden-publish.el (limited to 'lisp') diff --git a/lisp/denote-menu.el b/lisp/denote-menu.el index eb1c76c..7e1c8e0 100644 --- a/lisp/denote-menu.el +++ b/lisp/denote-menu.el @@ -8,8 +8,7 @@ ;; A keyboard-first browser for Denote notes built on vui.el. ;; Lists notes from `denote-directory' (silo-aware) in a borderless table with ;; live filtering, column sorting, and one-key actions. Ships its own -;; `denote-menu-mode' derived from `vui-mode' and registers normal-state -;; keys with helix when it is available. +;; `denote-menu-mode' derived from `vui-mode' with Evil normal-state keys. ;;; Code: @@ -17,6 +16,9 @@ (require 'vui-components) (require 'denote) +(declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings)) +(declare-function evil-set-initial-state "evil-core" (mode state)) + (defgroup denote-menu nil "A vui-based browser for Denote notes." :group 'denote @@ -34,10 +36,20 @@ "Width of the file extension column." :type 'integer) +(defcustom denote-menu-wide-breakpoint 78 + "Minimum window width for the sticky table layout." + :type 'integer) + +(defcustom denote-menu-preview-width 0.38 + "Fractional width of the optional note preview side window." + :type 'number) + (defvar-local denote-menu--dispatch nil "Alist of actions and visible paths for the current buffer. Set during render; consumed by the mode's interactive commands.") +(defconst denote-menu--preview-buffer-name "*Denote Preview*") + (defun denote-menu--format-date (identifier) "Format a Denote IDENTIFIER (20260315T120000) as \"2026-03-15 12:00\"." (if (and identifier (string-match "\\`\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)T\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)" identifier)) @@ -94,32 +106,11 @@ Set during render; consumed by the mode's interactive commands.") (string< (funcall key-fn a) (funcall key-fn b)))))) (if sort-desc (nreverse sorted) sorted))) -(defun denote-menu--format-keywords (keywords width) - "Format KEYWORDS as [a,b] fitting WIDTH, collapsing overflow to ,+N." - (let ((parts '()) - (used 0) - (idx 0) - (total (length keywords)) - (done nil)) - (while (and (< idx total) (not done)) - (let* ((kw (nth idx keywords)) - (remaining (- total idx 1)) - (suffix (if (> remaining 0) - (+ 2 (length (number-to-string remaining))) - 0)) - (cost (+ (if parts 1 0) (length kw)))) - (if (<= (+ used cost suffix 2) width) - (setq parts (cons kw parts) - used (+ used cost) - idx (1+ idx)) - (setq done t)))) - (let ((remaining (- total idx))) - (cond - ((> remaining 0) - (if parts - (format "[%s,+%d]" (string-join (nreverse parts) ",") remaining) - (format "[%s...]" (substring (car keywords) 0 (max 1 (- width 5)))))) - (t (format "[%s]" (string-join (nreverse parts) ","))))))) +(defun denote-menu--keywords-label (keywords) + "Return a compact display label for KEYWORDS." + (if keywords + (format "#%s" (string-join keywords " #")) + "untagged")) (defun denote-menu--sort-indicator (sort-key sort-desc) "Human-readable sort indicator for SORT-KEY and SORT-DESC." @@ -131,6 +122,74 @@ Set during render; consumed by the mode's interactive commands.") (format "%s %s" label (if sort-desc "↓" "↑")) label)) +(defun denote-menu--window-width () + "Return the live body width of the window displaying this menu." + (if-let* ((window (get-buffer-window (current-buffer) t))) + (window-body-width window) + (window-width))) + +(defun denote-menu--wide-table (visible sort-key sort-desc width) + "Render VISIBLE as a sticky table using responsive WIDTH columns." + (let* ((date-width (if (>= width 100) denote-menu-date-width 10)) + (keyword-width (max 14 (min denote-menu-keywords-width (/ width 4)))) + (title-width (max 18 (- width date-width keyword-width + denote-menu-ext-width 5)))) + (vui-table + :sticky-header t + :columns (list + (list :header (denote-menu--column-header + "Date" 'date sort-key sort-desc) + :width date-width :truncate t) + (list :header "Type" :width denote-menu-ext-width + :truncate t) + (list :header (denote-menu--column-header + "Keywords" 'keywords sort-key sort-desc) + :width keyword-width :truncate t) + (list :header (denote-menu--column-header + "Title" 'title sort-key sort-desc) + :width title-width :grow t :truncate t)) + :rows + (mapcar + (lambda (note) + (list + (vui-text (plist-get note :date) :face 'shadow) + (vui-text (if-let* ((ext (plist-get note :ext))) + (concat "." ext) + "—") + :face 'shadow) + (vui-text (denote-menu--keywords-label (plist-get note :keywords)) + :face 'font-lock-comment-face) + (vui-button (plist-get note :title) + :key (plist-get note :path) + :no-decoration t :help-echo nil + :on-click (lambda () + (find-file (plist-get note :path)))))) + visible)))) + +(defun denote-menu--compact-card (note width) + "Render NOTE as a two-line card fitting WIDTH." + (let ((path (plist-get note :path))) + (vui-vstack + :spacing 0 + (vui-flex + :width 'window :justify :space-between + (vui-flex-item + :grow 1 + (lambda (available) + (vui-button (plist-get note :title) + :key path :no-decoration t :help-echo nil + :max-width (max 8 available) + :face '(:inherit bold) + :on-click (lambda () (find-file path))))) + (vui-text (format "%s .%s" + (substring (plist-get note :date) 0 10) + (or (plist-get note :ext) "")) + :face 'shadow)) + (vui-box + (vui-text (denote-menu--keywords-label (plist-get note :keywords)) + :face 'font-lock-comment-face) + :width (max 12 (- width 2)) :padding-left 2)))) + (vui-defcomponent denote-menu-app () :state ((query "") (sort-key 'date) @@ -158,96 +217,117 @@ Set during render; consumed by the mode's interactive commands.") (_ 'date)))) :toggle-direction (vui-with-async-context (vui-set-state :sort-desc (not sort-desc))))) - (vui-vstack + (let ((width (denote-menu--window-width))) + (vui-vstack :spacing 1 - (vui-hstack - :spacing 2 - (vui-heading-2 "Denotes") - (vui-text (format "▸ %s" silo) :face '(:inherit success :weight bold)) + (vui-flex + :width 'window :justify :space-between + (vui-hstack + :spacing 2 + (vui-heading-2 "Denotes") + (vui-text (format "▸ %s" silo) + :face '(:inherit success :weight bold))) (vui-text (format "%d%s notes" (length visible) - (if filtering - (format " of %d" (length notes)) - "")) - :face 'shadow) - (vui-button "new" :on-click (lambda () - (let ((file (call-interactively #'denote))) - (when file (funcall (plist-get denote-menu--dispatch :refresh))))) - :help-echo "Create a new note") - (vui-button "export" :on-click #'denote-menu-export-to-dired - :help-echo "Open the visible notes in Dired")) - (vui-text "RET open · / filter · s/S sort · e export · n new · q quit" - :face 'shadow) - (vui-hstack - :spacing 2 + (if filtering (format " / %d" (length notes)) "")) + :face 'shadow)) + (vui-flex + :width 'window :justify :space-between (vui-hstack :spacing 1 - (vui-text "filter:" :face 'shadow) - (if filtering - (vui-text query :face '(:inherit warning :weight bold)) - (vui-text "none (press / to filter)" :face 'shadow))) - (vui-text (format "sort: %s" (denote-menu--sort-indicator sort-key sort-desc)) - :face 'shadow)) + (vui-text "filter" :face 'shadow) + (vui-text (if filtering query "all notes") + :face (if filtering 'warning 'shadow))) + (vui-hstack + :spacing 1 + (vui-text (format "sort %s" + (denote-menu--sort-indicator sort-key sort-desc)) + :face 'shadow) + (vui-button "new" :on-click #'denote-menu-new-note) + (vui-button "dired" :on-click #'denote-menu-export-to-dired))) (if (null visible) (vui-vstack :spacing 1 (vui-box (vui-text "∅" :face '(:inherit shadow :height 2.0)) - :width fill-column :align :center) + :width width :align :center) (vui-box (vui-text (if filtering (format "No notes matching \"%s\"" query) "No notes here yet") :face 'shadow) - :width fill-column :align :center) + :width width :align :center) (vui-box (vui-button "Create the first one" :on-click (lambda () (call-interactively #'denote))) - :width fill-column :align :center)) - (let* ((win (or (get-buffer-window (current-buffer)) (selected-window))) - (title-width (max 10 (- (window-width win) - denote-menu-date-width - denote-menu-ext-width - denote-menu-keywords-width - 4)))) - (vui-table - :columns (list (list :header (denote-menu--column-header "Date" 'date sort-key sort-desc) - :width denote-menu-date-width) - (list :header "" - :width denote-menu-ext-width) - (list :header (denote-menu--column-header "Keywords" 'keywords sort-key sort-desc) - :width denote-menu-keywords-width :truncate t) - (list :header (denote-menu--column-header "Title" 'title sort-key sort-desc) - :width title-width :truncate t)) - :rows (mapcar - (lambda (note) - (list (vui-text (plist-get note :date) :face 'shadow) - (vui-text (if-let* ((ext (plist-get note :ext))) - (concat "." ext) - "") - :face 'shadow) - (if (plist-get note :keywords) - (vui-text (denote-menu--format-keywords - (plist-get note :keywords) - denote-menu-keywords-width) - :face 'font-lock-comment-face) - (vui-text "·" :face 'shadow)) - (vui-button (plist-get note :title) - :key (plist-get note :path) - :no-decoration t - :help-echo nil - :on-click (lambda () (find-file (plist-get note :path)))))) - visible))))))) + :width width :align :center)) + (if (>= width denote-menu-wide-breakpoint) + (denote-menu--wide-table visible sort-key sort-desc width) + (vui-list visible + (lambda (note) (denote-menu--compact-card note width)) + (lambda (note) (plist-get note :path)) + :spacing 1))) + (vui-flex + :width 'window :justify :space-between + (vui-text "j/k move · RET/l open · / filter · p preview" + :face 'shadow) + (vui-text "s/S sort · n new · g refresh · ? help · q close" + :face 'shadow)))))) (defun denote-menu--action (name) "Return the buffer's dispatch action NAME, or signal an error." (or (plist-get denote-menu--dispatch name) (user-error "Denote-explorer is not ready in this buffer"))) +(defun denote-menu--path-on-line () + "Return the note path keyed on the current visual row." + (save-excursion + (beginning-of-line) + (let ((end (line-end-position)) path) + (while (and (not path) (< (point) end)) + (setq path (vui-key-at)) + (forward-char 1)) + path))) + (defun denote-menu-open-at-point () "Open the note at point." (interactive) - (if-let* ((path (vui-key-at))) + (if-let* ((path (or (vui-key-at) (denote-menu--path-on-line)))) (find-file path) (user-error "No note at point"))) +(defun denote-menu-preview-at-point () + "Show the note at point in an opt-in right side window." + (interactive) + (if-let* ((path (or (vui-key-at) (denote-menu--path-on-line)))) + (let ((buffer (get-buffer-create denote-menu--preview-buffer-name))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-file-contents path) + (org-mode) + (setq-local buffer-file-name path) + (setq-local mode-line-format nil) + (goto-char (point-min)) + (view-mode 1))) + (display-buffer-in-side-window + buffer `((side . right) + (slot . 1) + (window-width . ,denote-menu-preview-width)))) + (user-error "No note at point"))) + +(defun denote-menu-help () + "Show the Denote Menu key summary." + (interactive) + (message "Denote Menu: j/k move, TAB/S-TAB widgets, RET/l open, / filter, p preview, n new, s/S sort, e Dired, g refresh, h/q close")) + +(defun denote-menu-quit () + "Close the menu and its optional preview." + (interactive) + (when-let* ((preview (get-buffer denote-menu--preview-buffer-name)) + (window (get-buffer-window preview t))) + (delete-window window)) + (when-let* ((preview (get-buffer denote-menu--preview-buffer-name))) + (kill-buffer preview)) + (vui-quit)) + (defun denote-menu-filter () "Prompt for a filter query." (interactive) @@ -299,14 +379,25 @@ for `denote-directory' and silently drop the file-list filter." (defvar denote-menu-mode-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map vui-mode-map) (define-key map (kbd "RET") #'denote-menu-open-at-point) + (define-key map (kbd "l") #'denote-menu-open-at-point) + (define-key map (kbd "j") #'next-line) + (define-key map (kbd "k") #'previous-line) + (define-key map (kbd "TAB") #'vui-forward) + (define-key map (kbd "") #'vui-backward) + (define-key map (kbd "p") #'denote-menu-preview-at-point) (define-key map (kbd "n") #'denote-menu-new-note) (define-key map (kbd "e") #'denote-menu-export-to-dired) (define-key map (kbd "r") #'denote-menu-refresh) + (define-key map (kbd "g") #'denote-menu-refresh) (define-key map (kbd "/") #'denote-menu-filter) (define-key map (kbd "c") #'denote-menu-clear-filter) (define-key map (kbd "s") #'denote-menu-cycle-sort) (define-key map (kbd "S") #'denote-menu-toggle-sort-direction) + (define-key map (kbd "?") #'denote-menu-help) + (define-key map (kbd "h") #'denote-menu-quit) + (define-key map (kbd "q") #'denote-menu-quit) map) "Keymap for `denote-menu-mode'.") @@ -319,18 +410,20 @@ across re-renders. :group 'denote-menu (hl-line-mode 1)) +(with-eval-after-load 'evil + (evil-set-initial-state 'denote-menu-mode 'normal) + (evil-define-key* '(normal motion) denote-menu-mode-map + (kbd "j") #'next-line + (kbd "k") #'previous-line + (kbd "RET") #'denote-menu-open-at-point + (kbd "l") #'denote-menu-open-at-point + (kbd "h") #'denote-menu-quit + (kbd "q") #'denote-menu-quit + (kbd "g") #'denote-menu-refresh + (kbd "/") #'denote-menu-filter + (kbd "p") #'denote-menu-preview-at-point + (kbd "?") #'denote-menu-help)) -(with-eval-after-load 'helix - (helix-define-key 'normal "RET" #'denote-menu-open-at-point 'denote-menu-mode) - (helix-define-key 'normal "o" #'denote-menu-open-at-point 'denote-menu-mode) - (helix-define-key 'normal "/" #'denote-menu-filter 'denote-menu-mode) - (helix-define-key 'normal "c" #'denote-menu-clear-filter 'denote-menu-mode) - (helix-define-key 'normal "s" #'denote-menu-cycle-sort 'denote-menu-mode) - (helix-define-key 'normal "S" #'denote-menu-toggle-sort-direction 'denote-menu-mode) - (helix-define-key 'normal "e" #'denote-menu-export-to-dired 'denote-menu-mode) - (helix-define-key 'normal "n" #'denote-menu-new-note 'denote-menu-mode) - (helix-define-key 'normal "r" #'denote-menu-refresh 'denote-menu-mode) - (helix-define-key 'normal "q" #'vui-quit 'denote-menu-mode)) ;;;###autoload (defun denote-menu () diff --git a/lisp/garden-connect.el b/lisp/garden-connect.el new file mode 100644 index 0000000..6c6ffee --- /dev/null +++ b/lisp/garden-connect.el @@ -0,0 +1,365 @@ +;;; garden-connect.el --- unlinked-reference connector -*- lexical-binding: t; -*- + +(require 'garden-core) +(require 'garden-icons) +(require 'garden-fleet) +(require 'vui) +(require 'vui-components) + +(declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings)) +(declare-function evil-set-initial-state "evil-core" (mode state)) + +(defcustom garden-connect-min-title-length 3 "Minimum title length for a note to be scanned for mentions." :type 'integer :group 'garden) +(defcustom garden-connect-max-results 80 "Maximum number of unlinked references shown at once." :type 'integer :group 'garden) +(defcustom garden-connect-max-line 1500 "Maximum line length in characters before a line is skipped." :type 'integer :group 'garden) + +(defvar-local garden--ref-target nil + "Cons of (ID . TITLE) of the note shown in the connect buffer.") + +(defvar-local garden-connect--dispatch nil + "Async component actions exposed to `garden-connect-mode' commands.") + +(defun garden--long-line-p () + "Whether the current line exceeds `garden-connect-max-line'." + (> (- (line-end-position) (line-beginning-position)) garden-connect-max-line)) + +(defun garden--in-link-p (pos) + "Whether POS is inside an Org bracket link." + (save-excursion + (goto-char pos) + (let ((bol (line-beginning-position)) (depth 0)) + (goto-char bol) + (while (< (point) pos) + (cond ((looking-at "\\[\\[") (setq depth (1+ depth)) (forward-char 2)) + ((looking-at "\\]\\]") (when (> depth 0) (setq depth (1- depth))) (forward-char 2)) + (t (forward-char 1)))) + (> depth 0)))) + +(defun garden--in-block-p (pos) + "Whether POS is inside an Org src or example block." + (save-excursion + (save-match-data + (goto-char pos) + (let ((case-fold-search t)) + (and (re-search-backward "^[ \t]*#\\+\\(begin\\|end\\)_\\(src\\|example\\)\\>" nil t) + (string-equal (downcase (match-string 1)) "begin")))))) + +(defun garden--denote-link-text (id matched) + "Return a denote link to ID with MATCHED as the description." + (format "[[denote:%s][%s]]" id matched)) + +(defun garden--note-list () + "Return all garden notes as a list." + (let (acc) (maphash (lambda (_ n) (push n acc)) (garden-notes)) acc)) + +(defun garden-unlinked-references-for (id title) + "Find notes that mention TITLE without linking to the note ID. +Return a list of plists with the first mention found per note." + (let ((re (concat "\\_<" (regexp-quote title) "\\_>")) + (case-fold-search t) + (results '())) + (dolist (note (garden--note-list)) + (unless (or (equal (garden-note-id note) id) + (member id (garden-note-links note))) + (with-temp-buffer + (insert-file-contents (garden-note-file note)) + (goto-char (point-min)) + (catch 'found + (while (re-search-forward re nil t) + (let ((mb (match-beginning 0))) + (if (garden--long-line-p) + (goto-char (line-end-position)) + (save-excursion + (goto-char mb) + (beginning-of-line) + (when (and (not (looking-at-p "[ \t]*\\(#\\+\\|:[A-Za-z]\\)")) + (not (garden--in-link-p mb)) + (not (garden--in-block-p mb))) + (push (list :id (garden-note-id note) + :title (garden-note-title note) + :file (garden-note-file note) + :beg mb + :line (line-number-at-pos mb) + :context (string-trim (buffer-substring + (line-beginning-position) + (line-end-position)))) + results) + (throw 'found t)))))))))) + (nreverse results))) + +(defun garden-linkify (file beg id title) + "Replace the mention of TITLE at BEG in FILE with a link to ID. +Save FILE afterwards." + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char beg) + (let ((case-fold-search t) + (re (concat "\\_<" (regexp-quote title) "\\_>"))) + (when (looking-at re) + (let ((matched (match-string 0))) + (unless (save-match-data (or (garden--in-link-p beg) (garden--in-block-p beg))) + (replace-match (garden--denote-link-text id matched) t t)))))) + (save-buffer))) + +(defun garden--read-note () + "Prompt for a garden note and return its id." + (let* ((table (let (acc) + (maphash (lambda (_id n) (push (cons (garden-note-title n) n) acc)) (garden-notes)) + acc)) + (annotate (lambda (title) + (when-let* ((note (cdr (assoc title table)))) + (garden-note-annotation note)))) + (choice (completing-read "Find unlinked references to: " + (garden-completion-table (mapcar #'car table) annotate) nil t))) + (garden-note-id (cdr (assoc choice table))))) + +(defun garden--current-note-id () + "Return the note id of the current buffer's file, or nil." + (and (buffer-file-name) + (let ((id (garden--file-id (buffer-file-name)))) + (and id (garden-note id) id)))) + +(defun garden-connect--window-width () + "Return the body width of the window displaying the connect buffer." + (if-let* ((window (get-buffer-window (current-buffer) t))) + (window-body-width window) + (window-width))) + +(defun garden-connect--scan (id title) + "Return the capped unlinked-reference scan for ID and TITLE." + (seq-take (garden-unlinked-references-for id title) + garden-connect-max-results)) + +(defun garden--ref-card (ref id title on-linked) + "Render REF as a narrow card for target ID and TITLE. +Call ON-LINKED after successfully adding its link." + (let ((file (plist-get ref :file)) + (line (plist-get ref :line)) + (beg (plist-get ref :beg))) + (vui-vstack :spacing 0 + (vui-flex :width 'window :justify :space-between + (vui-flex-item :grow 1 + (lambda (width) + (vui-button (plist-get ref :title) + :key file :no-decoration t :max-width width + :face '(:inherit bold) + :on-click (lambda () + (find-file file) + (goto-char (point-min)) + (forward-line (1- line)))))) + (vui-muted (format "line %d" line)) + (vui-button (concat (garden-icon 'link) " link") + :on-click (lambda () + (garden-linkify file beg id title) + (garden-refresh) + (garden-fleet--refresh) + (funcall on-linked)))) + (vui-box (vui-text (plist-get ref :context) :face 'shadow) + :width (max 12 (- (garden-connect--window-width) 2)) + :padding-left 2)))) + +(defun garden-connect--table (refs id title on-linked width) + "Render REFS as a sticky review table for ID and TITLE at WIDTH." + (let ((context-width (max 22 (- width 34)))) + (vui-table + :sticky-header t + :columns `((:header "Note" :width 20 :grow t :truncate t) + (:header "Line" :width 6 :align :right) + (:header "Mention" :width ,context-width :grow t :truncate t) + (:header "" :width 7)) + :rows + (mapcar + (lambda (ref) + (let ((file (plist-get ref :file)) + (line (plist-get ref :line)) + (beg (plist-get ref :beg))) + (list + (vui-button (plist-get ref :title) + :key file :no-decoration t :help-echo file + :on-click (lambda () + (find-file file) + (goto-char (point-min)) + (forward-line (1- line)))) + (vui-text (number-to-string line) :face 'shadow) + (vui-text (plist-get ref :context) :face 'shadow) + (vui-button "link" :face 'success + :on-click (lambda () + (garden-linkify file beg id title) + (garden-refresh) + (garden-fleet--refresh) + (funcall on-linked)))))) + refs)))) + +(defun garden--linkify-note (file id title) + "Link the first valid mention of TITLE in FILE to ID. +Return the number of replacements made." + (let ((re (concat "\\_<" (regexp-quote title) "\\_>")) + (case-fold-search t) + (n 0)) + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (catch 'done + (while (re-search-forward re nil t) + (let ((mb (match-beginning 0)) + (matched (match-string 0))) + (cond + ((garden--long-line-p) (goto-char (line-end-position))) + ((save-match-data + (save-excursion + (goto-char mb) + (or (progn (beginning-of-line) + (looking-at-p "[ \t]*\\(#\\+\\|:[A-Za-z]\\)")) + (garden--in-link-p mb) + (garden--in-block-p mb))))) + (t (replace-match (garden--denote-link-text id matched) t t) + (setq n 1) + (throw 'done t))))))) + (when (> n 0) (save-buffer))) + n)) + +(defun garden-connect-all (&optional id title) + "Link every note that mentions the target note, after confirming. +When called interactively, ID and TITLE default to the note shown in +the current connect buffer." + (interactive) + (let* ((id (or id (car garden--ref-target))) + (title (or title (cdr garden--ref-target))) + (refs (garden-unlinked-references-for id title)) + (files (delete-dups (mapcar (lambda (r) (plist-get r :file)) refs))) + (n 0)) + (when (and refs + (yes-or-no-p (format "Connect all %d note(s) that mention “%s”? " (length refs) title))) + (dolist (f files) (setq n (+ n (garden--linkify-note f id title)))) + (garden-refresh) + (message "garden: connected %d note(s) to %s" n title)))) + +(vui-defcomponent garden-references (id title) + :state ((refs (garden-connect--scan id title)) + (busy nil) + (status nil)) + :render + (let* ((width (garden-connect--window-width)) + (rescan (vui-async-callback () + (vui-batch + (vui-set-state :busy t) + (vui-set-state :status nil)) + (garden-refresh) + (vui-batch + (vui-set-state :refs (garden-connect--scan id title)) + (vui-set-state :busy nil)))) + (linked (vui-async-callback () + (vui-set-state :refs (garden-connect--scan id title))))) + (setq garden-connect--dispatch (list :refresh rescan)) + (vui-vstack + :spacing 1 :indent 2 + (vui-flex + :width 'window :justify :space-between + (vui-heading-2 (format "%s connect" (garden-icon 'link))) + (vui-text (format "%d / %d max" (length refs) garden-connect-max-results) + :face 'shadow)) + (vui-text title :face '(:inherit outline-2 :weight bold)) + (vui-muted "Review first mentions one by one; bulk linking always asks for confirmation.") + (vui-hstack + :spacing 2 + (when refs + (vui-button (concat (garden-icon 'link) " link all") + :face 'warning + :on-click (lambda () + (garden-connect-all id title) + (funcall rescan)))) + (vui-button (concat (garden-icon 'refresh) " rescan") + :on-click rescan) + (vui-button (concat (garden-icon 'star) " another note") + :on-click #'garden-connect-pick)) + (cond + (busy (vui-warning "Scanning the garden…")) + ((null refs) + (vui-vstack + :spacing 1 + (vui-box (vui-text (garden-icon 'sparkle) + :face '(:inherit success :height 2.0)) + :width width :align :center) + (vui-box (vui-success "All linked up") :width width :align :center) + (vui-box (vui-muted "Every mention already points back to this note") + :width width :align :center))) + ((>= width 88) + (garden-connect--table refs id title linked width)) + (t + (vui-list refs + (lambda (ref) (garden--ref-card ref id title linked)) + (lambda (ref) (plist-get ref :file)) + :spacing 1))) + (when status (vui-text (car status) :face (cdr status))) + (vui-flex :width 'window :justify :space-between + (vui-muted "j/k move · TAB/S-TAB elements · RET/l activate") + (vui-muted "g rescan · ? help · h/q close"))))) + +(defun garden-connect-refresh () + "Rescan the current connect target." + (interactive) + (if-let* ((fn (plist-get garden-connect--dispatch :refresh))) + (funcall fn) + (user-error "Connect view is not ready"))) + +(defun garden-connect-help () + "Show keyboard help for the connect review screen." + (interactive) + (message "Garden Connect: j/k move, TAB/S-TAB elements, RET/l activate, g rescan, h/q close")) + +(defvar garden-connect-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map vui-mode-map) + (keymap-set map "j" #'next-line) + (keymap-set map "k" #'previous-line) + (keymap-set map "TAB" #'vui-forward) + (keymap-set map "" #'vui-backward) + (keymap-set map "RET" #'vui-activate) + (keymap-set map "l" #'vui-activate) + (keymap-set map "g" #'garden-connect-refresh) + (keymap-set map "?" #'garden-connect-help) + (keymap-set map "h" #'vui-quit) + (keymap-set map "q" #'vui-quit) + map)) + +(define-derived-mode garden-connect-mode vui-mode "Garden-Connect" + "Review unlinked Garden references." + (hl-line-mode 1)) + +(with-eval-after-load 'evil + (evil-set-initial-state 'garden-connect-mode 'normal) + (evil-define-key* '(normal motion) garden-connect-mode-map + (kbd "j") #'next-line (kbd "k") #'previous-line + (kbd "RET") #'vui-activate (kbd "l") #'vui-activate + (kbd "g") #'garden-connect-refresh (kbd "?") #'garden-connect-help + (kbd "h") #'vui-quit (kbd "q") #'vui-quit)) + +(defun garden--connect-show (id) + "Open the connect buffer for the note with ID." + (let ((note (garden-note id))) + (unless note (user-error "Not a garden note")) + (let ((title (garden-note-title note))) + (let ((buffer (get-buffer-create "*garden connect*"))) + (with-current-buffer buffer + (garden-connect-mode) + (setq-local garden--ref-target (cons id title)) + (vui-mount (vui-component 'garden-references :id id :title title) buffer) + (vui-rerender-on-resize)) + (switch-to-buffer buffer))))) + +;;;###autoload +(defun garden-connect () + "Show unlinked references to the current note, or prompt for one." + (interactive) + (garden-build) + (garden--connect-show (or (garden--current-note-id) (garden--read-note)))) + +;;;###autoload +(defun garden-connect-pick () + "Prompt for a note and show its unlinked references." + (interactive) + (garden-build) + (garden--connect-show (garden--read-note))) + +(provide 'garden-connect) +;;; garden-connect.el ends here diff --git a/lisp/garden-core.el b/lisp/garden-core.el new file mode 100644 index 0000000..79fc3a8 --- /dev/null +++ b/lisp/garden-core.el @@ -0,0 +1,372 @@ +;;; garden-core.el --- garden model -*- lexical-binding: t; -*- + +(require 'cl-lib) +(require 'seq) +(require 'subr-x) + +(defvar denote-directory) +(declare-function org-update-all-dblocks "org") + +(defgroup garden nil "A cute Denote-based digital garden." :group 'denote) + +(defcustom garden-directory (expand-file-name "~/garden/") + "Directory holding the garden's Denote notes." + :type 'directory :group 'garden) + +(defcustom garden-data-file (expand-file-name ".garden/tags.eld" garden-directory) + "File persisting the topic/meta overrides for keywords." + :type 'file :group 'garden) + +(defcustom garden-meta-frequency 0.30 + "Fraction of notes a keyword must reach to count as a meta tag." + :type 'number :group 'garden) + +(defcustom garden-suggest-excluded-tags '("fleet" "capture") + "Status tags never offered by `garden-suggest-tags'." + :type '(repeat string) :group 'garden) + +(cl-defstruct garden-note + "A garden note parsed from a Denote file." id title keywords file links) + +(defvar garden--notes nil + "Hash table of note id to `garden-note', or nil before the first build.") +(defvar garden--backlinks nil + "Hash table of note id to the ids linking to it.") +(defvar garden--keyword-counts nil + "Cached hash table of keyword to number of notes carrying it.") +(defvar garden--meta-overrides nil + "Alist of keyword to explicit meta flag, loaded from `garden-data-file'.") +(defvar garden--suggest-cache (make-hash-table :test 'equal) + "Cache of file to (MTIME . SUGGESTIONS) for `garden-suggest-tags'.") + +(defconst garden--id-regexp "\\`\\([0-9]\\{8\\}T[0-9]\\{6\\}\\)" + "Regexp matching the Denote identifier at the start of a file name.") +(defconst garden--link-regexp "\\[\\[denote:\\([0-9]\\{8\\}T[0-9]\\{6\\}\\)" + "Regexp matching the target id of a denote link.") + +(defun garden--note-files () + "Return all Denote-named org files in `garden-directory'." + (directory-files garden-directory t "\\`[0-9]\\{8\\}T[0-9]\\{6\\}.*\\.org\\'")) + +(defun garden--file-id (file) + "Return the Denote identifier of FILE, or nil." + (let ((base (file-name-nondirectory file))) + (when (string-match garden--id-regexp base) (match-string 1 base)))) + +(defun garden--file-keywords (file) + "Return the keywords encoded in FILE's name, minus provenance tags." + (let ((base (file-name-nondirectory file))) + (when (string-match "__\\([a-zA-Z0-9_-]+\\)\\.org\\'" base) + (seq-remove (lambda (k) (member k '("wiki" ""))) + (split-string (match-string 1 base) "_" t))))) + +(defun garden--file-title (file) + "Return the #+title of FILE, falling back to its base name." + (with-temp-buffer + (insert-file-contents file nil 0 2000) + (goto-char (point-min)) + (if (re-search-forward "^#\\+title:[ \t]*\\(.*\\)$" nil t) + (string-trim (match-string 1)) + (file-name-base file)))) + +(defun garden--file-links (file id) + "Return the ids FILE links to, excluding ID itself." + (let ((links '())) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward garden--link-regexp nil t) + (let ((target (match-string 1))) + (unless (equal target id) (push target links))))) + (delete-dups (nreverse links)))) + +(defun garden-build () + "Rebuild the in-memory note index from `garden-directory'." + (let ((notes (make-hash-table :test 'equal))) + (dolist (file (garden--note-files)) + (let ((id (garden--file-id file))) + (when id + (puthash id (make-garden-note :id id + :title (garden--file-title file) + :keywords (garden--file-keywords file) + :file file + :links (garden--file-links file id)) + notes)))) + (let ((backlinks (make-hash-table :test 'equal))) + (maphash (lambda (id note) + (dolist (target (garden-note-links note)) + (when (gethash target notes) + (push id (gethash target backlinks))))) + notes) + (setq garden--notes notes + garden--backlinks backlinks + garden--keyword-counts nil)) + (clrhash garden--suggest-cache) + (garden--load-overrides) + garden--notes)) + +(defun garden-notes () + "Return the note index, building it on first use." + (or garden--notes (garden-build))) + +(defun garden-note (id) + "Return the `garden-note' with ID, or nil." + (gethash id (garden-notes))) + +(defun garden-backlinks (id) + "Return the ids of notes linking to ID." + (garden-notes) + (gethash id garden--backlinks)) + +(defun garden-internal-links (note) + "Return NOTE's outgoing links that resolve to garden notes." + (seq-filter #'garden-note (garden-note-links note))) + +(defun garden-degree (id) + "Return the total number of links in and out of note ID." + (let ((note (garden-note id))) + (+ (length (garden-internal-links note)) + (length (garden-backlinks id))))) + +(defun garden-all-ids () + "Return the ids of all notes in the garden." + (let (ids) (maphash (lambda (id _n) (push id ids)) (garden-notes)) ids)) + +(defun garden-note-count () + "Return the number of notes in the garden." + (hash-table-count (garden-notes))) + +(defun garden-link-count () + "Return the number of internal links across all notes." + (let ((s 0)) + (maphash (lambda (_id note) (setq s (+ s (length (garden-internal-links note))))) (garden-notes)) + s)) + +(defun garden-orphans () + "Return the ids of notes with no links in or out." + (seq-filter (lambda (id) (zerop (garden-degree id))) (garden-all-ids))) + +(defun garden-hubs (&optional n) + "Return the N (default 6) best-connected note ids, descending." + (seq-take (seq-sort-by #'garden-degree #'> + (seq-filter (lambda (id) (> (garden-degree id) 0)) (garden-all-ids))) + (or n 6))) + +(defun garden-recent (&optional n) + "Return the N (default 6) most recent note ids." + (seq-take (seq-sort #'string> (garden-all-ids)) (or n 6))) + +(defun garden-keyword-counts () + "Return a hash table of keyword to note count, cached per build." + (or garden--keyword-counts + (let ((counts (make-hash-table :test 'equal))) + (maphash (lambda (_id note) + (dolist (k (garden-note-keywords note)) + (puthash k (1+ (gethash k counts 0)) counts))) + (garden-notes)) + (setq garden--keyword-counts counts)))) + +(defun garden-keywords-sorted () + "Return an alist of (KEYWORD . COUNT) sorted by descending count." + (let (alist) + (maphash (lambda (k c) (push (cons k c) alist)) (garden-keyword-counts)) + (seq-sort-by #'cdr #'> alist))) + +(defun garden-meta-tag-p (keyword) + "Return non-nil when KEYWORD is a meta tag rather than a topic. +Overrides in `garden--meta-overrides' win; otherwise a keyword is +meta when it appears in at least `garden-meta-frequency' of notes." + (let ((ov (assoc keyword garden--meta-overrides))) + (if ov (cdr ov) + (>= (/ (float (gethash keyword (garden-keyword-counts) 0)) + (max 1 (garden-note-count))) + garden-meta-frequency)))) + +(defun garden-topic-keywords () + "Return the (KEYWORD . COUNT) alist of topic keywords." + (seq-remove (lambda (kc) (garden-meta-tag-p (car kc))) (garden-keywords-sorted))) + +(defun garden-meta-keywords () + "Return the (KEYWORD . COUNT) alist of meta keywords." + (seq-filter (lambda (kc) (garden-meta-tag-p (car kc))) (garden-keywords-sorted))) + +(defun garden-notes-with-keyword (keyword) + "Return the notes tagged with KEYWORD, sorted by title." + (let (acc) + (maphash (lambda (_id note) + (when (member keyword (garden-note-keywords note)) (push note acc))) + (garden-notes)) + (seq-sort-by #'garden-note-title #'string< acc))) + +(defun garden--suggest-candidates (current) + "Return suggestible keywords: all topics not in CURRENT." + (seq-remove (lambda (k) + (or (member k current) + (member k garden-suggest-excluded-tags) + (garden-meta-tag-p k))) + (mapcar #'car (garden-keywords-sorted)))) + +(defun garden--count-matches (regexp text cap) + "Count occurrences of REGEXP in TEXT, stopping at CAP." + (let ((start 0) (hits 0)) + (while (and (< hits cap) (string-match regexp text start)) + (setq hits (1+ hits)) + (setq start (match-end 0))) + hits)) + +(defun garden--cooccurrence-counts (topics id) + "Tally keywords of notes other than ID that share a tag in TOPICS." + (let ((counts (make-hash-table :test 'equal))) + (when topics + (maphash (lambda (other-id note) + (unless (equal other-id id) + (let ((kws (garden-note-keywords note))) + (when (seq-intersection topics kws) + (dolist (k kws) + (puthash k (1+ (gethash k counts 0)) counts)))))) + (garden-notes))) + counts)) + +(defun garden--suggest-score (keyword title content linked cooc) + "Score KEYWORD against TITLE, CONTENT, LINKED keywords and COOC tallies." + (let ((regexp (concat "\\b" (regexp-quote keyword) "\\b"))) + (+ (if (string-match-p regexp title) 3 0) + (garden--count-matches regexp content 5) + (* 2 (seq-count (lambda (k) (equal k keyword)) linked)) + (min 3 (gethash keyword cooc 0))))) + +(defun garden--compute-suggestions (file limit) + "Compute up to LIMIT suggested tags for FILE, best first." + (let* ((id (garden--file-id file)) + (note (and id (garden-note id))) + (current (garden--file-keywords file)) + (topics (seq-difference current garden-suggest-excluded-tags)) + (title (downcase (garden--file-title file))) + (content (downcase (with-temp-buffer (insert-file-contents file) (buffer-string)))) + (linked (and note + (seq-mapcat (lambda (target) + (let ((n (garden-note target))) + (and n (garden-note-keywords n)))) + (garden-note-links note)))) + (cooc (garden--cooccurrence-counts topics id)) + (scored (seq-keep (lambda (k) + (let ((score (garden--suggest-score k title content linked cooc))) + (when (> score 0) (cons k score)))) + (garden--suggest-candidates current)))) + (mapcar #'car (seq-take (seq-sort-by #'cdr #'> scored) limit)))) + +(defun garden-suggest-tags (file &optional limit) + "Return up to LIMIT (default 3) suggested topic tags for FILE. +Results are cached per file modification time." + (let ((mtime (file-attribute-modification-time (file-attributes file))) + (cached (gethash file garden--suggest-cache))) + (if (and cached (equal (car cached) mtime)) + (cdr cached) + (let ((tags (garden--compute-suggestions file (or limit 3)))) + (puthash file (cons mtime tags) garden--suggest-cache) + tags)))) + +(defun garden--load-overrides () + "Load keyword meta overrides from `garden-data-file'." + (setq garden--meta-overrides + (when (file-exists-p garden-data-file) + (with-temp-buffer + (insert-file-contents garden-data-file) + (ignore-errors (read (current-buffer))))))) + +(defun garden--save-overrides () + "Persist keyword meta overrides to `garden-data-file'." + (make-directory (file-name-directory garden-data-file) t) + (with-temp-file garden-data-file (prin1 garden--meta-overrides (current-buffer)))) + +(defun garden-toggle-meta (keyword) + "Flip KEYWORD between topic and meta, persisting the override." + (setf (alist-get keyword garden--meta-overrides nil nil #'equal) + (not (garden-meta-tag-p keyword))) + (garden--save-overrides)) + +(defun garden-refresh () + "Rebuild the garden index." + (interactive) + (garden-build)) + +(defun garden-delete-note (id) + "Move the note with ID to the system trash after confirmation. +Kills any buffer visiting it and rebuilds the index. Returns +non-nil when the note was actually deleted." + (let* ((note (garden-note id)) + (file (garden-note-file note))) + (when (yes-or-no-p (format "Move “%s” to the trash? " (garden-note-title note))) + (when-let* ((buf (find-buffer-visiting file))) + (kill-buffer buf)) + (let ((delete-by-moving-to-trash t)) + (delete-file file t)) + (garden-build) + (message "garden: trashed %s" (garden-note-title note)) + t))) + +(defun garden-completion-table (candidates annotate) + "Build a completion table over CANDIDATES with annotations. +ANNOTATE is called with a candidate string and returns the +annotation suffix. Candidate order is preserved in completion +UIs that honor `display-sort-function'." + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata (annotation-function . ,annotate) + (display-sort-function . identity) + (cycle-sort-function . identity)) + (complete-with-action action candidates string pred)))) + +(defun garden-note-annotation (note) + "Return a completion annotation for NOTE: its date and keywords." + (let ((id (garden-note-id note))) + (propertize (format " %s-%s-%s · %s" + (substring id 0 4) (substring id 4 6) (substring id 6 8) + (string-join (garden-note-keywords note) " ")) + 'face 'completions-annotations))) + +(defun garden--dblock-files () + "Return the note files containing denote dynamic blocks." + (seq-filter (lambda (f) + (with-temp-buffer + (insert-file-contents f) + (goto-char (point-min)) + (re-search-forward "^#\\+BEGIN: denote" nil t))) + (garden--note-files))) + +(defun garden-update-indexes () + "Refresh the denote dynamic blocks in every note that has one." + (interactive) + (require 'denote) + (require 'denote-org) + (let ((denote-directory (file-name-as-directory (expand-file-name garden-directory))) + (updated 0)) + (dolist (file (garden--dblock-files)) + (with-current-buffer (find-file-noselect file) + (org-update-all-dblocks) + (when (buffer-modified-p) (save-buffer) (setq updated (1+ updated))))) + (when (called-interactively-p 'interactive) + (message "garden: refreshed link indexes in %d note(s)" updated)) + updated)) + +(defun garden--before-save-update-dblocks () + "Update denote dynamic blocks before saving a garden note." + (when (and (derived-mode-p 'org-mode) + buffer-file-name + (string-prefix-p (file-name-as-directory (expand-file-name garden-directory)) + (expand-file-name buffer-file-name)) + (save-excursion (goto-char (point-min)) + (re-search-forward "^#\\+BEGIN: denote" nil t))) + (require 'denote-org) + (let ((denote-directory (file-name-as-directory (expand-file-name garden-directory)))) + (org-update-all-dblocks)))) + +(define-minor-mode garden-auto-index-mode + "Keep denote dynamic blocks in garden notes fresh on save." + :global t + (if garden-auto-index-mode + (add-hook 'before-save-hook #'garden--before-save-update-dblocks) + (remove-hook 'before-save-hook #'garden--before-save-update-dblocks))) + +(provide 'garden-core) +;;; garden-core.el ends here diff --git a/lisp/garden-dashboard.el b/lisp/garden-dashboard.el new file mode 100644 index 0000000..4fb833b --- /dev/null +++ b/lisp/garden-dashboard.el @@ -0,0 +1,461 @@ +;;; garden-dashboard.el --- cute garden explorer -*- lexical-binding: t; -*- + +(require 'garden-core) +(require 'garden-icons) +(require 'garden-preview) +(require 'garden-connect) +(require 'garden-fleet) +(require 'garden-publish) +(require 'vui) +(require 'vui-components) + +(declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings)) +(declare-function evil-set-initial-state "evil-core" (mode state)) + +(defface garden-star '((t :inherit shadow)) "Face for the decorative star sprinkles." :group 'garden) +(defface garden-meta '((t :inherit shadow :height 0.9)) "Face for muted helper text." :group 'garden) +(defface garden-rule '((t :inherit shadow)) "Face for decorative rule lines." :group 'garden) +(defface garden-tag-xl '((t :weight bold :height 1.7)) "Face for the most frequent topic tags." :group 'garden) +(defface garden-tag-l '((t :weight bold :height 1.4)) "Face for very frequent topic tags." :group 'garden) +(defface garden-tag-m '((t :height 1.2)) "Face for moderately frequent topic tags." :group 'garden) +(defface garden-tag-s '((t :height 1.05)) "Face for less frequent topic tags." :group 'garden) +(defface garden-tag-xs '((t :inherit shadow :height 0.95)) "Face for rare topic tags." :group 'garden) +(defface garden-card-num '((t :weight bold :inherit success)) "Face for the stat card numbers." :group 'garden) +(defface garden-card-frame '((t :inherit shadow)) "Face for the stat card rules." :group 'garden) + +(defcustom garden-content-width 66 + "Maximum width in columns of decorative rule lines in the dashboard. +This variable no longer forces centering; it only caps the length +of banners and separators." + :type 'integer :group 'garden) +(defcustom garden-sidecar-width 34 + "Width in columns of the compact sidecar window." + :type 'integer :group 'garden) + +(defvar-local garden--compact nil + "Whether this dashboard buffer renders the compact view.") + +(defun garden--window-width () + "Return the live body width of the Garden window." + (if-let* ((window (get-buffer-window (current-buffer) t))) + (window-body-width window) + (window-width))) + +(defun garden--tag-face (count maxc) + "Return the meadow face for a tag with COUNT uses out of MAXC." + (let ((r (/ (float count) (max 1 maxc)))) + (cond ((>= r 0.75) 'garden-tag-xl) + ((>= r 0.50) 'garden-tag-l) + ((>= r 0.28) 'garden-tag-m) + ((>= r 0.12) 'garden-tag-s) + (t 'garden-tag-xs)))) + +(defun garden--chunk (list n) + "Partition LIST into consecutive chunks of N elements." + (let (rows) + (while list (push (seq-take list n) rows) (setq list (nthcdr n list))) + (nreverse rows))) + +(defun garden-browse-keyword (keyword) + "Pick one of the notes tagged with KEYWORD and visit it." + (let* ((notes (garden-notes-with-keyword keyword)) + (table (mapcar (lambda (n) (cons (garden-note-title n) n)) notes)) + (annotate (lambda (title) + (when-let* ((note (cdr (assoc title table)))) + (garden-note-annotation note)))) + (choice (completing-read (format "%s %s (%d): " (garden-icon 'leaf) keyword (length notes)) + (garden-completion-table (mapcar #'car table) annotate) nil t))) + (find-file (garden-note-file (cdr (assoc choice table)))))) + +(defun garden-search () + "Pick any garden note by title and visit it." + (interactive) + (let* ((ids (garden-all-ids)) + (table (mapcar (lambda (id) (cons (garden-note-title (garden-note id)) id)) ids)) + (annotate (lambda (title) + (when-let* ((id (cdr (assoc title table)))) + (garden-note-annotation (garden-note id))))) + (choice (completing-read (format "%s garden (%d): " (garden-icon 'search) (length ids)) + (garden-completion-table (mapcar #'car table) annotate) nil t))) + (find-file (garden-note-file (garden-note (cdr (assoc choice table))))))) + +(defun garden-search-text () + "Full-text search across all garden notes." + (interactive) + (if (fboundp 'consult-ripgrep) + (consult-ripgrep garden-directory) + (rgrep (read-string "Search garden: ") "*.org" garden-directory))) + +(defun garden-visit-random () + "Visit a random garden note." + (interactive) + (let ((ids (garden-all-ids))) + (when ids (find-file (garden-note-file (garden-note (nth (random (length ids)) ids))))))) + +(defun garden-reclassify-tag () + "Toggle a keyword between topic and meta." + (interactive) + (let ((k (completing-read "Toggle topic/meta: " (mapcar #'car (garden-keywords-sorted)) nil t))) + (garden-toggle-meta k) + (when (derived-mode-p 'vui-mode) (vui-refresh)))) + +(defun garden--id-time (id) + "Return the creation time encoded in the Denote ID." + (encode-time (list (string-to-number (substring id 13 15)) + (string-to-number (substring id 11 13)) + (string-to-number (substring id 9 11)) + (string-to-number (substring id 6 8)) + (string-to-number (substring id 4 6)) + (string-to-number (substring id 0 4)) + nil -1 nil))) + +(defun garden--age-suffix (id) + "Return a growth-stage age label for note ID, nil when older than a month." + (let ((days (/ (float-time (time-subtract (current-time) (garden--id-time id))) 86400))) + (cond ((< days 1) (format "%s just now" (garden-icon 'sprout))) + ((<= days 7) (format "%s this week" (garden-icon 'leaf))) + ((<= days 31) (format "%s last month" (garden-icon 'grass)))))) + +(defun garden--hub-suffix (id maxd) + "Return height dots and the degree of note ID scaled against MAXD." + (let* ((degree (garden-degree id)) + (dots (max 1 (ceiling (* 4 (/ (float degree) (max 1 maxd))))))) + (format "·%s %d" (make-string dots ?•) degree))) + +(defun garden--note-button (id &optional suffix width suffix-width) + "Render a row for note ID with optional SUFFIX. +When WIDTH is given, the title and suffix sit in fixed-width +columns so the action icons line up across rows; otherwise the +row flows. SUFFIX-WIDTH defaults to 12 columns." + (let* ((note (garden-note id)) + (file (garden-note-file note)) + (suffix-node (vui-muted (or suffix ""))) + (actions (vui-hstack :spacing 1 + (vui-button (garden-icon 'preview) + :no-decoration t + :help-echo "peek in the side window" + :on-click (lambda () (garden-preview-show file))) + (vui-button (garden-icon 'delete) + :no-decoration t + :help-echo "move to the trash" + :on-click (lambda () (unwind-protect (garden-delete-note id) (garden-fleet--refresh)))))) + (row-width (or width 'fill-column))) + (vui-flex + :width row-width :justify :space-between + (vui-flex-item + :grow 1 + (lambda (available) + (vui-button (garden-note-title note) + :key id :no-decoration t :help-echo file + :max-width available + :on-click (lambda () (find-file file))))) + (when suffix + (if suffix-width + (vui-box suffix-node :width suffix-width :align :right) + suffix-node)) + actions))) + +(defun garden--tag-button (k count maxc) + "Render the meadow button for keyword K used COUNT times out of MAXC." + (vui-button (format "%s" k) + :no-decoration t + :face (garden--tag-face count maxc) + :help-echo (format "%d notes — click to wander" count) + :on-click (lambda () (garden-browse-keyword k)))) + +(defun garden--rule (&optional width) + "Return a decorative horizontal rule WIDTH columns wide." + (vui-box (vui-text (format "%s · %s · %s" + (garden-icon 'leaf) + (garden-icon 'star) + (garden-icon 'leaf)) + :face 'garden-rule) + :width (max 1 (or width garden-content-width)) + :align :center :face 'fringe)) + +(defun garden--header () + "Render the left-aligned dashboard banner." + (let ((s (garden-icon 'star)) + (g (garden-icon 'garden))) + (let ((width (min garden-content-width (garden--window-width)))) + (vui-vstack + (vui-flex :width 'window :justify :space-between + (vui-text (format "%s · %s" s (garden-icon 'leaf)) + :face 'garden-star) + (vui-text (format "%s · %s" (garden-icon 'leaf) s) + :face 'garden-star)) + (vui-box (vui-heading-1 (format "%s cashmere's garden" g)) + :width width :align :center) + (vui-box (vui-muted "a little constellation of notes — wander slowly") + :width width :align :center) + (garden--rule width))))) + +(defun garden--toolbar () + "Render the dashboard action buttons as responsive toolbars." + (let ((primary + (list + (vui-button (concat (garden-icon 'refresh) " refresh") + :on-click (lambda () (garden-refresh) (garden-fleet--refresh))) + (vui-button (concat (garden-icon 'search) " search") :on-click #'garden-search) + (vui-button (concat (garden-icon 'grep) " grep") :on-click #'garden-search-text) + (vui-button (concat (garden-icon 'dice) " surprise me") :on-click #'garden-visit-random) + (vui-button (concat (garden-icon 'publish) " publish…") :on-click #'garden-publish-one))) + (secondary + (list + (vui-button (concat (garden-icon 'cog) " classify tag") :on-click #'garden-reclassify-tag) + (vui-button (concat (garden-icon 'link) " connect…") :on-click #'garden-connect-pick) + (vui-button (concat (garden-icon 'fleet) " fleet") :on-click #'garden-fleet) + (vui-button (concat (garden-icon 'preview) " preview") + :on-click (lambda () (garden-preview-mode 'toggle) (garden-fleet--refresh))) + (vui-button (concat (garden-icon 'leaf) " rebuild indexes") + :on-click (lambda () (garden-update-indexes) (garden-refresh) (garden-fleet--refresh)))))) + (vui-vstack + (vui-flex :width 'window :justify :start :spacing 1 :indent 2 + (apply #'vui-hstack :spacing 1 primary)) + (vui-flex :width 'window :justify :space-between :spacing 1 :indent 2 + (apply #'vui-hstack :spacing 1 secondary) + (vui-muted "q quit"))))) + +(defun garden--health-line () + "Return a one-line mood describing the garden's link density." + (let ((density (/ (float (garden-link-count)) (max 1 (garden-note-count))))) + (cond ((< density 0.5) + (format "%s quietly rooting — every link helps it grow" (garden-icon 'web))) + ((< density 1.2) + (format "%s a cozy web is forming" (garden-icon 'link))) + (t + (format "%s %.1f links per note — a thriving web!" (garden-icon 'sparkle) density))))) + +(defun garden--cards () + "Render the stat cards and the health line using `vui-table'." + (let* ((cells (list (cons (concat (garden-icon 'note) " notes") (garden-note-count)) + (cons (concat (garden-icon 'leaf) " topics") (length (garden-topic-keywords))) + (cons (concat (garden-icon 'link) " links") (garden-link-count)) + (cons (concat (garden-icon 'sprout) " seeds") (length (garden-orphans))))) + (cols (mapcar (lambda (_) '(:width 14 :align :center)) cells))) + (vui-vstack + (vui-table + :columns cols + :rows (list + (mapcar (lambda (c) (vui-text (number-to-string (cdr c)) :face 'garden-card-num)) cells) + (mapcar (lambda (c) (vui-text (car c) :face 'garden-meta)) cells)) + :border :ascii + :border-face 'garden-card-frame) + (vui-text (garden--health-line) :face 'vui-success)))) + +(defun garden--tag-rows (cols &optional max) + "Render the topic keywords in COLS columns, MAX tags at most." + (let* ((all (garden-topic-keywords)) + (topics (if max (seq-take all max) all)) + (maxc (if all (cdar all) 1))) + (apply #'vui-vstack :indent 1 :spacing 0 + (mapcar (lambda (row) + (apply #'vui-hstack :spacing 2 + (mapcar (lambda (kc) (garden--tag-button (car kc) (cdr kc) maxc)) row))) + (garden--chunk topics cols))))) + +(defun garden--meadow () + "Render the topic meadow tag cloud." + (vui-vstack + (vui-heading-2 (concat (garden-icon 'grass) " topic meadow")) + (garden--tag-rows 6))) + +(defun garden--hubs (&optional width) + "Render the best-connected notes." + (let* ((hubs (garden-hubs 6)) + (maxd (if hubs (garden-degree (car hubs)) 1))) + (vui-vstack + (vui-heading-3 (concat (garden-icon 'tree) " tallest trees")) + (apply #'vui-vstack :indent 2 + (mapcar (lambda (id) (garden--note-button id (garden--hub-suffix id maxd) width)) hubs))))) + +(defun garden--recent (&optional width) + "Render the most recent notes with their age labels." + (let ((recent (garden-recent 6))) + (vui-vstack + (vui-heading-3 (concat (garden-icon 'sprout) " just sprouted")) + (apply #'vui-vstack :indent 2 + (mapcar (lambda (id) (garden--note-button id (garden--age-suffix id) width)) recent))))) + +(defun garden--orphans () + "Render the collapsible list of unlinked notes." + (let* ((orphans (seq-sort #'string> (garden-orphans))) + (shown (seq-take orphans 60))) + (vui-collapsible + :title (format "%s %d unlinked notes — no links in or out yet" + (garden-icon 'fallen) (length orphans)) + :initially-expanded nil + :title-face 'vui-heading-3 + :expanded-indicator (format "%s " (garden-icon 'down)) + :collapsed-indicator (format "%s " (garden-icon 'up)) + (apply #'vui-vstack :indent 2 + (mapcar (lambda (id) (garden--note-button id)) shown))))) + +(defun garden--meta-strip () + "Render the strip of meta keywords with toggle buttons." + (let ((metas (garden-meta-keywords))) + (when metas + (vui-vstack + (vui-heading-3 (concat (garden-icon 'cog) " provenance & status")) + (apply #'vui-hstack :spacing 2 :indent 2 + (mapcar (lambda (kc) + (let ((k (car kc))) + (vui-button (format "%s·%d" k (cdr kc)) + :no-decoration t :face 'garden-meta + :help-echo "click → make it a topic" + :on-click (lambda () (garden-toggle-meta k) (vui-refresh))))) + metas)))))) + +(defun garden--view-full () + "Render the full dashboard view." + (let* ((width (garden--window-width)) + (wide (>= width 110)) + (panel-width (if wide (max 44 (/ (- width 8) 2)) width))) + (vui-vstack :spacing 1 :indent 2 + (garden--header) + (garden--toolbar) + (garden--cards) + (if wide + (vui-hstack + :spacing 4 + (vui-vstack :spacing 1 + (garden--meadow) + (garden--meta-strip)) + (vui-vstack :spacing 1 + (garden--hubs panel-width) + (garden--recent panel-width))) + (vui-vstack :spacing 1 + (garden--meadow) + (garden--hubs panel-width) + (garden--recent panel-width) + (garden--meta-strip))) + (garden--orphans) + (vui-flex :width 'window :justify :space-between + (vui-muted "j/k move · TAB/S-TAB elements · RET/l activate") + (vui-muted "g refresh · / search · ? help · h/q close"))))) + +(defun garden--view-compact () + "Render the compact sidecar view." + (let* ((indent 1) + (width (max 24 (min garden-sidecar-width (garden--window-width)))) + (suffix-w 9) + (col-w (floor (- width 5) 2)) + (hubs (garden-hubs 6)) + (maxd (if hubs (garden-degree (car hubs)) 1))) + (vui-vstack :spacing 0 :indent indent + (vui-flex :width width :justify :space-between :indent indent + (vui-heading-2 (format "%s garden" (garden-icon 'garden))) + (vui-text (garden-icon 'star) :face 'garden-star)) + (garden--rule width) + (vui-table + :columns `((:width ,col-w :align :center) + (:width ,col-w :align :center)) + :rows (list + (list (vui-text (number-to-string (garden-note-count)) :face 'garden-card-num) + (vui-text (number-to-string (length (garden-topic-keywords))) :face 'garden-card-num)) + (list (vui-text (concat (garden-icon 'note) " notes") :face 'garden-meta) + (vui-text (concat (garden-icon 'leaf) " topics") :face 'garden-meta)) + (list (vui-text (number-to-string (garden-link-count)) :face 'garden-card-num) + (vui-text (number-to-string (length (garden-orphans))) :face 'garden-card-num)) + (list (vui-text (concat (garden-icon 'link) " links") :face 'garden-meta) + (vui-text (concat (garden-icon 'sprout) " seeds") :face 'garden-meta))) + :border :ascii + :border-face 'garden-card-frame) + (vui-flex :width width :justify :start :spacing 1 :indent indent + (vui-button (garden-icon 'refresh) + :on-click (lambda () (garden-refresh) (garden-fleet--refresh))) + (vui-button (garden-icon 'search) :on-click #'garden-search) + (vui-button (garden-icon 'dice) :on-click #'garden-visit-random) + (vui-button (garden-icon 'publish) :on-click #'garden-publish-one) + (vui-muted "q")) + (vui-heading-3 (concat (garden-icon 'grass) " top topics")) + (garden--tag-rows 2 16) + (vui-heading-3 (concat (garden-icon 'tree) " hubs")) + (apply #'vui-vstack + (mapcar (lambda (id) (garden--note-button id (garden--hub-suffix id maxd) width suffix-w)) hubs)) + (vui-heading-3 (concat (garden-icon 'sprout) " recent")) + (apply #'vui-vstack + (mapcar (lambda (id) (garden--note-button id (garden--age-suffix id) width suffix-w)) (garden-recent 6)))))) + +(defun garden--view () + "Render the view matching this buffer's compact flag." + (if garden--compact (garden--view-compact) (garden--view-full))) + +(vui-defcomponent garden-dashboard () + :render (garden--view)) + +(defun garden-dashboard-refresh () + "Rebuild the Garden index and redraw the dashboard." + (interactive) + (garden-refresh) + (garden-fleet--refresh)) + +(defun garden-dashboard-help () + "Show Garden dashboard keyboard help." + (interactive) + (message "Garden: j/k move, TAB/S-TAB elements, RET/l activate, g refresh, / note search, s text search, h/q close")) + +(defvar garden-dashboard-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map vui-mode-map) + (define-key map (kbd "/") #'garden-search) + (define-key map (kbd "s") #'garden-search-text) + (define-key map (kbd "P") #'garden-publish-one) + (define-key map (kbd "j") #'next-line) + (define-key map (kbd "k") #'previous-line) + (define-key map (kbd "TAB") #'vui-forward) + (define-key map (kbd "") #'vui-backward) + (define-key map (kbd "RET") #'vui-activate) + (define-key map (kbd "l") #'vui-activate) + (define-key map (kbd "g") #'garden-dashboard-refresh) + (define-key map (kbd "?") #'garden-dashboard-help) + (define-key map (kbd "h") #'vui-quit) + (define-key map (kbd "q") #'vui-quit) + map) + "Keymap for `garden-dashboard-mode'.") + +(define-derived-mode garden-dashboard-mode vui-mode "Garden" + "Explore the Denote garden dashboard." + (hl-line-mode 1)) + +(with-eval-after-load 'evil + (evil-set-initial-state 'garden-dashboard-mode 'normal) + (evil-define-key* '(normal motion) garden-dashboard-mode-map + (kbd "j") #'next-line (kbd "k") #'previous-line + (kbd "RET") #'vui-activate (kbd "l") #'vui-activate + (kbd "g") #'garden-dashboard-refresh + (kbd "/") #'garden-search (kbd "s") #'garden-search-text + (kbd "?") #'garden-dashboard-help + (kbd "h") #'vui-quit (kbd "q") #'vui-quit)) + +(defun garden--prepare (compact) + "Build the index and mount the dashboard, COMPACT when non-nil." + (garden-build) + (let ((buffer (get-buffer-create "*garden*"))) + (with-current-buffer buffer + (garden-dashboard-mode) + (setq-local garden--compact compact) + (vui-mount (vui-component 'garden-dashboard) buffer) + (vui-rerender-on-resize)))) + +;;;###autoload +(defun garden () + "Open the garden dashboard." + (interactive) + (garden--prepare nil) + (switch-to-buffer "*garden*") + (vui-refresh)) + +;;;###autoload +(defun garden-sidecar () + "Open the compact garden dashboard in a left side window." + (interactive) + (garden--prepare t) + (let ((win (display-buffer-in-side-window + (get-buffer "*garden*") + `((side . left) (slot . 0) (window-width . ,garden-sidecar-width) + (window-parameters . ((no-delete-other-windows . t))))))) + (when win (select-window win) (vui-refresh)))) + +(provide 'garden-dashboard) +;;; garden-dashboard.el ends here diff --git a/lisp/garden-fleet.el b/lisp/garden-fleet.el new file mode 100644 index 0000000..70c5d72 --- /dev/null +++ b/lisp/garden-fleet.el @@ -0,0 +1,464 @@ +;;; garden-fleet.el --- import & process fleeting notes -*- lexical-binding: t; -*- + +(require 'garden-core) +(require 'garden-icons) +(require 'garden-preview) +(require 'vui) +(require 'vui-components) + +(declare-function evil-define-key* "evil-core" (state keymap key def &rest bindings)) +(declare-function evil-set-initial-state "evil-core" (mode state)) + +(defvar denote-directory) +(defvar denote-rename-confirmations) +(defvar denote-save-buffers) +(defvar denote-kill-buffers) +(declare-function denote-rename-file "denote") +(declare-function garden "garden-dashboard") + +(defcustom garden-fleet-source-directory (expand-file-name "~/org/") + "Directory scanned for fleeting notes to import." + :type 'directory :group 'garden) + +(defcustom garden-fleet-tags '("fleet" "capture") + "Tags marking a note as fleeting." + :type '(repeat string) :group 'garden) + +(defcustom garden-fleet-data-file (expand-file-name ".garden/fleet.eld" garden-directory) + "File persisting the manual ordering of staged fleet notes." + :type 'file :group 'garden) + +(defvar garden-fleet--order nil + "List of staged note ids in their manual order.") + +(defvar-local garden-fleet--dispatch nil + "Async actions exposed by the mounted Fleet component.") + +(defun garden-fleet--refresh () + "Re-render every live garden VUI buffer." + (dolist (name '("*garden-fleet*" "*garden*" "*garden connect*")) + (when-let* ((buf (get-buffer name)) + (root (buffer-local-value 'vui--root-instance buf))) + (vui-rerender root)))) + +(defun garden-fleet--load-order () + "Load the staged-note order from `garden-fleet-data-file'." + (setq garden-fleet--order + (when (file-exists-p garden-fleet-data-file) + (with-temp-buffer + (insert-file-contents garden-fleet-data-file) + (ignore-errors (read (current-buffer))))))) + +(defun garden-fleet--save-order () + "Persist the staged-note order to `garden-fleet-data-file'." + (make-directory (file-name-directory garden-fleet-data-file) t) + (with-temp-file garden-fleet-data-file (prin1 garden-fleet--order (current-buffer)))) + +(defun garden-fleet--file-tags (file) + "Return all tags encoded in FILE's name, provenance included." + (let ((base (file-name-nondirectory file))) + (when (string-match "__\\([a-zA-Z0-9_-]+\\)\\.org\\'" base) + (split-string (match-string 1 base) "_" t)))) + +(defun garden-fleet--fleet-p (tags) + "Return non-nil when TAGS marks a fleeting note." + (seq-intersection tags garden-fleet-tags)) + +(defun garden-fleet--source-files () + "Return the Denote-named org files in `garden-fleet-source-directory'." + (directory-files garden-fleet-source-directory t "\\`[0-9]\\{8\\}T[0-9]\\{6\\}.*\\.org\\'")) + +(defun garden-fleet-candidates () + "Return fleeting files in the inbox not yet imported." + (seq-filter (lambda (f) + (and (garden-fleet--fleet-p (garden-fleet--file-tags f)) + (not (garden-note (garden--file-id f))))) + (garden-fleet--source-files))) + +(defun garden-fleet-staged () + "Return imported fleet notes, manual order first, newest after." + (let (acc) + (maphash (lambda (_id note) + (when (garden-fleet--fleet-p (garden-fleet--file-tags (garden-note-file note))) + (push note acc))) + (garden-notes)) + (let ((by-id (make-hash-table :test 'equal))) + (dolist (note acc) (puthash (garden-note-id note) note by-id)) + (let ((ordered (seq-keep (lambda (id) (gethash id by-id)) garden-fleet--order)) + (rest (seq-remove (lambda (note) (member (garden-note-id note) garden-fleet--order)) acc))) + (append ordered (seq-sort-by #'garden-note-id #'string> rest)))))) + +(defun garden-fleet-import (file) + "Move FILE from the inbox into the garden and stage it." + (garden-fleet--load-order) + (let* ((id (garden--file-id file)) + (dest (expand-file-name (file-name-nondirectory file) garden-directory))) + (cond + ((file-exists-p dest) + (message "garden: %s already in the garden — skipped" (file-name-nondirectory file))) + (t + (rename-file file dest) + (setq garden-fleet--order (append garden-fleet--order (list id))) + (garden-fleet--save-order) + (garden-build) + (message "garden: imported %s" (file-name-nondirectory dest)))))) + +(defun garden-fleet-import-all () + "Import every fleeting note from the inbox after confirmation." + (interactive) + (let ((files (garden-fleet-candidates))) + (when (and files + (yes-or-no-p (format "Import all %d fleet/capture note(s) into the garden? " (length files)))) + (dolist (f files) (garden-fleet-import f)) + (garden-build)))) + +(defun garden-fleet--rename (file keywords) + "Rename FILE via denote so its name carries exactly KEYWORDS." + (require 'denote) + (let ((denote-directory (file-name-as-directory (expand-file-name garden-directory))) + (denote-rename-confirmations nil) + (denote-save-buffers t) + (denote-kill-buffers t)) + (denote-rename-file file 'keep-current keywords 'keep-current 'keep-current 'keep-current))) + +(defun garden-fleet-classify (id) + "Prompt for topic tags to add to the note with ID. +Suggested tags are listed first and marked in the completion UI." + (let* ((note (garden-note id)) + (file (garden-note-file note)) + (current (garden-fleet--file-tags file)) + (suggested (garden-suggest-tags file)) + (choices (seq-difference (mapcar #'car (garden-keywords-sorted)) current)) + (choices (append suggested (seq-difference choices suggested))) + (annotate (lambda (k) + (concat + (propertize (format " %d notes" (gethash k (garden-keyword-counts) 0)) + 'face 'completions-annotations) + (or (when (member k suggested) + (propertize (format " %s suggested" (garden-icon 'sparkle)) + 'face 'completions-annotations)) + "")))) + (prompt (if suggested + (format "Topic tag(s) for “%s” (%s maybe: %s): " + (garden-note-title note) (garden-icon 'sparkle) + (string-join suggested ", ")) + (format "Topic tag(s) for “%s”: " (garden-note-title note)))) + (added (completing-read-multiple prompt (garden-completion-table choices annotate)))) + (when added + (garden-fleet--rename file (delete-dups (append current added))) + (garden-build)))) + +(defun garden-fleet-tag (id tag) + "Add the single TAG to the note with ID without prompting." + (let* ((note (garden-note id)) + (file (garden-note-file note)) + (current (garden-fleet--file-tags file))) + (garden-fleet--rename file (delete-dups (append current (list tag)))) + (garden-build) + (message "garden: tagged “%s” with %s" (garden-note-title note) tag))) + +(defun garden-fleet-delete (id) + "Trash the staged note with ID and drop it from the order." + (garden-fleet--load-order) + (when (garden-delete-note id) + (setq garden-fleet--order (delete id garden-fleet--order)) + (garden-fleet--save-order))) + +(defun garden-fleet-return (id) + "Send the staged note with ID back to the ~/org inbox. +Moves its file to `garden-fleet-source-directory', drops it from +the manual order, and rebuilds the index." + (garden-fleet--load-order) + (let* ((note (garden-note id)) + (file (garden-note-file note)) + (dest (expand-file-name (file-name-nondirectory file) garden-fleet-source-directory))) + (make-directory garden-fleet-source-directory t) + (if (file-exists-p dest) + (message "garden: %s already in ~/org — left in place" (file-name-nondirectory file)) + (when-let* ((buf (find-buffer-visiting file))) + (kill-buffer buf)) + (rename-file file dest) + (setq garden-fleet--order (delete id garden-fleet--order)) + (garden-fleet--save-order) + (garden-build) + (message "garden: returned “%s” to ~/org" (garden-note-title note))))) + +(defun garden-fleet-discard (file) + "Trash the inbox candidate FILE after confirmation." + (when (yes-or-no-p (format "Move “%s” to the trash? " (garden--file-title file))) + (let ((delete-by-moving-to-trash t)) + (delete-file file t)) + (message "garden: discarded %s" (file-name-nondirectory file)))) + +(defun garden-fleet-graduate (id) + "Remove the fleeting tags from the note with ID after confirmation." + (garden-fleet--load-order) + (let* ((note (garden-note id)) + (file (garden-note-file note)) + (keywords (seq-remove (lambda (k) (member k garden-fleet-tags)) + (garden-fleet--file-tags file)))) + (when (yes-or-no-p (format "Graduate “%s” out of fleet? " (garden-note-title note))) + (garden-fleet--rename file keywords) + (setq garden-fleet--order (delete id garden-fleet--order)) + (garden-fleet--save-order) + (garden-build) + (message "garden: graduated %s" (garden-note-title note))))) + +(defun garden-fleet-move (id delta) + "Move the staged note with ID by DELTA positions in the order." + (garden-fleet--load-order) + (let* ((ids (mapcar #'garden-note-id (garden-fleet-staged))) + (pos (seq-position ids id)) + (new (and pos (+ pos delta)))) + (when (and pos new (>= new 0) (< new (length ids))) + (let ((other (nth new ids))) + (setq garden-fleet--order + (mapcar (lambda (x) (cond ((equal x id) other) ((equal x other) id) (t x))) ids)) + (garden-fleet--save-order))))) + +(defun garden-fleet--topic-tags (file) + "Return FILE's topic keywords, with provenance and status dropped." + (seq-difference (garden--file-keywords file) garden-fleet-tags)) + +(defun garden-fleet--icon-action (icon help on-click &optional face label) + "Render a quiet ICON button with HELP tooltip running ON-CLICK." + (vui-button (if label (format "%s %s" (garden-icon icon) label) + (garden-icon icon)) + :no-decoration (null label) :help-echo help :face face :on-click on-click)) + +(defun garden-fleet--candidate-row (file width) + "Render an inbox card for FILE using WIDTH." + (let ((tags-str (string-join (garden-fleet--topic-tags file) " ")) + (actions (vui-hstack :spacing 1 + (garden-fleet--icon-action 'import "import into the garden" + (lambda () (unwind-protect (garden-fleet-import file) (garden-fleet--refresh))) + 'success "import") + (garden-fleet--icon-action 'preview "peek in the side window" + (lambda () (garden-preview-show file)) 'link) + (garden-fleet--icon-action 'delete "move to the trash" + (lambda () (unwind-protect (garden-fleet-discard file) (garden-fleet--refresh))) + 'error)))) + (vui-vstack + :spacing 0 :face 'fringe + (vui-flex + :width width :justify :space-between + (vui-flex-item + :grow 1 + (lambda (available) + (vui-button (garden--file-title file) + :key file :no-decoration t :help-echo file + :max-width available :face '(:inherit bold) + :on-click (lambda () (find-file file))))) + (vui-muted "inbox")) + (vui-box (vui-text (if (string-empty-p tags-str) + "no topic tags" + (format "#%s" (string-replace " " " #" tags-str))) + :face 'shadow) + :width width :padding-left 2) + actions))) + +(defun garden-fleet--chips (id tags) + "Return a dot-separated list of one-click chips tagging note ID." + (let (out) + (dolist (tag tags) + (when out (push (vui-muted "·") out)) + (push (vui-button tag + :no-decoration t + :help-echo (format "click to tag with “%s” right away" tag) + :on-click (lambda () (unwind-protect (garden-fleet-tag id tag) (garden-fleet--refresh)))) + out)) + (nreverse out))) + +(defun garden-fleet--suggestion-chips (id file) + "Render one-click suggested-tag chips for the note ID in FILE. +The chips line up beneath the title column of the staged row above." + (let ((suggested (garden-suggest-tags file))) + (when suggested + (apply #'vui-hstack :spacing 1 + (vui-muted "maybe →") + (garden-fleet--chips id suggested))))) + +(defun garden-fleet--staged-row (note width) + "Render a staged card for NOTE using WIDTH." + (let* ((id (garden-note-id note)) + (file (garden-note-file note)) + (tags-str (string-join (garden-fleet--topic-tags file) " ")) + (queue (vui-hstack :spacing 1 + (garden-fleet--icon-action 'up "move up the queue" + (lambda () (unwind-protect (garden-fleet-move id -1) (garden-fleet--refresh)))) + (garden-fleet--icon-action 'down "move down the queue" + (lambda () (unwind-protect (garden-fleet-move id 1) (garden-fleet--refresh)))))) + (actions (vui-hstack :spacing 1 + (garden-fleet--icon-action 'classify "add topic tags" + (lambda () (unwind-protect (garden-fleet-classify id) (garden-fleet--refresh))) + 'link "classify") + (garden-fleet--icon-action 'graduate "graduate out of fleet" + (lambda () (unwind-protect (garden-fleet-graduate id) (garden-fleet--refresh))) + 'success "graduate") + (garden-fleet--icon-action 'preview "peek in the side window" + (lambda () (garden-preview-show file)) 'link) + (garden-fleet--icon-action 'return "send back to the ~/org inbox" + (lambda () (unwind-protect (garden-fleet-return id) (garden-fleet--refresh))) + 'warning)))) + (vui-vstack :spacing 0 :face 'fringe + (vui-flex :width width :justify :space-between + queue + (vui-flex-item :grow 1 + (lambda (w) + (vui-button (garden-note-title note) + :key id :no-decoration t :help-echo file + :max-width w :face '(:inherit bold) + :on-click (lambda () (find-file file))))) + (vui-muted "staged")) + (vui-box (vui-text (if (string-empty-p tags-str) + "no topic tags" + (format "#%s" (string-replace " " " #" tags-str))) + :face 'shadow) + :width width :padding-left 2) + (garden-fleet--suggestion-chips id file) + actions))) + +(defun garden-fleet--header () + "Render the fleet dashboard banner." + (let ((icon (garden-icon 'fleet)) + (wave (garden-icon 'leaf))) + (vui-vstack + (vui-text (format "~ %s ~ %s ~ %s ~" wave icon wave) :face 'garden-meta) + (vui-heading-1 (format "%s fleeting notes" icon)) + (vui-muted "import from ~/org, then order · classify · redo them")))) + +(defun garden-fleet--window-width () + "Return the live Fleet window body width." + (if-let* ((window (get-buffer-window (current-buffer) t))) + (window-body-width window) + (window-width))) + +(defun garden-fleet--panel (title empty items renderer width) + "Render a Fleet panel with TITLE, EMPTY message and ITEMS. +RENDERER receives each item and WIDTH." + (vui-vstack + :spacing 1 + (vui-flex :width width :justify :space-between + (vui-heading-2 title) + (vui-text (number-to-string (length items)) :face 'shadow)) + (if (null items) + (vui-box (vui-text empty :face 'shadow) :width width :align :center) + (vui-list items + (lambda (item) (funcall renderer item width)) + (lambda (item) + (if (stringp item) item (garden-note-id item))) + :spacing 1)))) + +(defun garden-fleet--view () + "Render the fleet dashboard: inbox candidates and staged notes." + (let* ((candidates (garden-fleet-candidates)) + (staged (garden-fleet-staged)) + (width (garden-fleet--window-width)) + (wide (>= width 100)) + (panel-width (if wide (max 42 (/ (- width 6) 2)) (max 28 (- width 4)))) + (refresh (vui-with-async-context + (garden-refresh) + (garden-fleet--refresh)))) + (setq garden-fleet--dispatch (list :refresh refresh)) + (vui-vstack :spacing 1 :indent 2 + (garden-fleet--header) + (vui-flex :width 'window :justify :space-between + (vui-hstack :spacing 2 + (vui-button (concat (garden-icon 'refresh) " rescan") + :on-click refresh) + (vui-button (concat (garden-icon 'import) " import all") + :on-click (lambda () (unwind-protect (garden-fleet-import-all) (garden-fleet--refresh)))) + (vui-button (concat (garden-icon 'preview) " preview") + :on-click (lambda () (garden-preview-mode 'toggle) (garden-fleet--refresh))) + (vui-button (concat (garden-icon 'star) " garden") + :on-click (lambda () (garden)))) + (vui-muted (format "%d inbox · %d staged" (length candidates) (length staged)))) + (if wide + (vui-hstack + :spacing 4 + (garden-fleet--panel + (concat (garden-icon 'inbox) " inbox") + "Inbox empty — nothing to import" + candidates #'garden-fleet--candidate-row panel-width) + (garden-fleet--panel + (concat (garden-icon 'tools) " staged") + "Nothing staged — import a note first" + staged #'garden-fleet--staged-row panel-width)) + (vui-vstack + :spacing 1 + (garden-fleet--panel + (concat (garden-icon 'inbox) " inbox") + "Inbox empty — nothing to import" + candidates #'garden-fleet--candidate-row panel-width) + (garden-fleet--panel + (concat (garden-icon 'tools) " staged") + "Nothing staged — import a note first" + staged #'garden-fleet--staged-row panel-width))) + (vui-flex :width 'window :justify :space-between + (vui-muted "j/k move · TAB/S-TAB elements · RET/l activate") + (vui-muted "g rescan · ? help · h garden · q close"))))) + +(vui-defcomponent garden-fleet-dashboard () + :render (garden-fleet--view)) + +(defun garden-fleet-refresh () + "Rescan and refresh the Fleet dashboard." + (interactive) + (if-let* ((fn (plist-get garden-fleet--dispatch :refresh))) + (funcall fn) + (user-error "Fleet dashboard is not ready"))) + +(defun garden-fleet-back () + "Return to a live Garden dashboard, or close Fleet." + (interactive) + (if-let* ((buffer (get-buffer "*garden*"))) + (switch-to-buffer buffer) + (vui-quit))) + +(defun garden-fleet-help () + "Show Fleet keyboard help." + (interactive) + (message "Garden Fleet: j/k move, TAB/S-TAB elements, RET/l activate, g rescan, h garden, q close")) + +(defvar garden-fleet-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map vui-mode-map) + (keymap-set map "j" #'next-line) + (keymap-set map "k" #'previous-line) + (keymap-set map "TAB" #'vui-forward) + (keymap-set map "" #'vui-backward) + (keymap-set map "RET" #'vui-activate) + (keymap-set map "l" #'vui-activate) + (keymap-set map "g" #'garden-fleet-refresh) + (keymap-set map "?" #'garden-fleet-help) + (keymap-set map "h" #'garden-fleet-back) + (keymap-set map "q" #'vui-quit) + map)) + +(define-derived-mode garden-fleet-mode vui-mode "Garden-Fleet" + "Manage the Garden fleeting-note queues." + (hl-line-mode 1)) + +(with-eval-after-load 'evil + (evil-set-initial-state 'garden-fleet-mode 'normal) + (evil-define-key* '(normal motion) garden-fleet-mode-map + (kbd "j") #'next-line (kbd "k") #'previous-line + (kbd "RET") #'vui-activate (kbd "l") #'vui-activate + (kbd "g") #'garden-fleet-refresh (kbd "?") #'garden-fleet-help + (kbd "h") #'garden-fleet-back (kbd "q") #'vui-quit)) + +;;;###autoload +(defun garden-fleet () + "Open the fleet dashboard for importing and classifying fleeting notes." + (interactive) + (garden-build) + (garden-fleet--load-order) + (let ((buffer (get-buffer-create "*garden-fleet*"))) + (with-current-buffer buffer + (garden-fleet-mode) + (vui-mount (vui-component 'garden-fleet-dashboard) buffer) + (vui-rerender-on-resize)) + (switch-to-buffer buffer))) + +(provide 'garden-fleet) +;;; garden-fleet.el ends here diff --git a/lisp/garden-icons.el b/lisp/garden-icons.el new file mode 100644 index 0000000..c083409 --- /dev/null +++ b/lisp/garden-icons.el @@ -0,0 +1,64 @@ +;;; garden-icons.el --- nerd-font icon glyphs for the garden UIs -*- lexical-binding: t; -*- + +;;; Commentary: + +;; One place for every pictogram the garden dashboards use. When +;; nerd-icons is available (and `garden-use-nerd-icons' is non-nil) +;; the UIs render single-width nerd-font glyphs, which align cleanly +;; in a monospace buffer; otherwise they fall back to the original +;; emoji. + +;;; Code: + +(require 'nerd-icons nil t) + +(declare-function nerd-icons-mdicon "nerd-icons") + +(defcustom garden-use-nerd-icons t + "Whether garden UIs render nerd-font glyphs instead of emoji." + :type 'boolean :group 'garden) + +(defconst garden-icon-alist + '((garden "nf-md-flower_outline" "✦") + (fleet "nf-md-ferry" "🚢") + (inbox "nf-md-inbox_arrow_down" "📥") + (import "nf-md-import" "⇨") + (classify "nf-md-tag_outline" "🏷") + (graduate "nf-md-school" "✓") + (delete "nf-md-trash_can_outline" "🗑") + (return "nf-md-undo_variant" "↩") + (preview "nf-md-eye_outline" "👁") + (refresh "nf-md-refresh" "↻") + (cog "nf-md-cog_outline" "⚙") + (tools "nf-md-hammer_wrench" "🛠") + (link "nf-md-link_variant" "🔗") + (web "nf-md-spider_web" "🕸") + (dice "nf-md-dice_multiple" "✦") + (sprout "nf-md-sprout" "🌱") + (leaf "nf-md-leaf" "🌿") + (grass "nf-md-grass" "🌾") + (tree "nf-md-tree" "🌳") + (fallen "nf-md-leaf_maple" "🍂") + (note "nf-md-note_text_outline" "📝") + (search "nf-md-magnify" "🔍") + (grep "nf-md-text_search" "🔎") + (publish "nf-md-publish" "🚀") + (sparkle "nf-md-shimmer" "✨") + (star "nf-md-star_four_points" "✦") + (up "nf-md-arrow_up_bold" "▲") + (down "nf-md-arrow_down_bold" "▼")) + "Mapping of semantic icon names to (NERD-GLYPH EMOJI-FALLBACK).") + +(defun garden-icon (name) + "Return the glyph string for the semantic icon NAME. +NAME is a key of `garden-icon-alist'. Returns a propertized +nerd-font glyph when available, the emoji fallback otherwise." + (let ((entry (alist-get name garden-icon-alist))) + (unless entry (error "garden: unknown icon %s" name)) + (if (and garden-use-nerd-icons (fboundp 'nerd-icons-mdicon)) + (or (nerd-icons-mdicon (car entry)) + (cadr entry)) + (cadr entry)))) + +(provide 'garden-icons) +;;; garden-icons.el ends here diff --git a/lisp/garden-links.el b/lisp/garden-links.el new file mode 100644 index 0000000..8fc20c8 --- /dev/null +++ b/lisp/garden-links.el @@ -0,0 +1,29 @@ +;;; garden-links.el --- Denote links dynamic block helpers -*- lexical-binding: t; -*- + +;; Thin wrappers around `denote-org' dynamic blocks. + +;;; Code: + +(require 'garden-core) + +(declare-function denote-org-dblock-insert-links "denote-org") + +;;;###autoload +(defun garden-insert-denote-links () + "Insert a `denote-links' dynamic block at point. +Prompts for a regexp and inserts a block that lists all Denote +notes whose file name matches it. Use `org-update-dblock' or +`C-c C-c' on the block to refresh it later." + (interactive) + (require 'denote-org) + (call-interactively #'denote-org-dblock-insert-links)) + +;;;###autoload +(defun garden-update-denote-links () + "Refresh every `denote-links' dynamic block in the current buffer." + (interactive) + (require 'denote-org) + (org-update-all-dblocks)) + +(provide 'garden-links) +;;; garden-links.el ends here diff --git a/lisp/garden-preview.el b/lisp/garden-preview.el new file mode 100644 index 0000000..f7f89a0 --- /dev/null +++ b/lisp/garden-preview.el @@ -0,0 +1,111 @@ +;;; garden-preview.el --- side-window note preview -*- lexical-binding: t; -*- + +;;; Commentary: + +;; Shows garden notes in a read-only side window on the right. Two +;; entry points: `garden-preview-show' for one-off peeks (wired to +;; per-row eye buttons), and `garden-preview-mode', a buffer-local +;; minor mode for the VUI dashboards that previews the note under +;; point as you move around. Buffers opened purely for previewing +;; are killed again by `garden-preview-quit'. + +;;; Code: + +(require 'garden-core) +(require 'cl-lib) + +(declare-function vui-element-at "vui") +(declare-function vui-element-get "vui") + +(defcustom garden-preview-width 45 + "Width of the preview side window in columns." + :type 'integer :group 'garden) + +(defvar garden-preview--opened nil + "Buffers the preview opened itself and may kill on quit.") + +(defvar-local garden-preview--owned nil + "Non-nil when this buffer was created by `garden-preview-show'.") + +(defvar garden-preview--last nil + "File shown in the preview window most recently.") + +(defun garden-preview-show (file) + "Display FILE read-only in a side window on the right. +Focus returns to the window that was selected before the call." + (interactive "fPreview note: ") + (let* ((existing (find-buffer-visiting file)) + (buf (or existing (find-file-noselect file))) + (origin (selected-window))) + (if existing + (progn + (with-current-buffer buf (setq garden-preview--owned nil)) + (setq garden-preview--opened (delq buf garden-preview--opened))) + (with-current-buffer buf + (setq garden-preview--owned t) + (cl-pushnew buf garden-preview--opened))) + (setq garden-preview--last file) + (with-current-buffer buf (setq buffer-read-only t)) + (or (with-selected-window (window-main-window) + (display-buffer-in-side-window + buf + `((side . right) (slot . 0) (window-width . ,garden-preview-width) + (window-parameters . ((no-delete-other-windows . t)))))) + (display-buffer buf '((display-buffer-reuse-window display-buffer-use-some-window) + (inhibit-same-window . t)))) + (select-window origin))) + +(defun garden-preview-quit () + "Close the preview window and kill buffers opened for previewing. +Only buffers that the preview itself created are killed." + (interactive) + (when-let* ((buf (and garden-preview--last (find-buffer-visiting garden-preview--last))) + (win (get-buffer-window buf))) + (when (window-parameter win 'window-side) + (delete-window win))) + (dolist (buf garden-preview--opened) + (when (and (buffer-live-p buf) + (buffer-local-value 'garden-preview--owned buf) + (not (buffer-modified-p buf)) + (not (get-buffer-window buf 'visible))) + (kill-buffer buf))) + (setq garden-preview--opened nil + garden-preview--last nil)) + +(defun garden-preview--file-at-line () + "Return the note file referenced by a VUI element on the current line, if any. +Works with both `button.el' text buttons (vui 1.3+) and widget fields." + (save-excursion + (let ((end (line-end-position)) + (file nil)) + (beginning-of-line) + (while (and (not file) (< (point) end)) + (let* ((elt (vui-element-at (point))) + (echo (and elt (vui-element-get elt 'help-echo)))) + (when (and (stringp echo) + (string-suffix-p ".org" echo) + (file-exists-p echo)) + (setq file echo))) + (forward-char 1)) + file))) + +(defun garden-preview--post-command () + "Preview the note under point when it changed." + (when-let* ((file (garden-preview--file-at-line))) + (unless (equal file garden-preview--last) + (garden-preview-show file)))) + +;;;###autoload +(define-minor-mode garden-preview-mode + "Preview the note under point in a right side window. +Buffer-local; meant for the garden VUI dashboards." + :lighter " peek" + (if garden-preview-mode + (progn + (add-hook 'post-command-hook #'garden-preview--post-command nil t) + (garden-preview--post-command)) + (remove-hook 'post-command-hook #'garden-preview--post-command t) + (garden-preview-quit))) + +(provide 'garden-preview) +;;; garden-preview.el ends here diff --git a/lisp/garden-publish.el b/lisp/garden-publish.el new file mode 100644 index 0000000..cafbcda --- /dev/null +++ b/lisp/garden-publish.el @@ -0,0 +1,450 @@ +;;; garden-publish.el --- publish the garden to the zola site -*- lexical-binding: t; -*- + +(require 'garden-core) +(require 'subr-x) + +(declare-function denote-publish-to-md "denote-publish") +(declare-function org-publish "ox-publish") + +(defvar denote-directory) +(defvar org-export-with-broken-links) +(defvar org-export-use-babel) +(defvar org-publish-project-alist) + +(defcustom garden-publish-site-directory (expand-file-name "~/cashmere.rs/") "Root directory of the Zola site checkout." :type 'directory :group 'garden) +(defcustom garden-publish-wiki-subdir "content/wiki" "Wiki output directory relative to the site root." :type 'string :group 'garden) + +(defun garden-publish--clean-generated (dir) + "Delete all generated Markdown files in DIR except _index.md." + (dolist (old (directory-files dir t "\\.md\\'")) + (unless (equal (file-name-nondirectory old) "_index.md") (delete-file old)))) + +(defun garden-publish--ensure-index (dir title) + "Create an _index.md with TITLE in DIR unless one already exists." + (let ((idx (expand-file-name "_index.md" dir))) + (unless (file-exists-p idx) + (with-temp-file idx (insert (format "+++\ntitle = %S\nsort_by = \"date\"\n+++\n" title)))))) + +(defun garden-publish--filename-slug (file) + "Return the slug part of the denote FILE name, or nil." + (let ((base (file-name-nondirectory file))) + (when (string-match "\\`[0-9]\\{8\\}T[0-9]\\{6\\}--\\([a-z0-9-]+\\)\\(?:__[a-z0-9_-]+\\)?\\.org\\'" base) + (match-string 1 base)))) + +(defun garden-publish--slug-map () + "Return a hash table mapping note ids to unique URL slugs." + (let ((map (make-hash-table :test 'equal)) + (seen (make-hash-table :test 'equal))) + (dolist (file (sort (garden--note-files) #'string<)) + (let* ((id (garden--file-id file)) + (base (garden-publish--filename-slug file)) + (kw (car (garden--file-keywords file)))) + (when (and id base) + (let ((slug base)) + (when (gethash slug seen) + (setq slug (if (and kw (not (gethash (concat base "-" kw) seen))) + (concat base "-" kw) + (let ((n 2)) + (while (gethash (format "%s-%d" base n) seen) (setq n (1+ n))) + (format "%s-%d" base n))))) + (puthash slug t seen) + (puthash id slug map))))) + map)) + +(defcustom garden-publish-exclude-keywords '("draft" "private" "noexport") "File keywords that exclude a note from publishing." :type '(repeat string) :group 'garden) + +(defun garden-publish--exclude-ids () + "Return a hash table of note ids that must not be published." + (let ((ex (make-hash-table :test 'equal))) + (dolist (file (garden--note-files)) + (when (seq-intersection garden-publish-exclude-keywords (garden--file-keywords file)) + (puthash (garden--file-id file) t ex))) + ex)) + +(defun garden-publish--rewrite-denote-links (map) + "Rewrite exported denote links in the current buffer using MAP. +MAP maps note ids to wiki slugs; links to unknown ids are reduced +to their description." + (goto-char (point-min)) + (while (re-search-forward + "]*>\\(\\(?:.\\|\n\\)*?\\)" + nil t) + (let* ((tid (match-string 1)) + (desc (match-string 2)) + (tslug (gethash tid map))) + (replace-match (if tslug (format "%s" tslug desc) desc) t t))) + (goto-char (point-min)) + (while (re-search-forward + "\\[\\([^]]*\\)\\](denote:\\([0-9]\\{8\\}T[0-9]\\{6\\}\\)[^)]*)" + nil t) + (let* ((desc (match-string 1)) + (tslug (gethash (match-string 2) map))) + (replace-match (if tslug (format "[%s](/wiki/%s/)" desc tslug) desc) t t)))) + +(defun garden-publish--fix-wiki-frontmatter () + "Move top-level tags/category in YAML front matter into a Zola taxonomies block. +This is done in the current buffer." + (save-excursion + (goto-char (point-min)) + (when (looking-at "^---$") + (let ((start (point))) + (forward-line) + (when (re-search-forward "^---$" nil t) + (let ((end (point))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (when (re-search-forward "^\\(tags:\\|category:\\)" nil t) + (beginning-of-line) + (insert "taxonomies:\n") + (goto-char (point-min)) + (while (re-search-forward "^tags:" nil t) + (replace-match " tags:")) + (goto-char (point-min)) + (while (re-search-forward "^category:" nil t) + (replace-match " categories:")))))))))) + +(defun garden-publish--fix-wiki (dir map exclude) + "Post-process exported wiki files in DIR. +Rewrite denote links using the id-to-slug table MAP, delete files +whose id is in the EXCLUDE table, strip PGP blocks and TODO +keywords, fix front matter taxonomies, and rename each file to its slug." + (dolist (md (directory-files dir t "\\.md\\'")) + (let* ((base (file-name-nondirectory md)) + (id (and (string-match "\\`\\([0-9]\\{8\\}T[0-9]\\{6\\}\\)" base) (match-string 1 base))) + (slug (and id (gethash id map)))) + (cond + ((and id (gethash id exclude)) (delete-file md)) + ((null slug) nil) + (t + (with-temp-buffer + (insert-file-contents md) + (garden-publish--fix-wiki-frontmatter) + (goto-char (point-min)) + (while (re-search-forward "\\(?:-----\\|–—\\)?BEGIN PGP\\(?:.\\|\n\\)*?END PGP[^&\n-]*\\(?:-----\\|–—\\)?" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "^\\(#+\\)[ \t]+\\(?:TODO\\|DONE\\|NEXT\\|WAIT[A-Z]*\\|CANCELL?ED\\|HOLD\\|STRT\\)[ \t]+" nil t) + (replace-match "\\1 ")) + (garden-publish--rewrite-denote-links map) + (write-region (point-min) (point-max) md nil 'silent)) + (unless (equal base (concat slug ".md")) + (rename-file md (expand-file-name (concat slug ".md") dir) t))))))) + +;;;###autoload +(defun garden-publish-wiki () + "Export all garden notes to Markdown in the site wiki directory." + (interactive) + (require 'denote) + (require 'ox-gfm) + (require 'denote-publish) + (let* ((out (expand-file-name garden-publish-wiki-subdir garden-publish-site-directory)) + (denote-directory (expand-file-name garden-directory)) + (org-export-with-broken-links t) + (org-export-use-babel nil) + (make-backup-files nil) + (org-publish-project-alist + `(("garden-wiki" + :base-directory ,(expand-file-name garden-directory) + :publishing-directory ,out + :publishing-function denote-publish-to-md + :recursive nil + :exclude-tags ("noexport" "draft") + :with-toc nil)))) + (make-directory out t) + (garden-publish--clean-generated out) + (garden-publish--ensure-index out "Wiki") + (garden-build) + (org-publish "garden-wiki" t) + (garden-publish--fix-wiki out (garden-publish--slug-map) (garden-publish--exclude-ids)) + (message "garden: published wiki to %s" out))) + +(defcustom garden-publish-blog-source (expand-file-name "~/garden/posts/") + "Directory holding the Org source files for blog posts." + :type 'directory :group 'garden) + +(defcustom garden-publish-pages-source (expand-file-name "~/garden/pages/") + "Directory holding the Org source files for standalone pages." + :type 'directory :group 'garden) + +(defcustom garden-publish-images-source (expand-file-name "~/garden/posts/images/") + "Directory holding images referenced by blog posts." + :type 'directory :group 'garden) + +(defcustom garden-publish-blog-subdir "content/blog" "Blog output directory relative to the site root." :type 'string :group 'garden) + +(declare-function org-export-as "ox") + +(defun garden-publish--parse-post (file) + "Parse the Org post FILE into a (PROPERTIES . BODY) pair." + (let ((props nil) (body-start 0) (i 0) + (lines (with-temp-buffer (insert-file-contents file) (split-string (buffer-string) "\n")))) + (catch 'done + (dolist (line lines) + (cond + ((string-match "\\`#\\+\\([A-Za-z_]+\\):[ \t]*\\(.*\\)\\'" line) + (push (cons (downcase (match-string 1 line)) (string-trim (match-string 2 line))) props)) + ((string-empty-p (string-trim line)) nil) + (t (setq body-start i) (throw 'done nil))) + (setq i (1+ i)))) + (cons props (string-join (nthcdr body-start lines) "\n")))) + +(defun garden-publish--strip-toc (body) + "Return BODY with any Table of Contents section removed." + (let ((out '()) (skip nil)) + (dolist (line (split-string body "\n")) + (cond + ((string-match-p "\\`\\*+ +Table of Contents[ \t]*\\'" line) (setq skip t)) + ((and skip (string-match-p "\\`\\*+ " line)) (setq skip nil) (push line out)) + (skip nil) + (t (push line out)))) + (string-join (nreverse out) "\n"))) + +(defun garden-publish--clean-slug (s) + "Normalize string S into a lowercase URL slug." + (let ((x (replace-regexp-in-string "[^a-z0-9]+" "-" (downcase (string-trim s))))) + (replace-regexp-in-string "\\(?:\\`-+\\|-+\\'\\)" "" x))) + +(defun garden-publish--org-to-gfm (body) + "Export the Org string BODY to GitHub-flavored Markdown." + (require 'ox-gfm) + (with-temp-buffer + (insert body) + (org-mode) + (let ((org-export-with-broken-links t) + (org-export-use-babel nil)) + (org-export-as 'gfm nil nil t '(:with-toc nil :with-section-numbers nil))))) + +(defun garden-publish--blog-one (file out-dir) + "Convert the blog post FILE to Markdown in OUT-DIR unless drafted." + (let* ((parsed (garden-publish--parse-post file)) + (props (car parsed)) + (body (cdr parsed))) + (unless (equal (cdr (assoc "status" props)) "draft") + (let* ((title (or (cdr (assoc "title" props)) (file-name-base file))) + (slug (garden-publish--clean-slug (or (cdr (assoc "slug" props)) (file-name-base file)))) + (date (let ((d (cdr (assoc "date" props)))) (and d (substring d 0 (min 10 (length d)))))) + (tags (let ((tg (cdr (assoc "tags" props)))) (and tg (split-string tg "[ ,]+" t)))) + (desc (cdr (assoc "description" props))) + (md (garden-publish--org-to-gfm + (garden-publish--strip-toc + (replace-regexp-in-string "/content/images/" "/images/" body)))) + (fm (concat "+++\n" + (format "title = %S\n" title) + (or (when date (format "date = \"%s\"\n" date)) "") + (or (when (and desc (not (string-empty-p desc))) + (format "description = %S\n" desc)) + "") + (or (when tags + (concat "[taxonomies]\n" + (format "tags = [%s]\n" + (mapconcat (lambda (x) (format "%S" x)) tags ", ")))) + "") + "+++\n\n"))) + (with-temp-file (expand-file-name (concat slug ".md") out-dir) + (insert fm md)))))) + +;;;###autoload +(defun garden-publish-blog () + "Export all blog posts and images to the site blog directory." + (interactive) + (let ((out (expand-file-name garden-publish-blog-subdir garden-publish-site-directory)) + (postsrc garden-publish-blog-source) + (imgsrc garden-publish-images-source) + (imgdst (expand-file-name "static/images" garden-publish-site-directory))) + (make-directory out t) + (garden-publish--clean-generated out) + (garden-publish--ensure-index out "Blog") + (if (file-directory-p postsrc) + (dolist (f (directory-files postsrc t "\\.org\\'")) + (garden-publish--blog-one f out)) + (message "garden: blog source missing, skipping posts")) + (when (file-directory-p imgsrc) + (make-directory imgdst t) + (copy-directory imgsrc imgdst t t t)) + (message "garden: published blog to %s" out))) + +(defcustom garden-publish-pages-skip '("wiki-archive") "Page slugs that are never published." :type '(repeat string) :group 'garden) + +(defcustom garden-publish-pages-manifest (expand-file-name ".garden/pages.eld" garden-directory) "File recording the page files written by the last publish run." :type 'file :group 'garden) + +(defun garden-publish--load-pages-manifest () + "Read the pages manifest file and return its entries, or nil." + (when (file-exists-p garden-publish-pages-manifest) + (with-temp-buffer + (insert-file-contents garden-publish-pages-manifest) + (ignore-errors (read (current-buffer)))))) + +(defun garden-publish--save-pages-manifest (entries) + "Write ENTRIES to the pages manifest file." + (make-directory (file-name-directory garden-publish-pages-manifest) t) + (with-temp-file garden-publish-pages-manifest (prin1 entries (current-buffer)))) + +(defun garden-publish--page-one (file out-dir) + "Convert the page FILE to Markdown in OUT-DIR and return its name." + (let* ((parsed (garden-publish--parse-post file)) + (props (car parsed)) + (body (cdr parsed)) + (slug (garden-publish--clean-slug (or (cdr (assoc "slug" props)) (file-name-base file))))) + (unless (or (equal (cdr (assoc "status" props)) "draft") + (member slug garden-publish-pages-skip)) + (let* ((title (or (cdr (assoc "title" props)) (file-name-base file))) + (desc (cdr (assoc "description" props))) + (md (garden-publish--org-to-gfm + (garden-publish--strip-toc + (replace-regexp-in-string "/content/images/" "/images/" body)))) + (fm (concat "+++\n" + (format "title = %S\n" title) + (or (when (and desc (not (string-empty-p desc))) + (format "description = %S\n" desc)) + "") + "+++\n\n"))) + (with-temp-file (expand-file-name (concat slug ".md") out-dir) + (insert fm md)) + (concat slug ".md"))))) + +;;;###autoload +(defun garden-publish-pages () + "Export all standalone pages and remove stale ones from the site." + (interactive) + (let ((out (expand-file-name "content" garden-publish-site-directory)) + (src garden-publish-pages-source) + (written '())) + (make-directory out t) + (if (file-directory-p src) + (dolist (f (directory-files src t "\\.org\\'")) + (let ((name (garden-publish--page-one f out))) + (when name (push name written)))) + (message "garden: pages source missing, skipping pages")) + (let ((stale (seq-difference (garden-publish--load-pages-manifest) written))) + (dolist (name stale) + (let ((md (expand-file-name name out))) + (when (file-exists-p md) (delete-file md)))) + (garden-publish--save-pages-manifest written) + (if stale + (message "garden: published pages to %s (removed %d stale)" out (length stale)) + (message "garden: published pages to %s" out))))) + +(defcustom garden-publish-deploy-command "just publish" + "Shell command that deploys the generated site." + :type 'string :group 'garden) + +(defun garden-publish--post-files () + "Return the Org files of all blog posts, or nil if the source is missing." + (when (file-directory-p garden-publish-blog-source) + (directory-files garden-publish-blog-source t "\\.org\\'"))) + +(defun garden-publish--page-files () + "Return the Org files of all standalone pages, or nil if the source is missing." + (when (file-directory-p garden-publish-pages-source) + (directory-files garden-publish-pages-source t "\\.org\\'"))) + +(defun garden-publish--pick-file (prompt files) + "Pick one of FILES by base name with PROMPT." + (if (null files) + (user-error "No source files available") + (let ((table (mapcar (lambda (f) (cons (file-name-nondirectory f) f)) files))) + (cdr (assoc (completing-read prompt table nil t) table))))) + +;;;###autoload +(defun garden-publish-post (file) + "Export the single blog post FILE to the site blog directory." + (interactive (list (garden-publish--pick-file "Publish post: " (garden-publish--post-files)))) + (let ((out (expand-file-name garden-publish-blog-subdir garden-publish-site-directory)) + (props (car (garden-publish--parse-post file)))) + (if (equal (cdr (assoc "status" props)) "draft") + (message "garden: %s is a draft, not published" (file-name-base file)) + (make-directory out t) + (garden-publish--ensure-index out "Blog") + (garden-publish--blog-one file out) + (message "garden: published post %s → %s" (file-name-base file) out)))) + +;;;###autoload +(defun garden-publish-page (file) + "Export the single standalone page FILE to the site content directory." + (interactive (list (garden-publish--pick-file "Publish page: " (garden-publish--page-files)))) + (let* ((out (expand-file-name "content" garden-publish-site-directory)) + (name (progn (make-directory out t) (garden-publish--page-one file out)))) + (if (null name) + (message "garden: %s is a draft or skipped, not published" (file-name-base file)) + (let ((manifest (garden-publish--load-pages-manifest))) + (unless (member name manifest) + (garden-publish--save-pages-manifest (cons name manifest)))) + (message "garden: published page %s" name)))) + +;;;###autoload +(defun garden-publish-note-as-page (&optional file slug) + "Export the garden note FILE as the standalone page SLUG on the site. +Interactively, offers the current buffer's note when visiting one, +and prompts for the slug. The note file itself stays untouched; +tag it noexport if it should not also appear under /wiki/." + (interactive) + (let* ((current (buffer-file-name)) + (file (or file + (if (and current + (string-prefix-p (expand-file-name garden-directory) + (expand-file-name current)) + (y-or-n-p (format "Publish %s as a page? " + (file-name-nondirectory current)))) + current + (garden-publish--pick-file "Publish note as page: " (garden--note-files))))) + (parsed (garden-publish--parse-post file)) + (props (car parsed)) + (title (or (cdr (assoc "title" props)) (file-name-base file))) + (slug (garden-publish--clean-slug + (or slug + (read-string "Page slug: " (or (garden-publish--filename-slug file) + (garden-publish--clean-slug title)))))) + (md (garden-publish--org-to-gfm + (garden-publish--strip-toc + (replace-regexp-in-string "/content/images/" "/images/" (cdr parsed))))) + (out (expand-file-name "content" garden-publish-site-directory)) + (map (garden-publish--slug-map))) + (make-directory out t) + (with-temp-file (expand-file-name (concat slug ".md") out) + (insert (format "+++\ntitle = %S\n+++\n\n" title) md) + (garden-publish--rewrite-denote-links map)) + (message "garden: published note as page /%s" slug))) + +;;;###autoload +(defun garden-publish-one () + "Publish a single post, page or note, then offer to deploy." + (interactive) + (let* ((candidates + (append + (mapcar (lambda (f) (cons (concat "post: " (file-name-base f)) (cons #'garden-publish-post f))) + (garden-publish--post-files)) + (mapcar (lambda (f) (cons (concat "page: " (file-name-base f)) (cons #'garden-publish-page f))) + (garden-publish--page-files)) + (mapcar (lambda (f) (cons (concat "note: " (file-name-nondirectory f)) (cons #'garden-publish-note-as-page f))) + (garden--note-files)))) + (choice (cdr (assoc (completing-read "Publish one: " candidates nil t) candidates)))) + (funcall (car choice) (cdr choice)) + (when (y-or-n-p (format "Deploy now (%s)? " garden-publish-deploy-command)) + (garden-publish-deploy)))) + +;;;###autoload +(defun garden-publish () + "Publish the wiki, the blog and the pages to the site directory." + (interactive) + (garden-publish-wiki) + (garden-publish-blog) + (garden-publish-pages) + (message "garden: published wiki + blog + pages → %s" garden-publish-site-directory)) + +;;;###autoload +(defun garden-publish-deploy () + "Run the deploy command asynchronously in the site directory." + (interactive) + (let ((default-directory (expand-file-name garden-publish-site-directory))) + (async-shell-command garden-publish-deploy-command "*garden-deploy*"))) + +;;;###autoload +(defun garden-publish-all () + "Publish the whole site and then deploy it." + (interactive) + (garden-publish) + (garden-publish-deploy)) + +(provide 'garden-publish) +;;; garden-publish.el ends here diff --git a/lisp/my-mode-line.el b/lisp/my-mode-line.el index f7cc66a..ac14cb1 100644 --- a/lisp/my-mode-line.el +++ b/lisp/my-mode-line.el @@ -63,6 +63,12 @@ (defconst my/mode-line--missing (make-symbol "missing") "Sentinel used when checking membership in package hash tables.") +(defvar my/mode-line--format nil + "The installed global header-line mode-line format.") + +(defvar-local my/mode-line--saved-mode-line-format nil + "Clatter's mode-line format saved while the global mode line is hidden.") + (defun my/mode-line--update-title-cache () "Update the cached #+title for the current buffer." (setq-local my/mode-line--buffer-title @@ -228,6 +234,58 @@ Optional THEME is ignored so this function also fits :inverse-video nil :strike-through nil)) +(defun my/mode-line--hide-clatter-buffers (&rest _) + "Hide Clatter's local mode lines while the global mode line is disabled." + (unless my/global-mode-line-mode + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'clatter-mode) + (unless (local-variable-p 'my/mode-line--saved-mode-line-format) + (setq-local my/mode-line--saved-mode-line-format mode-line-format)) + (setq-local mode-line-format nil)))))) + +(defun my/mode-line--restore-package-mode-lines () + "Restore package-local mode lines hidden by the global toggle." + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (local-variable-p 'my/mode-line--saved-mode-line-format) + (setq-local mode-line-format my/mode-line--saved-mode-line-format) + (kill-local-variable 'my/mode-line--saved-mode-line-format))))) + +(define-minor-mode my/global-mode-line-mode + "Show the custom global mode line. + +When disabled, the header-based global mode line and Clatter's package-local +bottom mode lines are hidden. Local informational headers, such as Elfeed's +column headings, remain visible." + :global t + :init-value t + :group 'mode-line + (if my/global-mode-line-mode + (progn + (setq-default header-line-format my/mode-line--format) + (my/mode-line--restore-package-mode-lines)) + (setq-default header-line-format nil) + (my/mode-line--hide-clatter-buffers)) + (force-mode-line-update t)) + +(defun my/toggle-mode-line () + "Toggle the custom mode line globally." + (interactive) + (my/global-mode-line-mode (if my/global-mode-line-mode -1 1))) + +(with-eval-after-load 'clatter-ui + (unless (advice-member-p #'my/mode-line--hide-clatter-buffers + 'clatter-ui-setup-buffer) + (advice-add 'clatter-ui-setup-buffer :after + #'my/mode-line--hide-clatter-buffers))) + +(with-eval-after-load 'clatter-track + (unless (advice-member-p #'my/mode-line--hide-clatter-buffers + 'clatter-track--refresh-mode-lines) + (advice-add 'clatter-track--refresh-mode-lines :after + #'my/mode-line--hide-clatter-buffers))) + (defun my/mode-line-install () "Install the custom mode-line built with mode-line-maker. The mode-line lives at the top of the window via `header-line-format'; @@ -236,25 +294,28 @@ the bottom mode-line is hidden." (my/mode-line-sync-theme) (add-hook 'enable-theme-functions #'my/mode-line-sync-theme) (setq-default mode-line-format nil) - (setq-default header-line-format - (mode-line-maker - '((:eval (my/mode-line-evil-state)) " " - (:eval (my/mode-line-buffer-state)) - (:eval (my/mode-line-remote)) " " - (:eval (my/mode-line-buffer-icon)) " " - (:eval (propertize (my/mode-line-buffer-name) - 'face 'mode-line-buffer-id - 'mouse-face 'mode-line-highlight - 'help-echo (concat (or buffer-file-truename (buffer-name)) - "\nmouse-1: Previous buffer\nmouse-3: Next buffer") - 'local-map mode-line-buffer-identification-keymap)) " " - mode-line-position) - '("" (:eval (my/mode-line-irc)) " " - (:eval (my/mode-line-clatter)) " " - (:eval (my/mode-line-mu4e)) " " - mode-line-process " " - (:eval (my/mode-line-time)) " " - mode-name " "))) + (setq my/mode-line--format + (mode-line-maker + '((:eval (my/mode-line-evil-state)) " " + (:eval (my/mode-line-buffer-state)) + (:eval (my/mode-line-remote)) " " + (:eval (my/mode-line-buffer-icon)) " " + (:eval (propertize (my/mode-line-buffer-name) + 'face 'mode-line-buffer-id + 'mouse-face 'mode-line-highlight + 'help-echo (concat (or buffer-file-truename (buffer-name)) + "\nmouse-1: Previous buffer\nmouse-3: Next buffer") + 'local-map mode-line-buffer-identification-keymap)) " " + mode-line-position) + '("" (:eval (my/mode-line-irc)) " " + (:eval (my/mode-line-clatter)) " " + (:eval (my/mode-line-mu4e)) " " + mode-line-process " " + (:eval (my/mode-line-time)) " " + mode-name " "))) + ;; The mode line is visible on every startup, regardless of its previous + ;; interactive state in a long-running session. + (my/global-mode-line-mode 1) (add-hook 'before-save-hook #'my/mode-line--invalidate-title-cache)) (provide 'my-mode-line) diff --git a/lisp/rsync-ui.el b/lisp/rsync-ui.el index 3282178..19ce985 100644 --- a/lisp/rsync-ui.el +++ b/lisp/rsync-ui.el @@ -260,14 +260,10 @@ (destination-label (if remote "SSH DESTINATION" "LOCAL DESTINATION")) (destination-glyph (if remote "⌁" "◎")) (destination-face (if remote 'warning 'success))) - (if (>= width 72) + (if (>= width 80) (let* ((card-width (min 30 (/ (- width 8) 2))) - (text-width (- card-width 2)) - (source (truncate-string-to-width - (rsync-ui--source-title sources) text-width nil nil "…")) - (destination (truncate-string-to-width - (rsync-ui--destination-title kind local-target ssh-host ssh-path) - text-width nil nil "…"))) + (source (rsync-ui--source-title sources)) + (destination (rsync-ui--destination-title kind local-target ssh-host ssh-path))) (vui-vstack :spacing 0 (vui-hstack @@ -293,12 +289,8 @@ (vui-box (vui-text destination :face 'rsync-ui-strong) :width card-width :align :center)))) (let* ((card-width (min 56 width)) - (text-width (- card-width 2)) - (source (truncate-string-to-width - (rsync-ui--source-title sources) text-width nil nil "…")) - (destination (truncate-string-to-width - (rsync-ui--destination-title kind local-target ssh-host ssh-path) - text-width nil nil "…"))) + (source (rsync-ui--source-title sources)) + (destination (rsync-ui--destination-title kind local-target ssh-host ssh-path))) (vui-vstack :spacing 0 (vui-hstack @@ -314,12 +306,12 @@ :width card-width :align :left :padding-left 2)))))) (defun rsync-ui--field-row (label field) - (vui-hstack + (vui-flex :width 'window (vui-box (vui-text label :face 'rsync-ui-faded) :width 16 :align :right) - field)) + (vui-flex-item :grow 1 field))) -(defun rsync-ui--gauge (progress) - (let* ((width 44) +(defun rsync-ui--gauge (progress &optional available) + (let* ((width (max 12 (min 44 (- (or available 52) 8)))) (done (max 0 (min width (round (* width (/ progress 100.0))))))) (vui-vstack :spacing 0 @@ -328,12 +320,12 @@ :spacing 0 (vui-text (make-string done ?█) :face 'success) (vui-text (make-string (- width done) ?░) :face 'shadow)) - :width 52 :align :center) + :width (or available 52) :align :center) (vui-box (vui-text (format "%3d%%" progress) :face '(:inherit bold :height 1.6)) - :width 52 :align :center)))) + :width (or available 52) :align :center)))) -(defun rsync-ui--preview-panel (preview delete) +(defun rsync-ui--preview-panel (preview delete width) (let ((count (plist-get preview :count)) (size (plist-get preview :size))) (vui-vstack @@ -343,17 +335,18 @@ "Everything is already in sync" (format "%d changes · %s to transfer" count size)) :face (if (zerop count) 'success 'rsync-ui-strong)) - :width 66 :align :center) + :width width :align :center) (when delete (vui-box (vui-text "Delete is enabled: extra files at the destination will be removed." :face '(:inherit warning :weight bold)) - :width 66 :align :center)) + :width width :align :center)) (when-let* ((sample (plist-get preview :sample))) - (vui-vstack - :spacing 0 :indent 4 - (mapcar (lambda (line) - (vui-text (truncate-string-to-width line 62 nil nil "…") :face 'shadow)) - sample)))))) + (vui-table + :sticky-header t + :columns `((:header "Preview — first changes" + :width ,(max 20 (- width 2)) :grow t :truncate t)) + :rows (mapcar (lambda (line) (list (vui-text line :face 'shadow))) + sample)))))) (vui-defcomponent rsync-ui-app (initial-sources initial-target) @@ -514,7 +507,7 @@ (vui-set-state :status nil) (vui-set-state :progress 0))))) (busy (process-live-p process)) - (source-width (max 12 (min 42 (- (rsync-ui--window-width) 31))))) + (view-width (max 28 (- (rsync-ui--window-width) 2)))) (setq rsync-ui--actions (list :choose-source choose-source :choose-target choose-target @@ -530,27 +523,27 @@ ((memq stage '(running done failed cancelled)) (vui-vstack :spacing 1 - (rsync-ui--gauge progress) + (rsync-ui--gauge progress (min 64 view-width)) (vui-flex :width 52 :justify :space-between (vui-text transferred :face 'rsync-ui-strong) (vui-text (if (string-empty-p speed) "Waiting for data…" speed) :face 'shadow) (vui-text (if (string-empty-p eta) "" (format "ETA %s" eta)) :face 'shadow)))) ((eq stage 'ready) - (rsync-ui--preview-panel preview delete)) + (rsync-ui--preview-panel preview delete view-width)) (t (vui-vstack :spacing 1 (rsync-ui--field-row "Source" - (vui-hstack - :spacing 1 - (vui-box - (vui-text - (truncate-string-to-width - (rsync-ui--source-title sources) (max 10 (- source-width 2)) nil nil "…")) - :width source-width) - (vui-button "Choose…" :on-click choose-source :disabled busy))) + (lambda (width) + (vui-flex + :width width + (vui-flex-item + :grow 1 + (vui-box (vui-text (rsync-ui--source-title sources)) + :width (max 8 (- width 10)))) + (vui-button "Choose…" :on-click choose-source :disabled busy)))) (rsync-ui--field-row "Destination" (vui-select :value kind @@ -560,15 +553,17 @@ (vui-vstack :spacing 1 (rsync-ui--field-row - "SSH host" - (vui-field :value ssh-host :size 42 :key 'ssh-host - :placeholder "user@example.org" - :on-change (lambda (value) (funcall invalidate :ssh-host value)))) + "SSH host" + (lambda (width) + (vui-field :value ssh-host :size (max 8 width) :key 'ssh-host + :placeholder "user@example.org" + :on-change (lambda (value) (funcall invalidate :ssh-host value))))) (rsync-ui--field-row "Remote folder" - (vui-field :value ssh-path :size 42 :key 'ssh-path - :placeholder "~/Backups/" - :on-change (lambda (value) (funcall invalidate :ssh-path value)))) + (lambda (width) + (vui-field :value ssh-path :size (max 8 width) :key 'ssh-path + :placeholder "~/Backups/" + :on-change (lambda (value) (funcall invalidate :ssh-path value))))) (rsync-ui--field-row "SSH port" (vui-field :value ssh-port :size 8 :key 'ssh-port @@ -578,12 +573,17 @@ (vui-muted "Uses your SSH key or agent; no password is stored."))) (rsync-ui--field-row "Local folder" - (vui-hstack - :spacing 1 - (vui-field :value local-target :size 36 :key 'local-target - :placeholder "~/Backups/" - :on-change (lambda (value) (funcall invalidate :local-target value))) - (vui-button "Choose…" :on-click choose-target :disabled busy)))) + (lambda (width) + (vui-flex + :width width + (vui-flex-item + :grow 1 + (lambda (field-width) + (vui-field :value local-target :size (max 8 field-width) + :key 'local-target :placeholder "~/Backups/" + :on-change (lambda (value) + (funcall invalidate :local-target value))))) + (vui-button "Choose…" :on-click choose-target :disabled busy))))) (rsync-ui--field-row "Folder behavior" (vui-select :value mode @@ -604,7 +604,8 @@ (when delete (vui-warning "Preview deletions carefully. This option changes the destination."))))))) (when status - (vui-box (vui-text (car status) :face (cdr status)) :width 66 :align :center)) + (vui-box (vui-text (car status) :face (cdr status)) + :width view-width :align :center)) (vui-flex :width 'fill-column :justify :space-between @@ -616,7 +617,7 @@ :face (when (eq stage 'ready) 'success)) (vui-button "Cancel" :on-click cancel-transfer :disabled (not busy) :face 'warning) (vui-button "Reset" :on-click reset :disabled busy :face 'shadow)) - (vui-muted "p preview · s start · x cancel · r reset · q close"))))) + (vui-muted "p preview · t transfer · x cancel · r reset · ? help · q close"))))) (defun rsync-ui--invoke (action) (if-let* ((callback (plist-get rsync-ui--actions action))) @@ -650,34 +651,44 @@ (defun rsync-ui-next-widget () (interactive) (condition-case nil - (widget-forward 1) + (vui-forward 1) (error (goto-char (point-min)) - (widget-forward 1)))) + (vui-forward 1)))) (defun rsync-ui-previous-widget () (interactive) (condition-case nil - (widget-backward 1) + (vui-backward 1) (error (goto-char (point-max)) - (widget-backward 1)))) + (vui-backward 1)))) + +(defun rsync-ui-help () + "Show keyboard help for the Rsync wizard." + (interactive) + (message "Rsync: j/k move, TAB/S-TAB elements, RET/l activate, p/g preview, t transfer, x cancel, r reset, h/q close")) (defvar rsync-ui-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map vui-mode-map) - (define-key map (kbd "j") #'rsync-ui-next-widget) - (define-key map (kbd "k") #'rsync-ui-previous-widget) + (define-key map (kbd "j") #'next-line) + (define-key map (kbd "k") #'previous-line) (define-key map (kbd "TAB") #'rsync-ui-next-widget) (define-key map (kbd "") #'rsync-ui-previous-widget) (define-key map (kbd "RET") #'vui-activate) + (define-key map (kbd "l") #'vui-activate) (define-key map (kbd "p") #'rsync-ui-preview) + (define-key map (kbd "g") #'rsync-ui-preview) + (define-key map (kbd "t") #'rsync-ui-start) (define-key map (kbd "s") #'rsync-ui-start) (define-key map (kbd "x") #'rsync-ui-cancel) (define-key map (kbd "r") #'rsync-ui-reset) (define-key map (kbd "o") #'rsync-ui-choose-source) (define-key map (kbd "d") #'rsync-ui-choose-target) - (define-key map (kbd "q") #'quit-window) + (define-key map (kbd "?") #'rsync-ui-help) + (define-key map (kbd "h") #'vui-quit) + (define-key map (kbd "q") #'vui-quit) map)) (define-derived-mode rsync-ui-mode vui-mode "Rsync" @@ -689,16 +700,21 @@ (with-eval-after-load 'evil (evil-set-initial-state 'rsync-ui-mode 'normal) (evil-define-key* '(normal motion) rsync-ui-mode-map - (kbd "j") #'rsync-ui-next-widget - (kbd "k") #'rsync-ui-previous-widget + (kbd "j") #'next-line + (kbd "k") #'previous-line (kbd "RET") #'vui-activate + (kbd "l") #'vui-activate (kbd "p") #'rsync-ui-preview + (kbd "g") #'rsync-ui-preview + (kbd "t") #'rsync-ui-start (kbd "s") #'rsync-ui-start (kbd "x") #'rsync-ui-cancel (kbd "r") #'rsync-ui-reset (kbd "o") #'rsync-ui-choose-source (kbd "d") #'rsync-ui-choose-target - (kbd "q") #'quit-window)) + (kbd "?") #'rsync-ui-help + (kbd "h") #'vui-quit + (kbd "q") #'vui-quit)) (defun rsync-ui--open (sources target) (let ((buffer (get-buffer-create rsync-ui-buffer-name))) diff --git a/lisp/zfs.el b/lisp/zfs.el index 07bb020..ff88154 100644 --- a/lisp/zfs.el +++ b/lisp/zfs.el @@ -82,6 +82,20 @@ Same plist shape as documented there." ((>= (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) @@ -344,7 +358,8 @@ Same plist shape as documented there." (cadr (assoc mode zfs-ui--copy-modes))) (defun zfs-ui--copy-preview-line (line) - (truncate-string-to-width line (max 24 (min 76 (- (window-width) 4))) nil nil "…")) + "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"))) @@ -467,25 +482,23 @@ Same plist shape as documented there." (defun zfs-ui--dataset-row (entry depth snap-count) (let* ((name (car entry)) (short (file-name-nondirectory name)) - (label (concat (make-string (* 2 depth) ?\s) - (if (> snap-count 0) "▸ " " ") + (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))) - (vui-hstack - (vui-box (vui-button (truncate-string-to-width label 32) :no-decoration t - :key (concat "ds:" name) - :on-click (lambda () (zfs-ui--go 'dataset name))) - :width 34) - (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop entry 'used))) :width 9) - (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop entry 'available)) :face 'shadow) :width 9) - (vui-box (vui-text (format "%s" (or (zfs-cli-prop entry 'compressratio) "-")) :face 'shadow) :width 7) - (vui-box (cond - ((or (null encryption) (equal encryption "off")) (vui-text "·" :face 'shadow)) - ((equal keystatus "available") (vui-text "🔓" :face 'success)) - (t (vui-text "🔒" :face 'warning))) - :width 4)))) + (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)) @@ -510,19 +523,13 @@ Same plist shape as documented there." (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) - (vui-hstack - :spacing 1 - (vui-box (vui-button name :no-decoration t - :key (concat "pool:" name) - :on-click (lambda () (zfs-ui--go 'pool name))) - :width 10) - (vui-box (vui-text (or health "?") :face (zfs--health-face health)) :width 9) - (vui-box (vui-text (zfs--gauge capacity) - :face (zfs--capacity-face capacity)) - :width 22) - (vui-text (format "%d%% · %s free of %s" - (or capacity 0) - (zfs--format-bytes free) + (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)))) @@ -538,18 +545,15 @@ Same plist shape as documented there." (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) - (vui-hstack - :spacing 1 - (vui-box (vui-text (if unlocked "🔓" "🔒") :face (if unlocked 'warning 'shadow)) :width 3) - (vui-box (vui-button name :no-decoration t - :key (concat "lock:" name) - :on-click (lambda () nil)) - :width 10) - (vui-box (vui-text (or (plist-get device :model) "?") :face 'shadow) :width 24) - (vui-box (vui-text (zfs--format-bytes (plist-get device :size)) :face 'shadow) :width 8) + (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 pool %s" mapper (or pool "?"))) + (unlocked (format "unlocked as %s · i imports %s" mapper (or pool "?"))) (t "locked · u unlock")) :face 'shadow)))) @@ -559,53 +563,73 @@ Same plist shape as documented there." :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))) - (apply - #'vui-vstack + (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 - (append - (when locked - (list (vui-vstack - :spacing 0 - (vui-heading-3 "Disks") - (vui-muted "LUKS disks ZFS can use once unlocked") - (apply #'vui-vstack :spacing 0 - (mapcar (lambda (device) (zfs-ui--locked-disk-row device pools)) locked))))) - (list - (vui-vstack - :spacing 0 - (vui-heading-3 "Utilities") - (vui-hstack - :spacing 2 - (vui-box (vui-text "C" :face 'success) :width 3) - (vui-button "Copy files" :no-decoration t :face 'success - :on-click (lambda () (zfs-ui--go 'copy))) - (vui-text "dry-run, copy, or move paths with rsync" :face 'shadow)) - (vui-hstack - :spacing 2 - (vui-box (vui-text "A" :face 'warning) :width 3) - (vui-button "Admin actions" :no-decoration t :face 'warning - :on-click (lambda () (zfs-ui--go 'admin))) - (vui-text "ack-gated export and format tools" :face 'shadow))) - (vui-vstack - :spacing 0 - (vui-heading-3 "Pools") - (vui-muted "teams of disks; datasets live inside them · RET details") - (if pools - (apply #'vui-vstack :spacing 0 (mapcar #'zfs-ui--pool-row pools)) - (vui-muted "No pools found. Kernel module loaded, pools imported?"))) + (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 "Datasets") - (vui-muted "named drawers · RET details · b backup · c new dataset inside") - (vui-hstack - (vui-box (vui-text "NAME" :face 'shadow) :width 34) - (vui-box (vui-text "USED" :face 'shadow) :width 9) - (vui-box (vui-text "AVAIL" :face 'shadow) :width 9) - (vui-box (vui-text "RATIO" :face 'shadow) :width 7) - (vui-box (vui-text "ENC" :face 'shadow) :width 4)) - (apply #'vui-vstack :spacing 0 - (mapcan (lambda (root) (zfs-ui--dataset-rows root 0 datasets snaps)) roots)))))))) + (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))) @@ -617,10 +641,9 @@ Same plist shape as documented there." ((numberp raw) (zfs--format-bytes raw)) (t (format "%s" (or raw "-"))))) (gloss (cdr (assoc property zfs-ui--property-glossary)))) - (vui-hstack - (vui-box (vui-text property :face 'shadow) :width 18) - (vui-box (vui-text value) :width 22) - (vui-text (or gloss "") :face 'shadow)))) + (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)) @@ -630,12 +653,10 @@ Same plist shape as documented there." :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) - (vui-hstack - (vui-box (vui-button (concat "@" leaf) :no-decoration t :face 'shadow - :key (concat "snap:" full-name) - :on-click (lambda () nil)) - :width 38) - (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop snap 'used)) :face 'shadow) :width 9) + (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) @@ -661,8 +682,12 @@ Same plist shape as documented there." (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) - (apply #'vui-vstack :spacing 0 - (mapcar (lambda (property) (zfs-ui--property-row entry property)) + (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")))) @@ -674,16 +699,21 @@ Same plist shape as documented there." (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 - (mapcar (lambda (snap) (zfs-ui--snapshot-row snap name host)) 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) - (vui-hstack - (vui-box (vui-text (concat (make-string (* 2 depth) ?\s) (plist-get vdev :name))) :width 40) - (vui-box (vui-text (or (plist-get vdev :state) "?") - :face (zfs--health-face (plist-get vdev :state))) - :width 9) - (vui-text (format "%s/%s/%s errors" + (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)) @@ -719,8 +749,12 @@ Same plist shape as documented there." (vui-vstack :spacing 0 (vui-heading-3 "Devices") - (apply #'vui-vstack :spacing 0 - (mapcar (lambda (vdev) (zfs-ui--vdev-row vdev 0)) vdevs)))))))) + (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 @@ -1078,16 +1112,19 @@ Same plist shape as documented there." (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 (apply - #'vui-vstack - :spacing 0 - (mapcar (lambda (target) - (vui-hstack - :spacing 2 - (vui-box (vui-text (plist-get target :name)) :width 16) - (vui-box (vui-text (or (plist-get target :ssh) "this machine") :face 'shadow) :width 24) - (vui-text (plist-get target :dataset) :face 'shadow))) - 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 @@ -1139,7 +1176,7 @@ Same plist shape as documented there." (setq zfs-ui--back-action (vui-with-async-context (if (eq page 'overview) - (bury-buffer) + (vui-quit) (zfs-ui--go 'overview)))) (let ((content (cond @@ -1175,11 +1212,11 @@ Same plist shape as documented there." (vui-text " ")) content (vui-text (pcase page - ('overview "RET open · C copy · A admin · u unlock · T targets · r refresh · q quit") - ('dataset "q back · s snapshot · b backup · c new dataset · d diff · R rollback · r refresh") - ('pool "q back · 1 scrub start · 2 scrub stop · x export · r refresh") - ('backup "q back · click a target · r refresh") - (_ "q back · r refresh")) + ('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 () @@ -1281,9 +1318,18 @@ Same plist shape as documented there." (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) @@ -1306,6 +1352,7 @@ Same plist shape as documented there." (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) @@ -1313,6 +1360,8 @@ Same plist shape as documented there." (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 @@ -1334,7 +1383,8 @@ Same plist shape as documented there." (kbd "F") #'zfs-ui-format (kbd "x") #'zfs-ui-export (kbd "1") #'zfs-ui-scrub-start - (kbd "2") #'zfs-ui-scrub-stop)) + (kbd "2") #'zfs-ui-scrub-stop + (kbd "?") #'zfs-ui-help)) ;;;###autoload (defun zfs () -- cgit v1.3.1