Enhance cider-connect to show all nREPLs available ports, instead o…

…f only Leiningen ones (#3399) Fixes #3390 Co-authored-by: ag91 <[email protected]>
clojure-emacs · Aug 11, 2023 · f376d2d · f376d2d
1 parent 37de49a
commit f376d2d
Show file tree

Hide file tree

Showing 4 changed files with 144 additions and 45 deletions.
diff --git a/.circleci/config.yml b/.circleci/config.yml
@@ -49,7 +49,7 @@ commands:
           name: Run Elisp-lint
           command: eldev lint
       - run:
-          name: Byte-compile `.el' files
+          name: Byte-compile .el files
           command: eldev -dtT compile --warnings-as-errors
 
 jobs:
@@ -110,13 +110,25 @@ jobs:
       - lint
 
 workflows:
-  version: 2
+  version: 2.1
   ci-test-matrix:
     jobs:
-      - test-ubuntu-emacs-26
-      - test-ubuntu-emacs-27
-      - test-ubuntu-emacs-28
-      - test-ubuntu-emacs-master
       - test-lint
-      - test-macos-emacs-latest
-      - test-windows-emacs-latest
+      - test-ubuntu-emacs-26:
+          requires:
+            - test-lint
+      - test-ubuntu-emacs-27:
+          requires:
+            - test-lint
+      - test-ubuntu-emacs-28:
+          requires:
+            - test-lint
+      - test-ubuntu-emacs-master:
+          requires:
+            - test-lint
+      - test-windows-emacs-latest:
+          requires:
+            - test-lint
+      - test-macos-emacs-latest:
+          requires:
+            - test-ubuntu-emacs-28
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -5,13 +5,11 @@
 ### New features
 
 - [#3352](https://github.com/clojure-emacs/cider/pull/3352) Add CIDER Log Mode, a major mode that allows you to capture, debug, inspect and view log events emitted by Java logging frameworks.
-- [#3354](https://github.com/clojure-emacs/cider/issues/3354): Add new customization variable `cider-reuse-dead-repls` to control how dead REPL buffers are reused on new connections.
 - `cider-test`: add timing information.
-- `cider-test`: only show diffs for collections.
 - `cider-test`: fail-fast by default, as controlled by the new `cider-test-fail-fast` defcustom and `cider-test-toggle-fail-fast` keybinding.
 - Infer indentation specs when possible ([doc](https://docs.cider.mx/cider/indent_spec.html#indentation-inference)).
 - Add new customization variable `cider-clojurec-eval-destination` to allow specifying which REPL CLJC evals are sent to.
-- Improve the presentation of `xref` data.
+- [#3354](https://github.com/clojure-emacs/cider/issues/3354): Add new customization variable `cider-reuse-dead-repls` to control how dead REPL buffers are reused on new connections.
 
 ### Bugs fixed
 
@@ -20,19 +18,21 @@
 - [#3355](https://github.com/clojure-emacs/cider/pull/3355): Fix `cider-mode` disabling itself after a disconnect when `cider-auto-mode` is set to nil.
 - [#3362](https://github.com/clojure-emacs/cider/issues/3362): Fix `sesman-restart` regression issue.
 - [#3236](https://github.com/clojure-emacs/cider/issues/3236): `cider-repl-set-ns` no longer changes the repl session type from `cljs:shadow` to `clj`.
-- [#3383](https://github.com/clojure-emacs/cider/issues/3383): `cider-connect-clj&cljs`: don't render `"ClojureScript REPL type:" for JVM repls. 
+- [#3383](https://github.com/clojure-emacs/cider/issues/3383): `cider-connect-clj&cljs`: don't render `"ClojureScript REPL type:"` for JVM repls. 
 - [#3331](https://github.com/clojure-emacs/cider/issues/3331): `cider-eval`: never jump to spurious locations, as sometimes conveyed by nREPL.  
 - [#3112](https://github.com/clojure-emacs/cider/issues/3112): Fix the CIDER `xref-find-references` backend to return correct filenames.
+- [#3393](https://github.com/clojure-emacs/cider/issues/3393): recompute namespace info on each shadow-cljs recompilation or evaluation.
 - Fix the `xref-find-definitions` CIDER backend to return correct filenames.
 - Fix the `cider-xref-fn-deps` buttons to direct to the right file.
 
-- [#3393](https://github.com/clojure-emacs/cider/issues/3393): recompute namespace info on each shadow-cljs recompilation or evaluation.
-
 ### Changes
 
-- Improve `nrepl-dict` error reporting.
+- [#3390](https://github.com/clojure-emacs/cider/issues/3390): Enhance `cider-connect` to show all nREPLs available ports, instead of only Leiningen ones.
 - Preserve the `:cljs-repl-type` more reliably.
-- [#3375](https://github.com/clojure-emacs/cider/pull/3375): `cider-test`: don't render a newline between expected and actual, most times. 
+- Improve the presentation of `xref` data.
+- `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.
 - Bump the injected `cider-nrepl` to [0.35](https://github.com/clojure-emacs/cider-nrepl/blob/v0.35.0/CHANGELOG.md#0350-2023-08-09).
   - Improves indentation, font-locking and other metadata support for ClojureScript.
   - Updates [Orchard](https://github.com/clojure-emacs/orchard/blob/v0.14.2/CHANGELOG.md)

diff --git a/cider.el b/cider.el
@@ -349,14 +349,14 @@ The repl dependendcies are most likely to be nREPL middlewares."
   :safe #'booleanp
   :version '(cider . "0.15.0"))
 
-(defvar cider-ps-running-nrepls-command "ps u | grep leiningen"
+(defvar cider-ps-running-lein-nrepls-command "ps u | grep leiningen"
   "Process snapshot command used in `cider-locate-running-nrepl-ports'.")
 
-(defvar cider-ps-running-nrepl-path-regexp-list
+(defvar cider-ps-running-lein-nrepl-path-regexp-list
   '("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D"
     "\\(?:-classpath +:?\\(.+?\\)/self-installs\\)")
   "Regexp list to get project paths.
-Extract project paths from output of `cider-ps-running-nrepls-command'.
+Extract project paths from output of `cider-ps-running-lein-nrepls-command'.
 Sub-match 1 must be the project path.")
 
 (defvar cider-host-history nil
@@ -1798,30 +1798,111 @@ of remote SSH hosts."
                       (or (eq ?s filetype)
                           (eq ?d filetype))))))
 
+(defun cider--path->path-port-pairs (path)
+  "Given PATH, returns all the possible <path, port> pairs."
+  (thread-last path
+               cider--file-path
+               nrepl-extract-ports
+               (mapcar (lambda (port)
+                         (list path port)))
+               ;; remove nils that may have been returned due to permission errors:
+               (seq-filter #'identity)))
+
+(defun cider--invoke-running-nrepl-path (f)
+  "Invokes F safely.
+
+Necessary since we run some OS-specific commands that may fail."
+  (condition-case nil
+      (let* ((x (funcall f)))
+        (mapcar (lambda (v)
+                  (if (and (listp v)
+                           (not (file-exists-p (car v))))
+                      nil
+                    v))
+                x))
+    (error nil)))
+
 (defun cider-locate-running-nrepl-ports (&optional dir)
   "Locate ports of running nREPL servers.
 When DIR is non-nil also look for nREPL port files in DIR.  Return a list
 of list of the form (project-dir port)."
-  (let* ((paths (cider--running-nrepl-paths))
-         (proj-ports (apply #'append
-                            (mapcar (lambda (d)
-                                      (mapcar (lambda (p) (list (file-name-nondirectory (directory-file-name d)) p))
-                                              (and d (nrepl-extract-ports (cider--file-path d)))))
-                                    (cons (clojure-project-dir dir) paths)))))
-    (seq-uniq (delq nil proj-ports))))
+  (let* ((pairs (cider--running-nrepl-paths))
+         (pairs (if-let (c (and dir (clojure-project-dir dir)))
+                    (cons (cider--path->path-port-pairs c) pairs)
+                  pairs)))
+    (thread-last pairs
+                 (delq nil)
+                 (mapcar (lambda (x)
+                           (list (file-name-nondirectory (directory-file-name (car x)))
+                                 (nth 1 x))))
+                 (seq-uniq))))
+
+(defun cider--running-lein-nrepl-paths ()
+  "Retrieve project paths of running lein nREPL servers.
+Use `cider-ps-running-lein-nrepls-command' and
+`cider-ps-running-lein-nrepl-path-regexp-list'."
+  (unless (eq system-type 'windows-nt)
+    (let (paths)
+      (with-temp-buffer
+        (insert (shell-command-to-string cider-ps-running-lein-nrepls-command))
+        (dolist (regexp cider-ps-running-lein-nrepl-path-regexp-list)
+          (goto-char 1)
+          (while (re-search-forward regexp nil t)
+            (setq paths (cons (match-string 1) paths)))))
+      (seq-mapcat (lambda (path)
+                    (cider--path->path-port-pairs path))
+                  paths))))
+
+(defun cider--running-non-lein-nrepl-paths ()
+  "Retrieve (directory, port) pairs of running nREPL servers other than Lein ones."
+  (unless (eq system-type 'windows-nt)
+    (let ((non-lein-nrepl-pids
+           (thread-last (split-string
+                         (shell-command-to-string "ps u | grep java | grep -v leiningen | grep nrepl.cmdline")
+                         "\n")
+                        (mapcar (lambda (s)
+                                  (nth 1 (split-string s " "))))
+                        (seq-filter #'identity))))
+      (when non-lein-nrepl-pids
+        (mapcar (lambda (pid)
+                  (let* ((directory (thread-last (split-string (shell-command-to-string (concat "lsof -a -d cwd -n -Fn -p " pid))
+                                                               "\n")
+                                                 (seq-map (lambda (s)
+                                                            (when (string-prefix-p "n" s)
+                                                              (replace-regexp-in-string "^n" "" s))))
+                                                 (seq-filter #'identity)
+                                                 car))
+                         (port (thread-last (split-string (shell-command-to-string (concat "lsof -n -Fn -i -a -p " pid))
+                                                          "\n")
+                                            (seq-map (lambda (s)
+                                                       (when (string-prefix-p "n" s)
+                                                         (replace-regexp-in-string ".*:" "" s))))
+                                            (seq-filter #'identity)
+                                            car)))
+                    (list directory port)))
+                non-lein-nrepl-pids)))))
+
+(defun cider--running-local-nrepl-paths ()
+  "Retrieve project paths of running nREPL servers.
+Do it by looping over the open REPL buffers."
+  (thread-last (buffer-list)
+               (seq-filter
+                (lambda (b)
+                  (string-prefix-p "*cider-repl" (buffer-name b))))
+               (seq-map
+                (lambda (b)
+                  (with-current-buffer b
+                    (when-let ((dir (plist-get (cider--gather-connect-params) :project-dir))
+                               (port (plist-get (cider--gather-connect-params) :port)))
+                      (list dir (prin1-to-string port))))))
+               (seq-filter #'identity)))
 
 (defun cider--running-nrepl-paths ()
   "Retrieve project paths of running nREPL servers.
-Use `cider-ps-running-nrepls-command' and
-`cider-ps-running-nrepl-path-regexp-list'."
-  (let (paths)
-    (with-temp-buffer
-      (insert (shell-command-to-string cider-ps-running-nrepls-command))
-      (dolist (regexp cider-ps-running-nrepl-path-regexp-list)
-        (goto-char 1)
-        (while (re-search-forward regexp nil t)
-          (setq paths (cons (match-string 1) paths)))))
-    (seq-uniq paths)))
+Search for lein or java processes including nrepl.command nREPL."
+  (append (cider--invoke-running-nrepl-path #'cider--running-lein-nrepl-paths)
+          (cider--invoke-running-nrepl-path #'cider--running-local-nrepl-paths)
+          (cider--invoke-running-nrepl-path #'cider--running-non-lein-nrepl-paths)))
 
 (defun cider--identify-buildtools-present (&optional project-dir)
   "Identify build systems present by their build files in PROJECT-DIR.

diff --git a/nrepl-client.el b/nrepl-client.el
@@ -232,18 +232,24 @@ PARAMS is as in `nrepl-make-buffer-name'."
 
 (defun nrepl-extract-port (dir)
   "Read port from applicable repl-port file in directory DIR."
-  (or (nrepl--port-from-file (expand-file-name "repl-port" dir))
-      (nrepl--port-from-file (expand-file-name ".nrepl-port" dir))
-      (nrepl--port-from-file (expand-file-name "target/repl-port" dir))
-      (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir))))
+  (condition-case nil
+      (or (nrepl--port-from-file (expand-file-name "repl-port" dir))
+          (nrepl--port-from-file (expand-file-name ".nrepl-port" dir))
+          (nrepl--port-from-file (expand-file-name "target/repl-port" dir))
+          (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir)))
+    ;; This operation can hit permission errors, particularly on macOS:
+    (error nil)))
 
 (defun nrepl-extract-ports (dir)
   "Read ports from applicable repl-port files in directory DIR."
-  (delq nil
-        (list (nrepl--port-from-file (expand-file-name "repl-port" dir))
-              (nrepl--port-from-file (expand-file-name ".nrepl-port" dir))
-              (nrepl--port-from-file (expand-file-name "target/repl-port" dir))
-              (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir)))))
+  (condition-case nil
+      (delq nil
+            (list (nrepl--port-from-file (expand-file-name "repl-port" dir))
+                  (nrepl--port-from-file (expand-file-name ".nrepl-port" dir))
+                  (nrepl--port-from-file (expand-file-name "target/repl-port" dir))
+                  (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir))))
+    ;; This operation can hit permission errors, particularly on macOS:
+    (error nil)))
 
 (make-obsolete 'nrepl-extract-port 'nrepl-extract-ports "1.5.0")