angrygoats
/
essentials
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
31 Commits
1 Branch
0 Tags
116 MiB
Tree: a85a39e875
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'a85a39e875'
${ noResults }
essentials/dotfiles/emacs.d/elpa/cider-20151022.28/cider-client.el

850 lines
34 KiB
Raw Normal View History Unescape

Add project to emacs.d
9 years ago
;;; cider-client.el --- A layer of abstraction above the actual client code. -*- lexical-binding: t -*-
;; Copyright © 2013-2015 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 'nrepl-client)
(require 'cider-common)
(require 'cider-compat)
(require 'seq)
;;; Connection Buffer Management
(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)
(error "No active nREPL connections")))
(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"))))
(define-obsolete-function-alias 'nrepl-current-connection-buffer 'cider-default-connection "0.10")
(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 `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 `cider-connections'.
Also close associated REPL and server buffers."
(let ((buffer (get-buffer conn-buffer)))
(setq cider-connections
(delq buffer cider-connections))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(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))))
;;; Current connection logic
(defvar-local cider-repl-type nil
"The type of this REPL buffer, usually either \"clj\" or \"cljs\".")
(defun cider-find-connection-buffer-for-project-directory (project-directory &optional all-connections)
"Return the most appropriate connection-buffer for the given PROJECT-DIRECTORY.
By order of preference, this is any connection whose directory matches
PROJECT-DIRECTORY, followed by any connection whose directory is nil,
followed by any connection at all.
Only return nil if `cider-connections' is empty (there are no connections).
If more than one connection satisfy a given level of preference, return the
connection buffer closer to the start of `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."
(let ((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: " nil (clojure-project-dir) nil (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-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 there is ambiguity, it is resolved by matching TYPE with the REPL
type (Clojure or ClojureScript). If TYPE is nil, it is derived from the
file extension."
;; Cleanup the connections list.
(cider-connections)
(cond
((cider--in-connection-buffer-p) (current-buffer))
((= 1 (length cider-connections)) (car cider-connections))
(t (let* ((project-directory (clojure-project-dir (cider-current-dir)))
(repls (and project-directory
(cider-find-connection-buffer-for-project-directory project-directory 'all))))
(if (= 1 (length repls))
;; Only one match, just return it.
(car repls)
;; OW, find one matching the extension of current file.
(let ((type (or type (file-name-extension (or (buffer-file-name) "")))))
(or (seq-find (lambda (conn)
(equal (with-current-buffer conn
(or cider-repl-type "clj"))
type))
(append repls cider-connections))
(car repls)
(car cider-connections))))))))
;;; 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)))
(define-obsolete-function-alias 'nrepl-connection-browser 'cider-connection-browser "0.10")
(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\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--connection-pp (connection)
"Print an nREPL CONNECTION to the current buffer."
(let* ((buffer-read-only nil)
(buffer (get-buffer connection))
(endpoint (buffer-local-value 'nrepl-endpoint buffer)))
(insert
(format "%s %-30s %-16s %5s %s%s"
(if (equal connection (car cider-connections)) "*" " ")
(buffer-name connection)
(car endpoint)
(prin1-to-string (cadr endpoint))
(or (cider--project-name
(buffer-local-value 'nrepl-project-dir buffer))
"")
(with-current-buffer buffer
(if cider-repl-type
(concat " " cider-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 "Connected. %s" (cider-random-words-of-inspiration)))
;; TODO: Replace direct usage of such hooks with CIDER hooks,
;; that are connection type independent
(add-hook 'nrepl-connected-hook 'cider-display-connected-message)
;;; 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 ()
"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\"."
(or cider-buffer-ns
(clojure-find-ns)
(when-let ((repl-buf (cider-current-connection)))
(buffer-local-value 'cider-buffer-ns repl-buf))
"user"))
(define-obsolete-function-alias 'cider-eval 'nrepl-request:eval "0.9")
(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)
(error "Can't find nREPL middleware providing op \"%s\". Please, install (or update) cider-nrepl %s and restart CIDER" op (upcase cider-version))))
(defun cider-nrepl-send-request (request callback)
"Send REQUEST and register response handler CALLBACK.
REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\"
\"par1\" ... ).
Return the id of the sent message."
(nrepl-send-request request callback (cider-current-connection)))
(defun cider-nrepl-send-sync-request (request &optional abort-on-input)
"Send REQUEST to the nREPL server synchronously.
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 (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 point)
"Send the request INPUT and register the CALLBACK as the response handler.
If NS is non-nil, include it in the request. POINT, if non-nil, is the
position of INPUT in its buffer."
(nrepl-request:eval input
callback
(cider-current-connection)
(cider-current-session)
ns
point))
(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))
(defun cider--nrepl-pprint-eval-request (input session &optional ns right-margin)
"Prepare :pprint-eval request message for INPUT.
SESSION and NS are used for the context of the evaluation.
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")
(and right-margin (list "right-margin" right-margin))
(nrepl--eval-request input session ns)))
(defun cider-nrepl-request:pprint-eval (input callback &optional ns right-margin)
"Send the request INPUT and register the CALLBACK as the response handler.
The request is dispatched via CONNECTION and SESSION.
If NS is non-nil, include it in the request.
RIGHT-MARGIN specifies the maximum column width of the
pretty-printed result, and is included in the request if non-nil."
(cider-nrepl-send-request
(cider--nrepl-pprint-eval-request input (cider-current-session) ns right-margin)
callback))
(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))
(define-obsolete-function-alias 'nrepl-current-session 'cider-current-session "0.10")
(defun cider-current-tooling-session ()
"Return the current tooling session."
(with-current-buffer (cider-current-connection)
nrepl-tooling-session))
(define-obsolete-function-alias 'nrepl-current-tooling-session 'cider-current-tooling-session "0.10")
(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 callback)
"Perform the nREPL \"load-file\" op.
FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be
loaded. 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)))))
;;; Sync Requests
(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p)
"Send \"apropos\" op with args SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P."
(thread-first `("op" "apropos"
"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")))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "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."
(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 '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 '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"
"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:resource (name)
"Perform nREPL \"resource\" op with resource name NAME."
(thread-first (list "op" "resource"
"name" name)
(cider-nrepl-send-sync-request)
(nrepl-dict-get "resource-path")))
(defun cider-sync-request:resources-list ()
"Perform nREPL \"resource\" op with resource name NAME."
(thread-first (list "op" "resources-list")
(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"
"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"
"edn" edn)
(append (and right-margin (list "right-margin" 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")))
;;; 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 ()
"Start the evaluation spinner.
Do nothing if `cider-show-eval-spinner' is nil."
(when cider-show-eval-spinner
(spinner-start cider-eval-spinner-type nil
cider-eval-spinner-delay)))
(defun cider-eval-spinner-handler (eval-buffer original-callback)
"Return a response handler that stops the spinner and calls 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
(spinner-stop)))
(funcall original-callback response)))
;;; 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)"
(if cider-repl-type
(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
:host (car nrepl-endpoint)
:port (cadr nrepl-endpoint)
:project-dir nrepl-project-dir)))
(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)))))
(define-obsolete-function-alias 'cider-display-current-connection-info 'cider-display-connection-info "0.10")
(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)))
(define-obsolete-function-alias 'cider-rotate-connection 'cider-rotate-default-connection "0.10")
(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 ()
"Change the designation in cider buffer names.
Buffer names changed are cider-repl and nrepl-server."
(interactive)
(cider-ensure-connected)
(let* ((designation (read-string (format "Change CIDER buffer designation from '%s': "
(cider-extract-designation-from-current-repl-buffer))))
(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