relic: 2026-09-23T00:10:38+02:00

1 files changed, 71 insertions, 9 deletions

diff --git a/lisp/citre-index.el b/lisp/citre-index.el
index 99dda7b..6764648 100644
--- a/lisp/citre-index.el
+++ b/lisp/citre-index.el
@@ -25,6 +25,11 @@
   "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-roots
+  '("/nix/store/" "/gnu/store/" "~/go/pkg/mod/" "~/.cargo/registry/")
+  "Directories whose contents never become a project of their own.
+Symbols from an immutable dependency store reach completion through the
+dependency index of the project that uses them." :type '(repeat directory) :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)
@@ -36,7 +41,12 @@
 (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))
+  entries watches live-directory retired error checked (revision 0))
+
+(defvar my/citre-index--snapshot-grace 5
+  "Seconds a superseded live snapshot stays on disk before it is deleted.
+A query that already collected a snapshot path keeps `readtags' able to
+open it until it has finished.")
 
 (defvar my/citre-index--projects (make-hash-table :test #'equal))
 (defvar my/citre-index--timer nil)
@@ -57,14 +67,23 @@
        (not (cl-intersection (split-string buffer-file-name "/" t)
                              my/citre-index-excluded-directories :test #'equal))))
 
+(defun my/citre-index--excluded-root-p (root)
+  "Whether ROOT lies inside `my/citre-index-excluded-roots'."
+  (cl-some (lambda (directory)
+             (string-prefix-p (file-name-as-directory
+                               (file-truename (expand-file-name directory)))
+                              root))
+           my/citre-index-excluded-roots))
+
 (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)))))
+                           (project-root project))))
+                (root (file-name-as-directory (file-truename root))))
+      (unless (my/citre-index--excluded-root-p root) root))))
 
 (defun my/citre-index--buffers (state)
   "Return living buffers attached to STATE."
@@ -89,6 +108,21 @@
         (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--retire-file (state file)
+  "Schedule FILE of STATE for deletion once in-flight readers have finished."
+  (when file
+    (push (cons (current-time) file) (my/citre-index-state-retired state))))
+
+(defun my/citre-index--collect-retired (state)
+  "Delete retired snapshots of STATE that no in-flight query can still open."
+  (setf (my/citre-index-state-retired state)
+        (cl-remove-if (lambda (entry)
+                        (when (time-less-p (time-add (car entry) my/citre-index--snapshot-grace)
+                                           (current-time))
+                          (ignore-errors (delete-file (cdr entry)))
+                          t))
+                      (my/citre-index-state-retired state))))
+
 (defun my/citre-index--cancel-timer (timer)
   "Cancel TIMER if it exists."
   (when (timerp timer) (cancel-timer timer)))
@@ -167,7 +201,7 @@
           (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-state-checked state) (process-get process 'started))
                 (my/citre-index--watch state (alist-get 'directories manifest))
                 (when (process-get process 'changed)
                   (my/citre-index--updated state)))
@@ -179,6 +213,7 @@
 (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)
+  (my/citre-index--collect-retired state)
   (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)
@@ -196,6 +231,7 @@
             (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 'started (current-time))
             (process-put process 'timeout
                          (run-at-time my/citre-index-process-timeout nil
                                       (lambda () (when (process-live-p process) (delete-process process))))))
@@ -210,6 +246,15 @@
       (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--snapshot-needed-p (state entry buffer)
+  "Whether ENTRY still holds content the disk index of STATE does not have.
+A snapshot of an unmodified buffer is superseded once a disk check that
+started after it has published its result."
+  (or (buffer-modified-p buffer)
+      (let ((checked (my/citre-index-state-checked state))
+            (time (plist-get entry :time)))
+        (not (and checked time (time-less-p time checked))))))
+
 (defun my/citre-index-live-entries (state)
   "Return valid live entries in STATE and retire entries of detached or renamed buffers."
   (let (entries retired)
@@ -219,10 +264,11 @@
          (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)))))
+                         (or (buffer-modified-p) (verify-visited-file-modtime buffer))))
+                  (my/citre-index--snapshot-needed-p state entry buffer))
              (push (cons path entry) entries)
            (push path retired)
-           (ignore-errors (delete-file (plist-get entry :file))))))
+           (my/citre-index--retire-file state (plist-get entry :file)))))
      (my/citre-index-state-entries state))
     (dolist (path retired) (remhash path (my/citre-index-state-entries state)))
     entries))
@@ -247,9 +293,10 @@
                       (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))
+                        (puthash path (list :file output :buffer buffer :tick (plist-get job :tick)
+                                            :time (current-time))
                                  (my/citre-index-state-entries state))
-                        (when old (ignore-errors (delete-file (plist-get old :file))))
+                        (when old (my/citre-index--retire-file state (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.
@@ -268,6 +315,7 @@
   "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)
+  (my/citre-index--collect-retired state)
   (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)
@@ -343,6 +391,18 @@
         (my/citre-index-request-refresh state)
       (my/citre-index--release state))))
 
+(defun my/citre-index--discard-stale-snapshots (cache)
+  "Delete snapshot directories in CACHE left behind by Emacs sessions that ended.
+A directory without a process identifier predates this naming scheme and
+therefore cannot belong to a running session."
+  (let ((processes (list-system-processes)))
+    (dolist (directory (file-expand-wildcards (expand-file-name "live-*" cache) t))
+      (let ((name (file-name-nondirectory (directory-file-name directory))))
+        (when (and (file-directory-p directory)
+                   (or (not (string-match "\\`live-\\([0-9]+\\)-" name))
+                       (not (memq (string-to-number (match-string 1 name)) processes))))
+          (ignore-errors (delete-directory directory t)))))))
+
 (defun my/citre-index-attach ()
   "Attach a local programming buffer to its automatic project index."
   (when my/citre-index-mode
@@ -355,10 +415,12 @@
           (unless state
             (let ((cache (expand-file-name (secure-hash 'sha256 root) my/citre-index-cache-directory)))
               (make-directory cache t)
+              (my/citre-index--discard-stale-snapshots cache)
               (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)))
+                           :live-directory (make-temp-file
+                                            (expand-file-name (format "live-%d-" (emacs-pid)) cache) t)))
               (puthash root state my/citre-index--projects)))
           (setq my/citre-index--state state)
           (my/citre-index--environment state)