[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/cider a0d0c3c70a 4/5: Also match friendly sessions based o
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/cider a0d0c3c70a 4/5: Also match friendly sessions based on the buffer's ns form |
|
Date: |
Tue, 22 Aug 2023 09:59:05 -0400 (EDT) |
branch: elpa/cider
commit a0d0c3c70a1968ed2342bb8bf0369f37d3216ed0
Author: vemv <vemv@users.noreply.github.com>
Commit: Bozhidar Batsov <bozhidar@batsov.dev>
Also match friendly sessions based on the buffer's ns form
Fixes https://github.com/clojure-emacs/cider/issues/3419
---
CHANGELOG.md | 1 +
cider-connection.el | 58 ------------------------------------------
cider-repl.el | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 74 insertions(+), 58 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8017439871..cba6dd11ed 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -40,6 +40,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 d1a835725c..d4f437f762 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 b083a08deb..9166c87c3d 100644
--- a/cider-repl.el
+++ b/cider-repl.el
@@ -1746,6 +1746,79 @@ 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."
+ (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