diff options
Diffstat (limited to 'cider-connection.el')
| -rw-r--r-- | cider-connection.el | 172 |
1 files changed, 118 insertions, 54 deletions
diff --git a/cider-connection.el b/cider-connection.el index 959b78e5..0a727fde 100644 --- a/cider-connection.el +++ b/cider-connection.el @@ -1,6 +1,6 @@ ;;; 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 +;; Copyright © 2019 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors ;; ;; Author: Artur Malabarba <bruce.connor.am@gmail.com> ;; Bozhidar Batsov <bozhidar@batsov.com> @@ -156,7 +156,7 @@ buffer." ;; inform sentinel not to kill the server, if any (thread-first (get-buffer-process repl) (process-plist) - (plist-put :no-server-kill t)))) + (plist-put :keep-server t)))) (let ((proc (get-buffer-process repl))) (when (and (process-live-p proc) (or (not nrepl-server-buffer) @@ -167,11 +167,7 @@ buffer." (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)))) + (unless no-kill (kill-buffer repl))) (when repl (sesman-remove-object 'CIDER nil repl (not no-kill) t))) @@ -328,7 +324,7 @@ 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 " "))) + (if genericp "" (upcase (concat (symbol-name cider-repl-type) " "))) (or (cider--project-name nrepl-project-dir) "<no project>") (plist-get nrepl-endpoint :host) (plist-get nrepl-endpoint :port) @@ -421,6 +417,32 @@ REPL defaults to the current REPL." (cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2) (sesman-more-recent-p (cdr session1) (cdr session2))) +(cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session) + (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 (process-live-p proc) + (let* ((classpath (or (process-get proc :cached-classpath) + (let ((cp (with-current-buffer repl + (cider-sync-request:classpath)))) + (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)))) + (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)))))) + (defvar cider-sesman-browser-map (let ((map (make-sparse-keymap))) (define-key map (kbd "j q") #'cider-quit) @@ -532,7 +554,7 @@ removed." "" host)) (repl-type (or (plist-get params :repl-type) "unknown")) - (cljs-repl-type (or (and (equal repl-type "cljs") + (cljs-repl-type (or (and (eq repl-type 'cljs) (plist-get params :cljs-repl-type)) "")) (specs `((?h . ,host) @@ -567,10 +589,10 @@ Session name can be customized with `cider-session-name-template'." ;;; REPL Buffer Init (defvar-local cider-cljs-repl-type nil - "The type of the CLJS runtime (Nashorn, Node etc.)") + "The type of the ClojureScript runtime (Nashorn, Node etc.)") (defvar-local cider-repl-type nil - "The type of this REPL buffer, usually either \"clj\" or \"cljs\".") + "The type of this REPL buffer, usually either clj or cljs.") (defun cider-repl-type (repl-buffer) "Get REPL-BUFFER's type." @@ -579,23 +601,23 @@ Session name can be customized with `cider-session-name-template'." (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. +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") + ((derived-mode-p 'clojurescript-mode) 'cljs) + ((derived-mode-p 'clojurec-mode) 'multi) + ((derived-mode-p 'clojure-mode) 'clj) (cider-repl-type)))) (defun cider-set-repl-type (&optional type) - "Set REPL TYPE to \"clj\" or \"cljs\". + "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"))))) + (let ((type (cider-maybe-intern (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) @@ -609,6 +631,41 @@ Assume that the current buffer is a REPL." (with-current-buffer nrepl-messages-buffer (rename-buffer (nrepl-messages-buffer-name params)))))))) +(defun cider--choose-reusable-repl-buffer (params) + "Find connection-less REPL buffer and ask the user for confirmation. +Return nil if no such buffers exists or the user has chosen not to reuse +the buffer. If multiple dead REPLs exist, ask the user to choose one. +PARAMS is a plist as received by `cider-repl-create'." + (when-let* ((repls (seq-filter (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'cider-repl-mode) + (not (process-live-p (get-buffer-process b)))))) + (buffer-list)))) + (let* ((proj-dir (plist-get params :project-dir)) + (host (plist-get params :host)) + (port (plist-get params :port)) + (cljsp (member (plist-get params :repl-type) '(cljs pending-cljs))) + (scored-repls + (delq nil + (mapcar (lambda (b) + (let ((bparams (cider--gather-connect-params nil b))) + (when (eq cljsp (member (plist-get bparams :repl-type) + '(cljs pending-cljs))) + (cons (buffer-name b) + (+ + (if (equal proj-dir (plist-get bparams :project-dir)) 8 0) + (if (equal host (plist-get bparams :host)) 4 0) + (if (equal port (plist-get bparams :port)) 2 0)))))) + repls)))) + (when scored-repls + (if (> (length scored-repls) 1) + (when (y-or-n-p "Dead REPLs exist. Reuse? ") + (let ((sorted-repls (seq-sort (lambda (a b) (> (cdr a) (cdr b))) scored-repls))) + (get-buffer (completing-read "REPL to reuse: " + (mapcar #'car sorted-repls) nil t nil nil (caar sorted-repls))))) + (when (y-or-n-p (format "A dead REPL %s exists. Reuse? " (caar scored-repls))) + (get-buffer (caar scored-repls)))))))) + (declare-function cider-default-err-handler "cider-eval") (declare-function cider-repl-mode "cider-repl") (declare-function cider-repl--state-handler "cider-repl") @@ -624,6 +681,7 @@ 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) + (cider--choose-reusable-repl-buffer params) (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*")))) (ses-name (or (plist-get params :session-name) (cider-make-session-name params)))) @@ -645,8 +703,8 @@ function with the repl buffer set as current." 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) + (add-hook 'nrepl-connected-hook #'cider--connected-handler nil 'local) + (add-hook 'nrepl-disconnected-hook #'cider--disconnected-handler nil 'local) (current-buffer)))) @@ -655,7 +713,7 @@ function with the repl buffer set as current." (defun cider--no-repls-user-error (type) "Throw \"No REPL\" user error customized for TYPE." (let ((type (cond - ((equal type "multi") + ((or (eq type 'multi) (eq type 'any)) "clj or cljs") ((listp type) (mapconcat #'identity type " or ")) @@ -665,41 +723,47 @@ function with the repl buffer set as current." (defun cider-current-repl (&optional type ensure) "Get the most recent REPL of TYPE from the current session. -TYPE is either \"clj\", \"cljs\" or \"multi\". When nil, infer the type -from the current buffer. If ENSURE is non-nil, throw an error if either -there is no linked session or there is no REPL of TYPE within the current -session." - (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 ensure)) - (repl (if (<= (length repls) 1) - (car repls) - ;; pick the most recent one - (seq-find (lambda (b) - (member b repls)) - (buffer-list))))) - (if (and ensure (null repl)) - (cider--no-repls-user-error type) - repl)))) +TYPE is either clj, cljs, multi or any. +When nil, infer the type from the current buffer. +If ENSURE is non-nil, throw an error if either there is +no linked session or there is no REPL of TYPE within the current session." + (let ((type (cider-maybe-intern type))) + (if (and (derived-mode-p 'cider-repl-mode) + (or (null type) + (eq 'any type) + (eq cider-repl-type type))) + ;; shortcut when in REPL buffer + (current-buffer) + (let* ((type (or type (cider-repl-type-for-buffer))) + (repls (cider-repls type ensure)) + (repl (if (<= (length repls) 1) + (car repls) + ;; pick the most recent one + (seq-find (lambda (b) + (member b repls)) + (buffer-list))))) + (if (and ensure (null repl)) + (cider--no-repls-user-error type) + repl))))) (defun cider--match-repl-type (type buffer) "Return non-nil if TYPE matches BUFFER's REPL type." (let ((buffer-repl-type (cider-repl-type buffer))) (cond ((null buffer-repl-type) nil) - ((or (null type) (equal type "multi")) t) + ((or (null type) (eq type 'multi) (eq type 'any)) t) ((listp type) (member buffer-repl-type type)) (t (string= type buffer-repl-type))))) (defun cider-repls (&optional type ensure) "Return cider REPLs of TYPE from the current session. -If TYPE is nil or \"multi\", return all repls. If TYPE is a list of types, +If TYPE is nil or multi, return all repls. If TYPE is a list of types, return only REPLs of type contained in the list. If ENSURE is non-nil, throw an error if no linked session exists." - (let ((repls (cdr (if ensure + (let ((type (cond + ((listp type) + (mapcar #'cider-maybe-intern type)) + ((cider-maybe-intern type)))) + (repls (cdr (if ensure (sesman-ensure-session 'CIDER) (sesman-current-session 'CIDER))))) (or (seq-filter (lambda (b) @@ -724,15 +788,15 @@ session." (declare (indent 1)) (let ((cur-type (cider-repl-type-for-buffer))) (cl-case which - (:clj-strict (when (equal cur-type "cljs") + (:clj-strict (when (eq cur-type 'cljs) (user-error "Clojure-only operation requested in a ClojureScript buffer"))) - (:cljs-strict (when (equal cur-type "clj") + (:cljs-strict (when (eq cur-type 'clj) (user-error "ClojureScript-only operation requested in a Clojure buffer")))) (let* ((type (cl-case which - ((:clj :clj-strict) "clj") - ((:cljs :cljs-strict) "cljs") - (:auto (if (equal cur-type "multi") - '("clj" "cljs") + ((:clj :clj-strict) 'clj) + ((:cljs :cljs-strict) 'cljs) + (:auto (if (eq cur-type 'multi) + '(clj cljs) cur-type)))) (repls (cider-repls type 'ensure))) (mapcar function repls)))) @@ -764,11 +828,11 @@ session." (make-obsolete 'cider-current-messages-buffer nil "0.18") (make-obsolete 'cider-default-connection "see sesman." "0.18") (make-obsolete 'cider-extract-designation-from-current-repl-buffer nil "0.18") -(make-obsolete 'cider-find-connection-buffer-for-project-directory 'sesman-linked-sessions "0.18") +(make-obsolete 'cider-find-connection-buffer-for-project-directory 'sesman-current-sessions "0.18") (make-obsolete 'cider-find-reusable-repl-buffer nil "0.18") (make-obsolete 'cider-make-connection-default "see sesman." "0.18") (make-obsolete 'cider-other-connection nil "0.18") -(make-obsolete 'cider-project-connections 'sesman-linked-sessions "0.18") +(make-obsolete 'cider-project-connections 'sesman-current-sessions "0.18") (make-obsolete 'cider-project-connections-types nil "0.18") (make-obsolete 'cider-prompt-for-project-on-connect nil "0.18") (make-obsolete 'cider-read-connection `sesman-ask-for-session "0.18") |