cider-connection.el (46931B)
1 ;;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*- 2 ;; 3 ;; Copyright © 2019-2023 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors 4 ;; 5 ;; Author: Artur Malabarba <bruce.connor.am@gmail.com> 6 ;; Bozhidar Batsov <bozhidar@batsov.dev> 7 ;; Vitalie Spinu <spinuvit@gmail.com> 8 ;; 9 ;; Keywords: languages, clojure, cider 10 ;; 11 ;; This program is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 ;; 16 ;; This program is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 ;; 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 23 ;; 24 ;; This file is not part of GNU Emacs. 25 ;; 26 ;; 27 ;;; Commentary: 28 ;; 29 ;; 30 ;;; Code: 31 32 (require 'nrepl-client) 33 (require 'cl-lib) 34 (require 'format-spec) 35 (require 'sesman) 36 (require 'sesman-browser) 37 (require 'spinner) 38 (require 'cider-popup) 39 (require 'cider-util) 40 41 (defcustom cider-session-name-template "%J:%h:%p" 42 "Format string to use for session names. 43 See `cider-format-connection-params' for available format characters." 44 :type 'string 45 :group 'cider 46 :package-version '(cider . "0.18.0")) 47 48 (defcustom cider-redirect-server-output-to-repl t 49 "Controls whether nREPL server output would be redirected to the REPL. 50 When non-nil the output would end up in both the nrepl-server buffer (when 51 available) and the matching REPL buffer." 52 :type 'boolean 53 :group 'cider 54 :safe #'booleanp 55 :package-version '(cider . "0.17.0")) 56 57 (defcustom cider-auto-mode t 58 "When non-nil, automatically enable cider mode for all Clojure buffers." 59 :type 'boolean 60 :group 'cider 61 :safe #'booleanp 62 :package-version '(cider . "0.9.0")) 63 64 ;;;###autoload 65 (defcustom cider-merge-sessions nil 66 "Controls session combination behaviour. 67 68 Symbol `host' combines all sessions of a project associated with the same host. 69 Symbol `project' combines all sessions of a project. 70 71 All other values do not combine any sessions." 72 :type 'symbol 73 :group 'cider 74 :safe #'symbolp 75 :package-version '(cider . "1.5")) 76 77 (defconst cider-required-nrepl-version "0.6.0" 78 "The minimum nREPL version that's known to work properly with CIDER.") 79 80 81 ;;; Connect 82 83 (defun cider-nrepl-connect (params) 84 "Start nrepl client and create the REPL. 85 PARAMS is a plist containing :host, :port, :server and other parameters for 86 `cider-repl-create'." 87 (process-buffer 88 (nrepl-start-client-process 89 (plist-get params :host) 90 (plist-get params :port) 91 (plist-get params :server) 92 (lambda (_) 93 (cider-repl-create params)) 94 (plist-get params :socket-file)))) 95 96 (defun cider-sessions () 97 "Return a list of all active CIDER sessions." 98 (sesman-sessions 'CIDER)) 99 100 (defun cider-connected-p () 101 "Return t if CIDER is currently connected, nil otherwise." 102 (process-live-p (get-buffer-process (cider-current-repl)))) 103 104 (defun cider-ensure-connected () 105 "Ensure there is a linked CIDER session." 106 (sesman-ensure-session 'CIDER)) 107 108 (defun cider--session-server (session) 109 "Return server buffer for SESSION or nil if there is no server." 110 (seq-some (lambda (r) 111 (buffer-local-value 'nrepl-server-buffer r)) 112 (cdr session))) 113 114 (defun cider--gather-session-params (session) 115 "Gather all params for a SESSION." 116 (let (params) 117 (dolist (repl (cdr session)) 118 (setq params (cider--gather-connect-params params repl))) 119 (when-let* ((server (cider--session-server session))) 120 (setq params (cider--gather-connect-params params server))) 121 params)) 122 123 (defun cider--gather-connect-params (&optional params proc-buffer) 124 "Gather all relevant connection parameters into PARAMS plist. 125 PROC-BUFFER is either server or client buffer, defaults to current buffer." 126 (let ((proc-buffer (or proc-buffer (current-buffer)))) 127 (with-current-buffer proc-buffer 128 (unless nrepl-endpoint 129 (error "This is not a REPL or SERVER buffer; is there an active REPL?")) 130 (let ((server-buf (if (nrepl-server-p proc-buffer) 131 proc-buffer 132 nrepl-server-buffer))) 133 (cl-loop for l on nrepl-endpoint by #'cddr 134 do (setq params (plist-put params (car l) (cadr l)))) 135 (setq params (thread-first 136 params 137 (plist-put :project-dir nrepl-project-dir))) 138 (when (buffer-live-p server-buf) 139 (setq params (thread-first 140 params 141 (plist-put :server (get-buffer-process server-buf)) 142 (plist-put :server-command nrepl-server-command)))) 143 ;; repl-specific parameters (do not pollute server params!) 144 (unless (nrepl-server-p proc-buffer) 145 (setq params (thread-first 146 params 147 (plist-put :session-name cider-session-name) 148 (plist-put :repl-type cider-repl-type) 149 (plist-put :cljs-repl-type cider-cljs-repl-type) 150 (plist-put :repl-init-function cider-repl-init-function)))) 151 params)))) 152 153 (defun cider--close-buffer (buffer) 154 "Close the BUFFER and kill its associated process (if any)." 155 (when (buffer-live-p buffer) 156 (when-let* ((proc (get-buffer-process buffer))) 157 (when (process-live-p proc) 158 (delete-process proc))) 159 (kill-buffer buffer))) 160 161 (declare-function cider-repl-emit-interactive-stderr "cider-repl") 162 (defun cider--close-connection (repl &optional no-kill) 163 "Close connection associated with REPL. 164 When NO-KILL is non-nil stop the connection but don't kill the REPL 165 buffer." 166 (when (buffer-live-p repl) 167 (with-current-buffer repl 168 (when spinner-current (spinner-stop)) 169 (when nrepl-tunnel-buffer 170 (cider--close-buffer nrepl-tunnel-buffer)) 171 (when no-kill 172 ;; inform sentinel not to kill the server, if any 173 (thread-first 174 (get-buffer-process repl) 175 (process-plist) 176 (plist-put :keep-server t)))) 177 (let ((proc (get-buffer-process repl))) 178 (when (and (process-live-p proc) 179 (or (not nrepl-server-buffer) 180 ;; Sync request will hang if the server is dead. 181 (process-live-p (get-buffer-process nrepl-server-buffer)))) 182 (nrepl-sync-request:close repl) 183 ;; give a chance to the REPL to respond to the closing of the connection 184 (sleep-for 0.5) 185 (delete-process proc))) 186 (when-let* ((messages-buffer (and nrepl-log-messages 187 (nrepl-messages-buffer repl)))) 188 (kill-buffer messages-buffer)) 189 (unless no-kill 190 (kill-buffer repl))) 191 (when repl 192 (sesman-remove-object 'CIDER nil repl (not no-kill) t))) 193 194 (defun cider-emit-manual-warning (section-id format &rest args) 195 "Emit a warning to the REPL and link to the online manual. 196 SECTION-ID is the section to link to. The link is added on the last line. 197 FORMAT is a format string to compile with ARGS and display on the REPL." 198 (let ((message (apply #'format format args))) 199 (cider-repl-emit-interactive-stderr 200 (concat "WARNING: " message " (" 201 (cider--manual-button "More information" section-id) 202 ")\n")))) 203 204 (defvar cider-version) 205 (defun cider--check-required-nrepl-version () 206 "Check whether we're using a compatible nREPL version." 207 (if-let* ((nrepl-version (cider--nrepl-version))) 208 (when (version< nrepl-version cider-required-nrepl-version) 209 (cider-emit-manual-warning "troubleshooting.html#warning-saying-you-have-to-use-newer-nrepl" 210 "CIDER requires nREPL %s (or newer) to work properly" 211 cider-required-nrepl-version)))) 212 213 (defvar cider-minimum-clojure-version) 214 (defun cider--check-clojure-version-supported () 215 "Ensure that we are meeting the minimum supported version of Clojure." 216 (if-let* ((clojure-version (cider--clojure-version)) 217 ;; drop all qualifiers from the version string 218 ;; e.g. 1.10.0-master-SNAPSHOT becomes simply 1.10.0 219 (clojure-version (car (split-string clojure-version "-")))) 220 (when (version< clojure-version cider-minimum-clojure-version) 221 (cider-emit-manual-warning "basics/installation.html#prerequisites" 222 "Clojure version (%s) is not supported (minimum %s). CIDER will not work." 223 clojure-version cider-minimum-clojure-version)))) 224 225 (defun cider--strip-version-patch (v) 226 "Strips everything but major.minor from the version, returning a version list. 227 V is the version string to strip the patch from." 228 (seq-take (version-to-list v) 2)) 229 230 (defun cider--compatible-middleware-version-p (required-ver ver) 231 "Checks that the available middleware version is compatible with the required. 232 We look only at the major and minor components. When the major 233 version is 0, only check that the minor versions match. When the major version 234 is > 0, first check that the major version matches, then that the minor 235 version is >= the required minor version. 236 VER the 'installed' version, 237 REQUIRED-VER the version required by cider." 238 (let ((ver* (cider--strip-version-patch ver)) 239 (required-ver* (cider--strip-version-patch required-ver))) 240 (cond ((= 0 (car required-ver*)) (= (cadr required-ver*) 241 (cadr ver*))) 242 (t (and (= (car required-ver*) 243 (car ver*)) 244 (version-list-<= required-ver* ver*)))))) 245 246 (defvar cider-required-middleware-version) 247 (defun cider--check-middleware-compatibility () 248 "CIDER frontend/backend compatibility check. 249 Retrieve the underlying connection's CIDER-nREPL version and checks if the 250 middleware used is compatible with CIDER. If not, will display a warning 251 message in the REPL area." 252 (let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-repl))) 253 (middleware-version (nrepl-dict-get version-dict "version-string"))) 254 (cond 255 ((null middleware-version) 256 (cider-emit-manual-warning "troubleshooting.html#cider-complains-of-the-cider-nrepl-version" 257 "CIDER requires cider-nrepl to be fully functional. Some features will not be available without it!")) 258 ((not (cider--compatible-middleware-version-p cider-required-middleware-version middleware-version)) 259 (cider-emit-manual-warning "troubleshooting.html#cider-complains-of-the-cider-nrepl-version" 260 "CIDER %s requires cider-nrepl %s, but you're currently using cider-nrepl %s. The version mismatch might break some functionality!" 261 cider-version cider-required-middleware-version middleware-version))))) 262 263 (declare-function cider-interactive-eval-handler "cider-eval") 264 (declare-function cider-nrepl-send-request "cider-client") 265 ;; TODO: Use some null handler here 266 (defun cider--subscribe-repl-to-server-out () 267 "Subscribe to the nREPL server's *out*." 268 (cider-nrepl-send-request '("op" "out-subscribe") 269 (cider-interactive-eval-handler (current-buffer)))) 270 271 (declare-function cider-mode "cider-mode") 272 (defun cider-enable-on-existing-clojure-buffers () 273 "Enable CIDER's minor mode on existing Clojure buffers. 274 See command `cider-mode'." 275 (interactive) 276 (add-hook 'clojure-mode-hook #'cider-mode) 277 (dolist (buffer (cider-util--clojure-buffers)) 278 (with-current-buffer buffer 279 (cider-mode +1) 280 ;; In global-eldoc-mode, a new file-visiting buffer calls 281 ;; `turn-on-eldoc-mode' which enables eldoc-mode if it's supported in that 282 ;; buffer as determined by `eldoc--supported-p'. Cider's eldoc support 283 ;; allows new buffers in cider-mode to enable eldoc-mode. As of 2021-04, 284 ;; however, clojure-mode itself has no eldoc support, so old clojure 285 ;; buffers opened before cider started aren't necessarily in eldoc-mode. 286 ;; Here, we've enabled cider-mode for this old clojure buffer, and now, if 287 ;; global-eldoc-mode is enabled, try to enable eldoc-mode as if the buffer 288 ;; had just been created with cider-mode. 289 (when global-eldoc-mode 290 (turn-on-eldoc-mode))))) 291 292 (declare-function cider--debug-mode "cider-debug") 293 (defun cider-disable-on-existing-clojure-buffers () 294 "Disable `cider-mode' and related commands on existing Clojure buffers." 295 (interactive) 296 (dolist (buffer (cider-util--clojure-buffers)) 297 (with-current-buffer buffer 298 (cider--debug-mode -1) 299 (cider-mode -1)))) 300 301 (defun cider-possibly-disable-on-existing-clojure-buffers () 302 "Disable `cider-mode' in all Clojure buffers if all CIDER sessions are closed." 303 (unless (cider-sessions) 304 (cider-disable-on-existing-clojure-buffers))) 305 306 (defun cider--set-connection-capabilities (&optional conn-buffer) 307 "Set `cider-connection-capabilities' for CONN-BUFFER during repl init. 308 See `cider-connection-capabilities'." 309 (with-current-buffer (or conn-buffer (current-buffer)) 310 (setf cider-connection-capabilities 311 (append 312 (pcase (cider-runtime) 313 ('clojure '(clojure jvm-compilation-errors)) 314 ('babashka '(babashka jvm-compilation-errors)) 315 (_ '())) 316 (when 317 (or 318 (eq cider-repl-type 'cljs) 319 ;; This check is currently basically for nbb. 320 ;; See `cider-sync-tooling-eval', but it is defined on a higher layer 321 (nrepl-dict-get 322 (nrepl-sync-request:eval "cljs.core/demunge" (current-buffer) nil 'tooling) 323 "value")) 324 '(cljs)))))) 325 326 (declare-function cider--debug-init-connection "cider-debug") 327 (declare-function cider-repl-init "cider-repl") 328 (declare-function cider-nrepl-op-supported-p "cider-client") 329 (defun cider--connected-handler () 330 "Handle CIDER initialization after nREPL connection has been established. 331 This function is appended to `nrepl-connected-hook' in the client process 332 buffer." 333 ;; `nrepl-connected-hook' is run in the connection buffer 334 ;; `cider-enlighten-mode' changes eval to include the debugger, so we inhibit 335 ;; it here as the debugger isn't necessarily initialized yet 336 (let ((cider-enlighten-mode nil)) 337 ;; after initialization, set mode-line and buffer name. 338 (cider-set-repl-type cider-repl-type) 339 (cider-repl-init 340 (current-buffer) 341 (lambda () 342 ;; Init logic that's specific to Clojure's nREPL and cider-nrepl 343 (when (cider-runtime-clojure-p) 344 (cider--check-required-nrepl-version) 345 (cider--check-clojure-version-supported) 346 (cider--check-middleware-compatibility) 347 348 ;; Redirect the nREPL's terminal output to a REPL buffer. 349 ;; If we don't do this the server's output will end up 350 ;; in the *nrepl-server* buffer. 351 (when (and cider-redirect-server-output-to-repl 352 (cider-nrepl-op-supported-p "out-subscribe")) 353 (cider--subscribe-repl-to-server-out)) 354 355 ;; Middleware on cider-nrepl's side is deferred until first usage, but 356 ;; loading middleware concurrently can lead to occasional "require" issues 357 ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards 358 ;; the end, allowing for the faster "server-out" middleware to load 359 ;; first. 360 (cider--debug-init-connection)) 361 362 (cider--set-connection-capabilities) 363 364 (when cider-repl-init-function 365 (funcall cider-repl-init-function)) 366 367 (when cider-auto-mode 368 (cider-enable-on-existing-clojure-buffers)) 369 370 (run-hooks 'cider-connected-hook))))) 371 372 (defun cider--disconnected-handler () 373 "Cleanup after nREPL connection has been lost or closed. 374 This function is appended to `nrepl-disconnected-hook' in the client 375 process buffer." 376 ;; `nrepl-connected-hook' is run in the connection buffer 377 (cider-possibly-disable-on-existing-clojure-buffers) 378 (run-hooks 'cider-disconnected-hook)) 379 380 381 ;;; Connection Info 382 383 (defun cider--java-version () 384 "Retrieve the underlying connection's Java version." 385 (with-current-buffer (cider-current-repl) 386 (when nrepl-versions 387 (thread-first 388 nrepl-versions 389 (nrepl-dict-get "java") 390 (nrepl-dict-get "version-string"))))) 391 392 (defun cider--clojure-version () 393 "Retrieve the underlying connection's Clojure version." 394 (with-current-buffer (cider-current-repl) 395 (when nrepl-versions 396 (thread-first 397 nrepl-versions 398 (nrepl-dict-get "clojure") 399 (nrepl-dict-get "version-string"))))) 400 401 (defun cider--nrepl-version () 402 "Retrieve the underlying connection's nREPL version." 403 (with-current-buffer (cider-current-repl) 404 (when nrepl-versions 405 (thread-first 406 nrepl-versions 407 (nrepl-dict-get "nrepl") 408 (nrepl-dict-get "version-string"))))) 409 410 (defun cider--babashka-version () 411 "Retrieve the underlying connection's Babashka version." 412 (with-current-buffer (cider-current-repl) 413 (when nrepl-versions 414 (nrepl-dict-get nrepl-versions "babashka")))) 415 416 (defun cider--babashka-nrepl-version () 417 "Retrieve the underlying connection's babashka.nrepl version." 418 (with-current-buffer (cider-current-repl) 419 (when nrepl-versions 420 (nrepl-dict-get nrepl-versions "babashka.nrepl")))) 421 422 (defun cider-runtime () 423 "Return the runtime of the nREPl server." 424 (cond 425 ((cider--clojure-version) 'clojure) 426 ((cider--babashka-version) 'babashka) 427 (t 'generic))) 428 429 (defun cider-runtime-clojure-p () 430 "Check if the current runtime is Clojure." 431 (eq (cider-runtime) 'clojure)) 432 433 (defun cider--connection-info (connection-buffer &optional genericp) 434 "Return info about CONNECTION-BUFFER. 435 Info contains project name, current REPL namespace, host:port endpoint and 436 runtime details. When GENERICP is non-nil, don't provide specific info 437 about this buffer (like variable `cider-repl-type')." 438 (with-current-buffer connection-buffer 439 (cond 440 ((cider--clojure-version) 441 (format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)" 442 (if genericp "" (upcase (concat (symbol-name cider-repl-type) " "))) 443 (or (cider--project-name nrepl-project-dir) "<no project>") 444 (plist-get nrepl-endpoint :host) 445 (plist-get nrepl-endpoint :port) 446 (cider--java-version) 447 (cider--clojure-version) 448 (cider--nrepl-version))) 449 ((cider--babashka-version) 450 (format "%s%s@%s:%s (Babashka %s, babashka.nrepl %s)" 451 (if genericp "" (upcase (concat (symbol-name cider-repl-type) " "))) 452 (or (cider--project-name nrepl-project-dir) "<no project>") 453 (plist-get nrepl-endpoint :host) 454 (plist-get nrepl-endpoint :port) 455 (cider--babashka-version) 456 (cider--babashka-nrepl-version))) 457 (t 458 (format "%s%s@%s:%s" 459 (if genericp "" (upcase (concat (symbol-name cider-repl-type) " "))) 460 (or (cider--project-name nrepl-project-dir) "<no project>") 461 (plist-get nrepl-endpoint :host) 462 (plist-get nrepl-endpoint :port)))))) 463 464 (defvar-local cider-connection-capabilities '() 465 "A list of some of the capabilities of this connection buffer. 466 In other words - what assumptions we make about the runtime. 467 This is more general than 468 `cider-nrepl-op-supported-p' and `cider-library-present-p'. 469 But does not need to replace them.") 470 471 (defun cider-connection-has-capability-p (capability &optional conn-buf) 472 "Return non nil when the cider connection has CAPABILITY for CONN-BUF. 473 By default it assumes the connection buffer is current." 474 (with-current-buffer (or conn-buf (current-buffer)) 475 (member capability cider-connection-capabilities))) 476 477 478 ;;; Connection Management Commands 479 480 (defun cider-quit (&optional repl) 481 "Quit the CIDER connection associated with REPL. 482 REPL defaults to the current REPL." 483 (interactive) 484 (let ((repl (or repl 485 (sesman-browser-get 'object) 486 (cider-current-repl nil 'ensure)))) 487 (cider--close-connection repl)) 488 ;; if there are no more sessions we can kill all ancillary buffers 489 (unless (cider-sessions) 490 (cider-close-ancillary-buffers)) 491 ;; need this to refresh sesman browser 492 (run-hooks 'sesman-post-command-hook)) 493 494 (defun cider-restart (&optional repl) 495 "Restart CIDER connection associated with REPL. 496 REPL defaults to the current REPL. Don't restart the server or other 497 connections within the same session. Use `sesman-restart' to restart the 498 entire session." 499 (interactive) 500 (let* ((repl (or repl 501 (sesman-browser-get 'object) 502 (cider-current-repl nil 'ensure))) 503 (params (thread-first 504 () 505 (cider--gather-connect-params repl) 506 (plist-put :session-name (sesman-session-name-for-object 'CIDER repl)) 507 (plist-put :repl-buffer repl)))) 508 (cider--close-connection repl 'no-kill) 509 (cider-nrepl-connect params) 510 ;; need this to refresh sesman browser 511 (run-hooks 'sesman-post-command-hook))) 512 513 (defun cider-close-ancillary-buffers () 514 "Close buffers that are shared across connections." 515 (interactive) 516 (dolist (buf-name cider-ancillary-buffers) 517 (when (get-buffer buf-name) 518 (kill-buffer buf-name)))) 519 520 (defun cider-describe-connection (&optional repl) 521 "Display information about the connection associated with REPL. 522 REPL defaults to the current REPL." 523 (interactive) 524 (let ((repl (or repl 525 (sesman-browser-get 'object) 526 (cider-current-repl nil 'ensure)))) 527 (message "%s" (cider--connection-info repl)))) 528 529 (defconst cider-nrepl-session-buffer "*cider-nrepl-session*") 530 531 (declare-function cider-nrepl-eval-session "cider-client") 532 (declare-function cider-nrepl-tooling-session "cider-client") 533 (defun cider-describe-nrepl-session () 534 "Describe an nREPL session." 535 (interactive) 536 (cider-ensure-connected) 537 (let* ((repl (cider-current-repl nil 'ensure)) 538 (selected-session (completing-read "Describe nREPL session: " (nrepl-sessions repl)))) 539 (when (and selected-session (not (equal selected-session ""))) 540 (let* ((session-info (nrepl-sync-request:describe repl)) 541 (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) 542 (session-id (nrepl-dict-get session-info "session")) 543 (session-type (cond 544 ((equal session-id (cider-nrepl-eval-session)) "Active eval") 545 ((equal session-id (cider-nrepl-tooling-session)) "Active tooling") 546 (t "Unknown")))) 547 (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer 'select nil 'ancillary) 548 (read-only-mode -1) 549 (insert (format "Session: %s\n" session-id) 550 (format "Type: %s session\n" session-type) 551 (format "Supported ops:\n")) 552 (mapc (lambda (op) (insert (format " * %s\n" op))) ops))) 553 (display-buffer cider-nrepl-session-buffer)))) 554 555 (defun cider-list-nrepl-middleware () 556 "List the loaded nREPL middleware." 557 (interactive) 558 (cider-ensure-connected) 559 (let* ((repl (cider-current-repl nil 'ensure)) 560 (middleware (nrepl-middleware repl))) 561 (with-current-buffer (cider-popup-buffer "*cider-nrepl-middleware*" 'select nil 'ancillary) 562 (read-only-mode -1) 563 (insert (format "Currently loaded middleware:\n")) 564 (mapc (lambda (mw) (insert (format " * %s\n" mw))) middleware)) 565 (display-buffer "*cider-nrepl-middleware*"))) 566 567 568 ;;; Sesman's Session-Wise Management UI 569 570 (cl-defmethod sesman-project ((_system (eql CIDER))) 571 "Find project directory." 572 (clojure-project-dir (cider-current-dir))) 573 574 (cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2) 575 "Figure out if SESSION1 or SESSION2 is more relevant." 576 (sesman-more-recent-p (cdr session1) (cdr session2))) 577 578 (declare-function cider-classpath-entries "cider-client") 579 (cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session) 580 "Check if SESSION is a friendly session." 581 (setcdr session (seq-filter #'buffer-live-p (cdr session))) 582 (when-let* ((repl (cadr session)) 583 (proc (get-buffer-process repl)) 584 (file (file-truename (or (buffer-file-name) default-directory)))) 585 ;; With avfs paths look like /path/to/.avfs/path/to/some.jar#uzip/path/to/file.clj 586 (when (string-match-p "#uzip" file) 587 (let ((avfs-path (directory-file-name (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/"))))) 588 (setq file (replace-regexp-in-string avfs-path "" file t t)))) 589 (when (process-live-p proc) 590 (let* ((classpath (or (process-get proc :cached-classpath) 591 (let ((cp (with-current-buffer repl 592 (cider-classpath-entries)))) 593 (process-put proc :cached-classpath cp) 594 cp))) 595 (classpath-roots (or (process-get proc :cached-classpath-roots) 596 (let ((cp (thread-last 597 classpath 598 (seq-filter (lambda (path) (not (string-match-p "\\.jar$" path)))) 599 (mapcar #'file-name-directory) 600 (seq-remove #'null) 601 (seq-uniq)))) 602 (process-put proc :cached-classpath-roots cp) 603 cp)))) 604 (or (seq-find (lambda (path) (string-prefix-p path file)) 605 classpath) 606 (seq-find (lambda (path) (string-prefix-p path file)) 607 classpath-roots)))))) 608 609 (defvar cider-sesman-browser-map 610 (let ((map (make-sparse-keymap))) 611 (define-key map (kbd "j q") #'cider-quit) 612 (define-key map (kbd "j k") #'cider-quit) 613 (define-key map (kbd "j r") #'cider-restart) 614 (define-key map (kbd "j d") #'cider-describe-connection) 615 (define-key map (kbd "j i") #'cider-describe-connection) 616 (define-key map (kbd "C-c C-q") #'cider-quit) 617 (define-key map (kbd "C-c C-q") #'cider-quit) 618 (define-key map (kbd "C-c C-r") #'cider-restart) 619 (define-key map (kbd "C-c M-r") #'cider-restart) 620 (define-key map (kbd "C-c C-d") #'cider-describe-connection) 621 (define-key map (kbd "C-c M-d") #'cider-describe-connection) 622 (define-key map (kbd "C-c C-i") #'cider-describe-connection) 623 map) 624 "Map active on REPL objects in sesman browser.") 625 626 (cl-defmethod sesman-session-info ((_system (eql CIDER)) session) 627 "Obtain info for a CIDER SESSION." 628 (list :objects (cdr session) 629 :map cider-sesman-browser-map)) 630 631 (declare-function cider "cider") 632 (cl-defmethod sesman-start-session ((_system (eql CIDER))) 633 "Start a connection of any type interactively. 634 Fallback on `cider' command." 635 (call-interactively #'cider)) 636 637 (cl-defmethod sesman-quit-session ((_system (eql CIDER)) session) 638 "Quit a CIDER SESSION." 639 (mapc #'cider--close-connection (cdr session)) 640 ;; if there are no more session we can kill all ancillary buffers 641 (unless (cider-sessions) 642 (cider-close-ancillary-buffers))) 643 644 (cl-defmethod sesman-restart-session ((_system (eql CIDER)) session) 645 "Restart a CIDER SESSION." 646 (let* ((ses-name (car session)) 647 (repls (cdr session)) 648 (srv-buf (cider--session-server session))) 649 (if srv-buf 650 ;; session with a server 651 (let ((s-params (cider--gather-connect-params nil srv-buf))) 652 ;; 1) kill all connections, but keep the buffers 653 (mapc (lambda (conn) 654 (cider--close-connection conn 'no-kill)) 655 repls) 656 ;; 2) kill the server 657 (nrepl-kill-server-buffer srv-buf) 658 ;; 3) start server 659 (nrepl-start-server-process 660 (plist-get s-params :project-dir) 661 (plist-get s-params :server-command) 662 (lambda (server-buf) 663 ;; 4) restart the repls reusing the buffer 664 (dolist (r repls) 665 (cider-nrepl-connect 666 (thread-first 667 () 668 (cider--gather-connect-params r) 669 ;; server params (:port, :project-dir etc) have precedence 670 (cider--gather-connect-params server-buf) 671 (plist-put :session-name ses-name) 672 (plist-put :repl-buffer r)))) 673 (sesman-browser-revert-all 'CIDER) 674 (message "Restarted CIDER %s session" ses-name)))) 675 ;; server-less session 676 (dolist (r repls) 677 (cider--close-connection r 'no-kill) 678 (cider-nrepl-connect 679 (thread-first 680 () 681 (cider--gather-connect-params r) 682 (plist-put :session-name ses-name) 683 (plist-put :repl-buffer r))))))) 684 685 (defun cider-format-connection-params (template params) 686 "Format PARAMS with TEMPLATE string. 687 The following formats can be used in TEMPLATE string: 688 689 %h - host 690 %H - remote host, empty for local hosts 691 %p - port 692 %j - short project name, or directory name if no project 693 %J - long project name including parent dir name 694 %r - REPL type (clj or cljs) 695 %S - type of the ClojureScript runtime (Browser, Node, Figwheel etc.) 696 %s - session name as defined by `cider-session-name-template'. 697 698 In case some values are empty, extra separators (: and -) are automatically 699 removed." 700 (let* ((dir (directory-file-name 701 (abbreviate-file-name 702 (or (plist-get params :project-dir) 703 (clojure-project-dir (cider-current-dir)) 704 default-directory)))) 705 (short-proj (file-name-nondirectory (directory-file-name dir))) 706 (parent-dir (ignore-errors 707 (thread-first dir file-name-directory 708 directory-file-name file-name-nondirectory 709 file-name-as-directory))) 710 (long-proj (format "%s%s" (or parent-dir "") short-proj)) 711 ;; use `dir` if it is shorter than `long-proj` or `short-proj` 712 (short-proj (if (>= (length short-proj) (length dir)) 713 dir 714 short-proj)) 715 (long-proj (if (>= (length long-proj) (length dir)) 716 dir 717 long-proj)) 718 (port (or (plist-get params :port) "")) 719 (host (or (plist-get params :host) "localhost")) 720 (remote-host (if (member host '("localhost" "127.0.0.1")) 721 "" 722 host)) 723 (repl-type (or (plist-get params :repl-type) "unknown")) 724 (cljs-repl-type (or (and (eq repl-type 'cljs) 725 (plist-get params :cljs-repl-type)) 726 "")) 727 (specs `((?h . ,host) 728 (?H . ,remote-host) 729 (?p . ,port) 730 (?j . ,short-proj) 731 (?J . ,long-proj) 732 (?r . ,repl-type) 733 (?S . ,cljs-repl-type))) 734 (ses-name (or (plist-get params :session-name) 735 (format-spec cider-session-name-template specs))) 736 (specs (append `((?s . ,ses-name)) specs))) 737 (thread-last 738 (format-spec template specs) 739 ;; remove extraneous separators 740 (replace-regexp-in-string "\\([:-]\\)[:-]+" "\\1") 741 (replace-regexp-in-string "\\(^[:-]\\)\\|\\([:-]$\\)" "") 742 (replace-regexp-in-string "[:-]\\([])*]\\)" "\\1")))) 743 744 (defun cider-make-session-name (params) 745 "Create new session name given plist of connection PARAMS. 746 Session name can be customized with `cider-session-name-template'." 747 (let* ((root-name (cider-format-connection-params cider-session-name-template params)) 748 (other-names (mapcar #'car (sesman-sessions 'CIDER))) 749 (name root-name) 750 (i 2)) 751 (while (member name other-names) 752 (setq name (concat root-name "#" (number-to-string i)) 753 i (+ i 1))) 754 name)) 755 756 757 ;;; REPL Buffer Init 758 759 (defvar-local cider-cljs-repl-type nil 760 "The type of the ClojureScript runtime (Browser, Node, Figwheel, etc.).") 761 762 (defvar-local cider-repl-type nil 763 "The type of this REPL buffer, usually either clj or cljs.") 764 765 (defvar-local cider-repl-cljs-upgrade-pending nil 766 "Is the cljs repl currently pending?") 767 768 (defun cider-repl-type (repl-buffer) 769 "Get REPL-BUFFER's type." 770 (buffer-local-value 'cider-repl-type repl-buffer)) 771 772 (defun cider-cljs-pending-p (repl-buffer) 773 "Returns non nil when REPL-BUFFER is currently a pending cljs repl." 774 (buffer-local-value 'cider-repl-cljs-upgrade-pending repl-buffer)) 775 776 (defun cider-repl-type-for-buffer (&optional buffer) 777 "Return the matching connection type (clj or cljs) for BUFFER. 778 BUFFER defaults to the `current-buffer'. In cljc buffers return 779 multi. This function infers connection type based on the major mode. 780 For the REPL type use the function `cider-repl-type'." 781 (with-current-buffer (or buffer (current-buffer)) 782 (cond 783 ((derived-mode-p 'clojurescript-mode) 'cljs) 784 ((derived-mode-p 'clojurec-mode) 'multi) 785 ((derived-mode-p 'clojure-mode) 'clj) 786 (cider-repl-type)))) 787 788 (defun cider-set-repl-type (&optional type) 789 "Set REPL TYPE to clj or cljs. 790 Assume that the current buffer is a REPL." 791 (interactive) 792 (let ((type (cider-maybe-intern (or type (completing-read 793 (format "Set REPL type (currently `%s') to: " 794 cider-repl-type) 795 '(clj cljs)))))) 796 (when (or (not (equal cider-repl-type type)) 797 (null mode-name)) 798 (setq cider-repl-type type) 799 (setq mode-name (format "REPL[%s]" type)) 800 (let ((params (cider--gather-connect-params))) 801 ;; We need to set current name to something else temporarily to avoid 802 ;; false name duplication in `nrepl-repl-buffer-name`. 803 (rename-buffer (generate-new-buffer-name "*dummy-cider-repl-buffer*")) 804 (rename-buffer (nrepl-repl-buffer-name params)) 805 (when (and nrepl-log-messages nrepl-messages-buffer) 806 (with-current-buffer nrepl-messages-buffer 807 (rename-buffer (nrepl-messages-buffer-name params)))))))) 808 809 (defun cider--choose-reusable-repl-buffer (params) 810 "Find connection-less REPL buffer and ask the user for confirmation. 811 Return nil if no such buffers exists or the user has chosen not to reuse 812 the buffer. If multiple dead REPLs exist, ask the user to choose one. 813 PARAMS is a plist as received by `cider-repl-create'." 814 (when-let* ((repls (seq-filter (lambda (b) 815 (with-current-buffer b 816 (and (derived-mode-p 'cider-repl-mode) 817 (not (process-live-p (get-buffer-process b)))))) 818 (buffer-list)))) 819 (let* ((proj-dir (plist-get params :project-dir)) 820 (host (plist-get params :host)) 821 (port (plist-get params :port)) 822 (cljsp (eq (plist-get params :repl-type) 'cljs)) 823 (scored-repls 824 (delq nil 825 (mapcar (lambda (b) 826 (let ((bparams (cider--gather-connect-params nil b))) 827 (when (and cljsp 828 (eq (plist-get bparams :repl-type) 829 'cljs)) 830 (cons (buffer-name b) 831 (+ 832 (if (equal proj-dir (plist-get bparams :project-dir)) 8 0) 833 (if (equal host (plist-get bparams :host)) 4 0) 834 (if (equal port (plist-get bparams :port)) 2 0)))))) 835 repls)))) 836 (when scored-repls 837 (if (> (length scored-repls) 1) 838 (when (y-or-n-p "Dead REPLs exist. Reuse? ") 839 (let ((sorted-repls (seq-sort (lambda (a b) (> (cdr a) (cdr b))) scored-repls))) 840 (get-buffer (completing-read "REPL to reuse: " 841 (mapcar #'car sorted-repls) nil t nil nil (caar sorted-repls))))) 842 (when (y-or-n-p (format "A dead REPL %s exists. Reuse? " (caar scored-repls))) 843 (get-buffer (caar scored-repls)))))))) 844 845 (declare-function cider-default-err-handler "cider-eval") 846 (declare-function cider-repl-mode "cider-repl") 847 (declare-function cider-repl--state-handler "cider-repl") 848 (declare-function cider-repl-reset-markers "cider-repl") 849 (defvar-local cider-session-name nil) 850 (defvar-local cider-repl-init-function nil) 851 (defvar-local cider-launch-params nil) 852 (defun cider-repl-create (params) 853 "Create new repl buffer. 854 PARAMS is a plist which contains :repl-type, :host, :port, :project-dir, 855 :repl-init-function and :session-name. When non-nil, :repl-init-function 856 must be a function with no arguments which is called after repl creation 857 function with the repl buffer set as current." 858 ;; Connection might not have been set as yet. Please don't send requests in 859 ;; this function, but use cider--connected-handler instead. 860 (let ((buffer (or (plist-get params :repl-buffer) 861 (cider--choose-reusable-repl-buffer params) 862 (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*")))) 863 (ses-name (or (plist-get params :session-name) 864 (cider-make-session-name params)))) 865 (with-current-buffer buffer 866 (setq-local sesman-system 'CIDER) 867 (setq-local default-directory (or (plist-get params :project-dir) default-directory)) 868 ;; creates a new session if session with ses-name doesn't already exist 869 (sesman-add-object 'CIDER ses-name buffer 'allow-new) 870 (unless (derived-mode-p 'cider-repl-mode) 871 (cider-repl-mode)) 872 (setq nrepl-err-handler #'cider-default-err-handler 873 ;; used as a new-repl marker in cider-set-repl-type 874 mode-name nil 875 cider-session-name ses-name 876 nrepl-project-dir (plist-get params :project-dir) 877 ;; Cljs repls are pending until they are upgraded. See cider-repl--state-handler 878 cider-repl-type (plist-get params :repl-type) 879 cider-repl-cljs-upgrade-pending (plist-get params :cider-repl-cljs-upgrade-pending) 880 ;; ran at the end of cider--connected-handler 881 cider-repl-init-function (plist-get params :repl-init-function) 882 cider-launch-params params) 883 (cider-repl-reset-markers) 884 (add-hook 'nrepl-response-handler-functions #'cider-repl--state-handler nil 'local) 885 (add-hook 'nrepl-connected-hook #'cider--connected-handler nil 'local) 886 (add-hook 'nrepl-disconnected-hook #'cider--disconnected-handler nil 'local) 887 (current-buffer)))) 888 889 890 ;;; Current/other REPLs 891 892 (defun cider--no-repls-user-error (type) 893 "Throw \"No REPL\" user error customized for TYPE." 894 (let ((type (cond 895 ((or (eq type 'multi) (eq type 'any)) 896 "clj or cljs") 897 ((listp type) 898 (mapconcat #'identity type " or ")) 899 (type)))) 900 (user-error "No %s REPLs in current session \"%s\"" 901 type (car (sesman-current-session 'CIDER))))) 902 903 (defun cider-current-repl (&optional type ensure) 904 "Get the most recent REPL of TYPE from the current session. 905 TYPE is either clj, cljs, multi or any. 906 When nil, infer the type from the current buffer. 907 If ENSURE is non-nil, throw an error if either there is 908 no linked session or there is no REPL of TYPE within the current session." 909 (let ((type (cider-maybe-intern type))) 910 (if (and (derived-mode-p 'cider-repl-mode) 911 (or (null type) 912 (eq 'any type) 913 (eq cider-repl-type type))) 914 ;; shortcut when in REPL buffer 915 (current-buffer) 916 (let* ((type (or type (cider-repl-type-for-buffer))) 917 (repls (cider-repls type ensure)) 918 (repl (if (<= (length repls) 1) 919 (car repls) 920 ;; pick the most recent one 921 (seq-find (lambda (b) 922 (member b repls)) 923 (buffer-list))))) 924 (if (and ensure (null repl)) 925 (cider--no-repls-user-error type) 926 repl))))) 927 928 (defun cider--match-repl-type (type buffer) 929 "Return non-nil if TYPE matches BUFFER's REPL type." 930 (let ((buffer-repl-type (cider-repl-type buffer))) 931 (cond ((null buffer-repl-type) nil) 932 ((or (null type) (eq type 'multi) (eq type 'any)) t) 933 ((listp type) (member buffer-repl-type type)) 934 (t 935 (or (string= type buffer-repl-type) 936 (let ((capabilities 937 (buffer-local-value 'cider-connection-capabilities buffer))) 938 (cond ((listp type) 939 (cl-some (lambda (it) (member it capabilities)) type)) 940 (t (member type capabilities))))))))) 941 942 (defun cider--get-host-from-session (session) 943 "Returns the host associated with SESSION." 944 (plist-get (cider--gather-session-params session) 945 :host)) 946 947 (defun cider--make-sessions-list-with-hosts (sessions) 948 "Makes a list of SESSIONS and their hosts. 949 Returns a list of the form ((session1 host1) (session2 host2) ...)." 950 (mapcar (lambda (session) 951 (list session (cider--get-host-from-session session))) 952 sessions)) 953 954 (defun cider--get-sessions-with-same-host (session sessions) 955 "Returns a list of SESSIONS with the same host as SESSION." 956 (mapcar #'car 957 (seq-filter (lambda (x) 958 (string-equal (cadr x) 959 (cider--get-host-from-session session))) 960 (cider--make-sessions-list-with-hosts sessions)))) 961 962 (defun cider--extract-connections (sessions) 963 "Returns a flattened list of all session buffers in SESSIONS." 964 (cl-reduce (lambda (x y) 965 (append x (cdr y))) 966 sessions 967 :initial-value '())) 968 969 (defun cider-repls (&optional type ensure) 970 "Return cider REPLs of TYPE from the current session. 971 If TYPE is nil or multi, return all REPLs. If TYPE is a list of types, 972 return only REPLs of type contained in the list. If ENSURE is non-nil, 973 throw an error if no linked session exists." 974 (let ((type (cond 975 ((listp type) 976 (mapcar #'cider-maybe-intern type)) 977 ((cider-maybe-intern type)))) 978 (repls (pcase cider-merge-sessions 979 ('host 980 (if ensure 981 (or (cider--extract-connections (cider--get-sessions-with-same-host 982 (sesman-current-session 'CIDER) 983 (sesman-current-sessions 'CIDER))) 984 (user-error "No linked %s sessions" 'CIDER)) 985 (cider--extract-connections (cider--get-sessions-with-same-host 986 (sesman-current-session 'CIDER) 987 (sesman-current-sessions 'CIDER))))) 988 ('project 989 (if ensure 990 (or (cider--extract-connections (sesman-current-sessions 'CIDER)) 991 (user-error "No linked %s sessions" 'CIDER)) 992 (cider--extract-connections (sesman-current-sessions 'CIDER)))) 993 (_ (cdr (if ensure 994 (sesman-ensure-session 'CIDER) 995 (sesman-current-session 'CIDER))))))) 996 (or (seq-filter (lambda (b) 997 (unless 998 (cider-cljs-pending-p b) 999 (cider--match-repl-type type b))) 1000 repls) 1001 (when ensure 1002 (cider--no-repls-user-error type))))) 1003 1004 (defun cider-map-repls (which function) 1005 "Call FUNCTION once for each appropriate REPL as indicated by WHICH. 1006 The function is called with one argument, the REPL buffer. The appropriate 1007 connections are found by inspecting the current buffer. WHICH is one of 1008 the following keywords: 1009 :auto - Act on the connections whose type matches the current buffer. In 1010 `cljc' files, mapping happens over both types of REPLs. 1011 :clj (:cljs) - Map over clj (cljs)) REPLs only. 1012 :clj-strict (:cljs-strict) - Map over clj (cljs) REPLs but signal a 1013 `user-error' in `clojurescript-mode' (`clojure-mode'). Use this for 1014 commands only supported in Clojure (ClojureScript). 1015 Error is signaled if no REPL buffers of specified type exist in current 1016 session." 1017 (declare (indent 1)) 1018 (let ((cur-type (cider-repl-type-for-buffer))) 1019 (cl-case which 1020 (:clj-strict (when (eq cur-type 'cljs) 1021 (user-error "Clojure-only operation requested in a ClojureScript buffer"))) 1022 (:cljs-strict (when (eq cur-type 'clj) 1023 (user-error "ClojureScript-only operation requested in a Clojure buffer")))) 1024 (let* ((type (cl-case which 1025 ((:clj :clj-strict) 'clj) 1026 ((:cljs :cljs-strict) 'cljs) 1027 (:auto (if (eq cur-type 'multi) 1028 '(clj cljs) 1029 cur-type)))) 1030 (ensure (cl-case which 1031 (:auto nil) 1032 (t 'ensure))) 1033 (repls (cider-repls type ensure))) 1034 (mapcar function repls)))) 1035 1036 ;; REPLs double as connections in CIDER, so it's useful to be able to refer to 1037 ;; them as connections in certain contexts. 1038 (defalias 'cider-current-connection #'cider-current-repl) 1039 (defalias 'cider-connections #'cider-repls) 1040 (defalias 'cider-map-connections #'cider-map-repls) 1041 (defalias 'cider-connection-type-for-buffer #'cider-repl-type-for-buffer) 1042 1043 ;; Deprecated after #2324 (introduction of sesman) 1044 1045 (define-obsolete-function-alias 'cider-current-repl-buffer #'cider-current-repl "0.18") 1046 (define-obsolete-function-alias 'cider-repl-buffers #'cider-repls "0.18") 1047 (define-obsolete-function-alias 'cider-current-session #'cider-nrepl-eval-session "0.18") 1048 (define-obsolete-function-alias 'cider-current-tooling-session #'cider-nrepl-tooling-session "0.18") 1049 (define-obsolete-function-alias 'nrepl-connection-buffer-name #'nrepl-repl-buffer-name "0.18") 1050 1051 (provide 'cider-connection) 1052 1053 ;;; cider-connection.el ends here