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

1199 lines
48 KiB
Raw Normal View History Unescape

Changes to emacs config
9 years ago
;;; cider-repl.el --- REPL interactions -*- lexical-binding: t -*-
;; Copyright © 2012-2015 Tim King, Phil Hagelberg
;; Copyright © 2013-2015 Bozhidar Batsov, Hugo Duncan, Steve Purcell
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; REPL interactions.
;;; Code:
(require 'cider-client)
(require 'cider-doc)
(require 'cider-eldoc) ; for cider-eldoc-setup
(require 'cider-common)
(require 'cider-compat)
(require 'clojure-mode)
(require 'easymenu)
(require 'cl-lib)
(eval-when-compile
(defvar paredit-version)
(defvar paredit-space-for-delimiter-predicates))
(defgroup cider-repl nil
"Interaction with the REPL."
:prefix "cider-repl-"
:group 'cider)
(defface cider-repl-prompt-face
'((t (:inherit font-lock-keyword-face)))
"Face for the prompt in the REPL buffer."
:group 'cider-repl)
(defface cider-repl-stdout-face
'((t (:inherit font-lock-string-face)))
"Face for STDOUT output in the REPL buffer."
:group 'cider-repl)
(defface cider-repl-stderr-face
'((t (:inherit font-lock-warning-face)))
"Face for STDERR output in the REPL buffer."
:group 'cider-repl
:package-version '(cider . "0.6.0"))
(defface cider-repl-input-face
'((t (:bold t)))
"Face for previous input in the REPL buffer."
:group 'cider-repl)
(defface cider-repl-result-face
'((t ()))
"Face for the result of an evaluation in the REPL buffer."
:group 'cider-repl)
(defcustom cider-repl-pop-to-buffer-on-connect t
"Controls whether to pop to the REPL buffer on connect.
When set to nil the buffer will only be created."
:type 'boolean
:group 'cider-repl)
(defcustom cider-repl-display-in-current-window nil
"Controls whether the REPL buffer is displayed in the current window."
:type 'boolean
:group 'cider-repl)
(defcustom cider-repl-use-pretty-printing nil
"Control whether the results in REPL are pretty-printed or not.
The `cider-toggle-pretty-printing' command can be used to interactively
change the setting's value."
:type 'boolean
:group 'cider-repl)
(defcustom cider-repl-use-clojure-font-lock t
"Non-nil means to use Clojure mode font-locking for input and result.
Nil means that `cider-repl-input-face' and `cider-repl-result-face'
will be used."
:type 'boolean
:group 'cider-repl
:package-version '(cider . "0.10.0"))
(defcustom cider-repl-result-prefix ""
"The prefix displayed in the REPL before a result value."
:type 'string
:group 'cider
:package-version '(cider . "0.5.0"))
(defcustom cider-repl-tab-command 'cider-repl-indent-and-complete-symbol
"Select the command to be invoked by the TAB key.
The default option is `cider-repl-indent-and-complete-symbol'. If
you'd like to use the default Emacs behavior use
`indent-for-tab-command'."
:type 'symbol
:group 'cider-repl)
;;;; REPL buffer local variables
(defvar-local cider-repl-input-start-mark nil)
(defvar-local cider-repl-prompt-start-mark nil)
(defvar-local cider-repl-old-input-counter 0
"Counter used to generate unique `cider-old-input' properties.
This property value must be unique to avoid having adjacent inputs be
joined together.")
(defvar-local cider-repl-input-history '()
"History list of strings read from the REPL buffer.")
(defvar-local cider-repl-input-history-items-added 0
"Variable counting the items added in the current session.")
(defvar-local cider-repl-output-start nil
"Marker for the start of output.
Currently its only purpose is to facilitate `cider-repl-clear-buffer'.")
(defvar-local cider-repl-output-end nil
"Marker for the end of output.
Currently its only purpose is to facilitate `cider-repl-clear-buffer'.")
(defun cider-repl-tab ()
"Invoked on TAB keystrokes in `cider-repl-mode' buffers."
(interactive)
(funcall cider-repl-tab-command))
(defun cider-repl-reset-markers ()
"Reset all REPL markers."
(dolist (markname '(cider-repl-output-start
cider-repl-output-end
cider-repl-prompt-start-mark
cider-repl-input-start-mark))
(set markname (make-marker))
(set-marker (symbol-value markname) (point))))
;;; REPL init
(defun cider-repl-buffer-name (&optional project-dir host port)
"Generate a REPL buffer name based on current connection buffer.
PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'."
(with-current-buffer (or (cider-default-connection 'no-error)
(current-buffer))
(nrepl-make-buffer-name nrepl-repl-buffer-name-template project-dir host port)))
(make-obsolete 'cider-repl-buffer-name
"use `nrepl-make-buffer-name' with `nrepl-repl-buffer-name-template' instead."
"0.10.0")
(defvar-local cider-repl-ns-cache nil
"A dict holding information about all currently loaded namespaces.
This cache is stored in the connection buffer. Other buffer's access it
via `cider-current-connection'.")
(defvar cider-mode)
(declare-function cider-refresh-dynamic-font-lock "cider-mode")
(defun cider-repl--state-handler (response)
"Handle the server STATE.
Currently, this is only used to keep `cider-repl-type' updated."
(with-demoted-errors "Error in `cider-repl--state-handler': %s"
(when (member "state" (nrepl-dict-get response "status"))
(nrepl-dbind-response response (repl-type changed-namespaces)
(setq cider-repl-type repl-type)
(unless (nrepl-dict-empty-p changed-namespaces)
(setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces))
(dolist (b (buffer-list))
(with-current-buffer b
(when cider-mode
(when-let ((ns-dict (nrepl-dict-get changed-namespaces (cider-current-ns))))
(cider-refresh-dynamic-font-lock ns-dict))))))))))
(declare-function cider-default-err-handler "cider-interaction")
(defun cider-repl-create (endpoint)
"Create a REPL buffer and install `cider-repl-mode'.
ENDPOINT is a plist as returned by `nrepl-connect'."
;; Connection might not have been set as yet. Please don't send requests here.
(let* ((reuse-buff (not (eq 'new nrepl-use-this-as-repl-buffer)))
(buff-name (nrepl-make-buffer-name nrepl-repl-buffer-name-template nil
(plist-get endpoint :host)
(plist-get endpoint :port)
reuse-buff)))
;; when reusing, rename the buffer accordingly
(when (and reuse-buff
(not (equal buff-name nrepl-use-this-as-repl-buffer)))
;; uniquify as it might be Nth connection to the same endpoint
(setq buff-name (generate-new-buffer-name buff-name))
(with-current-buffer nrepl-use-this-as-repl-buffer
(rename-buffer buff-name)))
(with-current-buffer (get-buffer-create buff-name)
(unless (derived-mode-p 'cider-repl-mode)
(cider-repl-mode))
(setq nrepl-err-handler #'cider-default-err-handler)
(cider-repl-reset-markers)
(add-hook 'nrepl-response-handler-functions #'cider-repl--state-handler nil 'local)
(add-hook 'nrepl-connected-hook 'cider--connected-handler nil 'local)
(add-hook 'nrepl-disconnected-hook 'cider--disconnected-handler nil 'local)
(current-buffer))))
(defun cider-repl-require-repl-utils ()
"Require standard REPL util functions into the current REPL."
(interactive)
(cider-nrepl-request:eval
"(when (clojure.core/resolve 'clojure.main/repl-requires)
(clojure.core/map clojure.core/require clojure.main/repl-requires))"
(lambda (_response) nil)))
(defun cider-repl-set-initial-ns (buffer)
"Set the REPL BUFFER's initial namespace (by altering `cider-buffer-ns').
This is \"user\" by default but can be overridden in apps like lein (:init-ns)."
;; we don't want to get a timeout during init
(let ((nrepl-sync-request-timeout nil))
(with-current-buffer buffer
(let ((initial-ns (or (read
(nrepl-dict-get
(cider-nrepl-sync-request:eval "(str *ns*)")
"value"))
"user")))
(setq cider-buffer-ns initial-ns)))))
(defvar cider-current-clojure-buffer nil
"This variable holds current buffer temporarily when connecting to a REPL.
It is set to current buffer when `cider' or `cider-jack-in' is called.
After the REPL buffer is created, the value of this variable is used
to call `cider-remember-clojure-buffer'.")
(declare-function cider-remember-clojure-buffer "cider-mode")
(defun cider-repl-init (buffer &optional no-banner)
"Initialize the REPL in BUFFER.
BUFFER must be a REPL buffer with `cider-repl-mode' and a running
client process connection. Unless NO-BANNER is non-nil, insert a banner."
(cider-repl-set-initial-ns buffer)
(cider-repl-require-repl-utils)
(unless no-banner
(cider-repl--insert-banner-and-prompt buffer))
(when cider-repl-display-in-current-window
(add-to-list 'same-window-buffer-names (buffer-name buffer)))
(when cider-repl-pop-to-buffer-on-connect
(pop-to-buffer buffer))
(cider-remember-clojure-buffer cider-current-clojure-buffer)
buffer)
(defun cider-repl--banner ()
"Generate the welcome REPL buffer banner."
(format "; CIDER %s (Java %s, Clojure %s, nREPL %s)"
(cider--version)
(cider--java-version)
(cider--clojure-version)
(cider--nrepl-version)))
(defun cider-repl--insert-banner-and-prompt (buffer)
"Insert REPL banner and REPL prompt in BUFFER."
(with-current-buffer buffer
(when (zerop (buffer-size))
(insert (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face)))
(goto-char (point-max))
(cider-repl--mark-output-start)
(cider-repl--mark-input-start)
(cider-repl--insert-prompt cider-buffer-ns)))
;;; REPL interaction
(defun cider-repl--in-input-area-p ()
"Return t if in input area."
(<= cider-repl-input-start-mark (point)))
(defun cider-repl--current-input (&optional until-point-p)
"Return the current input as string.
The input is the region from after the last prompt to the end of
buffer. If UNTIL-POINT-P is non-nil, the input is until the current
point."
(buffer-substring-no-properties cider-repl-input-start-mark
(if until-point-p
(point)
(point-max))))
(defun cider-repl-previous-prompt ()
"Move backward to the previous prompt."
(interactive)
(cider-repl--find-prompt t))
(defun cider-repl-next-prompt ()
"Move forward to the next prompt."
(interactive)
(cider-repl--find-prompt))
(defun cider-repl--find-prompt (&optional backward)
"Find the next prompt.
If BACKWARD is non-nil look backward."
(let ((origin (point))
(cider-repl-prompt-property 'field))
(while (progn
(cider-search-property-change cider-repl-prompt-property backward)
(not (or (cider-end-of-proprange-p cider-repl-prompt-property) (bobp) (eobp)))))
(unless (cider-end-of-proprange-p cider-repl-prompt-property)
(goto-char origin))))
(defun cider-search-property-change (prop &optional backward)
"Search forward for a property change to PROP.
If BACKWARD is non-nil search backward."
(cond (backward
(goto-char (previous-single-char-property-change (point) prop)))
(t
(goto-char (next-single-char-property-change (point) prop)))))
(defun cider-end-of-proprange-p (property)
"Return t if at the the end of a property range for PROPERTY."
(and (get-char-property (max (point-min) (1- (point))) property)
(not (get-char-property (point) property))))
(defun cider-repl--mark-input-start ()
"Mark the input start."
(set-marker cider-repl-input-start-mark (point) (current-buffer)))
(defun cider-repl--mark-output-start ()
"Mark the output start."
(set-marker cider-repl-output-start (point))
(set-marker cider-repl-output-end (point)))
(defun cider-repl-mode-beginning-of-defun (&optional arg)
(if (and arg (< arg 0))
(cider-repl-mode-end-of-defun (- arg))
(dotimes (_ (or arg 1))
(cider-repl-previous-prompt))))
(defun cider-repl-mode-end-of-defun (&optional arg)
(if (and arg (< arg 0))
(cider-repl-mode-beginning-of-defun (- arg))
(dotimes (_ (or arg 1))
(cider-repl-next-prompt))))
(defun cider-repl-beginning-of-defun ()
"Move to beginning of defun."
(interactive)
;; We call `beginning-of-defun' if we're at the start of a prompt
;; already, to trigger `cider-repl-mode-beginning-of-defun' by means
;; of the locally bound `beginning-of-defun-function', in order to
;; jump to the start of the previous prompt.
(if (and (not (cider-repl--at-prompt-start-p))
(cider-repl--in-input-area-p))
(goto-char cider-repl-input-start-mark)
(beginning-of-defun)))
(defun cider-repl-end-of-defun ()
"Move to end of defun."
(interactive)
;; C.f. `cider-repl-beginning-of-defun'
(if (and (not (= (point) (point-max)))
(cider-repl--in-input-area-p))
(goto-char (point-max))
(end-of-defun)))
(defun cider-repl-bol-mark ()
"Set the mark and go to the beginning of line or the prompt."
(interactive)
(unless mark-active
(set-mark (point)))
(move-beginning-of-line 1))
(defun cider-repl--at-prompt-start-p ()
"Return t if point is at the start of prompt.
This will not work on non-current prompts."
(= (point) cider-repl-input-start-mark))
(defun cider-repl--show-maximum-output ()
"Put the end of the buffer at the bottom of the window."
(when (eobp)
(let ((win (get-buffer-window (current-buffer))))
(when win
(with-selected-window win
(set-window-point win (point-max))
(recenter -1))))))
(defmacro cider-save-marker (marker &rest body)
"Save MARKER and execute BODY."
(declare (debug t))
(let ((pos (make-symbol "pos")))
`(let ((,pos (marker-position ,marker)))
(prog1 (progn . ,body)
(set-marker ,marker ,pos)))))
(put 'cider-save-marker 'lisp-indent-function 1)
(defun cider-repl-prompt-default (namespace)
"Return a prompt string that mentions NAMESPACE."
(format "%s> " namespace))
(define-obsolete-function-alias 'cider-repl-default-prompt 'cider-repl-prompt-default "0.10.0")
(defun cider-repl-prompt-abbreviated (namespace)
"Return a prompt string that abbreviates NAMESPACE."
(let* ((names (reverse (split-string namespace "\\.")))
(lastname (car names)))
(concat (mapconcat (lambda (s) (concat (substring s 0 1) "."))
(reverse (cdr names))
"")
lastname
"> ")))
(defun cider-repl-prompt-lastname (namespace)
"Return a prompt string with the last name in NAMESPACE."
(let* ((name (car (reverse (split-string namespace "\\.")))))
(concat name "> ")))
(defcustom cider-repl-prompt-function #'cider-repl-prompt-default
"A function that returns a prompt string.
Takes one argument, a namespace name.
For convenience, three functions are already provided for this purpose:
`cider-repl-prompt-lastname', `cider-repl-prompt-abbreviated', and
`cider-repl-prompt-default'"
:type '(choice (const :tag "Full namespace" cider-repl-prompt-default)
(const :tag "Abbreviated namespace" cider-repl-prompt-abbreviated)
(const :tag "Last name in namespace" cider-repl-prompt-lastname)
(function :tag "Custom function"))
:group 'cider-repl
:package-version '(cider . "0.9.0"))
(defun cider-repl--insert-prompt (namespace)
"Insert the prompt (before markers!), taking into account NAMESPACE.
Set point after the prompt.
Return the position of the prompt beginning."
(goto-char cider-repl-input-start-mark)
(cider-save-marker cider-repl-output-start
(cider-save-marker cider-repl-output-end
(unless (bolp) (insert-before-markers "\n"))
(let ((prompt-start (point))
(prompt (funcall cider-repl-prompt-function namespace)))
(cider-propertize-region
'(font-lock-face cider-repl-prompt-face read-only t intangible t
field cider-repl-prompt
rear-nonsticky (field read-only font-lock-face intangible))
(insert-before-markers prompt))
(set-marker cider-repl-prompt-start-mark prompt-start)
prompt-start))))
(defun cider-repl--emit-output-at-pos (buffer string output-face position &optional bol)
"Using BUFFER, insert STRING (applying to it OUTPUT-FACE) at POSITION.
If BOL is non-nil insert at the beginning of line."
(with-current-buffer buffer
(save-excursion
(cider-save-marker cider-repl-output-start
(cider-save-marker cider-repl-output-end
(goto-char position)
;; TODO: Review the need for bol
(when (and bol (not (bolp))) (insert-before-markers "\n"))
(cider-propertize-region `(font-lock-face ,output-face
rear-nonsticky (font-lock-face))
(insert-before-markers string)
(when (and (= (point) cider-repl-prompt-start-mark)
(not (bolp)))
(insert-before-markers "\n")
(set-marker cider-repl-output-end (1- (point))))))))
(cider-repl--show-maximum-output)))
(defun cider-repl--emit-interactive-output (string face)
"Emit STRING as interactive output using FACE."
(with-current-buffer (cider-current-repl-buffer)
(let ((pos (cider-repl--end-of-line-before-input-start))
(string (replace-regexp-in-string "\n\\'" "" string)))
(cider-repl--emit-output-at-pos (current-buffer) string face pos t)
(ansi-color-apply-on-region pos (point-max)))))
(defun cider-repl-emit-interactive-stdout (string)
"Emit STRING as interactive output."
(cider-repl--emit-interactive-output string 'cider-repl-stdout-face))
(defun cider-repl-emit-interactive-stderr (string)
"Emit STRING as interactive err output."
(cider-repl--emit-interactive-output string 'cider-repl-stderr-face))
(defun cider-repl--emit-output (buffer string face &optional bol)
"Using BUFFER, emit STRING font-locked with FACE.
If BOL is non-nil, emit at the beginning of the line."
(with-current-buffer buffer
(let ((pos (cider-repl--end-of-line-before-input-start)))
(cider-repl--emit-output-at-pos buffer string face cider-repl-input-start-mark bol)
(ansi-color-apply-on-region pos (point-max)))))
(defun cider-repl-emit-stdout (buffer string)
"Using BUFFER, emit STRING as standard output."
(cider-repl--emit-output buffer string 'cider-repl-stdout-face))
(defun cider-repl-emit-stderr (buffer string)
"Using BUFFER, emit STRING as error output."
(cider-repl--emit-output buffer string 'cider-repl-stderr-face))
(defun cider-repl-emit-prompt (buffer)
"Emit the REPL prompt into BUFFER."
(with-current-buffer buffer
(save-excursion
(cider-save-marker cider-repl-output-start
(cider-save-marker cider-repl-output-end
(cider-repl--insert-prompt cider-buffer-ns))))
(cider-repl--show-maximum-output)))
(defun cider-repl-emit-result (buffer string &optional bol)
"Emit into BUFFER the result STRING and mark it as an evaluation result.
If BOL is non-nil insert at the beginning of the line."
(with-current-buffer buffer
(save-excursion
(cider-save-marker cider-repl-output-start
(cider-save-marker cider-repl-output-end
(goto-char cider-repl-input-start-mark)
(when (and bol (not (bolp)))
(insert-before-markers "\n"))
(insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))
(if cider-repl-use-clojure-font-lock
(insert-before-markers (cider-font-lock-as-clojure string))
(cider-propertize-region
'(font-lock-face cider-repl-result-face rear-nonsticky (font-lock-face))
(insert-before-markers string))))))
(cider-repl--show-maximum-output)))
(defun cider-repl-newline-and-indent ()
"Insert a newline, then indent the next line.
Restrict the buffer from the prompt for indentation, to avoid being
confused by strange characters (like unmatched quotes) appearing
earlier in the buffer."
(interactive)
(save-restriction
(narrow-to-region cider-repl-prompt-start-mark (point-max))
(insert "\n")
(lisp-indent-line)))
(defun cider-repl-indent-and-complete-symbol ()
"Indent the current line and perform symbol completion.
First indent the line. If indenting doesn't move point, complete
the symbol."
(interactive)
(let ((pos (point)))
(lisp-indent-line)
(when (= pos (point))
(if (save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t))
(completion-at-point)))))
(defun cider-repl-kill-input ()
"Kill all text from the prompt to point."
(interactive)
(cond ((< (marker-position cider-repl-input-start-mark) (point))
(kill-region cider-repl-input-start-mark (point)))
((= (point) (marker-position cider-repl-input-start-mark))
(cider-repl-delete-current-input))))
(defun cider-repl--input-complete-p (start end)
"Return t if the region from START to END is a complete sexp."
(save-excursion
(goto-char start)
(cond ((looking-at-p "\\s *[@'`#]?[(\"]")
(ignore-errors
(save-restriction
(narrow-to-region start end)
;; Keep stepping over blanks and sexps until the end of
;; buffer is reached or an error occurs. Tolerate extra
;; close parens.
(cl-loop do (skip-chars-forward " \t\r\n)")
until (eobp)
do (forward-sexp))
t)))
(t t))))
(defun cider-repl-handler (buffer)
"Make a nREPL evaluation handler for the REPL BUFFER."
(nrepl-make-response-handler buffer
(lambda (buffer value)
(unless cider-repl-use-pretty-printing
(cider-repl-emit-result buffer value t)))
(lambda (buffer out)
(cider-repl-emit-stdout buffer out))
(lambda (buffer err)
(cider-repl-emit-stderr buffer err))
(lambda (buffer)
(cider-repl-emit-prompt buffer))))
(defun cider-repl--send-input (&optional newline)
"Go to the end of the input and send the current input.
If NEWLINE is true then add a newline at the end of the input."
(unless (cider-repl--in-input-area-p)
(error "No input at point"))
(goto-char (point-max))
(let ((end (point))) ; end of input, without the newline
(cider-repl--add-to-input-history (buffer-substring cider-repl-input-start-mark end))
(when newline
(insert "\n")
(cider-repl--show-maximum-output))
(let ((inhibit-modification-hooks t))
(add-text-properties cider-repl-input-start-mark
(point)
`(cider-old-input
,(cl-incf cider-repl-old-input-counter))))
(unless cider-repl-use-clojure-font-lock
(let ((overlay (make-overlay cider-repl-input-start-mark end)))
;; These properties are on an overlay so that they won't be taken
;; by kill/yank.
(overlay-put overlay 'read-only t)
(overlay-put overlay 'font-lock-face 'cider-repl-input-face))))
(let* ((input (cider-repl--current-input)))
(goto-char (point-max))
(cider-repl--mark-input-start)
(cider-repl--mark-output-start)
(cider-spinner-start)
(if (and (not (string-match-p "\\`[ \t\r\n]*\\'" input))
cider-repl-use-pretty-printing)
(cider-nrepl-request:pprint-eval
input
(cider-eval-spinner-handler
(current-buffer)
(cider-repl-handler (current-buffer)))
(cider-current-ns)
(1- (window-width)))
(cider-nrepl-request:eval
input
(cider-eval-spinner-handler
(current-buffer)
(cider-repl-handler (current-buffer)))
(cider-current-ns)))))
(defun cider-repl--ensure-valid-input (beg end)
"Ensure that the region between BEG and END is balanced."
(scan-sexps beg end))
(defun cider-repl-return (&optional end-of-input)
"Evaluate the current input string, or insert a newline.
Send the current input ony if a whole expression has been entered,
i.e. the parenthesis are matched.
When END-OF-INPUT is non-nil, send the input even if the parentheses
are not balanced."
(interactive "P")
(cider-repl--ensure-valid-input
(marker-position cider-repl-input-start-mark)
(point-max))
(cond
(end-of-input
(cider-repl--send-input))
((and (get-text-property (point) 'cider-old-input)
(< (point) cider-repl-input-start-mark))
(cider-repl--grab-old-input end-of-input)
(cider-repl--recenter-if-needed))
((cider-repl--input-complete-p cider-repl-input-start-mark (point-max))
(cider-repl--send-input t))
(t
(cider-repl-newline-and-indent)
(message "[input not complete]"))))
(defun cider-repl--recenter-if-needed ()
"Make sure that the point is visible."
(unless (pos-visible-in-window-p (point-max))
(save-excursion
(goto-char (point-max))
(recenter -1))))
(defun cider-repl--grab-old-input (replace)
"Resend the old REPL input at point.
If REPLACE is non-nil the current input is replaced with the old
input; otherwise the new input is appended. The old input has the
text property `cider-old-input'."
(cl-multiple-value-bind (beg end) (cider-property-bounds 'cider-old-input)
(let ((old-input (buffer-substring beg end)) ;;preserve
;;properties, they will be removed later
(offset (- (point) beg)))
;; Append the old input or replace the current input
(cond (replace (goto-char cider-repl-input-start-mark))
(t (goto-char (point-max))
(unless (eq (char-before) ?\ )
(insert " "))))
(delete-region (point) (point-max))
(save-excursion
(insert old-input)
(when (equal (char-before) ?\n)
(delete-char -1)))
(forward-char offset))))
(defun cider-repl-closing-return ()
"Evaluate the current input string after closing all open lists."
(interactive)
(goto-char (point-max))
(save-restriction
(narrow-to-region cider-repl-input-start-mark (point))
(while (ignore-errors (save-excursion (backward-up-list 1)) t)
(insert ")")))
(cider-repl-return))
(defun cider-repl-toggle-pretty-printing ()
"Toggle pretty-printing in the REPL."
(interactive)
(setq cider-repl-use-pretty-printing (not cider-repl-use-pretty-printing))
(message "Pretty printing in REPL %s."
(if cider-repl-use-pretty-printing "enabled" "disabled")))
(defvar cider-repl-clear-buffer-hook)
(defun cider-repl-clear-buffer ()
"Delete the output generated by the Clojure process."
(interactive)
(let ((inhibit-read-only t))
(delete-region (point-min) cider-repl-prompt-start-mark)
(delete-region cider-repl-output-start cider-repl-output-end)
(when (< (point) cider-repl-input-start-mark)
(goto-char cider-repl-input-start-mark))
(recenter t))
(run-hooks 'cider-repl-clear-buffer-hook))
(defun cider-repl--end-of-line-before-input-start ()
"Return the position of the end of the line preceding the beginning of input."
(1- (previous-single-property-change cider-repl-input-start-mark 'field nil
(1+ (point-min)))))
(defun cider-repl-clear-output ()
"Delete the output inserted since the last input."
(interactive)
(let ((start (save-excursion
(cider-repl-previous-prompt)
(ignore-errors (forward-sexp))
(forward-line)
(point)))
(end (cider-repl--end-of-line-before-input-start)))
(when (< start end)
(let ((inhibit-read-only t))
(delete-region start end)
(save-excursion
(goto-char start)
(insert
(propertize ";;; output cleared" 'font-lock-face 'font-lock-comment-face)))))))
(defun cider-repl-switch-ns-handler (buffer)
"Make a nREPL evaluation handler for the REPL BUFFER's ns switching."
(nrepl-make-response-handler buffer
(lambda (_buffer _value))
(lambda (buffer out)
(cider-repl-emit-stdout buffer out))
(lambda (buffer err)
(cider-repl-emit-stderr buffer err))
(lambda (buffer)
(cider-repl-emit-prompt buffer))))
(defun cider-repl-set-ns (ns)
"Switch the namespace of the REPL buffer to NS.
If invoked in a REPL buffer the command will prompt you for the name of the
namespace to switch to."
(interactive (list (if (or (derived-mode-p 'cider-repl-mode)
(null (cider-ns-form)))
(completing-read "Switch to namespace: "
(cider-sync-request:ns-list))
(cider-current-ns))))
(if (and ns (not (equal ns "")))
(cider-nrepl-request:eval (format "(in-ns '%s)" ns)
(cider-repl-switch-ns-handler (cider-current-connection))
nil)
(error "No namespace selected")))
;;;;; History
(defcustom cider-repl-wrap-history nil
"T to wrap history around when the end is reached."
:type 'boolean
:group 'cider-repl)
;; These two vars contain the state of the last history search. We
;; only use them if `last-command' was `cider-repl--history-replace',
;; otherwise we reinitialize them.
(defvar cider-repl-input-history-position -1
"Newer items have smaller indices.")
(defvar cider-repl-history-pattern nil
"The regexp most recently used for finding input history.")
(defun cider-repl--add-to-input-history (string)
"Add STRING to the input history.
Empty strings and duplicates are ignored."
(unless (or (equal string "")
(equal string (car cider-repl-input-history)))
(push string cider-repl-input-history)
(cl-incf cider-repl-input-history-items-added)))
(defun cider-repl-delete-current-input ()
"Delete all text after the prompt."
(goto-char (point-max))
(delete-region cider-repl-input-start-mark (point-max)))
(defun cider-repl--replace-input (string)
"Replace the current REPL input with STRING."
(cider-repl-delete-current-input)
(insert-and-inherit string))
(defun cider-repl--position-in-history (start-pos direction regexp)
"Return the position of the history item starting at START-POS.
Search in DIRECTION for REGEXP.
Return -1 resp the length of the history if no item matches."
;; Loop through the history list looking for a matching line
(let* ((step (cl-ecase direction
(forward -1)
(backward 1)))
(history cider-repl-input-history)
(len (length history)))
(cl-loop for pos = (+ start-pos step) then (+ pos step)
if (< pos 0) return -1
if (<= len pos) return len
if (string-match-p regexp (nth pos history)) return pos)))
(defun cider-repl--history-replace (direction &optional regexp)
"Replace the current input with the next line in DIRECTION.
DIRECTION is 'forward' or 'backward' (in the history list).
If REGEXP is non-nil, only lines matching REGEXP are considered."
(setq cider-repl-history-pattern regexp)
(let* ((min-pos -1)
(max-pos (length cider-repl-input-history))
(pos0 (cond ((cider-history-search-in-progress-p)
cider-repl-input-history-position)
(t min-pos)))
(pos (cider-repl--position-in-history pos0 direction (or regexp "")))
(msg nil))
(cond ((and (< min-pos pos) (< pos max-pos))
(cider-repl--replace-input (nth pos cider-repl-input-history))
(setq msg (format "History item: %d" pos)))
((not cider-repl-wrap-history)
(setq msg (cond ((= pos min-pos) "End of history")
((= pos max-pos) "Beginning of history"))))
(cider-repl-wrap-history
(setq pos (if (= pos min-pos) max-pos min-pos))
(setq msg "Wrapped history")))
(when (or (<= pos min-pos) (<= max-pos pos))
(when regexp
(setq msg (concat msg "; no matching item"))))
(message "%s%s" msg (cond ((not regexp) "")
(t (format "; current regexp: %s" regexp))))
(setq cider-repl-input-history-position pos)
(setq this-command 'cider-repl--history-replace)))
(defun cider-history-search-in-progress-p ()
"Return t if a current history search is in progress."
(eq last-command 'cider-repl--history-replace))
(defun cider-terminate-history-search ()
"Terminate the current history search."
(setq last-command this-command))
(defun cider-repl-previous-input ()
"Cycle backwards through input history.
If the `last-command' was a history navigation command use the
same search pattern for this command.
Otherwise use the current input as search pattern."
(interactive)
(cider-repl--history-replace 'backward (cider-repl-history-pattern t)))
(defun cider-repl-next-input ()
"Cycle forwards through input history.
See `cider-previous-input'."
(interactive)
(cider-repl--history-replace 'forward (cider-repl-history-pattern t)))
(defun cider-repl-forward-input ()
"Cycle forwards through input history."
(interactive)
(cider-repl--history-replace 'forward (cider-repl-history-pattern)))
(defun cider-repl-backward-input ()
"Cycle backwards through input history."
(interactive)
(cider-repl--history-replace 'backward (cider-repl-history-pattern)))
(defun cider-repl-previous-matching-input (regexp)
"Find the previous input matching REGEXP."
(interactive "sPrevious element matching (regexp): ")
(cider-terminate-history-search)
(cider-repl--history-replace 'backward regexp))
(defun cider-repl-next-matching-input (regexp)
"Find then next input matching REGEXP."
(interactive "sNext element matching (regexp): ")
(cider-terminate-history-search)
(cider-repl--history-replace 'forward regexp))
(defun cider-repl-history-pattern (&optional use-current-input)
"Return the regexp for the navigation commands.
If USE-CURRENT-INPUT is non-nil, use the current input."
(cond ((cider-history-search-in-progress-p)
cider-repl-history-pattern)
(use-current-input
(cl-assert (<= cider-repl-input-start-mark (point)))
(let ((str (cider-repl--current-input t)))
(cond ((string-match-p "^[ \n]*$" str) nil)
(t (concat "^" (regexp-quote str))))))
(t nil)))
;;; persistent history
(defcustom cider-repl-history-size 500
"The maximum number of items to keep in the REPL history."
:type 'integer
:safe 'integerp
:group 'cider-repl)
(defcustom cider-repl-history-file nil
"File to save the persistent REPL history to."
:type 'string
:safe 'stringp
:group 'cider-repl)
(defun cider-repl--history-read-filename ()
"Ask the user which file to use, defaulting `cider-repl-history-file'."
(read-file-name "Use CIDER REPL history file: "
cider-repl-history-file))
(defun cider-repl--history-read (filename)
"Read history from FILENAME and return it.
It does not yet set the input history."
(if (file-readable-p filename)
(with-temp-buffer
(insert-file-contents filename)
(when (> (buffer-size (current-buffer)) 0)
(read (current-buffer))))
'()))
(defun cider-repl-history-load (&optional filename)
"Load history from FILENAME into current session.
FILENAME defaults to the value of `cider-repl-history-file' but user
defined filenames can be used to read special history files.
The value of `cider-repl-input-history' is set by this function."
(interactive (list (cider-repl--history-read-filename)))
(let ((f (or filename cider-repl-history-file)))
;; TODO: probably need to set cider-repl-input-history-position as well.
;; in a fresh connection the newest item in the list is currently
;; not available. After sending one input, everything seems to work.
(setq cider-repl-input-history (cider-repl--history-read f))))
(defun cider-repl--history-write (filename)
"Write history to FILENAME.
Currently coding system for writing the contents is hardwired to
utf-8-unix."
(let* ((mhist (cider-repl--histories-merge cider-repl-input-history
cider-repl-input-history-items-added
(cider-repl--history-read filename)))
;; newest items are at the beginning of the list, thus 0
(hist (cl-subseq mhist 0 (min (length mhist) cider-repl-history-size))))
(unless (file-writable-p filename)
(error (format "History file not writable: %s" filename)))
(let ((print-length nil) (print-level nil))
(with-temp-file filename
;; TODO: really set cs for output
;; TODO: does cs need to be customizable?
(insert ";; -*- coding: utf-8-unix -*-\n")
(insert ";; Automatically written history of CIDER REPL session\n")
(insert ";; Edit at your own risk\n\n")
(prin1 (mapcar #'substring-no-properties hist) (current-buffer))))))
(defun cider-repl-history-save (&optional filename)
"Save the current REPL input history to FILENAME.
FILENAME defaults to the value of `cider-repl-history-file'."
(interactive (list (cider-repl--history-read-filename)))
(let* ((file (or filename cider-repl-history-file)))
(cider-repl--history-write file)))
(defun cider-repl-history-just-save ()
"Just save the history to `cider-repl-history-file'.
This function is meant to be used in hooks to avoid lambda
constructs."
(cider-repl-history-save cider-repl-history-file))
;; SLIME has different semantics and will not save any duplicates.
;; we keep track of how many items were added to the history in the
;; current session in `cider-repl--add-to-input-history' and merge only the
;; new items with the current history found in the file, which may
;; have been changed in the meantime by another session.
(defun cider-repl--histories-merge (session-hist n-added-items file-hist)
"Merge histories from SESSION-HIST adding N-ADDED-ITEMS into FILE-HIST."
(append (cl-subseq session-hist 0 n-added-items)
file-hist))
;;; REPL shortcuts
(defcustom cider-repl-shortcut-dispatch-char ?\,
"Character used to distinguish REPL commands from Lisp forms."
:type '(character)
:group 'cider-repl)
(defvar cider-repl-shortcuts (make-hash-table :test 'equal))
(defun cider-repl-add-shortcut (name handler)
"Add a REPL shortcut command, defined by NAME and HANDLER."
(puthash name handler cider-repl-shortcuts))
(declare-function cider-restart "cider-interaction")
(declare-function cider-quit "cider-interaction")
(cider-repl-add-shortcut "hasta la vista" #'cider-quit)
(cider-repl-add-shortcut "quit" #'cider-quit)
(cider-repl-add-shortcut "restart" #'cider-restart)
(cider-repl-add-shortcut "version" #'cider-version)
(cider-repl-add-shortcut "conn-info" #'cider-display-connection-info)
(cider-repl-add-shortcut "conn-rotate" #'cider-rotate-default-connection)
(cider-repl-add-shortcut "clear" #'cider-repl-clear-buffer)
(cider-repl-add-shortcut "ns" #'cider-repl-set-ns)
(cider-repl-add-shortcut "help" #'cider-repl-shortcuts-help)
(defun cider-repl-shortcuts-help ()
"Display a help buffer."
(interactive)
(ignore-errors (kill-buffer "*CIDER REPL Shortcuts Help*"))
(with-current-buffer (get-buffer-create "*CIDER REPL Shortcuts Help*")
(insert "CIDER REPL shortcuts:\n\n")
(maphash (lambda (k v) (insert (format "%s:\n\t%s\n" k v))) cider-repl-shortcuts)
(goto-char (point-min))
(help-mode)
(display-buffer (current-buffer) t))
(cider-repl-handle-shortcut)
(current-buffer))
(defun cider-repl--available-shortcuts ()
"Return the available REPL shortcuts."
(cider-util--hash-keys cider-repl-shortcuts))
(defun cider-repl-handle-shortcut ()
"Execute a REPL shortcut."
(interactive)
(if (> (point) cider-repl-input-start-mark)
(insert (string cider-repl-shortcut-dispatch-char))
(let ((command (completing-read "Command: "
(cider-repl--available-shortcuts))))
(if (not (equal command ""))
(let ((command-func (gethash command cider-repl-shortcuts)))
(if command-func
(call-interactively (gethash command cider-repl-shortcuts))
(error "Unknown command %S. Available commands: %s"
command-func
(mapconcat 'identity (cider-repl--available-shortcuts) ", "))))
(error "No command selected")))))
;;;;; CIDER REPL mode
(defvar cider-repl-mode-hook nil
"Hook executed when entering `cider-repl-mode'.")
(defvar cider-repl-mode-syntax-table
(copy-syntax-table clojure-mode-syntax-table))
(declare-function cider-eval-region "cider-interaction")
(declare-function cider-eval-last-sexp "cider-interaction")
(declare-function cider-refresh "cider-interaction")
(declare-function cider-toggle-trace-ns "cider-interaction")
(declare-function cider-toggle-trace-var "cider-interaction")
(declare-function cider-find-resource "cider-interaction")
(declare-function cider-restart "cider-interaction")
(declare-function cider-find-ns "cider-interaction")
(declare-function cider-switch-to-last-clojure-buffer "cider-mode")
(defvar cider-repl-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-d") #'cider-doc-map)
(define-key map (kbd "M-.") #'cider-find-var)
(define-key map (kbd "C-c C-.") #'cider-find-ns)
(define-key map (kbd "M-,") #'cider-pop-back)
(define-key map (kbd "C-c M-.") #'cider-find-resource)
(define-key map (kbd "RET") #'cider-repl-return)
(define-key map (kbd "TAB") #'cider-repl-tab)
(define-key map (kbd "C-<return>") #'cider-repl-closing-return)
(define-key map (kbd "C-j") #'cider-repl-newline-and-indent)
(define-key map (kbd "C-c C-o") #'cider-repl-clear-output)
(define-key map (kbd "C-c M-o") #'cider-repl-clear-buffer)
(define-key map (kbd "C-c M-n") #'cider-repl-set-ns)
(define-key map (kbd "C-c C-u") #'cider-repl-kill-input)
(define-key map (kbd "C-S-a") #'cider-repl-bol-mark)
(define-key map [S-home] #'cider-repl-bol-mark)
(define-key map (kbd "C-<up>") #'cider-repl-backward-input)
(define-key map (kbd "C-<down>") #'cider-repl-forward-input)
(define-key map (kbd "M-p") #'cider-repl-previous-input)
(define-key map (kbd "M-n") #'cider-repl-next-input)
(define-key map (kbd "M-r") #'cider-repl-previous-matching-input)
(define-key map (kbd "M-s") #'cider-repl-next-matching-input)
(define-key map (kbd "C-c C-n") #'cider-repl-next-prompt)
(define-key map (kbd "C-c C-p") #'cider-repl-previous-prompt)
(define-key map (kbd "C-c C-b") #'cider-interrupt)
(define-key map (kbd "C-c C-c") #'cider-interrupt)
(define-key map (kbd "C-c C-m") #'cider-macroexpand-1)
(define-key map (kbd "C-c M-m") #'cider-macroexpand-all)
(define-key map (kbd "C-c C-z") #'cider-switch-to-last-clojure-buffer)
(define-key map (kbd "C-c M-s") #'cider-selector)
(define-key map (kbd "C-c C-q") #'cider-quit)
(define-key map (kbd "C-c M-i") #'cider-inspect)
(define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var)
(define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns)
(define-key map (kbd "C-c C-x") #'cider-refresh)
(define-key map (kbd "C-x C-e") #'cider-eval-last-sexp)
(define-key map (kbd "C-c C-r") #'cider-eval-region)
(define-key map (string cider-repl-shortcut-dispatch-char) #'cider-repl-handle-shortcut)
(easy-menu-define cider-repl-mode-menu map
"Menu for CIDER's REPL mode"
`("REPL"
["Complete symbol" complete-symbol]
"--"
,cider-doc-menu
"--"
("Find"
["Find definition" cider-find-var]
["Find resource" cider-find-resource]
["Go back" cider-pop-back])
"--"
["Switch to Clojure buffer" cider-switch-to-last-clojure-buffer]
"--"
("Macroexpand"
["Macroexpand-1" cider-macroexpand-1]
["Macroexpand-all" cider-macroexpand-all])
"--"
["Run project (-main function)" cider-run]
["Inspect" cider-inspect]
["Toggle var tracing" cider-toggle-trace-var]
["Toggle ns tracing" cider-toggle-trace-ns]
["Refresh loaded code" cider-refresh]
"--"
["Set REPL ns" cider-repl-set-ns]
["Toggle pretty printing" cider-repl-toggle-pretty-printing]
"--"
["Next prompt" cider-repl-next-prompt]
["Previous prompt" cider-repl-previous-prompt]
["Clear output" cider-repl-clear-output]
["Clear buffer" cider-repl-clear-buffer]
["Kill input" cider-repl-kill-input]
"--"
["Interrupt evaluation" cider-interrupt]
"--"
["Quit" cider-quit]
["Restart" cider-restart]
"--"
["Version info" cider-version]))
map))
(defun cider-repl-wrap-fontify-function (func)
"Return a function that calls FUNC narrowed to input region."
(lambda (beg end &rest rest)
(when (and cider-repl-input-start-mark
(> end cider-repl-input-start-mark))
(save-restriction
(narrow-to-region cider-repl-input-start-mark (point-max))
(let ((font-lock-dont-widen t))
(apply func (max beg cider-repl-input-start-mark) end rest))))))
(declare-function cider-complete-at-point "cider-interaction")
(defvar cider--static-font-lock-keywords)
(define-derived-mode cider-repl-mode fundamental-mode "REPL"
"Major mode for Clojure REPL interactions.
\\{cider-repl-mode-map}"
(clojure-mode-variables)
(setq-local lisp-indent-function #'clojure-indent-function)
(setq-local indent-line-function #'lisp-indent-line)
(clojure-font-lock-setup)
(font-lock-add-keywords nil cider--static-font-lock-keywords)
(setq-local font-lock-fontify-region-function
(cider-repl-wrap-fontify-function font-lock-fontify-region-function))
(setq-local font-lock-unfontify-region-function
(cider-repl-wrap-fontify-function font-lock-unfontify-region-function))
(make-local-variable 'completion-at-point-functions)
(add-to-list 'completion-at-point-functions
#'cider-complete-at-point)
(set-syntax-table cider-repl-mode-syntax-table)
(cider-eldoc-setup)
(eldoc-mode +1)
;; At the REPL, we define beginning-of-defun and end-of-defun to be
;; the start of the previous prompt or next prompt respectively.
;; Notice the interplay with `cider-repl-beginning-of-defun'.
(setq-local beginning-of-defun-function #'cider-repl-mode-beginning-of-defun)
(setq-local end-of-defun-function #'cider-repl-mode-end-of-defun)
(setq-local prettify-symbols-alist clojure--prettify-symbols-alist)
(if (fboundp 'hack-dir-local-variables-non-file-buffer)
(hack-dir-local-variables-non-file-buffer))
(when cider-repl-history-file
(cider-repl-history-load cider-repl-history-file)
(add-hook 'kill-buffer-hook #'cider-repl-history-just-save t t)
(add-hook 'kill-emacs-hook #'cider-repl-history-just-save))
(add-hook 'paredit-mode-hook #'clojure-paredit-setup))
(provide 'cider-repl)
;;; cider-repl.el ends here