md: 2026-09-03T15:50:32+02:00

4 files changed, 1163 insertions, 25 deletions

diff --git a/lisp/citre-backend.el b/lisp/citre-backend.el
new file mode 100644
index 0000000..8c50c6d
--- /dev/null
+++ b/lisp/citre-backend.el
@@ -0,0 +1,138 @@
+;;; citre-backend.el --- Live and persistent tags through Citre -*- lexical-binding: t; -*-
+
+(require 'citre)
+(require 'citre-tags)
+(require 'citre-index)
+
+(defvar company--capf-cache)
+(defvar-local my/citre-backend--completion-cache nil)
+
+;; Retire the popup restart timer when reloading an earlier version of this module.
+(when (boundp 'my/citre-backend--company-timer)
+  (my/citre-index--cancel-timer (symbol-value 'my/citre-backend--company-timer))
+  (set 'my/citre-backend--company-timer nil))
+
+(defun my/citre-backend--sources ()
+  "Return (TAGS-FILE . LIVE-SOURCE) pairs in priority order."
+  (if-let* ((state my/citre-index--state))
+      (let* ((entries (my/citre-index-live-entries state))
+             (current (my/citre-index--path))
+             (live (sort entries (lambda (a b) (and (equal (car a) current) (not (equal (car b) current)))))))
+        (append
+         (mapcar (lambda (entry) (cons (plist-get (cdr entry) :file) (car entry))) live)
+         (let ((project (expand-file-name "project.tags" (my/citre-index-state-cache state))))
+           (if (file-readable-p project)
+               (list (cons project nil))
+             (when-let* ((legacy (citre-tags-file-path))) (list (cons legacy nil)))))
+         (let ((dependencies (expand-file-name "dependencies.tags" (my/citre-index-state-cache state))))
+           (when (file-readable-p dependencies) (list (cons dependencies nil))))))
+    (when-let* ((file (citre-tags-file-path))) (list (cons file nil)))))
+
+(defun my/citre-backend--query (operation &optional identifier)
+  "Merge tags for OPERATION, optionally using IDENTIFIER, while masking superseded files."
+  (let* ((sources (my/citre-backend--sources))
+         (masked (delq nil (mapcar #'cdr sources)))
+         (seen (make-hash-table :test #'equal))
+         result)
+    (dolist (source sources)
+      (let* ((file (car source))
+             (symbol (or (and identifier
+                              (citre-put-property (copy-sequence identifier)
+                                                  'file-path buffer-file-name 'tags-file file))
+                         (and (not (memq operation '(identifiers imenu)))
+                              (citre-tags-get-symbol file))))
+             (filter
+              (pcase operation
+                ('completion (when symbol (or (citre-tags--get-value-in-language-alist :completion-filter symbol)
+                                              (citre-tags-completion-default-filter symbol))))
+                ('definition (when symbol (or (citre-tags--get-value-in-language-alist :definition-filter symbol)
+                                              (citre-tags-definition-default-filter symbol))))
+                ('imenu (list 'and (citre-readtags-filter-input (my/citre-index--path) file)
+                              (list 'not citre-tags-filter-file-tags)))
+                (_ (list 'not citre-tags-filter-file-tags))))
+             (sorter
+              (pcase operation
+                ('completion (when symbol (or (citre-tags--get-value-in-language-alist :completion-sorter symbol)
+                                              citre-tags-completion-default-sorter)))
+                ('imenu (citre-readtags-sorter 'line))
+                (_ citre-tags-definition-default-sorter)))
+             (tags (when (or symbol (memq operation '(identifiers imenu)))
+                     (citre-tags-get-tags
+                      file symbol (if (eq operation 'completion) (if citre-tags-substr-completion 'substr 'prefix) 'exact)
+                      :filter filter :sorter sorter
+                      :require '(name ext-abspath)
+                      :optional '(pattern line end ext-kind-full signature scope typeref extras language)))))
+        (dolist (tag tags)
+          (let* ((path (citre-get-tag-field 'ext-abspath tag))
+                 (key (mapcar (lambda (field) (citre-get-tag-field field tag))
+                              '(name ext-abspath line scope ext-kind-full))))
+            (unless (or (and (not (cdr source)) (member path masked)) (gethash key seen))
+              (puthash key t seen)
+              (push tag result))))))
+    (nreverse result)))
+
+(defun my/citre-backend-completions ()
+  "Return current Citre completion bounds and tags, reusing a narrowing prefix."
+  (when-let* ((source (car (my/citre-backend--sources)))
+              (symbol (citre-tags-get-symbol (car source)))
+              (bounds (citre-get-property 'bounds symbol)))
+    (let* ((revision (and my/citre-index--state (my/citre-index-state-revision my/citre-index--state)))
+           (context (list revision (car bounds) major-mode citre-tags-substr-completion
+                          (buffer-substring-no-properties (line-beginning-position) (car bounds))))
+           (cache my/citre-backend--completion-cache)
+           (tags (if (and revision (equal context (plist-get cache :context))
+                          (string-prefix-p (plist-get cache :prefix) symbol))
+                     (plist-get cache :tags)
+                   (let ((tags (my/citre-backend--query 'completion)))
+                     (setq my/citre-backend--completion-cache
+                           (list :context context :prefix (substring-no-properties symbol) :tags tags))
+                     tags))))
+      (when tags (list (car bounds) (cdr bounds) tags)))))
+
+(defun my/citre-backend-definitions ()
+  "Find definitions in the current live and persistent indexes."
+  (my/citre-backend--query 'definition))
+
+(defun my/citre-backend-definitions-of-id (identifier)
+  "Find definitions of IDENTIFIER in the current project."
+  (my/citre-backend--query 'definition identifier))
+
+(defun my/citre-backend-identifiers ()
+  "Return all current identifiers for Citre's query UI."
+  (delete-dups (mapcar (lambda (tag) (citre-get-tag-field 'name tag))
+                      (my/citre-backend--query 'identifiers))))
+
+(defun my/citre-backend-imenu ()
+  "Return the current file's symbols for Imenu, including unsaved changes."
+  (my/citre-backend--query 'imenu))
+
+(defun my/citre-backend-usable-p ()
+  "Whether the current buffer has an automatic or conventional tags index."
+  (or my/citre-index--state (citre-tags-usable-p)))
+
+(defun my/citre-backend--updated (state)
+  "Invalidate data for STATE without restarting or rearranging an open Company menu."
+  (dolist (buffer (my/citre-index--buffers state))
+    (with-current-buffer buffer
+      (setq my/citre-backend--completion-cache nil)
+      (when (boundp 'imenu--index-alist) (setq imenu--index-alist nil))
+      ;; Fresh data is consumed on the next edit or completion request. Navigation keeps its current candidates and selection.
+      (when (and (boundp 'company--capf-cache)
+                 (eq (car company--capf-cache) buffer))
+        (setq company--capf-cache nil)))))
+
+(citre-register-backend
+ 'my-index
+ (citre-backend-create :usable-probe #'my/citre-backend-usable-p
+                      :symbol-at-point-fn #'citre-tags-symbol-at-point
+                      :completions-fn #'my/citre-backend-completions
+                      :defs-fn #'my/citre-backend-definitions
+                      :defs-of-id-fn #'my/citre-backend-definitions-of-id
+                      :id-list-fn #'my/citre-backend-identifiers
+                      :tags-in-buffer-fn #'my/citre-backend-imenu
+                      :after-jump-fn #'my/citre-index-attach))
+
+(add-hook 'my/citre-index-updated-hook #'my/citre-backend--updated)
+
+(provide 'citre-backend)
+;;; citre-backend.el ends here
diff --git a/lisp/citre-index.el b/lisp/citre-index.el
new file mode 100644
index 0000000..99dda7b
--- /dev/null
+++ b/lisp/citre-index.el
@@ -0,0 +1,469 @@
+;;; citre-index.el --- Automatic project and live-buffer tags -*- lexical-binding: t; -*-
+
+(require 'cl-lib)
+(require 'json)
+(require 'project)
+(require 'filenotify)
+(require 'subr-x)
+
+(defgroup my/citre nil "Automatic Citre indexes." :group 'tools)
+(defcustom my/project-ctags-program (expand-file-name "bin/project-ctags" user-emacs-directory)
+  "Worker used for disk indexes and buffer snapshots." :type 'file :group 'my/citre)
+(defcustom my/citre-index-cache-directory (expand-file-name "citre-cache/" user-emacs-directory)
+  "Persistent disk indexes; live snapshots are private to this Emacs session." :type 'directory :group 'my/citre)
+(defcustom my/citre-index-idle-delay 0.1
+  "Idle seconds before parsing changed buffers." :type 'number :group 'my/citre)
+(defcustom my/citre-index-refresh-delay 0.2
+  "Seconds to collect disk changes before checking the project." :type 'number :group 'my/citre)
+(defcustom my/citre-index-check-interval 30
+  "Seconds between background checks of projects with open buffers." :type 'number :group 'my/citre)
+(defcustom my/citre-index-dependency-check-interval 300
+  "Seconds between dependency discovery when declarations have not changed." :type 'number :group 'my/citre)
+(defcustom my/citre-index-max-watches 256
+  "Maximum directory watches per project; periodic checks cover the remainder." :type 'integer :group 'my/citre)
+(defcustom my/citre-index-max-buffer-size (* 2 1024 1024)
+  "Maximum buffer size for live snapshots; larger files use the disk index." :type 'integer :group 'my/citre)
+(defcustom my/citre-index-process-timeout 120
+  "Maximum seconds for a disk-index worker." :type 'number :group 'my/citre)
+(defcustom my/citre-index-excluded-directories
+  '(".git" ".hg" ".svn" ".direnv" ".venv" ".pixi" "__pycache__" "node_modules" "target" "build" "dist" "citre-cache")
+  "Directory names excluded from automatic project and live-buffer indexing." :type '(repeat string) :group 'my/citre)
+(defvar-local my/project-ctags-arguments nil
+  "Additional worker arguments, usually configured in project directory locals.")
+(put 'my/project-ctags-arguments 'safe-local-variable
+     (lambda (value) (and (listp value) (seq-every-p #'stringp value))))
+
+(cl-defstruct (my/citre-index-state (:constructor my/citre-index--make-state))
+  root cache environment paths arguments
+  disk-process live-process disk-timer live-timer pending force
+  entries watches live-directory error checked (revision 0))
+
+(defvar my/citre-index--projects (make-hash-table :test #'equal))
+(defvar my/citre-index--timer nil)
+(defvar my/citre-index-mode nil)
+(defvar my/citre-index-updated-hook nil
+  "Functions called with the project state after an index changes.")
+(defvar-local my/citre-index--state nil)
+(defvar-local my/citre-index--dirty nil)
+
+(defun my/citre-index--path ()
+  "Return the canonical visited filename, including for a new file."
+  (when buffer-file-name (file-truename buffer-file-name)))
+
+(defun my/citre-index--eligible-p ()
+  "Whether the current buffer is a local source file eligible for indexing."
+  (and buffer-file-name (derived-mode-p 'prog-mode)
+       (not (file-remote-p buffer-file-name))
+       (not (cl-intersection (split-string buffer-file-name "/" t)
+                             my/citre-index-excluded-directories :test #'equal))))
+
+(defun my/citre-index--root ()
+  "Find a local project root without prompting."
+  (when (my/citre-index--eligible-p)
+    (when-let* ((root (or (and (fboundp 'projectile-project-root)
+                              (ignore-errors (projectile-project-root)))
+                         (when-let* ((project (project-current nil)))
+                           (project-root project)))))
+      (file-name-as-directory (file-truename root)))))
+
+(defun my/citre-index--buffers (state)
+  "Return living buffers attached to STATE."
+  (cl-remove-if-not
+   (lambda (buffer)
+     (and (buffer-live-p buffer)
+          (eq (buffer-local-value 'my/citre-index--state buffer) state)))
+   (buffer-list)))
+
+(defun my/citre-index--log (state)
+  "Return the private worker log for STATE."
+  (get-buffer-create (format " *citre-index:%s*" (my/citre-index-state-root state))))
+
+(defun my/citre-index--updated (state)
+  "Invalidate consumers after publishing a new index in STATE."
+  (cl-incf (my/citre-index-state-revision state))
+  (run-hook-with-args 'my/citre-index-updated-hook state))
+
+(defun my/citre-index--environment (state)
+  "Capture the current buffer's project environment in STATE."
+  (setf (my/citre-index-state-environment state) (copy-sequence process-environment)
+        (my/citre-index-state-paths state) (copy-sequence exec-path)
+        (my/citre-index-state-arguments state) (copy-sequence my/project-ctags-arguments)))
+
+(defun my/citre-index--cancel-timer (timer)
+  "Cancel TIMER if it exists."
+  (when (timerp timer) (cancel-timer timer)))
+
+(defun my/citre-index--record-error (state error)
+  "Record ERROR without interrupting editing or displaying a buffer."
+  (setf (my/citre-index-state-error state) (format "%s" error))
+  (with-current-buffer (my/citre-index--log state)
+    (goto-char (point-max))
+    (insert (format "\n%s\n" error))))
+
+(defun my/citre-index--spawn (state name arguments sentinel &optional filter)
+  "Start one worker for STATE using ARGUMENTS, SENTINEL and FILTER."
+  (let ((default-directory (my/citre-index-state-root state))
+        (process-environment (my/citre-index-state-environment state))
+        (exec-path (my/citre-index-state-paths state)))
+    (make-process :name name :buffer (my/citre-index--log state)
+                  :command (append (list my/project-ctags-program default-directory) arguments)
+                  :connection-type 'pipe :noquery t :sentinel sentinel :filter filter
+                  :stderr (my/citre-index--log state))))
+
+(defun my/citre-index--watch (state directories)
+  "Reconcile bounded directory watches for STATE with DIRECTORIES."
+  (let* ((git (expand-file-name ".git" (my/citre-index-state-root state)))
+         (wanted (seq-take (delete-dups
+                            (append (list (my/citre-index-state-root state))
+                                    (when (file-directory-p git) (list git (expand-file-name "refs/heads" git)))
+                                    directories))
+                           my/citre-index-max-watches))
+         (watches (my/citre-index-state-watches state)))
+    (maphash (lambda (directory descriptor)
+               (unless (and (member directory wanted) (file-notify-valid-p descriptor))
+                 (ignore-errors (file-notify-rm-watch descriptor))
+                 (remhash directory watches)))
+             watches)
+    (dolist (directory wanted)
+      (when (and (file-directory-p directory) (not (gethash directory watches)))
+        (condition-case nil
+            (puthash directory
+                     (file-notify-add-watch
+                      directory '(change)
+                      (lambda (event)
+                        (unless (or (eq (nth 1 event) 'stopped)
+                                    (cl-some (lambda (path)
+                                               (and (stringp path)
+                                                    (string-prefix-p (file-name-as-directory my/citre-index-cache-directory) path)))
+                                             (cddr event)))
+                          (my/citre-index-request-refresh state))))
+                     watches)
+          (file-notify-error nil))))))
+
+(defun my/citre-index--disk-filter (state process chunk)
+  "Consume line-delimited worker events for STATE from PROCESS and CHUNK."
+  (let* ((text (concat (or (process-get process 'partial) "") chunk))
+         (lines (split-string text "\n")))
+    (process-put process 'partial (car (last lines)))
+    (dolist (line (butlast lines))
+      (condition-case nil
+          (let ((event (json-parse-string line :object-type 'alist :array-type 'list :false-object nil)))
+            (when (equal (alist-get 'event event) "complete")
+              (process-put process 'manifest event))
+            (when (alist-get 'changed event)
+              (process-put process 'changed t)
+              (when (equal (alist-get 'event event) "project")
+                (my/citre-index--updated state))))
+        (error (with-current-buffer (my/citre-index--log state)
+                 (goto-char (point-max)) (insert line "\n")))))))
+
+(defun my/citre-index--disk-finished (state process _event)
+  "Publish a finished disk worker for STATE."
+  (when (memq (process-status process) '(exit signal))
+    (my/citre-index--cancel-timer (process-get process 'timeout))
+    (when (eq process (my/citre-index-state-disk-process state))
+      (setf (my/citre-index-state-disk-process state) nil)
+      (if (and (eq (process-status process) 'exit) (zerop (process-exit-status process)))
+          (condition-case error
+              (let ((manifest (process-get process 'manifest)))
+                (setf (my/citre-index-state-error state) nil
+                      (my/citre-index-state-checked state) (current-time))
+                (my/citre-index--watch state (alist-get 'directories manifest))
+                (when (process-get process 'changed)
+                  (my/citre-index--updated state)))
+            (error (my/citre-index--record-error state error)))
+        (my/citre-index--record-error state (format "Disk worker exited: %s" (process-exit-status process))))
+      (when (my/citre-index-state-pending state)
+        (my/citre-index-request-refresh state)))))
+
+(defun my/citre-index--start-disk (state)
+  "Start or coalesce the next disk check for STATE."
+  (setf (my/citre-index-state-disk-timer state) nil)
+  (when (and my/citre-index-mode (my/citre-index--buffers state))
+    (if (process-live-p (my/citre-index-state-disk-process state))
+        (setf (my/citre-index-state-pending state) t)
+      (condition-case error
+          (let* ((arguments
+                  (append (my/citre-index-state-arguments state)
+                          (list "--cache-dir" (my/citre-index-state-cache state)
+                                "--dependency-check-interval" (number-to-string my/citre-index-dependency-check-interval)
+                                "--watch-limit" (number-to-string my/citre-index-max-watches))
+                          (cl-mapcan (lambda (name) (list "--exclude-dir" name)) my/citre-index-excluded-directories)
+                          (when (my/citre-index-state-force state) '("--force"))))
+                 (process (my/citre-index--spawn state "citre-disk" arguments
+                                                (lambda (process event) (my/citre-index--disk-finished state process event))
+                                                (lambda (process chunk) (my/citre-index--disk-filter state process chunk)))))
+            (setf (my/citre-index-state-disk-process state) process
+                  (my/citre-index-state-pending state) nil
+                  (my/citre-index-state-force state) nil)
+            (process-put process 'timeout
+                         (run-at-time my/citre-index-process-timeout nil
+                                      (lambda () (when (process-live-p process) (delete-process process))))))
+        (error (my/citre-index--record-error state error))))))
+
+(defun my/citre-index-request-refresh (state &optional force)
+  "Schedule a background disk check for STATE; FORCE requests a full rebuild."
+  (when (and my/citre-index-mode state)
+    (when force (setf (my/citre-index-state-force state) t))
+    (setf (my/citre-index-state-pending state) t)
+    (unless (timerp (my/citre-index-state-disk-timer state))
+      (setf (my/citre-index-state-disk-timer state)
+            (run-at-time my/citre-index-refresh-delay nil #'my/citre-index--start-disk state)))))
+
+(defun my/citre-index-live-entries (state)
+  "Return valid live entries in STATE and retire entries of detached or renamed buffers."
+  (let (entries retired)
+    (maphash
+     (lambda (path entry)
+       (let ((buffer (plist-get entry :buffer)))
+         (if (and (buffer-live-p buffer)
+                  (with-current-buffer buffer
+                    (and (eq my/citre-index--state state) (equal path (my/citre-index--path))
+                         (or (buffer-modified-p) (verify-visited-file-modtime buffer)))))
+             (push (cons path entry) entries)
+           (push path retired)
+           (ignore-errors (delete-file (plist-get entry :file))))))
+     (my/citre-index-state-entries state))
+    (dolist (path retired) (remhash path (my/citre-index-state-entries state)))
+    entries))
+
+(defun my/citre-index--live-finished (state directory jobs process _event)
+  "Publish only matching buffer versions from JOBS, then remove DIRECTORY."
+  (when (memq (process-status process) '(exit signal))
+    (my/citre-index--cancel-timer (process-get process 'timeout))
+    (when (eq process (my/citre-index-state-live-process state))
+      (setf (my/citre-index-state-live-process state) nil)
+      (unwind-protect
+          (if (and (eq (process-status process) 'exit) (zerop (process-exit-status process)))
+              (progn
+                (dolist (job jobs)
+                  (let ((buffer (plist-get job :buffer))
+                        (path (plist-get job :source)))
+                    (when (and (buffer-live-p buffer)
+                               (with-current-buffer buffer
+                                 (and (eq my/citre-index--state state)
+                                      (equal path (my/citre-index--path))
+                                      (= (buffer-chars-modified-tick) (plist-get job :tick)))))
+                      (let* ((old (gethash path (my/citre-index-state-entries state)))
+                             (output (make-temp-file (expand-file-name "buffer-" (my/citre-index-state-live-directory state)) nil ".tags")))
+                        (rename-file (plist-get job :output) output t)
+                        (puthash path (list :file output :buffer buffer :tick (plist-get job :tick))
+                                 (my/citre-index-state-entries state))
+                        (when old (ignore-errors (delete-file (plist-get old :file))))
+                        (with-current-buffer buffer (setq my/citre-index--dirty nil))))))
+                (my/citre-index--updated state))
+            ;; Retry on the next edit or explicit rebuild, not in an error loop.
+            (dolist (job jobs)
+              (when (buffer-live-p (plist-get job :buffer))
+                (with-current-buffer (plist-get job :buffer)
+                  (when (= (buffer-chars-modified-tick) (plist-get job :tick))
+                    (setq my/citre-index--dirty nil)))))
+            (my/citre-index--record-error state (format "Live worker exited: %s" (process-exit-status process))))
+        (ignore-errors (delete-directory directory t)))
+      (when (cl-some (lambda (buffer) (buffer-local-value 'my/citre-index--dirty buffer))
+                     (my/citre-index--buffers state))
+        (my/citre-index--schedule-live state)))))
+
+(defun my/citre-index--start-live (state)
+  "Parse dirty buffers of STATE independently of slower dependency checks."
+  (my/citre-index--cancel-timer (my/citre-index-state-live-timer state))
+  (setf (my/citre-index-state-live-timer state) nil)
+  (when (and my/citre-index-mode (not (process-live-p (my/citre-index-state-live-process state))))
+    (let ((directory (make-temp-file (expand-file-name "job-" (my/citre-index-state-live-directory state)) t))
+          jobs request)
+      (condition-case error
+          (progn
+            (dolist (buffer (my/citre-index--buffers state))
+              (with-current-buffer buffer
+                (when my/citre-index--dirty
+                  (if (or (> (buffer-size) my/citre-index-max-buffer-size)
+                          (not (my/citre-index--eligible-p)))
+                      (setq my/citre-index--dirty nil)
+                    (let* ((source (my/citre-index--path))
+                           (snapshot (expand-file-name (concat (number-to-string (length jobs)) "/" (file-name-nondirectory source)) directory))
+                           (output (concat snapshot ".tags"))
+                           (tick (buffer-chars-modified-tick)))
+                      (make-directory (file-name-directory snapshot) t)
+                      (let ((coding-system-for-write (or buffer-file-coding-system 'utf-8-unix)))
+                        (save-restriction
+                          (widen)
+                          (write-region (point-min) (point-max) snapshot nil 'silent)))
+                      (push (list :buffer buffer :source source :output output :tick tick) jobs)
+                      (push (list (cons 'source source) (cons 'snapshot snapshot) (cons 'output output)) request))))))
+            (if (null jobs)
+                (delete-directory directory t)
+              (let ((request-file (expand-file-name "request.json" directory)))
+                (with-temp-file request-file (insert (json-encode (vconcat request))))
+                (let ((process (my/citre-index--spawn
+                                state "citre-live" (append (my/citre-index-state-arguments state) (list "--snapshot-request" request-file))
+                                (lambda (process event) (my/citre-index--live-finished state directory jobs process event)))))
+                  (setf (my/citre-index-state-live-process state) process)
+                  (process-put process 'timeout
+                               (run-at-time 10 nil (lambda () (when (process-live-p process) (delete-process process)))))))))
+        (error
+         (ignore-errors (delete-directory directory t))
+         (my/citre-index--record-error state error))))))
+
+(defun my/citre-index--schedule-live (state)
+  "Debounce live parsing for STATE."
+  (unless (timerp (my/citre-index-state-live-timer state))
+    (setf (my/citre-index-state-live-timer state)
+          (run-with-idle-timer my/citre-index-idle-delay nil #'my/citre-index--start-live state))))
+
+(defun my/citre-index--changed (&rest _)
+  "Mark the current buffer dirty without running a parser inside the change hook."
+  (when my/citre-index--state
+    (setq my/citre-index--dirty t)
+    (my/citre-index--schedule-live my/citre-index--state)))
+
+(defun my/citre-index--saved ()
+  "Refresh disk state after a save or revert."
+  (when my/citre-index--state
+    (my/citre-index--environment my/citre-index--state)
+    (my/citre-index--changed)
+    (my/citre-index-request-refresh my/citre-index--state)))
+
+(defun my/citre-index--renamed ()
+  "Reattach live content when the visited filename or project changes."
+  (my/citre-index--detach)
+  (my/citre-index-attach))
+
+(defun my/citre-index--flush ()
+  "Start a pending live update when leaving Evil insert state."
+  (when (and my/citre-index--state my/citre-index--dirty)
+    (my/citre-index--start-live my/citre-index--state)))
+
+(defun my/citre-index--detach ()
+  "Detach the current buffer and invalidate its live results."
+  (when-let* ((state my/citre-index--state))
+    (setq my/citre-index--state nil my/citre-index--dirty nil)
+    (my/citre-index-live-entries state)
+    (my/citre-index--updated state)
+    (if (my/citre-index--buffers state)
+        (my/citre-index-request-refresh state)
+      (my/citre-index--release state))))
+
+(defun my/citre-index-attach ()
+  "Attach a local programming buffer to its automatic project index."
+  (when my/citre-index-mode
+    (when-let* ((root (my/citre-index--root)))
+      (when my/citre-index--state
+        (my/citre-index--environment my/citre-index--state))
+      (unless (and my/citre-index--state (equal root (my/citre-index-state-root my/citre-index--state)))
+        (my/citre-index--detach)
+        (let ((state (gethash root my/citre-index--projects)))
+          (unless state
+            (let ((cache (expand-file-name (secure-hash 'sha256 root) my/citre-index-cache-directory)))
+              (make-directory cache t)
+              (setq state (my/citre-index--make-state
+                           :root root :cache cache :entries (make-hash-table :test #'equal)
+                           :watches (make-hash-table :test #'equal)
+                           :live-directory (make-temp-file (expand-file-name "live-" cache) t)))
+              (puthash root state my/citre-index--projects)))
+          (setq my/citre-index--state state)
+          (my/citre-index--environment state)
+          (add-hook 'after-change-functions #'my/citre-index--changed nil t)
+          (add-hook 'after-save-hook #'my/citre-index--saved nil t)
+          (add-hook 'after-revert-hook #'my/citre-index--saved nil t)
+          (add-hook 'after-set-visited-file-name-hook #'my/citre-index--renamed nil t)
+          (add-hook 'kill-buffer-hook #'my/citre-index--detach nil t)
+          (add-hook 'change-major-mode-hook #'my/citre-index--detach nil t)
+          (add-hook 'evil-insert-state-exit-hook #'my/citre-index--flush nil t)
+          (when (fboundp 'citre-mode) (citre-mode 1))
+          (my/citre-index--changed)
+          (my/citre-index-request-refresh state))))))
+
+(defun my/citre-index--check ()
+  "Check active projects and refresh environments after direnv or project switches."
+  (when my/citre-index-mode
+    (maphash
+     (lambda (_root state)
+       (when-let* ((buffers (my/citre-index--buffers state)))
+         (with-current-buffer (if (memq (current-buffer) buffers) (current-buffer) (car buffers))
+           (my/citre-index--environment state))
+         (my/citre-index-request-refresh state)))
+     my/citre-index--projects)))
+
+(defun my/citre-index--focus ()
+  "Check project files when Emacs regains focus."
+  (when (frame-focus-state) (my/citre-index--check)))
+
+(defun my/project-ctags-setup ()
+  "Force a complete asynchronous rebuild of this project's disk and live indexes."
+  (interactive)
+  (my/citre-index-attach)
+  (unless my/citre-index--state (user-error "No local programming project in this buffer"))
+  (dolist (buffer (my/citre-index--buffers my/citre-index--state))
+    (with-current-buffer buffer (my/citre-index--changed)))
+  (my/citre-index-request-refresh my/citre-index--state t)
+  (message "Citre rebuild scheduled"))
+
+(defun my/citre-index-status ()
+  "Show index state and offer the log without opening it during ordinary editing."
+  (interactive)
+  (unless my/citre-index--state (user-error "No automatic Citre index in this buffer"))
+  (let ((state my/citre-index--state))
+    (with-help-window "*Citre index status*"
+      (princ (format "Project: %s\nCache: %s\nLive buffers: %d\nDisk worker: %s\nLive worker: %s\nLast check: %s\nLast error: %s\nLog: %s\n"
+                     (my/citre-index-state-root state) (my/citre-index-state-cache state)
+                     (length (my/citre-index-live-entries state))
+                     (if (process-live-p (my/citre-index-state-disk-process state)) "running" "idle")
+                     (if (process-live-p (my/citre-index-state-live-process state)) "running" "idle")
+                     (if (my/citre-index-state-checked state) (format-time-string "%F %T" (my/citre-index-state-checked state)) "pending")
+                     (or (my/citre-index-state-error state) "none")
+                     (buffer-name (my/citre-index--log state)))))))
+
+(defun my/citre-index--release (state)
+  "Release workers and watches belonging to STATE and remove its session snapshots."
+  (my/citre-index--cancel-timer (my/citre-index-state-disk-timer state))
+  (my/citre-index--cancel-timer (my/citre-index-state-live-timer state))
+  (dolist (process (list (my/citre-index-state-disk-process state) (my/citre-index-state-live-process state)))
+    (when (processp process)
+      (my/citre-index--cancel-timer (process-get process 'timeout))
+      (set-process-sentinel process #'ignore)
+      (when (process-live-p process) (delete-process process))))
+  (maphash (lambda (_directory descriptor) (ignore-errors (file-notify-rm-watch descriptor)))
+           (my/citre-index-state-watches state))
+  (ignore-errors (delete-directory (my/citre-index-state-live-directory state) t))
+  (remhash (my/citre-index-state-root state) my/citre-index--projects))
+
+(defun my/citre-index--stop ()
+  "Stop workers and watches and remove only this session's live snapshots."
+  (my/citre-index--cancel-timer my/citre-index--timer)
+  (setq my/citre-index--timer nil)
+  (maphash (lambda (_root state) (my/citre-index--release state)) my/citre-index--projects)
+  (clrhash my/citre-index--projects)
+  (dolist (buffer (buffer-list))
+    (with-current-buffer buffer
+      (when my/citre-index--state
+        (setq my/citre-index--state nil my/citre-index--dirty nil)
+        (remove-hook 'after-change-functions #'my/citre-index--changed t)
+        (remove-hook 'after-save-hook #'my/citre-index--saved t)
+        (remove-hook 'after-revert-hook #'my/citre-index--saved t)
+        (remove-hook 'after-set-visited-file-name-hook #'my/citre-index--renamed t)
+        (remove-hook 'kill-buffer-hook #'my/citre-index--detach t)
+        (remove-hook 'change-major-mode-hook #'my/citre-index--detach t)
+        (remove-hook 'evil-insert-state-exit-hook #'my/citre-index--flush t)))))
+
+(define-minor-mode my/citre-index-mode
+  "Maintain project tags and unsaved-buffer tags automatically."
+  :global t :group 'my/citre
+  (if my/citre-index-mode
+      (progn
+        (add-hook 'find-file-hook #'my/citre-index-attach)
+        (add-hook 'after-change-major-mode-hook #'my/citre-index-attach)
+        (add-hook 'magit-post-refresh-hook #'my/citre-index--check)
+        (add-hook 'kill-emacs-hook #'my/citre-index--stop)
+        (add-function :after after-focus-change-function #'my/citre-index--focus)
+        (my/citre-index--cancel-timer my/citre-index--timer)
+        (setq my/citre-index--timer (run-at-time my/citre-index-check-interval my/citre-index-check-interval #'my/citre-index--check))
+        (dolist (buffer (buffer-list)) (with-current-buffer buffer (my/citre-index-attach))))
+    (remove-hook 'find-file-hook #'my/citre-index-attach)
+    (remove-hook 'after-change-major-mode-hook #'my/citre-index-attach)
+    (remove-hook 'magit-post-refresh-hook #'my/citre-index--check)
+    (remove-hook 'kill-emacs-hook #'my/citre-index--stop)
+    (remove-function after-focus-change-function #'my/citre-index--focus)
+    (my/citre-index--stop)))
+
+(provide 'citre-index)
+;;; citre-index.el ends here
diff --git a/lisp/my-header-line.el b/lisp/my-header-line.el
index 0b0bc75..3d52f2c 100644
--- a/lisp/my-header-line.el
+++ b/lisp/my-header-line.el
@@ -2,6 +2,17 @@
 
 (require 'mode-line-maker)
 
+(defcustom my/header-line-height 35
+  "Minimum graphical header-line height, before image scaling.
+Matches the default height of Dirvish's full-frame header line."
+  :type 'natnum
+  :group 'mode-line)
+
+(defcustom my/header-line-show-major-mode nil
+  "Whether to show the major mode next to the clock in the header line."
+  :type 'boolean
+  :group 'mode-line)
+
 (defface my/header-line-evil-normal
   '((t (:inherit font-lock-keyword-face :weight bold)))
   "Face for the evil normal state indicator.")
@@ -35,16 +46,16 @@
   "Face for the IRC activity indicator.")
 
 (defface my/header-line-clatter-face
-  '((t (:inherit font-lock-builtin-face :weight bold)))
-  "Face for the Clatter joined-channel indicator.")
+  '((t (:inherit success :weight bold)))
+  "Theme success color for Clatter's connected-channel indicator.")
 
 (defface my/header-line-mu4e-face
-  '((t (:inherit warning :weight bold)))
-  "Face for the unread mail indicator.")
+  '((t (:inherit font-lock-type-face :weight bold)))
+  "Theme type accent for the unread mail indicator.")
 
 (defface my/header-line-time-face
-  '((t (:inherit font-lock-constant-face)))
-  "Face for the time segment.")
+  '((t (:inherit mode-line-buffer-id :weight normal)))
+  "Theme buffer-name accent for the clock, in regular weight.")
 
 (defface my/header-line-state-saved-face
   '((t (:inherit success)))
@@ -58,6 +69,30 @@
   '((t (:inherit error)))
   "Face for the read-only buffer state icon.")
 
+(defface my/header-line-position-face
+  '((t (:inherit shadow :weight normal :slant normal)))
+  "Quiet face for the scroll percentage and cursor position.")
+
+(defface my/header-line-workspace-active-face
+  '((t (:inherit my/header-line-position-face :inverse-video nil :box nil)))
+  "Current workspace, styled like the percentage and cursor position.")
+
+(defface my/header-line-workspace-inactive-face
+  '((t (:inherit shadow :weight normal :slant normal)))
+  "Quiet numbers for other open workspaces.")
+
+(defvar my/header-line-workspaces-expanded nil
+  "Whether the header line also shows the other open workspaces.")
+
+(defconst my/header-line-position
+  '(" "
+    (:propertize "%p" face my/header-line-position-face
+                 help-echo "Window scroll position")
+    " "
+    (:propertize "%l:%c" face my/header-line-position-face
+                 help-echo "Line : column (columns start at 0)"))
+  "Compact scroll percentage and line:column display.")
+
 (defvar-local my/header-line--buffer-title nil)
 
 (defconst my/header-line--missing (make-symbol "missing")
@@ -217,6 +252,56 @@ of a literal dash."
       (propertize (if icon (concat icon " " time) time)
                   'face 'my/header-line-time-face))))
 
+(defun my/toggle-header-line-workspaces ()
+  "Toggle between the current workspace and all open workspace names."
+  (interactive)
+  (setq my/header-line-workspaces-expanded
+        (not my/header-line-workspaces-expanded))
+  (force-mode-line-update t))
+
+(defun my/header-line--workspace-number (index)
+  "Return an outlined Nerd Icon for workspace INDEX, with a text fallback."
+  (let ((fallback (format "[%d]" index)))
+    (if (<= 1 index 10)
+        (my/header-line--icon
+         (format "nf-md-numeric_%d_box_outline" index)
+         'my/header-line-position-face fallback)
+      fallback)))
+
+(defun my/header-line-workspaces ()
+  "Show the current workspace or all workspaces, each with its number icon."
+  (when (and (bound-and-true-p persp-mode)
+             (fboundp 'my/workspace-current-name)
+             (fboundp 'my/workspace-names))
+    (let ((current (my/workspace-current-name))
+          (names (my/workspace-names))
+          (index 0))
+      (when (member current names)
+        (string-join
+         (delq nil
+               (mapcar
+                (lambda (name)
+                  ;; Keep the same numbering as workspace switching.
+                  (setq index (1+ index))
+                  (let ((active (equal name current)))
+                    (when (or active my/header-line-workspaces-expanded)
+                      (propertize
+                       ;; The maker expands this before the final header.
+                       (string-replace
+                        "%" "%%"
+                        (concat (my/header-line--workspace-number index)
+                                " " name))
+                       'face (if active 'my/header-line-workspace-active-face
+                               'my/header-line-workspace-inactive-face)
+                       'help-echo
+                       (format "%d: %s — t: toggle workspaces" index name)))))
+                names))
+         " ")))))
+
+(defun my/header-line--refresh-workspaces (&rest _args)
+  "Refresh all headers after workspace changes."
+  (force-mode-line-update t))
+
 (defun my/header-line-sync-theme (&optional _theme)
   "Make helper padding inherit the live header-line theme face.
 Optional THEME is ignored so this function also fits
@@ -231,6 +316,18 @@ Optional THEME is ignored so this function also fits
                       :inverse-video nil
                       :strike-through nil))
 
+(defun my/header-line--height-spacer ()
+  "Return a transparent height spacer, using the same approach as Dirvish."
+  (when (and (display-graphic-p)
+             (image-type-available-p 'pbm)
+             (> my/header-line-height 0))
+    (propertize
+     " " 'display
+     (create-image
+      (concat (format "P1\n1 %d\n" my/header-line-height)
+              (make-string my/header-line-height ?0) "\n")
+      'pbm t :foreground "None" :ascent 'center))))
+
 (define-minor-mode my/global-header-line-mode
   "Show the custom header line globally.
 
@@ -248,34 +345,49 @@ headings, remain visible."
   (interactive)
   (my/global-header-line-mode (if my/global-header-line-mode -1 1)))
 
+(defun my/header-line--make (left right)
+  "Build a header from LEFT and RIGHT, preserving literal percent signs."
+  ;; The maker has already expanded %p, %l, etc.  Escape its result before
+  ;; redisplay interprets it again, including percent signs in buffer names.
+  (let ((format (mode-line-maker left right)))
+    `(:eval (string-replace "%" "%%"
+                            (apply #'concat ,(cadr format))))))
+
 (defun my/header-line-install ()
   "Install the custom header line built with mode-line-maker."
   (setq global-mode-string (delq 'display-time-string global-mode-string))
   (my/header-line-sync-theme)
   (add-hook 'enable-theme-functions #'my/header-line-sync-theme)
   (setq my/header-line--format
-        (mode-line-maker
-         '((:eval (my/header-line-evil-state)) " "
-           (:eval (my/header-line-buffer-state))
-           (:eval (my/header-line-remote)) " "
-           (:eval (my/header-line-buffer-icon)) " "
-           (:eval (propertize (my/header-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/header-line-irc)) " "
-           (:eval (my/header-line-clatter)) " "
-           (:eval (my/header-line-mu4e)) " "
-           mode-line-process " "
-           (:eval (my/header-line-time)) " "
-           mode-name " ")))
+        (list
+         '(:eval (my/header-line--height-spacer))
+         (my/header-line--make
+          '((:eval (my/header-line-evil-state)) " "
+            (:eval (my/header-line-buffer-state))
+            (:eval (my/header-line-remote)) " "
+            (:eval (my/header-line-buffer-icon)) " "
+            (:eval (propertize (my/header-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))
+            my/header-line-position)
+          '("" (:eval (my/header-line-irc)) " "
+            (:eval (my/header-line-clatter)) " "
+            (:eval (my/header-line-mu4e)) " "
+            mode-line-process " "
+            (:eval (my/header-line-time)) " "
+            (my/header-line-show-major-mode ("" mode-name " "))
+            (:eval (my/header-line-workspaces)) " "))))
   ;; The header line is visible on every startup, regardless of its previous
   ;; interactive state in a long-running session.
   (my/global-header-line-mode 1)
-  (add-hook 'before-save-hook #'my/header-line--invalidate-title-cache))
+  (add-hook 'before-save-hook #'my/header-line--invalidate-title-cache)
+  (with-eval-after-load 'persp-mode
+    (add-hook 'persp-activated-functions #'my/header-line--refresh-workspaces)
+    (add-hook 'persp-names-cache-changed-functions
+              #'my/header-line--refresh-workspaces)))
 
 (provide 'my-header-line)
 ;;; my-header-line.el ends here
diff --git a/lisp/my-quick-access.el b/lisp/my-quick-access.el
new file mode 100644
index 0000000..ae1d538
--- /dev/null
+++ b/lisp/my-quick-access.el
@@ -0,0 +1,419 @@
+;;; my-quick-access.el --- Workspace bookmarks and recent buffers -*- lexical-binding: t; -*-
+
+(require 'cl-lib)
+(require 'subr-x)
+(require 'seq)
+(require 'bookmark)
+(require 'persp-mode)
+
+(defgroup my/quick-access nil
+  "Quick access to workspace bookmarks and buffers."
+  :group 'convenience)
+
+(defcustom my/quick-access-recent-count 5
+  "Maximum number of recently visited buffers shown in the popup."
+  :type 'natnum :group 'my/quick-access)
+
+(defface my/quick-access-title
+  '((t (:inherit mode-line-buffer-id :weight normal)))
+  "Theme accent for popup titles and selection keys."
+  :group 'my/quick-access)
+
+(defcustom my/quick-access-selection-keys '("f" "j" "d" "k" "g" "h")
+  "Distinct single-letter keys for recent buffers and ambiguous initials; use at least two."
+  :type '(repeat string) :group 'my/quick-access)
+
+(defcustom my/quick-access-max-height 0.48
+  "Maximum popup height as a fraction of the frame height."
+  :type '(float :tag "Frame height fraction") :group 'my/quick-access)
+
+(defcustom my/quick-access-page-size 6
+  "Maximum entries per page; small frames show fewer to keep the footer visible."
+  :type 'natnum :group 'my/quick-access)
+(defconst my/quick-access--buffer-name " *Workspace Quick Access*")
+(defvar my/quick-access--history (make-hash-table :test #'eq :weakness 'key))
+(defvar my/quick-access--hidden (make-hash-table :test #'eq :weakness 'key)
+  "Buffers hidden from quick access per workspace during this session.")
+(defvar my/quick-access--last-visit nil)
+(defvar my/quick-access--active nil)
+
+(defun my/quick-access--eligible-p (buffer)
+  "Whether BUFFER is a live, user-visible buffer."
+  (and (buffer-live-p buffer)
+       (not (minibufferp buffer))
+       (not (string-prefix-p " " (buffer-name buffer)))))
+
+(defun my/quick-access--track ()
+  "Remember visits independently for each workspace."
+  (when (and (bound-and-true-p persp-mode)
+             (not my/quick-access--active)
+             (not (active-minibuffer-window)))
+    (let* ((persp (get-current-persp))
+           (buffer (window-buffer (selected-window)))
+           (visit (cons persp buffer)))
+      (unless (and (eq persp (car my/quick-access--last-visit))
+                   (eq buffer (cdr my/quick-access--last-visit)))
+        (setq my/quick-access--last-visit visit)
+        (when (and (my/quick-access--eligible-p buffer)
+                   (memq buffer (safe-persp-buffers persp)))
+          (puthash persp
+                   (cons buffer
+                         (cl-remove-if
+                          (lambda (old) (or (eq old buffer)
+                                            (not (buffer-live-p old))))
+                          (gethash persp my/quick-access--history)))
+                   my/quick-access--history))))))
+
+(defun my/quick-access--buffers (persp current)
+  "Return live buffers of PERSP in visit order, excluding CURRENT.
+The frame's buffer order seeds history for buffers not visited since loading."
+  (let ((members (safe-persp-buffers persp))
+        (hidden (cl-remove-if-not #'buffer-live-p
+                                  (gethash persp my/quick-access--hidden))))
+    (puthash persp hidden my/quick-access--hidden)
+    (cl-remove-if-not
+     (lambda (buffer)
+       (and (not (eq buffer current))
+            (not (memq buffer hidden))
+            (my/quick-access--eligible-p buffer)
+            (memq buffer members)))
+     (delete-dups (append (gethash persp my/quick-access--history)
+                         (buffer-list (selected-frame)))))))
+
+(defun my/quick-access--scope-record (args)
+  "Tag stored bookmark ARGS before the bookmark library saves them.
+Existing assignments are retained when a shared bookmark is updated."
+  (if (not (bound-and-true-p persp-mode)) args
+    (pcase-let ((`(,name ,record ,no-overwrite) args))
+      (bookmark-maybe-load-default-file)
+      (let* ((old (and (not no-overwrite) (assoc name bookmark-alist)))
+             (scopes (delete-dups
+                      (cons (safe-persp-name (get-current-persp))
+                            (append (alist-get 'my/quick-access-workspaces record)
+                                    (and old (bookmark-prop-get
+                                              old 'my/quick-access-workspaces)))))))
+        (list name
+              (cons (cons 'my/quick-access-workspaces scopes)
+                    (assq-delete-all 'my/quick-access-workspaces
+                                     (copy-tree record)))
+              no-overwrite)))))
+
+(defun my/quick-access--renamed (original new-name &rest args)
+  "Keep bookmark assignments when ORIGINAL renames a workspace to NEW-NAME."
+  (bookmark-maybe-load-default-file)
+  (let ((old-name (apply original new-name args)) changed)
+    (when old-name
+      (dolist (record bookmark-alist)
+        (let ((scopes (bookmark-prop-get record 'my/quick-access-workspaces)))
+          (when (member old-name scopes)
+            (bookmark-prop-set
+             record 'my/quick-access-workspaces
+             (delete-dups (cons new-name (remove old-name scopes))))
+            (setq changed t))))
+      (when changed
+        (cl-incf bookmark-alist-modification-count)
+        (bookmark-save)))
+    old-name))
+
+(defun my/quick-access--bookmarks (workspace)
+  "Return bookmark records explicitly assigned to WORKSPACE."
+  (bookmark-maybe-load-default-file)
+  (cl-remove-if-not
+   (lambda (record)
+     (member workspace (bookmark-prop-get record 'my/quick-access-workspaces)))
+   (copy-sequence bookmark-alist)))
+
+(defun my/quick-access--add-bookmark (workspace)
+  "Assign an existing bookmark to WORKSPACE without moving or copying it."
+  (bookmark-maybe-load-default-file)
+  (unless bookmark-alist (user-error "No existing bookmarks; use C-s to save one"))
+  (let* ((name (completing-read "Add bookmark to workspace: "
+                                (bookmark-all-names) nil t))
+         (record (bookmark-get-bookmark name))
+         (scopes (bookmark-prop-get record 'my/quick-access-workspaces)))
+    (unless (member workspace scopes)
+      (bookmark-prop-set record 'my/quick-access-workspaces (cons workspace scopes))
+      (cl-incf bookmark-alist-modification-count)
+      (bookmark-save))))
+
+(defun my/quick-access--remove (item persp workspace)
+  "Remove ITEM from quick access in PERSP, named WORKSPACE.
+Buffers remain live and workspace members; bookmarks retain other assignments."
+  (if (bufferp item)
+      (when (buffer-live-p item)
+        (puthash persp
+                 (cons item (delq item (cl-remove-if-not
+                                        #'buffer-live-p
+                                        (gethash persp my/quick-access--hidden))))
+                 my/quick-access--hidden))
+    (let ((scopes (bookmark-prop-get item 'my/quick-access-workspaces)))
+      (when (member workspace scopes)
+        (bookmark-prop-set item 'my/quick-access-workspaces (remove workspace scopes))
+        (cl-incf bookmark-alist-modification-count)
+        (bookmark-save)))))
+
+(defun my/quick-access-restore-buffers ()
+  "Restore all buffers hidden from quick access in the current workspace."
+  (interactive)
+  (remhash (get-current-persp) my/quick-access--hidden)
+  (message "Hidden buffers restored for %s" (safe-persp-name (get-current-persp))))
+
+(defun my/quick-access--label (item)
+  "Return the display name of bookmark or buffer ITEM."
+  (if (bufferp item) (buffer-name item) (car item)))
+
+(defun my/quick-access--detail (item)
+  "Return a compact target description without accessing the filesystem."
+  (let ((file (if (bufferp item)
+                  (buffer-local-value 'buffer-file-name item)
+                (bookmark-get-filename item))))
+    (if (and (stringp file) (not (equal file "")))
+        (abbreviate-file-name file)
+      (if (bufferp item)
+          (with-current-buffer item
+            (abbreviate-file-name default-directory))
+        (or (bookmark-prop-get item 'buffer-name) "")))))
+
+(defun my/quick-access--initial (item)
+  "Return ITEM's first letter, ignoring punctuation and leading stars."
+  (let ((name (my/quick-access--label item)))
+    (if (string-match "[[:alnum:]]" name)
+        (downcase (match-string 0 name))
+      "?")))
+
+(defun my/quick-access--codes (count)
+  "Return COUNT prefix-free labels made from comfortable letter keys."
+  (unless (and (>= (length my/quick-access-selection-keys) 2)
+               (cl-every (lambda (key) (and (stringp key) (string-match-p "\\`[a-z]\\'" key))) my/quick-access-selection-keys)
+               (= (length my/quick-access-selection-keys) (length (delete-dups (copy-sequence my/quick-access-selection-keys)))))
+    (user-error "Selection keys must contain at least two distinct lowercase letters"))
+  (let ((codes (copy-sequence my/quick-access-selection-keys)))
+    (while (< (length codes) count)
+      (let* ((shortest (apply #'min (mapcar #'length codes)))
+             (index (cl-position shortest codes :key #'length :from-end t))
+             (prefix (nth index codes)))
+        (setq codes
+              (append (cl-subseq codes 0 index)
+                      (mapcar (lambda (key) (concat prefix key)) my/quick-access-selection-keys)
+                      (nthcdr (1+ index) codes)))))
+    (cl-subseq codes 0 count)))
+
+(defun my/quick-access--entries (items home prefix)
+  "Label ITEMS using HOME keys or initials; filter HOME labels by PREFIX."
+  (let ((codes (and home (my/quick-access--codes (length items)))))
+    (cl-loop for item in items for index from 0
+             for code = (if home (nth index codes) (my/quick-access--initial item))
+             when (or (not home) (string-prefix-p prefix code))
+             collect (cons code item))))
+
+(defun my/quick-access--clean-text (text)
+  "Keep TEXT on one display line and remove embedded text properties."
+  (replace-regexp-in-string "[\n\r\t]" " " (substring-no-properties text)))
+
+(defun my/quick-access--render (buffer window workspace source entries page size prefix group &optional removing)
+  "Draw ENTRIES in BUFFER and WINDOW, indicating REMOVING when active."
+  (let* ((pages (max 1 (ceiling (length entries) size)))
+         (page (min page (1- pages)))
+         (visible (seq-subseq entries (min (* page size) (length entries))
+                             (min (* (1+ page) size) (length entries)))))
+    (with-current-buffer buffer
+      (let ((inhibit-read-only t)
+            (width (max 20 (- (window-body-width window) 4))))
+        (erase-buffer)
+        (insert "  " (propertize
+                        (if removing
+                            (if (eq source 'bookmarks) "Remove bookmark" "Hide recent buffer")
+                          (if (eq source 'bookmarks) "Bookmarks" "Recent buffers"))
+                        'face 'my/quick-access-title)
+                "  " (propertize (my/quick-access--clean-text workspace) 'face 'shadow))
+        (when group (insert (format "  / %s%s" group prefix)))
+        (when (> pages 1) (insert (propertize (format "  (%d/%d)" (1+ page) pages)
+                                            'face 'shadow)))
+        (insert "\n\n")
+        (if (null entries)
+            (insert "  " (propertize
+                           (if (eq source 'bookmarks)
+                               "No bookmarks yet. C-s: save current location; C-i: add existing."
+                             "No other recent buffers in this workspace.")
+                           'face 'shadow) "\n")
+          (dolist (entry visible)
+            (let* ((item (cdr entry))
+                   (key (substring (car entry) (length prefix)))
+                   (start (point)))
+              (insert "  " (propertize (format "%-3s" key) 'face 'my/quick-access-title)
+                      (truncate-string-to-width
+                       (my/quick-access--clean-text (my/quick-access--label item))
+                       (- width 3) nil nil "…") "\n"
+                      "     " (propertize
+                               (truncate-string-to-width
+                                (my/quick-access--clean-text (my/quick-access--detail item))
+                                (- width 3) nil nil "…")
+                               'face 'shadow) "\n")
+              (add-text-properties start (point)
+                                   `(my/quick-access-item ,item mouse-face highlight)))))
+        (insert "\n  " (propertize
+                         (concat (if (eq source 'bookmarks) "SPC Recent buffers" "SPC Bookmarks")
+                                 (if removing "   C-d Cancel removal" "   C-d Remove")
+                                 "   C-f Search   Esc Close") 'face 'shadow)
+                "\n  " (propertize
+                           (concat "C-s Save bookmark   C-i Add existing"
+                                   (when group "   Backspace Back")
+                                   (when (> pages 1) "   C-j/C-k Page"))
+                           'face 'shadow) "\n")
+        (goto-char (point-min))))
+    (set-window-start window 1)
+    (fit-window-to-buffer window (max 6 (floor (* my/quick-access-max-height (frame-height)))) 5)
+    page))
+
+(defun my/quick-access--search (items &optional prompt)
+  "Read an ITEM through the user's existing completion interface."
+  (unless items (user-error "No entries in this workspace"))
+  (let* ((table (cl-loop for item in items for index from 1
+                         collect (cons (format "%s  —  %s  <%d>"
+                                               (my/quick-access--label item)
+                                               (my/quick-access--detail item) index)
+                                       item)))
+         (choice (completing-read (or prompt "Open: ") table nil t)))
+    (cdr (assoc choice table))))
+
+;;;###autoload
+(defun my/quick-access ()
+  "Open workspace bookmarks; SPC toggles recent buffers.
+
+Select bookmarks by initial and resolve collisions with `my/quick-access-selection-keys'; recent buffers use those keys directly. C-f searches the current source, including all eligible workspace buffers from the recent view. C-s saves the original location; C-i assigns an existing bookmark.
+
+C-d toggles removal: select an entry to unassign its bookmark or hide its buffer in this workspace. The popup stays open after removal. Hidden buffers stay hidden for this session; `my/quick-access-restore-buffers' restores them. Escape or C-g closes the popup and restores the original window."
+  (interactive)
+  (when (or my/quick-access--active (active-minibuffer-window))
+    (user-error "Finish the current selection first"))
+  (let* ((persp (get-current-persp))
+         (workspace (safe-persp-name persp))
+         (origin (selected-window))
+         (current (current-buffer))
+         (buffers (my/quick-access--buffers persp current))
+         (bookmarks (my/quick-access--bookmarks workspace))
+         (my/quick-access--active t)
+         (source 'bookmarks) group (prefix "") (page 0) removing
+         (size (max 1 (min my/quick-access-page-size (/ (- (floor (* my/quick-access-max-height (frame-height))) 7) 2))))
+         popup window selected
+         (pick (lambda (item)
+                 (when item
+                   (if removing
+                       (progn
+                         (my/quick-access--remove item persp workspace)
+                         (if (bufferp item)
+                             (setq buffers (delq item buffers))
+                           (setq bookmarks (delq item bookmarks)))
+                         (setq removing nil group nil prefix "" page 0))
+                     (throw 'my/quick-access-done item))))))
+    (unwind-protect
+        (progn
+          (let ((persp-add-buffer-on-after-change-major-mode nil))
+            (setq popup (generate-new-buffer my/quick-access--buffer-name))
+            (with-current-buffer popup
+              (special-mode)
+              (setq-local header-line-format nil mode-line-format nil
+                          display-line-numbers nil cursor-type nil
+                          truncate-lines t show-trailing-whitespace nil)))
+          (setq window
+                (display-buffer-in-side-window
+                 popup `((side . bottom) (slot . 10)
+                         (window-height . ,my/quick-access-max-height)
+                         (window-parameters . ((no-other-window . t)
+                                               (no-delete-other-windows . t))))))
+          (unless (window-live-p window) (user-error "Cannot display quick access"))
+          (setq selected
+                (catch 'my/quick-access-done
+                  (while (and (window-live-p window) (window-live-p origin))
+                    (let* ((items (if (eq source 'bookmarks)
+                                      (if group
+                                          (cl-remove-if-not
+                                           (lambda (item) (equal group (my/quick-access--initial item)))
+                                           bookmarks)
+                                        bookmarks)
+                                    (seq-take buffers my/quick-access-recent-count)))
+                           (home (or group (eq source 'buffers)))
+                           (entries (my/quick-access--entries items home prefix)))
+                      (setq page (my/quick-access--render
+                                  popup window workspace source entries page size prefix group removing))
+                      (let ((event (read-key)))
+                        (cond
+                         ((memq event '(27 escape ?\C-g)) (throw 'my/quick-access-done nil))
+                         ((eq event ?\C-d) (setq removing (not removing)))
+                         ((eq event ?\s)
+                          (setq source (if (eq source 'bookmarks) 'buffers 'bookmarks)
+                                group nil prefix "" page 0 removing nil))
+                         ((eq event ?\M-b)
+                          (setq source 'bookmarks group nil prefix "" page 0 removing nil))
+                         ((memq event '(backspace 127))
+                          (if (string-empty-p prefix) (setq group nil)
+                            (setq prefix (substring prefix 0 -1)))
+                          (setq page 0))
+                         ((memq event '(?\C-j ?\C-k))
+                          (setq page (mod (+ page (if (eq event ?\C-j) 1 -1))
+                                          (max 1 (ceiling (length entries) size)))))
+                         ((memq event '(?\C-f ?/))
+                          (condition-case err
+                              (funcall pick
+                                       (my/quick-access--search
+                                        (if (eq source 'bookmarks) bookmarks buffers)
+                                        (when removing "Remove from quick access: ")))
+                            (quit nil) (user-error (message "%s" (cadr err)))))
+                         ((memq event '(?\C-s ?\C-i tab))
+                          (condition-case err
+                              (progn
+                                (with-selected-window origin
+                                  (if (eq event ?\C-s)
+                                      (call-interactively #'bookmark-set)
+                                    (my/quick-access--add-bookmark workspace)))
+                                (setq bookmarks (my/quick-access--bookmarks workspace)
+                                      source 'bookmarks group nil prefix "" page 0 removing nil))
+                            (quit nil) (user-error (message "%s" (cadr err)))))
+                         ((and (consp event) (eq (car event) 'mouse-1))
+                          (let ((pos (event-start event)))
+                            (when (eq (posn-window pos) window)
+                              (when-let* ((point (posn-point pos))
+                                          ((integerp point))
+                                          (item (get-text-property point 'my/quick-access-item popup)))
+                                (funcall pick item)))))
+                         ((and (characterp event) (>= event 32))
+                          (let* ((key (downcase (char-to-string event)))
+                                 (code (concat prefix key))
+                                 (matches (cl-remove-if-not
+                                           (lambda (entry)
+                                             (if home (string-prefix-p code (car entry))
+                                               (equal key (car entry)))) entries)))
+                            (cond
+                             ((and home (assoc code matches))
+                              (funcall pick (cdr (assoc code matches))))
+                             ((and (not home) (= 1 (length matches)))
+                              (funcall pick (cdar matches)))
+                             (matches
+                              (if home (setq prefix code) (setq group key))
+                              (setq page 0))))))))))))
+      (when (and (window-live-p window) (eq (window-buffer window) popup))
+        (delete-window window))
+      (when (buffer-live-p popup) (kill-buffer popup))
+      (when (window-live-p origin) (select-window origin)))
+    (when selected
+      (if (bufferp selected)
+          (if (buffer-live-p selected) (switch-to-buffer selected)
+            (user-error "That buffer has been closed"))
+        (bookmark-jump selected))
+      (when (bound-and-true-p persp-mode)
+        (persp-add-buffer (current-buffer) persp nil nil)))))
+
+(define-minor-mode my/quick-access-mode
+  "Track workspace buffer visits and assign newly saved bookmarks to their workspace."
+  :global t :group 'my/quick-access
+  (if my/quick-access-mode
+      (progn
+        (add-hook 'post-command-hook #'my/quick-access--track)
+        (advice-add 'bookmark-store :filter-args #'my/quick-access--scope-record)
+        (advice-add 'persp-rename :around #'my/quick-access--renamed))
+    (remove-hook 'post-command-hook #'my/quick-access--track)
+    (advice-remove 'bookmark-store #'my/quick-access--scope-record)
+    (advice-remove 'persp-rename #'my/quick-access--renamed)))
+
+(provide 'my-quick-access)
+;;; my-quick-access.el ends here