diff --git a/CHANGELOG.md b/CHANGELOG.md index cf87aa173..bcab56a17 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -48,6 +48,7 @@ - Improve the presentation of `xref` data. - [#3419](https://github.com/clojure-emacs/cider/issues/3419): Also match friendly sessions based on the buffer's ns form. - Always match friendly sessions for `cider-ancillary-buffers` (like `*cider-error*`, `*cider-result*`, etc). +- Add buffer-local caching to friendly-session calculation. - `cider-test`: only show diffs for collections. - [#3375](https://github.com/clojure-emacs/cider/pull/3375): `cider-test`: don't render a newline between expected and actual, most times. - Ensure there's a leading `:` when using `cider-clojure-cli-aliases`. diff --git a/cider-common.el b/cider-common.el index e1cb51763..c6e7f6fae 100644 --- a/cider-common.el +++ b/cider-common.el @@ -305,6 +305,10 @@ whether DIRECTION is 'from-nrepl or 'to-nrepl." (seq-filter #'identity (mapcar f cider-path-translations)) (seq-some f cider-path-translations))))) +(defun cider--unix-time () + "Returns the Unix time." + (float-time)) + (defun cider--all-path-translations () "Returns `cider-path-translations' if non-empty, else seeks a present value." (or cider-path-translations diff --git a/cider-repl.el b/cider-repl.el index b2f637b1e..0791aa291 100644 --- a/cider-repl.el +++ b/cider-repl.el @@ -229,6 +229,9 @@ Currently its only purpose is to facilitate `cider-repl-clear-buffer'.") "A dict holding information about all currently loaded namespaces. This cache is stored in the connection buffer.") +(defvar-local cider-repl-ns-cached-at nil + "As Unix time.") + (defvar cider-mode) (declare-function cider-refresh-dynamic-font-lock "cider-mode") @@ -246,6 +249,7 @@ This cache is stored in the connection buffer.") (setq cider-repl-cljs-upgrade-pending nil)) (unless (nrepl-dict-empty-p changed-namespaces) (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces)) + (setq cider-repl-ns-cached-at (cider--unix-time)) (dolist (b (buffer-list)) (with-current-buffer b ;; Metadata changed, so signatures may have changed too. @@ -1750,6 +1754,19 @@ constructs." (mapconcat #'identity (cider-repl--available-shortcuts) ", ")))) (error "No command selected"))))) +(defvar-local cider--sesman-friendly-session-result + nil + "A -> hashmap.") + +(defvar-local cider--sesman-friendly-session-calculated-at + nil + "A -> hashmap.") + +(defvar-local cider--sesman-friendly-session-last-path-translations + nil + "The latest perceived value of (cider--all-path-translations) +in this buffer.") + (defun cider--sesman-friendly-session-p (session &optional debug) "Check if SESSION is a friendly session, DEBUG optionally. @@ -1777,11 +1794,13 @@ The checking is done as follows: (let ((cp (with-current-buffer repl (cider-classpath-entries)))) (process-put proc :cached-classpath cp) + (process-put proc :cached-classpath-at (cider--unix-time)) cp))) - (ns-list (or (process-get proc :all-namespaces) + (ns-list (or (process-get proc :cached-all-namespaces) (let ((ns-list (with-current-buffer repl (cider-sync-request:ns-list)))) - (process-put proc :all-namespaces ns-list) + (process-put proc :cached-all-namespaces ns-list) + (process-put proc :cached-all-namespaces-at (cider--unix-time)) ns-list))) (classpath-roots (or (process-get proc :cached-classpath-roots) (let ((cp (thread-last classpath @@ -1790,35 +1809,69 @@ The checking is done as follows: (seq-remove #'null) (seq-uniq)))) (process-put proc :cached-classpath-roots cp) + (process-put proc :cached-classpath-roots-at (cider--unix-time)) cp)))) - (or (seq-find (lambda (path) (string-prefix-p path file)) - classpath) - (seq-find (lambda (path) (string-prefix-p path file)) - classpath-roots) - (when-let* ((cider-path-translations (cider--all-path-translations)) - (translated (cider--translate-path file 'to-nrepl :return-all))) - (seq-find (lambda (translated-path) - (or (seq-find (lambda (path) - (string-prefix-p path translated-path)) - classpath) - (seq-find (lambda (path) - (string-prefix-p path translated-path)) - classpath-roots))) - translated)) - (when-let ((ns (condition-case nil - (substring-no-properties (cider-current-ns :no-default - ;; important - don't query the repl, - ;; avoiding a recursive invocation of `cider--sesman-friendly-session-p`: - :no-repl-check)) - (error nil)))) - ;; if the ns form matches with a ns of all runtime namespaces, we can consider the buffer to match - ;; (this is a bit lax, but also quite useful) - (with-current-buffer repl - (or (when cider-repl-ns-cache ;; may be nil on repl startup - (member ns (nrepl-dict-keys cider-repl-ns-cache))) - (member ns ns-list)))) - (when debug - (list file "was not determined to belong to classpath:" classpath "or classpath-roots:" classpath-roots)))))))) + + ;; Initialize this buffer-local variable: + (unless cider--sesman-friendly-session-calculated-at + (setq cider--sesman-friendly-session-calculated-at (nrepl-dict))) + + ;; Initialize this buffer-local variable: + (unless cider--sesman-friendly-session-result + (setq cider--sesman-friendly-session-result (nrepl-dict))) + + (let ((calculated-at (nrepl-dict-get cider--sesman-friendly-session-calculated-at repl)) + (cider-path-translations (cider--all-path-translations)) + (cider-repl-ns-cached-at (buffer-local-value 'cider-repl-ns-cached-at repl))) + (if (and calculated-at + (equal cider--sesman-friendly-session-last-path-translations + cider-path-translations) + (or (not cider-repl-ns-cached-at) + (> calculated-at + cider-repl-ns-cached-at)) + (> calculated-at + (process-get proc :cached-classpath-at)) + (> calculated-at + (process-get proc :cached-all-namespaces-at)) + (> calculated-at + (process-get proc :cached-classpath-roots-at))) + (nrepl-dict-get cider--sesman-friendly-session-result repl) + (let ((v (or (seq-find (lambda (path) (string-prefix-p path file)) + classpath) + (seq-find (lambda (path) (string-prefix-p path file)) + classpath-roots) + (when-let* ((translated (and cider-path-translations + (cider--translate-path file 'to-nrepl :return-all)))) + (seq-find (lambda (translated-path) + (or (seq-find (lambda (path) + (string-prefix-p path translated-path)) + classpath) + (seq-find (lambda (path) + (string-prefix-p path translated-path)) + classpath-roots))) + translated)) + (when-let ((ns (condition-case nil + (substring-no-properties (cider-current-ns :no-default + ;; important - don't query the repl, + ;; avoiding a recursive invocation of `cider--sesman-friendly-session-p`: + :no-repl-check)) + (error nil)))) + ;; if the ns form matches with a ns of all runtime namespaces, we can consider the buffer to match + ;; (this is a bit lax, but also quite useful) + (with-current-buffer repl + (or (when cider-repl-ns-cache ;; may be nil on repl startup + (member ns (nrepl-dict-keys cider-repl-ns-cache))) + (member ns ns-list)))) + (when debug + (list file "was not determined to belong to classpath:" classpath "or classpath-roots:" classpath-roots))))) + + (setq cider--sesman-friendly-session-last-path-translations cider-path-translations) + + (nrepl-dict-put cider--sesman-friendly-session-calculated-at repl (cider--unix-time)) + + (nrepl-dict-put cider--sesman-friendly-session-result repl v) + + v)))))))) (defun cider-debug-sesman-friendly-session-p () "`message's debugging information relative to friendly sessions.