cider-repl.el (80434B)
1 ;;; cider-repl.el --- CIDER REPL mode interactions -*- lexical-binding: t -*- 2 3 ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov 4 ;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors 5 ;; 6 ;; Author: Tim King <kingtim@gmail.com> 7 ;; Phil Hagelberg <technomancy@gmail.com> 8 ;; Bozhidar Batsov <bozhidar@batsov.dev> 9 ;; Artur Malabarba <bruce.connor.am@gmail.com> 10 ;; Hugo Duncan <hugo@hugoduncan.org> 11 ;; Steve Purcell <steve@sanityinc.com> 12 ;; Reid McKenzie <me@arrdem.com> 13 14 ;; This program is free software: you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation, either version 3 of the License, or 17 ;; (at your option) any later version. 18 19 ;; This program is distributed in the hope that it will be useful, 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; GNU General Public License for more details. 23 24 ;; You should have received a copy of the GNU General Public License 25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 26 27 ;; This file is not part of GNU Emacs. 28 29 ;;; Commentary: 30 31 ;; This functionality concerns `cider-repl-mode' and REPL interaction. For 32 ;; REPL/connection life-cycle management see cider-connection.el. 33 34 ;;; Code: 35 36 (require 'cl-lib) 37 (require 'easymenu) 38 (require 'image) 39 (require 'map) 40 (require 'seq) 41 (require 'subr-x) 42 43 (require 'clojure-mode) 44 (require 'sesman) 45 46 (require 'cider-client) 47 (require 'cider-doc) 48 (require 'cider-test) 49 (require 'cider-eldoc) ; for cider-eldoc-setup 50 (require 'cider-common) 51 (require 'cider-util) 52 (require 'cider-resolve) 53 54 (declare-function cider-inspect "cider-inspector") 55 56 57 (defgroup cider-repl nil 58 "Interaction with the REPL." 59 :prefix "cider-repl-" 60 :group 'cider) 61 62 (defface cider-repl-prompt-face 63 '((t (:inherit font-lock-keyword-face))) 64 "Face for the prompt in the REPL buffer.") 65 66 (defface cider-repl-stdout-face 67 '((t (:inherit font-lock-string-face))) 68 "Face for STDOUT output in the REPL buffer.") 69 70 (defface cider-repl-stderr-face 71 '((t (:inherit font-lock-warning-face))) 72 "Face for STDERR output in the REPL buffer." 73 :package-version '(cider . "0.6.0")) 74 75 (defface cider-repl-input-face 76 '((t (:bold t))) 77 "Face for previous input in the REPL buffer.") 78 79 (defface cider-repl-result-face 80 '((t ())) 81 "Face for the result of an evaluation in the REPL buffer.") 82 83 (defcustom cider-repl-pop-to-buffer-on-connect t 84 "Controls whether to pop to the REPL buffer on connect. 85 86 When set to nil the buffer will only be created, and not displayed. When 87 set to `display-only' the buffer will be displayed, but it will not become 88 focused. Otherwise the buffer is displayed and focused." 89 :type '(choice (const :tag "Create the buffer, but don't display it" nil) 90 (const :tag "Create and display the buffer, but don't focus it" 91 display-only) 92 (const :tag "Create, display, and focus the buffer" t))) 93 94 (defcustom cider-repl-display-in-current-window nil 95 "Controls whether the REPL buffer is displayed in the current window." 96 :type 'boolean) 97 98 (make-obsolete-variable 'cider-repl-scroll-on-output 'scroll-conservatively "0.21") 99 100 (defcustom cider-repl-use-pretty-printing t 101 "Control whether results in the REPL are pretty-printed or not. 102 The REPL will use the printer specified in `cider-print-fn'. 103 The `cider-toggle-pretty-printing' command can be used to interactively 104 change the setting's value." 105 :type 'boolean) 106 107 (make-obsolete-variable 'cider-repl-pretty-print-width 'cider-print-options "0.21") 108 109 (defcustom cider-repl-use-content-types nil 110 "Control whether REPL results are presented using content-type information. 111 The `cider-repl-toggle-content-types' command can be used to interactively 112 change the setting's value." 113 :type 'boolean 114 :package-version '(cider . "0.17.0")) 115 116 (defcustom cider-repl-auto-detect-type t 117 "Control whether to auto-detect the REPL type using track-state information. 118 If you disable this you'll have to manually change the REPL type between 119 Clojure and ClojureScript when invoking REPL type changing forms. 120 Use `cider-set-repl-type' to manually change the REPL type." 121 :type 'boolean 122 :safe #'booleanp 123 :package-version '(cider . "0.18.0")) 124 125 (defcustom cider-repl-use-clojure-font-lock t 126 "Non-nil means to use Clojure mode font-locking for input and result. 127 Nil means that `cider-repl-input-face' and `cider-repl-result-face' 128 will be used." 129 :type 'boolean 130 :package-version '(cider . "0.10.0")) 131 132 (defcustom cider-repl-require-ns-on-set nil 133 "Controls whether to require the ns before setting it in the REPL." 134 :type 'boolean 135 :package-version '(cider . "0.22.0")) 136 137 (defcustom cider-repl-result-prefix "" 138 "The prefix displayed in the REPL before a result value. 139 By default there's no prefix, but you can specify something 140 like \"=>\" if want results to stand out more." 141 :type 'string 142 :group 'cider 143 :package-version '(cider . "0.5.0")) 144 145 (defcustom cider-repl-tab-command 'cider-repl-indent-and-complete-symbol 146 "Select the command to be invoked by the TAB key. 147 The default option is `cider-repl-indent-and-complete-symbol'. If 148 you'd like to use the default Emacs behavior use 149 `indent-for-tab-command'." 150 :type 'symbol) 151 152 (make-obsolete-variable 'cider-repl-print-length 'cider-print-options "0.21") 153 (make-obsolete-variable 'cider-repl-print-level 'cider-print-options "0.21") 154 155 (defvar cider-repl-require-repl-utils-code 156 '((clj . "(when-let [requires (resolve 'clojure.main/repl-requires)] 157 (clojure.core/apply clojure.core/require @requires))") 158 (cljs . "(require '[cljs.repl :refer [apropos dir doc find-doc print-doc pst source]])"))) 159 160 (defcustom cider-repl-init-code (list (cdr (assoc 'clj cider-repl-require-repl-utils-code))) 161 "Clojure code to evaluate when starting a REPL. 162 Will be evaluated with bindings for set!-able vars in place." 163 :type '(list string) 164 :package-version '(cider . "0.21.0")) 165 166 (defcustom cider-repl-display-help-banner t 167 "When non-nil a bit of help text will be displayed on REPL start." 168 :type 'boolean 169 :package-version '(cider . "0.11.0")) 170 171 ;; See https://github.com/clojure-emacs/cider/issues/3219 for more details 172 (defcustom cider-repl-display-output-before-window-boundaries nil 173 "Controls whether to display output emitted before the REPL window boundaries. 174 175 If the prompt is on the first line of the window, then scroll the window 176 down by a single line to make the emitted output visible. 177 178 That behavior is desirable, but rarely needed and it slows down printing 179 output a lot (e.g. 10x) that's why it's disable by default starting with 180 CIDER 1.7." 181 :type 'boolean 182 :package-version '(cider . "1.7.0")) 183 184 185 ;;;; REPL buffer local variables 186 (defvar-local cider-repl-input-start-mark nil) 187 188 (defvar-local cider-repl-prompt-start-mark nil) 189 190 (defvar-local cider-repl-old-input-counter 0 191 "Counter used to generate unique `cider-old-input' properties. 192 This property value must be unique to avoid having adjacent inputs be 193 joined together.") 194 195 (defvar-local cider-repl-input-history '() 196 "History list of strings read from the REPL buffer.") 197 198 (defvar-local cider-repl-input-history-items-added 0 199 "Variable counting the items added in the current session.") 200 201 (defvar-local cider-repl-output-start nil 202 "Marker for the start of output. 203 Currently its only purpose is to facilitate `cider-repl-clear-buffer'.") 204 205 (defvar-local cider-repl-output-end nil 206 "Marker for the end of output. 207 Currently its only purpose is to facilitate `cider-repl-clear-buffer'.") 208 209 (defun cider-repl-tab () 210 "Invoked on TAB keystrokes in `cider-repl-mode' buffers." 211 (interactive) 212 (funcall cider-repl-tab-command)) 213 214 (defun cider-repl-reset-markers () 215 "Reset all REPL markers." 216 (dolist (markname '(cider-repl-output-start 217 cider-repl-output-end 218 cider-repl-prompt-start-mark 219 cider-repl-input-start-mark)) 220 (set markname (make-marker)) 221 (set-marker (symbol-value markname) (point)))) 222 223 224 ;;; REPL init 225 226 (defvar-local cider-repl-ns-cache nil 227 "A dict holding information about all currently loaded namespaces. 228 This cache is stored in the connection buffer.") 229 230 (defvar cider-mode) 231 (declare-function cider-refresh-dynamic-font-lock "cider-mode") 232 233 (defun cider-repl--state-handler (response) 234 "Handle server state contained in RESPONSE." 235 (with-demoted-errors "Error in `cider-repl--state-handler': %s" 236 (when (member "state" (nrepl-dict-get response "status")) 237 (nrepl-dbind-response response (repl-type changed-namespaces) 238 (when (and repl-type cider-repl-auto-detect-type) 239 (cider-set-repl-type repl-type)) 240 (when (eq (cider-maybe-intern repl-type) 'cljs) 241 (setq cider-repl-cljs-upgrade-pending nil)) 242 (unless (nrepl-dict-empty-p changed-namespaces) 243 (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces)) 244 (dolist (b (buffer-list)) 245 (with-current-buffer b 246 ;; Metadata changed, so signatures may have changed too. 247 (setq cider-eldoc-last-symbol nil) 248 (when (or cider-mode (derived-mode-p 'cider-repl-mode)) 249 (when-let* ((ns-dict (or (nrepl-dict-get changed-namespaces (cider-current-ns)) 250 (let ((ns-dict (cider-resolve--get-in (cider-current-ns)))) 251 (when (seq-find (lambda (ns) (nrepl-dict-get changed-namespaces ns)) 252 (nrepl-dict-get ns-dict "aliases")) 253 ns-dict))))) 254 (cider-refresh-dynamic-font-lock ns-dict)))))))))) 255 256 (defun cider-repl-require-repl-utils () 257 "Require standard REPL util functions into the current REPL." 258 (interactive) 259 (let* ((current-repl (cider-current-repl nil 'ensure)) 260 (require-code (cdr (assoc (cider-repl-type current-repl) cider-repl-require-repl-utils-code)))) 261 (nrepl-send-sync-request 262 (lax-plist-put 263 (nrepl--eval-request require-code (cider-current-ns)) 264 "inhibit-cider-middleware" "true") 265 current-repl))) 266 267 (defun cider-repl-init-eval-handler (&optional callback) 268 "Make an nREPL evaluation handler for use during REPL init. 269 Run CALLBACK once the evaluation is complete." 270 (nrepl-make-response-handler (current-buffer) 271 (lambda (_buffer _value)) 272 (lambda (buffer out) 273 (cider-repl-emit-stdout buffer out)) 274 (lambda (buffer err) 275 (cider-repl-emit-stderr buffer err)) 276 (lambda (buffer) 277 (cider-repl-emit-prompt buffer) 278 (when callback 279 (funcall callback))))) 280 281 (defun cider-repl-eval-init-code (&optional callback) 282 "Evaluate `cider-repl-init-code' in the current REPL. 283 Run CALLBACK once the evaluation is complete." 284 (interactive) 285 (let* ((request (map-merge 'hash-table 286 (cider--repl-request-map fill-column) 287 '(("inhibit-cider-middleware" "true"))))) 288 (cider-nrepl-request:eval 289 ;; Ensure we evaluate _something_ so the initial namespace is correctly set 290 (thread-first (or cider-repl-init-code '("nil")) 291 (string-join "\n")) 292 (cider-repl-init-eval-handler callback) 293 nil 294 (line-number-at-pos (point)) 295 (cider-column-number-at-pos (point)) 296 (thread-last 297 request 298 (map-pairs) 299 (seq-mapcat #'identity))))) 300 301 (defun cider-repl-init (buffer &optional callback) 302 "Initialize the REPL in BUFFER. 303 BUFFER must be a REPL buffer with `cider-repl-mode' and a running 304 client process connection. CALLBACK will be run once the REPL is 305 fully initialized." 306 (when cider-repl-display-in-current-window 307 (add-to-list 'same-window-buffer-names (buffer-name buffer))) 308 (pcase cider-repl-pop-to-buffer-on-connect 309 (`display-only 310 (let ((orig-buffer (current-buffer))) 311 (display-buffer buffer) 312 ;; User popup-rules (specifically `:select nil') can cause the call to 313 ;; `display-buffer' to reset the current Emacs buffer to the clj/cljs 314 ;; buffer that the user ran `jack-in' from - we need the current-buffer 315 ;; to be the repl to initialize, so reset it back here to be resilient 316 ;; against user config 317 (set-buffer orig-buffer))) 318 ((pred identity) (pop-to-buffer buffer))) 319 (with-current-buffer buffer 320 (cider-repl--insert-banner) 321 (cider-repl--insert-startup-commands) 322 (when-let* ((window (get-buffer-window buffer t))) 323 (with-selected-window window 324 (recenter (- -1 scroll-margin)))) 325 (cider-repl-eval-init-code callback)) 326 buffer) 327 328 (defun cider-repl--insert-banner () 329 "Insert the banner in the current REPL buffer." 330 (insert-before-markers 331 (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face)) 332 (when cider-repl-display-help-banner 333 (insert-before-markers 334 (propertize (cider-repl--help-banner) 'font-lock-face 'font-lock-comment-face)))) 335 336 (defun cider-repl--insert-startup-commands () 337 "Insert the values from params specified in PARAM-TUPLES. 338 PARAM-TUPLES are tuples of (param-key description) or (param-key 339 description transform) where transform is called with the param-value if 340 present." 341 (cl-labels 342 ((emit-comment 343 (contents) 344 (insert-before-markers 345 (propertize 346 (if (string-blank-p contents) ";;\n" (concat ";; " contents "\n")) 347 'font-lock-face 'font-lock-comment-face)))) 348 (let ((jack-in-command (plist-get cider-launch-params :jack-in-cmd)) 349 (cljs-repl-type (plist-get cider-launch-params :cljs-repl-type)) 350 (cljs-init-form (plist-get cider-launch-params :repl-init-form))) 351 (when jack-in-command 352 ;; spaces to align with the banner 353 (emit-comment (concat " Startup: " jack-in-command))) 354 (when (or cljs-repl-type cljs-init-form) 355 (emit-comment "") 356 (when cljs-repl-type 357 (emit-comment (concat "ClojureScript REPL type: " (symbol-name cljs-repl-type)))) 358 (when cljs-init-form 359 (emit-comment (concat "ClojureScript REPL init form: " cljs-init-form))) 360 (emit-comment ""))))) 361 362 (defun cider-repl--banner () 363 "Generate the welcome REPL buffer banner." 364 (cond 365 ((cider--clojure-version) (cider-repl--clojure-banner)) 366 ((cider--babashka-version) (cider-repl--babashka-banner)) 367 (t (cider-repl--basic-banner)))) 368 369 (defun cider-repl--clojure-banner () 370 "Generate the welcome REPL buffer banner for Clojure(Script)." 371 (format ";; Connected to nREPL server - nrepl://%s:%s 372 ;; CIDER %s, nREPL %s 373 ;; Clojure %s, Java %s 374 ;; Docs: (doc function-name) 375 ;; (find-doc part-of-name) 376 ;; Source: (source function-name) 377 ;; Javadoc: (javadoc java-object-or-class) 378 ;; Exit: <C-c C-q> 379 ;; Results: Stored in vars *1, *2, *3, an exception in *e; 380 " 381 (plist-get nrepl-endpoint :host) 382 (plist-get nrepl-endpoint :port) 383 (cider--version) 384 (cider--nrepl-version) 385 (cider--clojure-version) 386 (cider--java-version))) 387 388 (defun cider-repl--babashka-banner () 389 "Generate the welcome REPL buffer banner for Babashka." 390 (format ";; Connected to nREPL server - nrepl://%s:%s 391 ;; CIDER %s, babashka.nrepl %s 392 ;; Babashka %s 393 ;; Docs: (doc function-name) 394 ;; (find-doc part-of-name) 395 ;; Source: (source function-name) 396 ;; Javadoc: (javadoc java-object-or-class) 397 ;; Exit: <C-c C-q> 398 ;; Results: Stored in vars *1, *2, *3, an exception in *e; 399 " 400 (plist-get nrepl-endpoint :host) 401 (plist-get nrepl-endpoint :port) 402 (cider--version) 403 (cider--babashka-nrepl-version) 404 (cider--babashka-version))) 405 406 (defun cider-repl--basic-banner () 407 "Generate a basic banner with minimal info." 408 (format ";; Connected to nREPL server - nrepl://%s:%s 409 ;; CIDER %s 410 " 411 (plist-get nrepl-endpoint :host) 412 (plist-get nrepl-endpoint :port) 413 (cider--version))) 414 415 (defun cider-repl--help-banner () 416 "Generate the help banner." 417 (substitute-command-keys 418 ";; ====================================================================== 419 ;; If you're new to CIDER it is highly recommended to go through its 420 ;; user manual first. Type <M-x cider-view-manual> to view it. 421 ;; In case you're seeing any warnings you should consult the manual's 422 ;; \"Troubleshooting\" section. 423 ;; 424 ;; Here are a few tips to get you started: 425 ;; 426 ;; * Press <\\[describe-mode]> to see a list of the keybindings available (this 427 ;; will work in every Emacs buffer) 428 ;; * Press <\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command 429 ;; * Press <\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure file 430 ;; * Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a 431 ;; Java method) 432 ;; * Press <\\[cider-doc]> to view the documentation for something (e.g. 433 ;; a var, a Java method) 434 ;; * Print CIDER's refcard and keep it close to your keyboard. 435 ;; 436 ;; CIDER is super customizable - try <M-x customize-group cider> to 437 ;; get a feel for this. If you're thirsty for knowledge you should try 438 ;; <M-x cider-drink-a-sip>. 439 ;; 440 ;; If you think you've encountered a bug (or have some suggestions for 441 ;; improvements) use <M-x cider-report-bug> to report it. 442 ;; 443 ;; Above all else - don't panic! In case of an emergency - procure 444 ;; some (hard) cider and enjoy it responsibly! 445 ;; 446 ;; You can remove this message with the <M-x cider-repl-clear-help-banner> command. 447 ;; You can disable it from appearing on start by setting 448 ;; `cider-repl-display-help-banner' to nil. 449 ;; ====================================================================== 450 ")) 451 452 453 ;;; REPL interaction 454 455 (defun cider-repl--in-input-area-p () 456 "Return t if in input area." 457 (<= cider-repl-input-start-mark (point))) 458 459 (defun cider-repl--current-input (&optional until-point-p) 460 "Return the current input as string. 461 The input is the region from after the last prompt to the end of 462 buffer. If UNTIL-POINT-P is non-nil, the input is until the current 463 point." 464 (buffer-substring-no-properties cider-repl-input-start-mark 465 (if until-point-p 466 (point) 467 (point-max)))) 468 469 (defun cider-repl-previous-prompt () 470 "Move backward to the previous prompt." 471 (interactive) 472 (cider-repl--find-prompt t)) 473 474 (defun cider-repl-next-prompt () 475 "Move forward to the next prompt." 476 (interactive) 477 (cider-repl--find-prompt)) 478 479 (defun cider-repl--find-prompt (&optional backward) 480 "Find the next prompt. 481 If BACKWARD is non-nil look backward." 482 (let ((origin (point)) 483 (cider-repl-prompt-property 'field)) 484 (while (progn 485 (cider-search-property-change cider-repl-prompt-property backward) 486 (not (or (cider-end-of-proprange-p cider-repl-prompt-property) (bobp) (eobp))))) 487 (unless (cider-end-of-proprange-p cider-repl-prompt-property) 488 (goto-char origin)))) 489 490 (defun cider-search-property-change (prop &optional backward) 491 "Search forward for a property change to PROP. 492 If BACKWARD is non-nil search backward." 493 (cond (backward 494 (goto-char (previous-single-char-property-change (point) prop))) 495 (t 496 (goto-char (next-single-char-property-change (point) prop))))) 497 498 (defun cider-end-of-proprange-p (property) 499 "Return t if at the the end of a property range for PROPERTY." 500 (and (get-char-property (max (point-min) (1- (point))) property) 501 (not (get-char-property (point) property)))) 502 503 (defun cider-repl--mark-input-start () 504 "Mark the input start." 505 (set-marker cider-repl-input-start-mark (point) (current-buffer))) 506 507 (defun cider-repl--mark-output-start () 508 "Mark the output start." 509 (set-marker cider-repl-output-start (point)) 510 (set-marker cider-repl-output-end (point))) 511 512 (defun cider-repl-mode-beginning-of-defun (&optional arg) 513 "Move to the beginning of defun. 514 If given a negative value of ARG, move to the end of defun." 515 (if (and arg (< arg 0)) 516 (cider-repl-mode-end-of-defun (- arg)) 517 (dotimes (_ (or arg 1)) 518 (cider-repl-previous-prompt)))) 519 520 (defun cider-repl-mode-end-of-defun (&optional arg) 521 "Move to the end of defun. 522 If given a negative value of ARG, move to the beginning of defun." 523 (if (and arg (< arg 0)) 524 (cider-repl-mode-beginning-of-defun (- arg)) 525 (dotimes (_ (or arg 1)) 526 (cider-repl-next-prompt)))) 527 528 (defun cider-repl-beginning-of-defun () 529 "Move to beginning of defun." 530 (interactive) 531 ;; We call `beginning-of-defun' if we're at the start of a prompt 532 ;; already, to trigger `cider-repl-mode-beginning-of-defun' by means 533 ;; of the locally bound `beginning-of-defun-function', in order to 534 ;; jump to the start of the previous prompt. 535 (if (and (not (cider-repl--at-prompt-start-p)) 536 (cider-repl--in-input-area-p)) 537 (goto-char cider-repl-input-start-mark) 538 (beginning-of-defun))) 539 540 (defun cider-repl-end-of-defun () 541 "Move to end of defun." 542 (interactive) 543 ;; C.f. `cider-repl-beginning-of-defun' 544 (if (and (not (= (point) (point-max))) 545 (cider-repl--in-input-area-p)) 546 (goto-char (point-max)) 547 (end-of-defun))) 548 549 (defun cider-repl-bol-mark () 550 "Set the mark and go to the beginning of line or the prompt." 551 (interactive) 552 (unless mark-active 553 (set-mark (point))) 554 (move-beginning-of-line 1)) 555 556 (defun cider-repl--at-prompt-start-p () 557 "Return t if point is at the start of prompt. 558 This will not work on non-current prompts." 559 (= (point) cider-repl-input-start-mark)) 560 561 (defmacro cider-save-marker (marker &rest body) 562 "Save MARKER and execute BODY." 563 (declare (debug t)) 564 (let ((pos (make-symbol "pos"))) 565 `(let ((,pos (marker-position ,marker))) 566 (prog1 (progn . ,body) 567 (set-marker ,marker ,pos))))) 568 569 (put 'cider-save-marker 'lisp-indent-function 1) 570 571 (defun cider-repl-prompt-default (namespace) 572 "Return a prompt string that mentions NAMESPACE." 573 (format "%s> " namespace)) 574 575 (defun cider-repl-prompt-abbreviated (namespace) 576 "Return a prompt string that abbreviates NAMESPACE." 577 (format "%s> " (cider-abbreviate-ns namespace))) 578 579 (defun cider-repl-prompt-lastname (namespace) 580 "Return a prompt string with the last name in NAMESPACE." 581 (format "%s> " (cider-last-ns-segment namespace))) 582 583 (defcustom cider-repl-prompt-function #'cider-repl-prompt-default 584 "A function that returns a prompt string. 585 Takes one argument, a namespace name. 586 For convenience, three functions are already provided for this purpose: 587 `cider-repl-prompt-lastname', `cider-repl-prompt-abbreviated', and 588 `cider-repl-prompt-default'." 589 :type '(choice (const :tag "Full namespace" cider-repl-prompt-default) 590 (const :tag "Abbreviated namespace" cider-repl-prompt-abbreviated) 591 (const :tag "Last name in namespace" cider-repl-prompt-lastname) 592 (function :tag "Custom function")) 593 :package-version '(cider . "0.9.0")) 594 595 (defun cider-repl--insert-prompt (namespace) 596 "Insert the prompt (before markers!), taking into account NAMESPACE. 597 Set point after the prompt. 598 Return the position of the prompt beginning." 599 (goto-char cider-repl-input-start-mark) 600 (cider-save-marker cider-repl-output-start 601 (cider-save-marker cider-repl-output-end 602 (unless (bolp) (insert-before-markers "\n")) 603 (let ((prompt-start (point)) 604 (prompt (funcall cider-repl-prompt-function namespace))) 605 (cider-propertize-region 606 '(font-lock-face cider-repl-prompt-face read-only t intangible t 607 field cider-repl-prompt 608 rear-nonsticky (field read-only font-lock-face intangible)) 609 (insert-before-markers prompt)) 610 (set-marker cider-repl-prompt-start-mark prompt-start) 611 prompt-start)))) 612 613 (defun cider-repl--ansi-color-apply (string) 614 "Like `ansi-color-apply', but does not withhold non-SGR seqs found in STRING. 615 616 Workaround for Emacs bug#53808 whereby partial ANSI control seqs present in 617 the input stream may block the whole colorization process." 618 (let* ((result (ansi-color-apply string)) 619 620 ;; The STRING may end with a possible incomplete ANSI control seq which 621 ;; the call to `ansi-color-apply' stores in the `ansi-color-context' 622 ;; fragment. If the fragment is not an incomplete ANSI color control 623 ;; sequence (aka SGR seq) though then flush it out and appended it to 624 ;; the result. 625 (fragment-flush? 626 (when-let (fragment (and ansi-color-context (cadr ansi-color-context))) 627 (save-match-data 628 ;; Check if fragment is indeed an SGR seq in the making. The SGR 629 ;; seq is defined as starting with ESC followed by [ followed by 630 ;; zero or more [:digit:]+; followed by one or more digits and 631 ;; ending with m. 632 (when (string-match 633 (rx (sequence ?\e 634 (? (and (or ?\[ eol) 635 (or (+ (any (?0 . ?9))) eol) 636 (* (sequence ?\; (+ (any (?0 . ?9))))) 637 (or ?\; eol))))) 638 fragment) 639 (let* ((sgr-end-pos (match-end 0)) 640 (fragment-matches-whole? (or (= sgr-end-pos 0) 641 (= sgr-end-pos (length fragment))))) 642 (when (not fragment-matches-whole?) 643 ;; Definitely not an partial SGR seq, flush it out of 644 ;; `ansi-color-context'. 645 t))))))) 646 647 (if (not fragment-flush?) 648 result 649 650 (progn 651 ;; Temporarily replace the ESC char in the fragment so that is flushed 652 ;; out of `ansi-color-context' by `ansi-color-apply' and append it to 653 ;; the result. 654 (aset (cadr ansi-color-context) 0 ?\0) 655 (let ((result-fragment (ansi-color-apply ""))) 656 (aset result-fragment 0 ?\e) 657 (concat result result-fragment)))))) 658 659 (defvar-local cider-repl--ns-forms-plist nil 660 "Plist holding ns->ns-form mappings within each connection.") 661 662 (defun cider-repl--ns-form-changed-p (ns-form connection) 663 "Return non-nil if NS-FORM for CONNECTION changed since last eval." 664 (when-let* ((ns (cider-ns-from-form ns-form))) 665 (not (string= ns-form 666 (lax-plist-get 667 (buffer-local-value 'cider-repl--ns-forms-plist connection) 668 ns))))) 669 670 (defvar cider-repl--root-ns-highlight-template "\\_<\\(%s\\)[^$/: \t\n()]+" 671 "Regexp used to highlight root ns in REPL buffers.") 672 673 (defvar-local cider-repl--root-ns-regexp nil 674 "Cache of root ns regexp in REPLs.") 675 676 (defvar-local cider-repl--ns-roots nil 677 "List holding all past root namespaces seen during interactive eval.") 678 679 (defun cider-repl--cache-ns-form (ns-form connection) 680 "Given NS-FORM cache root ns in CONNECTION." 681 (with-current-buffer connection 682 (when-let* ((ns (cider-ns-from-form ns-form))) 683 ;; cache ns-form 684 (setq cider-repl--ns-forms-plist 685 (lax-plist-put cider-repl--ns-forms-plist ns ns-form)) 686 ;; cache ns roots regexp 687 (when (string-match "\\([^.]+\\)" ns) 688 (let ((root (match-string-no-properties 1 ns))) 689 (unless (member root cider-repl--ns-roots) 690 (push root cider-repl--ns-roots) 691 (let ((roots (mapconcat 692 ;; Replace _ or - with regexp pattern to accommodate "raw" namespaces 693 (lambda (r) (replace-regexp-in-string "[_-]+" "[_-]+" r)) 694 cider-repl--ns-roots "\\|"))) 695 (setq cider-repl--root-ns-regexp 696 (format cider-repl--root-ns-highlight-template roots))))))))) 697 698 (defvar cider-repl-spec-keywords-regexp 699 (concat 700 (regexp-opt '("In:" " val:" 701 " at:" "fails at:" 702 " spec:" "fails spec:" 703 " predicate:" "fails predicate:")) 704 "\\|^" 705 (regexp-opt '(":clojure.spec.alpha/spec" 706 ":clojure.spec.alpha/value") 707 "\\(")) 708 "Regexp matching clojure.spec `explain` keywords.") 709 710 (defun cider-repl-highlight-spec-keywords (string) 711 "Highlight clojure.spec `explain` keywords in STRING. 712 Foreground of `clojure-keyword-face' is used for highlight." 713 (cider-add-face cider-repl-spec-keywords-regexp 714 'clojure-keyword-face t nil string) 715 string) 716 717 (defun cider-repl-highlight-current-project (string) 718 "Fontify project's root namespace to make stacktraces more readable. 719 Foreground of `cider-stacktrace-ns-face' is used to propertize matched 720 namespaces. STRING is REPL's output." 721 (cider-add-face cider-repl--root-ns-regexp 'cider-stacktrace-ns-face 722 t nil string) 723 string) 724 725 (defun cider-repl-add-locref-help-echo (string) 726 "Set help-echo property of STRING to `cider-locref-help-echo'." 727 (put-text-property 0 (length string) 'help-echo 'cider-locref-help-echo string) 728 string) 729 730 (defvar cider-repl-preoutput-hook `(,(if (< emacs-major-version 29) 731 'cider-repl--ansi-color-apply 732 'ansi-color-apply) 733 cider-repl-highlight-current-project 734 cider-repl-highlight-spec-keywords 735 cider-repl-add-locref-help-echo) 736 "Hook run on output string before it is inserted into the REPL buffer. 737 Each functions takes a string and must return a modified string. Also see 738 `cider-run-chained-hook'.") 739 740 (defcustom cider-repl-buffer-size-limit nil 741 "The max size of the REPL buffer. 742 Setting this to nil removes the limit." 743 :group 'cider 744 :type 'integer 745 :package-version '(cider . "0.26.0")) 746 747 (defun cider-start-of-next-prompt (point) 748 "Return the position of the first char of the next prompt from POINT." 749 (let ((next-prompt-or-input (next-single-char-property-change point 'field))) 750 (if (eq (get-char-property next-prompt-or-input 'field) 'cider-repl-prompt) 751 next-prompt-or-input 752 (next-single-char-property-change next-prompt-or-input 'field)))) 753 754 (defun cider-repl-trim-top-of-buffer (buffer) 755 "Trims REPL output from beginning of BUFFER. 756 Trims by one fifth of `cider-repl-buffer-size-limit'. 757 Also clears remaining partial input or results." 758 (with-current-buffer buffer 759 (let* ((to-trim (ceiling (* cider-repl-buffer-size-limit 0.2))) 760 (start-of-next-prompt (cider-start-of-next-prompt to-trim)) 761 (inhibit-read-only t)) 762 (cider-repl--clear-region (point-min) start-of-next-prompt)))) 763 764 (defun cider-repl-trim-buffer () 765 "Trim the currently visited REPL buffer partially from the top. 766 See also `cider-repl-clear-buffer'." 767 (interactive) 768 (if cider-repl-buffer-size-limit 769 (cider-repl-trim-top-of-buffer (current-buffer)) 770 (user-error "The variable `cider-repl-buffer-size-limit' is not set"))) 771 772 (defun cider-repl-maybe-trim-buffer (buffer) 773 "Clear portion of printed output in BUFFER. 774 Clear the part where `cider-repl-buffer-size-limit' is exceeded." 775 (when (> (buffer-size) cider-repl-buffer-size-limit) 776 (cider-repl-trim-top-of-buffer buffer))) 777 778 (defun cider-repl--emit-output (buffer string face) 779 "Using BUFFER, emit STRING as output font-locked using FACE. 780 Before inserting, run `cider-repl-preoutput-hook' on STRING." 781 (with-current-buffer buffer 782 (save-excursion 783 (cider-save-marker cider-repl-output-start 784 (goto-char cider-repl-output-end) 785 (setq string (propertize string 786 'font-lock-face face 787 'rear-nonsticky '(font-lock-face))) 788 (setq string (cider-run-chained-hook 'cider-repl-preoutput-hook string)) 789 (insert-before-markers string)) 790 (when (and (= (point) cider-repl-prompt-start-mark) 791 (not (bolp))) 792 (insert-before-markers "\n") 793 (set-marker cider-repl-output-end (1- (point)))))) 794 (when cider-repl-display-output-before-window-boundaries 795 ;; FIXME: The code below is super slow, that's why it's disabled by default. 796 (when-let* ((window (get-buffer-window buffer t))) 797 ;; If the prompt is on the first line of the window, then scroll the window 798 ;; down by a single line to make the emitted output visible. 799 (when (and (pos-visible-in-window-p cider-repl-prompt-start-mark window) 800 (< 1 cider-repl-prompt-start-mark) 801 (not (pos-visible-in-window-p (1- cider-repl-prompt-start-mark) window))) 802 (with-selected-window window 803 (scroll-down 1)))))) 804 805 (defun cider-repl--emit-interactive-output (string face) 806 "Emit STRING as interactive output using FACE." 807 (cider-repl--emit-output (cider-current-repl) string face)) 808 809 (defun cider-repl-emit-interactive-stdout (string) 810 "Emit STRING as interactive output." 811 (cider-repl--emit-interactive-output string 'cider-repl-stdout-face)) 812 813 (defun cider-repl-emit-interactive-stderr (string) 814 "Emit STRING as interactive err output." 815 (cider-repl--emit-interactive-output string 'cider-repl-stderr-face)) 816 817 (defun cider-repl-emit-stdout (buffer string) 818 "Using BUFFER, emit STRING as standard output." 819 (cider-repl--emit-output buffer string 'cider-repl-stdout-face)) 820 821 (defun cider-repl-emit-stderr (buffer string) 822 "Using BUFFER, emit STRING as error output." 823 (cider-repl--emit-output buffer string 'cider-repl-stderr-face)) 824 825 (defun cider-repl-emit-prompt (buffer) 826 "Emit the REPL prompt into BUFFER." 827 (with-current-buffer buffer 828 (save-excursion 829 (cider-repl--insert-prompt cider-buffer-ns)))) 830 831 (defun cider-repl-emit-result (buffer string show-prefix &optional bol) 832 "Emit into BUFFER the result STRING and mark it as an evaluation result. 833 If SHOW-PREFIX is non-nil insert `cider-repl-result-prefix' at the beginning 834 of the line. If BOL is non-nil insert at the beginning of the line." 835 (with-current-buffer buffer 836 (save-excursion 837 (cider-save-marker cider-repl-output-start 838 (goto-char cider-repl-output-end) 839 (when (and bol (not (bolp))) 840 (insert-before-markers "\n")) 841 (when show-prefix 842 (insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) 843 (if cider-repl-use-clojure-font-lock 844 (insert-before-markers (cider-font-lock-as-clojure string)) 845 (cider-propertize-region 846 '(font-lock-face cider-repl-result-face rear-nonsticky (font-lock-face)) 847 (insert-before-markers string))))))) 848 849 (defun cider-repl-newline-and-indent () 850 "Insert a newline, then indent the next line. 851 Restrict the buffer from the prompt for indentation, to avoid being 852 confused by strange characters (like unmatched quotes) appearing 853 earlier in the buffer." 854 (interactive) 855 (save-restriction 856 (narrow-to-region cider-repl-prompt-start-mark (point-max)) 857 (insert "\n") 858 (lisp-indent-line))) 859 860 (defun cider-repl-indent-and-complete-symbol () 861 "Indent the current line and perform symbol completion. 862 First indent the line. If indenting doesn't move point, complete 863 the symbol." 864 (interactive) 865 (let ((pos (point))) 866 (lisp-indent-line) 867 (when (= pos (point)) 868 (if (save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t)) 869 (completion-at-point))))) 870 871 (defun cider-repl-kill-input () 872 "Kill all text from the prompt to point." 873 (interactive) 874 (cond ((< (marker-position cider-repl-input-start-mark) (point)) 875 (kill-region cider-repl-input-start-mark (point))) 876 ((= (point) (marker-position cider-repl-input-start-mark)) 877 (cider-repl-delete-current-input)))) 878 879 (defun cider-repl--input-complete-p (start end) 880 "Return t if the region from START to END is a complete sexp." 881 (save-excursion 882 (goto-char start) 883 (cond ((looking-at-p "\\s *[@'`#]?[(\"]") 884 (ignore-errors 885 (save-restriction 886 (narrow-to-region start end) 887 ;; Keep stepping over blanks and sexps until the end of 888 ;; buffer is reached or an error occurs. Tolerate extra 889 ;; close parens. 890 (cl-loop do (skip-chars-forward " \t\r\n)") 891 until (eobp) 892 do (forward-sexp)) 893 t))) 894 (t t)))) 895 896 (defun cider-repl--display-image (buffer image &optional show-prefix bol) 897 "Insert IMAGE into BUFFER at the current point. 898 899 For compatibility with the rest of CIDER's REPL machinery, supports 900 SHOW-PREFIX and BOL." 901 (with-current-buffer buffer 902 (save-excursion 903 (cider-save-marker cider-repl-output-start 904 (goto-char cider-repl-output-end) 905 (when (and bol (not (bolp))) 906 (insert-before-markers "\n")) 907 (when show-prefix 908 (insert-before-markers 909 (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) 910 ;; The below is inlined from `insert-image' and changed to use 911 ;; `insert-before-markers' rather than `insert' 912 (let ((start (point)) 913 (props (nconc `(display ,image rear-nonsticky (display)) 914 (when (boundp 'image-map) 915 `(keymap ,image-map))))) 916 (insert-before-markers " ") 917 (add-text-properties start (point) props))))) 918 t) 919 920 (defcustom cider-repl-image-margin 10 921 "Specifies the margin to be applied to images displayed in the REPL. 922 Either a single number of pixels - interpreted as a symmetric margin, or 923 pair of numbers `(x . y)' encoding an arbitrary margin." 924 :type '(choice integer (vector integer integer)) 925 :package-version '(cider . "0.17.0")) 926 927 (defun cider-repl--image (data type datap) 928 "A helper for creating images with CIDER's image options. 929 DATA is either the path to an image or its base64 coded data. TYPE is a 930 symbol indicating the image type. DATAP indicates whether the image is the 931 raw image data or a filename. Returns an image instance with a margin per 932 `cider-repl-image-margin'." 933 (create-image data type datap 934 :margin cider-repl-image-margin)) 935 936 (defun cider-repl-handle-jpeg (_type buffer image &optional show-prefix bol) 937 "A handler for inserting a jpeg IMAGE into a repl BUFFER. 938 Part of the default `cider-repl-content-type-handler-alist'." 939 (cider-repl--display-image buffer 940 (cider-repl--image image 'jpeg t) 941 show-prefix bol)) 942 943 (defun cider-repl-handle-png (_type buffer image &optional show-prefix bol) 944 "A handler for inserting a png IMAGE into a repl BUFFER. 945 Part of the default `cider-repl-content-type-handler-alist'." 946 (cider-repl--display-image buffer 947 (cider-repl--image image 'png t) 948 show-prefix bol)) 949 950 (defun cider-repl-handle-svg (_type buffer image &optional show-prefix bol) 951 "A handler for inserting an svg IMAGE into a repl BUFFER. 952 Part of the default `cider-repl-content-type-handler-alist'." 953 (cider-repl--display-image buffer 954 (cider-repl--image image 'svg t) 955 show-prefix bol)) 956 957 (defun cider-repl-handle-external-body (type buffer _ &optional _show-prefix _bol) 958 "Handler for slurping external content into BUFFER. 959 Handles an external-body TYPE by issuing a slurp request to fetch the content." 960 (if-let* ((args (cadr type)) 961 (access-type (nrepl-dict-get args "access-type"))) 962 (nrepl-send-request 963 (list "op" "slurp" "url" (nrepl-dict-get args access-type)) 964 (cider-repl-handler buffer) 965 (cider-current-repl))) 966 nil) 967 968 (defvar cider-repl-content-type-handler-alist 969 `(("message/external-body" . ,#'cider-repl-handle-external-body) 970 ("image/jpeg" . ,#'cider-repl-handle-jpeg) 971 ("image/png" . ,#'cider-repl-handle-png) 972 ("image/svg+xml" . ,#'cider-repl-handle-svg)) 973 "Association list from content-types to handlers. 974 Handlers must be functions of two required and two optional arguments - the 975 REPL buffer to insert into, the value of the given content type as a raw 976 string, the REPL's show prefix as any and an `end-of-line' flag. 977 978 The return value of the handler should be a flag, indicating whether or not 979 the REPL is ready for a prompt to be displayed. Most handlers should return 980 t, as the content-type response is (currently) an alternative to the 981 value response. However for handlers which themselves issue subsequent 982 nREPL ops, it may be convenient to prevent inserting a prompt.") 983 984 (defun cider-repl-handler (buffer) 985 "Make an nREPL evaluation handler for the REPL BUFFER." 986 (let ((show-prompt t)) 987 (nrepl-make-response-handler 988 buffer 989 (lambda (buffer value) 990 (cider-repl-emit-result buffer value t)) 991 (lambda (buffer out) 992 (cider-repl-emit-stdout buffer out)) 993 (lambda (buffer err) 994 (cider-repl-emit-stderr buffer err)) 995 (lambda (buffer) 996 (when show-prompt 997 (cider-repl-emit-prompt buffer)) 998 (when cider-repl-buffer-size-limit 999 (cider-repl-maybe-trim-buffer buffer))) 1000 nrepl-err-handler 1001 (lambda (buffer value content-type) 1002 (if-let* ((content-attrs (cadr content-type)) 1003 (content-type* (car content-type)) 1004 (handler (cdr (assoc content-type* 1005 cider-repl-content-type-handler-alist)))) 1006 (setq show-prompt (funcall handler content-type buffer value nil t)) 1007 (cider-repl-emit-result buffer value t t))) 1008 (lambda (buffer warning) 1009 (cider-repl-emit-stderr buffer warning))))) 1010 1011 (defun cider--repl-request-map (right-margin) 1012 "Map to be merged into REPL eval requests. 1013 RIGHT-MARGIN is as in `cider--nrepl-print-request-map'." 1014 (map-merge 'hash-table 1015 (cider--nrepl-print-request-map right-margin) 1016 (unless cider-repl-use-pretty-printing 1017 '(("nrepl.middleware.print/print" "cider.nrepl.pprint/pr"))) 1018 (when cider-repl-use-content-types 1019 (cider--nrepl-content-type-map)))) 1020 1021 (defun cider-repl--send-input (&optional newline) 1022 "Go to the end of the input and send the current input. 1023 If NEWLINE is true then add a newline at the end of the input." 1024 (unless (cider-repl--in-input-area-p) 1025 (error "No input at point")) 1026 (let ((input (cider-repl--current-input))) 1027 (if (string-blank-p input) 1028 ;; don't evaluate a blank string, but erase it and emit 1029 ;; a fresh prompt to acknowledge to the user. 1030 (progn 1031 (cider-repl--replace-input "") 1032 (cider-repl-emit-prompt (current-buffer))) 1033 ;; otherwise evaluate the input 1034 (goto-char (point-max)) 1035 (let ((end (point))) ; end of input, without the newline 1036 (cider-repl--add-to-input-history input) 1037 (when newline 1038 (insert "\n")) 1039 (let ((inhibit-modification-hooks t)) 1040 (add-text-properties cider-repl-input-start-mark 1041 (point) 1042 `(cider-old-input 1043 ,(cl-incf cider-repl-old-input-counter)))) 1044 (unless cider-repl-use-clojure-font-lock 1045 (let ((overlay (make-overlay cider-repl-input-start-mark end))) 1046 ;; These properties are on an overlay so that they won't be taken 1047 ;; by kill/yank. 1048 (overlay-put overlay 'read-only t) 1049 (overlay-put overlay 'font-lock-face 'cider-repl-input-face)))) 1050 (let ((input-start (save-excursion (cider-repl-beginning-of-defun) (point)))) 1051 (goto-char (point-max)) 1052 (cider-repl--mark-input-start) 1053 (cider-repl--mark-output-start) 1054 (cider-nrepl-request:eval 1055 input 1056 (cider-repl-handler (current-buffer)) 1057 (cider-current-ns) 1058 (line-number-at-pos input-start) 1059 (cider-column-number-at-pos input-start) 1060 (thread-last 1061 (cider--repl-request-map fill-column) 1062 (map-pairs) 1063 (seq-mapcat #'identity))))))) 1064 1065 (defun cider-repl-return (&optional end-of-input) 1066 "Evaluate the current input string, or insert a newline. 1067 Send the current input only if a whole expression has been entered, 1068 i.e. the parenthesis are matched. 1069 When END-OF-INPUT is non-nil, send the input even if the parentheses 1070 are not balanced." 1071 (interactive "P") 1072 (cond 1073 (end-of-input 1074 (cider-repl--send-input)) 1075 ((and (get-text-property (point) 'cider-old-input) 1076 (< (point) cider-repl-input-start-mark)) 1077 (cider-repl--grab-old-input end-of-input)) 1078 ((cider-repl--input-complete-p cider-repl-input-start-mark (point-max)) 1079 (cider-repl--send-input t)) 1080 (t 1081 (cider-repl-newline-and-indent) 1082 (message "[input not complete]")))) 1083 1084 (defun cider-repl--grab-old-input (replace) 1085 "Resend the old REPL input at point. 1086 If REPLACE is non-nil the current input is replaced with the old 1087 input; otherwise the new input is appended. The old input has the 1088 text property `cider-old-input'." 1089 (cl-multiple-value-bind (beg end) (cider-property-bounds 'cider-old-input) 1090 (let ((old-input (buffer-substring beg end)) ;;preserve 1091 ;;properties, they will be removed later 1092 (offset (- (point) beg))) 1093 ;; Append the old input or replace the current input 1094 (cond (replace (goto-char cider-repl-input-start-mark)) 1095 (t (goto-char (point-max)) 1096 (unless (eq (char-before) ?\ ) 1097 (insert " ")))) 1098 (delete-region (point) (point-max)) 1099 (save-excursion 1100 (insert old-input) 1101 (when (equal (char-before) ?\n) 1102 (delete-char -1))) 1103 (forward-char offset)))) 1104 1105 (defun cider-repl-closing-return () 1106 "Evaluate the current input string after closing input. 1107 Closes all open parentheses or bracketed expressions." 1108 (interactive) 1109 (goto-char (point-max)) 1110 (save-restriction 1111 (narrow-to-region cider-repl-input-start-mark (point)) 1112 (let ((matching-delimiter nil)) 1113 (while (ignore-errors 1114 (save-excursion 1115 (backward-up-list 1) 1116 (setq matching-delimiter (cdr (syntax-after (point))))) 1117 t) 1118 (insert-char matching-delimiter)))) 1119 (cider-repl-return)) 1120 1121 (defun cider-repl-toggle-pretty-printing () 1122 "Toggle pretty-printing in the REPL." 1123 (interactive) 1124 (setq cider-repl-use-pretty-printing (not cider-repl-use-pretty-printing)) 1125 (message "Pretty printing in REPL %s." 1126 (if cider-repl-use-pretty-printing "enabled" "disabled"))) 1127 1128 (defun cider-repl-toggle-content-types () 1129 "Toggle content-type rendering in the REPL." 1130 (interactive) 1131 (setq cider-repl-use-content-types (not cider-repl-use-content-types)) 1132 (message "Content-type support in REPL %s." 1133 (if cider-repl-use-content-types "enabled" "disabled"))) 1134 1135 (defun cider-repl-toggle-clojure-font-lock () 1136 "Toggle pretty-printing in the REPL." 1137 (interactive) 1138 (setq cider-repl-use-clojure-font-lock (not cider-repl-use-clojure-font-lock)) 1139 (message "Clojure font-locking in REPL %s." 1140 (if cider-repl-use-clojure-font-lock "enabled" "disabled"))) 1141 1142 (defun cider-repl-switch-to-other () 1143 "Switch between the Clojure and ClojureScript REPLs for the current project." 1144 (interactive) 1145 ;; FIXME: implement cycling as session can hold more than two REPLs 1146 (let* ((this-repl (cider-current-repl nil 'ensure)) 1147 (other-repl (car (seq-remove (lambda (r) (eq r this-repl)) (cider-repls nil t))))) 1148 (if other-repl 1149 (switch-to-buffer other-repl) 1150 (user-error "No other REPL in current session (%s)" 1151 (car (sesman-current-session 'CIDER)))))) 1152 1153 (defvar cider-repl-clear-buffer-hook) 1154 1155 (defun cider-repl--clear-region (start end) 1156 "Delete the output and its overlays between START and END." 1157 (mapc #'delete-overlay (overlays-in start end)) 1158 (delete-region start end)) 1159 1160 (defun cider-repl-clear-buffer () 1161 "Clear the currently visited REPL buffer completely. 1162 See also the related commands `cider-repl-clear-output' and 1163 `cider-find-and-clear-repl-output'." 1164 (interactive) 1165 (let ((inhibit-read-only t)) 1166 (cider-repl--clear-region (point-min) cider-repl-prompt-start-mark) 1167 (cider-repl--clear-region cider-repl-output-start cider-repl-output-end) 1168 (when (< (point) cider-repl-input-start-mark) 1169 (goto-char cider-repl-input-start-mark)) 1170 (recenter t)) 1171 (run-hooks 'cider-repl-clear-buffer-hook)) 1172 1173 (defun cider-repl-clear-output (&optional clear-repl) 1174 "Delete the output inserted since the last input. 1175 With a prefix argument CLEAR-REPL it will clear the entire REPL buffer instead." 1176 (interactive "P") 1177 (if clear-repl 1178 (cider-repl-clear-buffer) 1179 (let ((inhibit-read-only t)) 1180 (cider-repl--clear-region cider-repl-output-start cider-repl-output-end) 1181 (save-excursion 1182 (goto-char cider-repl-output-end) 1183 (insert-before-markers 1184 (propertize ";; output cleared\n" 'font-lock-face 'font-lock-comment-face)))))) 1185 1186 (defun cider-repl-clear-banners () 1187 "Delete the REPL banners." 1188 (interactive) 1189 ;; TODO: Improve the boundaries detecting logic 1190 ;; probably it should be based on text properties 1191 ;; the current implementation will clear warnings as well 1192 (let ((start (point-min)) 1193 (end (save-excursion 1194 (goto-char (point-min)) 1195 (cider-repl-next-prompt) 1196 (forward-line -1) 1197 (end-of-line) 1198 (point)))) 1199 (when (< start end) 1200 (let ((inhibit-read-only t)) 1201 (cider-repl--clear-region start (1+ end)))))) 1202 1203 (defun cider-repl-clear-help-banner () 1204 "Delete the help REPL banner." 1205 (interactive) 1206 ;; TODO: Improve the boundaries detecting logic 1207 ;; probably it should be based on text properties 1208 (let ((start (save-excursion 1209 (goto-char (point-min)) 1210 (search-forward ";; =") 1211 (beginning-of-line) 1212 (point))) 1213 (end (save-excursion 1214 (goto-char (point-min)) 1215 (cider-repl-next-prompt) 1216 (search-backward ";; =") 1217 (end-of-line) 1218 (point)))) 1219 (when (< start end) 1220 (let ((inhibit-read-only t)) 1221 (cider-repl--clear-region start (1+ end)))))) 1222 1223 (defun cider-repl-switch-ns-handler (buffer) 1224 "Make an nREPL evaluation handler for the REPL BUFFER's ns switching." 1225 (nrepl-make-response-handler buffer 1226 (lambda (_buffer _value)) 1227 (lambda (buffer out) 1228 (cider-repl-emit-stdout buffer out)) 1229 (lambda (buffer err) 1230 (cider-repl-emit-stderr buffer err)) 1231 (lambda (buffer) 1232 (cider-repl-emit-prompt buffer)))) 1233 1234 (defun cider-repl-set-ns (ns) 1235 "Switch the namespace of the REPL buffer to NS. 1236 If called from a cljc buffer act on both the Clojure and ClojureScript REPL 1237 if there are more than one REPL present. If invoked in a REPL buffer the 1238 command will prompt for the name of the namespace to switch to." 1239 (interactive (list (if (or (derived-mode-p 'cider-repl-mode) 1240 (null (cider-ns-form))) 1241 (completing-read "Switch to namespace: " 1242 (cider-sync-request:ns-list)) 1243 (cider-current-ns)))) 1244 (when (or (not ns) (equal ns "")) 1245 (user-error "No namespace selected")) 1246 (cider-map-repls :auto 1247 (lambda (connection) 1248 ;; NOTE: `require' and `in-ns' are special forms in ClojureScript. 1249 ;; That's why we eval them separately instead of combining them with `do'. 1250 (when cider-repl-require-ns-on-set 1251 (cider-sync-tooling-eval (format "(require '%s)" ns) nil connection)) 1252 (cider-tooling-eval (format "(in-ns '%s)" ns) 1253 (cider-repl-switch-ns-handler connection))))) 1254 1255 1256 ;;; Location References 1257 1258 (defcustom cider-locref-regexp-alist 1259 '((stdout-stacktrace "[ \t]\\(at \\([^$(]+\\).*(\\([^:()]+\\):\\([0-9]+\\))\\)" 1 2 3 4) 1260 (aviso-stacktrace "^[ \t]*\\(\\([^$/ \t]+\\).*? +\\([^:]+\\): +\\([0-9]+\\)\\)" 1 2 3 4) 1261 (print-stacktrace "\\[\\([^][$ \t]+\\).* +\\([^ \t]+\\) +\\([0-9]+\\)\\]" 0 1 2 3) 1262 (timbre-log "\\(TRACE\\|INFO\\|DEBUG\\|WARN\\|ERROR\\) +\\(\\[\\([^:]+\\):\\([0-9]+\\)\\]\\)" 2 3 nil 4) 1263 (cljs-message "at line \\([0-9]+\\) +\\(.*\\)$" 0 nil 2 1) 1264 (warning "warning,? +\\(\\([^\n:]+\\):\\([0-9]+\\):[0-9]+\\)" 1 nil 2 3) 1265 (compilation ".*compiling:(\\([^\n:)]+\\):\\([0-9]+\\):[0-9]+)" 0 nil 1 2)) 1266 "Alist holding regular expressions for inline location references. 1267 Each element in the alist has the form (NAME REGEXP HIGHLIGHT VAR FILE 1268 LINE), where NAME is the identifier of the regexp, REGEXP - regexp matching 1269 a location, HIGHLIGHT - sub-expression matching region to highlight on 1270 mouse-over, VAR - sub-expression giving Clojure VAR to look up. FILE is 1271 currently only used when VAR is nil and must be full resource path in that 1272 case." 1273 :type '(alist :key-type sexp) 1274 :package-version '(cider. "0.16.0")) 1275 1276 (defun cider--locref-at-point-1 (reg-list) 1277 "Workhorse for getting locref at point. 1278 REG-LIST is an entry in `cider-locref-regexp-alist'." 1279 (beginning-of-line) 1280 (when (re-search-forward (nth 1 reg-list) (point-at-eol) t) 1281 (let ((ix-highlight (or (nth 2 reg-list) 0)) 1282 (ix-var (nth 3 reg-list)) 1283 (ix-file (nth 4 reg-list)) 1284 (ix-line (nth 5 reg-list))) 1285 (list 1286 :type (car reg-list) 1287 :highlight (cons (match-beginning ix-highlight) (match-end ix-highlight)) 1288 :var (and ix-var 1289 (replace-regexp-in-string "_" "-" 1290 (match-string-no-properties ix-var) 1291 nil t)) 1292 :file (and ix-file (match-string-no-properties ix-file)) 1293 :line (and ix-line (string-to-number (match-string-no-properties ix-line))))))) 1294 1295 (defun cider-locref-at-point (&optional pos) 1296 "Return a plist of components of the location reference at POS. 1297 Limit search to current line only and return nil if no location has been 1298 found. Returned keys are :type, :highlight, :var, :file, :line, where 1299 :highlight is a cons of positions, :var and :file are strings or nil, :line 1300 is a number. See `cider-locref-regexp-alist' for how to specify regexes 1301 for locref look up." 1302 (save-excursion 1303 (goto-char (or pos (point))) 1304 ;; Regexp lookup on long lines can result in significant hangs #2532. We 1305 ;; assume that lines longer than 300 don't contain source references. 1306 (when (< (- (point-at-eol) (point-at-bol)) 300) 1307 (seq-some (lambda (rl) (cider--locref-at-point-1 rl)) 1308 cider-locref-regexp-alist)))) 1309 1310 (defun cider-jump-to-locref-at-point (&optional pos) 1311 "Identify location reference at POS and navigate to it. 1312 This function is used from help-echo property inside REPL buffers and uses 1313 regexes from `cider-locref-regexp-alist' to infer locations at point." 1314 (interactive) 1315 (if-let* ((loc (cider-locref-at-point pos))) 1316 (let* ((var (plist-get loc :var)) 1317 (line (plist-get loc :line)) 1318 (file (or 1319 ;; 1) retrieve from info middleware 1320 (when var 1321 (or (cider-sync-request:ns-path var) 1322 (nrepl-dict-get (cider-sync-request:info var) "file"))) 1323 (when-let* ((file (plist-get loc :file))) 1324 ;; 2) file detected by the regexp 1325 (or 1326 (if (file-name-absolute-p file) 1327 file 1328 ;; when not absolute, expand within the current project 1329 (when-let* ((proj (clojure-project-dir))) 1330 (let ((path (expand-file-name file proj))) 1331 (when (file-exists-p path) 1332 path)))) 1333 ;; 3) infer ns from the abbreviated path (common in 1334 ;; reflection warnings) 1335 (let ((ns (cider-path-to-ns file))) 1336 (cider-sync-request:ns-path ns))))))) 1337 (if file 1338 (cider--jump-to-loc-from-info (nrepl-dict "file" file "line" line) t) 1339 (error "No source location for %s" var))) 1340 (user-error "No location reference at point"))) 1341 1342 (defvar cider-locref-hoover-overlay 1343 (let ((o (make-overlay 1 1))) 1344 (overlay-put o 'category 'cider-error-hoover) 1345 ;; (overlay-put o 'face 'highlight) 1346 (overlay-put o 'pointer 'hand) 1347 (overlay-put o 'mouse-face 'highlight) 1348 (overlay-put o 'follow-link 'mouse) 1349 (overlay-put o 'keymap 1350 (let ((map (make-sparse-keymap))) 1351 (define-key map [return] #'cider-jump-to-locref-at-point) 1352 (define-key map [mouse-2] #'cider-jump-to-locref-at-point) 1353 map)) 1354 o) 1355 "Overlay used during hoovering on location references in REPL buffers. 1356 One for all REPLs.") 1357 1358 (defun cider-locref-help-echo (_win buffer pos) 1359 "Function for help-echo property in REPL buffers. 1360 WIN, BUFFER and POS are the window, buffer and point under mouse position." 1361 (with-current-buffer buffer 1362 (if-let* ((hl (plist-get (cider-locref-at-point pos) :highlight))) 1363 (move-overlay cider-locref-hoover-overlay (car hl) (cdr hl) buffer) 1364 (delete-overlay cider-locref-hoover-overlay)) 1365 nil)) 1366 1367 1368 ;;; History 1369 1370 (defcustom cider-repl-wrap-history nil 1371 "T to wrap history around when the end is reached." 1372 :type 'boolean) 1373 1374 ;; These two vars contain the state of the last history search. We 1375 ;; only use them if `last-command' was `cider-repl--history-replace', 1376 ;; otherwise we reinitialize them. 1377 1378 (defvar cider-repl-input-history-position -1 1379 "Newer items have smaller indices.") 1380 1381 (defvar cider-repl-history-pattern nil 1382 "The regexp most recently used for finding input history.") 1383 1384 (defun cider-repl--add-to-input-history (string) 1385 "Add STRING to the input history. 1386 Empty strings and duplicates are ignored." 1387 (unless (or (equal string "") 1388 (equal string (car cider-repl-input-history))) 1389 (push string cider-repl-input-history) 1390 (cl-incf cider-repl-input-history-items-added))) 1391 1392 (defun cider-repl-delete-current-input () 1393 "Delete all text after the prompt." 1394 (goto-char (point-max)) 1395 (delete-region cider-repl-input-start-mark (point-max))) 1396 1397 (defun cider-repl--replace-input (string) 1398 "Replace the current REPL input with STRING." 1399 (cider-repl-delete-current-input) 1400 (insert-and-inherit string)) 1401 1402 (defun cider-repl--position-in-history (start-pos direction regexp) 1403 "Return the position of the history item starting at START-POS. 1404 Search in DIRECTION for REGEXP. 1405 Return -1 resp the length of the history if no item matches." 1406 ;; Loop through the history list looking for a matching line 1407 (let* ((step (cl-ecase direction 1408 (forward -1) 1409 (backward 1))) 1410 (history cider-repl-input-history) 1411 (len (length history))) 1412 (cl-loop for pos = (+ start-pos step) then (+ pos step) 1413 if (< pos 0) return -1 1414 if (<= len pos) return len 1415 if (string-match-p regexp (nth pos history)) return pos))) 1416 1417 (defun cider-repl--history-replace (direction &optional regexp) 1418 "Replace the current input with the next line in DIRECTION. 1419 DIRECTION is 'forward' or 'backward' (in the history list). 1420 If REGEXP is non-nil, only lines matching REGEXP are considered." 1421 (setq cider-repl-history-pattern regexp) 1422 (let* ((min-pos -1) 1423 (max-pos (length cider-repl-input-history)) 1424 (pos0 (cond ((cider-history-search-in-progress-p) 1425 cider-repl-input-history-position) 1426 (t min-pos))) 1427 (pos (cider-repl--position-in-history pos0 direction (or regexp ""))) 1428 (msg nil)) 1429 (cond ((and (< min-pos pos) (< pos max-pos)) 1430 (cider-repl--replace-input (nth pos cider-repl-input-history)) 1431 (setq msg (format "History item: %d" pos))) 1432 ((not cider-repl-wrap-history) 1433 (setq msg (cond ((= pos min-pos) "End of history") 1434 ((= pos max-pos) "Beginning of history")))) 1435 (cider-repl-wrap-history 1436 (setq pos (if (= pos min-pos) max-pos min-pos)) 1437 (setq msg "Wrapped history"))) 1438 (when (or (<= pos min-pos) (<= max-pos pos)) 1439 (when regexp 1440 (setq msg (concat msg "; no matching item")))) 1441 (message "%s%s" msg (cond ((not regexp) "") 1442 (t (format "; current regexp: %s" regexp)))) 1443 (setq cider-repl-input-history-position pos) 1444 (setq this-command 'cider-repl--history-replace))) 1445 1446 (defun cider-history-search-in-progress-p () 1447 "Return t if a current history search is in progress." 1448 (eq last-command 'cider-repl--history-replace)) 1449 1450 (defun cider-terminate-history-search () 1451 "Terminate the current history search." 1452 (setq last-command this-command)) 1453 1454 (defun cider-repl-previous-input () 1455 "Cycle backwards through input history. 1456 If the `last-command' was a history navigation command use the 1457 same search pattern for this command. 1458 Otherwise use the current input as search pattern." 1459 (interactive) 1460 (cider-repl--history-replace 'backward (cider-repl-history-pattern t))) 1461 1462 (defun cider-repl-next-input () 1463 "Cycle forwards through input history. 1464 See `cider-previous-input'." 1465 (interactive) 1466 (cider-repl--history-replace 'forward (cider-repl-history-pattern t))) 1467 1468 (defun cider-repl-forward-input () 1469 "Cycle forwards through input history." 1470 (interactive) 1471 (cider-repl--history-replace 'forward (cider-repl-history-pattern))) 1472 1473 (defun cider-repl-backward-input () 1474 "Cycle backwards through input history." 1475 (interactive) 1476 (cider-repl--history-replace 'backward (cider-repl-history-pattern))) 1477 1478 (defun cider-repl-previous-matching-input (regexp) 1479 "Find the previous input matching REGEXP." 1480 (interactive "sPrevious element matching (regexp): ") 1481 (cider-terminate-history-search) 1482 (cider-repl--history-replace 'backward regexp)) 1483 1484 (defun cider-repl-next-matching-input (regexp) 1485 "Find then next input matching REGEXP." 1486 (interactive "sNext element matching (regexp): ") 1487 (cider-terminate-history-search) 1488 (cider-repl--history-replace 'forward regexp)) 1489 1490 (defun cider-repl-history-pattern (&optional use-current-input) 1491 "Return the regexp for the navigation commands. 1492 If USE-CURRENT-INPUT is non-nil, use the current input." 1493 (cond ((cider-history-search-in-progress-p) 1494 cider-repl-history-pattern) 1495 (use-current-input 1496 (cl-assert (<= cider-repl-input-start-mark (point))) 1497 (let ((str (cider-repl--current-input t))) 1498 (cond ((string-match-p "^[ \n]*$" str) nil) 1499 (t (concat "^" (regexp-quote str)))))) 1500 (t nil))) 1501 1502 ;;; persistent history 1503 (defcustom cider-repl-history-size 500 1504 "The maximum number of items to keep in the REPL history." 1505 :type 'integer 1506 :safe #'integerp) 1507 1508 (defcustom cider-repl-history-file nil 1509 "File to save the persistent REPL history to." 1510 :type 'string 1511 :safe #'stringp) 1512 1513 (defun cider-repl--history-read-filename () 1514 "Ask the user which file to use, defaulting `cider-repl-history-file'." 1515 (read-file-name "Use CIDER REPL history file: " 1516 cider-repl-history-file)) 1517 1518 (defun cider-repl--history-read (filename) 1519 "Read history from FILENAME and return it. 1520 It does not yet set the input history." 1521 (if (file-readable-p filename) 1522 (with-temp-buffer 1523 (insert-file-contents filename) 1524 (when (> (buffer-size (current-buffer)) 0) 1525 (read (current-buffer)))) 1526 '())) 1527 1528 (defun cider-repl-history-load (&optional filename) 1529 "Load history from FILENAME into current session. 1530 FILENAME defaults to the value of `cider-repl-history-file' but user 1531 defined filenames can be used to read special history files. 1532 1533 The value of `cider-repl-input-history' is set by this function." 1534 (interactive (list (cider-repl--history-read-filename))) 1535 (let ((f (or filename cider-repl-history-file))) 1536 ;; TODO: probably need to set cider-repl-input-history-position as well. 1537 ;; in a fresh connection the newest item in the list is currently 1538 ;; not available. After sending one input, everything seems to work. 1539 (setq cider-repl-input-history (cider-repl--history-read f)))) 1540 1541 (defun cider-repl--history-write (filename) 1542 "Write history to FILENAME. 1543 Currently coding system for writing the contents is hardwired to 1544 utf-8-unix." 1545 (let* ((mhist (cider-repl--histories-merge cider-repl-input-history 1546 cider-repl-input-history-items-added 1547 (cider-repl--history-read filename))) 1548 ;; newest items are at the beginning of the list, thus 0 1549 (hist (cl-subseq mhist 0 (min (length mhist) cider-repl-history-size)))) 1550 (unless (file-writable-p filename) 1551 (error (format "History file not writable: %s" filename))) 1552 (let ((print-length nil) (print-level nil)) 1553 (with-temp-file filename 1554 ;; TODO: really set cs for output 1555 ;; TODO: does cs need to be customizable? 1556 (insert ";; -*- coding: utf-8-unix -*-\n") 1557 (insert ";; Automatically written history of CIDER REPL session\n") 1558 (insert ";; Edit at your own risk\n\n") 1559 (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))) 1560 1561 (defun cider-repl-history-save (&optional filename) 1562 "Save the current REPL input history to FILENAME. 1563 FILENAME defaults to the value of `cider-repl-history-file'." 1564 (interactive (list (cider-repl--history-read-filename))) 1565 (let* ((file (or filename cider-repl-history-file))) 1566 (cider-repl--history-write file))) 1567 1568 (defun cider-repl-history-just-save () 1569 "Just save the history to `cider-repl-history-file'. 1570 This function is meant to be used in hooks to avoid lambda 1571 constructs." 1572 (cider-repl-history-save cider-repl-history-file)) 1573 1574 ;; SLIME has different semantics and will not save any duplicates. 1575 ;; we keep track of how many items were added to the history in the 1576 ;; current session in `cider-repl--add-to-input-history' and merge only the 1577 ;; new items with the current history found in the file, which may 1578 ;; have been changed in the meantime by another session. 1579 (defun cider-repl--histories-merge (session-hist n-added-items file-hist) 1580 "Merge histories from SESSION-HIST adding N-ADDED-ITEMS into FILE-HIST." 1581 (append (cl-subseq session-hist 0 n-added-items) 1582 file-hist)) 1583 1584 1585 ;;; REPL shortcuts 1586 (defcustom cider-repl-shortcut-dispatch-char ?\, 1587 "Character used to distinguish REPL commands from Lisp forms." 1588 :type '(character)) 1589 1590 (defvar cider-repl-shortcuts (make-hash-table :test 'equal)) 1591 1592 (defun cider-repl-add-shortcut (name handler) 1593 "Add a REPL shortcut command, defined by NAME and HANDLER." 1594 (puthash name handler cider-repl-shortcuts)) 1595 1596 (declare-function cider-toggle-trace-ns "cider-tracing") 1597 (declare-function cider-undef "cider-eval") 1598 (declare-function cider-browse-ns "cider-browse-ns") 1599 (declare-function cider-classpath "cider-classpath") 1600 (declare-function cider-repl-history "cider-repl-history") 1601 (declare-function cider-run "cider-mode") 1602 (declare-function cider-ns-refresh "cider-ns") 1603 (declare-function cider-ns-reload "cider-ns") 1604 (declare-function cider-find-var "cider-find") 1605 (declare-function cider-version "cider") 1606 (declare-function cider-test-run-loaded-tests "cider-test") 1607 (declare-function cider-test-run-project-tests "cider-test") 1608 (declare-function cider-sideloader-start "cider-eval") 1609 (cider-repl-add-shortcut "clear-output" #'cider-repl-clear-output) 1610 (cider-repl-add-shortcut "clear" #'cider-repl-clear-buffer) 1611 (cider-repl-add-shortcut "clear-banners" #'cider-repl-clear-banners) 1612 (cider-repl-add-shortcut "clear-help-banner" #'cider-repl-clear-help-banner) 1613 (cider-repl-add-shortcut "trim" #'cider-repl-trim-buffer) 1614 (cider-repl-add-shortcut "ns" #'cider-repl-set-ns) 1615 (cider-repl-add-shortcut "toggle-pprint" #'cider-repl-toggle-pretty-printing) 1616 (cider-repl-add-shortcut "toggle-font-lock" #'cider-repl-toggle-clojure-font-lock) 1617 (cider-repl-add-shortcut "toggle-content-types" #'cider-repl-toggle-content-types) 1618 (cider-repl-add-shortcut "browse-ns" (lambda () (interactive) (cider-browse-ns (cider-current-ns)))) 1619 (cider-repl-add-shortcut "classpath" #'cider-classpath) 1620 (cider-repl-add-shortcut "history" #'cider-repl-history) 1621 (cider-repl-add-shortcut "trace-ns" #'cider-toggle-trace-ns) 1622 (cider-repl-add-shortcut "sideloader-start" #'cider-sideloader-start) 1623 (cider-repl-add-shortcut "undef" #'cider-undef) 1624 (cider-repl-add-shortcut "refresh" #'cider-ns-refresh) 1625 (cider-repl-add-shortcut "reload" #'cider-ns-reload) 1626 (cider-repl-add-shortcut "find-var" #'cider-find-var) 1627 (cider-repl-add-shortcut "doc" #'cider-doc) 1628 (cider-repl-add-shortcut "help" #'cider-repl-shortcuts-help) 1629 (cider-repl-add-shortcut "test-ns" #'cider-test-run-ns-tests) 1630 (cider-repl-add-shortcut "test-all" #'cider-test-run-loaded-tests) 1631 (cider-repl-add-shortcut "test-project" #'cider-test-run-project-tests) 1632 (cider-repl-add-shortcut "test-ns-with-filters" #'cider-test-run-ns-tests-with-filters) 1633 (cider-repl-add-shortcut "test-all-with-filters" (lambda () (interactive) (cider-test-run-loaded-tests 'prompt-for-filters))) 1634 (cider-repl-add-shortcut "test-project-with-filters" (lambda () (interactive) (cider-test-run-project-tests 'prompt-for-filters))) 1635 (cider-repl-add-shortcut "test-report" #'cider-test-show-report) 1636 (cider-repl-add-shortcut "run" #'cider-run) 1637 (cider-repl-add-shortcut "conn-info" #'cider-describe-connection) 1638 (cider-repl-add-shortcut "version" #'cider-version) 1639 (cider-repl-add-shortcut "require-repl-utils" #'cider-repl-require-repl-utils) 1640 ;; So many ways to quit :-) 1641 (cider-repl-add-shortcut "adios" #'cider-quit) 1642 (cider-repl-add-shortcut "sayonara" #'cider-quit) 1643 (cider-repl-add-shortcut "quit" #'cider-quit) 1644 (cider-repl-add-shortcut "restart" #'cider-restart) 1645 1646 (defconst cider-repl-shortcuts-help-buffer "*CIDER REPL Shortcuts Help*") 1647 1648 (defun cider-repl-shortcuts-help () 1649 "Display a help buffer." 1650 (interactive) 1651 (ignore-errors (kill-buffer cider-repl-shortcuts-help-buffer)) 1652 (with-current-buffer (get-buffer-create cider-repl-shortcuts-help-buffer) 1653 (insert "CIDER REPL shortcuts:\n\n") 1654 (maphash (lambda (k v) (insert (format "%s:\n\t%s\n" k v))) cider-repl-shortcuts) 1655 (goto-char (point-min)) 1656 (help-mode) 1657 (display-buffer (current-buffer) t)) 1658 (cider-repl-handle-shortcut) 1659 (current-buffer)) 1660 1661 (defun cider-repl--available-shortcuts () 1662 "Return the available REPL shortcuts." 1663 (cider-util--hash-keys cider-repl-shortcuts)) 1664 1665 (defun cider-repl-handle-shortcut () 1666 "Execute a REPL shortcut." 1667 (interactive) 1668 (if (> (point) cider-repl-input-start-mark) 1669 (insert (string cider-repl-shortcut-dispatch-char)) 1670 (let ((command (completing-read "Command: " 1671 (cider-repl--available-shortcuts)))) 1672 (if (not (equal command "")) 1673 (let ((command-func (gethash command cider-repl-shortcuts))) 1674 (if command-func 1675 (call-interactively command-func) 1676 (error "Unknown command %S. Available commands: %s" 1677 command-func 1678 (mapconcat #'identity (cider-repl--available-shortcuts) ", ")))) 1679 (error "No command selected"))))) 1680 1681 1682 ;;;;; CIDER REPL mode 1683 (defvar cider-repl-mode-hook nil 1684 "Hook executed when entering `cider-repl-mode'.") 1685 1686 (defvar cider-repl-mode-syntax-table 1687 (copy-syntax-table clojure-mode-syntax-table)) 1688 1689 (declare-function cider-eval-last-sexp "cider-eval") 1690 (declare-function cider-toggle-trace-ns "cider-tracing") 1691 (declare-function cider-toggle-trace-var "cider-tracing") 1692 (declare-function cider-find-resource "cider-find") 1693 (declare-function cider-find-ns "cider-find") 1694 (declare-function cider-find-keyword "cider-find") 1695 (declare-function cider-find-var "cider-find") 1696 (declare-function cider-switch-to-last-clojure-buffer "cider-mode") 1697 (declare-function cider-macroexpand-1 "cider-macroexpansion") 1698 (declare-function cider-macroexpand-all "cider-macroexpansion") 1699 (declare-function cider-selector "cider-selector") 1700 (declare-function cider-jack-in-clj "cider") 1701 (declare-function cider-jack-in-cljs "cider") 1702 (declare-function cider-connect-clj "cider") 1703 (declare-function cider-connect-cljs "cider") 1704 1705 (defvar cider-repl-mode-map 1706 (let ((map (make-sparse-keymap))) 1707 (define-key map (kbd "C-c C-d") 'cider-doc-map) 1708 (define-key map (kbd "C-c ,") 'cider-test-commands-map) 1709 (define-key map (kbd "C-c C-t") 'cider-test-commands-map) 1710 (define-key map (kbd "M-.") #'cider-find-var) 1711 (define-key map (kbd "C-c C-.") #'cider-find-ns) 1712 (define-key map (kbd "C-c C-:") #'cider-find-keyword) 1713 (define-key map (kbd "M-,") #'cider-pop-back) 1714 (define-key map (kbd "C-c M-.") #'cider-find-resource) 1715 (define-key map (kbd "RET") #'cider-repl-return) 1716 (define-key map (kbd "TAB") #'cider-repl-tab) 1717 (define-key map (kbd "C-<return>") #'cider-repl-closing-return) 1718 (define-key map (kbd "C-j") #'cider-repl-newline-and-indent) 1719 (define-key map (kbd "C-c C-o") #'cider-repl-clear-output) 1720 (define-key map (kbd "C-c M-n") #'cider-repl-set-ns) 1721 (define-key map (kbd "C-c C-u") #'cider-repl-kill-input) 1722 (define-key map (kbd "C-S-a") #'cider-repl-bol-mark) 1723 (define-key map [S-home] #'cider-repl-bol-mark) 1724 (define-key map (kbd "C-<up>") #'cider-repl-backward-input) 1725 (define-key map (kbd "C-<down>") #'cider-repl-forward-input) 1726 (define-key map (kbd "M-p") #'cider-repl-previous-input) 1727 (define-key map (kbd "M-n") #'cider-repl-next-input) 1728 (define-key map (kbd "M-r") #'cider-repl-previous-matching-input) 1729 (define-key map (kbd "M-s") #'cider-repl-next-matching-input) 1730 (define-key map (kbd "C-c C-n") #'cider-repl-next-prompt) 1731 (define-key map (kbd "C-c C-p") #'cider-repl-previous-prompt) 1732 (define-key map (kbd "C-c C-b") #'cider-interrupt) 1733 (define-key map (kbd "C-c C-c") #'cider-interrupt) 1734 (define-key map (kbd "C-c C-m") #'cider-macroexpand-1) 1735 (define-key map (kbd "C-c M-m") #'cider-macroexpand-all) 1736 (define-key map (kbd "C-c C-s") #'sesman-map) 1737 (define-key map (kbd "C-c C-z") #'cider-switch-to-last-clojure-buffer) 1738 (define-key map (kbd "C-c M-o") #'cider-repl-switch-to-other) 1739 (define-key map (kbd "C-c M-s") #'cider-selector) 1740 (define-key map (kbd "C-c M-d") #'cider-describe-connection) 1741 (define-key map (kbd "C-c C-q") #'cider-quit) 1742 (define-key map (kbd "C-c M-r") #'cider-restart) 1743 (define-key map (kbd "C-c M-i") #'cider-inspect) 1744 (define-key map (kbd "C-c M-p") #'cider-repl-history) 1745 (define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var) 1746 (define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns) 1747 (define-key map (kbd "C-c C-x") 'cider-start-map) 1748 (define-key map (kbd "C-x C-e") #'cider-eval-last-sexp) 1749 (define-key map (kbd "C-c C-r") 'clojure-refactor-map) 1750 (define-key map (kbd "C-c C-v") 'cider-eval-commands-map) 1751 (define-key map (kbd "C-c M-j") #'cider-jack-in-clj) 1752 (define-key map (kbd "C-c M-J") #'cider-jack-in-cljs) 1753 (define-key map (kbd "C-c M-c") #'cider-connect-clj) 1754 (define-key map (kbd "C-c M-C") #'cider-connect-cljs) 1755 1756 (define-key map (string cider-repl-shortcut-dispatch-char) #'cider-repl-handle-shortcut) 1757 (easy-menu-define cider-repl-mode-menu map 1758 "Menu for CIDER's REPL mode" 1759 `("REPL" 1760 ["Complete symbol" complete-symbol] 1761 "--" 1762 ,cider-doc-menu 1763 "--" 1764 ("Find" 1765 ["Find definition" cider-find-var] 1766 ["Find namespace" cider-find-ns] 1767 ["Find resource" cider-find-resource] 1768 ["Find keyword" cider-find-keyword] 1769 ["Go back" cider-pop-back]) 1770 "--" 1771 ["Switch to Clojure buffer" cider-switch-to-last-clojure-buffer] 1772 ["Switch to other REPL" cider-repl-switch-to-other] 1773 "--" 1774 ("Macroexpand" 1775 ["Macroexpand-1" cider-macroexpand-1] 1776 ["Macroexpand-all" cider-macroexpand-all]) 1777 "--" 1778 ,cider-test-menu 1779 "--" 1780 ["Run project (-main function)" cider-run] 1781 ["Inspect" cider-inspect] 1782 ["Toggle var tracing" cider-toggle-trace-var] 1783 ["Toggle ns tracing" cider-toggle-trace-ns] 1784 ["Refresh loaded code" cider-ns-refresh] 1785 "--" 1786 ["Set REPL ns" cider-repl-set-ns] 1787 ["Toggle pretty printing" cider-repl-toggle-pretty-printing] 1788 ["Toggle Clojure font-lock" cider-repl-toggle-clojure-font-lock] 1789 ["Toggle rich content types" cider-repl-toggle-content-types] 1790 ["Require REPL utils" cider-repl-require-repl-utils] 1791 "--" 1792 ["Browse classpath" cider-classpath] 1793 ["Browse classpath entry" cider-open-classpath-entry] 1794 ["Browse namespace" cider-browse-ns] 1795 ["Browse all namespaces" cider-browse-ns-all] 1796 ["Browse spec" cider-browse-spec] 1797 ["Browse all specs" cider-browse-spec-all] 1798 "--" 1799 ["Next prompt" cider-repl-next-prompt] 1800 ["Previous prompt" cider-repl-previous-prompt] 1801 ["Clear output" cider-repl-clear-output] 1802 ["Clear buffer" cider-repl-clear-buffer] 1803 ["Trim buffer" cider-repl-trim-buffer] 1804 ["Clear banners" cider-repl-clear-banners] 1805 ["Clear help banner" cider-repl-clear-help-banner] 1806 ["Kill input" cider-repl-kill-input] 1807 "--" 1808 ["Interrupt evaluation" cider-interrupt] 1809 "--" 1810 ["Connection info" cider-describe-connection] 1811 "--" 1812 ["Close ancillary buffers" cider-close-ancillary-buffers] 1813 ["Quit" cider-quit] 1814 ["Restart" cider-restart] 1815 "--" 1816 ["Clojure Cheatsheet" cider-cheatsheet] 1817 "--" 1818 ["A sip of CIDER" cider-drink-a-sip] 1819 ["View user manual" cider-view-manual] 1820 ["View quick reference card" cider-view-refcard] 1821 ["Report a bug" cider-report-bug] 1822 ["Version info" cider-version])) 1823 map)) 1824 1825 (sesman-install-menu cider-repl-mode-map) 1826 1827 (defun cider-repl-wrap-fontify-function (func) 1828 "Return a function that will call FUNC narrowed to input region." 1829 (lambda (beg end &rest rest) 1830 (when (and cider-repl-input-start-mark 1831 (> end cider-repl-input-start-mark)) 1832 (save-restriction 1833 (narrow-to-region cider-repl-input-start-mark (point-max)) 1834 (let ((font-lock-dont-widen t)) 1835 (apply func (max beg cider-repl-input-start-mark) end rest)))))) 1836 1837 (declare-function cider-complete-at-point "cider-completion") 1838 (defvar cider--static-font-lock-keywords) 1839 1840 (define-derived-mode cider-repl-mode fundamental-mode "REPL" 1841 "Major mode for Clojure REPL interactions. 1842 1843 \\{cider-repl-mode-map}" 1844 (clojure-mode-variables) 1845 (clojure-font-lock-setup) 1846 (font-lock-add-keywords nil cider--static-font-lock-keywords) 1847 (setq-local sesman-system 'CIDER) 1848 (setq-local font-lock-fontify-region-function 1849 (cider-repl-wrap-fontify-function font-lock-fontify-region-function)) 1850 (setq-local font-lock-unfontify-region-function 1851 (cider-repl-wrap-fontify-function font-lock-unfontify-region-function)) 1852 (set-syntax-table cider-repl-mode-syntax-table) 1853 (cider-eldoc-setup) 1854 ;; At the REPL, we define beginning-of-defun and end-of-defun to be 1855 ;; the start of the previous prompt or next prompt respectively. 1856 ;; Notice the interplay with `cider-repl-beginning-of-defun'. 1857 (setq-local beginning-of-defun-function #'cider-repl-mode-beginning-of-defun) 1858 (setq-local end-of-defun-function #'cider-repl-mode-end-of-defun) 1859 (setq-local prettify-symbols-alist clojure--prettify-symbols-alist) 1860 ;; apply dir-local variables to REPL buffers 1861 (hack-dir-local-variables-non-file-buffer) 1862 (when cider-repl-history-file 1863 (cider-repl-history-load cider-repl-history-file) 1864 (add-hook 'kill-buffer-hook #'cider-repl-history-just-save t t) 1865 (add-hook 'kill-emacs-hook #'cider-repl-history-just-save)) 1866 (add-hook 'completion-at-point-functions #'cider-complete-at-point nil t) 1867 (add-hook 'paredit-mode-hook (lambda () (clojure-paredit-setup cider-repl-mode-map)))) 1868 1869 (provide 'cider-repl) 1870 1871 ;;; cider-repl.el ends here