diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/citre-backend.el | 59 | ||||
| -rw-r--r-- | lisp/citre-index.el | 80 |
2 files changed, 123 insertions, 16 deletions
diff --git a/lisp/citre-backend.el b/lisp/citre-backend.el index eefdd31..9169d31 100644 --- a/lisp/citre-backend.el +++ b/lisp/citre-backend.el @@ -31,6 +31,12 @@ The value `safe' filters by an explicitly declared receiver type only when at le :type '(set (const scope) (const source) (const count)) :group 'my/citre) +(defcustom my/citre-reference-program "rg" + "Program used to search references. +It must accept ripgrep's options and honour the project's ignore files." + :type 'string + :group 'my/citre) + (defcustom my/citre-completion-type-resolvers '(my/citre-backend--resolve-go-type my/citre-backend--resolve-rust-or-python-type @@ -248,14 +254,14 @@ Each function receives a receiver name and the beginning of its member expressio (let* ((type (plist-get context :type)) (matching (and type (seq-filter (lambda (tag) (my/citre-backend--scope-match-p type tag)) tags))) (visible (if (and (eq my/citre-completion-context-filter 'safe) matching) matching tags)) - (groups (make-hash-table :test #'equal)) (current-scope (my/citre-backend--current-scope))) - (dolist (tag tags) - (push tag (gethash (citre-get-tag-field 'name tag) groups))) (setq visible (sort visible (lambda (a b) (my/citre-backend--rank-less-p a b context current-scope)))) (if (not (eq my/citre-completion-deduplication 'name)) visible - (let ((seen (make-hash-table :test #'equal)) result) + (let ((groups (make-hash-table :test #'equal)) + (seen (make-hash-table :test #'equal)) result) + (dolist (tag tags) + (push tag (gethash (citre-get-tag-field 'name tag) groups))) (dolist (tag visible (nreverse result)) (let ((name (citre-get-tag-field 'name tag))) (unless (gethash name seen) @@ -316,16 +322,15 @@ Each function receives a receiver name and the beginning of its member expressio (context (list revision (car bounds) major-mode citre-tags-substr-completion (buffer-substring-no-properties (line-beginning-position) (car bounds)) member-context)) - (tick (buffer-chars-modified-tick)) (cache my/citre-backend--completion-cache) (tags (if (and revision (equal context (plist-get cache :context)) (string-prefix-p (plist-get cache :prefix) symbol)) - (progn (plist-put cache :tick tick) (plist-get cache :tags)) + (plist-get cache :tags) (let ((tags (my/citre-backend--prepare-completions (my/citre-backend--query 'completion) member-context))) (setq my/citre-backend--completion-cache (list :context context :prefix (substring-no-properties symbol) - :tick tick :tags tags)) + :tags tags)) tags)))) (when tags (list (car bounds) (cdr bounds) tags))))) @@ -359,6 +364,44 @@ Each function receives a receiver name and the beginning of its member expressio "Return the current file's symbols for Imenu, including unsaved changes." (my/citre-backend--query 'imenu)) +(defun my/citre-backend--reference-root () + "Return the directory searched for references." + (or (and my/citre-index--state (my/citre-index-state-root my/citre-index--state)) + (when-let* ((project (project-current nil))) (project-root project)) + default-directory)) + +(defun my/citre-backend-references-of-id (identifier) + "Return textual references to IDENTIFIER below the project root. +Universal Ctags records definitions only, so references come from a +whole-word search that honours the project's ignore files." + (when-let* ((program (executable-find my/citre-reference-program)) + (name (substring-no-properties identifier)) + (root (my/citre-backend--reference-root))) + (unless (string-empty-p name) + (let ((default-directory root) tags) + (with-temp-buffer + (process-file program nil t nil + "--no-heading" "--line-number" "--color=never" + "--word-regexp" "--fixed-strings" "--" name ".") + (goto-char (point-min)) + (while (not (eobp)) + ;; Citre renders the matched line from the file itself, so only the + ;; location is recorded here. + (when (looking-at "\\([^:\n]+\\):\\([0-9]+\\):") + (push (citre-make-tag + 'name name + 'ext-abspath (expand-file-name (match-string-no-properties 1) root) + 'line (match-string-no-properties 2) + 'extras "reference") + tags)) + (forward-line 1))) + (nreverse tags))))) + +(defun my/citre-backend-references () + "Return textual references to the symbol at point." + (when-let* ((symbol (citre-tags-symbol-at-point))) + (my/citre-backend-references-of-id symbol))) + (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))) @@ -381,6 +424,8 @@ Each function receives a receiver name and the beginning of its member expressio :completions-fn #'my/citre-backend-completions :defs-fn #'my/citre-backend-definitions :defs-of-id-fn #'my/citre-backend-definitions-of-id + :refs-fn #'my/citre-backend-references + :refs-of-id-fn #'my/citre-backend-references-of-id :id-list-fn #'my/citre-backend-identifiers :tags-in-buffer-fn #'my/citre-backend-imenu :after-jump-fn #'my/citre-index-attach)) 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) |