cider-client.el (36104B)
1 ;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*- 2 3 ;; Copyright © 2013-2023 Bozhidar Batsov 4 ;; 5 ;; Author: Bozhidar Batsov <bozhidar@batsov.dev> 6 7 ;; This program is free software: you can redistribute it and/or modify 8 ;; it under the terms of the GNU General Public License as published by 9 ;; the Free Software Foundation, either version 3 of the License, or 10 ;; (at your option) any later version. 11 12 ;; This program is distributed in the hope that it will be useful, 13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 ;; GNU General Public License for more details. 16 17 ;; You should have received a copy of the GNU General Public License 18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 19 20 ;; This file is not part of GNU Emacs. 21 22 ;;; Commentary: 23 24 ;; A layer of abstraction above the low-level nREPL client code. 25 26 ;;; Code: 27 28 (require 'map) 29 (require 'seq) 30 (require 'subr-x) 31 (require 'parseedn) 32 33 (require 'clojure-mode) 34 (require 'spinner) 35 36 (require 'cider-connection) 37 (require 'cider-common) 38 (require 'cider-util) 39 (require 'nrepl-client) 40 41 42 ;;; Eval spinner 43 (defcustom cider-eval-spinner-type 'progress-bar 44 "Appearance of the evaluation spinner. 45 46 Value is a symbol. The possible values are the symbols in the 47 `spinner-types' variable." 48 :type 'symbol 49 :group 'cider 50 :package-version '(cider . "0.10.0")) 51 52 (defcustom cider-show-eval-spinner t 53 "When true, show the evaluation spinner in the mode line." 54 :type 'boolean 55 :group 'cider 56 :package-version '(cider . "0.10.0")) 57 58 (defcustom cider-eval-spinner-delay 1 59 "Amount of time, in seconds, after which the evaluation spinner will be shown." 60 :type 'integer 61 :group 'cider 62 :package-version '(cider . "0.10.0")) 63 64 (defcustom cider-enhanced-cljs-completion-p t 65 "This setting enables dynamic cljs completions. 66 That is, expressions at point are evaluated and the properties of the 67 resulting value are used to compute completions." 68 :type 'boolean 69 :group 'cider 70 :package-version '(cider . "0.23.0")) 71 72 (defcustom cider-before-eval-hook nil 73 "List of functions to call before eval request is sent to nrepl." 74 :type 'hook 75 :group 'cider 76 :package-version '(cider . "1.2.0")) 77 78 (defcustom cider-after-eval-done-hook nil 79 "List of functions to call after eval was responded by nrepl with done status." 80 :type 'hook 81 :group 'cider 82 :package-version '(cider . "1.2.0")) 83 84 (defun cider-spinner-start (buffer) 85 "Start the evaluation spinner in BUFFER. 86 Do nothing if `cider-show-eval-spinner' is nil." 87 (when cider-show-eval-spinner 88 (with-current-buffer buffer 89 (spinner-start cider-eval-spinner-type nil 90 cider-eval-spinner-delay)))) 91 92 (defun cider-eval-spinner (eval-buffer response) 93 "Handle RESPONSE stopping the spinner. 94 EVAL-BUFFER is the buffer where the spinner was started." 95 ;; buffer still exists and 96 ;; we've got status "done" from nrepl 97 ;; stop the spinner 98 (when (and (buffer-live-p eval-buffer) 99 (let ((status (nrepl-dict-get response "status"))) 100 (or (member "done" status) 101 (member "eval-error" status) 102 (member "error" status)))) 103 (with-current-buffer eval-buffer 104 (when spinner-current (spinner-stop))))) 105 106 107 ;;; Evaluation helpers 108 (defun cider-ns-form-p (form) 109 "Check if FORM is an ns form." 110 (string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form)) 111 112 (defun cider-ns-from-form (ns-form) 113 "Get ns substring from NS-FORM." 114 (when (string-match "^[ \t\n]*\(ns[ \t\n]+\\([^][ \t\n(){}]+\\)" ns-form) 115 (match-string-no-properties 1 ns-form))) 116 117 (defvar-local cider-buffer-ns nil 118 "Current Clojure namespace of some buffer. 119 Useful for special buffers (e.g. REPL, doc buffers) that have to keep track 120 of a namespace. This should never be set in Clojure buffers, as there the 121 namespace should be extracted from the buffer's ns form.") 122 123 (defun cider-current-ns (&optional no-default) 124 "Return the current ns. 125 The ns is extracted from the ns form for Clojure buffers and from 126 `cider-buffer-ns' for all other buffers. If it's missing, use the current 127 REPL's ns, otherwise fall back to \"user\". When NO-DEFAULT is non-nil, it 128 will return nil instead of \"user\"." 129 (or cider-buffer-ns 130 (clojure-find-ns) 131 (when-let* ((repl (cider-current-repl))) 132 (buffer-local-value 'cider-buffer-ns repl)) 133 (if no-default nil "user"))) 134 135 (defun cider-path-to-ns (relpath) 136 "Transform RELPATH to Clojure namespace. 137 Remove extension and substitute \"/\" with \".\", \"_\" with \"-\"." 138 (thread-last 139 relpath 140 (file-name-sans-extension) 141 (replace-regexp-in-string "/" ".") 142 (replace-regexp-in-string "_" "-"))) 143 144 (defun cider-expected-ns (&optional path) 145 "Return the namespace string matching PATH, or nil if not found. 146 If PATH is nil, use the path to the file backing the current buffer. The 147 command falls back to `clojure-expected-ns' in the absence of an active 148 nREPL connection." 149 (if (cider-connected-p) 150 (let* ((path (file-truename (or path buffer-file-name))) 151 (relpath (thread-last 152 (cider-classpath-entries) 153 (seq-filter #'file-directory-p) 154 (seq-map (lambda (dir) 155 (when (file-in-directory-p path dir) 156 (file-relative-name path dir)))) 157 (seq-filter #'identity) 158 (seq-sort (lambda (a b) 159 (< (length a) (length b)))) 160 (car)))) 161 (if relpath 162 (cider-path-to-ns relpath) 163 (clojure-expected-ns path))) 164 (clojure-expected-ns path))) 165 166 (defun cider-nrepl-op-supported-p (op &optional connection skip-ensure) 167 "Check whether the CONNECTION supports the nREPL middleware OP. 168 Skip check if repl is active if SKIP-ENSURE is non nil." 169 (nrepl-op-supported-p op (or connection (cider-current-repl nil (if skip-ensure 170 nil 171 'ensure))))) 172 173 (defun cider-ensure-op-supported (op) 174 "Check for support of middleware op OP. 175 Signal an error if it is not supported." 176 (unless (cider-nrepl-op-supported-p op) 177 (user-error "`%s' requires the nREPL op \"%s\" (provided by cider-nrepl)" this-command op))) 178 179 (defun cider-nrepl-send-request (request callback &optional connection tooling) 180 "Send REQUEST and register response handler CALLBACK. 181 REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" 182 \"par1\" ... ). 183 If CONNECTION is provided dispatch to that connection instead of 184 the current connection. Return the id of the sent message. 185 If TOOLING is truthy then the tooling session is used." 186 (nrepl-send-request request callback (or connection (cider-current-repl 'any 'ensure)) tooling)) 187 188 (defun cider-nrepl-send-sync-request (request &optional connection abort-on-input) 189 "Send REQUEST to the nREPL server synchronously using CONNECTION. 190 Hold till final \"done\" message has arrived and join all response messages 191 of the same \"op\" that came along and return the accumulated response. 192 If ABORT-ON-INPUT is non-nil, the function will return nil 193 at the first sign of user input, so as not to hang the 194 interface." 195 (nrepl-send-sync-request request 196 (or connection (cider-current-repl 'any 'ensure)) 197 abort-on-input)) 198 199 (defun cider-nrepl-send-unhandled-request (request &optional connection) 200 "Send REQUEST to the nREPL CONNECTION and ignore any responses. 201 Immediately mark the REQUEST as done. Return the id of the sent message." 202 (let* ((conn (or connection (cider-current-repl 'any 'ensure))) 203 (id (nrepl-send-request request #'ignore conn))) 204 (with-current-buffer conn 205 (nrepl--mark-id-completed id)) 206 id)) 207 208 (defun cider-nrepl-request:eval (input callback &optional ns line column additional-params connection) 209 "Send the request INPUT and register the CALLBACK as the response handler. 210 If NS is non-nil, include it in the request. LINE and COLUMN, if non-nil, 211 define the position of INPUT in its buffer. ADDITIONAL-PARAMS is a plist 212 to be appended to the request message. CONNECTION is the connection 213 buffer, defaults to (cider-current-repl)." 214 (let ((connection (or connection (cider-current-repl nil 'ensure))) 215 (eval-buffer (current-buffer))) 216 (run-hooks 'cider-before-eval-hook) 217 (nrepl-request:eval input 218 (lambda (response) 219 (when cider-show-eval-spinner 220 (cider-eval-spinner connection response)) 221 (when (and (buffer-live-p eval-buffer) 222 (member "done" (nrepl-dict-get response "status"))) 223 (with-current-buffer eval-buffer 224 (run-hooks 'cider-after-eval-done-hook))) 225 (funcall callback response)) 226 connection 227 ns line column additional-params) 228 (cider-spinner-start connection))) 229 230 (defun cider-nrepl-sync-request:eval (input &optional connection ns) 231 "Send the INPUT to the nREPL CONNECTION synchronously. 232 If NS is non-nil, include it in the eval request." 233 (nrepl-sync-request:eval input (or connection (cider-current-repl nil 'ensure)) ns)) 234 235 (defcustom cider-format-code-options nil 236 "A map of options that will be passed to `cljfmt' to format code. 237 Assuming this is the Clojure map you want to use as `cljfmt' options: 238 239 {:indents {org.me/foo [[:inner 0]]} 240 :alias-map {\"me\" \"org.me\"}} 241 242 you need to encode it as the following plist: 243 244 '((\"indents\" ((\"org.me/foo\" ((\"inner\" 0))))) (\"alias-map\" ((\"me\" \"org.me\"))))" 245 :type 'list 246 :group 'cider 247 :package-version '(cider . "1.1.0")) 248 249 (defun cider--nrepl-format-code-request-map (&optional format-options) 250 "Map to merge into requests that require code formatting. 251 If non-nil, FORMAT-OPTIONS specifies the options cljfmt will use to format 252 the code. See `cider-format-code-options` for details." 253 (when format-options 254 (let* ((indents-dict (when (assoc "indents" format-options) 255 (thread-last 256 (cadr (assoc "indents" format-options)) 257 (map-pairs) 258 (seq-mapcat #'identity) 259 (apply #'nrepl-dict)))) 260 (alias-map-dict (when (assoc "alias-map" format-options) 261 (thread-last 262 (cadr (assoc "alias-map" format-options)) 263 (map-pairs) 264 (seq-mapcat #'identity) 265 (apply #'nrepl-dict))))) 266 (thread-last 267 (map-merge 'list 268 (when indents-dict 269 `(("indents" ,indents-dict))) 270 (when alias-map-dict 271 `(("alias-map" ,alias-map-dict)))) 272 (map-pairs) 273 (seq-mapcat #'identity) 274 (apply #'nrepl-dict))))) 275 276 (defcustom cider-print-fn 'pprint 277 "Sets the function to use for printing. 278 279 nil – to defer to nREPL to choose the printing function. This will use 280 the bound value of \\=`nrepl.middleware.print/*print-fn*\\=`, which 281 defaults to the equivalent of \\=`clojure.core/pr\\=`. 282 283 `pr' – to use the equivalent of \\=`clojure.core/pr\\=`. 284 285 `pprint' – to use \\=`clojure.pprint/pprint\\=` (this is the default). 286 287 `fipp' – to use the Fast Idiomatic Pretty Printer, approximately 5-10x 288 faster than \\=`clojure.core/pprint\\=`. 289 290 `puget' – to use Puget, which provides canonical serialization of data on 291 top of fipp, but at a slight performance cost. 292 293 `zprint' – to use zprint, a fast and flexible alternative to the libraries 294 mentioned above. 295 296 Alternatively can be the namespace-qualified name of a Clojure var whose 297 function takes three arguments: the object to print, the 298 \\=`java.io.PrintWriter\\=` to print on, and a (possibly nil) map of 299 options. If the function cannot be resolved, will behave as if set to 300 nil." 301 :type '(choice (const nil) 302 (const pr) 303 (const pprint) 304 (const fipp) 305 (const puget) 306 (const zprint) 307 string) 308 :group 'cider 309 :package-version '(cider . "0.21.0")) 310 311 (defcustom cider-print-options nil 312 "A map of options that will be passed to `cider-print-fn'. 313 Here's an example for `pprint': 314 315 '((\"length\" 50) (\"right-margin\" 70))" 316 :type 'list 317 :group 'cider 318 :package-version '(cider . "0.21.0")) 319 320 (make-obsolete-variable 'cider-pprint-fn 'cider-print-fn "0.21") 321 (make-obsolete-variable 'cider-pprint-options 'cider-print-options "0.21") 322 323 (defcustom cider-print-quota (* 1024 1024) 324 "A hard limit on the number of bytes to return from any printing operation. 325 Set to nil for no limit." 326 :type 'integer 327 :group 'cider 328 :package-version '(cider . "0.21.0")) 329 330 (defcustom cider-print-buffer-size (* 4 1024) 331 "The size in bytes of each value/output chunk when using print streaming. 332 Smaller values mean smaller data chunks and faster feedback, but they also mean 333 smaller results that can be font-locked as Clojure in the REPL buffers, as only 334 a single chunk result can be font-locked. 335 336 The default value in nREPL is 1024." 337 :type 'integer 338 :group 'cider 339 :package-version '(cider . "0.25.0")) 340 341 (defun cider--print-fn () 342 "Return the value to send in the nrepl.middleware.print/print slot." 343 (pcase cider-print-fn 344 (`pr "cider.nrepl.pprint/pr") 345 (`pprint "cider.nrepl.pprint/pprint") 346 (`fipp "cider.nrepl.pprint/fipp-pprint") 347 (`puget "cider.nrepl.pprint/puget-pprint") 348 (`zprint "cider.nrepl.pprint/zprint-pprint") 349 (_ cider-print-fn))) 350 351 (defvar cider--print-options-mapping 352 '((right-margin 353 ((fipp . width) (puget . width) (zprint . width))) 354 (length 355 ((fipp . print-length) (puget . print-length) (zprint . max-length))) 356 (level 357 ((fipp . print-level) (puget . print-level) (zprint . max-depth)))) 358 "A mapping of print option for the various supported print engines.") 359 360 (defun cider--print-option (name printer) 361 "Convert the generic NAME to its PRINTER specific variant. 362 E.g. pprint's right-margin would become width for fipp. 363 The function is useful when you want to generate dynamically 364 print options. 365 366 NAME can be a string or a symbol. PRINTER has to be a symbol. 367 The result will be a string." 368 (let* ((name (cider-maybe-intern name)) 369 (result (cdr (assoc printer (cadr (assoc name cider--print-options-mapping)))))) 370 (symbol-name (or result name)))) 371 372 (defun cider--nrepl-print-request-map (&optional right-margin) 373 "Map to merge into requests that require pretty-printing. 374 RIGHT-MARGIN specifies the maximum column-width of the printed result, and 375 is included in the request if non-nil." 376 (let* ((width-option (cider--print-option "right-margin" cider-print-fn)) 377 (print-options (thread-last 378 (map-merge 'hash-table 379 `((,width-option ,right-margin)) 380 cider-print-options) 381 (map-pairs) 382 (seq-mapcat #'identity) 383 (apply #'nrepl-dict)))) 384 (map-merge 'list 385 `(("nrepl.middleware.print/stream?" "1")) 386 (when cider-print-fn 387 `(("nrepl.middleware.print/print" ,(cider--print-fn)))) 388 (when cider-print-quota 389 `(("nrepl.middleware.print/quota" ,cider-print-quota))) 390 (when cider-print-buffer-size 391 `(("nrepl.middleware.print/buffer-size" ,cider-print-buffer-size))) 392 (unless (nrepl-dict-empty-p print-options) 393 `(("nrepl.middleware.print/options" ,print-options)))))) 394 395 (defun cider--nrepl-pr-request-map () 396 "Map to merge into requests that do not require pretty printing." 397 (let ((print-options (thread-last 398 cider-print-options 399 (map-pairs) 400 (seq-mapcat #'identity) 401 (apply #'nrepl-dict)))) 402 (map-merge 'list 403 `(("nrepl.middleware.print/print" "cider.nrepl.pprint/pr") 404 ("nrepl.middleware.print/stream?" nil)) 405 (unless (nrepl-dict-empty-p print-options) 406 `(("nrepl.middleware.print/options" ,print-options))) 407 (when cider-print-quota 408 `(("nrepl.middleware.print/quota" ,cider-print-quota)))))) 409 410 (defun cider--nrepl-content-type-map () 411 "Map to be merged into an eval request to make it use content-types." 412 '(("content-type" "true"))) 413 414 (defun cider-tooling-eval (input callback &optional ns connection) 415 "Send the request INPUT to CONNECTION and register the CALLBACK. 416 NS specifies the namespace in which to evaluate the request. Requests 417 evaluated in the tooling nREPL session don't affect the thread-local 418 bindings of the primary eval nREPL session (e.g. this is not going to 419 clobber *1/2/3)." 420 ;; namespace forms are always evaluated in the "user" namespace 421 (nrepl-request:eval input 422 callback 423 (or connection (cider-current-repl nil 'ensure)) 424 ns nil nil nil 'tooling)) 425 426 (defun cider-sync-tooling-eval (input &optional ns connection) 427 "Send the request INPUT to CONNECTION and evaluate in synchronously. 428 NS specifies the namespace in which to evaluate the request. Requests 429 evaluated in the tooling nREPL session don't affect the thread-local 430 bindings of the primary eval nREPL session (e.g. this is not going to 431 clobber *1/2/3)." 432 ;; namespace forms are always evaluated in the "user" namespace 433 (nrepl-sync-request:eval input 434 (or connection (cider-current-repl nil 'ensure)) 435 ns 436 'tooling)) 437 438 (defun cider-library-present-p (lib-ns) 439 "Check whether LIB-NS is present. 440 If a certain well-known ns in a library is present we assume that library 441 itself is present." 442 (nrepl-dict-get (cider-sync-tooling-eval (format "(require '%s)" lib-ns)) "value")) 443 444 445 ;;; Interrupt evaluation 446 447 (defun cider-interrupt-handler (buffer) 448 "Create an interrupt response handler for BUFFER." 449 (nrepl-make-response-handler buffer nil nil nil nil)) 450 451 (defun cider-interrupt () 452 "Interrupt any pending evaluations." 453 (interactive) 454 ;; FIXME: does this work correctly in cljc files? 455 (with-current-buffer (cider-current-repl nil 'ensure) 456 (let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests))) 457 (dolist (request-id pending-request-ids) 458 (nrepl-request:interrupt 459 request-id 460 (cider-interrupt-handler (current-buffer)) 461 (cider-current-repl)))))) 462 463 (defun cider-nrepl-eval-session () 464 "Return the eval nREPL session id of the current connection." 465 (with-current-buffer (cider-current-repl) 466 nrepl-session)) 467 468 (defun cider-nrepl-tooling-session () 469 "Return the tooling nREPL session id of the current connection." 470 (with-current-buffer (cider-current-repl) 471 nrepl-tooling-session)) 472 473 (defun cider--var-choice (var-info) 474 "Prompt to choose from among multiple VAR-INFO candidates, if required. 475 This is needed only when the symbol queried is an unqualified host platform 476 method, and multiple classes have a so-named member. If VAR-INFO does not 477 contain a `candidates' key, it is returned as is." 478 (let ((candidates (nrepl-dict-get var-info "candidates"))) 479 (if candidates 480 (let* ((classes (nrepl-dict-keys candidates)) 481 (choice (completing-read "Member in class: " classes nil t)) 482 (info (nrepl-dict-get candidates choice))) 483 info) 484 var-info))) 485 486 ;; FIXME: Now that nREPL supports a lookup op natively, we should 487 ;; remove this eval-based hack at some point. 488 (defconst cider-info-form " 489 (do 490 (require 'clojure.java.io) 491 (require 'clojure.walk) 492 493 (if-let [var (resolve '%s)] 494 (let [info (meta var)] 495 (-> info 496 (update :ns str) 497 (update :name str) 498 (update :file (comp str clojure.java.io/resource)) 499 (cond-> (:macro info) (update :macro str)) 500 (cond-> (:special-form info) (update :special-form str)) 501 (cond-> (:protocol info) (update :protocol str)) 502 (cond-> (:arglists info) (update :arglists str)) 503 (assoc :arglists-str (str (:arglists info))) 504 (clojure.walk/stringify-keys))))) 505 ") 506 507 (defun cider-fallback-eval:info (var) 508 "Obtain VAR metadata via a regular eval. 509 Used only when the info nREPL middleware is not available." 510 (let* ((response (cider-sync-tooling-eval (format cider-info-form var))) 511 (var-info (nrepl-dict-from-hash (parseedn-read-str (nrepl-dict-get response "value"))))) 512 var-info)) 513 514 (defun cider-var-info (var &optional all) 515 "Return VAR's info as an alist with list cdrs. 516 When multiple matching vars are returned you'll be prompted to select one, 517 unless ALL is truthy." 518 (when (and var (not (string= var ""))) 519 (let ((var-info (cond 520 ((cider-nrepl-op-supported-p "info") (cider-sync-request:info var)) 521 ((cider-nrepl-op-supported-p "lookup") (cider-sync-request:lookup var)) 522 (t (cider-fallback-eval:info var))))) 523 (if all var-info (cider--var-choice var-info))))) 524 525 (defun cider-member-info (class member) 526 "Return the CLASS MEMBER's info as an alist with list cdrs." 527 (when (and class member) 528 (cider-sync-request:info nil class member))) 529 530 531 ;;; Requests 532 533 (declare-function cider-load-file-handler "cider-eval") 534 (defun cider-request:load-file (file-contents file-path file-name &optional connection callback) 535 "Perform the nREPL \"load-file\" op. 536 FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be 537 loaded. If CONNECTION is nil, use `cider-current-repl'. If CALLBACK 538 is nil, use `cider-load-file-handler'." 539 (cider-nrepl-send-request `("op" "load-file" 540 "file" ,file-contents 541 "file-path" ,file-path 542 "file-name" ,file-name) 543 (or callback 544 (cider-load-file-handler (current-buffer))) 545 connection)) 546 547 548 ;;; Sync Requests 549 550 (defcustom cider-filtered-namespaces-regexps 551 '("^cider.nrepl" "^refactor-nrepl" "^nrepl") 552 "List of regexps used to filter out some vars/symbols/namespaces. 553 When nil, nothing is filtered out. Otherwise, all namespaces matching any 554 regexp from this list are dropped out of the \"ns-list\" op. Also, 555 \"apropos\" won't include vars from such namespaces. This list is passed 556 on to the nREPL middleware without any pre-processing. So the regexps have 557 to be in Clojure format (with twice the number of backslashes) and not 558 Emacs Lisp." 559 :type '(repeat string) 560 :safe #'listp 561 :group 'cider 562 :package-version '(cider . "0.13.0")) 563 564 (defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p) 565 "Send \"apropos\" request for regexp QUERY. 566 567 Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." 568 (let* ((query (replace-regexp-in-string "[ \t]+" ".+" query)) 569 (response (cider-nrepl-send-sync-request 570 `("op" "apropos" 571 "ns" ,(cider-current-ns) 572 "query" ,query 573 ,@(when search-ns `("search-ns" ,search-ns)) 574 ,@(when docs-p '("docs?" "t")) 575 ,@(when privates-p '("privates?" "t")) 576 ,@(when case-sensitive-p '("case-sensitive?" "t")) 577 "exclude-regexps" ,cider-filtered-namespaces-regexps)))) 578 (if (member "apropos-regexp-error" (nrepl-dict-get response "status")) 579 (user-error "Invalid regexp: %s" (nrepl-dict-get response "error-msg")) 580 (nrepl-dict-get response "apropos-matches")))) 581 582 (defun cider-sync-request:classpath () 583 "Return a list of classpath entries." 584 (cider-ensure-op-supported "classpath") 585 (thread-first 586 '("op" "classpath") 587 (cider-nrepl-send-sync-request) 588 (nrepl-dict-get "classpath"))) 589 590 (defun cider--get-abs-path (path project) 591 "Resolve PATH to an absolute path relative to PROJECT. 592 Do nothing if PATH is already absolute." 593 (if (not (file-name-absolute-p path)) 594 (expand-file-name path project) 595 path)) 596 597 (defun cider-fallback-eval:classpath () 598 "Return a list of classpath entries using eval. 599 600 Sometimes the classpath contains entries like src/main and we need to 601 resolve those to absolute paths." 602 (when (cider-runtime-clojure-p) 603 (let ((classpath (thread-first 604 "(seq (.split (System/getProperty \"java.class.path\") \":\"))" 605 (cider-sync-tooling-eval) 606 (nrepl-dict-get "value") 607 read)) 608 (project (clojure-project-dir))) 609 (mapcar (lambda (path) (cider--get-abs-path path project)) classpath)))) 610 611 (defun cider-classpath-entries () 612 "Return a list of classpath entries." 613 (seq-map #'expand-file-name ; normalize filenames for e.g. Windows 614 (if (cider-nrepl-op-supported-p "classpath") 615 (cider-sync-request:classpath) 616 (cider-fallback-eval:classpath)))) 617 618 (defun cider-sync-request:completion (prefix) 619 "Return a list of completions for PREFIX using nREPL's \"completion\" op." 620 (when-let* ((dict (thread-first `("op" "completions" 621 "ns" ,(cider-current-ns) 622 "prefix" ,prefix) 623 (cider-nrepl-send-sync-request (cider-current-repl) 624 'abort-on-input)))) 625 (nrepl-dict-get dict "completions"))) 626 627 (defun cider-sync-request:complete (prefix context) 628 "Return a list of completions for PREFIX using nREPL's \"complete\" op. 629 CONTEXT represents a completion context for compliment." 630 (when-let* ((dict (thread-first `("op" "complete" 631 "ns" ,(cider-current-ns) 632 "prefix" ,prefix 633 "context" ,context 634 ,@(when cider-enhanced-cljs-completion-p '("enhanced-cljs-completion?" "t"))) 635 (cider-nrepl-send-sync-request (cider-current-repl) 636 'abort-on-input)))) 637 (nrepl-dict-get dict "completions"))) 638 639 (defun cider-sync-request:complete-flush-caches () 640 "Send \"complete-flush-caches\" op to flush Compliment's caches." 641 (cider-nrepl-send-sync-request (list "op" "complete-flush-caches" 642 "session" (cider-nrepl-eval-session)) 643 nil 644 'abort-on-input)) 645 646 (defun cider-sync-request:info (symbol &optional class member) 647 "Send \"info\" op with parameters SYMBOL or CLASS and MEMBER." 648 (let ((var-info (thread-first `("op" "info" 649 "ns" ,(cider-current-ns) 650 ,@(when symbol `("sym" ,symbol)) 651 ,@(when class `("class" ,class)) 652 ,@(when member `("member" ,member))) 653 (cider-nrepl-send-sync-request (cider-current-repl))))) 654 (if (member "no-info" (nrepl-dict-get var-info "status")) 655 nil 656 var-info))) 657 658 (defun cider-sync-request:lookup (symbol &optional lookup-fn) 659 "Send \"lookup\" op request with parameters SYMBOL and LOOKUP-FN." 660 (let ((var-info (thread-first `("op" "lookup" 661 "ns" ,(cider-current-ns) 662 ,@(when symbol `("sym" ,symbol)) 663 ,@(when lookup-fn `("lookup-fn" ,lookup-fn))) 664 (cider-nrepl-send-sync-request (cider-current-repl))))) 665 (if (member "lookup-error" (nrepl-dict-get var-info "status")) 666 nil 667 (nrepl-dict-get var-info "info")))) 668 669 (defun cider-sync-request:eldoc (symbol &optional class member) 670 "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER." 671 (when-let* ((eldoc (thread-first `("op" "eldoc" 672 "ns" ,(cider-current-ns) 673 ,@(when symbol `("sym" ,symbol)) 674 ,@(when class `("class" ,class)) 675 ,@(when member `("member" ,member))) 676 (cider-nrepl-send-sync-request (cider-current-repl) 677 'abort-on-input)))) 678 (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) 679 nil 680 eldoc))) 681 682 (defun cider-sync-request:eldoc-datomic-query (symbol) 683 "Send \"eldoc-datomic-query\" op with parameter SYMBOL." 684 (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query" 685 "ns" ,(cider-current-ns) 686 ,@(when symbol `("sym" ,symbol))) 687 (cider-nrepl-send-sync-request nil 'abort-on-input)))) 688 (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) 689 nil 690 eldoc))) 691 692 (defun cider-sync-request:spec-list (&optional filter-regex) 693 "Get a list of the available specs in the registry. 694 Optional argument FILTER-REGEX filters specs. By default, all specs are 695 returned." 696 (setq filter-regex (or filter-regex "")) 697 (thread-first `("op" "spec-list" 698 "filter-regex" ,filter-regex 699 "ns" ,(cider-current-ns)) 700 (cider-nrepl-send-sync-request) 701 (nrepl-dict-get "spec-list"))) 702 703 (defun cider-sync-request:spec-form (spec) 704 "Get SPEC's form from registry." 705 (thread-first `("op" "spec-form" 706 "spec-name" ,spec 707 "ns" ,(cider-current-ns)) 708 (cider-nrepl-send-sync-request) 709 (nrepl-dict-get "spec-form"))) 710 711 (defun cider-sync-request:spec-example (spec) 712 "Get an example for SPEC." 713 (thread-first `("op" "spec-example" 714 "spec-name" ,spec) 715 (cider-nrepl-send-sync-request) 716 (nrepl-dict-get "spec-example"))) 717 718 (defun cider-sync-request:ns-list () 719 "Get a list of the available namespaces." 720 (thread-first `("op" "ns-list" 721 "exclude-regexps" ,cider-filtered-namespaces-regexps) 722 (cider-nrepl-send-sync-request) 723 (nrepl-dict-get "ns-list"))) 724 725 (defun cider-sync-request:ns-vars (ns) 726 "Get a list of the vars in NS." 727 (thread-first `("op" "ns-vars" 728 "ns" ,ns) 729 (cider-nrepl-send-sync-request) 730 (nrepl-dict-get "ns-vars"))) 731 732 (defun cider-sync-request:ns-path (ns) 733 "Get the path to the file containing NS." 734 (thread-first `("op" "ns-path" 735 "ns" ,ns) 736 (cider-nrepl-send-sync-request) 737 (nrepl-dict-get "path"))) 738 739 (defun cider-sync-request:ns-vars-with-meta (ns) 740 "Get a map of the vars in NS to its metadata information." 741 (thread-first `("op" "ns-vars-with-meta" 742 "ns" ,ns) 743 (cider-nrepl-send-sync-request) 744 (nrepl-dict-get "ns-vars-with-meta"))) 745 746 (defun cider-sync-request:private-ns-vars-with-meta (ns) 747 "Get a map of the vars in NS to its metadata information." 748 (thread-first `("op" "ns-vars-with-meta" 749 "ns" ,ns 750 "var-query" ,(nrepl-dict "private?" "t" 751 "include-meta-key" '("private"))) 752 (cider-nrepl-send-sync-request) 753 (nrepl-dict-get "ns-vars-with-meta"))) 754 755 (defun cider-sync-request:ns-load-all () 756 "Load all project namespaces." 757 (thread-first '("op" "ns-load-all") 758 (cider-nrepl-send-sync-request) 759 (nrepl-dict-get "loaded-ns"))) 760 761 (defun cider-sync-request:resource (name) 762 "Perform nREPL \"resource\" op with resource name NAME." 763 (thread-first `("op" "resource" 764 "name" ,name) 765 (cider-nrepl-send-sync-request) 766 (nrepl-dict-get "resource-path"))) 767 768 (defun cider-sync-request:resources-list () 769 "Return a list of all resources on the classpath. 770 The result entries are relative to the classpath." 771 (when-let* ((resources (thread-first '("op" "resources-list") 772 (cider-nrepl-send-sync-request) 773 (nrepl-dict-get "resources-list")))) 774 (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources))) 775 776 (defun cider-sync-request:fn-refs (ns sym) 777 "Return a list of functions that reference the function identified by NS and SYM." 778 (cider-ensure-op-supported "fn-refs") 779 (thread-first `("op" "fn-refs" 780 "ns" ,ns 781 "sym" ,sym) 782 (cider-nrepl-send-sync-request) 783 (nrepl-dict-get "fn-refs"))) 784 785 (defun cider-sync-request:fn-deps (ns sym) 786 "Return a list of function deps for the function identified by NS and SYM." 787 (cider-ensure-op-supported "fn-deps") 788 (thread-first `("op" "fn-deps" 789 "ns" ,ns 790 "sym" ,sym) 791 (cider-nrepl-send-sync-request) 792 (nrepl-dict-get "fn-deps"))) 793 794 (defun cider-sync-request:format-code (code &optional format-options) 795 "Perform nREPL \"format-code\" op with CODE. 796 FORMAT-OPTIONS is an optional configuration map for cljfmt." 797 (let* ((request `("op" "format-code" 798 "options" ,(cider--nrepl-format-code-request-map format-options) 799 "code" ,code)) 800 (response (cider-nrepl-send-sync-request request)) 801 (err (nrepl-dict-get response "err"))) 802 (when err 803 ;; err will be a stacktrace with a first line that looks like: 804 ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" 805 (error (car (split-string err "\n")))) 806 (nrepl-dict-get response "formatted-code"))) 807 808 (defun cider-sync-request:format-edn (edn right-margin) 809 "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." 810 (let* ((request (thread-last 811 (map-merge 'list 812 `(("op" "format-edn") 813 ("edn" ,edn)) 814 (cider--nrepl-print-request-map right-margin)) 815 (seq-mapcat #'identity))) 816 (response (cider-nrepl-send-sync-request request)) 817 (err (nrepl-dict-get response "err"))) 818 (when err 819 ;; err will be a stacktrace with a first line that looks like: 820 ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" 821 (error (car (split-string err "\n")))) 822 (nrepl-dict-get response "formatted-edn"))) 823 824 ;;; Dealing with input 825 ;; TODO: Replace this with some nil handler. 826 (defun cider-stdin-handler (&optional _buffer) 827 "Make a stdin response handler for _BUFFER." 828 (nrepl-make-response-handler (current-buffer) 829 (lambda (_buffer _value)) 830 (lambda (_buffer _out)) 831 (lambda (_buffer _err)) 832 nil)) 833 834 (defun cider-need-input (buffer) 835 "Handle an need-input request from BUFFER." 836 (with-current-buffer buffer 837 (let ((map (make-sparse-keymap))) 838 (set-keymap-parent map minibuffer-local-map) 839 (define-key map (kbd "C-c C-c") #'abort-recursive-edit) 840 (let ((stdin (condition-case nil 841 (concat (read-from-minibuffer "Stdin: " nil map) "\n") 842 (quit nil)))) 843 (nrepl-request:stdin stdin 844 (cider-stdin-handler buffer) 845 (cider-current-repl)))))) 846 847 (provide 'cider-client) 848 849 ;;; cider-client.el ends here