;;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*- ;; ;; Copyright © 2018 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors ;; ;; Author: Artur Malabarba ;; Bozhidar Batsov ;; Vitalie Spinu ;; ;; Keywords: languages, clojure, cider ;; ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;; ;; This file is not part of GNU Emacs. ;; ;; ;;; Commentary: ;; ;; ;;; Code: (require 'nrepl-client) (require 'cl-lib) (require 'sesman) (defcustom cider-connection-message-fn #'cider-random-words-of-inspiration "The function to use to generate the message displayed on connect. When set to nil no additional message will be displayed. A good alternative to the default is `cider-random-tip'." :type 'function :group 'cider :package-version '(cider . "0.11.0")) (defcustom cider-redirect-server-output-to-repl t "Controls whether nREPL server output would be redirected to the REPL. When non-nil the output would end up in both the nrepl-server buffer (when available) and the matching REPL buffer." :type 'boolean :group 'cider :safe #'booleanp :package-version '(cider . "0.17.0")) (defconst cider-required-nrepl-version "0.2.12" "The minimum nREPL version that's known to work properly with CIDER.") ;;; Connect (defun cider-nrepl-connect (params) "Start nrepl client and create the REPL. PARAMS is a plist containing :host, :port, :server and other parameters for `cider-repl-create'." (process-buffer (nrepl-start-client-process (plist-get params :host) (plist-get params :port) (plist-get params :server) (lambda (_) (cider-repl-create params))))) (defun cider-connected-p () "Return t if CIDER is currently connected, nil otherwise." (process-live-p (get-buffer-process (cider-current-repl)))) (defun cider-ensure-connected () "Ensure there is a linked CIDER session." (let ((sesman-disambiguate-by-relevance t)) (sesman-ensure-linked-session 'CIDER))) (defun cider--gather-connect-params (proc-buffer) "Gather all relevant for connection parameters in a plist. PROC-BUFFER is either server or client buffer." (with-current-buffer proc-buffer (unless nrepl-endpoint (error "This is not a REPL or SERVER buffer; is there an active REPL?")) (let ((server-buf (if (nrepl-server-p proc-buffer) proc-buffer nrepl-server-buffer))) (append nrepl-endpoint (list :project-dir nrepl-project-dir) (when (buffer-live-p server-buf) (list :server (get-buffer-process server-buf) :server-command nrepl-server-command)) ;; repl-specific parameters (do not pollute server params!) (unless (nrepl-server-p proc-buffer) (list :repl-type cider-repl-type :repl-init-function cider-repl-init-function)))))) (defun cider--close-buffer (buffer) "Close the BUFFER and kill its associated process (if any)." (when (buffer-live-p buffer) (when-let* ((proc (get-buffer-process buffer))) (when (process-live-p proc) (delete-process proc))) (kill-buffer buffer))) (defun cider--close-connection (repl &optional no-kill) "Close connection associated with REPL. When NO-KILL is non-nil stop the connection but don't kill the REPL buffer." (when (buffer-live-p repl) (with-current-buffer repl (when spinner-current (spinner-stop)) (when nrepl-tunnel-buffer (cider--close-buffer nrepl-tunnel-buffer)) (when no-kill ;; inform sentinel not to kill the server, if any (thread-first (get-buffer-process repl) (process-plist) (plist-put :no-server-kill t)))) (let ((proc (get-buffer-process repl))) (when (and (process-live-p proc) (or (not nrepl-server-buffer) ;; Sync request will hang if the server is dead. (process-live-p (get-buffer-process nrepl-server-buffer)))) (nrepl-sync-request:close repl) (delete-process proc))) (when-let* ((messages-buffer (and nrepl-log-messages (nrepl-messages-buffer repl)))) (kill-buffer messages-buffer)) (if no-kill (with-current-buffer repl (goto-char (point-max)) (cider-repl-emit-interactive-stderr (format "*** Closed on %s ***\n" (current-time-string)))) (kill-buffer repl))) (when repl (sesman-remove-object 'CIDER nil repl (not no-kill) t))) (defun cider-emit-manual-warning (section-id format &rest args) "Emit a warning to the REPL and link to the online manual. SECTION-ID is the section to link to. The link is added on the last line. FORMAT is a format string to compile with ARGS and display on the REPL." (let ((message (apply #'format format args))) (cider-repl-emit-interactive-stderr (concat "WARNING: " message "\n " (cider--manual-button "More information" section-id) ".")))) (defvar cider-version) (defun cider--check-required-nrepl-version () "Check whether we're using a compatible nREPL version." (if-let* ((nrepl-version (cider--nrepl-version))) (when (version< nrepl-version cider-required-nrepl-version) (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" "CIDER requires nREPL %s (or newer) to work properly" cider-required-nrepl-version)) (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" "Can't determine nREPL's version.\nPlease, update nREPL to %s." cider-required-nrepl-version))) (defun cider--check-clojure-version-supported () "Ensure that we are meeting the minimum supported version of Clojure." (if-let* ((clojure-version (cider--clojure-version))) (when (version< clojure-version cider-minimum-clojure-version) (cider-emit-manual-warning "installation/#prerequisites" "Clojure version (%s) is not supported (minimum %s). CIDER will not work." clojure-version cider-minimum-clojure-version)) (cider-emit-manual-warning "installation/#prerequisites" "Can't determine Clojure's version. CIDER requires Clojure %s (or newer)." cider-minimum-clojure-version))) (defun cider--check-middleware-compatibility () "CIDER frontend/backend compatibility check. Retrieve the underlying connection's CIDER-nREPL version and checks if the middleware used is compatible with CIDER. If not, will display a warning message in the REPL area." (let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-repl))) (middleware-version (nrepl-dict-get version-dict "version-string" "not installed"))) (unless (equal cider-version middleware-version) (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" "CIDER's version (%s) does not match cider-nrepl's version (%s). Things will break!" cider-version middleware-version)))) (defun cider--subscribe-repl-to-server-out () "Subscribe to the nREPL server's *out*." (cider-nrepl-send-request '("op" "out-subscribe") (cider-interactive-eval-handler (current-buffer)))) (defvar cider-auto-mode) (declare-function cider-enable-on-existing-clojure-buffers "cider-interaction") (declare-function cider--debug-init-connection "cider-debug") (defun cider--connected-handler () "Handle CIDER initialization after nREPL connection has been established. This function is appended to `nrepl-connected-hook' in the client process buffer." ;; `nrepl-connected-hook' is run in the connection buffer ;; `cider-enlighten-mode' changes eval to include the debugger, so we inhibit ;; it here as the debugger isn't necessarily initialized yet (let ((cider-enlighten-mode nil)) ;; after initialization, set mode-line and buffer name. (cider-set-repl-type cider-repl-type) (cider-repl-init (current-buffer)) (cider--check-required-nrepl-version) (cider--check-clojure-version-supported) (cider--check-middleware-compatibility) (when cider-redirect-server-output-to-repl (cider--subscribe-repl-to-server-out)) (when cider-auto-mode (cider-enable-on-existing-clojure-buffers)) ;; Middleware on cider-nrepl's side is deferred until first usage, but ;; loading middleware concurrently can lead to occasional "require" issues ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards ;; the end, allowing for the faster "server-out" middleware to load ;; first. (cider--debug-init-connection) (when cider-repl-init-function (funcall cider-repl-init-function)) (run-hooks 'cider-connected-hook))) (defun cider--disconnected-handler () "Cleanup after nREPL connection has been lost or closed. This function is appended to `nrepl-disconnected-hook' in the client process buffer." ;; `nrepl-connected-hook' is run in the connection buffer (cider-possibly-disable-on-existing-clojure-buffers) (run-hooks 'cider-disconnected-hook)) ;;; Connection Info (defun cider--java-version () "Retrieve the underlying connection's Java version." (with-current-buffer (cider-current-repl) (when nrepl-versions (thread-first nrepl-versions (nrepl-dict-get "java") (nrepl-dict-get "version-string"))))) (defun cider--clojure-version () "Retrieve the underlying connection's Clojure version." (with-current-buffer (cider-current-repl) (when nrepl-versions (thread-first nrepl-versions (nrepl-dict-get "clojure") (nrepl-dict-get "version-string"))))) (defun cider--nrepl-version () "Retrieve the underlying connection's nREPL version." (with-current-buffer (cider-current-repl) (when nrepl-versions (thread-first nrepl-versions (nrepl-dict-get "nrepl") (nrepl-dict-get "version-string"))))) (defun cider--connection-info (connection-buffer &optional genericp) "Return info about CONNECTION-BUFFER. Info contains project name, current REPL namespace, host:port endpoint and Clojure version. When GENERICP is non-nil, don't provide specific info about this buffer (like variable `cider-repl-type')." (with-current-buffer connection-buffer (format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)" (if genericp "" (upcase (concat cider-repl-type " "))) (or (cider--project-name nrepl-project-dir) "") (plist-get nrepl-endpoint :host) (plist-get nrepl-endpoint :port) (cider--java-version) (cider--clojure-version) (cider--nrepl-version)))) ;;; Cider's Connection Management UI (defun cider-quit () "Quit the currently active CIDER connection." (interactive) (cider-ensure-connected) (let ((connection (cider-current-repl))) (cider--close-connection connection)) ;; if there are no more connections we can kill all ancillary buffers (unless (cider-connected-p) (cider-close-ancillary-buffers))) (defun cider-restart () "Restart the currently active CIDER connection. Don't restart the server or other connections within the same session. Use `sesman-restart' to restart the entire session." (interactive) (let* ((repl (or (cider-current-repl) (user-error "No linked REPL"))) (params (thread-first (cider--gather-connect-params repl) (plist-put :session-name (sesman-session-name-for-object 'CIDER repl)) (plist-put :repl-buffer repl)))) (cider--close-connection repl 'no-kill) (cider-nrepl-connect params))) (defun cider-close-ancillary-buffers () "Close buffers that are shared across connections." (interactive) (dolist (buf-name cider-ancillary-buffers) (when (get-buffer buf-name) (kill-buffer buf-name)))) (defun cider-describe-current-connection () "Display information about the current connection." (interactive) (message "%s" (cider--connection-info (cider-current-repl)))) (define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-current-connection "0.18.0") (defun cider-describe-nrepl-session () "Describe an nREPL session." (interactive) (cider-ensure-connected) (let* ((repl (cider-current-repl)) (selected-session (completing-read "Describe nREPL session: " (nrepl-sessions repl)))) (when (and selected-session (not (equal selected-session ""))) (let* ((session-info (nrepl-sync-request:describe repl)) (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) (session-id (nrepl-dict-get session-info "session")) (session-type (cond ((equal session-id (cider-nrepl-eval-session)) "Active eval") ((equal session-id (cider-nrepl-tooling-session)) "Active tooling") (t "Unknown")))) (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer) (read-only-mode -1) (insert (format "Session: %s\n" session-id) (format "Type: %s session\n" session-type) (format "Supported ops:\n")) (mapc (lambda (op) (insert (format " * %s\n" op))) ops))) (display-buffer cider-nrepl-session-buffer)))) ;;; Sesman's Session-Wise Management UI (cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2) (sesman-more-recent-p (cdr session1) (cdr session2))) (cl-defmethod sesman-session-info ((_system (eql CIDER)) session) (interactive "P") (let ((repl (cadr session))) (format "\t%s: %s\n\tREPLS: %s" (if (buffer-local-value 'nrepl-server-buffer repl) "SERVER" "CONNECTION") (cider--connection-info repl t) (mapconcat #'buffer-name (cdr session) ", ")))) (declare-function cider-jack-in-clj&cljs "cider") (cl-defmethod sesman-start-session ((_system (eql CIDER))) "Start a clj session with a cljs REPL if cljs requirements are met." (cider-jack-in-clj&cljs nil t)) (cl-defmethod sesman-quit-session ((_system (eql CIDER)) session) (mapc #'cider--close-connection (cdr session)) ;; if there are no more connections we can kill all ancillary buffers (unless (cider-connected-p) (cider-close-ancillary-buffers))) (cl-defmethod sesman-restart-session ((_system (eql CIDER)) session) (let* ((repls (cdr session)) (s-buf (seq-some (lambda (r) (buffer-local-value 'nrepl-server-buffer r)) repls)) (s-params (cider--gather-connect-params s-buf)) (ses-name (car session))) ;; 1) kill all connections, but keep the buffers (mapc (lambda (conn) (cider--close-connection conn 'no-kill)) repls) ;; 2) kill the server (message "Waiting for CIDER server to quit...") (nrepl-kill-server-buffer s-buf) ;; 3) start server (nrepl-start-server-process (plist-get s-params :project-dir) (plist-get s-params :server-command) (lambda (server-buf) ;; 4) restart the repls reusing the buffer (dolist (r repls) (cider-nrepl-connect ;; server params (:port, :project-dir etc) have precedence (thread-first (append (cider--gather-connect-params server-buf) (cider--gather-connect-params r)) (plist-put :session-name ses-name) (plist-put :repl-buffer r)))) (message "Restarted CIDER %s session" ses-name))))) (defun cider-new-session-name (params) "Create new session name given plist of connection PARAMS." (let* ((dir (or (plist-get params :project-dir) (clojure-project-dir (cider-current-dir)) default-directory)) (host (plist-get params :host)) ;; showing host:port on remotes only (host-port (if (not (or (null host) (equal host "localhost") (equal host "127.0.0.1"))) (format ":%s:%s" host (plist-get params :port)) "")) (root-name (file-name-nondirectory (directory-file-name dir))) (name (format "%s%s" root-name host-port)) (other-names (mapcar #'car (sesman-sessions 'CIDER))) (i 2)) (while (member name other-names) (setq name (concat root-name "#" (number-to-string i)) i (+ i 1))) name)) ;;; REPL Buffer Init (defvar-local cider-repl-type nil "The type of this REPL buffer, usually either \"clj\" or \"cljs\".") (defun cider-repl-type (repl-buffer) "Get REPL-BUFFER's type." (buffer-local-value 'cider-repl-type repl-buffer)) (defun cider-repl-type-for-buffer (&optional buffer) "Return the matching connection type (clj or cljs) for BUFFER. BUFFER defaults to the `current-buffer'. In cljc buffers return \"multi\". This function infers connection type based on the major mode. For the REPL type use the function `cider-repl-type'." (with-current-buffer (or buffer (current-buffer)) (cond ((derived-mode-p 'clojurescript-mode) "cljs") ((derived-mode-p 'clojurec-mode) "multi") ((derived-mode-p 'clojure-mode) "clj") (cider-repl-type)))) (defalias 'cider-connection-type-for-buffer 'cider-repl-type-for-buffer) (defun cider-set-repl-type (&optional type) "Set REPL TYPE to \"clj\" or \"cljs\". Assume that the current buffer is a REPL." (interactive) (let ((type (or type (completing-read (format "Set REPL type (currently `%s') to: " cider-repl-type) '("clj" "cljs"))))) (when (or (not (equal cider-repl-type type)) (null mode-name)) (setq cider-repl-type type) (setq mode-name (format "REPL[%s]" type)) (rename-buffer (nrepl-repl-buffer-name)) (when (and nrepl-log-messages nrepl-messages-buffer) (let ((mbuf-name (nrepl-messages-buffer-name (current-buffer)))) (with-current-buffer nrepl-messages-buffer (rename-buffer mbuf-name))))))) (declare-function cider-default-err-handler "cider-interaction") (defvar-local cider-repl-init-function nil) (defun cider-repl-create (params) "Create new repl buffer. PARAMS is a plist which contains :repl-type, :host, :port, :project-dir, :repl-init-function and :session-name. When non-nil, :repl-init-function must be a function with no arguments which is called after repl creation function with the repl buffer set as current." ;; Connection might not have been set as yet. Please don't send requests in ;; this function, but use cider--connected-handler instead. (let ((buffer (or (plist-get params :repl-buffer) (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*"))))) (with-current-buffer buffer (let ((ses-name (or (plist-get params :session-name) (cider-new-session-name params)))) (sesman-add-object 'CIDER ses-name buffer t)) (unless (derived-mode-p 'cider-repl-mode) (cider-repl-mode)) (setq nrepl-err-handler #'cider-default-err-handler ;; used as a new-repl marker in cider-set-repl-type mode-name nil ;; REPLs start with clj and then "upgrade" to a different type cider-repl-type "clj" ;; ran at the end of cider--connected-handler cider-repl-init-function (plist-get params :repl-init-function)) (cider-repl-reset-markers) (add-hook 'nrepl-response-handler-functions #'cider-repl--state-handler nil 'local) (add-hook 'nrepl-connected-hook 'cider--connected-handler nil 'local) (add-hook 'nrepl-disconnected-hook 'cider--disconnected-handler nil 'local) (current-buffer)))) ;;; Current/other REPLs (defun cider-current-repl (&optional type) "Get the most recent REPL of TYPE from the current session. TYPE is either \"clj\" or \"cljs\". When nil, infer the REPL from the current buffer." (if (and (derived-mode-p 'cider-repl-mode) (or (null type) (string= cider-repl-type type))) ;; shortcut when in REPL buffer (current-buffer) (let* ((type (or type (cider-repl-type-for-buffer))) (repls (cider-repls type))) ;; pick the most recent one (seq-find (lambda (b) (member b repls)) (buffer-list))))) (defun cider-repls (&optional type) "Return cider REPLs of TYPE from the current session. If TYPE is nil, return all repls." (let ((repls (cdr (sesman-current-session 'CIDER)))) (if (or (null type) (equal type "multi")) repls (seq-filter (lambda (b) (string= type (cider-repl-type b))) repls)))) (defun cider-map-repls (which function) "Call FUNCTION once for each appropriate REPL as indicated by WHICH. The function is called with one argument, the REPL buffer. The appropriate connections are found by inspecting the current buffer. WHICH is one of the following keywords: :auto - Act on the connections whose type matches the current buffer. In `cljc' files, mapping happens over both types of REPLs. :clj (:cljs) - Map over clj (cljs)) REPLs only. :clj-strict (:cljs-strict) - Map over clj (cljs) REPLs but signal a `user-error' in `clojurescript-mode' (`clojure-mode'). Use this for commands only supported in Clojure (ClojureScript). Error is signaled if no REPL buffer of specified type exists." (declare (indent 1)) (let ((cur-type (cider-repl-type-for-buffer))) (cl-case which (:clj-strict (when (equal cur-type "cljs") (user-error "Clojure-only operation requested in ClojureScript buffer"))) (:cljs-strict (when (equal cur-type "clj") (user-error "ClojureScript-only operation requested in Clojure buffer")))) (let* ((type (cl-case which ((:clj :clj-strict) "clj") ((:cljs :cljs-strict) "cljs") (:auto cur-type cur-type))) (repls (cider-repls type))) (unless repls ;; cannot happen with "multi" (user-error "No %s REPLs found. Have you linked a session?" type)) (mapcar function repls)))) ;; tmp (defun cider-connections (&optional type) "Return cider REPLs of TYPE from the current session. +If TYPE is nil, return all repls." (let ((repls (cdr (sesman-current-session 'CIDER)))) (if (or (null type) (equal type "multi")) repls (seq-filter (lambda (b) (string= type (cider-repl-type b))) repls)))) (provide 'cider-connection) ;;; cider-connection.el ends here