diff --git a/CHANGELOG.md b/CHANGELOG.md index 420dba040..50e336c68 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -38,6 +38,7 @@ - Introduce `cider-stacktrace-navigate-to-other-window` defcustom. - Preserve the `:cljs-repl-type` more reliably. - 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. - `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. - Improve `nrepl-dict` error reporting. diff --git a/cider-connection.el b/cider-connection.el index d1a835725..d4f437f76 100644 --- a/cider-connection.el +++ b/cider-connection.el @@ -615,64 +615,6 @@ REPL defaults to the current REPL." (declare-function cider-classpath-entries "cider-client") -(defun cider--sesman-friendly-session-p (session &optional debug) - "Check if SESSION is a friendly session, DEBUG optionally." - (setcdr session (seq-filter #'buffer-live-p (cdr session))) - (when-let* ((repl (cadr session)) - (proc (get-buffer-process repl)) - (file (file-truename (or (buffer-file-name) default-directory)))) - ;; With avfs paths look like /path/to/.avfs/path/to/some.jar#uzip/path/to/file.clj - (when (string-match-p "#uzip" file) - (let ((avfs-path (directory-file-name (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/"))))) - (setq file (replace-regexp-in-string avfs-path "" file t t)))) - (when-let ((tp (cider-tramp-prefix (current-buffer)))) - (setq file (string-remove-prefix tp file))) - (when (process-live-p proc) - (let* ((classpath (or (process-get proc :cached-classpath) - (let ((cp (with-current-buffer repl - (cider-classpath-entries)))) - (process-put proc :cached-classpath cp) - cp))) - (classpath-roots (or (process-get proc :cached-classpath-roots) - (let ((cp (thread-last - classpath - (seq-filter (lambda (path) (not (string-match-p "\\.jar$" path)))) - (mapcar #'file-name-directory) - (seq-remove #'null) - (seq-uniq)))) - (process-put proc :cached-classpath-roots cp) - 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 debug - (list file "was not determined to belong to classpath:" classpath "or classpath-roots:" classpath-roots))))))) - -(defun cider-debug-sesman-friendly-session-p () - "`message's debugging information relative to friendly sessions. - -This is useful for when one sees 'No linked CIDER sessions' -in an unexpected place." - (interactive) - (message (prin1-to-string (mapcar (lambda (session) - (cider--sesman-friendly-session-p session t)) - (sesman--all-system-sessions 'CIDER))))) - -(cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session) - "Check if SESSION is a friendly session." - (cider--sesman-friendly-session-p session)) - (defvar cider-sesman-browser-map (let ((map (make-sparse-keymap))) (define-key map (kbd "j q") #'cider-quit) diff --git a/cider-repl.el b/cider-repl.el index b083a08de..a6f1ef297 100644 --- a/cider-repl.el +++ b/cider-repl.el @@ -1746,6 +1746,87 @@ constructs." (mapconcat #'identity (cider-repl--available-shortcuts) ", ")))) (error "No command selected"))))) + +(defun cider--sesman-friendly-session-p (session &optional debug) + "Check if SESSION is a friendly session, DEBUG optionally. + +The checking is done as follows: + +* Consider the buffer's filename, strip any Docker/TRAMP details from it +* Check if that filename belongs to the classpath, + or to the classpath roots (e.g. the project root dir) +* As a fallback, check if the buffer's ns form + matches any of the loaded namespaces." + (setcdr session (seq-filter #'buffer-live-p (cdr session))) + (when-let* ((repl (cadr session)) + (proc (get-buffer-process repl)) + (file (file-truename (or (buffer-file-name) default-directory)))) + ;; With avfs paths look like /path/to/.avfs/path/to/some.jar#uzip/path/to/file.clj + (when (string-match-p "#uzip" file) + (let ((avfs-path (directory-file-name (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/"))))) + (setq file (replace-regexp-in-string avfs-path "" file t t)))) + (when-let ((tp (cider-tramp-prefix (current-buffer)))) + (setq file (string-remove-prefix tp file))) + (when (process-live-p proc) + (let* ((classpath (or (process-get proc :cached-classpath) + (let ((cp (with-current-buffer repl + (cider-classpath-entries)))) + (process-put proc :cached-classpath cp) + cp))) + (ns-list (or (process-get proc :all-namespaces) + (let ((ns-list (with-current-buffer repl + (cider-sync-request:ns-list)))) + (process-put proc :all-namespaces ns-list) + ns-list))) + (classpath-roots (or (process-get proc :cached-classpath-roots) + (let ((cp (thread-last + classpath + (seq-filter (lambda (path) (not (string-match-p "\\.jar$" path)))) + (mapcar #'file-name-directory) + (seq-remove #'null) + (seq-uniq)))) + (process-put proc :cached-classpath-roots cp) + 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)) + (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))))))) + +(defun cider-debug-sesman-friendly-session-p () + "`message's debugging information relative to friendly sessions. + +This is useful for when one sees 'No linked CIDER sessions' +in an unexpected place." + (interactive) + (message (prin1-to-string (mapcar (lambda (session) + (cider--sesman-friendly-session-p session t)) + (sesman--all-system-sessions 'CIDER))))) + +(cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session) + "Check if SESSION is a friendly session." + (cider--sesman-friendly-session-p session)) + ;;;;; CIDER REPL mode (defvar cider-repl-mode-hook nil