Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Also match friendly sessions based on the buffer's ns form #3424

Merged
merged 2 commits into from
Aug 22, 2023
Merged

Also match friendly sessions based on the buffer's ns form #3424

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
566712d
Also match friendly sessions based on the buffer's ns form
vemv Aug 22, 2023
810cbe3
Expand `cider--sesman-friendly-session-p`'s docstring'
vemv Aug 22, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
58 changes: 0 additions & 58 deletions cider-connection.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Because the new impl uses misc variables/defuns like cider-repl-ns-cache, cider-sync-request:ns-list, I had to move it, keeping the linter happy.

tbh it makes sense to me that if this code now uses more repl-based capabilities, it's defined in cider-repl.el.

An alternative possibly being declare-function?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not a big fan of declare-function, so let's keep it moved.

"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)
Expand Down
81 changes: 81 additions & 0 deletions cider-repl.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Comment on lines +1776 to +1780
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This section is new.

(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))))
Comment on lines +1804 to +1812
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This section is new.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Looks good to me. At some point it'd be nice to comment all the cases for a friendly session as the function is now huge and it's kind of hard to follow.

(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
Expand Down
Loading