branch: externals/gnosis
commit b1d562cea5a49f3c91f31a8f6931d11877c11be8
Author: Thanos Apollo <[email protected]>
Commit: Thanos Apollo <[email protected]>
[fix] gnosis-tl: Add sorting.
---
gnosis-dashboard.el | 99 +++++++++++++++++++++++--------
gnosis-tl.el | 163 ++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 239 insertions(+), 23 deletions(-)
diff --git a/gnosis-dashboard.el b/gnosis-dashboard.el
index 71d3107740..0da5a6cce9 100644
--- a/gnosis-dashboard.el
+++ b/gnosis-dashboard.el
@@ -76,14 +76,17 @@ When non-nil, sort in ascending order (smaller values
first)."
Populated by `gnosis-dashboard--output-themata', invalidated on
edit, delete, and suspend.")
-(defvar-local gnosis-dashboard--rendered-ids nil
- "Thema IDs of the last rendered view.")
+(defvar gnosis-dashboard--rendered-ids nil
+ "Thema IDs of the last rendered all-themata view.")
-(defvar-local gnosis-dashboard--rendered-width nil
- "Window width of the last rendered view.")
+(defvar gnosis-dashboard--rendered-width nil
+ "Window width of the last rendered all-themata view.")
-(defvar-local gnosis-dashboard--rendered-text nil
- "Cached buffer text (with properties) of the last rendered view.")
+(defvar gnosis-dashboard--rendered-text nil
+ "Pre-rendered buffer text (with properties) of the all-themata view.
+Persists across dashboard opens. Invalidated only when data changes
+via `gnosis-dashboard--update-entries', `gnosis-dashboard--remove-entries',
+or `gnosis-dashboard-rebuild-cache'.")
(defvar gnosis-dashboard-themata-mode)
@@ -500,7 +503,8 @@ Continues as long as the dashboard buffer exists."
(run-with-timer gnosis-dashboard-timer-delay nil
#'gnosis-dashboard--warm-cache-chunk
(cdr chunks) total new-warmed))
- (message "Cache warmed (%d themata)" total)))))
+ (message "Cache warmed (%d themata)" total)
+ (gnosis-dashboard--start-prerender)))))
(defun gnosis-dashboard-warm-cache ()
"Warm the entry cache for all themata in the background.
@@ -517,6 +521,51 @@ which view the user navigates to."
#'gnosis-dashboard--warm-cache-chunk
chunks (length all-ids) 0))))
+(defun gnosis-dashboard--start-prerender ()
+ "Begin background pre-rendering of the all-themata view.
+Called after cache warming completes. Splits entries into chunks
+and processes them via timer chain, storing the final result in
+`gnosis-dashboard--rendered-text'."
+ (let* ((buf (get-buffer gnosis-dashboard-buffer-name))
+ (win (and buf (get-buffer-window buf)))
+ (w (if win (window-width win) 80))
+ (all-ids (gnosis-select 'id 'themata nil t))
+ (gen gnosis-dashboard--load-generation)
+ (fmt (gnosis-dashboard--compute-column-format w))
+ (entries (cl-loop for id in all-ids
+ for entry = (gethash id
gnosis-dashboard--entry-cache)
+ when entry collect entry))
+ (chunks (let (result (rest entries))
+ (while rest
+ (push (seq-take rest gnosis-dashboard-chunk-size) result)
+ (setq rest (nthcdr gnosis-dashboard-chunk-size rest)))
+ (nreverse result))))
+ (when chunks
+ (run-with-timer gnosis-dashboard-timer-delay nil
+ #'gnosis-dashboard--prerender-chunk
+ chunks fmt w all-ids gen nil))))
+
+(defun gnosis-dashboard--prerender-chunk (chunks fmt width all-ids gen acc)
+ "Render one CHUNKS entry for the pre-render cache.
+FMT: column format vector. WIDTH: window width.
+ALL-IDS: full thema ID list. GEN: load generation for staleness.
+ACC: accumulated result strings."
+ (when (and (get-buffer gnosis-dashboard-buffer-name)
+ (= gen gnosis-dashboard--load-generation))
+ (let ((rendered (gnosis-tl-render-lines (car chunks) fmt 2)))
+ (push rendered acc)
+ (if (cdr chunks)
+ (run-with-timer gnosis-dashboard-timer-delay nil
+ #'gnosis-dashboard--prerender-chunk
+ (cdr chunks) fmt width all-ids gen acc)
+ ;; Final chunk — assemble and store
+ (let ((text (apply #'concat (nreverse acc))))
+ (when (= gen gnosis-dashboard--load-generation)
+ (setq gnosis-dashboard--rendered-text text
+ gnosis-dashboard--rendered-ids all-ids
+ gnosis-dashboard--rendered-width width))
+ (message "Pre-render complete (%d themata)" (length all-ids)))))))
+
(defun gnosis-dashboard-rebuild-cache ()
"Clear and rebuild the themata entry cache."
(interactive)
@@ -525,20 +574,22 @@ which view the user navigates to."
(message "Cache cleared, rebuilding...")
(gnosis-dashboard-warm-cache))
-(defun gnosis-dashboard--set-column-format ()
- "Set `tabulated-list-format' based on current window width.
+(defun gnosis-dashboard--compute-column-format (width)
+ "Compute the themata column format vector for window WIDTH.
Distributes available width (minus padding and column gaps)
-proportionally so all columns fit within the window."
- (let* ((w (window-width))
- ;; Reserve: tabulated-list-padding (2) + 5 column gaps (1 each)
- (avail (- w 7)))
- (setf tabulated-list-format
- `[("Keimenon" ,(max 10 (/ (* avail 28) 100)) t)
- ("Hypothesis" ,(max 8 (/ (* avail 16) 100)) t)
- ("Answer" ,(max 8 (/ (* avail 16) 100)) t)
- ("Tags" ,(max 8 (/ (* avail 18) 100)) t)
- ("Type" ,(max 5 (/ (* avail 10) 100)) t)
- ("Suspend" ,(max 3 (/ (* avail 8) 100)) t)])))
+proportionally so all columns fit."
+ (let ((avail (- width 7)))
+ `[("Keimenon" ,(max 10 (/ (* avail 28) 100)) t)
+ ("Hypothesis" ,(max 8 (/ (* avail 16) 100)) t)
+ ("Answer" ,(max 8 (/ (* avail 16) 100)) t)
+ ("Tags" ,(max 8 (/ (* avail 18) 100)) t)
+ ("Type" ,(max 5 (/ (* avail 10) 100)) t)
+ ("Suspend" ,(max 3 (/ (* avail 8) 100)) t)]))
+
+(defun gnosis-dashboard--set-column-format ()
+ "Set `tabulated-list-format' based on current window width."
+ (setf tabulated-list-format
+ (gnosis-dashboard--compute-column-format (window-width))))
(defun gnosis-dashboard-output-themata (thema-ids)
@@ -576,7 +627,7 @@ proportionally so all columns fit within the window."
;; Cache miss — compute entries and render
(let ((entries (gnosis-dashboard--output-themata thema-ids)))
(setq tabulated-list-entries entries)
- (tabulated-list-print)
+ (gnosis-tl-print)
;; Defer rendered text cache to idle time
(let ((buf (current-buffer))
(ids (copy-sequence thema-ids))
@@ -589,8 +640,8 @@ proportionally so all columns fit within the window."
(setq gnosis-dashboard--rendered-ids ids
gnosis-dashboard--rendered-width w
gnosis-dashboard--rendered-text
- (buffer-substring (point-min) (point-max))))))))))
- (gnosis-dashboard--set-header-line (length thema-ids))))
+ (buffer-string))))))))))
+ (gnosis-dashboard--set-header-line (length thema-ids)))
(defun gnosis-dashboard-deck-thema-count (id)
"Return total thema count for deck with ID."
@@ -855,6 +906,8 @@ When called with a prefix, unsuspend all themata of deck."
"n" #'gnosis-dashboard-menu-nodes
"t" #'gnosis-dashboard-menu-themata
"D" #'gnosis-dashboard-output-decks
+ ;; Sort (override tabulated-list-sort with fast version)
+ "S" #'gnosis-tl-sort
;; Actions
"r" #'gnosis-review
"a" #'gnosis-add-thema
diff --git a/gnosis-tl.el b/gnosis-tl.el
index 30825e9380..885a18c15e 100644
--- a/gnosis-tl.el
+++ b/gnosis-tl.el
@@ -96,6 +96,169 @@ Returns a single string with tabulated-list text properties
attached."
line)
line)))
+;;; Sorting
+
+(defun gnosis-tl--get-sorter ()
+ "Return a comparison function for `tabulated-list-entries', or nil.
+Mirrors `tabulated-list--get-sorter': uses `tabulated-list-sort-key'
+and `tabulated-list-format' to build the comparator. Returns nil
+when no sort key is set or the column is not sortable."
+ (when (and tabulated-list-sort-key
+ (car tabulated-list-sort-key))
+ (let* ((sort-col (car tabulated-list-sort-key))
+ (n (tabulated-list--column-number sort-col))
+ (sorter (nth 2 (aref tabulated-list-format n))))
+ (when (eq sorter t)
+ (setq sorter (lambda (a b)
+ (let ((a (aref (cadr a) n))
+ (b (aref (cadr b) n)))
+ (string< (if (stringp a) a (car a))
+ (if (stringp b) b (car b)))))))
+ (when sorter
+ (if (cdr tabulated-list-sort-key)
+ (lambda (a b) (funcall sorter b a))
+ sorter)))))
+
+;;; Bulk rendering
+
+(defun gnosis-tl--render-into-buffer (entries format padding)
+ "Render ENTRIES into the current buffer at point.
+FORMAT is the `tabulated-list-format' vector. PADDING is the
+`tabulated-list-padding' integer.
+
+Uses pre-computed format strings and an ASCII fast-path to
+minimise per-entry overhead. Properties set per line:
+`tabulated-list-id', `tabulated-list-entry'; per column:
+`tabulated-list-column-name' (needed by `tabulated-list-sort')."
+ (let* ((specs (gnosis-tl--column-specs format))
+ (n-cols (length specs))
+ (last-idx (1- n-cols))
+ (ellipsis gnosis-tl-ellipsis)
+ (pad-str (when (> padding 0) (make-string padding ?\s)))
+ ;; Pre-compute per-column vectors (avoid plist-get in hot loop)
+ (widths (vconcat (mapcar (lambda (s) (plist-get s :width)) specs)))
+ (pad-rights (vconcat (cl-loop for s in specs for i from 0
+ collect (if (= i last-idx) 0
+ (plist-get s :pad-right)))))
+ (right-aligns (vconcat (mapcar (lambda (s) (plist-get s
:right-align)) specs)))
+ (col-names (vconcat (mapcar (lambda (s) (plist-get s :name)) specs)))
+ ;; Pre-computed "%-Ns" format strings for ASCII fast-path
+ (fmt-strs (vconcat (cl-loop for i below n-cols
+ collect (format "%%-%ds"
+ (+ (aref widths i)
+ (aref pad-rights
i)))))))
+ (dolist (entry entries)
+ (let ((id (car entry))
+ (cols (cadr entry))
+ (beg (point))
+ (i 0))
+ (when pad-str (insert pad-str))
+ (while (< i n-cols)
+ (let* ((raw (or (aref cols i) ""))
+ (text (if (stringp raw) raw (format "%s" raw)))
+ (len (length text))
+ (ascii-p (= len (string-bytes text)))
+ (width (aref widths i))
+ (col-beg (point)))
+ (if (= i last-idx)
+ ;; Last column — no padding, just truncate if needed
+ (insert (if (and ascii-p (<= len width))
+ text
+ (let ((sw (if ascii-p len (string-width text))))
+ (if (> sw width)
+ (truncate-string-to-width text width nil nil
ellipsis)
+ text))))
+ ;; Non-last columns — pad to width + pad-right
+ (if (and ascii-p (<= len width))
+ ;; Fast path: single C-level format call does padding
+ (insert (format (aref fmt-strs i) text))
+ ;; Slow path: multibyte or truncation needed
+ (let ((sw (if ascii-p len (string-width text)))
+ (pr (aref pad-rights i)))
+ (if (> sw width)
+ (insert (truncate-string-to-width text width nil nil
ellipsis)
+ (make-string pr ?\s))
+ (if (aref right-aligns i)
+ (insert (make-string (- width sw) ?\s) text
+ (make-string pr ?\s))
+ (insert text (make-string (+ (- width sw) pr) ?\s)))))))
+ (put-text-property col-beg (point)
+ 'tabulated-list-column-name
+ (aref col-names i)))
+ (setq i (1+ i)))
+ (insert ?\n)
+ (add-text-properties beg (point)
+ (list 'tabulated-list-id id
+ 'tabulated-list-entry cols))))))
+
+(defun gnosis-tl-render-lines (entries format padding)
+ "Render ENTRIES into a single propertized string.
+FORMAT is the `tabulated-list-format' vector. PADDING is the
+`tabulated-list-padding' integer. Returns the concatenated text
+of all formatted lines. Pure function — no buffer side effects."
+ (with-temp-buffer
+ (gnosis-tl--render-into-buffer entries format padding)
+ (buffer-string)))
+
+(defun gnosis-tl-print (&optional remember-pos)
+ "Fast drop-in replacement for `tabulated-list-print'.
+Renders directly into the current buffer using optimised bulk
+insertion. When REMEMBER-POS is non-nil, restore point to the
+same entry ID and column."
+ (let* ((saved-id (and remember-pos (tabulated-list-get-id)))
+ (saved-col (and remember-pos (current-column)))
+ (inhibit-read-only t)
+ (entries (if (functionp tabulated-list-entries)
+ (funcall tabulated-list-entries)
+ tabulated-list-entries))
+ (sorter (gnosis-tl--get-sorter)))
+ (when sorter
+ (setq entries (sort entries sorter))
+ (unless (functionp tabulated-list-entries)
+ (setq tabulated-list-entries entries)))
+ (erase-buffer)
+ (gnosis-tl--render-into-buffer entries tabulated-list-format
+ (or tabulated-list-padding 0))
+ (set-buffer-modified-p nil)
+ (if (and saved-id remember-pos)
+ (progn
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (not (equal (get-text-property (point)
'tabulated-list-id)
+ saved-id)))
+ (forward-line 1))
+ (when saved-col
+ (move-to-column saved-col)))
+ (goto-char (point-min)))))
+
+(defun gnosis-tl-sort (&optional n)
+ "Sort the current tabulated-list by column at point.
+Like `tabulated-list-sort' but re-renders with `gnosis-tl-print'.
+With numeric prefix N, sort the Nth column. With prefix -1,
+restore original order."
+ (interactive "P")
+ (when (and n (or (>= n (length tabulated-list-format))
+ (< n -1)))
+ (user-error "Invalid column number"))
+ (if (equal n -1)
+ (progn
+ (setq tabulated-list-sort-key nil)
+ (tabulated-list-init-header)
+ (gnosis-tl-print t))
+ (let ((name (if n
+ (car (aref tabulated-list-format n))
+ (get-text-property (point)
+ 'tabulated-list-column-name))))
+ (unless name (user-error "No column at point"))
+ (unless (nth 2 (assoc name (append tabulated-list-format nil)))
+ (user-error "Cannot sort by %s" name))
+ (if (equal name (car tabulated-list-sort-key))
+ (setcdr tabulated-list-sort-key
+ (not (cdr tabulated-list-sort-key)))
+ (setq tabulated-list-sort-key (cons name nil)))
+ (tabulated-list-init-header)
+ (gnosis-tl-print t))))
+
;;; Single-entry buffer operations
(defun gnosis-tl-replace-entry (id new-cols)
