|
|
- ;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*-
-
- ;; Copyright © 2013-2019 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 low-level nREPL client code.
-
- ;;; Code:
-
- (require 'map)
- (require 'seq)
- (require 'subr-x)
- (require 'parseedn)
-
- (require 'clojure-mode)
- (require 'spinner)
-
- (require 'cider-compat)
- (require 'cider-connection)
- (require 'cider-common)
- (require 'cider-util)
- (require 'nrepl-client)
-
- ;;; 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))
-
- (defun cider-ns-from-form (ns-form)
- "Get ns substring from NS-FORM."
- (when (string-match "^[ \t\n]*\(ns[ \t\n]+\\([^][ \t\n(){}]+\\)" ns-form)
- (match-string-no-properties 1 ns-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 (cider-current-repl)))
- (buffer-local-value 'cider-buffer-ns repl))
- (if no-default nil "user")))
-
- (defun cider-path-to-ns (relpath)
- "Transform RELPATH to Clojure namespace.
- Remove extension and substitute \"/\" with \".\", \"_\" with \"-\"."
- (thread-last relpath
- (file-name-sans-extension)
- (replace-regexp-in-string "/" ".")
- (replace-regexp-in-string "_" "-")))
-
- (defun cider-expected-ns (&optional path)
- "Return the namespace string matching PATH, or nil if not found.
- 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 (file-truename (or path buffer-file-name)))
- (relpath (thread-last (cider-classpath-entries)
- (seq-filter #'file-directory-p)
- (seq-map (lambda (dir)
- (when (file-in-directory-p path dir)
- (file-relative-name path dir))))
- (seq-filter #'identity)
- (seq-sort (lambda (a b)
- (< (length a) (length b))))
- (car))))
- (if relpath
- (cider-path-to-ns relpath)
- (clojure-expected-ns path)))
- (clojure-expected-ns path)))
-
- (defun cider-nrepl-op-supported-p (op &optional connection)
- "Check whether the CONNECTION supports the nREPL middleware OP."
- (nrepl-op-supported-p op (or connection (cider-current-repl nil 'ensure))))
-
- (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\" (provided by cider-nrepl)" this-command op)))
-
- (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-repl 'any 'ensure))))
-
- (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-repl 'any 'ensure))
- abort-on-input))
-
- (defun cider-nrepl-send-unhandled-request (request &optional connection)
- "Send REQUEST to the nREPL CONNECTION and ignore any responses.
- Immediately mark the REQUEST as done. Return the id of the sent message."
- (let* ((conn (or connection (cider-current-repl 'any 'ensure)))
- (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 connection)
- "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. CONNECTION is the connection
- buffer, defaults to (cider-current-repl)."
- (let ((connection (or connection (cider-current-repl nil 'ensure))))
- (nrepl-request:eval input
- (if cider-show-eval-spinner
- (cider-eval-spinner-handler connection callback)
- callback)
- connection
- ns line column additional-params)
- (cider-spinner-start connection)))
-
- (defun cider-nrepl-sync-request:eval (input &optional connection ns)
- "Send the INPUT to the nREPL CONNECTION synchronously.
- If NS is non-nil, include it in the eval request."
- (nrepl-sync-request:eval input (or connection (cider-current-repl nil 'ensure)) ns))
-
- (defcustom cider-print-fn 'pprint
- "Sets the function to use for printing.
-
- nil – to defer to nREPL to choose the printing function. This will use
- the bound value of \\=`nrepl.middleware.print/*print-fn*\\=`, which
- defaults to the equivalent of \\=`clojure.core/pr\\=`.
-
- `pr' – to use the equivalent of \\=`clojure.core/pr\\=`.
-
- `pprint' – to use \\=`clojure.pprint/pprint\\=` (this is the default).
-
- `fipp' – to use the Fast Idiomatic Pretty Printer, approximately 5-10x
- faster than \\=`clojure.core/pprint\\=`.
-
- `puget' – to use Puget, which provides canonical serialization of data on
- top of fipp, but at a slight performance cost.
-
- `zprint' – to use zprint, a fast and flexible alternative to the libraries
- mentioned above.
-
- Alternatively can be the namespace-qualified name of a Clojure var whose
- function takes three arguments: the object to print, the
- \\=`java.io.PrintWriter\\=` to print on, and a (possibly nil) map of
- options. If the function cannot be resolved, will behave as if set to
- nil."
- :type '(choice (const nil)
- (const pr)
- (const pprint)
- (const fipp)
- (const puget)
- (const zprint)
- string)
- :group 'cider
- :package-version '(cider . "0.21.0"))
-
- (defcustom cider-print-options nil
- "A map of options that will be passed to `cider-print-fn'.
- Here's an example for `pprint':
-
- '((\"length\" 50) (\"right-margin\" 70))"
- :type 'list
- :group 'cider
- :package-version '(cider . "0.21.0"))
-
- (make-obsolete-variable 'cider-pprint-fn 'cider-print-fn "0.21")
- (make-obsolete-variable 'cider-pprint-options 'cider-print-options "0.21")
-
- (defcustom cider-print-quota (* 1024 1024)
- "A hard limit on the number of bytes to return from any printing operation.
- Set to nil for no limit."
- :type 'integer
- :group 'cider
- :package-version '(cider . "0.21.0"))
-
- (defun cider--print-fn ()
- "Return the value to send in the nrepl.middleware.print/print slot."
- (pcase cider-print-fn
- (`pr "cider.nrepl.pprint/pr")
- (`pprint "cider.nrepl.pprint/pprint")
- (`fipp "cider.nrepl.pprint/fipp-pprint")
- (`puget "cider.nrepl.pprint/puget-pprint")
- (`zprint "cider.nrepl.pprint/zprint-pprint")
- (_ cider-print-fn)))
-
- (defvar cider--print-options-mapping
- '((right-margin
- ((fipp . width) (puget . width) (zprint . width)))
- (length
- ((fipp . print-length) (puget . print-length) (zprint . max-length)))
- (level
- ((fipp . print-level) (puget . print-level) (zprint . max-depth))))
- "A mapping of print option for the various supported print engines.")
-
- (defun cider--print-option (name printer)
- "Convert the generic NAME to its PRINTER specific variant.
- E.g. pprint's right-margin would become width for fipp.
- The function is useful when you want to generate dynamically
- print options.
-
- NAME can be a string or a symbol. PRINTER has to be a symbol.
- The result will be a string."
- (let* ((name (cider-maybe-intern name))
- (result (cdr (assoc printer (cadr (assoc name cider--print-options-mapping))))))
- (symbol-name (or result name))))
-
- (defun cider--nrepl-print-request-map (&optional right-margin)
- "Map to merge into requests that require pretty-printing.
- RIGHT-MARGIN specifies the maximum column-width of the printed result, and
- is included in the request if non-nil."
- (let* ((width-option (cider--print-option "right-margin" cider-print-fn))
- (print-options (thread-last
- (map-merge 'hash-table
- `((,width-option ,right-margin))
- cider-print-options)
- (map-pairs)
- (seq-mapcat #'identity)
- (apply #'nrepl-dict))))
- (map-merge 'list
- `(("nrepl.middleware.print/stream?" "1"))
- (when cider-print-fn
- `(("nrepl.middleware.print/print" ,(cider--print-fn))))
- (when cider-print-quota
- `(("nrepl.middleware.print/quota" ,cider-print-quota)))
- (unless (nrepl-dict-empty-p print-options)
- `(("nrepl.middleware.print/options" ,print-options))))))
-
- (defun cider--nrepl-pr-request-map ()
- "Map to merge into requests that do not require pretty printing."
- (let ((print-options (thread-last cider-print-options
- (map-pairs)
- (seq-mapcat #'identity)
- (apply #'nrepl-dict))))
- (map-merge 'list
- `(("nrepl.middleware.print/print" "cider.nrepl.pprint/pr"
- "nrepl.middleware.print/stream?" nil))
- (unless (nrepl-dict-empty-p print-options)
- `(("nrepl.middleware.print/options" ,print-options)))
- (when cider-print-quota
- `(("nrepl.middleware.print/quota" ,cider-print-quota))))))
-
- (defun cider--nrepl-content-type-map ()
- "Map to be merged into an eval request to make it use content-types."
- '(("content-type" "true")))
-
- (defun cider-tooling-eval (input callback &optional ns connection)
- "Send the request INPUT to CONNECTION and register the CALLBACK.
- NS specifies the namespace in which to evaluate the request. Requests
- evaluated in the tooling nREPL session don't affect the thread-local
- bindings of the primary eval nREPL session (e.g. this is not going to
- clobber *1/2/3)."
- ;; namespace forms are always evaluated in the "user" namespace
- (nrepl-request:eval input
- callback
- (or connection (cider-current-repl nil 'ensure))
- ns nil nil nil 'tooling))
-
- (defun cider-sync-tooling-eval (input &optional ns connection)
- "Send the request INPUT to CONNECTION and evaluate in synchronously.
- NS specifies the namespace in which to evaluate the request. Requests
- evaluated in the tooling nREPL session don't affect the thread-local
- bindings of the primary eval nREPL session (e.g. this is not going to
- clobber *1/2/3)."
- ;; namespace forms are always evaluated in the "user" namespace
- (nrepl-sync-request:eval input
- (or connection (cider-current-repl nil 'ensure))
- ns
- 'tooling))
-
- (defun cider-library-present-p (lib-ns)
- "Check whether LIB-NS is present.
- If a certain well-known ns in a library is present we assume that library
- itself is present."
- (nrepl-dict-get (cider-sync-tooling-eval (format "(require '%s)" lib-ns)) "value"))
-
- ;;; Interrupt evaluation
-
- (defun cider-interrupt-handler (buffer)
- "Create an interrupt response handler for BUFFER."
- (nrepl-make-response-handler buffer nil nil nil nil))
-
- (defun cider-interrupt ()
- "Interrupt any pending evaluations."
- (interactive)
- ;; FIXME: does this work correctly in cljc files?
- (with-current-buffer (cider-current-repl nil 'ensure)
- (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-repl))))))
-
- (defun cider-nrepl-eval-session ()
- "Return the eval nREPL session id of the current connection."
- (with-current-buffer (cider-current-repl)
- nrepl-session))
-
- (defun cider-nrepl-tooling-session ()
- "Return the tooling nREPL session id of the current connection."
- (with-current-buffer (cider-current-repl)
- 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)))
-
- (defconst cider-info-form "
- (do
- (require 'clojure.java.io)
- (require 'clojure.walk)
-
- (if-let [var (resolve '%s)]
- (let [info (meta var)]
- (-> info
- (update :ns str)
- (update :name str)
- (update :file (comp str clojure.java.io/resource))
- (assoc :arglists-str (str (:arglists info)))
- (clojure.walk/stringify-keys)))))
- ")
-
- (defun cider-fallback-eval:info (var)
- "Obtain VAR metadata via a regular eval.
- Used only when the info nREPL middleware is not available."
- (let* ((response (cider-sync-tooling-eval (format cider-info-form var)))
- (var-info (nrepl-dict-from-hash (parseedn-read-str (nrepl-dict-get response "value")))))
- 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 (if (cider-nrepl-op-supported-p "info")
- (cider-sync-request:info var)
- (cider-fallback-eval: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)))
-
- ;;; Requests
-
- (declare-function cider-load-file-handler "cider-eval")
- (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-repl'. If CALLBACK
- is nil, use `cider-load-file-handler'."
- (cider-nrepl-send-request `("op" "load-file"
- "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" "^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"
- "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"))
- "exclude-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 '("op" "classpath")
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "classpath")))
-
- (defun cider-fallback-eval:classpath ()
- "Return a list of classpath entries using eval."
- (read (nrepl-dict-get (cider-sync-tooling-eval "(seq (.split (System/getProperty \"java.class.path\") \":\"))") "value")))
-
- (defun cider-classpath-entries ()
- "Return a list of classpath entries."
- (if (cider-nrepl-op-supported-p "classpath")
- (cider-sync-request:classpath)
- (cider-fallback-eval: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 `("op" "complete"
- "ns" ,(cider-current-ns)
- "symbol" ,str
- "context" ,context)
- (cider-nrepl-send-sync-request (cider-current-repl)
- 'abort-on-input))))
- (nrepl-dict-get dict "completions")))
-
- (defun cider-sync-request:complete-flush-caches ()
- "Send \"complete-flush-caches\" op to flush Compliment's caches."
- (cider-nrepl-send-sync-request (list "op" "complete-flush-caches"
- "session" (cider-nrepl-eval-session))
- 'abort-on-input))
-
- (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"
- "ns" ,(cider-current-ns)
- ,@(when symbol `("symbol" ,symbol))
- ,@(when class `("class" ,class))
- ,@(when member `("member" ,member)))
- (cider-nrepl-send-sync-request (cider-current-repl)))))
- (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"
- "ns" ,(cider-current-ns)
- ,@(when symbol `("symbol" ,symbol))
- ,@(when class `("class" ,class))
- ,@(when member `("member" ,member)))
- (cider-nrepl-send-sync-request (cider-current-repl)
- 'abort-on-input))))
- (if (member "no-eldoc" (nrepl-dict-get eldoc "status"))
- nil
- eldoc)))
-
- (defun cider-sync-request:eldoc-datomic-query (symbol)
- "Send \"eldoc-datomic-query\" op with parameter SYMBOL."
- (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query"
- "ns" ,(cider-current-ns)
- ,@(when symbol `("symbol" ,symbol)))
- (cider-nrepl-send-sync-request nil 'abort-on-input))))
- (if (member "no-eldoc" (nrepl-dict-get eldoc "status"))
- nil
- eldoc)))
-
- (defun cider-sync-request:spec-list (&optional filter-regex)
- "Get a list of the available specs in the registry.
- Optional argument FILTER-REGEX filters specs. By default, all specs are
- returned."
- (setq filter-regex (or filter-regex ""))
- (thread-first `("op" "spec-list"
- "filter-regex" ,filter-regex
- "ns" ,(cider-current-ns))
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "spec-list")))
-
- (defun cider-sync-request:spec-form (spec)
- "Get SPEC's form from registry."
- (thread-first `("op" "spec-form"
- "spec-name" ,spec
- "ns" ,(cider-current-ns))
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "spec-form")))
-
- (defun cider-sync-request:spec-example (spec)
- "Get an example for SPEC."
- (thread-first `("op" "spec-example"
- "spec-name" ,spec)
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "spec-example")))
-
- (defun cider-sync-request:ns-list ()
- "Get a list of the available namespaces."
- (thread-first `("op" "ns-list"
- "exclude-regexps" ,cider-filtered-namespaces-regexps)
- (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 `("op" "ns-vars"
- "ns" ,ns)
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "ns-vars")))
-
- (defun cider-sync-request:ns-path (ns)
- "Get the path to the file containing NS."
- (thread-first `("op" "ns-path"
- "ns" ,ns)
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "path")))
-
- (defun cider-sync-request:ns-vars-with-meta (ns)
- "Get a map of the vars in NS to its metadata information."
- (thread-first `("op" "ns-vars-with-meta"
- "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 '("op" "ns-load-all")
- (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 `("op" "resource"
- "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.
- The result entries are relative to the classpath."
- (when-let* ((resources (thread-first '("op" "resources-list")
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "resources-list"))))
- (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources)))
-
- (defun cider-sync-request:fn-refs (ns sym)
- "Return a list of functions that reference the function identified by NS and SYM."
- (cider-ensure-op-supported "fn-refs")
- (thread-first `("op" "fn-refs"
- "ns" ,ns
- "symbol" ,sym)
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "fn-refs")))
-
- (defun cider-sync-request:fn-deps (ns sym)
- "Return a list of function deps for the function identified by NS and SYM."
- (cider-ensure-op-supported "fn-deps")
- (thread-first `("op" "fn-deps"
- "ns" ,ns
- "symbol" ,sym)
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "fn-deps")))
-
- (defun cider-sync-request:format-code (code)
- "Perform nREPL \"format-code\" op with CODE."
- (thread-first `("op" "format-code"
- "code" ,code)
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "formatted-code")))
-
- (defun cider-sync-request:format-edn (edn right-margin)
- "Perform \"format-edn\" op with EDN and RIGHT-MARGIN."
- (let* ((request (thread-last
- (map-merge 'list
- `(("op" "format-edn")
- ("edn" ,edn))
- (cider--nrepl-print-request-map right-margin))
- (seq-mapcat #'identity)))
- (response (cider-nrepl-send-sync-request 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")))
-
- ;;; Dealing with input
- ;; TODO: Replace this with some nil handler.
- (defun cider-stdin-handler (&optional _buffer)
- "Make a stdin response handler for _BUFFER."
- (nrepl-make-response-handler (current-buffer)
- (lambda (_buffer _value))
- (lambda (_buffer _out))
- (lambda (_buffer _err))
- nil))
-
- (defun cider-need-input (buffer)
- "Handle an need-input request from BUFFER."
- (with-current-buffer buffer
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map (kbd "C-c C-c") 'abort-recursive-edit)
- (let ((stdin (condition-case nil
- (concat (read-from-minibuffer "Stdin: " nil map) "\n")
- (quit nil))))
- (nrepl-request:stdin stdin
- (cider-stdin-handler buffer)
- (cider-current-repl))))))
-
- (provide 'cider-client)
-
- ;;; cider-client.el ends here
|