Function: cider--sesman-friendly-session-p

cider--sesman-friendly-session-p is a byte-compiled function defined in cider-repl.el.

Signature

(cider--sesman-friendly-session-p SESSION &optional DEBUG)

Documentation

Check if SESSION is a friendly session, DEBUG optionally.

The checking is done as follows:

* If the current buffer's name equals to the value of cider-test-report-buffer,
  only accept the given session's repl if it equals cider-test--current-repl
* Consider if the buffer belongs to cider-ancillary-buffers
* 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.

Source Code

;; Defined in ~/.emacs.d/elpa/cider-20260414.1619/cider-repl.el
(defun cider--sesman-friendly-session-p (session &optional debug)
  "Check if SESSION is a friendly session, DEBUG optionally.

The checking is done as follows:

* If the current buffer's name equals to the value of `cider-test-report-buffer',
  only accept the given session's repl if it equals `cider-test--current-repl'
* Consider if the buffer belongs to `cider-ancillary-buffers'
* 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)))
    (cond
     ((equal (buffer-name)
             cider-test-report-buffer)
      (or (not cider-test--current-repl)
          (not (buffer-live-p cider-test--current-repl))
          (equal repl
                 cider-test--current-repl)))

     ((member (buffer-name) cider-ancillary-buffers)
      t)

     (t
      (when-let* ((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 (when (nrepl-op-supported-p "ns-list" repl)
                            (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
                                                                              ;; 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))))))))))