Klimi's new dotfiles with stow.
No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.

1712 líneas
71 KiB

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