1130 lines
46 KiB
EmacsLisp
1130 lines
46 KiB
EmacsLisp
;;; cider-client.el --- A layer of abstraction above the actual client code. -*- lexical-binding: t -*-
|
||
|
||
;; Copyright © 2013-2016 Bozhidar Batsov
|
||
;;
|
||
;; Author: Bozhidar Batsov <bozhidar@batsov.com>
|
||
|
||
;; 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 <http://www.gnu.org/licenses/>.
|
||
|
||
;; This file is not part of GNU Emacs.
|
||
|
||
;;; Commentary:
|
||
|
||
;; A layer of abstraction above the actual client code.
|
||
|
||
;;; Code:
|
||
|
||
(require 'spinner)
|
||
(require 'ewoc)
|
||
(require 'nrepl-client)
|
||
(require 'cider-common)
|
||
(require 'cider-util)
|
||
(require 'clojure-mode)
|
||
|
||
(require 'cider-compat)
|
||
(require 'seq)
|
||
|
||
;;; Connection Buffer Management
|
||
|
||
(defcustom cider-request-dispatch 'dynamic
|
||
"Controls the request dispatch mechanism when several connections are present.
|
||
Dynamic dispatch tries to infer the connection based on the current project
|
||
& currently visited file, while static dispatch simply uses the default
|
||
connection.
|
||
|
||
Project metadata is attached to connections when they are created with commands
|
||
like `cider-jack-in' and `cider-connect'."
|
||
:type '(choice (const :tag "dynamic" dynamic)
|
||
(const :tag "static" static))
|
||
:group 'cider
|
||
:package-version '(cider . "0.10.0"))
|
||
|
||
(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"))
|
||
|
||
(defvar cider-connections nil
|
||
"A list of connections.")
|
||
|
||
(defun cider-connected-p ()
|
||
"Return t if CIDER is currently connected, nil otherwise."
|
||
(not (null (cider-connections))))
|
||
|
||
(defun cider-ensure-connected ()
|
||
"Ensure there is a cider connection present.
|
||
An error is signaled in the absence of a connection."
|
||
(unless (cider-connected-p)
|
||
(user-error "`%s' needs an active nREPL connection" this-command)))
|
||
|
||
(defsubst cider--in-connection-buffer-p ()
|
||
"Return non-nil if current buffer is connected to a server."
|
||
(and (derived-mode-p 'cider-repl-mode)
|
||
(process-live-p
|
||
(get-buffer-process (current-buffer)))))
|
||
|
||
(defun cider-default-connection (&optional no-error)
|
||
"The default (fallback) connection to use for nREPL interaction.
|
||
When NO-ERROR is non-nil, don't throw an error when no connection has been
|
||
found."
|
||
(or (car (cider-connections))
|
||
(unless no-error
|
||
(error "No nREPL connection buffer"))))
|
||
|
||
(defun cider-connections ()
|
||
"Return the list of connection buffers.
|
||
If the list is empty and buffer-local, return the global value."
|
||
(or (setq cider-connections
|
||
(seq-filter #'buffer-live-p cider-connections))
|
||
(when (local-variable-p 'cider-connect)
|
||
(kill-local-variable 'cider-connections)
|
||
(seq-filter #'buffer-live-p cider-connections))))
|
||
|
||
(defun cider-repl-buffers ()
|
||
"Return the list of REPL buffers."
|
||
(seq-filter
|
||
(lambda (buffer)
|
||
(with-current-buffer buffer (derived-mode-p 'cider-repl-mode)))
|
||
(buffer-list)))
|
||
|
||
(defun cider-make-connection-default (connection-buffer)
|
||
"Make the nREPL CONNECTION-BUFFER the default connection.
|
||
Moves CONNECTION-BUFFER to the front of variable `cider-connections'."
|
||
(interactive (list (if (cider--in-connection-buffer-p)
|
||
(current-buffer)
|
||
(user-error "Not in a REPL buffer"))))
|
||
;; maintain the connection list in most recently used order
|
||
(let ((buf (get-buffer connection-buffer)))
|
||
(setq cider-connections
|
||
(cons buf (delq buf cider-connections))))
|
||
(cider--connections-refresh))
|
||
|
||
(declare-function cider--close-buffer "cider-interaction")
|
||
(defun cider--close-connection-buffer (conn-buffer)
|
||
"Close CONN-BUFFER, removing it from variable `cider-connections'.
|
||
Also close associated REPL and server buffers."
|
||
(let ((buffer (get-buffer conn-buffer))
|
||
(nrepl-messages-buffer (and nrepl-log-messages
|
||
(nrepl-messages-buffer conn-buffer))))
|
||
(setq cider-connections
|
||
(delq buffer cider-connections))
|
||
(when (buffer-live-p buffer)
|
||
(with-current-buffer buffer
|
||
(when spinner-current (spinner-stop))
|
||
(when nrepl-tunnel-buffer
|
||
(cider--close-buffer nrepl-tunnel-buffer)))
|
||
;; If this is the only (or last) REPL connected to its server, the
|
||
;; kill-process hook will kill the server.
|
||
(cider--close-buffer buffer)
|
||
(when nrepl-messages-buffer
|
||
(kill-buffer nrepl-messages-buffer)))))
|
||
|
||
|
||
;;; Current connection logic
|
||
(defvar-local cider-repl-type "clj"
|
||
"The type of this REPL buffer, usually either \"clj\" or \"cljs\".")
|
||
|
||
(defun cider-find-connection-buffer-for-project-directory (&optional project-directory all-connections)
|
||
"Return the most appropriate connection-buffer for the current project.
|
||
|
||
By order of preference, this is any connection whose directory matches
|
||
`clojure-project-dir', followed by any connection whose directory is nil,
|
||
followed by any connection at all.
|
||
|
||
If PROJECT-DIRECTORY is provided act on that project instead.
|
||
|
||
Only return nil if variable `cider-connections' is empty,
|
||
i.e there are no connections.
|
||
|
||
If more than one connection satisfy a given level of preference, return the
|
||
connection buffer closer to the start of variable `cider-connections'. This is
|
||
usally the connection that was more recently created, but the order can be
|
||
changed. For instance, the function `cider-make-connection-default' can be
|
||
used to move a connection to the head of the list, so that it will take
|
||
precedence over other connections associated with the same project.
|
||
|
||
If ALL-CONNECTIONS is non-nil, the return value is a list and all matching
|
||
connections are returned, instead of just the most recent."
|
||
(when-let ((project-directory (or project-directory
|
||
(clojure-project-dir (cider-current-dir))))
|
||
(fn (if all-connections #'seq-filter #'seq-find)))
|
||
(or (funcall fn (lambda (conn)
|
||
(when-let ((conn-proj-dir (with-current-buffer conn
|
||
nrepl-project-dir)))
|
||
(equal (file-truename project-directory)
|
||
(file-truename conn-proj-dir))))
|
||
cider-connections)
|
||
(funcall fn (lambda (conn)
|
||
(with-current-buffer conn
|
||
(not nrepl-project-dir)))
|
||
cider-connections)
|
||
(if all-connections
|
||
cider-connections
|
||
(car cider-connections)))))
|
||
|
||
(defun cider-read-connection (prompt)
|
||
"Completing read for connections using PROMPT."
|
||
(get-buffer (completing-read prompt (mapcar #'buffer-name (cider-connections)))))
|
||
|
||
(defun cider-assoc-project-with-connection (&optional project connection)
|
||
"Associate a Clojure PROJECT with an nREPL CONNECTION.
|
||
|
||
Useful for connections created using `cider-connect', as for them
|
||
such a link cannot be established automatically."
|
||
(interactive)
|
||
(cider-ensure-connected)
|
||
(let ((conn-buf (or connection (cider-read-connection "Connection: ")))
|
||
(project-dir (or project (read-directory-name "Project directory: " (clojure-project-dir)))))
|
||
(when conn-buf
|
||
(with-current-buffer conn-buf
|
||
(setq nrepl-project-dir project-dir)))))
|
||
|
||
(defun cider-assoc-buffer-with-connection ()
|
||
"Associate the current buffer with a connection.
|
||
|
||
Useful for connections created using `cider-connect', as for them
|
||
such a link cannot be established automatically."
|
||
(interactive)
|
||
(cider-ensure-connected)
|
||
(let ((conn (cider-read-connection "Connection: ")))
|
||
(when conn
|
||
(setq-local cider-connections (list conn)))))
|
||
|
||
(defun cider-clear-buffer-local-connection ()
|
||
"Remove association between the current buffer and a connection."
|
||
(interactive)
|
||
(cider-ensure-connected)
|
||
(kill-local-variable 'cider-connections))
|
||
|
||
(defun cider-connection-type-for-buffer ()
|
||
"Return the matching connection type (clj or cljs) for the current buffer."
|
||
(cond
|
||
((derived-mode-p 'clojurescript-mode) "cljs")
|
||
((derived-mode-p 'clojure-mode) "clj")
|
||
(cider-repl-type)
|
||
(t "clj")))
|
||
|
||
(defun cider-toggle-request-dispatch ()
|
||
"Toggles the value of `cider-request-dispatch' between static and dynamic.
|
||
|
||
Handy when you're using dynamic dispatch, but you want to quickly force all
|
||
evaluation commands to use a particular connection."
|
||
(interactive)
|
||
(let ((new-value (if (eq cider-request-dispatch 'static) 'dynamic 'static)))
|
||
(setq cider-request-dispatch new-value)
|
||
(message "Toggled CIDER request dispatch to %s." new-value)))
|
||
|
||
(defun cider-current-connection (&optional type)
|
||
"Return the REPL buffer relevant for the current Clojure source buffer.
|
||
A REPL is relevant if its `nrepl-project-dir' is compatible with the
|
||
current directory (see `cider-find-connection-buffer-for-project-directory').
|
||
|
||
If TYPE is provided, it is either \"clj\" or \"cljs\", and only a
|
||
connection of that type is returned. If no connections of that TYPE exist,
|
||
return nil.
|
||
|
||
If TYPE is nil, then connections whose type matches the current file
|
||
extension are given preference, but if none exist, any connection is
|
||
returned. In this case, only return nil if there are no active connections
|
||
at all."
|
||
;; If TYPE was specified, we only return that type (or nil). OW, we prefer
|
||
;; that TYPE, but ultimately allow any type.
|
||
(cl-labels ((right-type-p
|
||
(c)
|
||
(when (or (not type)
|
||
(and (buffer-live-p c)
|
||
(with-current-buffer c (equal cider-repl-type type))))
|
||
c)))
|
||
(let ((connections (cider-connections)))
|
||
(cond
|
||
((not connections) nil)
|
||
;; if you're in a REPL buffer, it's the connection buffer
|
||
((and (derived-mode-p 'cider-repl-mode) (right-type-p (current-buffer))))
|
||
((eq cider-request-dispatch 'static) (car connections))
|
||
((= 1 (length connections)) (right-type-p (car connections)))
|
||
(t (let ((project-connections (cider-find-connection-buffer-for-project-directory
|
||
nil :all-connections))
|
||
(guessed-type (or type (cider-connection-type-for-buffer))))
|
||
;; So we have multiple connections. Look for the connection type we
|
||
;; want, prioritizing the current project.
|
||
(or (seq-find (lambda (conn)
|
||
(equal (cider--connection-type conn) guessed-type))
|
||
project-connections)
|
||
(seq-find (lambda (conn)
|
||
(equal (cider--connection-type conn) guessed-type))
|
||
connections)
|
||
(right-type-p (car project-connections))
|
||
(right-type-p (car connections)))))))))
|
||
|
||
(defun cider-other-connection (&optional connection)
|
||
"Return the first connection of another type than CONNECTION.
|
||
Only return connections in the same project or nil.
|
||
CONNECTION defaults to `cider-current-connection'."
|
||
(when-let ((connection (or connection (cider-current-connection)))
|
||
(connection-type (cider--connection-type connection)))
|
||
(cider-current-connection (pcase connection-type
|
||
(`"clj" "cljs")
|
||
(_ "clj")))))
|
||
|
||
(defvar cider--has-warned-about-bad-repl-type nil)
|
||
|
||
(defun cider--guess-cljs-connection ()
|
||
"Hacky way to find a ClojureScript REPL.
|
||
DO NOT USE THIS FUNCTION.
|
||
It was written only to be used in `cider-map-connections', as a workaround
|
||
to a still-undetermined bug in the state-stracker backend."
|
||
(when-let ((project-connections (cider-find-connection-buffer-for-project-directory
|
||
nil :all-connections))
|
||
(cljs-conn
|
||
;; So we have multiple connections. Look for the connection type we
|
||
;; want, prioritizing the current project.
|
||
(or (seq-find (lambda (c) (string-match "\\bCLJS\\b" (buffer-name c)))
|
||
project-connections)
|
||
(seq-find (lambda (c) (string-match "\\bCLJS\\b" (buffer-name c)))
|
||
(cider-connections)))))
|
||
(unless cider--has-warned-about-bad-repl-type
|
||
(setq cider--has-warned-about-bad-repl-type t)
|
||
(read-key
|
||
(concat "The ClojureScript REPL seems to be is misbehaving."
|
||
(substitute-command-keys
|
||
"\nWe have applied a workaround, but please also file a bug report with `\\[cider-report-bug]'.")
|
||
"\nPress any key to continue.")))
|
||
cljs-conn))
|
||
|
||
(defun cider-map-connections (function which &optional any-mode)
|
||
"Call FUNCTION once for each appropriate connection.
|
||
The function is called with one argument, the connection buffer.
|
||
The appropriate connections are found by inspecting the current buffer. If
|
||
the buffer is associated with a .cljc or .cljx file, BODY will be executed
|
||
multiple times.
|
||
|
||
WHICH is one of the following keywords identifying which connections to map
|
||
over.
|
||
:any - Act the connection whose type matches the current buffer.
|
||
:clj - Like :any, but signal a `user-error' in `clojurescript-mode' or if
|
||
there is no Clojure connection (use this for commands only
|
||
supported in Clojure).
|
||
:cljs - Like :clj, but demands a ClojureScript connection instead.
|
||
:both - In `clojurec-mode' or `clojurex-mode' act on both connections,
|
||
otherwise function like :any. Obviously, this option might run
|
||
FUNCTION twice.
|
||
|
||
If ANY-MODE is non-nil, :clj and :cljs don't signal errors due to being in
|
||
the wrong major mode (they still signal if the desired connection type
|
||
doesn't exist). Use this for commands that only apply to a specific
|
||
connection but can be invoked from any buffer (like `cider-refresh')."
|
||
(cl-labels ((err (msg) (user-error (concat "`%s' " msg) this-command)))
|
||
;; :both in a clj or cljs buffer just means :any.
|
||
(let* ((which (if (and (eq which :both)
|
||
(not (cider--cljc-or-cljx-buffer-p)))
|
||
:any
|
||
which))
|
||
(curr
|
||
(pcase which
|
||
(`:any (let ((type (cider-connection-type-for-buffer)))
|
||
(or (cider-current-connection type)
|
||
(when (equal type "cljs")
|
||
(cider--guess-cljs-connection))
|
||
(err (substitute-command-keys
|
||
(format "needs a Clojure%s REPL.\nIf you don't know what that means, you probably need to jack-in (%s)."
|
||
(if (equal type "cljs") "Script" "")
|
||
(if (equal type "cljs") "`\\[cider-jack-in-clojurescript]'" "`\\[cider-jack-in]'")))))))
|
||
(`:both (or (cider-current-connection)
|
||
(err "needs an active REPL connection")))
|
||
(`:clj (cond ((and (not any-mode)
|
||
(derived-mode-p 'clojurescript-mode))
|
||
(err "doesn't support ClojureScript"))
|
||
((cider-current-connection "clj"))
|
||
((err "needs a Clojure REPL"))))
|
||
(`:cljs (cond ((and (not any-mode)
|
||
(eq major-mode 'clojure-mode))
|
||
(err "doesn't support Clojure"))
|
||
((cider-current-connection "cljs"))
|
||
((err "needs a ClojureScript REPL")))))))
|
||
(funcall function curr)
|
||
(when (eq which :both)
|
||
(when-let ((other-connection (cider-other-connection curr)))
|
||
(funcall function other-connection))))))
|
||
|
||
|
||
;;; Connection Browser
|
||
(defvar cider-connections-buffer-mode-map
|
||
(let ((map (make-sparse-keymap)))
|
||
(define-key map "d" #'cider-connections-make-default)
|
||
(define-key map "g" #'cider-connection-browser)
|
||
(define-key map "k" #'cider-connections-close-connection)
|
||
(define-key map (kbd "RET") #'cider-connections-goto-connection)
|
||
(define-key map "?" #'describe-mode)
|
||
(define-key map "h" #'describe-mode)
|
||
map))
|
||
|
||
(declare-function cider-popup-buffer-mode "cider-popup")
|
||
(define-derived-mode cider-connections-buffer-mode cider-popup-buffer-mode
|
||
"CIDER Connections"
|
||
"CIDER Connections Buffer Mode.
|
||
\\{cider-connections-buffer-mode-map}
|
||
\\{cider-popup-buffer-mode-map}"
|
||
(setq-local truncate-lines t))
|
||
|
||
(defvar cider--connection-ewoc)
|
||
(defconst cider--connection-browser-buffer-name "*cider-connections*")
|
||
|
||
(defun cider-connection-browser ()
|
||
"Open a browser buffer for nREPL connections."
|
||
(interactive)
|
||
(if-let ((buffer (get-buffer cider--connection-browser-buffer-name)))
|
||
(progn
|
||
(cider--connections-refresh-buffer buffer)
|
||
(unless (get-buffer-window buffer)
|
||
(select-window (display-buffer buffer))))
|
||
(cider--setup-connection-browser)))
|
||
|
||
(defun cider--connections-refresh ()
|
||
"Refresh the connections buffer, if the buffer exists.
|
||
The connections buffer is determined by
|
||
`cider--connection-browser-buffer-name'"
|
||
(when-let ((buffer (get-buffer cider--connection-browser-buffer-name)))
|
||
(cider--connections-refresh-buffer buffer)))
|
||
|
||
(add-hook 'nrepl-disconnected-hook #'cider--connections-refresh)
|
||
|
||
(defun cider--connections-refresh-buffer (buffer)
|
||
"Refresh the connections BUFFER."
|
||
(cider--update-connections-display
|
||
(buffer-local-value 'cider--connection-ewoc buffer)
|
||
cider-connections))
|
||
|
||
(defun cider--setup-connection-browser ()
|
||
"Create a browser buffer for nREPL connections."
|
||
(with-current-buffer (get-buffer-create cider--connection-browser-buffer-name)
|
||
(let ((ewoc (ewoc-create
|
||
'cider--connection-pp
|
||
" REPL Host Port Project Type\n")))
|
||
(setq-local cider--connection-ewoc ewoc)
|
||
(cider--update-connections-display ewoc cider-connections)
|
||
(setq buffer-read-only t)
|
||
(cider-connections-buffer-mode)
|
||
(display-buffer (current-buffer)))))
|
||
|
||
(defun cider-client-name-repl-type (type)
|
||
"Return a human-readable name for a connection TYPE.
|
||
TYPE can be any of the possible values of `cider-repl-type'."
|
||
(pcase type
|
||
("clj" "Clojure")
|
||
("cljs" "ClojureScript")
|
||
(_ "Unknown")))
|
||
|
||
(defun cider-project-name (project-dir)
|
||
"Extract the project name from PROJECT-DIR."
|
||
(if (and project-dir (not (equal project-dir "")))
|
||
(file-name-nondirectory (directory-file-name project-dir))
|
||
"-"))
|
||
|
||
(defun cider--connection-pp (connection)
|
||
"Print an nREPL CONNECTION to the current buffer."
|
||
(let* ((buffer-read-only nil)
|
||
(buffer (get-buffer connection))
|
||
(project-name (cider-project-name (buffer-local-value 'nrepl-project-dir buffer)))
|
||
(repl-type (cider-client-name-repl-type (buffer-local-value 'cider-repl-type buffer)))
|
||
(endpoint (buffer-local-value 'nrepl-endpoint buffer)))
|
||
(insert
|
||
(format "%s %-30s %-16s %5s %-16s %s"
|
||
(if (equal connection (car cider-connections)) "*" " ")
|
||
(buffer-name connection)
|
||
(car endpoint)
|
||
(prin1-to-string (cadr endpoint))
|
||
project-name
|
||
repl-type))))
|
||
|
||
(defun cider--update-connections-display (ewoc connections)
|
||
"Update the connections EWOC to show CONNECTIONS."
|
||
(ewoc-filter ewoc (lambda (n) (member n connections)))
|
||
(let ((existing))
|
||
(ewoc-map (lambda (n) (setq existing (cons n existing))) ewoc)
|
||
(let ((added (seq-difference connections existing)))
|
||
(mapc (apply-partially 'ewoc-enter-last ewoc) added)
|
||
(save-excursion (ewoc-refresh ewoc)))))
|
||
|
||
(defun cider--ewoc-apply-at-point (f)
|
||
"Apply function F to the ewoc node at point.
|
||
F is a function of two arguments, the ewoc and the data at point."
|
||
(let* ((ewoc cider--connection-ewoc)
|
||
(node (and ewoc (ewoc-locate ewoc))))
|
||
(when node
|
||
(funcall f ewoc (ewoc-data node)))))
|
||
|
||
(defun cider-connections-make-default ()
|
||
"Make default the connection at point in the connection browser."
|
||
(interactive)
|
||
(save-excursion
|
||
(cider--ewoc-apply-at-point #'cider--connections-make-default)))
|
||
|
||
(defun cider--connections-make-default (ewoc data)
|
||
"Make the connection in EWOC specified by DATA default.
|
||
Refreshes EWOC."
|
||
(interactive)
|
||
(cider-make-connection-default data)
|
||
(ewoc-refresh ewoc))
|
||
|
||
(defun cider-connections-close-connection ()
|
||
"Close connection at point in the connection browser."
|
||
(interactive)
|
||
(cider--ewoc-apply-at-point #'cider--connections-close-connection))
|
||
|
||
(defun cider--connections-close-connection (ewoc data)
|
||
"Close the connection in EWOC specified by DATA."
|
||
(cider--close-connection-buffer (get-buffer data))
|
||
(cider--update-connections-display ewoc cider-connections))
|
||
|
||
(defun cider-connections-goto-connection ()
|
||
"Goto connection at point in the connection browser."
|
||
(interactive)
|
||
(cider--ewoc-apply-at-point #'cider--connections-goto-connection))
|
||
|
||
(defun cider--connections-goto-connection (_ewoc data)
|
||
"Goto the REPL for the connection in _EWOC specified by DATA."
|
||
(when (buffer-live-p data)
|
||
(select-window (display-buffer data))))
|
||
|
||
|
||
(defun cider-display-connected-message ()
|
||
"Message displayed on successful connection."
|
||
(message
|
||
(concat "Connected."
|
||
(if cider-connection-message-fn
|
||
(format " %s" (funcall cider-connection-message-fn))
|
||
""))))
|
||
|
||
;; TODO: Replace direct usage of such hooks with CIDER hooks,
|
||
;; that are connection type independent
|
||
(add-hook 'nrepl-connected-hook 'cider-display-connected-message)
|
||
|
||
|
||
;;; Eval spinner
|
||
(defcustom cider-eval-spinner-type 'progress-bar
|
||
"Appearance of the evaluation spinner.
|
||
|
||
Value is a symbol. The possible values are the symbols in the
|
||
`spinner-types' variable."
|
||
:type 'symbol
|
||
:group 'cider
|
||
:package-version '(cider . "0.10.0"))
|
||
|
||
(defcustom cider-show-eval-spinner t
|
||
"When true, show the evaluation spinner in the mode line."
|
||
:type 'boolean
|
||
:group 'cider
|
||
:package-version '(cider . "0.10.0"))
|
||
|
||
(defcustom cider-eval-spinner-delay 1
|
||
"Amount of time, in seconds, after which the evaluation spinner will be shown."
|
||
:type 'integer
|
||
:group 'cider
|
||
:package-version '(cider . "0.10.0"))
|
||
|
||
(defun cider-spinner-start (buffer)
|
||
"Start the evaluation spinner in BUFFER.
|
||
Do nothing if `cider-show-eval-spinner' is nil."
|
||
(when cider-show-eval-spinner
|
||
(with-current-buffer buffer
|
||
(spinner-start cider-eval-spinner-type nil
|
||
cider-eval-spinner-delay))))
|
||
|
||
(defun cider-eval-spinner-handler (eval-buffer original-callback)
|
||
"Return a response handler to stop the spinner and call ORIGINAL-CALLBACK.
|
||
EVAL-BUFFER is the buffer where the spinner was started."
|
||
(lambda (response)
|
||
;; buffer still exists and
|
||
;; we've got status "done" from nrepl
|
||
;; stop the spinner
|
||
(when (and (buffer-live-p eval-buffer)
|
||
(let ((status (nrepl-dict-get response "status")))
|
||
(or (member "done" status)
|
||
(member "eval-error" status)
|
||
(member "error" status))))
|
||
(with-current-buffer eval-buffer
|
||
(when spinner-current (spinner-stop))))
|
||
(funcall original-callback response)))
|
||
|
||
|
||
;;; Evaluation helpers
|
||
(defun cider-ns-form-p (form)
|
||
"Check if FORM is an ns form."
|
||
(string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form))
|
||
|
||
(defvar-local cider-buffer-ns nil
|
||
"Current Clojure namespace of some buffer.
|
||
|
||
Useful for special buffers (e.g. REPL, doc buffers) that have to
|
||
keep track of a namespace.
|
||
|
||
This should never be set in Clojure buffers, as there the namespace
|
||
should be extracted from the buffer's ns form.")
|
||
|
||
(defun cider-current-ns (&optional no-default)
|
||
"Return the current ns.
|
||
The ns is extracted from the ns form for Clojure buffers and from
|
||
`cider-buffer-ns' for all other buffers. If it's missing, use the current
|
||
REPL's ns, otherwise fall back to \"user\".
|
||
|
||
When NO-DEFAULT is non-nil, it will return nil instead of \"user\"."
|
||
(or cider-buffer-ns
|
||
(clojure-find-ns)
|
||
(when-let ((repl-buf (cider-current-connection)))
|
||
(buffer-local-value 'cider-buffer-ns repl-buf))
|
||
(if no-default nil "user")))
|
||
|
||
(defun cider-expected-ns (&optional path)
|
||
"Return the namespace string matching PATH, or nil if not found.
|
||
|
||
PATH is expected to be an absolute file path.
|
||
If PATH is nil, use the path to the file backing the current buffer.
|
||
|
||
The command falls back to `clojure-expected-ns' in the absence of an
|
||
active nREPL connection."
|
||
(if (cider-connected-p)
|
||
(let* ((path (or path (file-truename (buffer-file-name))))
|
||
(relpath (thread-last (cider-sync-request:classpath)
|
||
(seq-map
|
||
(lambda (cp)
|
||
(when (string-prefix-p cp path)
|
||
(substring path (length cp)))))
|
||
(seq-filter #'identity)
|
||
(seq-sort (lambda (a b)
|
||
(< (length a) (length b))))
|
||
(car))))
|
||
(if relpath
|
||
(thread-last (substring relpath 1) ; remove leading /
|
||
(file-name-sans-extension)
|
||
(replace-regexp-in-string "/" ".")
|
||
(replace-regexp-in-string "_" "-"))
|
||
(clojure-expected-ns path)))
|
||
(clojure-expected-ns path)))
|
||
|
||
(defun cider-nrepl-op-supported-p (op)
|
||
"Check whether the current connection supports the nREPL middleware OP."
|
||
(nrepl-op-supported-p op (cider-current-connection)))
|
||
|
||
(defvar cider-version)
|
||
(defun cider-ensure-op-supported (op)
|
||
"Check for support of middleware op OP.
|
||
Signal an error if it is not supported."
|
||
(unless (cider-nrepl-op-supported-p op)
|
||
(user-error "`%s' requires the nREPL op \"%s\". Please, install (or update) cider-nrepl %s and restart CIDER" this-command op (upcase cider-version))))
|
||
|
||
(defun cider-nrepl-send-request (request callback &optional connection)
|
||
"Send REQUEST and register response handler CALLBACK.
|
||
REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\"
|
||
\"par1\" ... ).
|
||
If CONNECTION is provided dispatch to that connection instead of
|
||
the current connection.
|
||
|
||
Return the id of the sent message."
|
||
(nrepl-send-request request callback (or connection (cider-current-connection))))
|
||
|
||
(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input)
|
||
"Send REQUEST to the nREPL server synchronously using CONNECTION.
|
||
Hold till final \"done\" message has arrived and join all response messages
|
||
of the same \"op\" that came along and return the accumulated response.
|
||
If ABORT-ON-INPUT is non-nil, the function will return nil
|
||
at the first sign of user input, so as not to hang the
|
||
interface."
|
||
(nrepl-send-sync-request request
|
||
(or connection (cider-current-connection))
|
||
abort-on-input))
|
||
|
||
(defun cider-nrepl-send-unhandled-request (request)
|
||
"Send REQUEST to the nREPL server and ignore any responses.
|
||
Immediately mark the REQUEST as done.
|
||
Return the id of the sent message."
|
||
(let* ((conn (cider-current-connection))
|
||
(id (nrepl-send-request request #'ignore conn)))
|
||
(with-current-buffer conn
|
||
(nrepl--mark-id-completed id))
|
||
id))
|
||
|
||
(defun cider-nrepl-request:eval (input callback &optional ns line column additional-params)
|
||
"Send the request INPUT and register the CALLBACK as the response handler.
|
||
If NS is non-nil, include it in the request. LINE and COLUMN, if non-nil,
|
||
define the position of INPUT in its buffer. ADDITIONAL-PARAMS is a plist
|
||
to be appended to the request message."
|
||
(let ((connection (cider-current-connection)))
|
||
(nrepl-request:eval input
|
||
(if cider-show-eval-spinner
|
||
(cider-eval-spinner-handler connection callback)
|
||
callback)
|
||
connection
|
||
(cider-current-session)
|
||
ns line column additional-params)
|
||
(cider-spinner-start connection)))
|
||
|
||
(defun cider-nrepl-sync-request:eval (input &optional ns)
|
||
"Send the INPUT to the nREPL server synchronously.
|
||
If NS is non-nil, include it in the request."
|
||
(nrepl-sync-request:eval
|
||
input
|
||
(cider-current-connection)
|
||
(cider-current-session)
|
||
ns))
|
||
|
||
(defcustom cider-pprint-fn 'pprint
|
||
"Sets the function to use when pretty-printing evaluation results.
|
||
|
||
The value must be one of the following symbols:
|
||
|
||
`pprint' - to use \\=`clojure.pprint/pprint\\=`
|
||
|
||
`fipp' - to use the Fast Idiomatic Pretty Printer, approximately 5-10x
|
||
faster than \\=`clojure.core/pprint\\=` (this is the default)
|
||
|
||
`puget' - to use Puget, which provides canonical serialization of data on
|
||
top of fipp, but at a slight performance cost
|
||
|
||
Alternatively, can be the namespace-qualified name of a Clojure function of
|
||
one argument. If the function cannot be resolved, an exception will be
|
||
thrown.
|
||
|
||
The function is assumed to respect the contract of \\=`clojure.pprint/pprint\\=`
|
||
with respect to the bound values of \\=`*print-length*\\=`, \\=`*print-level*\\=`,
|
||
\\=`*print-meta*\\=`, and \\=`clojure.pprint/*print-right-margin*\\=`."
|
||
:type '(choice (const pprint)
|
||
(const fipp)
|
||
(const puget)
|
||
string)
|
||
:group 'cider
|
||
:package-version '(cider . "0.11.0"))
|
||
|
||
(defun cider--pprint-fn ()
|
||
"Return the value to send in the pprint-fn slot of messages."
|
||
(pcase cider-pprint-fn
|
||
(`pprint "clojure.pprint/pprint")
|
||
(`fipp "cider.nrepl.middleware.pprint/fipp-pprint")
|
||
(`puget "cider.nrepl.middleware.pprint/puget-pprint")
|
||
(_ cider-pprint-fn)))
|
||
|
||
(defun cider--nrepl-pprint-request-plist (right-margin &optional pprint-fn)
|
||
"Plist to be appended to an eval request to make it use pprint.
|
||
PPRINT-FN is the name of the Clojure function to use.
|
||
RIGHT-MARGIN specifies the maximum column-width of the pretty-printed
|
||
result, and is included in the request if non-nil."
|
||
(append (list "pprint" "true"
|
||
"pprint-fn" (or pprint-fn (cider--pprint-fn)))
|
||
(and right-margin (list "print-right-margin" right-margin))))
|
||
|
||
(defun cider-tooling-eval (input callback &optional ns)
|
||
"Send the request INPUT and register the CALLBACK as the response handler.
|
||
NS specifies the namespace in which to evaluate the request."
|
||
;; namespace forms are always evaluated in the "user" namespace
|
||
(nrepl-request:eval input
|
||
callback
|
||
(cider-current-connection)
|
||
(cider-current-tooling-session)
|
||
ns))
|
||
|
||
(defalias 'cider-current-repl-buffer #'cider-current-connection
|
||
"The current REPL buffer.
|
||
Return the REPL buffer given by `cider-current-connection'.")
|
||
|
||
(declare-function cider-interrupt-handler "cider-interaction")
|
||
(defun cider-interrupt ()
|
||
"Interrupt any pending evaluations."
|
||
(interactive)
|
||
(with-current-buffer (cider-current-connection)
|
||
(let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests)))
|
||
(dolist (request-id pending-request-ids)
|
||
(nrepl-request:interrupt
|
||
request-id
|
||
(cider-interrupt-handler (current-buffer))
|
||
(cider-current-connection)
|
||
(cider-current-session))))))
|
||
|
||
(defun cider-current-session ()
|
||
"The REPL session to use for this buffer."
|
||
(with-current-buffer (cider-current-connection)
|
||
nrepl-session))
|
||
|
||
(defun cider-current-messages-buffer ()
|
||
"The nREPL messages buffer, matching the current connection."
|
||
(nrepl-messages-buffer (cider-current-connection)))
|
||
|
||
(defun cider-current-tooling-session ()
|
||
"Return the current tooling session."
|
||
(with-current-buffer (cider-current-connection)
|
||
nrepl-tooling-session))
|
||
|
||
(defun cider--var-choice (var-info)
|
||
"Prompt to choose from among multiple VAR-INFO candidates, if required.
|
||
This is needed only when the symbol queried is an unqualified host platform
|
||
method, and multiple classes have a so-named member. If VAR-INFO does not
|
||
contain a `candidates' key, it is returned as is."
|
||
(let ((candidates (nrepl-dict-get var-info "candidates")))
|
||
(if candidates
|
||
(let* ((classes (nrepl-dict-keys candidates))
|
||
(choice (completing-read "Member in class: " classes nil t))
|
||
(info (nrepl-dict-get candidates choice)))
|
||
info)
|
||
var-info)))
|
||
|
||
(defun cider-var-info (var &optional all)
|
||
"Return VAR's info as an alist with list cdrs.
|
||
When multiple matching vars are returned you'll be prompted to select one,
|
||
unless ALL is truthy."
|
||
(when (and var (not (string= var "")))
|
||
(let ((var-info (cider-sync-request:info var)))
|
||
(if all var-info (cider--var-choice var-info)))))
|
||
|
||
(defun cider-member-info (class member)
|
||
"Return the CLASS MEMBER's info as an alist with list cdrs."
|
||
(when (and class member)
|
||
(cider-sync-request:info nil class member)))
|
||
|
||
(defun cider--find-var-other-window (var &optional line)
|
||
"Find the definition of VAR, optionally at a specific LINE.
|
||
|
||
Display the results in a different window."
|
||
(if-let ((info (cider-var-info var)))
|
||
(progn
|
||
(if line (setq info (nrepl-dict-put info "line" line)))
|
||
(cider--jump-to-loc-from-info info t))
|
||
(user-error "Symbol %s not resolved" var)))
|
||
|
||
(defun cider--find-var (var &optional line)
|
||
"Find the definition of VAR, optionally at a specific LINE."
|
||
(if-let ((info (cider-var-info var)))
|
||
(progn
|
||
(if line (setq info (nrepl-dict-put info "line" line)))
|
||
(cider--jump-to-loc-from-info info))
|
||
(user-error "Symbol %s not resolved" var)))
|
||
|
||
(defun cider-find-var (&optional arg var line)
|
||
"Find definition for VAR at LINE.
|
||
|
||
Prompt according to prefix ARG and `cider-prompt-for-symbol'.
|
||
A single or double prefix argument inverts the meaning of
|
||
`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes
|
||
the results to be displayed in a different window. The default value is
|
||
thing at point."
|
||
(interactive "P")
|
||
(cider-ensure-op-supported "info")
|
||
(if var
|
||
(cider--find-var var line)
|
||
(funcall (cider-prompt-for-symbol-function arg)
|
||
"Symbol"
|
||
(if (cider--open-other-window-p arg)
|
||
#'cider--find-var-other-window
|
||
#'cider--find-var))))
|
||
|
||
|
||
;;; Requests
|
||
|
||
(declare-function cider-load-file-handler "cider-interaction")
|
||
(defun cider-request:load-file (file-contents file-path file-name &optional connection callback)
|
||
"Perform the nREPL \"load-file\" op.
|
||
FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be
|
||
loaded.
|
||
|
||
If CONNECTION is nil, use `cider-current-connection'.
|
||
If CALLBACK is nil, use `cider-load-file-handler'."
|
||
(cider-nrepl-send-request (list "op" "load-file"
|
||
"session" (cider-current-session)
|
||
"file" file-contents
|
||
"file-path" file-path
|
||
"file-name" file-name)
|
||
(or callback
|
||
(cider-load-file-handler (current-buffer)))
|
||
connection))
|
||
|
||
|
||
;;; Sync Requests
|
||
|
||
(defcustom cider-filtered-namespaces-regexps
|
||
'("^cider.nrepl" "^refactor-nrepl" "^clojure.tools.nrepl")
|
||
"List of regexps used to filter out some vars/symbols/namespaces.
|
||
When nil, nothing is filtered out. Otherwise, all namespaces matching any
|
||
regexp from this list are dropped out of the \"ns-list\" op.
|
||
Also, \"apropos\" won't include vars from such namespaces.
|
||
This list is passed on to the nREPL middleware without any pre-processing.
|
||
So the regexps have to be in Clojure format (with twice the number of
|
||
backslashes) and not Emacs Lisp."
|
||
:type '(repeat string)
|
||
:safe #'listp
|
||
:group 'cider
|
||
:package-version '(cider . "0.13.0"))
|
||
|
||
(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p)
|
||
"Send \"apropos\" request for regexp QUERY.
|
||
|
||
Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P."
|
||
(let* ((query (replace-regexp-in-string "[ \t]+" ".+" query))
|
||
(response (cider-nrepl-send-sync-request
|
||
`("op" "apropos"
|
||
"session" ,(cider-current-session)
|
||
"ns" ,(cider-current-ns)
|
||
"query" ,query
|
||
,@(when search-ns `("search-ns" ,search-ns))
|
||
,@(when docs-p '("docs?" "t"))
|
||
,@(when privates-p '("privates?" "t"))
|
||
,@(when case-sensitive-p '("case-sensitive?" "t"))
|
||
"filter-regexps" ,cider-filtered-namespaces-regexps))))
|
||
(if (member "apropos-regexp-error" (nrepl-dict-get response "status"))
|
||
(user-error "Invalid regexp: %s" (nrepl-dict-get response "error-msg"))
|
||
(nrepl-dict-get response "apropos-matches"))))
|
||
|
||
(defun cider-sync-request:classpath ()
|
||
"Return a list of classpath entries."
|
||
(cider-ensure-op-supported "classpath")
|
||
(thread-first (list "op" "classpath"
|
||
"session" (cider-current-session))
|
||
(cider-nrepl-send-sync-request)
|
||
(nrepl-dict-get "classpath")))
|
||
|
||
(defun cider-sync-request:complete (str context)
|
||
"Return a list of completions for STR using nREPL's \"complete\" op.
|
||
CONTEXT represents a completion context for compliment."
|
||
(when-let ((dict (thread-first (list "op" "complete"
|
||
"session" (cider-current-session)
|
||
"ns" (cider-current-ns)
|
||
"symbol" str
|
||
"context" context)
|
||
(cider-nrepl-send-sync-request nil 'abort-on-input))))
|
||
(nrepl-dict-get dict "completions")))
|
||
|
||
(defun cider-sync-request:info (symbol &optional class member)
|
||
"Send \"info\" op with parameters SYMBOL or CLASS and MEMBER."
|
||
(let ((var-info (thread-first `("op" "info"
|
||
"session" ,(cider-current-session)
|
||
"ns" ,(cider-current-ns)
|
||
,@(when symbol (list "symbol" symbol))
|
||
,@(when class (list "class" class))
|
||
,@(when member (list "member" member)))
|
||
(cider-nrepl-send-sync-request))))
|
||
(if (member "no-info" (nrepl-dict-get var-info "status"))
|
||
nil
|
||
var-info)))
|
||
|
||
(defun cider-sync-request:eldoc (symbol &optional class member)
|
||
"Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER."
|
||
(when-let ((eldoc (thread-first `("op" "eldoc"
|
||
"session" ,(cider-current-session)
|
||
"ns" ,(cider-current-ns)
|
||
,@(when symbol (list "symbol" symbol))
|
||
,@(when class (list "class" class))
|
||
,@(when member (list "member" member)))
|
||
(cider-nrepl-send-sync-request nil 'abort-on-input))))
|
||
(if (member "no-eldoc" (nrepl-dict-get eldoc "status"))
|
||
nil
|
||
eldoc)))
|
||
|
||
(defun cider-sync-request:ns-list ()
|
||
"Get a list of the available namespaces."
|
||
(thread-first (list "op" "ns-list"
|
||
"filter-regexps" cider-filtered-namespaces-regexps
|
||
"session" (cider-current-session))
|
||
(cider-nrepl-send-sync-request)
|
||
(nrepl-dict-get "ns-list")))
|
||
|
||
(defun cider-sync-request:ns-vars (ns)
|
||
"Get a list of the vars in NS."
|
||
(thread-first (list "op" "ns-vars"
|
||
"session" (cider-current-session)
|
||
"ns" ns)
|
||
(cider-nrepl-send-sync-request)
|
||
(nrepl-dict-get "ns-vars")))
|
||
|
||
(defun cider-sync-request:ns-vars-with-meta (ns)
|
||
"Get a map of the vars in NS to its metadata information."
|
||
(thread-first (list "op" "ns-vars-with-meta"
|
||
"session" (cider-current-session)
|
||
"ns" ns)
|
||
(cider-nrepl-send-sync-request)
|
||
(nrepl-dict-get "ns-vars-with-meta")))
|
||
|
||
(defun cider-sync-request:ns-load-all ()
|
||
"Load all project namespaces."
|
||
(thread-first (list "op" "ns-load-all"
|
||
"session" (cider-current-session))
|
||
(cider-nrepl-send-sync-request)
|
||
(nrepl-dict-get "loaded-ns")))
|
||
|
||
(defun cider-sync-request:resource (name)
|
||
"Perform nREPL \"resource\" op with resource name NAME."
|
||
(thread-first (list "op" "resource"
|
||
"session" (cider-current-session)
|
||
"name" name)
|
||
(cider-nrepl-send-sync-request)
|
||
(nrepl-dict-get "resource-path")))
|
||
|
||
(defun cider-sync-request:resources-list ()
|
||
"Return a list of all resources on the classpath."
|
||
(thread-first (list "op" "resources-list"
|
||
"session" (cider-current-session))
|
||
(cider-nrepl-send-sync-request)
|
||
(nrepl-dict-get "resources-list")))
|
||
|
||
(defun cider-sync-request:format-code (code)
|
||
"Perform nREPL \"format-code\" op with CODE."
|
||
(thread-first (list "op" "format-code"
|
||
"session" (cider-current-session)
|
||
"code" code)
|
||
(cider-nrepl-send-sync-request)
|
||
(nrepl-dict-get "formatted-code")))
|
||
|
||
(defun cider-sync-request:format-edn (edn &optional right-margin)
|
||
"Perform \"format-edn\" op with EDN and RIGHT-MARGIN."
|
||
(let* ((response (thread-first (list "op" "format-edn"
|
||
"session" (cider-current-session)
|
||
"edn" edn)
|
||
(append (cider--nrepl-pprint-request-plist right-margin))
|
||
(cider-nrepl-send-sync-request)))
|
||
(err (nrepl-dict-get response "err")))
|
||
(when err
|
||
;; err will be a stacktrace with a first line that looks like:
|
||
;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]"
|
||
(error (car (split-string err "\n"))))
|
||
(nrepl-dict-get response "formatted-edn")))
|
||
|
||
|
||
;;; Connection info
|
||
(defun cider--java-version ()
|
||
"Retrieve the underlying connection's Java version."
|
||
(with-current-buffer (cider-current-connection "clj")
|
||
(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-connection "clj")
|
||
(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-connection "clj")
|
||
(when nrepl-versions
|
||
(thread-first nrepl-versions
|
||
(nrepl-dict-get "nrepl")
|
||
(nrepl-dict-get "version-string")))))
|
||
|
||
(defun cider--connection-info (connection-buffer)
|
||
"Return info about CONNECTION-BUFFER.
|
||
|
||
Info contains project name, current REPL namespace, host:port
|
||
endpoint and Clojure version."
|
||
(with-current-buffer connection-buffer
|
||
(format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)"
|
||
(upcase (concat cider-repl-type " "))
|
||
(or (cider--project-name nrepl-project-dir) "<no project>")
|
||
(car nrepl-endpoint)
|
||
(cadr nrepl-endpoint)
|
||
(cider--java-version)
|
||
(cider--clojure-version)
|
||
(cider--nrepl-version))))
|
||
|
||
(defun cider--connection-properties (conn-buffer)
|
||
"Extract the essential properties of CONN-BUFFER."
|
||
(with-current-buffer conn-buffer
|
||
(list
|
||
:type cider-repl-type
|
||
:host (car nrepl-endpoint)
|
||
:port (cadr nrepl-endpoint)
|
||
:project-dir nrepl-project-dir)))
|
||
|
||
(defun cider--connection-type (conn-buffer)
|
||
"Get CONN-BUFFER's type.
|
||
|
||
Return value matches `cider-repl-type'."
|
||
(plist-get (cider--connection-properties conn-buffer) :type))
|
||
|
||
(defun cider--connection-host (conn-buffer)
|
||
"Get CONN-BUFFER's host."
|
||
(plist-get (cider--connection-properties conn-buffer) :host))
|
||
|
||
(defun cider--connection-port (conn-buffer)
|
||
"Get CONN-BUFFER's port."
|
||
(plist-get (cider--connection-properties conn-buffer) :port))
|
||
|
||
(defun cider--connection-project-dir (conn-buffer)
|
||
"Get CONN-BUFFER's project dir."
|
||
(plist-get (cider--connection-properties conn-buffer) :project-dir))
|
||
|
||
(defun cider-display-connection-info (&optional show-default)
|
||
"Display information about the current connection.
|
||
|
||
With a prefix argument SHOW-DEFAULT it will display info about the
|
||
default connection."
|
||
(interactive "P")
|
||
(message "%s" (cider--connection-info (if show-default
|
||
(cider-default-connection)
|
||
(cider-current-connection)))))
|
||
|
||
(defun cider-rotate-default-connection ()
|
||
"Rotate and display the default nREPL connection."
|
||
(interactive)
|
||
(cider-ensure-connected)
|
||
(setq cider-connections
|
||
(append (cdr cider-connections)
|
||
(list (car cider-connections))))
|
||
(message "Default nREPL connection: %s"
|
||
(cider--connection-info (car cider-connections))))
|
||
|
||
(defun cider-replicate-connection (&optional conn)
|
||
"Establish a new connection based on an existing connection.
|
||
The new connection will use the same host and port.
|
||
If CONN is not provided the user will be prompted to select a connection."
|
||
(interactive)
|
||
(let* ((conn (or conn (cider-read-connection "Select connection to replicate: ")))
|
||
(host (cider--connection-host conn))
|
||
(port (cider--connection-port conn))
|
||
(project-dir (cider--connection-project-dir conn)))
|
||
(cider-connect host port project-dir)))
|
||
|
||
(defun cider-extract-designation-from-current-repl-buffer ()
|
||
"Extract the designation from the cider repl buffer name."
|
||
(let ((repl-buffer-name (buffer-name (cider-current-repl-buffer)))
|
||
(template (split-string nrepl-repl-buffer-name-template "%s")))
|
||
(string-match (format "^%s\\(.*\\)%s"
|
||
(regexp-quote (concat (car template) nrepl-buffer-name-separator))
|
||
(regexp-quote (cadr template)))
|
||
repl-buffer-name)
|
||
(or (match-string 1 repl-buffer-name) "<no designation>")))
|
||
|
||
(defun cider-change-buffers-designation (designation)
|
||
"Change the DESIGNATION in cider buffer names.
|
||
Buffer names changed are cider-repl and nrepl-server."
|
||
(interactive (list (read-string (format "Change CIDER buffer designation from '%s': "
|
||
(cider-extract-designation-from-current-repl-buffer)))))
|
||
(cider-ensure-connected)
|
||
(let ((new-repl-buffer-name (nrepl-format-buffer-name-template
|
||
nrepl-repl-buffer-name-template designation)))
|
||
(with-current-buffer (cider-current-repl-buffer)
|
||
(rename-buffer new-repl-buffer-name)
|
||
(when nrepl-server-buffer
|
||
(let ((new-server-buffer-name (nrepl-format-buffer-name-template
|
||
nrepl-server-buffer-name-template designation)))
|
||
(with-current-buffer nrepl-server-buffer
|
||
(rename-buffer new-server-buffer-name)))))
|
||
(message "CIDER buffer designation changed to: %s" designation)))
|
||
|
||
(provide 'cider-client)
|
||
|
||
;;; cider-client.el ends here
|