diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el | 1115 |
1 files changed, 0 insertions, 1115 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el deleted file mode 100644 index 67f2706ba34e..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el +++ /dev/null @@ -1,1115 +0,0 @@ -;;; cider-eval.el --- Interactive evaluation (compilation) functionality -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.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: - -;; This file contains CIDER's interactive evaluation (compilation) functionality. -;; Although Clojure doesn't really have the concept of evaluation (only -;; compilation), we're using everywhere in the code the term evaluation for -;; brevity (and to be in line with the naming employed by other similar modes). -;; -;; This files also contains all the logic related to displaying errors and -;; evaluation warnings. -;; -;; Pretty much all of the commands here are meant to be used mostly from -;; `cider-mode', but some of them might make sense in other contexts as well. - -;;; Code: - -(require 'cider-client) -(require 'cider-repl) -(require 'cider-popup) -(require 'cider-common) -(require 'cider-util) -(require 'cider-stacktrace) -(require 'cider-overlays) -(require 'cider-compat) - -(require 'clojure-mode) -(require 'ansi-color) -(require 'cl-lib) -(require 'subr-x) -(require 'compile) - -(defconst cider-read-eval-buffer "*cider-read-eval*") -(defconst cider-result-buffer "*cider-result*") - -(defcustom cider-show-error-buffer t - "Control the popup behavior of cider stacktraces. -The following values are possible t or 'always, 'except-in-repl, -'only-in-repl. Any other value, including nil, will cause the stacktrace -not to be automatically shown. - -Irespective of the value of this variable, the `cider-error-buffer' is -always generated in the background. Use `cider-selector' to -navigate to this buffer." - :type '(choice (const :tag "always" t) - (const except-in-repl) - (const only-in-repl) - (const :tag "never" nil)) - :group 'cider) - -(defcustom cider-auto-jump-to-error t - "Control the cursor jump behaviour in compilation error buffer. -When non-nil automatically jump to error location during interactive -compilation. When set to 'errors-only, don't jump to warnings. -When set to nil, don't jump at all." - :type '(choice (const :tag "always" t) - (const errors-only) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-auto-select-error-buffer t - "Controls whether to auto-select the error popup buffer." - :type 'boolean - :group 'cider) - -(defcustom cider-auto-track-ns-form-changes t - "Controls whether to auto-evaluate a source buffer's ns form when changed. -When non-nil CIDER will check for ns form changes before each eval command. -When nil the users are expected to take care of the re-evaluating updated -ns forms manually themselves." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.0")) - -(defcustom cider-save-file-on-load 'prompt - "Controls whether to prompt to save the file when loading a buffer. -If nil, files are not saved. -If 'prompt, the user is prompted to save the file if it's been modified. -If t, save the file without confirmation." - :type '(choice (const prompt :tag "Prompt to save the file if it's been modified") - (const nil :tag "Don't save the file") - (const t :tag "Save the file without confirmation")) - :group 'cider - :package-version '(cider . "0.6.0")) - - -(defconst cider-output-buffer "*cider-out*") - -(defcustom cider-interactive-eval-output-destination 'repl-buffer - "The destination for stdout and stderr produced from interactive evaluation." - :type '(choice (const output-buffer) - (const repl-buffer)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defface cider-error-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "red") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline t))) - "Face used to highlight compilation errors in Clojure buffers." - :group 'cider) - -(defface cider-warning-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "yellow") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline (:color "yellow")))) - "Face used to highlight compilation warnings in Clojure buffers." - :group 'cider) - -(defcustom cider-comment-prefix ";; => " - "The prefix to insert before the first line of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-comment-continued-prefix ";; " - "The prefix to use on the second and subsequent lines of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-comment-postfix "" - "The postfix to be appended after the final line of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - - -;;; Utilities - -(defun cider--clear-compilation-highlights () - "Remove compilation highlights." - (remove-overlays (point-min) (point-max) 'cider-note-p t)) - -(defun cider-clear-compilation-highlights (&optional arg) - "Remove compilation highlights. -When invoked with a prefix ARG the command doesn't prompt for confirmation." - (interactive "P") - (when (or arg (y-or-n-p "Are you sure you want to clear the compilation highlights? ")) - (cider--clear-compilation-highlights))) - -(defun cider--quit-error-window () - "Buries the `cider-error-buffer' and quits its containing window." - (when-let* ((error-win (get-buffer-window cider-error-buffer))) - (quit-window nil error-win))) - - -;;; Dealing with compilation (evaluation) errors and warnings -(defun cider-find-property (property &optional backward) - "Find the next text region which has the specified PROPERTY. -If BACKWARD is t, then search backward. -Returns the position at which PROPERTY was found, or nil if not found." - (let ((p (if backward - (previous-single-char-property-change (point) property) - (next-single-char-property-change (point) property)))) - (when (and (not (= p (point-min))) (not (= p (point-max)))) - p))) - -(defun cider-jump-to-compilation-error (&optional _arg _reset) - "Jump to the line causing the current compilation error. -_ARG and _RESET are ignored, as there is only ever one compilation error. -They exist for compatibility with `next-error'." - (interactive) - (cl-labels ((goto-next-note-boundary - () - (let ((p (or (cider-find-property 'cider-note-p) - (cider-find-property 'cider-note-p t)))) - (when p - (goto-char p) - (message "%s" (get-char-property p 'cider-note)))))) - ;; if we're already on a compilation error, first jump to the end of - ;; it, so that we find the next error. - (when (get-char-property (point) 'cider-note-p) - (goto-next-note-boundary)) - (goto-next-note-boundary))) - -(defun cider--show-error-buffer-p () - "Return non-nil if the error buffer must be shown on error. -Takes into account both the value of `cider-show-error-buffer' and the -currently selected buffer." - (let* ((selected-buffer (window-buffer (selected-window))) - (replp (with-current-buffer selected-buffer (derived-mode-p 'cider-repl-mode)))) - (memq cider-show-error-buffer - (if replp - '(t always only-in-repl) - '(t always except-in-repl))))) - -(defun cider-new-error-buffer (&optional mode error-types) - "Return an empty error buffer using MODE. - -When deciding whether to display the buffer, takes into account not only -the value of `cider-show-error-buffer' and the currently selected buffer -but also the ERROR-TYPES of the error, which is checked against the -`cider-stacktrace-suppressed-errors' set. - -When deciding whether to select the buffer, takes into account the value of -`cider-auto-select-error-buffer'." - (if (and (cider--show-error-buffer-p) - (not (cider-stacktrace-some-suppressed-errors-p error-types))) - (cider-popup-buffer cider-error-buffer cider-auto-select-error-buffer mode 'ancillary) - (cider-make-popup-buffer cider-error-buffer mode 'ancillary))) - -(defun cider-emit-into-color-buffer (buffer value) - "Emit into color BUFFER the provided VALUE." - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (goto-char (point-max)) - (insert (format "%s" value)) - (ansi-color-apply-on-region (point-min) (point-max))) - (goto-char (point-min)))) - -(defun cider--handle-err-eval-response (response) - "Render eval RESPONSE into a new error buffer. - -Uses the value of the `out' slot in RESPONSE." - (nrepl-dbind-response response (out) - (when out - (let ((error-buffer (cider-new-error-buffer))) - (cider-emit-into-color-buffer error-buffer out) - (with-current-buffer error-buffer - (compilation-minor-mode +1)))))) - -(defun cider-default-err-eval-handler () - "Display the last exception without middleware support." - (cider--handle-err-eval-response - (cider-nrepl-sync-request:eval - "(clojure.stacktrace/print-cause-trace *e)"))) - -(defun cider--render-stacktrace-causes (causes &optional error-types) - "If CAUSES is non-nil, render its contents into a new error buffer. -Optional argument ERROR-TYPES contains a list which should determine the -op/situation that originated this error." - (when causes - (let ((error-buffer (cider-new-error-buffer #'cider-stacktrace-mode error-types))) - (cider-stacktrace-render error-buffer (reverse causes) error-types)))) - -(defun cider--handle-stacktrace-response (response causes) - "Handle stacktrace op RESPONSE, aggregating the result into CAUSES. -If RESPONSE contains a cause, cons it onto CAUSES and return that. If -RESPONSE is the final message (i.e. it contains a status), render CAUSES -into a new error buffer." - (nrepl-dbind-response response (class status) - (cond (class (cons response causes)) - (status (cider--render-stacktrace-causes causes))))) - -(defun cider-default-err-op-handler () - "Display the last exception, with middleware support." - ;; Causes are returned as a series of messages, which we aggregate in `causes' - (let (causes) - (cider-nrepl-send-request - (nconc '("op" "stacktrace") - (when (cider--pprint-fn) - `("pprint-fn" ,(cider--pprint-fn))) - (when cider-stacktrace-print-length - `("print-length" ,cider-stacktrace-print-length)) - (when cider-stacktrace-print-level - `("print-level" ,cider-stacktrace-print-level))) - (lambda (response) - ;; While the return value of `cider--handle-stacktrace-response' is not - ;; meaningful for the last message, we do not need the value of `causes' - ;; after it has been handled, so it's fine to set it unconditionally here - (setq causes (cider--handle-stacktrace-response response causes)))))) - -(defun cider-default-err-handler () - "This function determines how the error buffer is shown. -It delegates the actual error content to the eval or op handler." - (if (cider-nrepl-op-supported-p "stacktrace") - (cider-default-err-op-handler) - (cider-default-err-eval-handler))) - -(defvar cider-compilation-regexp - '("\\(?:.*\\(warning, \\)\\|.*?\\(, compiling\\):(\\)\\(.*?\\):\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\(\\(?: - \\(.*\\)\\)\\|)\\)" 3 4 5 (1)) - "Specifications for matching errors and warnings in Clojure stacktraces. -See `compilation-error-regexp-alist' for help on their format.") - -(add-to-list 'compilation-error-regexp-alist-alist - (cons 'cider cider-compilation-regexp)) -(add-to-list 'compilation-error-regexp-alist 'cider) - -(defun cider-extract-error-info (regexp message) - "Extract error information with REGEXP against MESSAGE." - (let ((file (nth 1 regexp)) - (line (nth 2 regexp)) - (col (nth 3 regexp)) - (type (nth 4 regexp)) - (pat (car regexp))) - (when (string-match pat message) - ;; special processing for type (1.2) style - (setq type (if (consp type) - (or (and (car type) (match-end (car type)) 1) - (and (cdr type) (match-end (cdr type)) 0) - 2))) - (list - (when file - (let ((val (match-string-no-properties file message))) - (unless (string= val "NO_SOURCE_PATH") val))) - (when line (string-to-number (match-string-no-properties line message))) - (when col - (let ((val (match-string-no-properties col message))) - (when val (string-to-number val)))) - (aref [cider-warning-highlight-face - cider-warning-highlight-face - cider-error-highlight-face] - (or type 2)) - message)))) - -(defun cider--goto-expression-start () - "Go to the beginning a list, vector, map or set outside of a string. -We do so by starting and the current position and proceeding backwards -until we find a delimiters that's not inside a string." - (if (and (looking-back "[])}]" (line-beginning-position)) - (null (nth 3 (syntax-ppss)))) - (backward-sexp) - (while (or (not (looking-at-p "[({[]")) - (nth 3 (syntax-ppss))) - (backward-char)))) - -(defun cider--find-last-error-location (message) - "Return the location (begin end buffer) from the Clojure error MESSAGE. -If location could not be found, return nil." - (save-excursion - (let ((info (cider-extract-error-info cider-compilation-regexp message))) - (when info - (let ((file (nth 0 info)) - (line (nth 1 info)) - (col (nth 2 info))) - (unless (or (not (stringp file)) - (cider--tooling-file-p file)) - (when-let* ((buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)) - (move-to-column (or col 0)) - (let ((begin (progn (if col (cider--goto-expression-start) (back-to-indentation)) - (point))) - (end (progn (if col (forward-list) (move-end-of-line nil)) - (point)))) - (list begin end buffer)))))))))))) - -(defun cider-handle-compilation-errors (message eval-buffer) - "Highlight and jump to compilation error extracted from MESSAGE. -EVAL-BUFFER is the buffer that was current during user's interactive -evaluation command. Honor `cider-auto-jump-to-error'." - (when-let* ((loc (cider--find-last-error-location message)) - (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc))) - (info (cider-extract-error-info cider-compilation-regexp message))) - (let* ((face (nth 3 info)) - (note (nth 4 info)) - (auto-jump (if (eq cider-auto-jump-to-error 'errors-only) - (not (eq face 'cider-warning-highlight-face)) - cider-auto-jump-to-error))) - (overlay-put overlay 'cider-note-p t) - (overlay-put overlay 'font-lock-face face) - (overlay-put overlay 'cider-note note) - (overlay-put overlay 'help-echo note) - (overlay-put overlay 'modification-hooks - (list (lambda (o &rest _args) (delete-overlay o)))) - (when auto-jump - (with-current-buffer eval-buffer - (push-mark) - ;; At this stage selected window commonly is *cider-error* and we need to - ;; re-select the original user window. If eval-buffer is not - ;; visible it was probably covered as a result of a small screen or user - ;; configuration (https://github.com/clojure-emacs/cider/issues/847). In - ;; that case we don't jump at all in order to avoid covering *cider-error* - ;; buffer. - (when-let* ((win (get-buffer-window eval-buffer))) - (with-selected-window win - (cider-jump-to (nth 2 loc) (car loc))))))))) - - -;;; Interactive evaluation handlers -(defun cider-insert-eval-handler (&optional buffer) - "Make an nREPL evaluation handler for the BUFFER. -The handler simply inserts the result value in BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (with-current-buffer buffer - (insert value))) - (lambda (_buffer out) - (cider-repl-emit-interactive-stdout out)) - (lambda (_buffer err) - (cider-handle-compilation-errors err eval-buffer)) - '()))) - -(defun cider--emit-interactive-eval-output (output repl-emit-function) - "Emit output resulting from interactive code evaluation. -The OUTPUT can be sent to either a dedicated output buffer or the current -REPL buffer. This is controlled by `cider-interactive-eval-output-destination'. -REPL-EMIT-FUNCTION emits the OUTPUT." - (pcase cider-interactive-eval-output-destination - (`output-buffer (let ((output-buffer (or (get-buffer cider-output-buffer) - (cider-popup-buffer cider-output-buffer t)))) - (cider-emit-into-popup-buffer output-buffer output) - (pop-to-buffer output-buffer))) - (`repl-buffer (funcall repl-emit-function output)) - (_ (error "Unsupported value %s for `cider-interactive-eval-output-destination'" - cider-interactive-eval-output-destination)))) - -(defun cider-emit-interactive-eval-output (output) - "Emit OUTPUT resulting from interactive code evaluation. -The output can be send to either a dedicated output buffer or the current -REPL buffer. This is controlled via -`cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stdout)) - -(defun cider-emit-interactive-eval-err-output (output) - "Emit err OUTPUT resulting from interactive code evaluation. -The output can be send to either a dedicated output buffer or the current -REPL buffer. This is controlled via -`cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stderr)) - -(defun cider--make-fringe-overlays-for-region (beg end) - "Place eval indicators on all sexps between BEG and END." - (with-current-buffer (if (markerp end) - (marker-buffer end) - (current-buffer)) - (save-excursion - (goto-char beg) - (remove-overlays beg end 'category 'cider-fringe-indicator) - (condition-case nil - (while (progn (clojure-forward-logical-sexp) - (and (<= (point) end) - (not (eobp)))) - (cider--make-fringe-overlay (point))) - (scan-error nil))))) - -(defun cider-interactive-eval-handler (&optional buffer place) - "Make an interactive eval handler for BUFFER. -PLACE is used to display the evaluation result. -If non-nil, it can be the position where the evaluated sexp ends, -or it can be a list with (START END) of the evaluated region." - (let* ((eval-buffer (current-buffer)) - (beg (car-safe place)) - (end (or (car-safe (cdr-safe place)) place)) - (beg (when beg (copy-marker beg))) - (end (when end (copy-marker end))) - (fringed nil)) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (if beg - (unless fringed - (cider--make-fringe-overlays-for-region beg end) - (setq fringed t)) - (cider--make-fringe-overlay end)) - (cider--display-interactive-eval-result value end)) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err) - (cider-handle-compilation-errors err eval-buffer)) - '()))) - -(defun cider-load-file-handler (&optional buffer) - "Make a load file handler for BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (buffer value) - (cider--display-interactive-eval-result value) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (cider--make-fringe-overlays-for-region (point-min) (point-max)) - (run-hooks 'cider-file-loaded-hook)))) - (lambda (_buffer value) - (cider-emit-interactive-eval-output value)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err) - (cider-handle-compilation-errors err eval-buffer)) - '() - (lambda () - (funcall nrepl-err-handler))))) - -(defun cider-eval-print-handler (&optional buffer) - "Make a handler for evaluating and printing result in BUFFER." - (nrepl-make-response-handler (or buffer (current-buffer)) - (lambda (buffer value) - (with-current-buffer buffer - (insert - (if (derived-mode-p 'cider-clojure-interaction-mode) - (format "\n%s\n" value) - value)))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - '())) - -(defun cider-eval-print-with-comment-handler (buffer location comment-prefix) - "Make a handler for evaluating and printing commented results in BUFFER. -LOCATION is the location at which to insert. COMMENT-PREFIX is the comment -prefix to use." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (with-current-buffer buffer - (save-excursion - (goto-char location) - (insert (concat comment-prefix - value "\n"))))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - '())) - -(defun cider-eval-pprint-with-multiline-comment-handler (buffer location comment-prefix continued-prefix comment-postfix) - "Make a handler for evaluating and inserting results in BUFFER. -The inserted text is pretty-printed and region will be commented. -LOCATION is the location at which to insert. -COMMENT-PREFIX is the comment prefix for the first line of output. -CONTINUED-PREFIX is the comment prefix to use for the remaining lines. -COMMENT-POSTFIX is the text to output after the last line." - (cl-flet ((multiline-comment-handler (buffer value) - (with-current-buffer buffer - (save-excursion - (goto-char location) - (let ((lines (split-string value "[\n]+" t))) - ;; only the first line gets the normal comment-prefix - (insert (concat comment-prefix (pop lines))) - (dolist (elem lines) - (insert (concat "\n" continued-prefix elem))) - (unless (string= comment-postfix "") - (insert comment-postfix))))))) - (nrepl-make-response-handler buffer - '() - #'multiline-comment-handler - #'multiline-comment-handler - '()))) - -(defun cider-popup-eval-out-handler (&optional buffer) - "Make a handler for evaluating and printing stdout/stderr in popup BUFFER. -This is used by pretty-printing commands and intentionally discards their results." - (cl-flet ((popup-output-handler (buffer str) - (cider-emit-into-popup-buffer buffer - (ansi-color-apply str) - nil - t))) - (nrepl-make-response-handler (or buffer (current-buffer)) - '() - ;; stdout handler - #'popup-output-handler - ;; stderr handler - #'popup-output-handler - '()))) - - -;;; Interactive valuation commands - -(defvar cider-to-nrepl-filename-function - (with-no-warnings - (if (eq system-type 'cygwin) - #'cygwin-convert-file-name-to-windows - #'identity)) - "Function to translate Emacs filenames to nREPL namestrings.") - -(defun cider--prep-interactive-eval (form connection) - "Prepare the environment for an interactive eval of FORM in CONNECTION. -Ensure the current ns declaration has been evaluated (so that the ns -containing FORM exists). Cache ns-form in the current buffer unless FORM is -ns declaration itself. Clear any compilation highlights and kill the error -window." - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((cur-ns-form (cider-ns-form))) - (when (and cur-ns-form - (not (cider-ns-form-p form)) - (cider-repl--ns-form-changed-p cur-ns-form connection)) - (when cider-auto-track-ns-form-changes - ;; The first interactive eval on a file can load a lot of libs. This can - ;; easily lead to more than 10 sec. - (let ((nrepl-sync-request-timeout 30)) - ;; TODO: check for evaluation errors - (cider-nrepl-sync-request:eval cur-ns-form connection))) - ;; cache at the end, in case of errors - (cider-repl--cache-ns-form cur-ns-form connection)))) - -(defvar-local cider-interactive-eval-override nil - "Function to call instead of `cider-interactive-eval'.") - -(defun cider-interactive-eval (form &optional callback bounds additional-params) - "Evaluate FORM and dispatch the response to CALLBACK. -If the code to be evaluated comes from a buffer, it is preferred to use a -nil FORM, and specify the code via the BOUNDS argument instead. - -This function is the main entry point in CIDER's interactive evaluation -API. Most other interactive eval functions should rely on this function. -If CALLBACK is nil use `cider-interactive-eval-handler'. -BOUNDS, if non-nil, is a list of two numbers marking the start and end -positions of FORM in its buffer. -ADDITIONAL-PARAMS is a plist to be appended to the request message. - -If `cider-interactive-eval-override' is a function, call it with the same -arguments and only proceed with evaluation if it returns nil." - (let ((form (or form (apply #'buffer-substring-no-properties bounds))) - (start (car-safe bounds)) - (end (car-safe (cdr-safe bounds)))) - (when (and start end) - (remove-overlays start end 'cider-temporary t)) - (unless (and cider-interactive-eval-override - (functionp cider-interactive-eval-override) - (funcall cider-interactive-eval-override form callback bounds)) - (cider-map-repls :auto - (lambda (connection) - (cider--prep-interactive-eval form connection) - (cider-nrepl-request:eval - form - (or callback (cider-interactive-eval-handler nil bounds)) - ;; always eval ns forms in the user namespace - ;; otherwise trying to eval ns form for the first time will produce an error - (if (cider-ns-form-p form) "user" (cider-current-ns)) - (when start (line-number-at-pos start)) - (when start (cider-column-number-at-pos start)) - additional-params - connection)))))) - -(defun cider-eval-region (start end) - "Evaluate the region between START and END." - (interactive "r") - (cider-interactive-eval nil nil (list start end))) - -(defun cider-eval-last-sexp (&optional output-to-current-buffer) - "Evaluate the expression preceding point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer." - (interactive "P") - (cider-interactive-eval nil - (when output-to-current-buffer (cider-eval-print-handler)) - (cider-last-sexp 'bounds))) - -(defun cider-eval-last-sexp-and-replace () - "Evaluate the expression preceding point and replace it with its result." - (interactive) - (let ((last-sexp (cider-last-sexp))) - ;; we have to be sure the evaluation won't result in an error - (cider-nrepl-sync-request:eval last-sexp) - ;; seems like the sexp is valid, so we can safely kill it - (backward-kill-sexp) - (cider-interactive-eval last-sexp (cider-eval-print-handler)))) - -(defun cider-eval-sexp-at-point (&optional output-to-current-buffer) - "Evaluate the expression around point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." - (interactive "P") - (save-excursion - (goto-char (cadr (cider-sexp-at-point 'bounds))) - (cider-eval-last-sexp output-to-current-buffer))) - -(defvar-local cider-previous-eval-context nil - "The previous evaluation context if any. -That's set by commands like `cider-eval-last-sexp-in-context'.") - -(defun cider--eval-in-context (code) - "Evaluate CODE in user-provided evaluation context." - (let* ((code (string-trim-right code)) - (eval-context (read-string - (format "Evaluation context (let-style) for `%s': " code) - cider-previous-eval-context)) - (code (concat "(let [" eval-context "]\n " code ")"))) - (cider-interactive-eval code) - (setq-local cider-previous-eval-context eval-context))) - -(defun cider-eval-last-sexp-in-context () - "Evaluate the preceding sexp in user-supplied context. -The context is just a let binding vector (without the brackets). -The context is remembered between command invocations." - (interactive) - (cider--eval-in-context (cider-last-sexp))) - -(defun cider-eval-sexp-at-point-in-context () - "Evaluate the preceding sexp in user-supplied context. - -The context is just a let binding vector (without the brackets). -The context is remembered between command invocations." - (interactive) - (cider--eval-in-context (cider-sexp-at-point))) - -(defun cider-eval-defun-to-comment (&optional insert-before) - "Evaluate the \"top-level\" form and insert result as comment. - -The formatting of the comment is defined in `cider-comment-prefix' -which, by default, is \";; => \" and can be customized. - -With the prefix arg INSERT-BEFORE, insert before the form, otherwise afterwards." - (interactive "P") - (let* ((bounds (cider-defun-at-point 'bounds)) - (insertion-point (nth (if insert-before 0 1) bounds))) - (cider-interactive-eval nil - (cider-eval-print-with-comment-handler - (current-buffer) - insertion-point - cider-comment-prefix) - bounds))) - -(defun cider-pprint-form-to-comment (form-fn insert-before) - "Evaluate the form selected by FORM-FN and insert result as comment. -FORM-FN can be either `cider-last-sexp' or `cider-defun-at-point'. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (let* ((bounds (funcall form-fn 'bounds)) - (insertion-point (nth (if insert-before 0 1) bounds)) - ;; when insert-before, we need a newline after the output to - ;; avoid commenting the first line of the form - (comment-postfix (concat cider-comment-postfix - (if insert-before "\n" "")))) - (cider-interactive-eval nil - (cider-eval-pprint-with-multiline-comment-handler - (current-buffer) - insertion-point - cider-comment-prefix - cider-comment-continued-prefix - comment-postfix) - bounds - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) - -(defun cider-pprint-eval-last-sexp-to-comment (&optional insert-before) - "Evaluate the last sexp and insert result as comment. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (interactive "P") - (cider-pprint-form-to-comment 'cider-last-sexp insert-before)) - -(defun cider-pprint-eval-defun-to-comment (&optional insert-before) - "Evaluate the \"top-level\" form and insert result as comment. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (interactive "P") - (cider-pprint-form-to-comment 'cider-defun-at-point insert-before)) - -(declare-function cider-switch-to-repl-buffer "cider-mode") - -(defun cider-eval-last-sexp-to-repl (&optional prefix) - "Evaluate the expression preceding point and insert its result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider-interactive-eval nil - (cider-insert-eval-handler (cider-current-repl)) - (cider-last-sexp 'bounds)) - (when prefix - (cider-switch-to-repl-buffer))) - -(defun cider-pprint-eval-last-sexp-to-repl (&optional prefix) - "Evaluate expr before point and insert its pretty-printed result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider-interactive-eval nil - (cider-insert-eval-handler (cider-current-repl)) - (cider-last-sexp 'bounds) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))) - (when prefix - (cider-switch-to-repl-buffer))) - -(defun cider-eval-print-last-sexp () - "Evaluate the expression preceding point. -Print its value into the current buffer." - (interactive) - (cider-interactive-eval nil - (cider-eval-print-handler) - (cider-last-sexp 'bounds))) - -(defun cider--pprint-eval-form (form) - "Pretty print FORM in popup buffer." - (let* ((result-buffer (cider-popup-buffer cider-result-buffer nil 'clojure-mode 'ancillary)) - (handler (cider-popup-eval-out-handler result-buffer))) - (cider-interactive-eval (when (stringp form) form) - handler - (when (consp form) form) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) - -(defun cider-pprint-eval-last-sexp (&optional output-to-current-buffer) - "Evaluate the sexp preceding point and pprint its value. -If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current -buffer, else display in a popup buffer." - (interactive "P") - (if output-to-current-buffer - (cider-pprint-eval-last-sexp-to-comment) - (cider--pprint-eval-form (cider-last-sexp 'bounds)))) - -(defun cider--prompt-and-insert-inline-dbg () - "Insert a #dbg button at the current sexp." - (save-excursion - (let ((beg)) - (skip-chars-forward "\r\n[:blank:]") - (unless (looking-at-p "(") - (ignore-errors (backward-up-list))) - (setq beg (point)) - (let* ((cond (cider-read-from-minibuffer "Condition for debugging (leave empty for \"always\"): ")) - (button (propertize (concat "#dbg" - (unless (equal cond "") - (format " ^{:break/when %s}" cond))) - 'font-lock-face 'cider-fragile-button-face))) - (when (> (current-column) 30) - (insert "\n") - (indent-according-to-mode)) - (insert button) - (when (> (current-column) 40) - (insert "\n") - (indent-according-to-mode))) - (make-button beg (point) - 'help-echo "Breakpoint. Reevaluate this form to remove it." - :type 'cider-fragile)))) - -(defun cider-eval-defun-at-point (&optional debug-it) - "Evaluate the current toplevel form, and print result in the minibuffer. -With DEBUG-IT prefix argument, also debug the entire form as with the -command `cider-debug-defun-at-point'." - (interactive "P") - (let ((inline-debug (eq 16 (car-safe debug-it)))) - (when debug-it - (when (derived-mode-p 'clojurescript-mode) - (when (y-or-n-p (concat "The debugger doesn't support ClojureScript yet, and we need help with that." - " \nWould you like to read the Feature Request?")) - (browse-url "https://github.com/clojure-emacs/cider/issues/1416")) - (user-error "The debugger does not support ClojureScript")) - (when inline-debug - (cider--prompt-and-insert-inline-dbg))) - (cider-interactive-eval (when (and debug-it (not inline-debug)) - (concat "#dbg\n" (cider-defun-at-point))) - nil (cider-defun-at-point 'bounds)))) - -(defun cider--calculate-opening-delimiters () - "Walks up the list of expressions to collect all sexp opening delimiters. -The result is a list of the delimiters. - -That function is used in `cider-eval-defun-up-to-point' so it can make an -incomplete expression complete." - (interactive) - (let ((result nil)) - (save-excursion - (condition-case nil - (while t - (backward-up-list) - (push (char-after) result)) - (error result))))) - -(defun cider--matching-delimiter (delimiter) - "Get the matching (opening/closing) delimiter for DELIMITER." - (pcase delimiter - (?\( ?\)) - (?\[ ?\]) - (?\{ ?\}) - (?\) ?\() - (?\] ?\[) - (?\} ?\{))) - -(defun cider--calculate-closing-delimiters () - "Compute the list of closing delimiters to make the defun before point valid." - (mapcar #'cider--matching-delimiter (cider--calculate-opening-delimiters))) - -(defun cider-eval-defun-up-to-point (&optional output-to-current-buffer) - "Evaluate the current toplevel form up to point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer. It constructs an expression to eval in the following manner: - -- It find the code between the point and the start of the toplevel expression; -- It balances this bit of code by closing all open expressions; -- It evaluates the resulting code using `cider-interactive-eval'." - (interactive "P") - (let* ((beg-of-defun (save-excursion (beginning-of-defun) (point))) - (code (buffer-substring-no-properties beg-of-defun (point))) - (code (concat code (cider--calculate-closing-delimiters)))) - (cider-interactive-eval - code - (when output-to-current-buffer (cider-eval-print-handler))))) - -(defun cider-eval-sexp-up-to-point (&optional output-to-current-buffer) - "Evaluate the current sexp form up to point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer. It constructs an expression to eval in the following manner: - -- It finds the code between the point and the start of the sexp expression; -- It balances this bit of code by closing the expression; -- It evaluates the resulting code using `cider-interactive-eval'." - (interactive "P") - (let* ((beg-of-sexp (save-excursion (up-list) (backward-list) (point))) - (beg-delimiter (save-excursion (up-list) (backward-list) (char-after))) - (beg-set? (save-excursion (up-list) (backward-list) (char-before))) - (code (buffer-substring-no-properties beg-of-sexp (point))) - (code (if (= beg-set? ?#) (concat (list beg-set?) code) code)) - (code (concat code (list (cider--matching-delimiter beg-delimiter))))) - (cider-interactive-eval code - (when output-to-current-buffer (cider-eval-print-handler))))) - -(defun cider-pprint-eval-defun-at-point (&optional output-to-current-buffer) - "Evaluate the \"top-level\" form at point and pprint its value. -If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current -buffer, else display in a popup buffer." - (interactive "P") - (if output-to-current-buffer - (cider-pprint-eval-defun-to-comment) - (cider--pprint-eval-form (cider-defun-at-point 'bounds)))) - -(defun cider-eval-ns-form () - "Evaluate the current buffer's namespace form." - (interactive) - (when (clojure-find-ns) - (save-excursion - (goto-char (match-beginning 0)) - (cider-eval-defun-at-point)))) - -(defun cider-read-and-eval (&optional value) - "Read a sexp from the minibuffer and output its result to the echo area. -If VALUE is non-nil, it is inserted into the minibuffer as initial input." - (interactive) - (let* ((form (cider-read-from-minibuffer "Clojure Eval: " value)) - (override cider-interactive-eval-override) - (ns-form (if (cider-ns-form-p form) "" (format "(ns %s)" (cider-current-ns))))) - (with-current-buffer (get-buffer-create cider-read-eval-buffer) - (erase-buffer) - (clojure-mode) - (unless (string= "" ns-form) - (insert ns-form "\n\n")) - (insert form) - (let ((cider-interactive-eval-override override)) - (cider-interactive-eval form))))) - -(defun cider-read-and-eval-defun-at-point () - "Insert the toplevel form at point in the minibuffer and output its result. -The point is placed next to the function name in the minibuffer to allow -passing arguments." - (interactive) - (let* ((fn-name (cadr (split-string (cider-defun-at-point)))) - (form (format "(%s)" fn-name))) - (cider-read-and-eval (cons form (length form))))) - -;; Eval keymaps -(defvar cider-eval-pprint-commands-map - (let ((map (define-prefix-command 'cider-eval-pprint-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "e") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "d") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "c e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "c d") #'cider-pprint-eval-defun-to-comment) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-e") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "C-d") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "C-c e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "C-c C-e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "C-c d") #'cider-pprint-eval-defun-to-comment) - (define-key map (kbd "C-c C-d") #'cider-pprint-eval-defun-to-comment))) - -(defvar cider-eval-commands-map - (let ((map (define-prefix-command 'cider-eval-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "w") #'cider-eval-last-sexp-and-replace) - (define-key map (kbd "r") #'cider-eval-region) - (define-key map (kbd "n") #'cider-eval-ns-form) - (define-key map (kbd "d") #'cider-eval-defun-at-point) - (define-key map (kbd "e") #'cider-eval-last-sexp) - (define-key map (kbd "v") #'cider-eval-sexp-at-point) - (define-key map (kbd "o") #'cider-eval-sexp-up-to-point) - (define-key map (kbd ".") #'cider-read-and-eval-defun-at-point) - (define-key map (kbd "z") #'cider-eval-defun-up-to-point) - (define-key map (kbd "c") #'cider-eval-last-sexp-in-context) - (define-key map (kbd "b") #'cider-eval-sexp-at-point-in-context) - (define-key map (kbd "f") 'cider-eval-pprint-commands-map) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-w") #'cider-eval-last-sexp-and-replace) - (define-key map (kbd "C-r") #'cider-eval-region) - (define-key map (kbd "C-n") #'cider-eval-ns-form) - (define-key map (kbd "C-d") #'cider-eval-defun-at-point) - (define-key map (kbd "C-f") #'cider-eval-last-sexp) - (define-key map (kbd "C-v") #'cider-eval-sexp-at-point) - (define-key map (kbd "C-o") #'cider-eval-sexp-up-to-point) - (define-key map (kbd "C-.") #'cider-read-and-eval-defun-at-point) - (define-key map (kbd "C-z") #'cider-eval-defun-up-to-point) - (define-key map (kbd "C-c") #'cider-eval-last-sexp-in-context) - (define-key map (kbd "C-b") #'cider-eval-sexp-at-point-in-context) - (define-key map (kbd "C-f") 'cider-eval-pprint-commands-map))) - -(defun cider--file-string (file) - "Read the contents of a FILE and return as a string." - (with-current-buffer (find-file-noselect file) - (substring-no-properties (buffer-string)))) - -(defun cider-load-buffer (&optional buffer) - "Load (eval) BUFFER's file in nREPL. -If no buffer is provided the command acts on the current buffer. If the -buffer is for a cljc file, and both a Clojure and ClojureScript REPL exists -for the project, it is evaluated in both REPLs." - (interactive) - (setq buffer (or buffer (current-buffer))) - ;; When cider-load-buffer or cider-load-file are called in programs the - ;; current context might not match the buffer's context. We use the caller - ;; context instead of the buffer's context because that's the common use - ;; case. For the other use case just let-bind the default-directory. - (let ((orig-default-directory default-directory)) - (with-current-buffer buffer - (check-parens) - (let ((default-directory orig-default-directory)) - (unless buffer-file-name - (user-error "Buffer `%s' is not associated with a file" (current-buffer))) - (when (and cider-save-file-on-load - (buffer-modified-p) - (or (eq cider-save-file-on-load t) - (y-or-n-p (format "Save file %s? " buffer-file-name)))) - (save-buffer)) - (remove-overlays nil nil 'cider-temporary t) - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((filename (buffer-file-name buffer)) - (ns-form (cider-ns-form))) - (cider-map-repls :auto - (lambda (repl) - (when ns-form - (cider-repl--cache-ns-form ns-form repl)) - (cider-request:load-file (cider--file-string filename) - (funcall cider-to-nrepl-filename-function - (cider--server-filename filename)) - (file-name-nondirectory filename) - repl))) - (message "Loading %s..." filename)))))) - -(defun cider-load-file (filename) - "Load (eval) the Clojure file FILENAME in nREPL. -If the file is a cljc file, and both a Clojure and ClojureScript REPL -exists for the project, it is evaluated in both REPLs. The heavy lifting -is done by `cider-load-buffer'." - (interactive (list - (read-file-name "Load file: " nil nil nil - (when (buffer-file-name) - (file-name-nondirectory - (buffer-file-name)))))) - (if-let* ((buffer (find-buffer-visiting filename))) - (cider-load-buffer buffer) - (cider-load-buffer (find-file-noselect filename)))) - -(defun cider-load-all-files (directory) - "Load all files in DIRECTORY (recursively). -Useful when the running nREPL on remote host." - (interactive "DLoad files beneath directory: ") - (mapcar #'cider-load-file - (directory-files-recursively directory ".clj$"))) - -(defalias 'cider-eval-file 'cider-load-file - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-all-files 'cider-load-all-files - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-buffer 'cider-load-buffer - "A convenience alias as some people are confused by the load-* names.") - -(defun cider-load-all-project-ns () - "Load all namespaces in the current project." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "ns-load-all") - (when (y-or-n-p "Are you sure you want to load all namespaces in the project? ") - (message "Loading all project namespaces...") - (let ((loaded-ns-count (length (cider-sync-request:ns-load-all)))) - (message "Loaded %d namespaces" loaded-ns-count)))) - -(provide 'cider-eval) - -;;; cider-eval.el ends here |