From 4bfb2c7bfd386b4e884ae37f45348fbab206c25e Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Tue, 13 Nov 2018 10:55:12 +0100 Subject: [PATCH] update cider. Signed-off-by: Andreas Gerler --- elpa/cider-20170129.1941/cider-autoloads.el | 326 --- elpa/cider-20170129.1941/cider-client.el | 1126 ---------- elpa/cider-20170129.1941/cider-compat.el | 157 -- elpa/cider-20170129.1941/cider-interaction.el | 1828 ----------------- elpa/cider-20170129.1941/cider-pkg.el | 12 - elpa/cider-20170129.1941/cider.el | 885 -------- .../cider-apropos.el | 31 +- elpa/cider-20181110.1413/cider-autoloads.el | 772 +++++++ .../cider-browse-ns.el | 37 +- elpa/cider-20181110.1413/cider-browse-spec.el | 357 ++++ elpa/cider-20181110.1413/cider-cheatsheet.el | 577 ++++++ .../cider-classpath.el | 10 +- elpa/cider-20181110.1413/cider-client.el | 577 ++++++ .../cider-common.el | 198 +- elpa/cider-20181110.1413/cider-compat.el | 54 + elpa/cider-20181110.1413/cider-completion.el | 253 +++ elpa/cider-20181110.1413/cider-connection.el | 857 ++++++++ .../cider-debug.el | 61 +- .../cider-doc.el | 87 +- .../cider-eldoc.el | 111 +- elpa/cider-20181110.1413/cider-eval.el | 1116 ++++++++++ elpa/cider-20181110.1413/cider-find.el | 231 +++ elpa/cider-20181110.1413/cider-format.el | 150 ++ .../cider-grimoire.el | 23 +- .../cider-inspector.el | 95 +- .../cider-macroexpansion.el | 32 +- .../cider-mode.el | 512 +++-- elpa/cider-20181110.1413/cider-ns.el | 265 +++ .../cider-overlays.el | 17 +- elpa/cider-20181110.1413/cider-pkg.el | 23 + .../cider-popup.el | 19 +- elpa/cider-20181110.1413/cider-profile.el | 208 ++ .../cider-repl-history.el | 43 +- .../cider-repl.el | 752 +++++-- .../cider-resolve.el | 23 +- .../cider-scratch.el | 40 +- .../cider-selector.el | 33 +- .../cider-stacktrace.el | 348 +++- .../cider-test.el | 402 ++-- elpa/cider-20181110.1413/cider-tracing.el | 90 + .../cider-util.el | 246 ++- elpa/cider-20181110.1413/cider.el | 1452 +++++++++++++ .../nrepl-client.el | 572 +++--- .../nrepl-dict.el | 8 +- 44 files changed, 9421 insertions(+), 5595 deletions(-) delete mode 100644 elpa/cider-20170129.1941/cider-autoloads.el delete mode 100644 elpa/cider-20170129.1941/cider-client.el delete mode 100644 elpa/cider-20170129.1941/cider-compat.el delete mode 100644 elpa/cider-20170129.1941/cider-interaction.el delete mode 100644 elpa/cider-20170129.1941/cider-pkg.el delete mode 100644 elpa/cider-20170129.1941/cider.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-apropos.el (90%) create mode 100644 elpa/cider-20181110.1413/cider-autoloads.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-browse-ns.el (90%) create mode 100644 elpa/cider-20181110.1413/cider-browse-spec.el create mode 100644 elpa/cider-20181110.1413/cider-cheatsheet.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-classpath.el (93%) create mode 100644 elpa/cider-20181110.1413/cider-client.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-common.el (54%) create mode 100644 elpa/cider-20181110.1413/cider-compat.el create mode 100644 elpa/cider-20181110.1413/cider-completion.el create mode 100644 elpa/cider-20181110.1413/cider-connection.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-debug.el (94%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-doc.el (88%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-eldoc.el (81%) create mode 100644 elpa/cider-20181110.1413/cider-eval.el create mode 100644 elpa/cider-20181110.1413/cider-find.el create mode 100644 elpa/cider-20181110.1413/cider-format.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-grimoire.el (84%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-inspector.el (82%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-macroexpansion.el (89%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-mode.el (65%) create mode 100644 elpa/cider-20181110.1413/cider-ns.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-overlays.el (95%) create mode 100644 elpa/cider-20181110.1413/cider-pkg.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-popup.el (89%) create mode 100644 elpa/cider-20181110.1413/cider-profile.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-repl-history.el (96%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-repl.el (65%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-resolve.el (90%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-scratch.el (73%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-selector.el (90%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-stacktrace.el (66%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-test.el (65%) create mode 100644 elpa/cider-20181110.1413/cider-tracing.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/cider-util.el (75%) create mode 100644 elpa/cider-20181110.1413/cider.el rename elpa/{cider-20170129.1941 => cider-20181110.1413}/nrepl-client.el (73%) rename elpa/{cider-20170129.1941 => cider-20181110.1413}/nrepl-dict.el (97%) diff --git a/elpa/cider-20170129.1941/cider-autoloads.el b/elpa/cider-20170129.1941/cider-autoloads.el deleted file mode 100644 index 3bec2d92..00000000 --- a/elpa/cider-20170129.1941/cider-autoloads.el +++ /dev/null @@ -1,326 +0,0 @@ -;;; cider-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) - -;;;### (autoloads nil "cider" "cider.el" (22692 30287 0 0)) -;;; Generated autoloads from cider.el - -(autoload 'cider-version "cider" "\ -Display CIDER's version. - -\(fn)" t nil) - -(autoload 'cider-jack-in "cider" "\ -Start an nREPL server for the current project and connect to it. -If PROMPT-PROJECT is t, then prompt for the project for which to -start the server. -If CLJS-TOO is non-nil, also start a ClojureScript REPL session with its -own buffer. - -\(fn &optional PROMPT-PROJECT CLJS-TOO)" t nil) - -(autoload 'cider-jack-in-clojurescript "cider" "\ -Start an nREPL server and connect to it both Clojure and ClojureScript REPLs. -If PROMPT-PROJECT is t, then prompt for the project for which to -start the server. - -\(fn &optional PROMPT-PROJECT)" t nil) - -(autoload 'cider-connect "cider" "\ -Connect to an nREPL server identified by HOST and PORT. -Create REPL buffer and start an nREPL client connection. - -When the optional param PROJECT-DIR is present, the connection -gets associated with it. - -\(fn HOST PORT &optional PROJECT-DIR)" t nil) - -(eval-after-load 'clojure-mode '(progn (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in) (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-clojurescript) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect))) - -;;;*** - -;;;### (autoloads nil "cider-apropos" "cider-apropos.el" (22692 30287 -;;;;;; 0 0)) -;;; Generated autoloads from cider-apropos.el - -(autoload 'cider-apropos "cider-apropos" "\ -Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). - -\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) - -(autoload 'cider-apropos-documentation "cider-apropos" "\ -Shortcut for (cider-apropos nil t). - -\(fn)" t nil) - -(autoload 'cider-apropos-select "cider-apropos" "\ -Similar to `cider-apropos', but presents the results in a completing read. - -Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). - -\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) - -(autoload 'cider-apropos-documentation-select "cider-apropos" "\ -Shortcut for (cider-apropos-select nil t). - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-browse-ns" "cider-browse-ns.el" (22692 -;;;;;; 30287 0 0)) -;;; Generated autoloads from cider-browse-ns.el - -(autoload 'cider-browse-ns "cider-browse-ns" "\ -List all NAMESPACE's vars in BUFFER. - -\(fn NAMESPACE)" t nil) - -(autoload 'cider-browse-ns-all "cider-browse-ns" "\ -List all loaded namespaces in BUFFER. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-classpath" "cider-classpath.el" (22692 -;;;;;; 30287 0 0)) -;;; Generated autoloads from cider-classpath.el - -(autoload 'cider-classpath "cider-classpath" "\ -List all classpath entries. - -\(fn)" t nil) - -(autoload 'cider-open-classpath-entry "cider-classpath" "\ -Open a classpath entry. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-debug" "cider-debug.el" (22692 30287 -;;;;;; 0 0)) -;;; Generated autoloads from cider-debug.el - -(autoload 'cider-debug-defun-at-point "cider-debug" "\ -Instrument the \"top-level\" expression at point. -If it is a defn, dispatch the instrumented definition. Otherwise, -immediately evaluate the instrumented expression. - -While debugged code is being evaluated, the user is taken through the -source code and displayed the value of various expressions. At each step, -a number of keys will be prompted to the user. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-grimoire" "cider-grimoire.el" (22692 -;;;;;; 30287 0 0)) -;;; Generated autoloads from cider-grimoire.el - -(autoload 'cider-grimoire-web "cider-grimoire" "\ -Open grimoire documentation in the default web browser. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -\(fn &optional ARG)" t nil) - -(autoload 'cider-grimoire "cider-grimoire" "\ -Open grimoire documentation in a popup buffer. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-inspector" "cider-inspector.el" (22692 -;;;;;; 30287 0 0)) -;;; Generated autoloads from cider-inspector.el - -(autoload 'cider-inspect-last-sexp "cider-inspector" "\ -Inspect the result of the the expression preceding point. - -\(fn)" t nil) - -(autoload 'cider-inspect-defun-at-point "cider-inspector" "\ -Inspect the result of the \"top-level\" expression at point. - -\(fn)" t nil) - -(autoload 'cider-inspect-last-result "cider-inspector" "\ -Inspect the most recent eval result. - -\(fn)" t nil) - -(autoload 'cider-inspect "cider-inspector" "\ -Inspect the result of the preceding sexp. - -With a prefix argument ARG it inspects the result of the \"top-level\" form. -With a second prefix argument it prompts for an expression to eval and inspect. - -\(fn &optional ARG)" t nil) - -(autoload 'cider-inspect-expr "cider-inspector" "\ -Evaluate EXPR in NS and inspect its value. -Interactively, EXPR is read from the minibuffer, and NS the -current buffer's namespace. - -\(fn EXPR NS)" t nil) - -(define-obsolete-function-alias 'cider-inspect-read-and-inspect 'cider-inspect-expr "0.13.0") - -;;;*** - -;;;### (autoloads nil "cider-macroexpansion" "cider-macroexpansion.el" -;;;;;; (22692 30287 0 0)) -;;; Generated autoloads from cider-macroexpansion.el - -(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\ -Invoke \\=`macroexpand-1\\=` on the expression preceding point. -If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of -\\=`macroexpand-1\\=`. - -\(fn &optional PREFIX)" t nil) - -(autoload 'cider-macroexpand-all "cider-macroexpansion" "\ -Invoke \\=`clojure.walk/macroexpand-all\\=` on the expression preceding point. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-mode" "cider-mode.el" (22692 30287 0 -;;;;;; 0)) -;;; Generated autoloads from cider-mode.el - -(defvar cider-mode-line '(:eval (format " cider[%s]" (cider--modeline-info))) "\ -Mode line lighter for `cider-mode'. - -The value of this variable is a mode line template as in -`mode-line-format'. See Info Node `(elisp)Mode Line Format' for -details about mode line templates. - -Customize this variable to change how `cider-mode' displays its -status in the mode line. The default value displays the current connection. -Set this variable to nil to disable the mode line -entirely.") - -(custom-autoload 'cider-mode-line "cider-mode" t) - -(eval-after-load 'clojure-mode '(easy-menu-define cider-clojure-mode-menu-open clojure-mode-map "Menu for Clojure mode.\n This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." `("CIDER" :visible (not cider-mode) ["Start a REPL" cider-jack-in :help "Starts an nREPL server (with lein, boot, or maven) and connects a REPL to it."] ["Connect to a REPL" cider-connect :help "Connects to a REPL that's already running."] ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clojurescript :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL.\n Configure `cider-cljs-lein-repl', `cider-cljs-boot-repl' and `cider-cljs-gradle-repl' to change the ClojureScript REPL to use."] "--" ["View manual online" cider-view-manual]))) - -(autoload 'cider-mode "cider-mode" "\ -Minor mode for REPL interaction from a Clojure buffer. - -\\{cider-mode-map} - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-repl-history" "cider-repl-history.el" -;;;;;; (22692 30287 0 0)) -;;; Generated autoloads from cider-repl-history.el - -(autoload 'cider-repl-history "cider-repl-history" "\ -Display items in the CIDER command history in another buffer. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-scratch" "cider-scratch.el" (22692 30287 -;;;;;; 0 0)) -;;; Generated autoloads from cider-scratch.el - -(autoload 'cider-scratch "cider-scratch" "\ -Go to the scratch buffer named `cider-scratch-buffer-name'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-selector" "cider-selector.el" (22692 -;;;;;; 30287 0 0)) -;;; Generated autoloads from cider-selector.el - -(autoload 'cider-selector "cider-selector" "\ -Select a new buffer by type, indicated by a single character. -The user is prompted for a single character indicating the method by -which to choose a new buffer. The `?' character describes then -available methods. OTHER-WINDOW provides an optional target. - -See `def-cider-selector-method' for defining new methods. - -\(fn &optional OTHER-WINDOW)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-test" "cider-test.el" (22692 30287 0 -;;;;;; 0)) -;;; Generated autoloads from cider-test.el - -(defvar cider-auto-test-mode nil "\ -Non-nil if Cider-Auto-Test mode is enabled. -See the `cider-auto-test-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `cider-auto-test-mode'.") - -(custom-autoload 'cider-auto-test-mode "cider-test" nil) - -(autoload 'cider-auto-test-mode "cider-test" "\ -Toggle automatic testing of Clojure files. - -When enabled this reruns tests every time a Clojure file is loaded. -Only runs tests corresponding to the loaded file's namespace and does -nothing if no tests are defined or if the file failed to load. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-util" "cider-util.el" (22692 30287 0 -;;;;;; 0)) -;;; Generated autoloads from cider-util.el - -(autoload 'cider-view-manual "cider-util" "\ -View the manual in your default browser. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("cider-client.el" "cider-common.el" "cider-compat.el" -;;;;;; "cider-doc.el" "cider-eldoc.el" "cider-interaction.el" "cider-overlays.el" -;;;;;; "cider-pkg.el" "cider-popup.el" "cider-repl.el" "cider-resolve.el" -;;;;;; "cider-stacktrace.el" "nrepl-client.el" "nrepl-dict.el") -;;;;;; (22692 30287 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; cider-autoloads.el ends here diff --git a/elpa/cider-20170129.1941/cider-client.el b/elpa/cider-20170129.1941/cider-client.el deleted file mode 100644 index f921af71..00000000 --- a/elpa/cider-20170129.1941/cider-client.el +++ /dev/null @@ -1,1126 +0,0 @@ -;;; cider-client.el --- A layer of abstraction above the actual client code. -*- lexical-binding: t -*- - -;; Copyright © 2013-2017 Bozhidar Batsov -;; -;; Author: Bozhidar Batsov - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A layer of abstraction above the actual client code. - -;;; Code: - -(require 'spinner) -(require 'ewoc) -(require 'nrepl-client) -(require 'cider-common) -(require 'cider-util) -(require 'clojure-mode) - -(require 'subr-x) -(require 'cider-compat) -(require 'seq) - -;;; Connection Buffer Management - -(defcustom cider-request-dispatch 'dynamic - "Controls the request dispatch mechanism when several connections are present. -Dynamic dispatch tries to infer the connection based on the current project -& currently visited file, while static dispatch simply uses the default -connection. - -Project metadata is attached to connections when they are created with commands -like `cider-jack-in' and `cider-connect'." - :type '(choice (const :tag "dynamic" dynamic) - (const :tag "static" static)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration - "The function to use to generate the message displayed on connect. -When set to nil no additional message will be displayed. - -A good alternative to the default is `cider-random-tip'." - :type 'function - :group 'cider - :package-version '(cider . "0.11.0")) - -(defvar cider-connections nil - "A list of connections.") - -(defun cider-connected-p () - "Return t if CIDER is currently connected, nil otherwise." - (not (null (cider-connections)))) - -(defun cider-ensure-connected () - "Ensure there is a cider connection present. -An error is signaled in the absence of a connection." - (unless (cider-connected-p) - (user-error "`%s' needs an active nREPL connection" this-command))) - -(defsubst cider--in-connection-buffer-p () - "Return non-nil if current buffer is connected to a server." - (and (derived-mode-p 'cider-repl-mode) - (process-live-p - (get-buffer-process (current-buffer))))) - -(defun cider-default-connection (&optional no-error) - "The default (fallback) connection to use for nREPL interaction. -When NO-ERROR is non-nil, don't throw an error when no connection has been -found." - (or (car (cider-connections)) - (unless no-error - (error "No nREPL connection buffer")))) - -(defun cider-connections () - "Return the list of connection buffers. -If the list is empty and buffer-local, return the global value." - (or (setq cider-connections - (seq-filter #'buffer-live-p cider-connections)) - (when (local-variable-p 'cider-connect) - (kill-local-variable 'cider-connections) - (seq-filter #'buffer-live-p cider-connections)))) - -(defun cider-repl-buffers () - "Return the list of REPL buffers." - (seq-filter - (lambda (buffer) - (with-current-buffer buffer (derived-mode-p 'cider-repl-mode))) - (buffer-list))) - -(defun cider-make-connection-default (connection-buffer) - "Make the nREPL CONNECTION-BUFFER the default connection. -Moves CONNECTION-BUFFER to the front of variable `cider-connections'." - (interactive (list (if (cider--in-connection-buffer-p) - (current-buffer) - (user-error "Not in a REPL buffer")))) - ;; maintain the connection list in most recently used order - (let ((buf (get-buffer connection-buffer))) - (setq cider-connections - (cons buf (delq buf cider-connections)))) - (cider--connections-refresh)) - -(declare-function cider--close-buffer "cider-interaction") -(defun cider--close-connection-buffer (conn-buffer) - "Close CONN-BUFFER, removing it from variable `cider-connections'. -Also close associated REPL and server buffers." - (let ((buffer (get-buffer conn-buffer)) - (nrepl-messages-buffer (and nrepl-log-messages - (nrepl-messages-buffer conn-buffer)))) - (setq cider-connections - (delq buffer cider-connections)) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when spinner-current (spinner-stop)) - (when nrepl-tunnel-buffer - (cider--close-buffer nrepl-tunnel-buffer))) - ;; If this is the only (or last) REPL connected to its server, the - ;; kill-process hook will kill the server. - (cider--close-buffer buffer) - (when nrepl-messages-buffer - (kill-buffer nrepl-messages-buffer))))) - - -;;; Current connection logic -(defvar-local cider-repl-type "clj" - "The type of this REPL buffer, usually either \"clj\" or \"cljs\".") - -(defun cider-find-connection-buffer-for-project-directory (&optional project-directory all-connections) - "Return the most appropriate connection-buffer for the current project. - -By order of preference, this is any connection whose directory matches -`clojure-project-dir', followed by any connection whose directory is nil, -followed by any connection at all. - -If PROJECT-DIRECTORY is provided act on that project instead. - -Only return nil if variable `cider-connections' is empty, -i.e there are no connections. - -If more than one connection satisfy a given level of preference, return the -connection buffer closer to the start of variable `cider-connections'. This is -usally the connection that was more recently created, but the order can be -changed. For instance, the function `cider-make-connection-default' can be -used to move a connection to the head of the list, so that it will take -precedence over other connections associated with the same project. - -If ALL-CONNECTIONS is non-nil, the return value is a list and all matching -connections are returned, instead of just the most recent." - (when-let ((project-directory (or project-directory - (clojure-project-dir (cider-current-dir)))) - (fn (if all-connections #'seq-filter #'seq-find))) - (or (funcall fn (lambda (conn) - (when-let ((conn-proj-dir (with-current-buffer conn - nrepl-project-dir))) - (equal (file-truename project-directory) - (file-truename conn-proj-dir)))) - cider-connections) - (funcall fn (lambda (conn) - (with-current-buffer conn - (not nrepl-project-dir))) - cider-connections) - (if all-connections - cider-connections - (car cider-connections))))) - -(defun cider-read-connection (prompt) - "Completing read for connections using PROMPT." - (get-buffer (completing-read prompt (mapcar #'buffer-name (cider-connections))))) - -(defun cider-assoc-project-with-connection (&optional project connection) - "Associate a Clojure PROJECT with an nREPL CONNECTION. - -Useful for connections created using `cider-connect', as for them -such a link cannot be established automatically." - (interactive) - (cider-ensure-connected) - (let ((conn-buf (or connection (cider-read-connection "Connection: "))) - (project-dir (or project (read-directory-name "Project directory: " (clojure-project-dir))))) - (when conn-buf - (with-current-buffer conn-buf - (setq nrepl-project-dir project-dir))))) - -(defun cider-assoc-buffer-with-connection () - "Associate the current buffer with a connection. - -Useful for connections created using `cider-connect', as for them -such a link cannot be established automatically." - (interactive) - (cider-ensure-connected) - (let ((conn (cider-read-connection "Connection: "))) - (when conn - (setq-local cider-connections (list conn))))) - -(defun cider-toggle-buffer-connection () - "Toggles the current buffer's connection between Clojure and ClojureScript." - (interactive) - (cider-ensure-connected) - (let ((other-conn (cider-other-connection))) - (if other-conn - (setq-local cider-connections (list other-conn)) - (user-error "No other connection available")))) - -(defun cider-clear-buffer-local-connection () - "Remove association between the current buffer and a connection." - (interactive) - (cider-ensure-connected) - (kill-local-variable 'cider-connections)) - -(defun cider-connection-type-for-buffer () - "Return the matching connection type (clj or cljs) for the current buffer." - (cond - ((derived-mode-p 'clojurescript-mode) "cljs") - ((derived-mode-p 'clojure-mode) "clj") - (cider-repl-type) - (t "clj"))) - -(defun cider-toggle-request-dispatch () - "Toggles the value of `cider-request-dispatch' between static and dynamic. - -Handy when you're using dynamic dispatch, but you want to quickly force all -evaluation commands to use a particular connection." - (interactive) - (let ((new-value (if (eq cider-request-dispatch 'static) 'dynamic 'static))) - (setq cider-request-dispatch new-value) - (message "Toggled CIDER request dispatch to %s." new-value))) - -(defun cider-current-connection (&optional type) - "Return the REPL buffer relevant for the current Clojure source buffer. -A REPL is relevant if its `nrepl-project-dir' is compatible with the -current directory (see `cider-find-connection-buffer-for-project-directory'). - -If TYPE is provided, it is either \"clj\" or \"cljs\", and only a -connection of that type is returned. If no connections of that TYPE exist, -return nil. - -If TYPE is nil, then connections whose type matches the current file -extension are given preference, but if none exist, any connection is -returned. In this case, only return nil if there are no active connections -at all." - ;; If TYPE was specified, we only return that type (or nil). OW, we prefer - ;; that TYPE, but ultimately allow any type. - (cl-labels ((right-type-p - (c) - (when (or (not type) - (and (buffer-live-p c) - (with-current-buffer c (equal cider-repl-type type)))) - c))) - (let ((connections (cider-connections))) - (cond - ((not connections) nil) - ;; if you're in a REPL buffer, it's the connection buffer - ((and (derived-mode-p 'cider-repl-mode) (right-type-p (current-buffer)))) - ((eq cider-request-dispatch 'static) (car connections)) - ((= 1 (length connections)) (right-type-p (car connections))) - (t (let ((project-connections (cider-find-connection-buffer-for-project-directory - nil :all-connections)) - (guessed-type (or type (cider-connection-type-for-buffer)))) - ;; So we have multiple connections. Look for the connection type we - ;; want, prioritizing the current project. - (or (seq-find (lambda (conn) - (equal (cider--connection-type conn) guessed-type)) - project-connections) - (seq-find (lambda (conn) - (equal (cider--connection-type conn) guessed-type)) - connections) - (right-type-p (car project-connections)) - (right-type-p (car connections))))))))) - -(defun cider-other-connection (&optional connection) - "Return the first connection of another type than CONNECTION. -Only return connections in the same project or nil. -CONNECTION defaults to `cider-current-connection'." - (when-let ((connection (or connection (cider-current-connection))) - (connection-type (cider--connection-type connection))) - (cider-current-connection (pcase connection-type - (`"clj" "cljs") - (_ "clj"))))) - -(defvar cider--has-warned-about-bad-repl-type nil) - -(defun cider--guess-cljs-connection () - "Hacky way to find a ClojureScript REPL. -DO NOT USE THIS FUNCTION. -It was written only to be used in `cider-map-connections', as a workaround -to a still-undetermined bug in the state-stracker backend." - (when-let ((project-connections (cider-find-connection-buffer-for-project-directory - nil :all-connections)) - (cljs-conn - ;; So we have multiple connections. Look for the connection type we - ;; want, prioritizing the current project. - (or (seq-find (lambda (c) (string-match "\\bCLJS\\b" (buffer-name c))) - project-connections) - (seq-find (lambda (c) (string-match "\\bCLJS\\b" (buffer-name c))) - (cider-connections))))) - (unless cider--has-warned-about-bad-repl-type - (setq cider--has-warned-about-bad-repl-type t) - (read-key - (concat "The ClojureScript REPL seems to be is misbehaving." - (substitute-command-keys - "\nWe have applied a workaround, but please also file a bug report with `\\[cider-report-bug]'.") - "\nPress any key to continue."))) - cljs-conn)) - -(defun cider-map-connections (function which &optional any-mode) - "Call FUNCTION once for each appropriate connection. -The function is called with one argument, the connection buffer. -The appropriate connections are found by inspecting the current buffer. If -the buffer is associated with a .cljc or .cljx file, BODY will be executed -multiple times. - -WHICH is one of the following keywords identifying which connections to map -over. - :any - Act the connection whose type matches the current buffer. - :clj - Like :any, but signal a `user-error' in `clojurescript-mode' or if - there is no Clojure connection (use this for commands only - supported in Clojure). - :cljs - Like :clj, but demands a ClojureScript connection instead. - :both - In `clojurec-mode' or `clojurex-mode' act on both connections, - otherwise function like :any. Obviously, this option might run - FUNCTION twice. - -If ANY-MODE is non-nil, :clj and :cljs don't signal errors due to being in -the wrong major mode (they still signal if the desired connection type -doesn't exist). Use this for commands that only apply to a specific -connection but can be invoked from any buffer (like `cider-refresh')." - (cl-labels ((err (msg) (user-error (concat "`%s' " msg) this-command))) - ;; :both in a clj or cljs buffer just means :any. - (let* ((which (if (and (eq which :both) - (not (cider--cljc-or-cljx-buffer-p))) - :any - which)) - (curr - (pcase which - (`:any (let ((type (cider-connection-type-for-buffer))) - (or (cider-current-connection type) - (when (equal type "cljs") - (cider--guess-cljs-connection)) - (err (substitute-command-keys - (format "needs a Clojure%s REPL.\nIf you don't know what that means, you probably need to jack-in (%s)." - (if (equal type "cljs") "Script" "") - (if (equal type "cljs") "`\\[cider-jack-in-clojurescript]'" "`\\[cider-jack-in]'"))))))) - (`:both (or (cider-current-connection) - (err "needs an active REPL connection"))) - (`:clj (cond ((and (not any-mode) - (derived-mode-p 'clojurescript-mode)) - (err "doesn't support ClojureScript")) - ((cider-current-connection "clj")) - ((err "needs a Clojure REPL")))) - (`:cljs (cond ((and (not any-mode) - (eq major-mode 'clojure-mode)) - (err "doesn't support Clojure")) - ((cider-current-connection "cljs")) - ((err "needs a ClojureScript REPL"))))))) - (funcall function curr) - (when (eq which :both) - (when-let ((other-connection (cider-other-connection curr))) - (funcall function other-connection)))))) - - -;;; Connection Browser -(defvar cider-connections-buffer-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "d" #'cider-connections-make-default) - (define-key map "g" #'cider-connection-browser) - (define-key map "k" #'cider-connections-close-connection) - (define-key map (kbd "RET") #'cider-connections-goto-connection) - (define-key map "?" #'describe-mode) - (define-key map "h" #'describe-mode) - map)) - -(declare-function cider-popup-buffer-mode "cider-popup") -(define-derived-mode cider-connections-buffer-mode cider-popup-buffer-mode - "CIDER Connections" - "CIDER Connections Buffer Mode. -\\{cider-connections-buffer-mode-map} -\\{cider-popup-buffer-mode-map}" - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -(defvar cider--connection-ewoc) -(defconst cider--connection-browser-buffer-name "*cider-connections*") - -(defun cider-connection-browser () - "Open a browser buffer for nREPL connections." - (interactive) - (if-let ((buffer (get-buffer cider--connection-browser-buffer-name))) - (progn - (cider--connections-refresh-buffer buffer) - (unless (get-buffer-window buffer) - (select-window (display-buffer buffer)))) - (cider--setup-connection-browser))) - -(defun cider--connections-refresh () - "Refresh the connections buffer, if the buffer exists. -The connections buffer is determined by -`cider--connection-browser-buffer-name'" - (when-let ((buffer (get-buffer cider--connection-browser-buffer-name))) - (cider--connections-refresh-buffer buffer))) - -(add-hook 'nrepl-disconnected-hook #'cider--connections-refresh) - -(defun cider--connections-refresh-buffer (buffer) - "Refresh the connections BUFFER." - (cider--update-connections-display - (buffer-local-value 'cider--connection-ewoc buffer) - cider-connections)) - -(defun cider--setup-connection-browser () - "Create a browser buffer for nREPL connections." - (with-current-buffer (get-buffer-create cider--connection-browser-buffer-name) - (let ((ewoc (ewoc-create - 'cider--connection-pp - " REPL Host Port Project Type\n"))) - (setq-local cider--connection-ewoc ewoc) - (cider--update-connections-display ewoc cider-connections) - (setq buffer-read-only t) - (cider-connections-buffer-mode) - (display-buffer (current-buffer))))) - -(defun cider-client-name-repl-type (type) - "Return a human-readable name for a connection TYPE. -TYPE can be any of the possible values of `cider-repl-type'." - (pcase type - ("clj" "Clojure") - ("cljs" "ClojureScript") - (_ "Unknown"))) - -(defun cider-project-name (project-dir) - "Extract the project name from PROJECT-DIR." - (if (and project-dir (not (equal project-dir ""))) - (file-name-nondirectory (directory-file-name project-dir)) - "-")) - -(defun cider--connection-pp (connection) - "Print an nREPL CONNECTION to the current buffer." - (let* ((buffer-read-only nil) - (buffer (get-buffer connection)) - (project-name (cider-project-name (buffer-local-value 'nrepl-project-dir buffer))) - (repl-type (cider-client-name-repl-type (buffer-local-value 'cider-repl-type buffer))) - (endpoint (buffer-local-value 'nrepl-endpoint buffer))) - (insert - (format "%s %-30s %-16s %5s %-16s %s" - (if (equal connection (car cider-connections)) "*" " ") - (buffer-name connection) - (car endpoint) - (prin1-to-string (cadr endpoint)) - project-name - repl-type)))) - -(defun cider--update-connections-display (ewoc connections) - "Update the connections EWOC to show CONNECTIONS." - (ewoc-filter ewoc (lambda (n) (member n connections))) - (let ((existing)) - (ewoc-map (lambda (n) (setq existing (cons n existing))) ewoc) - (let ((added (seq-difference connections existing))) - (mapc (apply-partially 'ewoc-enter-last ewoc) added) - (save-excursion (ewoc-refresh ewoc))))) - -(defun cider--ewoc-apply-at-point (f) - "Apply function F to the ewoc node at point. -F is a function of two arguments, the ewoc and the data at point." - (let* ((ewoc cider--connection-ewoc) - (node (and ewoc (ewoc-locate ewoc)))) - (when node - (funcall f ewoc (ewoc-data node))))) - -(defun cider-connections-make-default () - "Make default the connection at point in the connection browser." - (interactive) - (save-excursion - (cider--ewoc-apply-at-point #'cider--connections-make-default))) - -(defun cider--connections-make-default (ewoc data) - "Make the connection in EWOC specified by DATA default. -Refreshes EWOC." - (interactive) - (cider-make-connection-default data) - (ewoc-refresh ewoc)) - -(defun cider-connections-close-connection () - "Close connection at point in the connection browser." - (interactive) - (cider--ewoc-apply-at-point #'cider--connections-close-connection)) - -(defun cider--connections-close-connection (ewoc data) - "Close the connection in EWOC specified by DATA." - (cider--close-connection-buffer (get-buffer data)) - (cider--update-connections-display ewoc cider-connections)) - -(defun cider-connections-goto-connection () - "Goto connection at point in the connection browser." - (interactive) - (cider--ewoc-apply-at-point #'cider--connections-goto-connection)) - -(defun cider--connections-goto-connection (_ewoc data) - "Goto the REPL for the connection in _EWOC specified by DATA." - (when (buffer-live-p data) - (select-window (display-buffer data)))) - - -(defun cider-display-connected-message () - "Message displayed on successful connection." - (message - (concat "Connected." - (if cider-connection-message-fn - (format " %s" (funcall cider-connection-message-fn)) - "")))) - -;; TODO: Replace direct usage of such hooks with CIDER hooks, -;; that are connection type independent -(add-hook 'nrepl-connected-hook 'cider-display-connected-message) - - -;;; Eval spinner -(defcustom cider-eval-spinner-type 'progress-bar - "Appearance of the evaluation spinner. - -Value is a symbol. The possible values are the symbols in the -`spinner-types' variable." - :type 'symbol - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-show-eval-spinner t - "When true, show the evaluation spinner in the mode line." - :type 'boolean - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-eval-spinner-delay 1 - "Amount of time, in seconds, after which the evaluation spinner will be shown." - :type 'integer - :group 'cider - :package-version '(cider . "0.10.0")) - -(defun cider-spinner-start (buffer) - "Start the evaluation spinner in BUFFER. -Do nothing if `cider-show-eval-spinner' is nil." - (when cider-show-eval-spinner - (with-current-buffer buffer - (spinner-start cider-eval-spinner-type nil - cider-eval-spinner-delay)))) - -(defun cider-eval-spinner-handler (eval-buffer original-callback) - "Return a response handler to stop the spinner and call ORIGINAL-CALLBACK. -EVAL-BUFFER is the buffer where the spinner was started." - (lambda (response) - ;; buffer still exists and - ;; we've got status "done" from nrepl - ;; stop the spinner - (when (and (buffer-live-p eval-buffer) - (let ((status (nrepl-dict-get response "status"))) - (or (member "done" status) - (member "eval-error" status) - (member "error" status)))) - (with-current-buffer eval-buffer - (when spinner-current (spinner-stop)))) - (funcall original-callback response))) - - -;;; Evaluation helpers -(defun cider-ns-form-p (form) - "Check if FORM is an ns form." - (string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form)) - -(defvar-local cider-buffer-ns nil - "Current Clojure namespace of some buffer. - -Useful for special buffers (e.g. REPL, doc buffers) that have to -keep track of a namespace. - -This should never be set in Clojure buffers, as there the namespace -should be extracted from the buffer's ns form.") - -(defun cider-current-ns (&optional no-default) - "Return the current ns. -The ns is extracted from the ns form for Clojure buffers and from -`cider-buffer-ns' for all other buffers. If it's missing, use the current -REPL's ns, otherwise fall back to \"user\". - -When NO-DEFAULT is non-nil, it will return nil instead of \"user\"." - (or cider-buffer-ns - (clojure-find-ns) - (when-let ((repl-buf (cider-current-connection))) - (buffer-local-value 'cider-buffer-ns repl-buf)) - (if no-default nil "user"))) - -(defun cider-expected-ns (&optional path) - "Return the namespace string matching PATH, or nil if not found. - -PATH is expected to be an absolute file path. -If PATH is nil, use the path to the file backing the current buffer. - -The command falls back to `clojure-expected-ns' in the absence of an -active nREPL connection." - (if (cider-connected-p) - (let* ((path (or path (file-truename (buffer-file-name)))) - (relpath (thread-last (cider-sync-request:classpath) - (seq-map - (lambda (cp) - (when (string-prefix-p cp path) - (substring path (length cp))))) - (seq-filter #'identity) - (seq-sort (lambda (a b) - (< (length a) (length b)))) - (car)))) - (if relpath - (thread-last (substring relpath 1) ; remove leading / - (file-name-sans-extension) - (replace-regexp-in-string "/" ".") - (replace-regexp-in-string "_" "-")) - (clojure-expected-ns path))) - (clojure-expected-ns path))) - -(defun cider-nrepl-op-supported-p (op) - "Check whether the current connection supports the nREPL middleware OP." - (nrepl-op-supported-p op (cider-current-connection))) - -(defvar cider-version) -(defun cider-ensure-op-supported (op) - "Check for support of middleware op OP. -Signal an error if it is not supported." - (unless (cider-nrepl-op-supported-p op) - (user-error "`%s' requires the nREPL op \"%s\". Please, install (or update) cider-nrepl %s and restart CIDER" this-command op (upcase cider-version)))) - -(defun cider-nrepl-send-request (request callback &optional connection) - "Send REQUEST and register response handler CALLBACK. -REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" -\"par1\" ... ). -If CONNECTION is provided dispatch to that connection instead of -the current connection. - -Return the id of the sent message." - (nrepl-send-request request callback (or connection (cider-current-connection)))) - -(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input) - "Send REQUEST to the nREPL server synchronously using CONNECTION. -Hold till final \"done\" message has arrived and join all response messages -of the same \"op\" that came along and return the accumulated response. -If ABORT-ON-INPUT is non-nil, the function will return nil -at the first sign of user input, so as not to hang the -interface." - (nrepl-send-sync-request request - (or connection (cider-current-connection)) - abort-on-input)) - -(defun cider-nrepl-send-unhandled-request (request) - "Send REQUEST to the nREPL server and ignore any responses. -Immediately mark the REQUEST as done. -Return the id of the sent message." - (let* ((conn (cider-current-connection)) - (id (nrepl-send-request request #'ignore conn))) - (with-current-buffer conn - (nrepl--mark-id-completed id)) - id)) - -(defun cider-nrepl-request:eval (input callback &optional ns line column additional-params) - "Send the request INPUT and register the CALLBACK as the response handler. -If NS is non-nil, include it in the request. LINE and COLUMN, if non-nil, -define the position of INPUT in its buffer. ADDITIONAL-PARAMS is a plist -to be appended to the request message." - (let ((connection (cider-current-connection))) - (nrepl-request:eval input - (if cider-show-eval-spinner - (cider-eval-spinner-handler connection callback) - callback) - connection - ns line column additional-params) - (cider-spinner-start connection))) - -(defun cider-nrepl-sync-request:eval (input &optional ns) - "Send the INPUT to the nREPL server synchronously. -If NS is non-nil, include it in the request." - (nrepl-sync-request:eval - input - (cider-current-connection) - ns)) - -(defcustom cider-pprint-fn 'pprint - "Sets the function to use when pretty-printing evaluation results. - -The value must be one of the following symbols: - - `pprint' - to use \\=`clojure.pprint/pprint\\=` - - `fipp' - to use the Fast Idiomatic Pretty Printer, approximately 5-10x - faster than \\=`clojure.core/pprint\\=` (this is the default) - - `puget' - to use Puget, which provides canonical serialization of data on - top of fipp, but at a slight performance cost - -Alternatively, can be the namespace-qualified name of a Clojure function of -one argument. If the function cannot be resolved, an exception will be -thrown. - -The function is assumed to respect the contract of \\=`clojure.pprint/pprint\\=` -with respect to the bound values of \\=`*print-length*\\=`, \\=`*print-level*\\=`, -\\=`*print-meta*\\=`, and \\=`clojure.pprint/*print-right-margin*\\=`." - :type '(choice (const pprint) - (const fipp) - (const puget) - string) - :group 'cider - :package-version '(cider . "0.11.0")) - -(defun cider--pprint-fn () - "Return the value to send in the pprint-fn slot of messages." - (pcase cider-pprint-fn - (`pprint "clojure.pprint/pprint") - (`fipp "cider.nrepl.middleware.pprint/fipp-pprint") - (`puget "cider.nrepl.middleware.pprint/puget-pprint") - (_ cider-pprint-fn))) - -(defun cider--nrepl-pprint-request-plist (right-margin &optional pprint-fn) - "Plist to be appended to an eval request to make it use pprint. -PPRINT-FN is the name of the Clojure function to use. -RIGHT-MARGIN specifies the maximum column-width of the pretty-printed -result, and is included in the request if non-nil." - (append (list "pprint" "true" - "pprint-fn" (or pprint-fn (cider--pprint-fn))) - (and right-margin (list "print-right-margin" right-margin)))) - -(defun cider-tooling-eval (input callback &optional ns) - "Send the request INPUT and register the CALLBACK as the response handler. -NS specifies the namespace in which to evaluate the request." - ;; namespace forms are always evaluated in the "user" namespace - (nrepl-request:eval input - callback - (cider-current-connection) - ns nil nil nil t ; tooling - )) - -(defalias 'cider-current-repl-buffer #'cider-current-connection - "The current REPL buffer. -Return the REPL buffer given by `cider-current-connection'.") - -(declare-function cider-interrupt-handler "cider-interaction") -(defun cider-interrupt () - "Interrupt any pending evaluations." - (interactive) - (with-current-buffer (cider-current-connection) - (let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests))) - (dolist (request-id pending-request-ids) - (nrepl-request:interrupt - request-id - (cider-interrupt-handler (current-buffer)) - (cider-current-connection)))))) - -(defun cider-current-session () - "Return the eval nREPL session id of the current connection." - (cider-session-for-connection (cider-current-connection))) - -(defun cider-session-for-connection (connection) - (with-current-buffer connection - nrepl-session)) - -(defun cider-current-messages-buffer () - "The nREPL messages buffer, matching the current connection." - (nrepl-messages-buffer (cider-current-connection))) - -(defun cider-current-tooling-session () - "Return the tooling nREPL session id of the current connection." - (with-current-buffer (cider-current-connection) - nrepl-tooling-session)) - -(defun cider--var-choice (var-info) - "Prompt to choose from among multiple VAR-INFO candidates, if required. -This is needed only when the symbol queried is an unqualified host platform -method, and multiple classes have a so-named member. If VAR-INFO does not -contain a `candidates' key, it is returned as is." - (let ((candidates (nrepl-dict-get var-info "candidates"))) - (if candidates - (let* ((classes (nrepl-dict-keys candidates)) - (choice (completing-read "Member in class: " classes nil t)) - (info (nrepl-dict-get candidates choice))) - info) - var-info))) - -(defun cider-var-info (var &optional all) - "Return VAR's info as an alist with list cdrs. -When multiple matching vars are returned you'll be prompted to select one, -unless ALL is truthy." - (when (and var (not (string= var ""))) - (let ((var-info (cider-sync-request:info var))) - (if all var-info (cider--var-choice var-info))))) - -(defun cider-member-info (class member) - "Return the CLASS MEMBER's info as an alist with list cdrs." - (when (and class member) - (cider-sync-request:info nil class member))) - -(defun cider--find-var-other-window (var &optional line) - "Find the definition of VAR, optionally at a specific LINE. - -Display the results in a different window." - (if-let ((info (cider-var-info var))) - (progn - (if line (setq info (nrepl-dict-put info "line" line))) - (cider--jump-to-loc-from-info info t)) - (user-error "Symbol %s not resolved" var))) - -(defun cider--find-var (var &optional line) - "Find the definition of VAR, optionally at a specific LINE." - (if-let ((info (cider-var-info var))) - (progn - (if line (setq info (nrepl-dict-put info "line" line))) - (cider--jump-to-loc-from-info info)) - (user-error "Symbol %s not resolved" var))) - -(defun cider-find-var (&optional arg var line) - "Find definition for VAR at LINE. - -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point." - (interactive "P") - (cider-ensure-op-supported "info") - (if var - (cider--find-var var line) - (funcall (cider-prompt-for-symbol-function arg) - "Symbol" - (if (cider--open-other-window-p arg) - #'cider--find-var-other-window - #'cider--find-var)))) - - -;;; Requests - -(declare-function cider-load-file-handler "cider-interaction") -(defun cider-request:load-file (file-contents file-path file-name &optional connection callback) - "Perform the nREPL \"load-file\" op. -FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be -loaded. - -If CONNECTION is nil, use `cider-current-connection'. -If CALLBACK is nil, use `cider-load-file-handler'." - (cider-nrepl-send-request (list "op" "load-file" - "file" file-contents - "file-path" file-path - "file-name" file-name) - (or callback - (cider-load-file-handler (current-buffer))) - connection)) - - -;;; Sync Requests - -(defcustom cider-filtered-namespaces-regexps - '("^cider.nrepl" "^refactor-nrepl" "^clojure.tools.nrepl") - "List of regexps used to filter out some vars/symbols/namespaces. -When nil, nothing is filtered out. Otherwise, all namespaces matching any -regexp from this list are dropped out of the \"ns-list\" op. -Also, \"apropos\" won't include vars from such namespaces. -This list is passed on to the nREPL middleware without any pre-processing. -So the regexps have to be in Clojure format (with twice the number of -backslashes) and not Emacs Lisp." - :type '(repeat string) - :safe #'listp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p) - "Send \"apropos\" request for regexp QUERY. - -Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." - (let* ((query (replace-regexp-in-string "[ \t]+" ".+" query)) - (response (cider-nrepl-send-sync-request - `("op" "apropos" - "ns" ,(cider-current-ns) - "query" ,query - ,@(when search-ns `("search-ns" ,search-ns)) - ,@(when docs-p '("docs?" "t")) - ,@(when privates-p '("privates?" "t")) - ,@(when case-sensitive-p '("case-sensitive?" "t")) - "filter-regexps" ,cider-filtered-namespaces-regexps)))) - (if (member "apropos-regexp-error" (nrepl-dict-get response "status")) - (user-error "Invalid regexp: %s" (nrepl-dict-get response "error-msg")) - (nrepl-dict-get response "apropos-matches")))) - -(defun cider-sync-request:classpath () - "Return a list of classpath entries." - (cider-ensure-op-supported "classpath") - (thread-first (list "op" "classpath") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "classpath"))) - -(defun cider-sync-request:complete (str context) - "Return a list of completions for STR using nREPL's \"complete\" op. -CONTEXT represents a completion context for compliment." - (when-let ((dict (thread-first (list "op" "complete" - "ns" (cider-current-ns) - "symbol" str - "context" context) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (nrepl-dict-get dict "completions"))) - -(defun cider-sync-request:info (symbol &optional class member) - "Send \"info\" op with parameters SYMBOL or CLASS and MEMBER." - (let ((var-info (thread-first `("op" "info" - "ns" ,(cider-current-ns) - ,@(when symbol (list "symbol" symbol)) - ,@(when class (list "class" class)) - ,@(when member (list "member" member))) - (cider-nrepl-send-sync-request)))) - (if (member "no-info" (nrepl-dict-get var-info "status")) - nil - var-info))) - -(defun cider-sync-request:eldoc (symbol &optional class member) - "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER." - (when-let ((eldoc (thread-first `("op" "eldoc" - "ns" ,(cider-current-ns) - ,@(when symbol (list "symbol" symbol)) - ,@(when class (list "class" class)) - ,@(when member (list "member" member))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) - nil - eldoc))) - -(defun cider-sync-request:ns-list () - "Get a list of the available namespaces." - (thread-first (list "op" "ns-list" - "filter-regexps" cider-filtered-namespaces-regexps) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-list"))) - -(defun cider-sync-request:ns-vars (ns) - "Get a list of the vars in NS." - (thread-first (list "op" "ns-vars" - "ns" ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars"))) - -(defun cider-sync-request:ns-vars-with-meta (ns) - "Get a map of the vars in NS to its metadata information." - (thread-first (list "op" "ns-vars-with-meta" - "ns" ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars-with-meta"))) - -(defun cider-sync-request:ns-load-all () - "Load all project namespaces." - (thread-first (list "op" "ns-load-all") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "loaded-ns"))) - -(defun cider-sync-request:resource (name) - "Perform nREPL \"resource\" op with resource name NAME." - (thread-first (list "op" "resource" - "name" name) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resource-path"))) - -(defun cider-sync-request:resources-list () - "Return a list of all resources on the classpath." - (thread-first (list "op" "resources-list") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resources-list"))) - -(defun cider-sync-request:format-code (code) - "Perform nREPL \"format-code\" op with CODE." - (thread-first (list "op" "format-code" - "code" code) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "formatted-code"))) - -(defun cider-sync-request:format-edn (edn right-margin) - "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." - (let* ((response (thread-first (list "op" "format-edn" - "edn" edn) - (append (cider--nrepl-pprint-request-plist right-margin)) - (cider-nrepl-send-sync-request))) - (err (nrepl-dict-get response "err"))) - (when err - ;; err will be a stacktrace with a first line that looks like: - ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" - (error (car (split-string err "\n")))) - (nrepl-dict-get response "formatted-edn"))) - - -;;; Connection info -(defun cider--java-version () - "Retrieve the underlying connection's Java version." - (with-current-buffer (cider-current-connection "clj") - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "java") - (nrepl-dict-get "version-string"))))) - -(defun cider--clojure-version () - "Retrieve the underlying connection's Clojure version." - (with-current-buffer (cider-current-connection "clj") - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "clojure") - (nrepl-dict-get "version-string"))))) - -(defun cider--nrepl-version () - "Retrieve the underlying connection's nREPL version." - (with-current-buffer (cider-current-connection "clj") - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "nrepl") - (nrepl-dict-get "version-string"))))) - -(defun cider--connection-info (connection-buffer) - "Return info about CONNECTION-BUFFER. - -Info contains project name, current REPL namespace, host:port -endpoint and Clojure version." - (with-current-buffer connection-buffer - (format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)" - (upcase (concat cider-repl-type " ")) - (or (cider--project-name nrepl-project-dir) "") - (car nrepl-endpoint) - (cadr nrepl-endpoint) - (cider--java-version) - (cider--clojure-version) - (cider--nrepl-version)))) - -(defun cider--connection-properties (conn-buffer) - "Extract the essential properties of CONN-BUFFER." - (with-current-buffer conn-buffer - (list - :type cider-repl-type - :host (car nrepl-endpoint) - :port (cadr nrepl-endpoint) - :project-dir nrepl-project-dir))) - -(defun cider--connection-type (conn-buffer) - "Get CONN-BUFFER's type. - -Return value matches `cider-repl-type'." - (plist-get (cider--connection-properties conn-buffer) :type)) - -(defun cider--connection-host (conn-buffer) - "Get CONN-BUFFER's host." - (plist-get (cider--connection-properties conn-buffer) :host)) - -(defun cider--connection-port (conn-buffer) - "Get CONN-BUFFER's port." - (plist-get (cider--connection-properties conn-buffer) :port)) - -(defun cider--connection-project-dir (conn-buffer) - "Get CONN-BUFFER's project dir." - (plist-get (cider--connection-properties conn-buffer) :project-dir)) - -(defun cider-display-connection-info (&optional show-default) - "Display information about the current connection. - -With a prefix argument SHOW-DEFAULT it will display info about the -default connection." - (interactive "P") - (message "%s" (cider--connection-info (if show-default - (cider-default-connection) - (cider-current-connection))))) - -(defun cider-rotate-default-connection () - "Rotate and display the default nREPL connection." - (interactive) - (cider-ensure-connected) - (setq cider-connections - (append (cdr cider-connections) - (list (car cider-connections)))) - (message "Default nREPL connection: %s" - (cider--connection-info (car cider-connections)))) - -(defun cider-replicate-connection (&optional conn) - "Establish a new connection based on an existing connection. -The new connection will use the same host and port. -If CONN is not provided the user will be prompted to select a connection." - (interactive) - (let* ((conn (or conn (cider-read-connection "Select connection to replicate: "))) - (host (cider--connection-host conn)) - (port (cider--connection-port conn)) - (project-dir (cider--connection-project-dir conn))) - (cider-connect host port project-dir))) - -(defun cider-extract-designation-from-current-repl-buffer () - "Extract the designation from the cider repl buffer name." - (let ((repl-buffer-name (buffer-name (cider-current-repl-buffer))) - (template (split-string nrepl-repl-buffer-name-template "%s"))) - (string-match (format "^%s\\(.*\\)%s" - (regexp-quote (concat (car template) nrepl-buffer-name-separator)) - (regexp-quote (cadr template))) - repl-buffer-name) - (or (match-string 1 repl-buffer-name) ""))) - -(defun cider-change-buffers-designation (designation) - "Change the DESIGNATION in cider buffer names. -Buffer names changed are cider-repl and nrepl-server." - (interactive (list (read-string (format "Change CIDER buffer designation from '%s': " - (cider-extract-designation-from-current-repl-buffer))))) - (cider-ensure-connected) - (let ((new-repl-buffer-name (nrepl-format-buffer-name-template - nrepl-repl-buffer-name-template designation))) - (with-current-buffer (cider-current-repl-buffer) - (rename-buffer new-repl-buffer-name) - (when nrepl-server-buffer - (let ((new-server-buffer-name (nrepl-format-buffer-name-template - nrepl-server-buffer-name-template designation))) - (with-current-buffer nrepl-server-buffer - (rename-buffer new-server-buffer-name))))) - (message "CIDER buffer designation changed to: %s" designation))) - -(provide 'cider-client) - -;;; cider-client.el ends here diff --git a/elpa/cider-20170129.1941/cider-compat.el b/elpa/cider-20170129.1941/cider-compat.el deleted file mode 100644 index c34bc7bf..00000000 --- a/elpa/cider-20170129.1941/cider-compat.el +++ /dev/null @@ -1,157 +0,0 @@ -;;; cider-compat.el --- Functions from newer Emacs versions for compatibility -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Pretty much everything here's copied from subr-x for compatibility with -;; Emacs 24.4. - -;;; Code: - -(eval-and-compile - - (unless (fboundp 'internal--thread-argument) - (defmacro internal--thread-argument (first? &rest forms) - "Internal implementation for `thread-first' and `thread-last'. -When Argument FIRST? is non-nil argument is threaded first, else -last. FORMS are the expressions to be threaded." - (pcase forms - (`(,x (,f . ,args) . ,rest) - `(internal--thread-argument - ,first? ,(if first? `(,f ,x ,@args) `(,f ,@args ,x)) ,@rest)) - (`(,x ,f . ,rest) `(internal--thread-argument ,first? (,f ,x) ,@rest)) - (_ (car forms))))) - - (unless (fboundp 'thread-first) - (defmacro thread-first (&rest forms) - "Thread FORMS elements as the first argument of their successor. -Example: - (thread-first - 5 - (+ 20) - (/ 25) - - - (+ 40)) -Is equivalent to: - (+ (- (/ (+ 5 20) 25)) 40) -Note how the single `-' got converted into a list before -threading." - (declare (indent 1) - (debug (form &rest [&or symbolp (sexp &rest form)]))) - `(internal--thread-argument t ,@forms))) - - (unless (fboundp 'thread-last) - (defmacro thread-last (&rest forms) - "Thread FORMS elements as the last argument of their successor. -Example: - (thread-last - 5 - (+ 20) - (/ 25) - - - (+ 40)) -Is equivalent to: - (+ 40 (- (/ 25 (+ 20 5)))) -Note how the single `-' got converted into a list before -threading." - (declare (indent 1) (debug thread-first)) - `(internal--thread-argument nil ,@forms)))) - - -(eval-and-compile - - (unless (fboundp 'internal--listify) - - (defsubst internal--listify (elt) - "Wrap ELT in a list if it is not one." - (if (not (listp elt)) - (list elt) - elt))) - - (unless (fboundp 'internal--check-binding) - - (defsubst internal--check-binding (binding) - "Check BINDING is properly formed." - (when (> (length binding) 2) - (signal - 'error - (cons "`let' bindings can have only one value-form" binding))) - binding)) - - (unless (fboundp 'internal--build-binding-value-form) - - (defsubst internal--build-binding-value-form (binding prev-var) - "Build the conditional value form for BINDING using PREV-VAR." - `(,(car binding) (and ,prev-var ,(cadr binding))))) - - (unless (fboundp 'internal--build-binding) - - (defun internal--build-binding (binding prev-var) - "Check and build a single BINDING with PREV-VAR." - (thread-first - binding - internal--listify - internal--check-binding - (internal--build-binding-value-form prev-var)))) - - (unless (fboundp 'internal--build-bindings) - - (defun internal--build-bindings (bindings) - "Check and build conditional value forms for BINDINGS." - (let ((prev-var t)) - (mapcar (lambda (binding) - (let ((binding (internal--build-binding binding prev-var))) - (setq prev-var (car binding)) - binding)) - bindings))))) - -(eval-and-compile - - (unless (fboundp 'if-let) - (defmacro if-let (bindings then &rest else) - "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in THEN, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." - (declare (indent 2) - (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) - (when (and (<= (length bindings) 2) - (not (listp (car bindings)))) - ;; Adjust the single binding case - (setq bindings (list bindings))) - `(let* ,(internal--build-bindings bindings) - (if ,(car (internal--listify (car (last bindings)))) - ,then - ,@else)))) - - (unless (fboundp 'when-let) - (defmacro when-let (bindings &rest body) - "Process BINDINGS and if all values are non-nil eval BODY. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in BODY, and its cadr is a sexp to be -evalled to set symbol's value. In the special case you only want -to bind a single value, BINDINGS can just be a plain tuple." - (declare (indent 1) (debug if-let)) - (list 'if-let bindings (macroexp-progn body))))) - -(provide 'cider-compat) -;;; cider-compat.el ends here diff --git a/elpa/cider-20170129.1941/cider-interaction.el b/elpa/cider-20170129.1941/cider-interaction.el deleted file mode 100644 index d08d6d09..00000000 --- a/elpa/cider-20170129.1941/cider-interaction.el +++ /dev/null @@ -1,1828 +0,0 @@ -;;; cider-interaction.el --- IDE for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides an Emacs Lisp client to connect to Clojure nREPL servers. - -;;; Code: - -(require 'cider-client) -(require 'cider-repl) -(require 'cider-popup) -(require 'cider-common) -(require 'cider-util) -(require 'cider-stacktrace) -(require 'cider-test) -(require 'cider-doc) -(require 'cider-eldoc) -(require 'cider-overlays) -(require 'subr-x) -(require 'cider-compat) - -(require 'clojure-mode) -(require 'thingatpt) -(require 'arc-mode) -(require 'ansi-color) -(require 'cl-lib) -(require 'compile) -(require 'etags) ; for find-tags-marker-ring -(require 'tramp) - -(defconst cider-read-eval-buffer "*cider-read-eval*") -(defconst cider-result-buffer "*cider-result*") -(defconst cider-nrepl-session-buffer "*cider-nrepl-session*") -(add-to-list 'cider-ancillary-buffers cider-nrepl-session-buffer) - -(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-visit-error-buffer' 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-prompt-save-file-on-load t - "Controls whether to prompt to save the file when loading a buffer. -If nil, files are not saved. -If t, the user is prompted to save the file if it's been modified. -If the symbol `always-save', save the file without confirmation." - :type '(choice (const t :tag "Prompt to save the file if it's been modified") - (const nil :tag "Don't save the file") - (const always-save :tag "Save the file without confirmation")) - :group 'cider - :package-version '(cider . "0.6.0")) - -(defcustom cider-completion-use-context t - "When true, uses context at point to improve completion suggestions." - :type 'boolean - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-annotate-completion-candidates t - "When true, annotate completion candidates with some extra information." - :type 'boolean - :group 'cider - :package-version '(cider . "0.8.0")) - -(defcustom cider-annotate-completion-function - #'cider-default-annotate-completion-function - "Controls how the annotations for completion candidates are formatted. - -Must be a function that takes two arguments: the abbreviation of the -candidate type according to `cider-completion-annotations-alist' and the -candidate's namespace." - :type 'function - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-completion-annotations-alist - '(("class" "c") - ("field" "fi") - ("function" "f") - ("import" "i") - ("keyword" "k") - ("local" "l") - ("macro" "m") - ("method" "me") - ("namespace" "n") - ("protocol" "p") - ("protocol-function" "pf") - ("record" "r") - ("special-form" "s") - ("static-field" "sf") - ("static-method" "sm") - ("type" "t") - ("var" "v")) - "Controls the abbreviations used when annotating completion candidates. - -Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE -is a possible value of the candidate's type returned from the completion -backend, and ABBREVIATION is a short form of that type." - :type '(alist :key-type string :value-type string) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-completion-annotations-include-ns 'unqualified - "Controls passing of namespaces to `cider-annotate-completion-function'. - -When set to 'always, the candidate's namespace will always be passed if it -is available. When set to 'unqualified, the namespace will only be passed -if the candidate is not namespace-qualified." - :type '(choice (const always) - (const unqualified) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defconst cider-refresh-log-buffer "*cider-refresh-log*") - -(defcustom cider-refresh-show-log-buffer nil - "Controls when to display the refresh log buffer. - -If non-nil, the log buffer will be displayed every time `cider-refresh' is -called. - -If nil, the log buffer will still be written to, but will never be -displayed automatically. Instead, the most relevant information will be -displayed in the echo area." - :type '(choice (const :tag "always" t) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-refresh-before-fn nil - "Clojure function for `cider-refresh' to call before reloading. - -If nil, nothing will be invoked before reloading. Must be a -namespace-qualified function of zero arity. Any thrown exception will -prevent reloading from occurring." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-refresh-after-fn nil - "Clojure function for `cider-refresh' to call after reloading. - -If nil, nothing will be invoked after reloading. Must be a -namespace-qualified function of zero arity." - :type 'string - :group 'cider - :package-version '(cider . "0.10.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) - -(defconst cider-clojure-artifact-id "org.clojure/clojure" - "Artifact identifier for Clojure.") - -(defconst cider-minimum-clojure-version "1.7.0" - "Minimum supported version of Clojure.") - -(defconst cider-latest-clojure-version "1.8.0" - "Latest supported version of Clojure.") - -(defconst cider-required-nrepl-version "0.2.12" - "The minimum nREPL version that's known to work properly with CIDER.") - -;;; Minibuffer -(defvar cider-minibuffer-history '() - "History list of expressions read from the minibuffer.") - -(defvar cider-minibuffer-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "TAB") #'complete-symbol) - (define-key map (kbd "M-TAB") #'complete-symbol) - map) - "Minibuffer keymap used for reading Clojure expressions.") - -(defvar-local cider-connection-created-with 'jack-in - "Save how the connection was created. -Its value can be either 'jack-in or 'connect.") - -(defun cider-read-from-minibuffer (prompt &optional value) - "Read a string from the minibuffer, prompting with PROMPT. -If VALUE is non-nil, it is inserted into the minibuffer as initial-input. - -PROMPT need not end with \": \". If it doesn't, VALUE is displayed on the -prompt as a default value (used if the user doesn't type anything) and is -not used as initial input (input is left empty)." - (minibuffer-with-setup-hook - (lambda () - (set-syntax-table clojure-mode-syntax-table) - (add-hook 'completion-at-point-functions - #'cider-complete-at-point nil t) - (setq-local eldoc-documentation-function #'cider-eldoc) - (run-hooks 'eval-expression-minibuffer-setup-hook)) - (let* ((has-colon (string-match ": \\'" prompt)) - (input (read-from-minibuffer (cond - (has-colon prompt) - (value (format "%s (default %s): " prompt value)) - (t (format "%s: " prompt))) - (when has-colon value) ; initial-input - cider-minibuffer-map nil - 'cider-minibuffer-history - (unless has-colon value)))) ; default-value - (if (and (equal input "") value (not has-colon)) - value - input)))) - - -;;; 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))) - -;;; -(declare-function cider-mode "cider-mode") - -(defun cider-jump-to (buffer &optional pos other-window) - "Push current point onto marker ring, and jump to BUFFER and POS. -POS can be either a number, a cons, or a symbol. -If a number, it is the character position (the point). -If a cons, it specifies the position as (LINE . COLUMN). COLUMN can be nil. -If a symbol, `cider-jump-to' searches for something that looks like the -symbol's definition in the file. -If OTHER-WINDOW is non-nil don't reuse current window." - (with-no-warnings - (ring-insert find-tag-marker-ring (point-marker))) - (if other-window - (pop-to-buffer buffer) - ;; like switch-to-buffer, but reuse existing window if BUFFER is visible - (pop-to-buffer buffer '((display-buffer-reuse-window display-buffer-same-window)))) - (with-current-buffer buffer - (widen) - (goto-char (point-min)) - (cider-mode +1) - (cond - ;; Line-column specification. - ((consp pos) - (forward-line (1- (or (car pos) 1))) - (if (cdr pos) - (move-to-column (cdr pos)) - (back-to-indentation))) - ;; Point specification. - ((numberp pos) - (goto-char pos)) - ;; Symbol or string. - (pos - ;; Try to find (def full-name ...). - (if (or (save-excursion - (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote pos)) - nil 'noerror)) - (let ((name (replace-regexp-in-string ".*/" "" pos))) - ;; Try to find (def name ...). - (or (save-excursion - (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote name)) - nil 'noerror)) - ;; Last resort, just find the first occurrence of `name'. - (save-excursion - (search-forward name nil 'noerror))))) - (goto-char (match-beginning 0)) - (message "Can't find %s in %s" pos (buffer-file-name)))) - (t nil)))) - -(defun cider-find-dwim-other-window (symbol-file) - "Jump to SYMBOL-FILE at point, place results in other window." - (interactive (cider--find-dwim-interactive "Jump to: ")) - (cider--find-dwim symbol-file 'cider-find-dwim-other-window t)) - -(defun cider-find-dwim (symbol-file) - "Find and display the SYMBOL-FILE at point. - -SYMBOL-FILE could be a var or a resource. If thing at point is empty -then show dired on project. If var is not found, try to jump to resource -of the same name. When called interactively, a prompt is given according -to the variable `cider-prompt-for-symbol'. A single or double prefix argument -inverts the meaning. A prefix of `-' or a double prefix argument causes the -results to be displayed in a different window. -A default value of thing at point is given when prompted." - (interactive (cider--find-dwim-interactive "Jump to: ")) - (cider--find-dwim symbol-file `cider-find-dwim - (cider--open-other-window-p current-prefix-arg))) - -(defun cider--find-dwim (symbol-file callback &optional other-window) - "Find the SYMBOL-FILE at point. - -CALLBACK upon failure to invoke prompt if not prompted previously. -Show results in a different window if OTHER-WINDOW is true." - (if-let ((info (cider-var-info symbol-file))) - (cider--jump-to-loc-from-info info other-window) - (progn - (cider-ensure-op-supported "resource") - (if-let ((resource (cider-sync-request:resource symbol-file)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer 0 other-window) - (if (cider--prompt-for-symbol-p current-prefix-arg) - (error "Resource or var %s not resolved" symbol-file) - (let ((current-prefix-arg (if current-prefix-arg nil '(4)))) - (call-interactively callback))))))) - -(defun cider--find-dwim-interactive (prompt) - "Get interactive arguments for jump-to functions using PROMPT as needed." - (if (cider--prompt-for-symbol-p current-prefix-arg) - (list - (cider-read-from-minibuffer prompt (thing-at-point 'filename))) - (list (or (thing-at-point 'filename) "")))) ; No prompt. - -(defun cider-find-resource (path) - "Find the resource at PATH. - -Prompt for input as indicated by the variable `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix -argument causes the results to be displayed in other window. The default -value is thing at point." - (interactive - (list - (if (cider--prompt-for-symbol-p current-prefix-arg) - (completing-read "Resource: " - (cider-sync-request:resources-list) - nil nil - (thing-at-point 'filename)) - (or (thing-at-point 'filename) "")))) - (cider-ensure-op-supported "resource") - (when (= (length path) 0) - (error "Cannot find resource for empty path")) - (if-let ((resource (cider-sync-request:resource path)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg)) - (if (cider--prompt-for-symbol-p current-prefix-arg) - (error "Cannot find resource %s" path) - (let ((current-prefix-arg (cider--invert-prefix-arg current-prefix-arg))) - (call-interactively `cider-find-resource))))) - -(defun cider--invert-prefix-arg (arg) - "Invert the effect of prefix value ARG on `cider-prompt-for-symbol'. - -This function preserves the `other-window' meaning of ARG." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (16 -1) ; empty empty -> - - (-1 16) ; - -> empty empty - (4 nil) ; empty -> no-prefix - (_ 4)))) ; no-prefix -> empty - -(defun cider--prefix-invert-prompt-p (arg) - "Test prefix value ARG for its effect on `cider-prompt-for-symbol`." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (16 t) ; empty empty - (4 t) ; empty - (_ nil)))) - -(defun cider--prompt-for-symbol-p (&optional prefix) - "Check if cider should prompt for symbol. - -Tests againsts PREFIX and the value of `cider-prompt-for-symbol'. -Invert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be." - (if (cider--prefix-invert-prompt-p prefix) - (not cider-prompt-for-symbol) cider-prompt-for-symbol)) - -(defun cider-sync-request:ns-path (ns) - "Get the path to the file containing NS." - (thread-first (list "op" "ns-path" - "ns" ns) - cider-nrepl-send-sync-request - (nrepl-dict-get "path"))) - -(defun cider--find-ns (ns &optional other-window) - "Find the file containing NS's definition. -Optionally open it in a different window if OTHER-WINDOW is truthy." - (if-let ((path (cider-sync-request:ns-path ns))) - (cider-jump-to (cider-find-file path) nil other-window) - (user-error "Can't find %s" ns))) - -(defun cider-find-ns (&optional arg ns) - "Find the file containing NS. - -A prefix ARG of `-` or a double prefix argument causes -the results to be displayed in a different window." - (interactive "P") - (cider-ensure-connected) - (cider-ensure-op-supported "ns-path") - (if ns - (cider--find-ns ns) - (let* ((namespaces (cider-sync-request:ns-list)) - (ns (completing-read "Find namespace: " namespaces))) - (cider--find-ns ns (cider--open-other-window-p arg))))) - -(defvar cider-completion-last-context nil) - -(defun cider-completion-symbol-start-pos () - "Find the starting position of the symbol at point, unless inside a string." - (let ((sap (symbol-at-point))) - (when (and sap (not (nth 3 (syntax-ppss)))) - (car (bounds-of-thing-at-point 'symbol))))) - -(defun cider-completion-get-context-at-point () - "Extract the context at point. -If point is not inside the list, returns nil; otherwise return \"top-level\" -form, with symbol at point replaced by __prefix__." - (when (save-excursion - (condition-case _ - (progn - (up-list) - (check-parens) - t) - (scan-error nil) - (user-error nil))) - (save-excursion - (let* ((pref-end (point)) - (pref-start (cider-completion-symbol-start-pos)) - (context (cider-defun-at-point)) - (_ (beginning-of-defun)) - (expr-start (point))) - (concat (when pref-start (substring context 0 (- pref-start expr-start))) - "__prefix__" - (substring context (- pref-end expr-start))))))) - -(defun cider-completion-get-context () - "Extract context depending on `cider-completion-use-context' and major mode." - (let ((context (if (and cider-completion-use-context - ;; Important because `beginning-of-defun' and - ;; `ending-of-defun' work incorrectly in the REPL - ;; buffer, so context extraction fails there. - (derived-mode-p 'clojure-mode)) - (or (cider-completion-get-context-at-point) - "nil") - "nil"))) - (if (string= cider-completion-last-context context) - ":same" - (setq cider-completion-last-context context) - context))) - -(defun cider-completion--parse-candidate-map (candidate-map) - (let ((candidate (nrepl-dict-get candidate-map "candidate")) - (type (nrepl-dict-get candidate-map "type")) - (ns (nrepl-dict-get candidate-map "ns"))) - (put-text-property 0 1 'type type candidate) - (put-text-property 0 1 'ns ns candidate) - candidate)) - -(defun cider-complete (str) - "Complete STR with context at point." - (let* ((context (cider-completion-get-context)) - (candidates (cider-sync-request:complete str context))) - (mapcar #'cider-completion--parse-candidate-map candidates))) - -(defun cider-completion--get-candidate-type (symbol) - (let ((type (get-text-property 0 'type symbol))) - (or (cadr (assoc type cider-completion-annotations-alist)) - type))) - -(defun cider-completion--get-candidate-ns (symbol) - (when (or (eq 'always cider-completion-annotations-include-ns) - (and (eq 'unqualified cider-completion-annotations-include-ns) - (not (cider-namespace-qualified-p symbol)))) - (get-text-property 0 'ns symbol))) - -(defun cider-default-annotate-completion-function (type ns) - (concat (when ns (format " (%s)" ns)) - (when type (format " <%s>" type)))) - -(defun cider-annotate-symbol (symbol) - "Return a string suitable for annotating SYMBOL. - -If SYMBOL has a text property `type` whose value is recognised, its -abbreviation according to `cider-completion-annotations-alist' will be -used. If `type` is present but not recognised, its value will be used -unaltered. - -If SYMBOL has a text property `ns`, then its value will be used according -to `cider-completion-annotations-include-ns'. - -The formatting is performed by `cider-annotate-completion-function'." - (when cider-annotate-completion-candidates - (let* ((type (cider-completion--get-candidate-type symbol)) - (ns (cider-completion--get-candidate-ns symbol))) - (funcall cider-annotate-completion-function type ns)))) - -(defun cider-complete-at-point () - "Complete the symbol at point." - (when-let ((bounds (bounds-of-thing-at-point 'symbol))) - (when (and (cider-connected-p) - (not (or (cider-in-string-p) (cider-in-comment-p)))) - (list (car bounds) (cdr bounds) - (completion-table-dynamic #'cider-complete) - :annotation-function #'cider-annotate-symbol - :company-doc-buffer #'cider-create-doc-buffer - :company-location #'cider-company-location - :company-docsig #'cider-company-docsig)))) - -(defun cider-company-location (var) - "Open VAR's definition in a buffer. - -Returns the cons of the buffer itself and the location of VAR's definition -in the buffer." - (when-let ((info (cider-var-info var)) - (file (nrepl-dict-get info "file")) - (line (nrepl-dict-get info "line")) - (buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (cons buffer (point)))))) - -(defun cider-company-docsig (thing) - "Return signature for THING." - (let* ((eldoc-info (cider-eldoc-info thing)) - (ns (lax-plist-get eldoc-info "ns")) - (symbol (lax-plist-get eldoc-info "symbol")) - (arglists (lax-plist-get eldoc-info "arglists"))) - (when eldoc-info - (format "%s: %s" - (cider-eldoc-format-thing ns symbol thing - (cider-eldoc-thing-type eldoc-info)) - (cider-eldoc-format-arglist arglists 0))))) - -;; Fuzzy completion for company-mode - -(defun cider-company-unfiltered-candidates (string table predicate point) - "Return CIDER completion candidates as is, without filtering them by prefix." - (cider-complete string)) - -(add-to-list 'completion-styles-alist - '(cider - cider-company-unfiltered-candidates - cider-company-unfiltered-candidates - "CIDER backend-driven completion style.")) - -(defun cider-company-enable-fuzzy-completion () - "Enable backend-driven fuzzy completion in the current buffer." - (setq-local completion-styles '(cider))) - -(defun cider-stdin-handler (&optional buffer) - "Make a stdin response handler for BUFFER." - (nrepl-make-response-handler (or buffer (current-buffer)) - (lambda (buffer value) - (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)) - nil)) - -(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) - (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)))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (if beg - (cider--make-fringe-overlays-for-region beg end) - (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-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." - (nrepl-make-response-handler (or buffer (current-buffer)) - '() - ;; stdout handler - (lambda (buffer str) - (cider-emit-into-popup-buffer buffer (ansi-color-apply str))) - ;; stderr handler - (lambda (buffer str) - (cider-emit-into-popup-buffer buffer (ansi-color-apply str))) - '())) - -(defun cider-visit-error-buffer () - "Visit the `cider-error-buffer' (usually *cider-error*) if it exists." - (interactive) - (if-let ((buffer (get-buffer cider-error-buffer))) - (cider-popup-buffer-display buffer cider-auto-select-error-buffer) - (user-error "No %s buffer" cider-error-buffer))) - -(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) - (cider-make-popup-buffer cider-error-buffer mode))) - -(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 - (append - (list "op" "stacktrace") - (when (cider--pprint-fn) - (list "pprint-fn" (cider--pprint-fn))) - (when cider-stacktrace-print-length - (list "print-length" cider-stacktrace-print-length)) - (when cider-stacktrace-print-level - (list "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))))))))) - -(defun cider-need-input (buffer) - "Handle an need-input request from BUFFER." - (with-current-buffer buffer - (nrepl-request:stdin (concat (read-from-minibuffer "Stdin: ") "\n") - (cider-stdin-handler buffer) - (cider-current-connection)))) - -(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)))) - - -;;; Evaluation - -(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.") - -(defvar-local cider--ns-form-cache (make-hash-table :test 'equal) - "ns form cache for the current buffer. - -The cache is a hash where the keys are connection names and the values -are ns forms. This allows every connection to keep track of the ns -form independently.") - -(defun cider--cache-ns-form () - "Cache the form in the current buffer for the current connection." - (puthash (cider-current-connection) - (cider-ns-form) - cider--ns-form-cache)) - -(defun cider--cached-ns-form () - "Retrieve the cached ns form for the current buffer & connection." - (gethash (cider-current-connection) cider--ns-form-cache)) - -(defun cider--prep-interactive-eval (form) - "Prepare the environment for an interactive eval of FORM. - -If FORM is an ns-form, ensure that it is evaluated in the `user` -namespace. Otherwise, ensure the current ns declaration has been -evaluated (so that the ns containing FORM exists). - -Clears any compilation highlights and kills the error window." - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((cur-ns-form (cider-ns-form))) - (when (and cur-ns-form - (not (string= cur-ns-form (cider--cached-ns-form))) - (not (cider-ns-form-p form))) - ;; TODO: check for evaluation errors - (cider-eval-ns-form 'sync) - (cider--cache-ns-form)))) - -(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 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-connections #'ignore :any) - (cider--prep-interactive-eval form) - (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)))) - -(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 prefix) - "Evaluate the expression preceding point. -If invoked with a PREFIX argument, print the result in the current buffer." - (interactive "P") - (cider-interactive-eval nil - (when prefix (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 prefix) - "Evaluate the expression around point. -If invoked with a PREFIX argument, print the result in the current buffer." - (interactive "P") - (save-excursion - (goto-char (cadr (cider-sexp-at-point 'bounds))) - (cider-eval-last-sexp prefix))) - -(defun cider-eval-defun-to-comment (loc) - "Evaluate the \"top-level\" form and insert result as comment at LOC. - -With a prefix arg, LOC, insert before the form, otherwise afterwards." - (interactive "P") - (let* ((bounds (cider-defun-at-point 'bounds)) - (insertion-point (nth (if loc 0 1) bounds))) - (cider-interactive-eval nil - (cider-eval-print-with-comment-handler - (current-buffer) insertion-point ";; => ") - bounds))) - -(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-connection)) - (cider-last-sexp 'bounds)) - (when prefix - (cider-switch-to-repl-buffer))) - -(defun cider-pprint-eval-last-sexp-to-repl (&optional prefix) - "Evaluate the expression preceding point and insert its pretty-printed result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (let* ((conn-buffer (cider-current-connection))) - (cider-interactive-eval nil - (cider-insert-eval-handler conn-buffer) - (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)) - (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 () - "Evaluate the sexp preceding point and pprint its value in a popup buffer." - (interactive) - (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-pprint-eval-defun-at-point () - "Evaluate the \"top-level\" form at point and pprint its value in a popup buffer." - (interactive) - (cider--pprint-eval-form (cider-defun-at-point 'bounds))) - -(defun cider-eval-ns-form (&optional sync) - "Evaluate the current buffer's namespace form. - -When SYNC is true the form is evaluated synchronously, -otherwise it's evaluated interactively." - (interactive) - (when (clojure-find-ns) - (save-excursion - (goto-char (match-beginning 0)) - (if sync - ;; 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)) - (cider-nrepl-sync-request:eval (cider-defun-at-point))) - (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 (concat "(" fn-name ")"))) - (cider-read-and-eval (cons form (length form))))) - -;; Eval keymap - -(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 "v") #'cider-eval-sexp-at-point) - (define-key map (kbd ".") #'cider-read-and-eval-defun-at-point) - ;; 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-v") #'cider-eval-sexp-at-point) - (define-key map (kbd "C-.") #'cider-read-and-eval-defun-at-point))) - - -;; Connection and REPL - -(defun cider-insert-in-repl (form eval) - "Insert FORM in the REPL buffer and switch to it. -If EVAL is non-nil the form will also be evaluated." - (while (string-match "\\`[ \t\n\r]+\\|[ \t\n\r]+\\'" form) - (setq form (replace-match "" t t form))) - (with-current-buffer (cider-current-connection) - (goto-char (point-max)) - (let ((beg (point))) - (insert form) - (indent-region beg (point))) - (when eval - (cider-repl-return))) - (cider-switch-to-repl-buffer)) - -(defun cider-insert-last-sexp-in-repl (&optional arg) - "Insert the expression preceding point in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-last-sexp) arg)) - -(defun cider-insert-defun-in-repl (&optional arg) - "Insert the top-level form at point in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-defun-at-point) arg)) - -(defun cider-insert-region-in-repl (start end &optional arg) - "Insert the curent region in the REPL buffer. -START and END represent the region's boundaries. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "rP") - (cider-insert-in-repl - (buffer-substring-no-properties start end) arg)) - -(defun cider-insert-ns-form-in-repl (&optional arg) - "Insert the current buffer's ns form in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-ns-form) arg)) - -(defun cider-ping () - "Check that communication with the nREPL server works." - (interactive) - (thread-first (cider-nrepl-sync-request:eval "\"PONG\"") - (nrepl-dict-get "value") - (read) - (message))) - -(defun cider-enable-on-existing-clojure-buffers () - "Enable CIDER's minor mode on existing Clojure buffers. -See `cider-mode'." - (interactive) - (add-hook 'clojure-mode-hook #'cider-mode) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (cider-mode +1)))) - -(defun cider-disable-on-existing-clojure-buffers () - "Disable `cider-mode' on existing Clojure buffers. -See `cider-mode'." - (interactive) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (cider-mode -1)))) - -(defun cider-possibly-disable-on-existing-clojure-buffers () - "If not connected, disable `cider-mode' on existing Clojure buffers." - (unless (cider-connected-p) - (cider-disable-on-existing-clojure-buffers))) - - -;;; Completion - -(defun cider-sync-request:toggle-trace-var (symbol) - "Toggle var tracing for SYMBOL." - (thread-first (list "op" "toggle-trace-var" - "ns" (cider-current-ns) - "sym" symbol) - (cider-nrepl-send-sync-request))) - -(defun cider--toggle-trace-var (sym) - "Toggle var tracing for SYM." - (let* ((trace-response (cider-sync-request:toggle-trace-var sym)) - (var-name (nrepl-dict-get trace-response "var-name")) - (var-status (nrepl-dict-get trace-response "var-status"))) - (pcase var-status - ("not-found" (error "Var %s not found" (cider-propertize sym 'fn))) - ("not-traceable" (error "Var %s can't be traced because it's not bound to a function" (cider-propertize var-name 'fn))) - (_ (message "Var %s %s" (cider-propertize var-name 'fn) var-status))))) - -(defun cider-toggle-trace-var (arg) - "Toggle var tracing. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates." - (interactive "P") - (cider-ensure-op-supported "toggle-trace-var") - (funcall (cider-prompt-for-symbol-function arg) - "Toggle trace for var" - #'cider--toggle-trace-var)) - -(defun cider-sync-request:toggle-trace-ns (ns) - "Toggle namespace tracing for NS." - (thread-first (list "op" "toggle-trace-ns" - "ns" ns) - (cider-nrepl-send-sync-request))) - -(defun cider-toggle-trace-ns (query) - "Toggle ns tracing. -Defaults to the current ns. With prefix arg QUERY, prompts for a ns." - (interactive "P") - (cider-map-connections - (lambda (conn) - (with-current-buffer conn - (cider-ensure-op-supported "toggle-trace-ns") - (let ((ns (if query - (completing-read "Toggle trace for ns: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (let* ((trace-response (cider-sync-request:toggle-trace-ns ns)) - (ns-status (nrepl-dict-get trace-response "ns-status"))) - (pcase ns-status - ("not-found" (error "Namespace %s not found" (cider-propertize ns 'ns))) - (_ (message "Namespace %s %s" (cider-propertize ns 'ns) ns-status))))))) - :clj)) - -(defun cider-undef () - "Undefine a symbol from the current ns." - (interactive) - (cider-ensure-op-supported "undef") - (cider-read-symbol-name - "Undefine symbol: " - (lambda (sym) - (cider-nrepl-send-request - (list "op" "undef" - "ns" (cider-current-ns) - "symbol" sym) - (cider-interactive-eval-handler (current-buffer)))))) - -(defun cider-refresh--handle-response (response log-buffer) - (nrepl-dbind-response response (out err reloading status error error-ns after before) - (cl-flet* ((log (message &optional face) - (cider-emit-into-popup-buffer log-buffer message face)) - - (log-echo (message &optional face) - (log message face) - (unless cider-refresh-show-log-buffer - (let ((message-truncate-lines t)) - (message "cider-refresh: %s" message))))) - (cond - (out - (log out)) - - (err - (log err 'font-lock-warning-face)) - - ((member "invoking-before" status) - (log-echo (format "Calling %s\n" before) 'font-lock-string-face)) - - ((member "invoked-before" status) - (log-echo (format "Successfully called %s\n" before) 'font-lock-string-face)) - - ((member "invoked-not-resolved" status) - (log-echo "Could not resolve refresh function\n" 'font-lock-string-face)) - - (reloading - (log-echo (format "Reloading %s\n" reloading) 'font-lock-string-face)) - - ((member "reloading" (nrepl-dict-keys response)) - (log-echo "Nothing to reload\n" 'font-lock-string-face)) - - ((member "ok" status) - (log-echo "Reloading successful\n" 'font-lock-string-face)) - - (error-ns - (log-echo (format "Error reloading %s\n" error-ns) 'font-lock-warning-face)) - - ((member "invoking-after" status) - (log-echo (format "Calling %s\n" after) 'font-lock-string-face)) - - ((member "invoked-after" status) - (log-echo (format "Successfully called %s\n" after) 'font-lock-string-face)))) - - (with-selected-window (or (get-buffer-window cider-refresh-log-buffer) - (selected-window)) - (with-current-buffer cider-refresh-log-buffer - (goto-char (point-max)))) - - (when (member "error" status) - (cider--render-stacktrace-causes error)))) - -(defun cider-refresh (&optional mode) - "Reload modified and unloaded namespaces on the classpath. - -With a single prefix argument, or if MODE is `refresh-all', reload all -namespaces on the classpath unconditionally. - -With a double prefix argument, or if MODE is `clear', clear the state of -the namespace tracker before reloading. This is useful for recovering from -some classes of error (for example, those caused by circular dependencies) -that a normal reload would not otherwise recover from. The trade-off of -clearing is that stale code from any deleted files may not be completely -unloaded. - -With a negative prefix argument, or if MODE is `inhibit-fns', prevent any -refresh functions (defined in `cider-refresh-before-fn' and -`cider-refresh-after-fn') from being invoked." - (interactive "p") - (cider-ensure-connected) - (cider-ensure-op-supported "refresh") - (let ((clear? (member mode '(clear 16))) - (refresh-all? (member mode '(refresh-all 4))) - (inhibit-refresh-fns (member mode '(inhibit-fns -1)))) - (cider-map-connections - (lambda (conn) - ;; Inside the lambda, so the buffer is not created if we error out. - (let ((log-buffer (or (get-buffer cider-refresh-log-buffer) - (cider-make-popup-buffer cider-refresh-log-buffer)))) - (when cider-refresh-show-log-buffer - (cider-popup-buffer-display log-buffer)) - (when inhibit-refresh-fns - (cider-emit-into-popup-buffer log-buffer "inhibiting refresh functions\n")) - (when clear? - (cider-nrepl-send-sync-request (list "op" "refresh-clear") conn)) - (cider-nrepl-send-request - (append (list "op" (if refresh-all? "refresh-all" "refresh") - "print-length" cider-stacktrace-print-length - "print-level" cider-stacktrace-print-level) - (when (cider--pprint-fn) (list "pprint-fn" (cider--pprint-fn))) - (when (and (not inhibit-refresh-fns) cider-refresh-before-fn) - (list "before" cider-refresh-before-fn)) - (when (and (not inhibit-refresh-fns) cider-refresh-after-fn) - (list "after" cider-refresh-after-fn))) - (lambda (response) - (cider-refresh--handle-response response log-buffer)) - conn))) - :clj 'any-mode))) - -(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 or cljx file, and both a Clojure and -ClojureScript REPL exists for the project, it is evaluated in both REPLs." - (interactive) - (check-parens) - (cider-ensure-connected) - (setq buffer (or buffer (current-buffer))) - (with-current-buffer buffer - (unless buffer-file-name - (user-error "Buffer `%s' is not associated with a file" (current-buffer))) - (when (and cider-prompt-save-file-on-load - (buffer-modified-p) - (or (eq cider-prompt-save-file-on-load 'always-save) - (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) - (cider--cache-ns-form) - (let ((filename (buffer-file-name))) - (cider-map-connections - (lambda (connection) - (cider-request:load-file (cider-file-string filename) - (funcall cider-to-nrepl-filename-function - (cider--server-filename filename)) - (file-name-nondirectory filename) - connection)) - :both) - (message "Loading %s..." filename)))) - -(defun cider-load-file (filename) - "Load (eval) the Clojure file FILENAME in nREPL. - -If the file is a cljc or cljx 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) - (find-file filename) - (cider-load-buffer (current-buffer)))) - -(defalias 'cider-eval-file 'cider-load-file - "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--format-buffer (formatter) - "Format the contents of the current buffer. - -Uses FORMATTER, a function of one argument, to convert the string contents -of the buffer into a formatted string." - (let* ((original (substring-no-properties (buffer-string))) - (formatted (funcall formatter original))) - (unless (equal original formatted) - (erase-buffer) - (insert formatted)))) - -(defun cider-format-buffer () - "Format the Clojure code in the current buffer." - (interactive) - (cider-ensure-connected) - (cider--format-buffer #'cider-sync-request:format-code)) - -(defun cider-format-edn-buffer () - "Format the EDN data in the current buffer." - (interactive) - (cider-ensure-connected) - (cider--format-buffer (lambda (edn) - (cider-sync-request:format-edn edn (cider--pretty-print-width))))) - -(defun cider--format-reindent (formatted start) - "Reindent FORMATTED to align with buffer position START." - (let* ((start-column (save-excursion (goto-char start) (current-column))) - (indent-line (concat "\n" (make-string start-column ? )))) - (replace-regexp-in-string "\n" indent-line formatted))) - -(defun cider--format-region (start end formatter) - "Format the contents of the given region. - -START and END represent the region's boundaries. -FORMATTER is a function of one argument which is used to convert -the string contents of the region into a formatted string." - (let* ((original (buffer-substring-no-properties start end)) - (formatted (funcall formatter original)) - (indented (cider--format-reindent formatted start))) - (unless (equal original indented) - (delete-region start end) - (insert indented)))) - -(defun cider-format-region (start end) - "Format the Clojure code in the current region. -START and END represent the region's boundaries." - (interactive "r") - (cider-ensure-connected) - (cider--format-region start end #'cider-sync-request:format-code)) - -(defun cider-format-edn-region (start end) - "Format the EDN data in the current region. -START and END represent the region's boundaries." - (interactive "r") - (cider-ensure-connected) - (let* ((start-column (save-excursion (goto-char start) (current-column))) - (right-margin (- (cider--pretty-print-width) start-column))) - (cider--format-region start end - (lambda (edn) - (cider-sync-request:format-edn edn right-margin))))) - -(defun cider-format-defun () - "Format the code in the current defun." - (interactive) - (cider-ensure-connected) - (save-excursion - (mark-defun) - (cider-format-region (region-beginning) (region-end)))) - -;;; interrupt evaluation -(defun cider-interrupt-handler (buffer) - "Create an interrupt response handler for BUFFER." - (nrepl-make-response-handler buffer nil nil nil nil)) - -(defun cider-describe-nrepl-session () - "Describe an nREPL session." - (interactive) - (cider-ensure-connected) - (let ((selected-session (completing-read "Describe nREPL session: " (nrepl-sessions (cider-current-connection))))) - (when (and selected-session (not (equal selected-session ""))) - (let* ((session-info (nrepl-sync-request:describe (cider-current-connection))) - (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) - (session-id (nrepl-dict-get session-info "session")) - (session-type (cond - ((equal session-id (cider-current-session)) "Active eval") - ((equal session-id (cider-current-tooling-session)) "Active tooling") - (t "Unknown")))) - (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer) - (read-only-mode -1) - (insert (format "Session: %s\n" session-id) - (format "Type: %s session\n" session-type) - (format "Supported ops:\n")) - (mapc (lambda (op) (insert (format " * %s\n" op))) ops))) - (display-buffer cider-nrepl-session-buffer)))) - -(defun cider-close-nrepl-session () - "Close an nREPL session for the current connection." - (interactive) - (cider-ensure-connected) - (nrepl-sync-request:close (cider-current-connection)) - (message "Closed nREPL session")) - -;;; quiting -(defun cider--close-buffer (buffer) - "Close the BUFFER and kill its associated process (if any)." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when-let ((proc (get-buffer-process buffer))) - (when (process-live-p proc) - (when (or (not nrepl-server-buffer) - ;; Sync request will hang if the server is dead. - (process-live-p (get-buffer-process nrepl-server-buffer))) - (when (or nrepl-session nrepl-tooling-session) - (nrepl-sync-request:close buffer))) - (when proc (delete-process proc))))) - (kill-buffer buffer))) - -(defun cider-close-ancillary-buffers () - "Close buffers that are shared across connections." - (interactive) - (dolist (buf-name cider-ancillary-buffers) - (when (get-buffer buf-name) - (kill-buffer buf-name)))) - -(defun cider--quit-connection (conn) - "Quit the connection CONN." - (when conn - (cider--close-connection-buffer conn) - ;; clean the cached ns forms for this connection in all Clojure buffers - (dolist (clojure-buffer (cider-util--clojure-buffers)) - (with-current-buffer clojure-buffer - (remhash conn cider--ns-form-cache))))) - -(defun cider-quit (&optional quit-all) - "Quit the currently active CIDER connection. - -With a prefix argument QUIT-ALL the command will kill all connections -and all ancillary CIDER buffers." - (interactive "P") - (cider-ensure-connected) - (if (and quit-all (y-or-n-p "Are you sure you want to quit all CIDER connections? ")) - (progn - (dolist (connection cider-connections) - (cider--quit-connection connection)) - (message "All active nREPL connections were closed")) - (let ((connection (cider-current-connection))) - (when (y-or-n-p (format "Are you sure you want to quit the current CIDER connection %s? " - (cider-propertize (buffer-name connection) 'bold))) - (cider--quit-connection connection)))) - ;; if there are no more connections we can kill all ancillary buffers - (unless (cider-connected-p) - (cider-close-ancillary-buffers))) - -(defun cider--restart-connection (conn) - "Restart the connection CONN." - (let ((project-dir (with-current-buffer conn nrepl-project-dir)) - (buf-name (buffer-name conn)) - ;; save these variables before we kill the connection - (conn-creation-method (with-current-buffer conn cider-connection-created-with)) - (conn-endpoint (with-current-buffer conn nrepl-endpoint))) - (cider--quit-connection conn) - ;; Workaround for a nasty race condition https://github.com/clojure-emacs/cider/issues/439 - ;; TODO: Find a better way to ensure `cider-quit' has finished - (message "Waiting for CIDER connection %s to quit..." - (cider-propertize buf-name 'bold)) - (sleep-for 2) - (pcase conn-creation-method - (`connect (apply #'cider-connect conn-endpoint)) - (`jack-in (if project-dir - (let ((default-directory project-dir)) - (cider-jack-in)) - (error "Can't restart CIDER connection for unknown project"))) - (_ (error "Unexpected value %S for `cider-connection-created-with'" - conn-creation-method))))) - -(defun cider-restart (&optional restart-all) - "Restart the currently active CIDER connection. -If RESTART-ALL is t, then restarts all connections." - (interactive "P") - (cider-ensure-connected) - (if restart-all - (dolist (conn cider-connections) - (cider--restart-connection conn)) - (cider--restart-connection (cider-current-connection)))) - -(defvar cider--namespace-history nil - "History of user input for namespace prompts.") - -(defun cider--var-namespace (var) - "Return the namespace of VAR. -VAR is a fully qualified Clojure variable name as a string." - (replace-regexp-in-string "\\(?:#'\\)?\\(.*\\)/.*" "\\1" var)) - -(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)))) - -(defun cider-run (&optional function) - "Run -main or FUNCTION, prompting for its namespace if necessary. -With a prefix argument, prompt for function to run instead of -main." - (interactive (list (when current-prefix-arg (read-string "Function name: ")))) - (cider-ensure-connected) - (let ((name (or function "-main"))) - (when-let ((response (cider-nrepl-send-sync-request - (list "op" "ns-list-vars-by-name" "name" name)))) - (if-let ((vars (split-string (substring (nrepl-dict-get response "var-list") 1 -1)))) - (cider-interactive-eval - (if (= (length vars) 1) - (concat "(" (car vars) ")") - (let* ((completions (mapcar #'cider--var-namespace vars)) - (def (or (car cider--namespace-history) - (car completions)))) - (format "(#'%s/%s)" - (completing-read (format "Namespace (%s): " def) - completions nil t nil - 'cider--namespace-history def) - name)))) - (user-error "No %s var defined in any namespace" (cider-propertize name 'fn)))))) - -(provide 'cider-interaction) - -;;; cider-interaction.el ends here diff --git a/elpa/cider-20170129.1941/cider-pkg.el b/elpa/cider-20170129.1941/cider-pkg.el deleted file mode 100644 index 77fcff34..00000000 --- a/elpa/cider-20170129.1941/cider-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -(define-package "cider" "20170129.1941" "Clojure Interactive Development Environment that Rocks" - '((emacs "24.4") - (clojure-mode "5.6.0") - (pkg-info "0.4") - (queue "0.1.1") - (spinner "1.7") - (seq "2.16")) - :url "http://www.github.com/clojure-emacs/cider" :keywords - '("languages" "clojure" "cider")) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/cider-20170129.1941/cider.el b/elpa/cider-20170129.1941/cider.el deleted file mode 100644 index c46e02a1..00000000 --- a/elpa/cider-20170129.1941/cider.el +++ /dev/null @@ -1,885 +0,0 @@ -;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell -;; Maintainer: Bozhidar Batsov -;; URL: http://www.github.com/clojure-emacs/cider -;; Version: 0.15.0-snapshot -;; Package-Requires: ((emacs "24.4") (clojure-mode "5.6.0") (pkg-info "0.4") (queue "0.1.1") (spinner "1.7") (seq "2.16")) -;; Keywords: languages, clojure, cider - -;; 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 . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides a Clojure interactive development environment for Emacs, built on -;; top of nREPL. - -;;; Installation: - -;; Available as a package in melpa.org and stable.melpa.org - -;; (add-to-list 'package-archives -;; '("melpa" . "https://melpa.org/packages/")) -;; -;; or -;; -;; (add-to-list 'package-archives -;; '("melpa-stable" . "https://stable.melpa.org/packages/") t) -;; -;; M-x package-install cider - -;;; Usage: - -;; M-x cider-jack-in - -;;; Code: - -(defgroup cider nil - "Clojure Interactive Development Environment that Rocks." - :prefix "cider-" - :group 'applications - :link '(url-link :tag "GitHub" "https://github.com/clojure-emacs/cider") - :link '(url-link :tag "Online Manual" "https://cider.readthedocs.org") - :link '(emacs-commentary-link :tag "Commentary" "cider")) - -(defcustom cider-prompt-for-project-on-connect 'when-needed - "Controls whether to prompt for associated project on `cider-connect'. - -When set to when-needed, the project will be derived from the buffer you're -visiting, when invoking `cider-connect'. -When set to t, you'll always to prompted to select the matching project. -When set to nil, you'll never be prompted to select a project and no -project inference will take place." - :type '(choice (const :tag "always" t) - (const when-needed) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(require 'cider-client) -(require 'cider-eldoc) -(require 'cider-repl) -(require 'cider-mode) -(require 'cider-common) -(require 'subr-x) -(require 'cider-compat) -(require 'cider-debug) -(require 'tramp-sh) -(require 'cider-repl-history) - -(require 'seq) - -(defconst cider-version "0.15.0-snapshot" - "Fallback version used when it cannot be extracted automatically. -Normally it won't be used, unless `pkg-info' fails to extract the -version from the CIDER package or library.") - -(defconst cider-codename "London" - "Codename used to denote stable releases.") - -(defcustom cider-lein-command - "lein" - "The command used to execute Leiningen." - :type 'string - :group 'cider) - -(defcustom cider-lein-global-options - nil - "Command global options used to execute Leiningen (e.g.: -o for offline)." - :type 'string - :group 'cider) - -(defcustom cider-lein-parameters - "repl :headless" - "Params passed to Leiningen to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider) - -(defcustom cider-boot-command - "boot" - "The command used to execute Boot." - :type 'string - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-boot-global-options - nil - "Command global options used to execute Boot (e.g.: -c for checkouts)." - :type 'string - :group 'cider - :package-version '(cider . "0.14.0")) - -(defcustom cider-boot-parameters - "repl -s wait" - "Params passed to boot to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-gradle-command - "gradle" - "The command used to execute Gradle." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-gradle-global-options - "--no-daemon" - "Command line options used to execute Gradle (e.g.: -m for dry run)." - :type 'string - :group 'cider - :package-version '(cider . "0.14.0")) - -(defcustom cider-gradle-parameters - "clojureRepl" - "Params passed to gradle to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-default-repl-command - "lein" - "The default command and parameters to use when connecting to nREPL. -This value will only be consulted when no identifying file types, i.e. -project.clj for leiningen or build.boot for boot, could be found." - :type 'string - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-preferred-build-tool - nil - "Allow choosing a build system when there are many. -When there are artifacts from multiple build systems (\"lein\", \"boot\", -\"gradle\") the user is prompted to select one of them. When non-nil, this -variable will suppress this behavior and will select whatever build system -is indicated by the variable if present. Note, this is only when CIDER -cannot decide which of many build systems to use and will never override a -command when there is no ambiguity." - :type '(choice (const "lein") - (const "boot") - (const "gradle") - (const :tag "Always ask" nil)) - :group 'cider - :package-version '(cider . "0.13.0")) - -(defcustom cider-allow-jack-in-without-project 'warn - "Controls what happens when doing `cider-jack-in' outside a project. -When set to 'warn you'd prompted to confirm the command. -When set to t `cider-jack-in' will quietly continue. -When set to nil `cider-jack-in' will fail." - :type '(choice (const :tag "always" t) - (const 'warn) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.15.0")) - -(defcustom cider-known-endpoints nil - "A list of connection endpoints where each endpoint is a list. -For example: \\='((\"label\" \"host\" \"port\")). -The label is optional so that \\='(\"host\" \"port\") will suffice. -This variable is used by `cider-connect'." - :type '(repeat (list (string :tag "label") - (string :tag "host") - (string :tag "port"))) - :group 'cider) - -(defcustom cider-connected-hook nil - "List of functions to call when connected to Clojure nREPL server." - :type 'hook - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-disconnected-hook nil - "List of functions to call when disconnected from the Clojure nREPL server." - :type 'hook - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-auto-mode t - "When non-nil, automatically enable `cider-mode' for all Clojure buffers." - :type 'boolean - :package-version '(cider . "0.9.0")) - -(defcustom cider-inject-dependencies-at-jack-in t - "When nil, do not inject repl dependencies (most likely nREPL middlewares) at `cider-jack-in' time." - :type 'boolean - :version '(cider . "0.11.0")) - -(defvar cider-ps-running-nrepls-command "ps u | grep leiningen" - "Process snapshot command used in `cider-locate-running-nrepl-ports'.") - -(defvar cider-ps-running-nrepl-path-regexp-list - '("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D" - "\\(?:-classpath +:?\\(.+?\\)/self-installs\\)") - "Regexp list to get project paths. -Extract project paths from output of `cider-ps-running-nrepls-command'. -Sub-match 1 must be the project path.") - -(defvar cider-host-history nil - "Completion history for connection hosts.") - -;;;###autoload -(defun cider-version () - "Display CIDER's version." - (interactive) - (message "CIDER %s" (cider--version))) - -(defun cider-jack-in-command (project-type) - "Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE." - (pcase project-type - ("lein" cider-lein-command) - ("boot" cider-boot-command) - ("gradle" cider-gradle-command) - (_ (user-error "Unsupported project type `%s'" project-type)))) - -(defun cider-jack-in-resolve-command (project-type) - "Determine the resolved file path to `cider-jack-in-command' if it can be -found for the PROJECT-TYPE" - (pcase project-type - ("lein" (cider--lein-resolve-command)) - ("boot" (cider--boot-resolve-command)) - ("gradle" (cider--gradle-resolve-command)) - (_ (user-error "Unsupported project type `%s'" project-type)))) - -(defun cider-jack-in-global-options (project-type) - "Determine the command line options for `cider-jack-in' for the PROJECT-TYPE." - (pcase project-type - ("lein" cider-lein-global-options) - ("boot" cider-boot-global-options) - ("gradle" cider-gradle-global-options) - (_ (user-error "Unsupported project type `%s'" project-type)))) - -(defun cider-jack-in-params (project-type) - "Determine the commands params for `cider-jack-in' for the PROJECT-TYPE." - (pcase project-type - ("lein" cider-lein-parameters) - ("boot" cider-boot-parameters) - ("gradle" cider-gradle-parameters) - (_ (user-error "Unsupported project type `%s'" project-type)))) - - -;;; Jack-in dependencies injection -(defvar cider-jack-in-dependencies nil - "List of dependencies where elements are lists of artifact name and version.") -(put 'cider-jack-in-dependencies 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-dependencies - "org.clojure/tools.nrepl" "0.2.12") - -(defvar cider-jack-in-dependencies-exclusions nil - "List of exclusions for jack in dependencies. - -Elements of the list are artifact name and list of exclusions to apply for the artifact.") -(put 'cider-jack-in-dependencies-exclusions 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-dependencies-exclusions - "org.clojure/tools.nrepl" '("org.clojure/clojure")) - -(defcustom cider-jack-in-auto-inject-clojure nil - "Version of clojure to auto-inject into REPL. - -If nil, do not inject Clojure into the REPL. If `latest', inject -`cider-latest-clojure-version', which should approximate to the most recent -version of Clojure. If `minimal', inject `cider-minimum-clojure-version', -which will be the lowest version CIDER supports. If a string, use this as -the version number. If it is a list, the first element should be a string, -specifying the artifact ID, and the second element the version number." - :type '(choice (const :tag "None" nil) - (const :tag "Latest" 'latest) - (const :tag "Minimal" 'minimal) - (string :tag "Specific Version") - (list :tag "Artifact ID and Version" - (string :tag "Artifact ID") - (string :tag "Version")))) - -(defvar cider-jack-in-lein-plugins nil - "List of Leiningen plugins where elements are lists of artifact name and version.") -(put 'cider-jack-in-lein-plugins 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-lein-plugins - "cider/cider-nrepl" (upcase cider-version)) - -(defvar cider-jack-in-nrepl-middlewares nil - "List of Clojure variable names. -Each of these Clojure variables should hold a vector of nREPL middlewares.") -(put 'cider-jack-in-nrepl-middlewares 'risky-local-variable t) -(add-to-list 'cider-jack-in-nrepl-middlewares "cider.nrepl/cider-middleware") - -(defun cider--list-as-boot-artifact (list) - "Return a boot artifact string described by the elements of LIST. -LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). The returned -string is quoted for passing as argument to an inferior shell." - (concat "-d " (shell-quote-argument (format "%s:%s" (car list) (cadr list))))) - -(defun cider-boot-dependencies (dependencies) - "Return a list of boot artifact strings created from DEPENDENCIES." - (concat (mapconcat #'cider--list-as-boot-artifact dependencies " ") - (when (not (seq-empty-p dependencies)) " "))) - -(defun cider-boot-middleware-task (params middlewares) - (concat "cider.tasks/add-middleware " - (mapconcat (lambda (middleware) - (format "-m %s" (shell-quote-argument middleware))) - middlewares - " ") - " " params)) - -(defun cider-boot-jack-in-dependencies (global-opts params dependencies plugins middlewares) - (concat global-opts - (when (not (seq-empty-p global-opts)) " ") - "-i \"(require 'cider.tasks)\" " ;; Note the white space at the end here - (cider-boot-dependencies (append dependencies plugins)) - (cider-boot-middleware-task params middlewares))) - -(defun cider--lein-artifact-exclusions (exclusions) - "Return an exclusions vector described by the elements of EXCLUSIONS." - (if exclusions - (format " :exclusions [%s]" (mapconcat #'identity exclusions " ")) - "")) - -(defun cider--list-as-lein-artifact (list &optional exclusions) - "Return an artifact string described by the elements of LIST. -LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). Optionally a list -of EXCLUSIONS can be provided as well. The returned -string is quoted for passing as argument to an inferior shell." - (shell-quote-argument (format "[%s %S%s]" (car list) (cadr list) (cider--lein-artifact-exclusions exclusions)))) - -(defun cider-lein-jack-in-dependencies (global-opts params dependencies dependencies-exclusions lein-plugins) - (concat - global-opts - (when (not (seq-empty-p global-opts)) " ") - (mapconcat #'identity - (append (seq-map (lambda (dep) - (let ((exclusions (cadr (assoc (car dep) dependencies-exclusions)))) - (concat "update-in :dependencies conj " - (cider--list-as-lein-artifact dep exclusions)))) - dependencies) - (seq-map (lambda (plugin) - (concat "update-in :plugins conj " - (cider--list-as-lein-artifact plugin))) - lein-plugins)) - " -- ") - " -- " - params)) - -(defun cider-add-clojure-dependencies-maybe (dependencies) - "Return DEPENDENCIES with an added Clojure dependency if requested. - -See also `cider-jack-in-auto-inject-clojure'." - (if cider-jack-in-auto-inject-clojure - (if (consp cider-jack-in-auto-inject-clojure) - (cons cider-jack-in-auto-inject-clojure dependencies) - (cons (list cider-clojure-artifact-id - (cond - ((stringp cider-jack-in-auto-inject-clojure) - cider-jack-in-auto-inject-clojure) - ((eq cider-jack-in-auto-inject-clojure 'minimal) - cider-minimum-clojure-version) - ((eq cider-jack-in-auto-inject-clojure 'latest) - cider-latest-clojure-version))) - dependencies)) - dependencies)) - -(defun cider-inject-jack-in-dependencies (global-opts params project-type) - "Return PARAMS with injected REPL dependencies. -These are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' and -`cider-jack-in-nrepl-middlewares' are injected from the CLI according to -the used PROJECT-TYPE. Eliminates the need for hacking profiles.clj or the -boot script for supporting cider with its nREPL middleware and -dependencies." - (pcase project-type - ("lein" (cider-lein-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - cider-jack-in-dependencies-exclusions - cider-jack-in-lein-plugins)) - ("boot" (cider-boot-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - cider-jack-in-lein-plugins - cider-jack-in-nrepl-middlewares)) - ("gradle" (concat - global-opts - (when (not (seq-empty-p global-opts)) " ") - params)) - (_ (error "Unsupported project type `%s'" project-type)))) - - -;;; ClojureScript REPL creation -(defconst cider--cljs-repl-types - '(("(cemerick.piggieback/cljs-repl (cljs.repl.rhino/repl-env))" - "Rhino" "") - ("(do (require 'figwheel-sidecar.repl-api) (figwheel-sidecar.repl-api/start-figwheel!) (figwheel-sidecar.repl-api/cljs-repl))" - "Figwheel-sidecar" " (add figwheel-sidecar to your plugins)") - ("(do (require 'cljs.repl.node) (cemerick.piggieback/cljs-repl (cljs.repl.node/repl-env)))" - "Node" " (requires NodeJS to be installed)") - ("(do (require 'weasel.repl.websocket) (cemerick.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \"127.0.0.1\" :port 9001)))" - "Weasel" " (see http://cider.readthedocs.io/en/latest/up_and_running/#browser-connected-clojurescript-repl)") - ("(do (require 'adzerk.boot-cljs-repl) (adzerk.boot-cljs-repl/start-repl))" - "Boot-cljs-repl" " (see https://github.com/adzerk-oss/boot-cljs-repl/blob/master/README.md"))) - -(defcustom cider-cljs-lein-repl "(cemerick.piggieback/cljs-repl (cljs.repl.rhino/repl-env))" - "Clojure form that returns a ClojureScript REPL environment. -This is only used in lein projects. It is evaluated in a Clojure REPL and -it should start a ClojureScript REPL." - :type `(choice ,@(seq-map (lambda (x) `(const :tag ,(apply #'concat (cdr x)) ,(car x))) - cider--cljs-repl-types) - (string :tag "Custom")) - :safe (lambda (x) (assoc x cider--cljs-repl-types)) - :package-version '(cider . "0.11.0") - :group 'cider) - -(defcustom cider-cljs-boot-repl "(do (require 'adzerk.boot-cljs-repl) (adzerk.boot-cljs-repl/start-repl))" - "Clojure form that returns a ClojureScript REPL environment. -This is only used in boot projects. It is evaluated in a Clojure REPL and -it should start a ClojureScript REPL." - :type `(choice ,@(seq-map (lambda (x) `(const :tag ,(apply #'concat (cdr x)) ,(car x))) - cider--cljs-repl-types) - (string :tag "Custom")) - :safe (lambda (x) (assoc x cider--cljs-repl-types)) - :package-version '(cider . "0.15.0") - :group 'cider) - -(defcustom cider-cljs-gradle-repl "(cemerick.piggieback/cljs-repl (cljs.repl.rhino/repl-env))" - "Clojure form that returns a ClojureScript REPL environment. -This is only used in gradle projects. It is evaluated in a Clojure REPL and -it should start a ClojureScript REPL." - :type `(choice ,@(seq-map (lambda (x) `(const :tag ,(apply #'concat (cdr x)) ,(car x))) - cider--cljs-repl-types) - (string :tag "Custom")) - :safe (lambda (x) (assoc x cider--cljs-repl-types)) - :package-version '(cider . "0.15.0") - :group 'cider) - -(defun cider-cljs-repl-form (project-type) - "Return a Clojure form that returns a ClojureScript REPL environment -based on PROJECT-TYPE." - (pcase project-type - ("lein" cider-cljs-lein-repl) - ("boot" cider-cljs-boot-repl) - ("gradle" cider-cljs-gradle-repl) - (_ (error "Unsupported project type `%s'" project-type)))) - -(defun cider--offer-to-open-app-in-browser (server-buffer) - "Look for a server address in SERVER-BUFFER and offer to open it." - (when (buffer-live-p server-buffer) - (with-current-buffer server-buffer - (save-excursion - (goto-char (point-min)) - (when-let ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror) - (match-string 0)))) - (when (y-or-n-p (format "Visit ‘%s’ in a browser? " url)) - (browse-url url))))))) - -(defun cider-create-sibling-cljs-repl (client-buffer) - "Create a ClojureScript REPL with the same server as CLIENT-BUFFER. -The new buffer will correspond to the same project as CLIENT-BUFFER, which -should be the regular Clojure REPL started by the server process filter." - (interactive (list (cider-current-connection))) - (let* ((nrepl-repl-buffer-name-template "*cider-repl CLJS%s*") - (nrepl-create-client-buffer-function #'cider-repl-create) - (nrepl-use-this-as-repl-buffer 'new) - (client-process-args (with-current-buffer client-buffer - (unless (or nrepl-server-buffer nrepl-endpoint) - (error "This is not a REPL buffer, is there a REPL active?")) - (list (car nrepl-endpoint) - (elt nrepl-endpoint 1) - (when (buffer-live-p nrepl-server-buffer) - (get-buffer-process nrepl-server-buffer))))) - (cljs-proc (apply #'nrepl-start-client-process client-process-args)) - (cljs-buffer (process-buffer cljs-proc)) - (cljs-repl-form (cider-cljs-repl-form (cider-project-type)))) - (with-current-buffer cljs-buffer - ;; The new connection has now been bumped to the top, but it's still a - ;; Clojure REPL! Additionally, some ClojureScript REPLs can actually take - ;; a while to start (some even depend on the user opening a browser). - ;; Meanwhile, this REPL will gladly receive requests in place of the - ;; original Clojure REPL. Our solution is to bump the original REPL back - ;; up the list, so it takes priority on Clojure requests. - (cider-make-connection-default client-buffer) - (pcase (assoc cljs-repl-form cider--cljs-repl-types) - (`(,_ ,name ,info) - (message "Starting a %s REPL%s" name (or info ""))) - (_ (message "Starting a custom ClojureScript REPL"))) - (cider-nrepl-send-request - (list "op" "eval" - "ns" (cider-current-ns) - "code" cljs-repl-form) - (cider-repl-handler (current-buffer))) - (cider--offer-to-open-app-in-browser nrepl-server-buffer)))) - -(defun cider--select-zombie-buffer (repl-buffers) - "Return a zombie buffer from REPL-BUFFERS, or nil if none exists." - (when-let ((zombie-buffs (seq-remove #'get-buffer-process repl-buffers))) - (when (y-or-n-p - (format "Zombie REPL buffers exist (%s). Reuse? " - (mapconcat #'buffer-name zombie-buffs ", "))) - (if (= (length zombie-buffs) 1) - (car zombie-buffs) - (completing-read "Choose REPL buffer: " - (mapcar #'buffer-name zombie-buffs) - nil t))))) - -(defun cider-find-reusable-repl-buffer (endpoint project-directory) - "Check whether a reusable connection buffer already exists. -Looks for buffers where `nrepl-endpoint' matches ENDPOINT, or -`nrepl-project-dir' matches PROJECT-DIRECTORY. If such a buffer was found, -and has no process, return it. If the process is alive, ask the user for -confirmation and return 'new/nil for y/n answer respectively. If other -REPL buffers with dead process exist, ask the user if any of those should -be reused." - (if-let ((repl-buffers (cider-repl-buffers)) - (exact-buff (seq-find - (lambda (buff) - (with-current-buffer buff - (or (and endpoint - (equal endpoint nrepl-endpoint)) - (and project-directory - (equal project-directory nrepl-project-dir))))) - repl-buffers))) - (if (get-buffer-process exact-buff) - (when (y-or-n-p (format "REPL buffer already exists (%s). \ -Do you really want to create a new one? " - exact-buff)) - 'new) - exact-buff) - (or (cider--select-zombie-buffer repl-buffers) 'new))) - -;;;###autoload -(defun cider-jack-in (&optional prompt-project cljs-too) - "Start an nREPL server for the current project and connect to it. -If PROMPT-PROJECT is t, then prompt for the project for which to -start the server. -If CLJS-TOO is non-nil, also start a ClojureScript REPL session with its -own buffer." - (interactive "P") - (setq cider-current-clojure-buffer (current-buffer)) - (let* ((project-type (cider-project-type)) - (command (cider-jack-in-command project-type)) - (command-resolved (cider-jack-in-resolve-command project-type)) - (command-global-opts (cider-jack-in-global-options project-type)) - (command-params (cider-jack-in-params project-type))) - (if command-resolved - (let* ((project (when prompt-project - (read-directory-name "Project: "))) - (project-dir (clojure-project-dir - (or project (cider-current-dir)))) - (params (if prompt-project - (read-string (format "nREPL server command: %s " - command-params) - command-params) - command-params)) - (params (if cider-inject-dependencies-at-jack-in - (cider-inject-jack-in-dependencies command-global-opts params project-type) - params)) - - (cmd (format "%s %s" command-resolved params))) - (if (or project-dir cider-allow-jack-in-without-project) - (progn - (when (or project-dir - (eq cider-allow-jack-in-without-project t) - (and (null project-dir) - (eq cider-allow-jack-in-without-project 'warn) - (y-or-n-p "Are you sure you want to run `cider-jack-in' without a Clojure project? "))) - (when-let ((repl-buff (cider-find-reusable-repl-buffer nil project-dir))) - (let ((nrepl-create-client-buffer-function #'cider-repl-create) - (nrepl-use-this-as-repl-buffer repl-buff)) - (nrepl-start-server-process - project-dir cmd - (when cljs-too #'cider-create-sibling-cljs-repl)))))) - (user-error "`cider-jack-in' is not allowed without a Clojure project"))) - (user-error "The %s executable isn't on your `exec-path'" command)))) - -;;;###autoload -(defun cider-jack-in-clojurescript (&optional prompt-project) - "Start an nREPL server and connect to it both Clojure and ClojureScript REPLs. -If PROMPT-PROJECT is t, then prompt for the project for which to -start the server." - (interactive "P") - (cider-jack-in prompt-project 'cljs-too)) - -;;;###autoload -(defun cider-connect (host port &optional project-dir) - "Connect to an nREPL server identified by HOST and PORT. -Create REPL buffer and start an nREPL client connection. - -When the optional param PROJECT-DIR is present, the connection -gets associated with it." - (interactive (cider-select-endpoint)) - (setq cider-current-clojure-buffer (current-buffer)) - (when-let ((repl-buff (cider-find-reusable-repl-buffer `(,host ,port) nil))) - (let* ((nrepl-create-client-buffer-function #'cider-repl-create) - (nrepl-use-this-as-repl-buffer repl-buff) - (conn (process-buffer (nrepl-start-client-process host port)))) - (with-current-buffer conn - (setq cider-connection-created-with 'connect)) - (if project-dir - (cider-assoc-project-with-connection project-dir conn) - (let ((project-dir (clojure-project-dir))) - (cond - ;; associate only if we're in a project - ((and project-dir (null cider-prompt-for-project-on-connect)) (cider-assoc-project-with-connection project-dir conn)) - ;; associate if we're in a project, prompt otherwise - ((eq cider-prompt-for-project-on-connect 'when-needed) (cider-assoc-project-with-connection project-dir conn)) - ;; always prompt - (t (cider-assoc-project-with-connection nil conn)))))))) - -(defun cider-current-host () - "Retrieve the current host." - (if (and (stringp buffer-file-name) - (file-remote-p buffer-file-name)) - tramp-current-host - "localhost")) - -(defun cider-select-endpoint () - "Interactively select the host and port to connect to." - (dolist (endpoint cider-known-endpoints) - (unless (stringp (or (nth 2 endpoint) - (nth 1 endpoint))) - (user-error "The port for %s in `cider-known-endpoints' should be a string" - (nth 0 endpoint)))) - (let* ((ssh-hosts (cider--ssh-hosts)) - (hosts (seq-uniq (append (when cider-host-history - ;; history elements are strings of the form "host:port" - (list (split-string (car cider-host-history) ":"))) - (list (list (cider-current-host))) - cider-known-endpoints - ssh-hosts - (when (file-remote-p default-directory) - ;; add localhost even in remote buffers - '(("localhost")))))) - (sel-host (cider--completing-read-host hosts)) - (host (car sel-host)) - (port (or (cadr sel-host) - (cider--completing-read-port host (cider--infer-ports host ssh-hosts))))) - (list host port))) - -(defun cider--ssh-hosts () - "Retrieve all ssh host from local configuration files." - (seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s))) - (let ((tramp-completion-mode t)) - (tramp-completion-handle-file-name-all-completions "" "/ssh:")))) - -(defun cider--completing-read-host (hosts) - "Interactively select host from HOSTS. -Each element in HOSTS is one of: (host), (host port) or (label host port). -Return a list of the form (HOST PORT), where PORT can be nil." - (let* ((hosts (cider-join-into-alist hosts)) - (sel-host (completing-read "Host: " hosts nil nil nil - 'cider-host-history (caar hosts))) - (host (or (cdr (assoc sel-host hosts)) (list sel-host)))) - ;; remove the label - (if (= 3 (length host)) (cdr host) host))) - -(defun cider--infer-ports (host ssh-hosts) - "Infer nREPL ports on HOST. -Return a list of elements of the form (directory port). SSH-HOSTS is a list -of remote SSH hosts." - (let ((localp (or (nrepl-local-host-p host) - (not (assoc-string host ssh-hosts))))) - (if localp - ;; change dir: current file might be remote - (let* ((change-dir-p (file-remote-p default-directory)) - (default-directory (if change-dir-p "~/" default-directory))) - (cider-locate-running-nrepl-ports (unless change-dir-p default-directory))) - (let ((vec (vector "sshx" nil host "" nil)) - ;; change dir: user might want to connect to a different remote - (dir (when (file-remote-p default-directory) - (with-parsed-tramp-file-name default-directory cur - (when (string= cur-host host) default-directory))))) - (tramp-maybe-open-connection vec) - (with-current-buffer (tramp-get-connection-buffer vec) - (cider-locate-running-nrepl-ports dir)))))) - -(defun cider--completing-read-port (host ports) - "Interactively select port for HOST from PORTS." - (let* ((ports (cider-join-into-alist ports)) - (sel-port (completing-read (format "Port for %s: " host) ports - nil nil nil nil (caar ports))) - (port (or (cdr (assoc sel-port ports)) sel-port)) - (port (if (listp port) (cadr port) port))) - (if (stringp port) (string-to-number port) port))) - -(defun cider-locate-running-nrepl-ports (&optional dir) - "Locate ports of running nREPL servers. -When DIR is non-nil also look for nREPL port files in DIR. Return a list -of list of the form (project-dir port)." - (let* ((paths (cider--running-nrepl-paths)) - (proj-ports (mapcar (lambda (d) - (when-let ((port (and d (nrepl-extract-port (cider--file-path d))))) - (list (file-name-nondirectory (directory-file-name d)) port))) - (cons (clojure-project-dir dir) paths)))) - (seq-uniq (delq nil proj-ports)))) - -(defun cider--running-nrepl-paths () - "Retrieve project paths of running nREPL servers. -Use `cider-ps-running-nrepls-command' and `cider-ps-running-nrepl-path-regexp-list'." - (let (paths) - (with-temp-buffer - (insert (shell-command-to-string cider-ps-running-nrepls-command)) - (dolist (regexp cider-ps-running-nrepl-path-regexp-list) - (goto-char 1) - (while (re-search-forward regexp nil t) - (setq paths (cons (match-string 1) paths))))) - (seq-uniq paths))) - -(defun cider--identify-buildtools-present () - "Identify build systems present by their build files." - (let* ((default-directory (clojure-project-dir (cider-current-dir))) - (build-files '(("lein" . "project.clj") - ("boot" . "build.boot") - ("gradle" . "build.gradle")))) - (delq nil - (mapcar (lambda (candidate) - (when (file-exists-p (cdr candidate)) - (car candidate))) - build-files)))) - -(defun cider-project-type () - "Determine the type, either leiningen, boot or gradle, of the current project. -If more than one project file types are present, check for a preferred -build tool in `cider-preferred-build-tool', otherwise prompt the user to -choose." - (let* ((choices (cider--identify-buildtools-present)) - (multiple-project-choices (> (length choices) 1)) - (default (car choices))) - (cond ((and multiple-project-choices - (member cider-preferred-build-tool choices)) - cider-preferred-build-tool) - (multiple-project-choices - (completing-read (format "Which command should be used (default %s): " default) - choices nil t nil nil default)) - (choices - (car choices)) - (t cider-default-repl-command)))) - - -;; TODO: Implement a check for `cider-lein-command' over tramp -(defun cider--lein-resolve-command () - "Find `cider-lein-command' on `exec-path' if possible, or return `nil'. - -In case `default-directory' is non-local we assume the command is available." - (when-let ((command (or (and (file-remote-p default-directory) cider-lein-command) - (executable-find cider-lein-command) - (executable-find (concat cider-lein-command ".bat"))))) - (shell-quote-argument command))) - -;; TODO: Implement a check for `cider-boot-command' over tramp -(defun cider--boot-resolve-command () - "Find `cider-boot-command' on `exec-path' if possible, or return `nil'. - -In case `default-directory' is non-local we assume the command is available." - (when-let ((command (or (and (file-remote-p default-directory) cider-boot-command) - (executable-find cider-boot-command) - (executable-find (concat cider-boot-command ".exe"))))) - (shell-quote-argument command))) - -;; TODO: Implement a check for `cider-gradle-command' over tramp -(defun cider--gradle-resolve-command () - "Find `cider-gradle-command' on `exec-path' if possible, or return `nil'. - -In case `default-directory' is non-local we assume the command is available." - (when-let ((command (or (and (file-remote-p default-directory) cider-gradle-command) - (executable-find cider-gradle-command) - (executable-find (concat cider-gradle-command ".exe"))))) - (shell-quote-argument command))) - - -;;; Check that the connection is working well -;; TODO: This is nrepl specific. It should eventually go into some cider-nrepl-client -;; file. -(defun cider--check-required-nrepl-version () - "Check whether we're using a compatible nREPL version." - (if-let ((nrepl-version (cider--nrepl-version))) - (when (version< nrepl-version cider-required-nrepl-version) - (cider-repl-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" - "CIDER requires nREPL %s (or newer) to work properly" - cider-required-nrepl-version)) - (cider-repl-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" - "Can't determine nREPL's version.\nPlease, update nREPL to %s." - cider-required-nrepl-version))) - -(defun cider--check-clojure-version-supported () - "Ensure that we are meeting the minimum supported version of Clojure." - (if-let ((clojure-version (cider--clojure-version))) - (when (version< clojure-version cider-minimum-clojure-version) - (cider-repl-manual-warning "installation/#prerequisites" - "Clojure version (%s) is not supported (minimum %s). CIDER will not work." - clojure-version cider-minimum-clojure-version)) - (cider-repl-manual-warning "installation/#prerequisites" - "Can't determine Clojure's version. CIDER requires Clojure %s (or newer)." - cider-minimum-clojure-version))) - -(defun cider--check-middleware-compatibility () - "CIDER frontend/backend compatibility check. -Retrieve the underlying connection's CIDER-nREPL version and checks if the -middleware used is compatible with CIDER. If not, will display a warning -message in the REPL area." - (let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-connection))) - (middleware-version (nrepl-dict-get version-dict "version-string" "not installed"))) - (unless (equal cider-version middleware-version) - (cider-repl-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" - "CIDER's version (%s) does not match cider-nrepl's version (%s). Things will break!" - cider-version middleware-version)))) - -(defun cider--subscribe-repl-to-server-out () - "Subscribe to the server's *out*." - (cider-nrepl-send-request '("op" "out-subscribe") - (cider-interactive-eval-handler (current-buffer)))) - -(defun cider--connected-handler () - "Handle cider initialization after nREPL connection has been established. -This function is appended to `nrepl-connected-hook' in the client process -buffer." - ;; `nrepl-connected-hook' is run in the connection buffer - (cider-make-connection-default (current-buffer)) - (cider-repl-init (current-buffer)) - (cider--check-required-nrepl-version) - (cider--check-clojure-version-supported) - (cider--check-middleware-compatibility) - (cider--debug-init-connection) - (cider--subscribe-repl-to-server-out) - (when cider-auto-mode - (cider-enable-on-existing-clojure-buffers)) - (run-hooks 'cider-connected-hook)) - -(defun cider--disconnected-handler () - "Cleanup after nREPL connection has been lost or closed. -This function is appended to `nrepl-disconnected-hook' in the client -process buffer." - ;; `nrepl-connected-hook' is run in the connection buffer - (cider-possibly-disable-on-existing-clojure-buffers) - (run-hooks 'cider-disconnected-hook)) - -;;;###autoload -(eval-after-load 'clojure-mode - '(progn - (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in) - (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-clojurescript) - (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect))) - -(provide 'cider) - -;;; cider.el ends here diff --git a/elpa/cider-20170129.1941/cider-apropos.el b/elpa/cider-20181110.1413/cider-apropos.el similarity index 90% rename from elpa/cider-20170129.1941/cider-apropos.el rename to elpa/cider-20181110.1413/cider-apropos.el index 74d00860..97be9aa6 100644 --- a/elpa/cider-20170129.1941/cider-apropos.el +++ b/elpa/cider-20181110.1413/cider-apropos.el @@ -1,6 +1,6 @@ ;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- -;; Copyright © 2014-2017 Jeff Valk, Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors ;; ;; Author: Jeff Valk @@ -40,8 +40,6 @@ (defconst cider-apropos-buffer "*cider-apropos*") -(push cider-apropos-buffer cider-ancillary-buffers) - (defcustom cider-apropos-actions '(("display-doc" . cider-doc-lookup) ("find-def" . cider--find-var) ("lookup-on-grimoire" . cider-grimoire-lookup)) @@ -54,6 +52,15 @@ the symbol found by the apropos search as argument." :group 'cider :package-version '(cider . "0.13.0")) +(define-button-type 'apropos-special-form + 'apropos-label "Special form" + 'apropos-short-label "s" + 'face 'font-lock-keyword-face + 'help-echo "mouse-2, RET: Display more help on this special form" + 'follow-link t + 'action (lambda (button) + (describe-function (button-get button 'apropos-symbol)))) + (defun cider-apropos-doc (button) "Display documentation for the symbol represented at BUTTON." (cider-doc-lookup (button-get button 'apropos-symbol))) @@ -108,9 +115,8 @@ and be case-sensitive (based on CASE-SENSITIVE-P)." (defun cider-show-apropos (summary results query docs-p) "Show SUMMARY and RESULTS for QUERY in a pop-up buffer, formatted for DOCS-P." - (with-current-buffer (cider-popup-buffer cider-apropos-buffer t) + (with-current-buffer (cider-popup-buffer cider-apropos-buffer 'select 'apropos-mode 'ancillary) (let ((inhibit-read-only t)) - (apropos-mode) (if (boundp 'header-line-format) (setq-local header-line-format summary) (insert summary "\n\n")) @@ -136,9 +142,9 @@ optionally search doc strings (based on DOCS-P), include private vars (y-or-n-p "Case-sensitive? "))))) (cider-ensure-connected) (cider-ensure-op-supported "apropos") - (if-let ((summary (cider-apropos-summary - query ns docs-p privates-p case-sensitive-p)) - (results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))) + (if-let* ((summary (cider-apropos-summary + query ns docs-p privates-p case-sensitive-p)) + (results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))) (cider-show-apropos summary results query docs-p) (message "No apropos matches for %S" query))) @@ -166,7 +172,6 @@ optionally search doc strings (based on DOCS-P), include private vars ;;;###autoload (defun cider-apropos-select (query &optional ns docs-p privates-p case-sensitive-p) "Similar to `cider-apropos', but presents the results in a completing read. - Show all symbols whose names match QUERY, a regular expression. QUERY can also be a list of space-separated words (e.g. take while) which will be converted to a regular expression (like take.+while) automatically @@ -183,10 +188,10 @@ optionally search doc strings (based on DOCS-P), include private vars (y-or-n-p "Case-sensitive? "))))) (cider-ensure-connected) (cider-ensure-op-supported "apropos") - (if-let ((summary (cider-apropos-summary - query ns docs-p privates-p case-sensitive-p)) - (results (mapcar (lambda (r) (nrepl-dict-get r "name")) - (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))) + (if-let* ((summary (cider-apropos-summary + query ns docs-p privates-p case-sensitive-p)) + (results (mapcar (lambda (r) (nrepl-dict-get r "name")) + (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))) (cider-apropos-act-on-symbol (completing-read (concat summary ": ") results)) (message "No apropos matches for %S" query))) diff --git a/elpa/cider-20181110.1413/cider-autoloads.el b/elpa/cider-20181110.1413/cider-autoloads.el new file mode 100644 index 00000000..56c25811 --- /dev/null +++ b/elpa/cider-20181110.1413/cider-autoloads.el @@ -0,0 +1,772 @@ +;;; cider-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "cider" "cider.el" (0 0 0 0)) +;;; Generated autoloads from cider.el + +(autoload 'cider-version "cider" "\ +Display CIDER's version. + +\(fn)" t nil) + (autoload 'cider-start-map "cider" "CIDER jack-in and connect keymap." t 'keymap) + +(autoload 'cider-jack-in-clj "cider" "\ +Start an nREPL server for the current project and connect to it. +PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. +With the prefix argument, prompt for all these parameters. + +\(fn PARAMS)" t nil) + +(autoload 'cider-jack-in-cljs "cider" "\ +Start an nREPL server for the current project and connect to it. +PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and +:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, +prompt for all these parameters. + +\(fn PARAMS)" t nil) + +(autoload 'cider-jack-in-clj&cljs "cider" "\ +Start an nREPL server and connect with clj and cljs REPLs. +PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and +:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, +prompt for all these parameters. When SOFT-CLJS-START is non-nil, start +cljs REPL only when the ClojureScript dependencies are met. + +\(fn &optional PARAMS SOFT-CLJS-START)" t nil) + +(autoload 'cider-connect-sibling-clj "cider" "\ +Create a Clojure REPL with the same server as OTHER-REPL. +PARAMS is for consistency with other connection commands and is currently +ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can +also be a server buffer, in which case a new session with a REPL for that +server is created. + +\(fn PARAMS &optional OTHER-REPL)" t nil) + +(autoload 'cider-connect-sibling-cljs "cider" "\ +Create a ClojureScript REPL with the same server as OTHER-REPL. +PARAMS is a plist optionally containing :cljs-repl-type (e.g. Node, +Figwheel, etc). All other parameters are inferred from the OTHER-REPL. +OTHER-REPL defaults to `cider-current-repl' but in programs can also be a +server buffer, in which case a new session for that server is created. + +\(fn PARAMS &optional OTHER-REPL)" t nil) + +(autoload 'cider-connect-clj "cider" "\ +Initialize a Clojure connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port and :project-dir. On +prefix argument, prompt for all the parameters. + +\(fn &optional PARAMS)" t nil) + +(autoload 'cider-connect-cljs "cider" "\ +Initialize a ClojureScript connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port, :project-dir and +:cljs-repl-type (e.g. Node, Figwheel, etc). On prefix, prompt for all the +parameters regardless of their supplied or default values. + +\(fn &optional PARAMS)" t nil) + +(autoload 'cider-connect-clj&cljs "cider" "\ +Initialize a Clojure and ClojureScript connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port, :project-dir and +:cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is +non-nil, don't start if ClojureScript requirements are not met. + +\(fn PARAMS &optional SOFT-CLJS-START)" t nil) + +(autoload 'cider "cider" "\ +Start a connection of any type interactively. + +\(fn)" t nil) + +(defalias 'cider-jack-in #'cider-jack-in-clj) + +(defalias 'cider-jack-in-clojure #'cider-jack-in-clj) + +(defalias 'cider-jack-in-clojurescript #'cider-jack-in-cljs) + +(defalias 'cider-connect #'cider-connect-clj) + +(defalias 'cider-connect-clojure #'cider-connect-clj) + +(defalias 'cider-connect-clojurescript #'cider-connect-cljs) + +(defalias 'cider-connect-sibling-clojure #'cider-connect-sibling-clj) + +(defalias 'cider-connect-sibling-clojurescript #'cider-connect-sibling-cljs) + +(with-eval-after-load 'clojure-mode (define-key clojure-mode-map (kbd "C-c M-x") #'cider) (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) (require 'sesman) (sesman-install-menu clojure-mode-map) (add-hook 'clojure-mode-hook (lambda nil (setq-local sesman-system 'CIDER)))) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-apropos" "cider-apropos.el" (0 0 0 0)) +;;; Generated autoloads from cider-apropos.el + +(autoload 'cider-apropos "cider-apropos" "\ +Show all symbols whose names match QUERY, a regular expression. +QUERY can also be a list of space-separated words (e.g. take while) which +will be converted to a regular expression (like take.+while) automatically +behind the scenes. The search may be limited to the namespace NS, and may +optionally search doc strings (based on DOCS-P), include private vars +\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). + +\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) + +(autoload 'cider-apropos-documentation "cider-apropos" "\ +Shortcut for (cider-apropos nil t). + +\(fn)" t nil) + +(autoload 'cider-apropos-select "cider-apropos" "\ +Similar to `cider-apropos', but presents the results in a completing read. +Show all symbols whose names match QUERY, a regular expression. +QUERY can also be a list of space-separated words (e.g. take while) which +will be converted to a regular expression (like take.+while) automatically +behind the scenes. The search may be limited to the namespace NS, and may +optionally search doc strings (based on DOCS-P), include private vars +\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). + +\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) + +(autoload 'cider-apropos-documentation-select "cider-apropos" "\ +Shortcut for (cider-apropos-select nil t). + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-apropos" '("cider-" "apropos-special-form"))) + +;;;*** + +;;;### (autoloads nil "cider-browse-ns" "cider-browse-ns.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cider-browse-ns.el + +(autoload 'cider-browse-ns "cider-browse-ns" "\ +List all NAMESPACE's vars in BUFFER. + +\(fn NAMESPACE)" t nil) + +(autoload 'cider-browse-ns-all "cider-browse-ns" "\ +List all loaded namespaces in BUFFER. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-browse-ns" '("cider-browse-ns-"))) + +;;;*** + +;;;### (autoloads nil "cider-browse-spec" "cider-browse-spec.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cider-browse-spec.el + +(autoload 'cider-browse-spec "cider-browse-spec" "\ +Browse SPEC definition. + +\(fn SPEC)" t nil) + +(autoload 'cider-browse-spec-all "cider-browse-spec" "\ +Open list of specs in a popup buffer. + +With a prefix argument ARG, prompts for a regexp to filter specs. +No filter applied if the regexp is the empty string. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-browse-spec" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-cheatsheet" "cider-cheatsheet.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cider-cheatsheet.el + +(autoload 'cider-cheatsheet "cider-cheatsheet" "\ +Navigate `cider-cheatsheet-hierarchy' with `completing-read'. + +When you make it to a Clojure var its doc buffer gets displayed. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-cheatsheet" '("cider-cheatsheet-"))) + +;;;*** + +;;;### (autoloads nil "cider-classpath" "cider-classpath.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cider-classpath.el + +(autoload 'cider-classpath "cider-classpath" "\ +List all classpath entries. + +\(fn)" t nil) + +(autoload 'cider-open-classpath-entry "cider-classpath" "\ +Open a classpath entry. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-classpath" '("cider-classpath-"))) + +;;;*** + +;;;### (autoloads nil "cider-client" "cider-client.el" (0 0 0 0)) +;;; Generated autoloads from cider-client.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-client" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-common" "cider-common.el" (0 0 0 0)) +;;; Generated autoloads from cider-common.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-common" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-completion" "cider-completion.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cider-completion.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-completion" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-connection" "cider-connection.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cider-connection.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-connection" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-debug" "cider-debug.el" (0 0 0 0)) +;;; Generated autoloads from cider-debug.el + +(autoload 'cider-debug-defun-at-point "cider-debug" "\ +Instrument the \"top-level\" expression at point. +If it is a defn, dispatch the instrumented definition. Otherwise, +immediately evaluate the instrumented expression. + +While debugged code is being evaluated, the user is taken through the +source code and displayed the value of various expressions. At each step, +a number of keys will be prompted to the user. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-debug" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-doc" "cider-doc.el" (0 0 0 0)) +;;; Generated autoloads from cider-doc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-doc" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-eldoc" "cider-eldoc.el" (0 0 0 0)) +;;; Generated autoloads from cider-eldoc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-eldoc" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-eval" "cider-eval.el" (0 0 0 0)) +;;; Generated autoloads from cider-eval.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-eval" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-find" "cider-find.el" (0 0 0 0)) +;;; Generated autoloads from cider-find.el + +(autoload 'cider-find-var "cider-find" "\ +Find definition for VAR at LINE. +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point. + +\(fn &optional ARG VAR LINE)" t nil) + +(autoload 'cider-find-dwim-at-mouse "cider-find" "\ +Find and display variable or resource at mouse EVENT. + +\(fn EVENT)" t nil) + +(autoload 'cider-find-dwim "cider-find" "\ +Find and display the SYMBOL-FILE at point. +SYMBOL-FILE could be a var or a resource. If thing at point is empty then +show dired on project. If var is not found, try to jump to resource of the +same name. When called interactively, a prompt is given according to the +variable `cider-prompt-for-symbol'. A single or double prefix argument +inverts the meaning. A prefix of `-' or a double prefix argument causes +the results to be displayed in a different window. A default value of thing +at point is given when prompted. + +\(fn SYMBOL-FILE)" t nil) + +(autoload 'cider-find-resource "cider-find" "\ +Find the resource at PATH. +Prompt for input as indicated by the variable `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix +argument causes the results to be displayed in other window. The default +value is thing at point. + +\(fn PATH)" t nil) + +(autoload 'cider-find-ns "cider-find" "\ +Find the file containing NS. +A prefix ARG of `-` or a double prefix argument causes +the results to be displayed in a different window. + +\(fn &optional ARG NS)" t nil) + +(autoload 'cider-find-keyword "cider-find" "\ +Find the namespace of the keyword at point and its first occurrence there. + +For instance - if the keyword at point is \":cider.demo/keyword\", this command +would find the namespace \"cider.demo\" and afterwards find the first mention +of \"::keyword\" there. + +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-find" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-format" "cider-format.el" (0 0 0 0)) +;;; Generated autoloads from cider-format.el + +(autoload 'cider-format-region "cider-format" "\ +Format the Clojure code in the current region. +START and END represent the region's boundaries. + +\(fn START END)" t nil) + +(autoload 'cider-format-defun "cider-format" "\ +Format the code in the current defun. + +\(fn)" t nil) + +(autoload 'cider-format-buffer "cider-format" "\ +Format the Clojure code in the current buffer. + +\(fn)" t nil) + +(autoload 'cider-format-edn-buffer "cider-format" "\ +Format the EDN data in the current buffer. + +\(fn)" t nil) + +(autoload 'cider-format-edn-region "cider-format" "\ +Format the EDN data in the current region. +START and END represent the region's boundaries. + +\(fn START END)" t nil) + +(autoload 'cider-format-edn-last-sexp "cider-format" "\ +Format the EDN data of the last sexp. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-format" '("cider--format-"))) + +;;;*** + +;;;### (autoloads nil "cider-grimoire" "cider-grimoire.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cider-grimoire.el + +(autoload 'cider-grimoire-web "cider-grimoire" "\ +Open grimoire documentation in the default web browser. + +Prompts for the symbol to use, or uses the symbol at point, depending on +the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the +opposite of what that option dictates. + +\(fn &optional ARG)" t nil) + +(autoload 'cider-grimoire "cider-grimoire" "\ +Open grimoire documentation in a popup buffer. + +Prompts for the symbol to use, or uses the symbol at point, depending on +the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the +opposite of what that option dictates. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-grimoire" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-inspector" "cider-inspector.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cider-inspector.el + +(autoload 'cider-inspect-last-sexp "cider-inspector" "\ +Inspect the result of the the expression preceding point. + +\(fn)" t nil) + +(autoload 'cider-inspect-defun-at-point "cider-inspector" "\ +Inspect the result of the \"top-level\" expression at point. + +\(fn)" t nil) + +(autoload 'cider-inspect-last-result "cider-inspector" "\ +Inspect the most recent eval result. + +\(fn)" t nil) + +(autoload 'cider-inspect "cider-inspector" "\ +Inspect the result of the preceding sexp. + +With a prefix argument ARG it inspects the result of the \"top-level\" form. +With a second prefix argument it prompts for an expression to eval and inspect. + +\(fn &optional ARG)" t nil) + +(autoload 'cider-inspect-expr "cider-inspector" "\ +Evaluate EXPR in NS and inspect its value. +Interactively, EXPR is read from the minibuffer, and NS the +current buffer's namespace. + +\(fn EXPR NS)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-inspector" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-macroexpansion" "cider-macroexpansion.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cider-macroexpansion.el + +(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\ +Invoke \\=`macroexpand-1\\=` on the expression preceding point. +If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of +\\=`macroexpand-1\\=`. + +\(fn &optional PREFIX)" t nil) + +(autoload 'cider-macroexpand-all "cider-macroexpansion" "\ +Invoke \\=`macroexpand-all\\=` on the expression preceding point. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-macroexpansion" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-mode" "cider-mode.el" (0 0 0 0)) +;;; Generated autoloads from cider-mode.el + +(defvar cider-mode-line '(:eval (format " cider[%s]" (cider--modeline-info))) "\ +Mode line lighter for cider mode. + +The value of this variable is a mode line template as in +`mode-line-format'. See Info Node `(elisp)Mode Line Format' for details +about mode line templates. + +Customize this variable to change how cider mode displays its status in the +mode line. The default value displays the current connection. Set this +variable to nil to disable the mode line entirely.") + +(custom-autoload 'cider-mode-line "cider-mode" t) + +(with-eval-after-load 'clojure-mode (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map "Menu for Clojure mode.\n This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." `("CIDER" :visible (not cider-mode) ["Start a Clojure REPL" cider-jack-in-clj :help "Starts an nREPL server and connects a Clojure REPL to it."] ["Connect to a Clojure REPL" cider-connect-clj :help "Connects to a REPL that's already running."] ["Start a ClojureScript REPL" cider-jack-in-cljs :help "Starts an nREPL server and connects a ClojureScript REPL to it."] ["Connect to a ClojureScript REPL" cider-connect-cljs :help "Connects to a ClojureScript REPL that's already running."] ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clj&cljs :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] "--" ["View manual online" cider-view-manual]))) + +(autoload 'cider-mode "cider-mode" "\ +Minor mode for REPL interaction from a Clojure buffer. + +\\{cider-mode-map} + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-mode" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-ns" "cider-ns.el" (0 0 0 0)) +;;; Generated autoloads from cider-ns.el + +(autoload 'cider-ns-reload "cider-ns" "\ +Send a (require 'ns :reload) to the REPL. + +With an argument PROMPT, it prompts for a namespace name. This is the +Clojure out of the box reloading experience and does not rely on +org.clojure/tools.namespace. See Commentary of this file for a longer list +of differences. From the Clojure doc: \":reload forces loading of all the +identified libs even if they are already loaded\". + +\(fn &optional PROMPT)" t nil) + +(autoload 'cider-ns-reload-all "cider-ns" "\ +Send a (require 'ns :reload-all) to the REPL. + +With an argument PROMPT, it prompts for a namespace name. This is the +Clojure out of the box reloading experience and does not rely on +org.clojure/tools.namespace. See Commentary of this file for a longer list +of differences. From the Clojure doc: \":reload-all implies :reload and +also forces loading of all libs that the identified libs directly or +indirectly load via require\". + +\(fn &optional PROMPT)" t nil) + +(autoload 'cider-ns-refresh "cider-ns" "\ +Reload modified and unloaded namespaces on the classpath. + +With a single prefix argument, or if MODE is `refresh-all', reload all +namespaces on the classpath unconditionally. + +With a double prefix argument, or if MODE is `clear', clear the state of +the namespace tracker before reloading. This is useful for recovering from +some classes of error (for example, those caused by circular dependencies) +that a normal reload would not otherwise recover from. The trade-off of +clearing is that stale code from any deleted files may not be completely +unloaded. + +With a negative prefix argument, or if MODE is `inhibit-fns', prevent any +refresh functions (defined in `cider-ns-refresh-before-fn' and +`cider-ns-refresh-after-fn') from being invoked. + +\(fn &optional MODE)" t nil) + +(define-obsolete-function-alias 'cider-refresh 'cider-ns-refresh "0.18") + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-ns" '("cider-ns-"))) + +;;;*** + +;;;### (autoloads nil "cider-overlays" "cider-overlays.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cider-overlays.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-overlays" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-popup" "cider-popup.el" (0 0 0 0)) +;;; Generated autoloads from cider-popup.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-popup" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-profile" "cider-profile.el" (0 0 0 0)) +;;; Generated autoloads from cider-profile.el + +(autoload 'cider-profile-samples "cider-profile" "\ +Displays current max-sample-count. +If optional QUERY is specified, set max-sample-count and display new value. + +\(fn &optional QUERY)" t nil) + +(autoload 'cider-profile-var-profiled-p "cider-profile" "\ +Displays the profiling status of var under point. +Prompts for var if none under point or QUERY is present. + +\(fn QUERY)" t nil) + +(autoload 'cider-profile-ns-toggle "cider-profile" "\ +Toggle profiling for the ns associated with optional QUERY. + +If optional argument QUERY is non-nil, prompt for ns. Otherwise use +current ns. + +\(fn &optional QUERY)" t nil) + +(autoload 'cider-profile-toggle "cider-profile" "\ +Toggle profiling for the given QUERY. +Defaults to the symbol at point. +With prefix arg or no symbol at point, prompts for a var. + +\(fn QUERY)" t nil) + +(autoload 'cider-profile-summary "cider-profile" "\ +Display a summary of currently collected profile data. + +\(fn)" t nil) + +(autoload 'cider-profile-var-summary "cider-profile" "\ +Display profile data for var under point QUERY. +Defaults to the symbol at point. With prefix arg or no symbol at point, +prompts for a var. + +\(fn QUERY)" t nil) + +(autoload 'cider-profile-clear "cider-profile" "\ +Clear any collected profile data. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-profile" '("cider-profile-"))) + +;;;*** + +;;;### (autoloads nil "cider-repl" "cider-repl.el" (0 0 0 0)) +;;; Generated autoloads from cider-repl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-repl" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-repl-history" "cider-repl-history.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cider-repl-history.el + +(autoload 'cider-repl-history "cider-repl-history" "\ +Display items in the CIDER command history in another buffer. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-repl-history" '("cider-repl-history-"))) + +;;;*** + +;;;### (autoloads nil "cider-resolve" "cider-resolve.el" (0 0 0 0)) +;;; Generated autoloads from cider-resolve.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-resolve" '("cider-resolve-"))) + +;;;*** + +;;;### (autoloads nil "cider-scratch" "cider-scratch.el" (0 0 0 0)) +;;; Generated autoloads from cider-scratch.el + +(autoload 'cider-scratch "cider-scratch" "\ +Go to the scratch buffer named `cider-scratch-buffer-name'. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-scratch" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-selector" "cider-selector.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cider-selector.el + +(autoload 'cider-selector "cider-selector" "\ +Select a new buffer by type, indicated by a single character. +The user is prompted for a single character indicating the method by +which to choose a new buffer. The `?' character describes then +available methods. OTHER-WINDOW provides an optional target. +See `def-cider-selector-method' for defining new methods. + +\(fn &optional OTHER-WINDOW)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-selector" '("??" "?c" "?e" "?q" "?r" "?m" "?x" "?p" "?d" "?s" "def-cider-selector-method" "cider-selector-"))) + +;;;*** + +;;;### (autoloads nil "cider-stacktrace" "cider-stacktrace.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cider-stacktrace.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-stacktrace" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-test" "cider-test.el" (0 0 0 0)) +;;; Generated autoloads from cider-test.el + +(defvar cider-auto-test-mode nil "\ +Non-nil if Cider-Auto-Test mode is enabled. +See the `cider-auto-test-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `cider-auto-test-mode'.") + +(custom-autoload 'cider-auto-test-mode "cider-test" nil) + +(autoload 'cider-auto-test-mode "cider-test" "\ +Toggle automatic testing of Clojure files. + +When enabled this reruns tests every time a Clojure file is loaded. +Only runs tests corresponding to the loaded file's namespace and does +nothing if no tests are defined or if the file failed to load. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-test" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-tracing" "cider-tracing.el" (0 0 0 0)) +;;; Generated autoloads from cider-tracing.el + +(autoload 'cider-toggle-trace-var "cider-tracing" "\ +Toggle var tracing. +Prompts for the symbol to use, or uses the symbol at point, depending on +the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the +opposite of what that option dictates. + +\(fn ARG)" t nil) + +(autoload 'cider-toggle-trace-ns "cider-tracing" "\ +Toggle ns tracing. +Defaults to the current ns. With prefix arg QUERY, prompts for a ns. + +\(fn QUERY)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-tracing" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-util" "cider-util.el" (0 0 0 0)) +;;; Generated autoloads from cider-util.el + +(autoload 'cider-view-manual "cider-util" "\ +View the manual in your default browser. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-util" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "nrepl-client" "nrepl-client.el" (0 0 0 0)) +;;; Generated autoloads from nrepl-client.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nrepl-client" '("nrepl-" "cider-enlighten-mode"))) + +;;;*** + +;;;### (autoloads nil "nrepl-dict" "nrepl-dict.el" (0 0 0 0)) +;;; Generated autoloads from nrepl-dict.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nrepl-dict" '("nrepl-"))) + +;;;*** + +;;;### (autoloads nil nil ("cider-compat.el" "cider-pkg.el") (0 0 +;;;;;; 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; cider-autoloads.el ends here diff --git a/elpa/cider-20170129.1941/cider-browse-ns.el b/elpa/cider-20181110.1413/cider-browse-ns.el similarity index 90% rename from elpa/cider-20170129.1941/cider-browse-ns.el rename to elpa/cider-20181110.1413/cider-browse-ns.el index b142ecfe..6f735353 100644 --- a/elpa/cider-20170129.1941/cider-browse-ns.el +++ b/elpa/cider-20181110.1413/cider-browse-ns.el @@ -1,6 +1,6 @@ ;;; cider-browse-ns.el --- CIDER namespace browser -;; Copyright © 2014-2017 John Andrews, Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2018 John Andrews, Bozhidar Batsov and CIDER contributors ;; Author: John Andrews @@ -35,16 +35,17 @@ ;;; Code: -(require 'cider-interaction) (require 'cider-client) -(require 'subr-x) +(require 'cider-popup) (require 'cider-compat) (require 'cider-util) (require 'nrepl-dict) -(defconst cider-browse-ns-buffer "*cider-ns-browser*") +(require 'subr-x) +(require 'easymenu) +(require 'thingatpt) -(push cider-browse-ns-buffer cider-ancillary-buffers) +(defconst cider-browse-ns-buffer "*cider-ns-browser*") (defvar-local cider-browse-ns-current-ns nil) @@ -59,6 +60,13 @@ (define-key map "^" #'cider-browse-ns-all) (define-key map "n" #'next-line) (define-key map "p" #'previous-line) + (easy-menu-define cider-browse-ns-mode-menu map + "Menu for CIDER's namespace browser" + '("Namespace Browser" + ["Show doc" cider-browse-ns-doc-at-point] + ["Go to definition" cider-browse-ns-find-at-point] + "--" + ["Browse all namespaces" cider-browse-ns-all])) map)) (defvar cider-browse-ns-mouse-map @@ -70,8 +78,8 @@ "Major mode for browsing Clojure namespaces. \\{cider-browse-ns-mode-map}" - (setq buffer-read-only t) (setq-local electric-indent-chars nil) + (setq-local sesman-system 'CIDER) (when cider-special-mode-truncate-lines (setq-local truncate-lines t)) (setq-local cider-browse-ns-current-ns nil)) @@ -150,7 +158,7 @@ Each item consists of a ns-var and the first line of its docstring." (defun cider-browse-ns (namespace) "List all NAMESPACE's vars in BUFFER." (interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list)))) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t) + (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) (cider-browse-ns--list (current-buffer) namespace (cider-browse-ns--items namespace)) @@ -160,7 +168,7 @@ Each item consists of a ns-var and the first line of its docstring." (defun cider-browse-ns-all () "List all loaded namespaces in BUFFER." (interactive) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t) + (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) (let ((names (cider-sync-request:ns-list))) (cider-browse-ns--list (current-buffer) "All loaded namespaces" @@ -174,11 +182,11 @@ Each item consists of a ns-var and the first line of its docstring." Return a list of the type ('ns or 'var) and the value." (let ((line (car (split-string (string-trim (thing-at-point 'line)) " ")))) (if (string-match "\\." line) - (list 'ns line) - (list 'var (format "%s/%s" - (or (get-text-property (point) 'cider-browse-ns-current-ns) - cider-browse-ns-current-ns) - line))))) + `(ns ,line) + `(var ,(format "%s/%s" + (or (get-text-property (point) 'cider-browse-ns-current-ns) + cider-browse-ns-current-ns) + line))))) (defun cider-browse-ns-doc-at-point () "Show the documentation for the thing at current point." @@ -201,6 +209,9 @@ be displayed." (cider-browse-ns value) (cider-doc-lookup value)))) +(declare-function cider-find-ns "cider-find") +(declare-function cider-find-var "cider-find") + (defun cider-browse-ns-find-at-point () "Find the definition of the thing at point." (interactive) diff --git a/elpa/cider-20181110.1413/cider-browse-spec.el b/elpa/cider-20181110.1413/cider-browse-spec.el new file mode 100644 index 00000000..d58352b1 --- /dev/null +++ b/elpa/cider-20181110.1413/cider-browse-spec.el @@ -0,0 +1,357 @@ +;;; cider-browse-spec.el --- CIDER spec browser + +;; Copyright © 2017 Juan Monetta, Bozhidar Batsov and CIDER contributors + +;; Author: Juan Monetta + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; M-x cider-browse-spec +;; +;; Display a spec description you can browse. +;; Pressing over a sub spec will take you to the description of that sub spec. +;; Pressing ^ takes you to the list of all specs. + +;; M-x cider-browse-spec-all +;; +;; Explore clojure.spec registry by browsing a list of all specs. +;; Pressing over a spec display the spec description you can browse. + +;;; Code: + +(require 'cider-client) +(require 'cider-compat) +(require 'cider-util) +(require 'cl-lib) +(require 'nrepl-dict) +(require 'seq) +(require 'subr-x) +(require 'help-mode) + +;; The buffer names used by the spec browser +(defconst cider-browse-spec-buffer "*cider-spec-browser*") +(defconst cider-browse-spec-example-buffer "*cider-spec-example*") + +;; Mode Definition + +(defvar cider-browse-spec-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (make-composed-keymap button-buffer-map + cider-popup-buffer-mode-map)) + (define-key map (kbd "RET") #'cider-browse-spec--browse-at) + (define-key map "n" #'forward-button) + (define-key map "p" #'backward-button) + map) + "Keymap for `cider-browse-spec-mode'.") + +(define-derived-mode cider-browse-spec-mode special-mode "Specs" + "Major mode for browsing Clojure specs. + +\\{cider-browse-spec-mode-map}" + (setq-local electric-indent-chars nil) + (setq-local sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (setq-local truncate-lines t))) + +(defvar cider-browse-spec--current-spec nil) + +(defvar cider-browse-spec-view-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map help-mode-map) + (define-key map (kbd "RET") #'cider-browse-spec--browse-at) + (define-key map "^" #'cider-browse-spec-all) + (define-key map "e" #'cider-browse-spec--print-curr-spec-example) + (define-key map "n" #'forward-button) + (define-key map "p" #'backward-button) + map) + "Keymap for `cider-browse-spec-view-mode'.") + +(define-derived-mode cider-browse-spec-view-mode help-mode "Spec" + "Major mode for displaying CIDER spec. + +\\{cider-browse-spec-view-mode-map}" + (setq-local cider-browse-spec--current-spec nil) + (setq-local electric-indent-chars nil) + (setq-local sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (setq-local truncate-lines t))) + +(defvar cider-browse-spec-example-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map cider-popup-buffer-mode-map) + (define-key map "^" #'cider-browse-spec-all) + (define-key map "e" #'cider-browse-spec--print-curr-spec-example) + (define-key map "g" #'revert-buffer) + map) + "Keymap for `cider-browse-spec-example-mode'.") + +(define-derived-mode cider-browse-spec-example-mode special-mode "Example" + "Major mode for Clojure spec examples. + +\\{cider-browse-spec-example-mode-map}" + (setq-local electric-indent-chars nil) + (setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function) + (setq-local sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (setq-local truncate-lines t))) + +;; Non interactive functions + +(define-button-type 'cider-browse-spec--spec + 'action #'cider-browse-spec--browse-at + 'face nil + 'follow-link t + 'help-echo "View spec") + +(defun cider-browse-spec--draw-list-buffer (buffer title specs) + "Reset contents of BUFFER. +Display TITLE at the top and SPECS are indented underneath." + (with-current-buffer buffer + (cider-browse-spec-mode) + (let ((inhibit-read-only t)) + (erase-buffer) + (goto-char (point-max)) + (insert (cider-propertize title 'emph) "\n") + (dolist (spec-name specs) + (insert (propertize " " 'spec-name spec-name)) + (thread-first (cider-font-lock-as-clojure spec-name) + (insert-text-button 'type 'cider-browse-spec--spec) + (button-put 'spec-name spec-name)) + (insert (propertize "\n" 'spec-name spec-name))) + (goto-char (point-min))))) + +(defun cider--qualified-keyword-p (str) + "Return non nil if STR is a namespaced keyword." + (string-match-p "^:.+/.+$" str)) + +(defun cider--spec-fn-p (value fn-name) + "Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME." + (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\)/" fn-name "$") value)) + +(defun cider-browse-spec--pprint (form) + "Given a spec FORM builds a multi line string with a pretty render of that FORM." + (cond ((stringp form) + (if (cider--qualified-keyword-p form) + (with-temp-buffer + (thread-first form + (insert-text-button 'type 'cider-browse-spec--spec) + (button-put 'spec-name form)) + (buffer-string)) + ;; to make it easier to read replace all clojure.spec ns with s/ + ;; and remove all clojure.core ns + (thread-last form + (replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\)/" "s/") + (replace-regexp-in-string "^\\(clojure.core\\)/" "")))) + + ((and (listp form) (stringp (cl-first form))) + (let ((form-tag (cl-first form))) + (cond + ;; prettier fns #() + ((string-equal form-tag "clojure.core/fn") + (if (equal (cl-second form) '("%")) + (format "#%s" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))) + (format "(fn [%%] %s)" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))))) + ;; prettier (s/and ) + ((cider--spec-fn-p form-tag "and") + (format "(s/and\n%s)" (string-join (thread-last (cl-rest form) + (mapcar #'cider-browse-spec--pprint) + (mapcar (lambda (x) (format "%s" x)))) + "\n"))) + ;; prettier (s/or ) + ((cider--spec-fn-p form-tag "or") + (let ((name-spec-pair (seq-partition (cl-rest form) 2))) + (format "(s/or\n%s)" (string-join + (thread-last name-spec-pair + (mapcar (lambda (s) (format "%s %s" (cl-first s) (cider-browse-spec--pprint (cl-second s)))))) + "\n")))) + ;; prettier (s/merge ) + ((cider--spec-fn-p form-tag "merge") + (format "(s/merge\n%s)" (string-join (thread-last (cl-rest form) + (mapcar #'cider-browse-spec--pprint) + (mapcar (lambda (x) (format "%s" x)))) + "\n"))) + ;; prettier (s/keys ) + ((cider--spec-fn-p form-tag "keys") + (let ((keys-args (seq-partition (cl-rest form) 2))) + (format "(s/keys%s)" (thread-last + keys-args + (mapcar (lambda (s) + (let ((key-type (cl-first s)) + (specs-vec (cl-second s))) + (concat "\n" key-type + " [" + (string-join (thread-last specs-vec + (mapcar #'cider-browse-spec--pprint) + (mapcar (lambda (x) (format "%s" x)))) + "\n") + "]")))) + (cl-reduce #'concat))))) + ;; prettier (s/multi-spec) + ((cider--spec-fn-p form-tag "multi-spec") + (let ((multi-method (cl-second form)) + (retag (cl-third form)) + (sub-specs (cl-rest (cl-rest (cl-rest form))))) + (format "(s/multi-spec %s %s\n%s)" + multi-method + retag + (string-join + (thread-last sub-specs + (mapcar (lambda (s) + (concat "\n\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) + "\n")))) + ;; prettier (s/cat ) + ((cider--spec-fn-p form-tag "cat") + (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) + (format "(s/cat %s)" + (thread-last name-spec-pairs + (mapcar (lambda (s) + (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) + (cl-reduce #'concat))))) + ;; prettier (s/alt ) + ((cider--spec-fn-p form-tag "alt") + (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) + (format "(s/alt %s)" + (thread-last name-spec-pairs + (mapcar (lambda (s) + (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) + (cl-reduce #'concat))))) + ;; prettier (s/fspec ) + ((cider--spec-fn-p form-tag "fspec") + (thread-last (seq-partition (cl-rest form) 2) + (cl-remove-if (lambda (s) (and (stringp (cl-second s)) + (string-empty-p (cl-second s))))) + (mapcar (lambda (s) + (format "\n%-11s: %s" (pcase (cl-first s) + (":args" "arguments") + (":ret" "returns") + (":fn" "invariants")) + (cider-browse-spec--pprint (cl-second s))))) + (cl-reduce #'concat) + (format "%s"))) + ;; every other with no special management + (t (format "(%s %s)" + (cider-browse-spec--pprint form-tag) + (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " ")))))) + (t (format "%s" form)))) + +(defun cider-browse-spec--pprint-indented (spec-form) + "Indent (pretty-print) and font-lock SPEC-FORM. +Return the result as a string." + (with-temp-buffer + (clojure-mode) + (insert (cider-browse-spec--pprint spec-form)) + (indent-region (point-min) (point-max)) + (cider--font-lock-ensure) + (buffer-string))) + +(defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form) + "Reset contents of BUFFER and draws everything needed to browse the SPEC-FORM. +Display SPEC as a title and uses `cider-browse-spec--pprint' to display +a more user friendly representation of SPEC-FORM." + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer) + (goto-char (point-max)) + (insert (cider-font-lock-as-clojure spec) "\n\n") + (insert (cider-browse-spec--pprint-indented spec-form)) + (cider--make-back-forward-xrefs) + (current-buffer)))) + +(defun cider-browse-spec--browse (spec) + "Browse SPEC." + (cider-ensure-connected) + (cider-ensure-op-supported "spec-form") + (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select #'cider-browse-spec-view-mode 'ancillary) + (setq-local cider-browse-spec--current-spec spec) + (cider-browse-spec--draw-spec-buffer (current-buffer) + spec + (cider-sync-request:spec-form spec)) + (goto-char (point-min)) + (current-buffer))) + +(defun cider-browse-spec--browse-at (&optional pos) + "View the definition of a spec. + +Optional argument POS is the position of a spec, defaulting to point. POS +may also be a button, so this function can be used a the button's `action' +property." + (interactive) + (let ((pos (or pos (point)))) + (when-let* ((spec (button-get pos 'spec-name))) + (cider-browse-spec--browse spec)))) + +;; Interactive Functions + +(defun cider-browse-spec--print-curr-spec-example () + "Generate and print an example of the current spec." + (interactive) + (cider-ensure-connected) + (cider-ensure-op-supported "spec-example") + (if-let* ((spec cider-browse-spec--current-spec)) + (if-let* ((example (cider-sync-request:spec-example spec))) + (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer 'select #'cider-browse-spec-example-mode 'ancillary) + (setq-local cider-browse-spec--current-spec spec) + (let ((inhibit-read-only t)) + (insert "Example of " (cider-font-lock-as-clojure spec)) + (insert "\n\n") + (insert (cider-font-lock-as-clojure example)) + (goto-char (point-min)))) + (error (format "No example for spec %s" spec))) + (error "No current spec"))) + +(defun cider-browse-spec--example-revert-buffer-function (&rest _) + "`revert-buffer' function for `cider-browse-spec-example-mode'. + +Generates a new example for the current spec." + (cider-browse-spec--print-curr-spec-example)) + +;;;###autoload +(defun cider-browse-spec (spec) + "Browse SPEC definition." + (interactive (list (completing-read "Browse spec: " + (cider-sync-request:spec-list) + nil nil + (cider-symbol-at-point)))) + (cider-browse-spec--browse spec)) + +(defun cider-browse-spec-regex (regex) + "Open the list of specs that matches REGEX in a popup buffer. +Displays all specs when REGEX is nil." + (cider-ensure-connected) + (cider-ensure-op-supported "spec-list") + (let ((filter-regex (or regex ""))) + (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select nil 'ancillary) + (let ((specs (cider-sync-request:spec-list filter-regex))) + (cider-browse-spec--draw-list-buffer (current-buffer) + (if (string-empty-p filter-regex) + "All specs in registry" + (format "All specs matching regex `%s' in registry" filter-regex)) + specs))))) + +;;;###autoload +(defun cider-browse-spec-all (&optional arg) + "Open list of specs in a popup buffer. + +With a prefix argument ARG, prompts for a regexp to filter specs. +No filter applied if the regexp is the empty string." + (interactive "P") + (cider-browse-spec-regex (if arg (read-string "Filter regex: ") ""))) + +(provide 'cider-browse-spec) + +;;; cider-browse-spec.el ends here diff --git a/elpa/cider-20181110.1413/cider-cheatsheet.el b/elpa/cider-20181110.1413/cider-cheatsheet.el new file mode 100644 index 00000000..d870c5a5 --- /dev/null +++ b/elpa/cider-20181110.1413/cider-cheatsheet.el @@ -0,0 +1,577 @@ +;;; cider-cheatsheet.el --- Quick reference for Clojure -*- lexical-binding: t -*- + +;; Copyright © 2018 Kris Jenkins, Bozhidar Batsov and CIDER contributors +;; +;; Author: Kris Jenkins + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A quick reference system for Clojure. Fast, searchable & available offline. + +;; Mostly taken from Kris Jenkins' `clojure-cheatsheet' +;; See: https://github.com/clojure-emacs/clojure-cheatsheet + +;;; Code: + +(require 'cider-doc) +(require 'seq) + +(defconst cider-cheatsheet-hierarchy + '(("Primitives" + ("Numbers" + ("Arithmetic" + (clojure.core + - * / quot rem mod dec inc max min)) + ("Compare" + (clojure.core = == not= < > <= >= compare)) + ("Bitwise" + (clojure.core bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set bit-shift-left bit-shift-right bit-test bit-xor unsigned-bit-shift-right)) + ("Cast" + (clojure.core byte short long int float double bigdec bigint biginteger num rationalize)) + ("Test" + (clojure.core nil? some? identical? zero? pos? neg? even? odd?)) + ("Random" + (clojure.core rand rand-int)) + ("BigDecimal" + (clojure.core with-precision)) + ("Ratios" + (clojure.core numerator denominator ratio?)) + ("Arbitrary Precision Arithmetic" + (clojure.core +\' -\' *\' inc\' dec\')) + ("Unchecked" + (clojure.core *unchecked-math* + unchecked-add + unchecked-add-int + unchecked-byte + unchecked-char + unchecked-dec + unchecked-dec-int + unchecked-divide-int + unchecked-double + unchecked-float + unchecked-inc + unchecked-inc-int + unchecked-int + unchecked-long + unchecked-multiply + unchecked-multiply-int + unchecked-negate + unchecked-negate-int + unchecked-remainder-int + unchecked-short + unchecked-subtract + unchecked-subtract-int))) + + ("Strings" + ("Create" + (clojure.core str format)) + ("Use" + (clojure.core count get subs compare) + (clojure.string join escape split split-lines replace replace-first reverse re-quote-replacement index-of last-index-of starts-with? ends-with? includes?)) + ("Regex" + (clojure.core re-find re-seq re-matches re-pattern re-matcher re-groups) + (clojure.string replace replace-first re-quote-replacement)) + ("Letters" + (clojure.string capitalize lower-case upper-case)) + ("Trim" + (clojure.string trim trim-newline triml trimr)) + ("Test" + (clojure.core char char? string?) + (clojure.string blank?))) + + ("Other" + ("Characters" + (clojure.core char char-name-string char-escape-string)) + ("Keywords" + (clojure.core keyword keyword? find-keyword)) + ("Symbols" + (clojure.core symbol symbol? gensym)) + ("Data Readers" + (clojure.core *data-readers* default-data-readers *default-data-reader-fn*)))) + + ("Collections" + ("Generic Ops" + (clojure.core count bounded-count empty not-empty into conj)) + ("Tree Walking" + (clojure.walk walk prewalk prewalk-demo prewalk-replace postwalk postwalk-demo postwalk-replace keywordize-keys stringify-keys)) + ("Content tests" + (clojure.core distinct? empty? every? not-every? some not-any?)) + ("Capabilities" + (clojure.core sequential? associative? sorted? counted? reversible?)) + ("Type tests" + (clojure.core type class coll? list? vector? set? map? seq? + number? integer? float? decimal? class? rational? ratio? + chunked-seq? reduced? special-symbol? record?)) + ("Lists" + ("Create" + (clojure.core list list*)) + ("Examine" + (clojure.core first nth peek)) + ("Change" + (clojure.core cons conj rest pop))) + + ("Vectors" + ("Create" + (clojure.core vec vector vector-of)) + ("Examine" + (clojure.core get peek)) + + ("Change" + (clojure.core assoc pop subvec replace conj rseq)) + ("Ops" + (clojure.core mapv filterv reduce-kv))) + + ("Sets" + ("Create" + (clojure.core set hash-set sorted-set sorted-set-by)) + ("Examine" + (clojure.core get contains?)) + ("Change" + (clojure.core conj disj)) + ("Relational Algebra" + (clojure.set join select project union difference intersection)) + ("Get map" + (clojure.set index rename-keys rename map-invert)) + ("Test" + (clojure.set subset? superset?)) + ("Sorted Sets" + (clojure.core rseq subseq rsubseq))) + + ("Maps" + ("Create" + (clojure.core hash-map array-map zipmap sorted-map sorted-map-by bean frequencies group-by)) + ("Examine" + (clojure.core get get-in contains? find keys vals map-entry?)) + ("Change" + (clojure.core assoc assoc-in dissoc merge merge-with select-keys update update-in)) + ("Entry" + (clojure.core key val)) + ("Sorted Maps" + (clojure.core rseq subseq rsubseq))) + + ("Hashes" + (clojure.core hash hash-ordered-coll hash-unordered-coll mix-collection-hash)) + + ("Volatiles" + (clojure.core volatile! volatile? vreset! vswap!))) + + ("Functions" + ("Create" + (clojure.core fn defn defn- definline identity constantly comp complement partial juxt memfn memoize fnil every-pred some-fn trampoline)) + ("Call" + (clojure.core -> ->> some-> some->> as-> cond-> cond->>)) + ("Test" + (clojure.core fn? ifn?))) + + ("Transducers" + ("Create" + (clojure.core cat dedupe distinct drop drop-while filter halt-when interpose keep keep-indexed map map-indexed mapcat partition-all partition-by random-sample remove replace take take-nth take-while)) + ("Call" + (clojure.core ->Eduction eduction into sequence transduce completing run!)) + ("Early Termination" + (clojure.core deref reduced reduced? ensure-reduced unreduced))) + + ("Spec" + ("Operations" + (clojure.spec.alpha valid? conform unform explain explain-data explain-str explain-out form describe assert check-asserts check-asserts?)) + ("Generator Ops" + (clojure.spec.alpha gen exercise exercise-fn)) + ("Defn & Registry" + (clojure.spec.alpha def fdef registry get-spec spec? spec with-gen)) + ("Logical" + (clojure.spec.alpha and or)) + ("Collection" + (clojure.spec.alpha coll-of map-of every every-kv keys merge)) + ("Regex " + (clojure.spec.alpha cat alt * + \? & keys*)) + ("Range" + (clojure.spec.alpha int-in inst-in double-in int-in-range? inst-in-range?)) + ("Custom Explain" + (clojure.spec.alpha explain-printer *explain-out*)) + ("Other" + (clojure.spec.alpha nilable multi-spec fspec conformer)) + + ("Predicates with test.check generators" + ("Numbers" + (clojure.core number? rational? integer? ratio? decimal? float? zero? double? int? nat-int? neg-int? pos-int?)) + ("Symbols & Keywords" + (clojure.core keyword? symbol? ident? qualified-ident? qualified-keyword? qualified-symbol? simple-ident? simple-keyword? simple-symbol?)) + ("Scalars" + (clojure.core string? true? false? nil? some? boolean? bytes? inst? uri? uuid?)) + ("Collections" + (clojure.core list? map? set? vector? associative? coll? sequential? seq? empty? indexed? seqable?)) + ("Other" + (clojure.core any?)))) + + ("Other" + ("XML" + (clojure.core xml-seq) + (clojure.xml parse)) + ("REPL" + (clojure.core *1 *2 *3 *e *print-dup* *print-length* *print-level* *print-meta* *print-readably*)) + ("EDN" + (clojure.edn read read-string)) + ("Compiling Code & Class Generation" + (clojure.core *compile-files* *compile-path* *file* *warn-on-reflection* compile gen-class gen-interface loaded-libs test)) + ("Misc" + (clojure.core eval force name *clojure-version* clojure-version *command-line-args*)) + ("Pretty Printing" + (clojure.pprint pprint print-table pp *print-right-margin*)) + ("Browser / Shell" + (clojure.java.browse browse-url) + (clojure.java.shell sh with-sh-dir with-sh-env))) + + ("Vars & Global Environment" + ("Def Variants" + (:special def) + (clojure.core defn defn- definline defmacro defmethod defmulti defonce defrecord)) + ("Interned Vars" + (:special var) + (clojure.core declare intern binding find-var)) + ("Var Objects" + (clojure.core with-local-vars var-get var-set alter-var-root var?)) + ("Var Validators" + (clojure.core set-validator! get-validator))) + + ("Reader Conditionals" + (clojure.core reader-conditional reader-conditional? tagged-literal tagged-literal?)) + + ("Abstractions" + ("Protocols" + (clojure.core defprotocol extend extend-type extend-protocol reify extends? satisfies? extenders)) + ("Records & Types" + (clojure.core defrecord deftype)) + ("Multimethods" + ("Define" + (clojure.core defmulti defmethod)) + ("Dispatch" + (clojure.core get-method methods)) + ("Remove" + (clojure.core remove-method remove-all-methods)) + ("Prefer" + (clojure.core prefer-method prefers)) + ("Relation" + (clojure.core derive isa? parents ancestors descendants make-hierarchy)))) + + ("Macros" + ("Create" + (clojure.core defmacro definline)) + ("Debug" + (clojure.core macroexpand-1 macroexpand) + (clojure.walk macroexpand-all)) + ("Branch" + (clojure.core and or when when-not when-let when-first if-not if-let cond condp case)) + ("Loop" + (clojure.core for doseq dotimes while)) + ("Arrange" + (clojure.core .. doto ->)) + ("Scope" + (clojure.core binding locking time) + (clojure.core with-in-str with-local-vars with-open with-out-str with-precision with-redefs with-redefs-fn)) + ("Lazy" + (clojure.core lazy-cat lazy-seq delay delay?)) + ("Doc" + (clojure.core assert comment) + (clojure.repl doc dir dir-fn source-fn))) + + ("Java Interop" + ("General" + (:special new set!) + (clojure.core .. doto bean comparator enumeration-seq import iterator-seq memfn definterface supers bases)) + ("Cast" + (clojure.core boolean byte short char int long float double bigdec bigint num cast biginteger)) + ("Exceptions" + (:special throw try catch finally) + (clojure.core ex-info ex-data Throwable->map StackTraceElement->vec) + (clojure.repl pst)) + ("Arrays" + ("Create" + (clojure.core boolean-array byte-array double-array char-array float-array int-array long-array make-array object-array short-array to-array)) + ("Manipulate" + (clojure.core aclone aget aset alength amap areduce aset-int aset-long aset-short aset-boolean aset-byte aset-char aset-double aset-float)) + ("Cast" + (clojure.core booleans bytes chars doubles floats ints longs shorts))) + ("Proxy" + ("Create" + (clojure.core proxy get-proxy-class construct-proxy init-proxy)) + ("Misc" + (clojure.core proxy-mappings proxy-super update-proxy)))) + + ("Namespaces" + ("Current" + (clojure.core *ns*)) + ("Create Switch" + (clojure.core ns in-ns create-ns)) + ("Add" + (clojure.core alias import intern refer refer-clojure)) + ("Find" + (clojure.core all-ns find-ns)) + ("Examine" + (clojure.core ns-aliases ns-imports ns-interns ns-map ns-name ns-publics ns-refers)) + ("From symbol" + (clojure.core resolve namespace ns-resolve the-ns)) + ("Remove" + (clojure.core ns-unalias ns-unmap remove-ns))) + ("Loading" + ("Load libs" + (clojure.core require use import refer)) + ("List Loaded" + (clojure.core loaded-libs)) + ("Load Misc" + (clojure.core load load-file load-reader load-string))) + + ("Concurrency" + ("Atoms" + (clojure.core atom swap! swap-vals! reset! reset-vals! compare-and-set!)) + ("Futures" + (clojure.core future future-call future-cancel future-cancelled? future-done? future?)) + ("Threads" + (clojure.core bound-fn bound-fn* get-thread-bindings pop-thread-bindings push-thread-bindings)) + + ("Misc" + (clojure.core locking pcalls pvalues pmap seque promise deliver)) + + ("Refs & Transactions" + ("Create" + (clojure.core ref)) + ("Examine" + (clojure.core deref)) + ("Transaction" + (clojure.core sync dosync io!)) + ("In Transaction" + (clojure.core ensure ref-set alter commute)) + ("Validators" + (clojure.core get-validator set-validator!)) + ("History" + (clojure.core ref-history-count ref-max-history ref-min-history))) + + ("Agents & Asynchronous Actions" + ("Create" + (clojure.core agent)) + ("Examine" + (clojure.core agent-error)) + ("Change State" + (clojure.core send send-off restart-agent send-via set-agent-send-executor! set-agent-send-off-executor!)) + ("Block Waiting" + (clojure.core await await-for)) + ("Ref Validators" + (clojure.core get-validator set-validator!)) + ("Watchers" + (clojure.core add-watch remove-watch)) + ("Thread Handling" + (clojure.core shutdown-agents)) + ("Error" + (clojure.core error-handler set-error-handler! error-mode set-error-mode!)) + ("Misc" + (clojure.core *agent* release-pending-sends)))) + + ("Sequences" + ("Creating a Lazy Seq" + ("From Collection" + (clojure.core seq sequence keys vals rseq subseq rsubseq)) + ("From Producer Fn" + (clojure.core lazy-seq repeatedly iterate)) + ("From Constant" + (clojure.core repeat range)) + ("From Other" + (clojure.core file-seq line-seq resultset-seq re-seq tree-seq xml-seq iterator-seq enumeration-seq)) + ("From Seq" + (clojure.core keep keep-indexed))) + + ("Seq in, Seq out" + ("Get shorter" + (clojure.core distinct dedupe filter remove for)) + ("Get longer" + (clojure.core cons conj concat lazy-cat mapcat cycle interleave interpose))) + ("Tail-items" + (clojure.core rest nthrest fnext nnext drop drop-while take-last for)) + ("Head-items" + (clojure.core take take-nth take-while butlast drop-last for)) + ("Change" + (clojure.core conj concat distinct flatten group-by partition partition-all partition-by split-at split-with filter remove replace shuffle random-sample)) + ("Rearrange" + (clojure.core reverse sort sort-by compare)) + ("Process items" + (clojure.core map pmap map-indexed mapcat for replace seque)) + + ("Using a Seq" + ("Extract item" + (clojure.core first second last rest next ffirst nfirst fnext nnext nth nthnext rand-nth when-first max-key min-key)) + ("Construct coll" + (clojure.core zipmap into reduce reductions set vec into-array to-array-2d)) + ("Pass to fn" + (clojure.core apply)) + ("Search" + (clojure.core some filter)) + ("Force evaluation" + (clojure.core doseq dorun doall)) + ("Check for forced" + (clojure.core realized?)))) + + ("Zippers" + ("Create" + (clojure.zip zipper seq-zip vector-zip xml-zip)) + ("Get loc" + (clojure.zip up down left right leftmost rightmost)) + ("Get seq" + (clojure.zip lefts rights path children)) + ("Change" + (clojure.zip make-node replace edit insert-child insert-left insert-right append-child remove)) + ("Move" + (clojure.zip next prev)) + ("XML" + (clojure.data.zip.xml attr attr= seq-test tag= text text= xml-> xml1->)) + ("Misc" + (clojure.zip root node branch? end?))) + + ("Documentation" + ("REPL" + (clojure.repl doc find-doc apropos source pst) + (clojure.java.javadoc javadoc))) + + ("Transients" + ("Create" + (clojure.core transient persistent!)) + ("Change" + (clojure.core conj! pop! assoc! dissoc! disj!))) + ("Misc" + ("Compare" + (clojure.core = == identical? not= not compare) + (clojure.data diff)) + ("Test" + (clojure.core true? false? nil? instance?))) + + ("IO" + ("To/from ..." + (clojure.core spit slurp)) + ("To *out*" + (clojure.core pr prn print printf println newline) + (clojure.pprint print-table)) + ("To writer" + (clojure.pprint pprint cl-format)) + ("To string" + (clojure.core format with-out-str pr-str prn-str print-str println-str)) + ("From *in*" + (clojure.core read-line read)) + ("From reader" + (clojure.core line-seq read)) + ("From string" + (clojure.core read-string with-in-str)) + ("Open" + (clojure.core with-open) + (clojure.java.io reader writer input-stream output-stream)) + ("Interop" + (clojure.java.io make-writer make-reader make-output-stream make-input-stream)) + ("Misc" + (clojure.core flush file-seq *in* *out* *err*) + (clojure.java.io file copy delete-file resource as-file as-url as-relative-path make-parents))) + + ("Metadata" + (clojure.core meta with-meta alter-meta! reset-meta! vary-meta)) + + ("Special Forms" + (:special def if do quote var recur throw try monitor-enter monitor-exit) + (clojure.core fn loop) + ("Binding / Destructuring" + (clojure.core let fn letfn defn defmacro loop for doseq if-let if-some when-let when-some))) + + ("Async" + ("Main" + (clojure.core.async go go-loop ! >!! chan put! take take! close! timeout offer! poll! promise-chan)) + ("Choice" + (clojure.core.async alt! alt!! alts! alts!! do-alts)) + ("Buffering" + (clojure.core.async buffer dropping-buffer sliding-buffer unblocking-buffer?)) + ("Pipelines" + (clojure.core.async pipeline pipeline-async pipeline-blocking)) + ("Threading" + (clojure.core.async thread thread-call)) + ("Mixing" + (clojure.core.async admix solo-mode mix unmix unmix-all toggle merge pipe unique)) + ("Multiples" + (clojure.core.async mult tap untap untap-all)) + ("Publish/Subscribe" + (clojure.core.async pub sub unsub unsub-all)) + ("Higher Order" + (clojure.core.async filter< filter> map map< map> mapcat< mapcat> partition partition-by reduce remove< remove> split)) + ("Pre-Populate" + (clojure.core.async into onto-chan to-chan))) + ("Unit Tests" + ("Defining" + (clojure.test deftest deftest- testing is are)) + ("Running" + (clojure.test run-tests run-all-tests test-vars)) + ("Fixtures" + (clojure.test use-fixtures join-fixtures compose-fixtures)))) + "A data structure for Clojure cheatsheet information. + +It's a tree, where the head of each list determines the context of the rest +of the list. The head may be: + + - A string, in which case it's a (sub)heading for the rest of the items. + + - A symbol, in which case it's the Clojure namespace of the symbols that + follow it. + + - The keyword :special, in which case it's a Clojure special form + + - Any other keyword, in which case it's a typed item that will be passed + through. + +Note that some Clojure symbols appear in more than once. This is entirely +intentional. For instance, `map` belongs in the sections on collections +and transducers.") + +(defun cider-cheatsheet--expand-vars (list) + "Expand the symbols in LIST to fully-qualified var names. + +This list is supposed to have the following format: + + (my-ns var1 var2 var3)" + (let ((ns (car list)) + (vars (cdr list))) + (if (eq ns :special) + (mapcar #'symbol-name vars) + (mapcar (lambda (var) (format "%s/%s" ns var)) vars)))) + +(defun cider-cheatsheet--select-var (var-list) + "Expand the symbols in VAR-LIST to fully-qualified var names. + +The list can hold one or more lists inside - one per each namespace." + (let ((namespaced-vars (seq-mapcat #'cider-cheatsheet--expand-vars + (seq-remove (lambda (list) + (eq (car list) :url)) + var-list)))) + (cider-doc-lookup (completing-read "Select var: " namespaced-vars)))) + +;;;###autoload +(defun cider-cheatsheet () + "Navigate `cider-cheatsheet-hierarchy' with `completing-read'. + +When you make it to a Clojure var its doc buffer gets displayed." + (interactive) + (let ((cheatsheet-data cider-cheatsheet-hierarchy)) + (while (stringp (caar cheatsheet-data)) + (let* ((sections (mapcar #'car cheatsheet-data)) + (sel-section (completing-read "Select cheatsheet section: " sections)) + (section-data (seq-find (lambda (elem) (equal (car elem) sel-section)) cheatsheet-data))) + (setq cheatsheet-data (cdr section-data)))) + (cider-cheatsheet--select-var cheatsheet-data))) + +(provide 'cider-cheatsheet) + +;;; cider-cheatsheet.el ends here diff --git a/elpa/cider-20170129.1941/cider-classpath.el b/elpa/cider-20181110.1413/cider-classpath.el similarity index 93% rename from elpa/cider-20170129.1941/cider-classpath.el rename to elpa/cider-20181110.1413/cider-classpath.el index ea7fe8a8..10141370 100644 --- a/elpa/cider-20170129.1941/cider-classpath.el +++ b/elpa/cider-20181110.1413/cider-classpath.el @@ -1,6 +1,6 @@ ;;; cider-classpath.el --- Basic Java classpath browser -;; Copyright © 2014-2017 Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors ;; 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 @@ -30,8 +30,6 @@ (defvar cider-classpath-buffer "*cider-classpath*") -(push cider-classpath-buffer cider-ancillary-buffers) - (defvar cider-classpath-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map cider-popup-buffer-mode-map) @@ -49,8 +47,8 @@ "Major mode for browsing the entries in Java's classpath. \\{cider-classpath-mode-map}" - (setq buffer-read-only t) (setq-local electric-indent-chars nil) + (setq-local sesman-system 'CIDER) (when cider-special-mode-truncate-lines (setq-local truncate-lines t))) @@ -94,7 +92,7 @@ (interactive) (cider-ensure-connected) (cider-ensure-op-supported "classpath") - (with-current-buffer (cider-popup-buffer cider-classpath-buffer t) + (with-current-buffer (cider-popup-buffer cider-classpath-buffer 'select nil 'ancillary) (cider-classpath-list (current-buffer) (mapcar (lambda (name) (cider-classpath-properties name)) @@ -106,7 +104,7 @@ (interactive) (cider-ensure-connected) (cider-ensure-op-supported "classpath") - (when-let ((entry (completing-read "Classpath entries: " (cider-sync-request:classpath)))) + (when-let* ((entry (completing-read "Classpath entries: " (cider-sync-request:classpath)))) (find-file-other-window entry))) (provide 'cider-classpath) diff --git a/elpa/cider-20181110.1413/cider-client.el b/elpa/cider-20181110.1413/cider-client.el new file mode 100644 index 00000000..2c092fbe --- /dev/null +++ b/elpa/cider-20181110.1413/cider-client.el @@ -0,0 +1,577 @@ +;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov +;; +;; Author: Bozhidar Batsov + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A layer of abstraction above the low-level nREPL client code. + +;;; Code: + +(require 'spinner) +(require 'nrepl-client) +(require 'cider-connection) +(require 'cider-common) +(require 'cider-util) +(require 'clojure-mode) + +(require 'subr-x) +(require 'cider-compat) +(require 'seq) + + +;;; Eval spinner +(defcustom cider-eval-spinner-type 'progress-bar + "Appearance of the evaluation spinner. + +Value is a symbol. The possible values are the symbols in the +`spinner-types' variable." + :type 'symbol + :group 'cider + :package-version '(cider . "0.10.0")) + +(defcustom cider-show-eval-spinner t + "When true, show the evaluation spinner in the mode line." + :type 'boolean + :group 'cider + :package-version '(cider . "0.10.0")) + +(defcustom cider-eval-spinner-delay 1 + "Amount of time, in seconds, after which the evaluation spinner will be shown." + :type 'integer + :group 'cider + :package-version '(cider . "0.10.0")) + +(defun cider-spinner-start (buffer) + "Start the evaluation spinner in BUFFER. +Do nothing if `cider-show-eval-spinner' is nil." + (when cider-show-eval-spinner + (with-current-buffer buffer + (spinner-start cider-eval-spinner-type nil + cider-eval-spinner-delay)))) + +(defun cider-eval-spinner-handler (eval-buffer original-callback) + "Return a response handler to stop the spinner and call ORIGINAL-CALLBACK. +EVAL-BUFFER is the buffer where the spinner was started." + (lambda (response) + ;; buffer still exists and + ;; we've got status "done" from nrepl + ;; stop the spinner + (when (and (buffer-live-p eval-buffer) + (let ((status (nrepl-dict-get response "status"))) + (or (member "done" status) + (member "eval-error" status) + (member "error" status)))) + (with-current-buffer eval-buffer + (when spinner-current (spinner-stop)))) + (funcall original-callback response))) + + +;;; Evaluation helpers +(defun cider-ns-form-p (form) + "Check if FORM is an ns form." + (string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form)) + +(defun cider-ns-from-form (ns-form) + "Get ns substring from NS-FORM." + (when (string-match "^[ \t\n]*\(ns[ \t\n]+\\([^][ \t\n(){}]+\\)" ns-form) + (match-string-no-properties 1 ns-form))) + +(defvar-local cider-buffer-ns nil + "Current Clojure namespace of some buffer. +Useful for special buffers (e.g. REPL, doc buffers) that have to keep track +of a namespace. This should never be set in Clojure buffers, as there the +namespace should be extracted from the buffer's ns form.") + +(defun cider-current-ns (&optional no-default) + "Return the current ns. +The ns is extracted from the ns form for Clojure buffers and from +`cider-buffer-ns' for all other buffers. If it's missing, use the current +REPL's ns, otherwise fall back to \"user\". When NO-DEFAULT is non-nil, it +will return nil instead of \"user\"." + (or cider-buffer-ns + (clojure-find-ns) + (when-let* ((repl (cider-current-repl))) + (buffer-local-value 'cider-buffer-ns repl)) + (if no-default nil "user"))) + +(defun cider-expected-ns (&optional path) + "Return the namespace string matching PATH, or nil if not found. +PATH is expected to be an absolute file path. If PATH is nil, use the path +to the file backing the current buffer. The command falls back to +`clojure-expected-ns' in the absence of an active nREPL connection." + (if (cider-connected-p) + (let* ((path (or path (file-truename (buffer-file-name)))) + (relpath (thread-last (cider-sync-request:classpath) + (seq-map + (lambda (cp) + (when (string-prefix-p cp path) + (substring path (length cp))))) + (seq-filter #'identity) + (seq-sort (lambda (a b) + (< (length a) (length b)))) + (car)))) + (if relpath + (thread-last (substring relpath 1) ; remove leading / + (file-name-sans-extension) + (replace-regexp-in-string "/" ".") + (replace-regexp-in-string "_" "-")) + (clojure-expected-ns path))) + (clojure-expected-ns path))) + +(defun cider-nrepl-op-supported-p (op &optional connection) + "Check whether the CONNECTION supports the nREPL middleware OP." + (nrepl-op-supported-p op (or connection (cider-current-repl)))) + +(defvar cider-version) +(defun cider-ensure-op-supported (op) + "Check for support of middleware op OP. +Signal an error if it is not supported." + (unless (cider-nrepl-op-supported-p op) + (user-error "`%s' requires the nREPL op \"%s\" (provided by cider-nrepl)" this-command op))) + +(defun cider-nrepl-send-request (request callback &optional connection) + "Send REQUEST and register response handler CALLBACK. +REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" + \"par1\" ... ). +If CONNECTION is provided dispatch to that connection instead of +the current connection. Return the id of the sent message." + (nrepl-send-request request callback (or connection (cider-current-repl "any")))) + +(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input) + "Send REQUEST to the nREPL server synchronously using CONNECTION. +Hold till final \"done\" message has arrived and join all response messages +of the same \"op\" that came along and return the accumulated response. +If ABORT-ON-INPUT is non-nil, the function will return nil +at the first sign of user input, so as not to hang the +interface." + (nrepl-send-sync-request request + (or connection (cider-current-repl "any")) + abort-on-input)) + +(defun cider-nrepl-send-unhandled-request (request &optional connection) + "Send REQUEST to the nREPL CONNECTION and ignore any responses. +Immediately mark the REQUEST as done. Return the id of the sent message." + (let* ((conn (or connection (cider-current-repl "any"))) + (id (nrepl-send-request request #'ignore conn))) + (with-current-buffer conn + (nrepl--mark-id-completed id)) + id)) + +(defun cider-nrepl-request:eval (input callback &optional ns line column additional-params connection) + "Send the request INPUT and register the CALLBACK as the response handler. +If NS is non-nil, include it in the request. LINE and COLUMN, if non-nil, +define the position of INPUT in its buffer. ADDITIONAL-PARAMS is a plist +to be appended to the request message. CONNECTION is the connection +buffer, defaults to (cider-current-repl)." + (let ((connection (or connection (cider-current-repl)))) + (nrepl-request:eval input + (if cider-show-eval-spinner + (cider-eval-spinner-handler connection callback) + callback) + connection + ns line column additional-params) + (cider-spinner-start connection))) + +(defun cider-nrepl-sync-request:eval (input &optional connection ns) + "Send the INPUT to the nREPL CONNECTION synchronously. +If NS is non-nil, include it in the eval request." + (nrepl-sync-request:eval input (or connection (cider-current-repl)) ns)) + +(defcustom cider-pprint-fn 'pprint + "Sets the function to use when pretty-printing evaluation results. + +The value must be one of the following symbols: + +`pprint' - to use \\=`clojure.pprint/pprint\\=` + +`fipp' - to use the Fast Idiomatic Pretty Printer, approximately 5-10x +faster than \\=`clojure.core/pprint\\=` (this is the default) + +`puget' - to use Puget, which provides canonical serialization of data on +top of fipp, but at a slight performance cost + +Alternatively, can be the namespace-qualified name of a Clojure function of +one argument. If the function cannot be resolved, an exception will be +thrown. + +The function is assumed to respect the contract of \\=`clojure.pprint/pprint\\=` +with respect to the bound values of \\=`*print-length*\\=`, \\=`*print-level*\\=`, +\\=`*print-meta*\\=`, and \\=`clojure.pprint/*print-right-margin*\\=`." + :type '(choice (const pprint) + (const fipp) + (const puget) + string) + :group 'cider + :package-version '(cider . "0.11.0")) + +(defun cider--pprint-fn () + "Return the value to send in the pprint-fn slot of messages." + (pcase cider-pprint-fn + (`pprint "clojure.pprint/pprint") + (`fipp "cider.nrepl.middleware.pprint/fipp-pprint") + (`puget "cider.nrepl.middleware.pprint/puget-pprint") + (_ cider-pprint-fn))) + +(defun cider--nrepl-pprint-request-plist (right-margin &optional pprint-fn) + "Plist to be appended to an eval request to make it use pprint. +PPRINT-FN is the name of the Clojure function to use. +RIGHT-MARGIN specifies the maximum column-width of the pretty-printed +result, and is included in the request if non-nil." + (nconc `("pprint" "true" + "pprint-fn" ,(or pprint-fn (cider--pprint-fn))) + (and right-margin `("print-right-margin" ,right-margin)))) + +(defun cider--nrepl-content-type-plist () + "Plist to be appended to an eval request to make it use content-types." + '("content-type" "true")) + +(defun cider-tooling-eval (input callback &optional ns connection) + "Send the request INPUT to CONNECTION and register the CALLBACK. +NS specifies the namespace in which to evaluate the request. Requests +evaluated in the tooling nREPL session don't affect the thread-local +bindings of the primary eval nREPL session (e.g. this is not going to +clobber *1/2/3)." + ;; namespace forms are always evaluated in the "user" namespace + (nrepl-request:eval input + callback + (or connection (cider-current-repl)) + ns nil nil nil 'tooling)) + +(defun cider-sync-tooling-eval (input &optional ns connection) + "Send the request INPUT to CONNECTION and evaluate in synchronously. +NS specifies the namespace in which to evaluate the request. Requests +evaluated in the tooling nREPL session don't affect the thread-local +bindings of the primary eval nREPL session (e.g. this is not going to +clobber *1/2/3)." + ;; namespace forms are always evaluated in the "user" namespace + (nrepl-sync-request:eval input + (or connection (cider-current-repl)) + ns + 'tooling)) + +;; TODO: Add some unit tests and pretty those two functions up. +;; FIXME: Currently that's broken for group-id with multiple segments (e.g. org.clojure/clojure) +(defun cider-classpath-libs () + "Return a list of all libs on the classpath." + (let ((libs (seq-filter (lambda (cp-entry) + (string-suffix-p ".jar" cp-entry)) + (cider-sync-request:classpath))) + (dir-sep (if (string-equal system-type "windows-nt") "\\\\" "/"))) + (thread-last libs + (seq-map (lambda (s) (split-string s dir-sep))) + (seq-map #'reverse) + (seq-map (lambda (l) (reverse (seq-take l 4))))))) + +(defun cider-library-present-p (lib) + "Check whether LIB is present on the classpath. +The library is a string of the format \"group-id/artifact-id\"." + (let* ((lib (split-string lib "/")) + (group-id (car lib)) + (artifact-id (cadr lib))) + (seq-find (lambda (lib) + (let ((g (car lib)) + (a (cadr lib))) + (and (equal group-id g) (equal artifact-id a)))) + (cider-classpath-libs)))) + + +;;; Interrupt evaluation + +(defun cider-interrupt-handler (buffer) + "Create an interrupt response handler for BUFFER." + (nrepl-make-response-handler buffer nil nil nil nil)) + +(defun cider-interrupt () + "Interrupt any pending evaluations." + (interactive) + ;; FIXME: does this work correctly in cljc files? + (with-current-buffer (cider-current-repl) + (let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests))) + (dolist (request-id pending-request-ids) + (nrepl-request:interrupt + request-id + (cider-interrupt-handler (current-buffer)) + (cider-current-repl)))))) + +(defun cider-nrepl-eval-session () + "Return the eval nREPL session id of the current connection." + (with-current-buffer (cider-current-repl) + nrepl-session)) + +(defun cider-nrepl-tooling-session () + "Return the tooling nREPL session id of the current connection." + (with-current-buffer (cider-current-repl) + nrepl-tooling-session)) + +(defun cider--var-choice (var-info) + "Prompt to choose from among multiple VAR-INFO candidates, if required. +This is needed only when the symbol queried is an unqualified host platform +method, and multiple classes have a so-named member. If VAR-INFO does not +contain a `candidates' key, it is returned as is." + (let ((candidates (nrepl-dict-get var-info "candidates"))) + (if candidates + (let* ((classes (nrepl-dict-keys candidates)) + (choice (completing-read "Member in class: " classes nil t)) + (info (nrepl-dict-get candidates choice))) + info) + var-info))) + +(defun cider-var-info (var &optional all) + "Return VAR's info as an alist with list cdrs. +When multiple matching vars are returned you'll be prompted to select one, +unless ALL is truthy." + (when (and var (not (string= var ""))) + (let ((var-info (cider-sync-request:info var))) + (if all var-info (cider--var-choice var-info))))) + +(defun cider-member-info (class member) + "Return the CLASS MEMBER's info as an alist with list cdrs." + (when (and class member) + (cider-sync-request:info nil class member))) + + +;;; Requests + +(declare-function cider-load-file-handler "cider-eval") +(defun cider-request:load-file (file-contents file-path file-name &optional connection callback) + "Perform the nREPL \"load-file\" op. +FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be +loaded. If CONNECTION is nil, use `cider-current-repl'. If CALLBACK +is nil, use `cider-load-file-handler'." + (cider-nrepl-send-request `("op" "load-file" + "file" ,file-contents + "file-path" ,file-path + "file-name" ,file-name) + (or callback + (cider-load-file-handler (current-buffer))) + connection)) + + +;;; Sync Requests + +(defcustom cider-filtered-namespaces-regexps + '("^cider.nrepl" "^refactor-nrepl" "^clojure.tools.nrepl" "^nrepl") + "List of regexps used to filter out some vars/symbols/namespaces. +When nil, nothing is filtered out. Otherwise, all namespaces matching any +regexp from this list are dropped out of the \"ns-list\" op. Also, +\"apropos\" won't include vars from such namespaces. This list is passed +on to the nREPL middleware without any pre-processing. So the regexps have +to be in Clojure format (with twice the number of backslashes) and not +Emacs Lisp." + :type '(repeat string) + :safe #'listp + :group 'cider + :package-version '(cider . "0.13.0")) + +(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p) + "Send \"apropos\" request for regexp QUERY. + +Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." + (let* ((query (replace-regexp-in-string "[ \t]+" ".+" query)) + (response (cider-nrepl-send-sync-request + `("op" "apropos" + "ns" ,(cider-current-ns) + "query" ,query + ,@(when search-ns `("search-ns" ,search-ns)) + ,@(when docs-p '("docs?" "t")) + ,@(when privates-p '("privates?" "t")) + ,@(when case-sensitive-p '("case-sensitive?" "t")) + "filter-regexps" ,cider-filtered-namespaces-regexps)))) + (if (member "apropos-regexp-error" (nrepl-dict-get response "status")) + (user-error "Invalid regexp: %s" (nrepl-dict-get response "error-msg")) + (nrepl-dict-get response "apropos-matches")))) + +(defun cider-sync-request:classpath () + "Return a list of classpath entries." + (cider-ensure-op-supported "classpath") + (thread-first '("op" "classpath") + (cider-nrepl-send-sync-request) + (nrepl-dict-get "classpath"))) + +(defun cider-sync-request:complete (str context) + "Return a list of completions for STR using nREPL's \"complete\" op. +CONTEXT represents a completion context for compliment." + (when-let* ((dict (thread-first `("op" "complete" + "ns" ,(cider-current-ns) + "symbol" ,str + "context" ,context) + (cider-nrepl-send-sync-request nil 'abort-on-input)))) + (nrepl-dict-get dict "completions"))) + +(defun cider-sync-request:complete-flush-caches () + "Send \"complete-flush-caches\" op to flush Compliment's caches." + (cider-nrepl-send-sync-request (list "op" "complete-flush-caches" + "session" (cider-nrepl-eval-session)) + 'abort-on-input)) + +(defun cider-sync-request:info (symbol &optional class member) + "Send \"info\" op with parameters SYMBOL or CLASS and MEMBER." + (let ((var-info (thread-first `("op" "info" + "ns" ,(cider-current-ns) + ,@(when symbol `("symbol" ,symbol)) + ,@(when class `("class" ,class)) + ,@(when member `("member" ,member))) + (cider-nrepl-send-sync-request)))) + (if (member "no-info" (nrepl-dict-get var-info "status")) + nil + var-info))) + +(defun cider-sync-request:eldoc (symbol &optional class member) + "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER." + (when-let* ((eldoc (thread-first `("op" "eldoc" + "ns" ,(cider-current-ns) + ,@(when symbol `("symbol" ,symbol)) + ,@(when class `("class" ,class)) + ,@(when member `("member" ,member))) + (cider-nrepl-send-sync-request nil 'abort-on-input)))) + (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) + nil + eldoc))) + +(defun cider-sync-request:eldoc-datomic-query (symbol) + "Send \"eldoc-datomic-query\" op with parameter SYMBOL." + (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query" + "ns" ,(cider-current-ns) + ,@(when symbol `("symbol" ,symbol))) + (cider-nrepl-send-sync-request nil 'abort-on-input)))) + (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) + nil + eldoc))) + +(defun cider-sync-request:spec-list (&optional filter-regex) + "Get a list of the available specs in the registry. +Optional argument FILTER-REGEX filters specs. By default, all specs are +returned." + (setq filter-regex (or filter-regex "")) + (thread-first `("op" "spec-list" + "filter-regex" ,filter-regex) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-list"))) + +(defun cider-sync-request:spec-form (spec) + "Get SPEC's form from registry." + (thread-first `("op" "spec-form" + "spec-name" ,spec) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-form"))) + +(defun cider-sync-request:spec-example (spec) + "Get an example for SPEC." + (thread-first `("op" "spec-example" + "spec-name" ,spec) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-example"))) + +(defun cider-sync-request:ns-list () + "Get a list of the available namespaces." + (thread-first `("op" "ns-list" + "filter-regexps" ,cider-filtered-namespaces-regexps) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-list"))) + +(defun cider-sync-request:ns-vars (ns) + "Get a list of the vars in NS." + (thread-first `("op" "ns-vars" + "ns" ,ns) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-vars"))) + +(defun cider-sync-request:ns-path (ns) + "Get the path to the file containing NS." + (thread-first `("op" "ns-path" + "ns" ,ns) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "path"))) + +(defun cider-sync-request:ns-vars-with-meta (ns) + "Get a map of the vars in NS to its metadata information." + (thread-first `("op" "ns-vars-with-meta" + "ns" ,ns) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-vars-with-meta"))) + +(defun cider-sync-request:ns-load-all () + "Load all project namespaces." + (thread-first '("op" "ns-load-all") + (cider-nrepl-send-sync-request) + (nrepl-dict-get "loaded-ns"))) + +(defun cider-sync-request:resource (name) + "Perform nREPL \"resource\" op with resource name NAME." + (thread-first `("op" "resource" + "name" ,name) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "resource-path"))) + +(defun cider-sync-request:resources-list () + "Return a list of all resources on the classpath. +The result entries are relative to the classpath." + (when-let* ((resources (thread-first '("op" "resources-list") + (cider-nrepl-send-sync-request) + (nrepl-dict-get "resources-list")))) + (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources))) + +(defun cider-sync-request:format-code (code) + "Perform nREPL \"format-code\" op with CODE." + (thread-first `("op" "format-code" + "code" ,code) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "formatted-code"))) + +(defun cider-sync-request:format-edn (edn right-margin) + "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." + (let* ((response (thread-first `("op" "format-edn" + "edn" ,edn) + (append (cider--nrepl-pprint-request-plist right-margin)) + (cider-nrepl-send-sync-request))) + (err (nrepl-dict-get response "err"))) + (when err + ;; err will be a stacktrace with a first line that looks like: + ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" + (error (car (split-string err "\n")))) + (nrepl-dict-get response "formatted-edn"))) + +;;; Dealing with input +;; TODO: Replace this with some nil handler. +(defun cider-stdin-handler (&optional _buffer) + "Make a stdin response handler for _BUFFER." + (nrepl-make-response-handler (current-buffer) + (lambda (_buffer _value)) + (lambda (_buffer _out)) + (lambda (_buffer _err)) + nil)) + +(defun cider-need-input (buffer) + "Handle an need-input request from BUFFER." + (with-current-buffer buffer + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map (kbd "C-c C-c") 'abort-recursive-edit) + (let ((stdin (condition-case nil + (concat (read-from-minibuffer "Stdin: " nil map) "\n") + (quit nil)))) + (nrepl-request:stdin stdin + (cider-stdin-handler buffer) + (cider-current-repl)))))) + +(provide 'cider-client) + +;;; cider-client.el ends here diff --git a/elpa/cider-20170129.1941/cider-common.el b/elpa/cider-20181110.1413/cider-common.el similarity index 54% rename from elpa/cider-20170129.1941/cider-common.el rename to elpa/cider-20181110.1413/cider-common.el index 053100d7..48a27446 100644 --- a/elpa/cider-20170129.1941/cider-common.el +++ b/elpa/cider-20181110.1413/cider-common.el @@ -1,6 +1,6 @@ ;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- -;; Copyright © 2015-2017 Artur Malabarba +;; Copyright © 2015-2018 Artur Malabarba ;; Author: Artur Malabarba @@ -28,6 +28,7 @@ (require 'cider-compat) (require 'nrepl-dict) (require 'cider-util) +(require 'etags) ; for find-tags-marker-ring (require 'tramp) (defcustom cider-prompt-for-symbol t @@ -70,7 +71,45 @@ INVERT is used to invert the semantics of the function `cider--should-prompt-for (when kw (replace-regexp-in-string "\\`:+" "" kw))) -(declare-function cider-read-from-minibuffer "cider-interaction") +;;; Minibuffer +(defvar cider-minibuffer-history '() + "History list of expressions read from the minibuffer.") + +(defvar cider-minibuffer-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map (kbd "TAB") #'complete-symbol) + (define-key map (kbd "M-TAB") #'complete-symbol) + map) + "Minibuffer keymap used for reading Clojure expressions.") + +(declare-function cider-complete-at-point "cider-completion") +(declare-function cider-eldoc "cider-eldoc") +(defun cider-read-from-minibuffer (prompt &optional value) + "Read a string from the minibuffer, prompting with PROMPT. +If VALUE is non-nil, it is inserted into the minibuffer as initial-input. +PROMPT need not end with \": \". If it doesn't, VALUE is displayed on the +prompt as a default value (used if the user doesn't type anything) and is +not used as initial input (input is left empty)." + (minibuffer-with-setup-hook + (lambda () + (set-syntax-table clojure-mode-syntax-table) + (add-hook 'completion-at-point-functions + #'cider-complete-at-point nil t) + (setq-local eldoc-documentation-function #'cider-eldoc) + (run-hooks 'eval-expression-minibuffer-setup-hook)) + (let* ((has-colon (string-match ": \\'" prompt)) + (input (read-from-minibuffer (cond + (has-colon prompt) + (value (format "%s (default %s): " prompt value)) + (t (format "%s: " prompt))) + (when has-colon value) ; initial-input + cider-minibuffer-map nil + 'cider-minibuffer-history + (unless has-colon value)))) ; default-value + (if (and (equal input "") value (not has-colon)) + value + input)))) (defun cider-read-symbol-name (prompt callback) "Read a symbol name using PROMPT with a default of the one at point. @@ -86,7 +125,53 @@ On failure, read a symbol name using PROMPT and call CALLBACK with that." (condition-case nil (funcall callback (cider--kw-to-symbol (cider-symbol-at-point 'look-back))) ('error (funcall callback (cider-read-from-minibuffer prompt))))) -(declare-function cider-jump-to "cider-interaction") +(declare-function cider-mode "cider-mode") + +(defun cider-jump-to (buffer &optional pos other-window) + "Push current point onto marker ring, and jump to BUFFER and POS. +POS can be either a number, a cons, or a symbol. +If a number, it is the character position (the point). +If a cons, it specifies the position as (LINE . COLUMN). COLUMN can be nil. +If a symbol, `cider-jump-to' searches for something that looks like the +symbol's definition in the file. +If OTHER-WINDOW is non-nil don't reuse current window." + (with-no-warnings + (ring-insert find-tag-marker-ring (point-marker))) + (if other-window + (pop-to-buffer buffer) + ;; like switch-to-buffer, but reuse existing window if BUFFER is visible + (pop-to-buffer buffer '((display-buffer-reuse-window display-buffer-same-window)))) + (with-current-buffer buffer + (widen) + (goto-char (point-min)) + (cider-mode +1) + (cond + ;; Line-column specification. + ((consp pos) + (forward-line (1- (or (car pos) 1))) + (if (cdr pos) + (move-to-column (cdr pos)) + (back-to-indentation))) + ;; Point specification. + ((numberp pos) + (goto-char pos)) + ;; Symbol or string. + (pos + ;; Try to find (def full-name ...). + (if (or (save-excursion + (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote pos)) + nil 'noerror)) + (let ((name (replace-regexp-in-string ".*/" "" pos))) + ;; Try to find (def name ...). + (or (save-excursion + (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote name)) + nil 'noerror)) + ;; Last resort, just find the first occurrence of `name'. + (save-excursion + (search-forward name nil 'noerror))))) + (goto-char (match-beginning 0)) + (message "Can't find %s in %s" pos (buffer-file-name)))) + (t nil)))) (defun cider--find-buffer-for-file (file) "Return a buffer visiting FILE. @@ -123,20 +208,34 @@ create a valid path." (match-string 1 filename) filename))) +(defun cider-make-tramp-prefix (method user host) + "Constructs a Tramp file prefix from METHOD, USER, HOST. +It originated from Tramp's `tramp-make-tramp-file-name'. The original be +forced to make full file name with `with-parsed-tramp-file-name', not providing +prefix only option." + (concat tramp-prefix-format + (unless (zerop (length method)) + (concat method tramp-postfix-method-format)) + (unless (zerop (length user)) + (concat user tramp-postfix-user-format)) + (when host + (if (string-match tramp-ipv6-regexp host) + (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) + host)) + tramp-postfix-host-format)) + (defun cider-tramp-prefix (&optional buffer) "Use the filename for BUFFER to determine a tramp prefix. -Defaults to the current buffer. -Return the tramp prefix, or nil if BUFFER is local." +Defaults to the current buffer. Return the tramp prefix, or nil +if BUFFER is local." (let* ((buffer (or buffer (current-buffer))) (name (or (buffer-file-name buffer) (with-current-buffer buffer default-directory)))) (when (tramp-tramp-file-p name) - (let ((vec (tramp-dissect-file-name name))) - (tramp-make-tramp-file-name (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - nil))))) + (with-parsed-tramp-file-name name v + (with-no-warnings + (cider-make-tramp-prefix v-method v-user v-host)))))) (defun cider--client-tramp-filename (name &optional buffer) "Return the tramp filename for path NAME relative to BUFFER. @@ -144,6 +243,7 @@ If BUFFER has a tramp prefix, it will be added as a prefix to NAME. If the resulting path is an existing tramp file, it returns the path, otherwise, nil." (let* ((buffer (or buffer (current-buffer))) + (name (replace-regexp-in-string "^file:" "" name)) (name (concat (cider-tramp-prefix buffer) name))) (if (tramp-handle-file-exists-p name) name))) @@ -186,44 +286,54 @@ If no local or remote file exists, return nil." (defun cider-find-file (url) "Return a buffer visiting the file URL if it exists, or nil otherwise. If URL has a scheme prefix, it must represent a fully-qualified file path -or an entry within a zip/jar archive. If URL doesn't contain a scheme -prefix and is an absolute path, it is treated as such. Finally, if URL is -relative, it is expanded within each of the open Clojure buffers till an -existing file ending with URL has been found." +or an entry within a zip/jar archive. If AVFS (archive virtual file +system; see online docs) is mounted the archive entry is opened inside the +AVFS directory, otherwise the entry is archived into a temporary read-only +buffer. If URL doesn't contain a scheme prefix and is an absolute path, it +is treated as such. Finally, if URL is relative, it is expanded within each +of the open Clojure buffers till an existing file ending with URL has been +found." (require 'arc-mode) (cond ((string-match "^file:\\(.+\\)" url) - (when-let ((file (cider--url-to-file (match-string 1 url))) - (path (cider--file-path file))) + (when-let* ((file (cider--url-to-file (match-string 1 url))) + (path (cider--file-path file))) (find-file-noselect path))) ((string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" url) - (when-let ((entry (match-string 3 url)) - (file (cider--url-to-file (match-string 2 url))) - (path (cider--file-path file)) - (name (format "%s:%s" path entry))) - (or (find-buffer-visiting name) - (if (tramp-tramp-file-p path) - (progn - ;; Use emacs built in archiving - (find-file path) - (goto-char (point-min)) - ;; Make sure the file path is followed by a newline to - ;; prevent eg. clj matching cljs. - (search-forward (concat entry "\n")) - ;; moves up to matching line - (forward-line -1) - (archive-extract) - (current-buffer)) - ;; Use external zip program to just extract the single file - (with-current-buffer (generate-new-buffer - (file-name-nondirectory entry)) - (archive-zip-extract path entry) - (set-visited-file-name name) - (setq-local default-directory (file-name-directory path)) - (setq-local buffer-read-only t) - (set-buffer-modified-p nil) - (set-auto-mode) - (current-buffer)))))) - (t (if-let ((path (cider--file-path url))) + (when-let* ((entry (match-string 3 url)) + (file (cider--url-to-file (match-string 2 url))) + (path (cider--file-path file)) + (name (format "%s:%s" path entry)) + (avfs (format "%s%s#uzip/%s" + (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/")) + path entry))) + (cond + ;; 1) use avfs + ((file-exists-p avfs) + (find-file-noselect avfs)) + ;; 2) already uncompressed + ((find-buffer-visiting name)) + ;; 3) on remotes use Emacs built-in archiving + ((tramp-tramp-file-p path) + (find-file path) + (goto-char (point-min)) + ;; anchor to eol to prevent eg. clj matching cljs. + (re-search-forward (concat entry "$")) + (let ((archive-buffer (current-buffer))) + (archive-extract) + (kill-buffer archive-buffer)) + (current-buffer)) + ;; 4) Use external zip program to extract a single file + (t + (with-current-buffer (generate-new-buffer + (file-name-nondirectory entry)) + (archive-zip-extract path entry) + (set-visited-file-name name) + (setq-local default-directory (file-name-directory path)) + (setq-local buffer-read-only t) + (set-buffer-modified-p nil) + (set-auto-mode) + (current-buffer)))))) + (t (if-let* ((path (cider--file-path url))) (find-file-noselect path) (unless (file-name-absolute-p url) (let ((cider-buffers (cider-util--clojure-buffers)) diff --git a/elpa/cider-20181110.1413/cider-compat.el b/elpa/cider-20181110.1413/cider-compat.el new file mode 100644 index 00000000..e6b64b28 --- /dev/null +++ b/elpa/cider-20181110.1413/cider-compat.el @@ -0,0 +1,54 @@ +;;; cider-compat.el --- Functions from newer Emacs versions for compatibility -*- lexical-binding: t -*- + +;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Everything here was copied from subr-x for compatibility with +;; Emacs 25.1. + +;;; Code: + +(eval-and-compile + + (unless (fboundp 'if-let*) + (defmacro if-let* (bindings then &rest else) + "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. +Argument BINDINGS is a list of tuples whose car is a symbol to be +bound and (optionally) used in THEN, and its cadr is a sexp to be +evalled to set symbol's value." + (declare (indent 2) + (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) + `(let* ,(internal--build-bindings bindings) + (if ,(car (internal--listify (car (last bindings)))) + ,then + ,@else)))) + + (unless (fboundp 'when-let*) + (defmacro when-let* (bindings &rest body) + "Process BINDINGS and if all values are non-nil eval BODY. +Argument BINDINGS is a list of tuples whose car is a symbol to be +bound and (optionally) used in BODY, and its cadr is a sexp to be +evalled to set symbol's value." + (declare (indent 1) (debug if-let*)) + `(if-let* ,bindings ,(macroexp-progn body))))) + +(provide 'cider-compat) +;;; cider-compat.el ends here diff --git a/elpa/cider-20181110.1413/cider-completion.el b/elpa/cider-20181110.1413/cider-completion.el new file mode 100644 index 00000000..c52769ee --- /dev/null +++ b/elpa/cider-20181110.1413/cider-completion.el @@ -0,0 +1,253 @@ +;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Smart REPL-powered code completion and integration with company-mode. + +;;; Code: + +(require 'subr-x) +(require 'thingatpt) + +(require 'cider-client) +(require 'cider-common) +(require 'cider-eldoc) +(require 'nrepl-dict) + +(defcustom cider-completion-use-context t + "When true, uses context at point to improve completion suggestions." + :type 'boolean + :group 'cider + :package-version '(cider . "0.7.0")) + +(defcustom cider-annotate-completion-candidates t + "When true, annotate completion candidates with some extra information." + :type 'boolean + :group 'cider + :package-version '(cider . "0.8.0")) + +(defcustom cider-annotate-completion-function + #'cider-default-annotate-completion-function + "Controls how the annotations for completion candidates are formatted. +Must be a function that takes two arguments: the abbreviation of the +candidate type according to `cider-completion-annotations-alist' and the +candidate's namespace." + :type 'function + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-completion-annotations-alist + '(("class" "c") + ("field" "fi") + ("function" "f") + ("import" "i") + ("keyword" "k") + ("local" "l") + ("macro" "m") + ("method" "me") + ("namespace" "n") + ("protocol" "p") + ("protocol-function" "pf") + ("record" "r") + ("special-form" "s") + ("static-field" "sf") + ("static-method" "sm") + ("type" "t") + ("var" "v")) + "Controls the abbreviations used when annotating completion candidates. + +Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE +is a possible value of the candidate's type returned from the completion +backend, and ABBREVIATION is a short form of that type." + :type '(alist :key-type string :value-type string) + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-completion-annotations-include-ns 'unqualified + "Controls passing of namespaces to `cider-annotate-completion-function'. + +When set to 'always, the candidate's namespace will always be passed if it +is available. When set to 'unqualified, the namespace will only be passed +if the candidate is not namespace-qualified." + :type '(choice (const always) + (const unqualified) + (const :tag "never" nil)) + :group 'cider + :package-version '(cider . "0.9.0")) + +(defvar cider-completion-last-context nil) + +(defun cider-completion-symbol-start-pos () + "Find the starting position of the symbol at point, unless inside a string." + (let ((sap (symbol-at-point))) + (when (and sap (not (nth 3 (syntax-ppss)))) + (car (bounds-of-thing-at-point 'symbol))))) + +(defun cider-completion-get-context-at-point () + "Extract the context at point. +If point is not inside the list, returns nil; otherwise return \"top-level\" +form, with symbol at point replaced by __prefix__." + (when (save-excursion + (condition-case _ + (progn + (up-list) + (check-parens) + t) + (scan-error nil) + (user-error nil))) + (save-excursion + (let* ((pref-end (point)) + (pref-start (cider-completion-symbol-start-pos)) + (context (cider-defun-at-point)) + (_ (beginning-of-defun)) + (expr-start (point))) + (concat (when pref-start (substring context 0 (- pref-start expr-start))) + "__prefix__" + (substring context (- pref-end expr-start))))))) + +(defun cider-completion-get-context () + "Extract context depending on `cider-completion-use-context' and major mode." + (let ((context (if (and cider-completion-use-context + ;; Important because `beginning-of-defun' and + ;; `ending-of-defun' work incorrectly in the REPL + ;; buffer, so context extraction fails there. + (derived-mode-p 'clojure-mode)) + (or (cider-completion-get-context-at-point) + "nil") + "nil"))) + (if (string= cider-completion-last-context context) + ":same" + (setq cider-completion-last-context context) + context))) + +(defun cider-completion--parse-candidate-map (candidate-map) + "Get \"candidate\" from CANDIDATE-MAP. +Put type and ns properties on the candidate" + (let ((candidate (nrepl-dict-get candidate-map "candidate")) + (type (nrepl-dict-get candidate-map "type")) + (ns (nrepl-dict-get candidate-map "ns"))) + (put-text-property 0 1 'type type candidate) + (put-text-property 0 1 'ns ns candidate) + candidate)) + +(defun cider-complete (str) + "Complete STR with context at point." + (let* ((context (cider-completion-get-context)) + (candidates (cider-sync-request:complete str context))) + (mapcar #'cider-completion--parse-candidate-map candidates))) + +(defun cider-completion--get-candidate-type (symbol) + "Get candidate type for SYMBOL." + (let ((type (get-text-property 0 'type symbol))) + (or (cadr (assoc type cider-completion-annotations-alist)) + type))) + +(defun cider-completion--get-candidate-ns (symbol) + "Get candidate ns for SYMBOL." + (when (or (eq 'always cider-completion-annotations-include-ns) + (and (eq 'unqualified cider-completion-annotations-include-ns) + (not (cider-namespace-qualified-p symbol)))) + (get-text-property 0 'ns symbol))) + +(defun cider-default-annotate-completion-function (type ns) + "Get completion function based on TYPE and NS." + (concat (when ns (format " (%s)" ns)) + (when type (format " <%s>" type)))) + +(defun cider-annotate-symbol (symbol) + "Return a string suitable for annotating SYMBOL. +If SYMBOL has a text property `type` whose value is recognised, its +abbreviation according to `cider-completion-annotations-alist' will be +used. If `type` is present but not recognised, its value will be used +unaltered. If SYMBOL has a text property `ns`, then its value will be used +according to `cider-completion-annotations-include-ns'. The formatting is +performed by `cider-annotate-completion-function'." + (when cider-annotate-completion-candidates + (let* ((type (cider-completion--get-candidate-type symbol)) + (ns (cider-completion--get-candidate-ns symbol))) + (funcall cider-annotate-completion-function type ns)))) + +(defun cider-complete-at-point () + "Complete the symbol at point." + (when-let* ((bounds (bounds-of-thing-at-point 'symbol))) + (when (and (cider-connected-p) + (not (or (cider-in-string-p) (cider-in-comment-p)))) + (list (car bounds) (cdr bounds) + (completion-table-dynamic #'cider-complete) + :annotation-function #'cider-annotate-symbol + :company-doc-buffer #'cider-create-doc-buffer + :company-location #'cider-company-location + :company-docsig #'cider-company-docsig)))) + +(defun cider-completion-flush-caches () + "Force Compliment to refill its caches. +This command should be used if Compliment fails to pick up new classnames +and methods from dependencies that were loaded dynamically after the REPL +has started." + (interactive) + (cider-sync-request:complete-flush-caches)) + +(defun cider-company-location (var) + "Open VAR's definition in a buffer. +Returns the cons of the buffer itself and the location of VAR's definition +in the buffer." + (when-let* ((info (cider-var-info var)) + (file (nrepl-dict-get info "file")) + (line (nrepl-dict-get info "line")) + (buffer (cider-find-file file))) + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (cons buffer (point)))))) + +(defun cider-company-docsig (thing) + "Return signature for THING." + (let* ((eldoc-info (cider-eldoc-info thing)) + (ns (lax-plist-get eldoc-info "ns")) + (symbol (lax-plist-get eldoc-info "symbol")) + (arglists (lax-plist-get eldoc-info "arglists"))) + (when eldoc-info + (format "%s: %s" + (cider-eldoc-format-thing ns symbol thing + (cider-eldoc-thing-type eldoc-info)) + (cider-eldoc-format-arglist arglists 0))))) + +;; Fuzzy completion for company-mode + +(defun cider-company-unfiltered-candidates (string &rest _) + "Return CIDER completion candidates for STRING as is, unfiltered." + (cider-complete string)) + +(add-to-list 'completion-styles-alist + '(cider + cider-company-unfiltered-candidates + cider-company-unfiltered-candidates + "CIDER backend-driven completion style.")) + +(defun cider-company-enable-fuzzy-completion () + "Enable backend-driven fuzzy completion in the current buffer." + (setq-local completion-styles '(cider))) + +(provide 'cider-completion) +;;; cider-completion.el ends here diff --git a/elpa/cider-20181110.1413/cider-connection.el b/elpa/cider-20181110.1413/cider-connection.el new file mode 100644 index 00000000..bfaa8f76 --- /dev/null +++ b/elpa/cider-20181110.1413/cider-connection.el @@ -0,0 +1,857 @@ +;;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*- +;; +;; Copyright © 2018 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors +;; +;; Author: Artur Malabarba +;; Bozhidar Batsov +;; Vitalie Spinu +;; +;; Keywords: languages, clojure, cider +;; +;; 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 . +;; +;; This file is not part of GNU Emacs. +;; +;; +;;; Commentary: +;; +;; +;;; Code: + +(require 'nrepl-client) +(require 'cl-lib) +(require 'format-spec) +(require 'sesman) +(require 'sesman-browser) + +(defcustom cider-session-name-template "%J:%h:%p" + "Format string to use for session names. +See `cider-format-connection-params' for available format characters." + :type 'string + :group 'cider + :package-version '(cider . "0.18.0")) + +(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration + "The function to use to generate the message displayed on connect. +When set to nil no additional message will be displayed. A good +alternative to the default is `cider-random-tip'." + :type 'function + :group 'cider + :package-version '(cider . "0.11.0")) + +(defcustom cider-redirect-server-output-to-repl t + "Controls whether nREPL server output would be redirected to the REPL. +When non-nil the output would end up in both the nrepl-server buffer (when +available) and the matching REPL buffer." + :type 'boolean + :group 'cider + :safe #'booleanp + :package-version '(cider . "0.17.0")) + +(defcustom cider-auto-mode t + "When non-nil, automatically enable cider mode for all Clojure buffers." + :type 'boolean + :group 'cider + :safe #'booleanp + :package-version '(cider . "0.9.0")) + +(defconst cider-required-nrepl-version "0.2.12" + "The minimum nREPL version that's known to work properly with CIDER.") + + +;;; Connect + +(defun cider-nrepl-connect (params) + "Start nrepl client and create the REPL. +PARAMS is a plist containing :host, :port, :server and other parameters for +`cider-repl-create'." + (process-buffer + (nrepl-start-client-process + (plist-get params :host) + (plist-get params :port) + (plist-get params :server) + (lambda (_) + (cider-repl-create params))))) + +(defun cider-connected-p () + "Return t if CIDER is currently connected, nil otherwise." + (process-live-p (get-buffer-process (cider-current-repl)))) + +(defun cider-ensure-connected () + "Ensure there is a linked CIDER session." + (sesman-ensure-session 'CIDER)) + +(defun cider--session-server (session) + "Return server buffer for SESSION or nil if there is no server." + (seq-some (lambda (r) + (buffer-local-value 'nrepl-server-buffer r)) + (cdr session))) + +(defun cider--gather-session-params (session) + "Gather all params for a SESSION." + (let (params) + (dolist (repl (cdr session)) + (setq params (cider--gather-connect-params params repl))) + (when-let* ((server (cider--session-server session))) + (setq params (cider--gather-connect-params params server))) + params)) + +(defun cider--gather-connect-params (&optional params proc-buffer) + "Gather all relevant connection parameters into PARAMS plist. +PROC-BUFFER is either server or client buffer, defaults to current buffer." + (let ((proc-buffer (or proc-buffer (current-buffer)))) + (with-current-buffer proc-buffer + (unless nrepl-endpoint + (error "This is not a REPL or SERVER buffer; is there an active REPL?")) + (let ((server-buf (if (nrepl-server-p proc-buffer) + proc-buffer + nrepl-server-buffer))) + (cl-loop for l on nrepl-endpoint by #'cddr + do (setq params (plist-put params (car l) (cadr l)))) + (setq params (thread-first params + (plist-put :project-dir nrepl-project-dir))) + (when (buffer-live-p server-buf) + (setq params (thread-first params + (plist-put :server (get-buffer-process server-buf)) + (plist-put :server-command nrepl-server-command)))) + ;; repl-specific parameters (do not pollute server params!) + (unless (nrepl-server-p proc-buffer) + (setq params (thread-first params + (plist-put :session-name cider-session-name) + (plist-put :repl-type cider-repl-type) + (plist-put :cljs-repl-type cider-cljs-repl-type) + (plist-put :repl-init-function cider-repl-init-function)))) + params)))) + +(defun cider--close-buffer (buffer) + "Close the BUFFER and kill its associated process (if any)." + (when (buffer-live-p buffer) + (when-let* ((proc (get-buffer-process buffer))) + (when (process-live-p proc) + (delete-process proc))) + (kill-buffer buffer))) + +(declare-function cider-repl-emit-interactive-stderr "cider-repl") +(defun cider--close-connection (repl &optional no-kill) + "Close connection associated with REPL. +When NO-KILL is non-nil stop the connection but don't kill the REPL +buffer." + (when (buffer-live-p repl) + (with-current-buffer repl + (when spinner-current (spinner-stop)) + (when nrepl-tunnel-buffer + (cider--close-buffer nrepl-tunnel-buffer)) + (when no-kill + ;; inform sentinel not to kill the server, if any + (thread-first (get-buffer-process repl) + (process-plist) + (plist-put :keep-server t)))) + (let ((proc (get-buffer-process repl))) + (when (and (process-live-p proc) + (or (not nrepl-server-buffer) + ;; Sync request will hang if the server is dead. + (process-live-p (get-buffer-process nrepl-server-buffer)))) + (nrepl-sync-request:close repl) + (delete-process proc))) + (when-let* ((messages-buffer (and nrepl-log-messages + (nrepl-messages-buffer repl)))) + (kill-buffer messages-buffer)) + (unless no-kill + (kill-buffer repl))) + (when repl + (sesman-remove-object 'CIDER nil repl (not no-kill) t))) + +(defun cider-emit-manual-warning (section-id format &rest args) + "Emit a warning to the REPL and link to the online manual. +SECTION-ID is the section to link to. The link is added on the last line. +FORMAT is a format string to compile with ARGS and display on the REPL." + (let ((message (apply #'format format args))) + (cider-repl-emit-interactive-stderr + (concat "WARNING: " message "\n " + (cider--manual-button "More information" section-id) + ".")))) + +(defvar cider-version) +(defun cider--check-required-nrepl-version () + "Check whether we're using a compatible nREPL version." + (if-let* ((nrepl-version (cider--nrepl-version))) + (when (version< nrepl-version cider-required-nrepl-version) + (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" + "CIDER requires nREPL %s (or newer) to work properly" + cider-required-nrepl-version)) + (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" + "Can't determine nREPL's version.\nPlease, update nREPL to %s." + cider-required-nrepl-version))) + +(defvar cider-minimum-clojure-version) +(defun cider--check-clojure-version-supported () + "Ensure that we are meeting the minimum supported version of Clojure." + (if-let* ((clojure-version (cider--clojure-version))) + (when (version< clojure-version cider-minimum-clojure-version) + (cider-emit-manual-warning "installation/#prerequisites" + "Clojure version (%s) is not supported (minimum %s). CIDER will not work." + clojure-version cider-minimum-clojure-version)) + (cider-emit-manual-warning "installation/#prerequisites" + "Can't determine Clojure's version. CIDER requires Clojure %s (or newer)." + cider-minimum-clojure-version))) + +(defvar cider-required-middleware-version) +(defun cider--check-middleware-compatibility () + "CIDER frontend/backend compatibility check. +Retrieve the underlying connection's CIDER-nREPL version and checks if the +middleware used is compatible with CIDER. If not, will display a warning +message in the REPL area." + (let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-repl))) + (middleware-version (nrepl-dict-get version-dict "version-string"))) + (cond + ((null middleware-version) + (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" + "CIDER requires cider-nrepl to be fully functional. Many things will not work without it!")) + ((version< middleware-version cider-required-middleware-version) + (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" + "CIDER %s requires cider-nrepl %s+, but you're currently using cider-nrepl %s. Things will break!" + cider-version cider-required-middleware-version middleware-version))))) + +(declare-function cider-interactive-eval-handler "cider-eval") +;; TODO: Use some null handler here +(defun cider--subscribe-repl-to-server-out () + "Subscribe to the nREPL server's *out*." + (cider-nrepl-send-request '("op" "out-subscribe") + (cider-interactive-eval-handler (current-buffer)))) + +(declare-function cider-mode "cider-mode") +(defun cider-enable-on-existing-clojure-buffers () + "Enable CIDER's minor mode on existing Clojure buffers. +See command `cider-mode'." + (interactive) + (add-hook 'clojure-mode-hook #'cider-mode) + (dolist (buffer (cider-util--clojure-buffers)) + (with-current-buffer buffer + (cider-mode +1)))) + +(defun cider-disable-on-existing-clojure-buffers () + "Disable command `cider-mode' on existing Clojure buffers." + (interactive) + (dolist (buffer (cider-util--clojure-buffers)) + (with-current-buffer buffer + (cider-mode -1)))) + +(defun cider-possibly-disable-on-existing-clojure-buffers () + "If not connected, disable command `cider-mode' on existing Clojure buffers." + (unless (cider-connected-p) + (cider-disable-on-existing-clojure-buffers))) + +(declare-function cider--debug-init-connection "cider-debug") +(declare-function cider-repl-init "cider-repl") +(defun cider--connected-handler () + "Handle CIDER initialization after nREPL connection has been established. +This function is appended to `nrepl-connected-hook' in the client process +buffer." + ;; `nrepl-connected-hook' is run in the connection buffer + ;; `cider-enlighten-mode' changes eval to include the debugger, so we inhibit + ;; it here as the debugger isn't necessarily initialized yet + (let ((cider-enlighten-mode nil)) + ;; after initialization, set mode-line and buffer name. + (cider-set-repl-type cider-repl-type) + (cider-repl-init (current-buffer)) + (cider--check-required-nrepl-version) + (cider--check-clojure-version-supported) + (cider--check-middleware-compatibility) + (when cider-redirect-server-output-to-repl + (cider--subscribe-repl-to-server-out)) + (when cider-auto-mode + (cider-enable-on-existing-clojure-buffers)) + ;; Middleware on cider-nrepl's side is deferred until first usage, but + ;; loading middleware concurrently can lead to occasional "require" issues + ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards + ;; the end, allowing for the faster "server-out" middleware to load + ;; first. + (cider--debug-init-connection) + (when cider-repl-init-function + (funcall cider-repl-init-function)) + (run-hooks 'cider-connected-hook))) + +(defun cider--disconnected-handler () + "Cleanup after nREPL connection has been lost or closed. +This function is appended to `nrepl-disconnected-hook' in the client +process buffer." + ;; `nrepl-connected-hook' is run in the connection buffer + (cider-possibly-disable-on-existing-clojure-buffers) + (run-hooks 'cider-disconnected-hook)) + + +;;; Connection Info + +(defun cider--java-version () + "Retrieve the underlying connection's Java version." + (with-current-buffer (cider-current-repl) + (when nrepl-versions + (thread-first nrepl-versions + (nrepl-dict-get "java") + (nrepl-dict-get "version-string"))))) + +(defun cider--clojure-version () + "Retrieve the underlying connection's Clojure version." + (with-current-buffer (cider-current-repl) + (when nrepl-versions + (thread-first nrepl-versions + (nrepl-dict-get "clojure") + (nrepl-dict-get "version-string"))))) + +(defun cider--nrepl-version () + "Retrieve the underlying connection's nREPL version." + (with-current-buffer (cider-current-repl) + (when nrepl-versions + (thread-first nrepl-versions + (nrepl-dict-get "nrepl") + (nrepl-dict-get "version-string"))))) + +(defun cider--connection-info (connection-buffer &optional genericp) + "Return info about CONNECTION-BUFFER. +Info contains project name, current REPL namespace, host:port endpoint and +Clojure version. When GENERICP is non-nil, don't provide specific info +about this buffer (like variable `cider-repl-type')." + (with-current-buffer connection-buffer + (format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)" + (if genericp "" (upcase (concat cider-repl-type " "))) + (or (cider--project-name nrepl-project-dir) "") + (plist-get nrepl-endpoint :host) + (plist-get nrepl-endpoint :port) + (cider--java-version) + (cider--clojure-version) + (cider--nrepl-version)))) + + +;;; Cider's Connection Management UI + +(defun cider-quit (&optional repl) + "Quit the CIDER connection associated with REPL. +REPL defaults to the current REPL." + (interactive) + (let ((repl (or repl + (sesman-browser-get 'object) + (cider-current-repl nil 'ensure)))) + (cider--close-connection repl)) + ;; if there are no more connections we can kill all ancillary buffers + (unless (cider-connected-p) + (cider-close-ancillary-buffers)) + ;; need this to refresh sesman browser + (run-hooks 'sesman-post-command-hook)) + +(defun cider-restart (&optional repl) + "Restart CIDER connection associated with REPL. +REPL defaults to the current REPL. Don't restart the server or other +connections within the same session. Use `sesman-restart' to restart the +entire session." + (interactive) + (let* ((repl (or repl + (sesman-browser-get 'object) + (cider-current-repl nil 'ensure))) + (params (thread-first () + (cider--gather-connect-params repl) + (plist-put :session-name (sesman-session-name-for-object 'CIDER repl)) + (plist-put :repl-buffer repl)))) + (cider--close-connection repl 'no-kill) + (cider-nrepl-connect params) + ;; need this to refresh sesman browser + (run-hooks 'sesman-post-command-hook))) + +(defun cider-close-ancillary-buffers () + "Close buffers that are shared across connections." + (interactive) + (dolist (buf-name cider-ancillary-buffers) + (when (get-buffer buf-name) + (kill-buffer buf-name)))) + +(defun cider-describe-connection (&optional repl) + "Display information about the connection associated with REPL. +REPL defaults to the current REPL." + (interactive) + (let ((repl (or repl + (sesman-browser-get 'object) + (cider-current-repl nil 'ensure)))) + (message "%s" (cider--connection-info repl)))) +(define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-connection "0.18.0") + +(defconst cider-nrepl-session-buffer "*cider-nrepl-session*") + +(defun cider-describe-nrepl-session () + "Describe an nREPL session." + (interactive) + (cider-ensure-connected) + (let* ((repl (cider-current-repl nil 'ensure)) + (selected-session (completing-read "Describe nREPL session: " (nrepl-sessions repl)))) + (when (and selected-session (not (equal selected-session ""))) + (let* ((session-info (nrepl-sync-request:describe repl)) + (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) + (session-id (nrepl-dict-get session-info "session")) + (session-type (cond + ((equal session-id (cider-nrepl-eval-session)) "Active eval") + ((equal session-id (cider-nrepl-tooling-session)) "Active tooling") + (t "Unknown")))) + (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer 'select nil 'ancillary) + (read-only-mode -1) + (insert (format "Session: %s\n" session-id) + (format "Type: %s session\n" session-type) + (format "Supported ops:\n")) + (mapc (lambda (op) (insert (format " * %s\n" op))) ops))) + (display-buffer cider-nrepl-session-buffer)))) + + +;;; Sesman's Session-Wise Management UI + +(cl-defmethod sesman-project ((_system (eql CIDER))) + (clojure-project-dir (cider-current-dir))) + +(cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2) + (sesman-more-recent-p (cdr session1) (cdr session2))) + +(cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session) + (setcdr session (seq-filter #'buffer-live-p (cdr session))) + (when-let* ((repl (cadr session)) + (proc (get-buffer-process repl)) + (file (file-truename (or (buffer-file-name) default-directory)))) + ;; With avfs paths look like /path/to/.avfs/path/to/some.jar#uzip/path/to/file.clj + (when (string-match-p "#uzip" file) + (let ((avfs-path (directory-file-name (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/"))))) + (setq file (replace-regexp-in-string avfs-path "" file t t)))) + (when (process-live-p proc) + (let* ((classpath (or (process-get proc :cached-classpath) + (let ((cp (with-current-buffer repl + (cider-sync-request:classpath)))) + (process-put proc :cached-classpath cp) + cp))) + (classpath-roots (or (process-get proc :cached-classpath-roots) + (let ((cp (thread-last classpath + (seq-filter (lambda (path) (not (string-match-p "\\.jar$" path)))) + (mapcar #'file-name-directory)))) + (process-put proc :cached-classpath-roots cp) + cp)))) + (or (seq-find (lambda (path) (string-prefix-p path file)) + classpath) + (seq-find (lambda (path) (string-prefix-p path file)) + classpath-roots)))))) + +(defvar cider-sesman-browser-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "j q") #'cider-quit) + (define-key map (kbd "j k") #'cider-quit) + (define-key map (kbd "j r") #'cider-restart) + (define-key map (kbd "j d") #'cider-describe-connection) + (define-key map (kbd "j i") #'cider-describe-connection) + (define-key map (kbd "C-c C-q") #'cider-quit) + (define-key map (kbd "C-c C-q") #'cider-quit) + (define-key map (kbd "C-c C-r") #'cider-restart) + (define-key map (kbd "C-c M-r") #'cider-restart) + (define-key map (kbd "C-c C-d") #'cider-describe-connection) + (define-key map (kbd "C-c M-d") #'cider-describe-connection) + (define-key map (kbd "C-c C-i") #'cider-describe-connection) + map) + "Map active on REPL objects in sesman browser.") + +(cl-defmethod sesman-session-info ((_system (eql CIDER)) session) + (interactive "P") + (list :objects (cdr session) + :map cider-sesman-browser-map)) + +(declare-function cider "cider") +(cl-defmethod sesman-start-session ((_system (eql CIDER))) + "Start a connection of any type interactively. +Fallback on `cider' command." + (call-interactively #'cider)) + +(cl-defmethod sesman-quit-session ((_system (eql CIDER)) session) + (mapc #'cider--close-connection (cdr session)) + ;; if there are no more connections we can kill all ancillary buffers + (unless (cider-connected-p) + (cider-close-ancillary-buffers))) + +(cl-defmethod sesman-restart-session ((_system (eql CIDER)) session) + (let* ((ses-name (car session)) + (repls (cdr session)) + (srv-buf (cider--session-server session))) + (if srv-buf + ;; session with a server + (let ((s-params (cider--gather-connect-params nil srv-buf))) + ;; 1) kill all connections, but keep the buffers + (mapc (lambda (conn) + (cider--close-connection conn 'no-kill)) + repls) + ;; 2) kill the server + (nrepl-kill-server-buffer srv-buf) + ;; 3) start server + (nrepl-start-server-process + (plist-get s-params :project-dir) + (plist-get s-params :server-command) + (lambda (server-buf) + ;; 4) restart the repls reusing the buffer + (dolist (r repls) + (cider-nrepl-connect + (thread-first () + (cider--gather-connect-params r) + ;; server params (:port, :project-dir etc) have precedence + (cider--gather-connect-params server-buf) + (plist-put :session-name ses-name) + (plist-put :repl-buffer r)))) + (sesman-browser-revert-all 'CIDER) + (message "Restarted CIDER %s session" ses-name)))) + ;; server-less session + (dolist (r repls) + (cider--close-connection r 'no-kill) + (cider-nrepl-connect + (thread-first () + (cider--gather-connect-params r) + (plist-put :session-name ses-name) + (plist-put :repl-buffer r))))))) + +(defun cider-format-connection-params (template params) + "Format PARAMS with TEMPLATE string. +The following formats can be used in TEMPLATE string: + + %h - host + %H - remote host, empty for local hosts + %p - port + %j - short project name, or directory name if no project + %J - long project name including parent dir name + %r - REPL type (clj or cljs) + %S - type of the ClojureScript runtime (Nashorn, Node, Figwheel etc.) + %s - session name as defined by `cider-session-name-template'. + +In case some values are empty, extra separators (: and -) are automatically +removed." + (let* ((dir (directory-file-name + (abbreviate-file-name + (or (plist-get params :project-dir) + (clojure-project-dir (cider-current-dir)) + default-directory)))) + (short-proj (file-name-nondirectory (directory-file-name dir))) + (parent-dir (ignore-errors + (thread-first dir file-name-directory + directory-file-name file-name-nondirectory + file-name-as-directory))) + (long-proj (format "%s%s" (or parent-dir "") short-proj)) + ;; use `dir` if it is shorter than `long-proj` or `short-proj` + (short-proj (if (>= (length short-proj) (length dir)) + dir + short-proj)) + (long-proj (if (>= (length long-proj) (length dir)) + dir + long-proj)) + (port (or (plist-get params :port) "")) + (host (or (plist-get params :host) "localhost")) + (remote-host (if (member host '("localhost" "127.0.0.1")) + "" + host)) + (repl-type (or (plist-get params :repl-type) "unknown")) + (cljs-repl-type (or (and (equal repl-type "cljs") + (plist-get params :cljs-repl-type)) + "")) + (specs `((?h . ,host) + (?H . ,remote-host) + (?p . ,port) + (?j . ,short-proj) + (?J . ,long-proj) + (?r . ,repl-type) + (?S . ,cljs-repl-type))) + (ses-name (or (plist-get params :session-name) + (format-spec cider-session-name-template specs))) + (specs (append `((?s . ,ses-name)) specs))) + (thread-last (format-spec template specs) + ;; remove extraneous separators + (replace-regexp-in-string "\\([:-]\\)[:-]+" "\\1") + (replace-regexp-in-string "\\(^[:-]\\)\\|\\([:-]$\\)" "") + (replace-regexp-in-string "[:-]\\([])*]\\)" "\\1")))) + +(defun cider-make-session-name (params) + "Create new session name given plist of connection PARAMS. +Session name can be customized with `cider-session-name-template'." + (let* ((root-name (cider-format-connection-params cider-session-name-template params)) + (other-names (mapcar #'car (sesman-sessions 'CIDER))) + (name root-name) + (i 2)) + (while (member name other-names) + (setq name (concat root-name "#" (number-to-string i)) + i (+ i 1))) + name)) + + +;;; REPL Buffer Init + +(defvar-local cider-cljs-repl-type nil + "The type of the ClojureScript runtime (Nashorn, Node etc.)") + +(defvar-local cider-repl-type nil + "The type of this REPL buffer, usually either \"clj\" or \"cljs\".") + +(defun cider-repl-type (repl-buffer) + "Get REPL-BUFFER's type." + (buffer-local-value 'cider-repl-type repl-buffer)) + +(defun cider-repl-type-for-buffer (&optional buffer) + "Return the matching connection type (clj or cljs) for BUFFER. +BUFFER defaults to the `current-buffer'. In cljc buffers return +\"multi\". This function infers connection type based on the major mode. +For the REPL type use the function `cider-repl-type'." + (with-current-buffer (or buffer (current-buffer)) + (cond + ((derived-mode-p 'clojurescript-mode) "cljs") + ((derived-mode-p 'clojurec-mode) "multi") + ((derived-mode-p 'clojure-mode) "clj") + (cider-repl-type)))) + +(defun cider-set-repl-type (&optional type) + "Set REPL TYPE to \"clj\" or \"cljs\". +Assume that the current buffer is a REPL." + (interactive) + (let ((type (or type (completing-read + (format "Set REPL type (currently `%s') to: " + cider-repl-type) + '("clj" "cljs"))))) + (when (or (not (equal cider-repl-type type)) + (null mode-name)) + (setq cider-repl-type type) + (setq mode-name (format "REPL[%s]" type)) + (let ((params (cider--gather-connect-params))) + ;; We need to set current name to something else temporarily to avoid + ;; false name duplication in `nrepl-repl-buffer-name`. + (rename-buffer (generate-new-buffer-name "*dummy-cider-repl-buffer*")) + (rename-buffer (nrepl-repl-buffer-name params)) + (when (and nrepl-log-messages nrepl-messages-buffer) + (with-current-buffer nrepl-messages-buffer + (rename-buffer (nrepl-messages-buffer-name params)))))))) + +(defun cider--choose-reusable-repl-buffer (params) + "Find connection-less REPL buffer and ask the user for confirmation. +Return nil if no such buffers exists or the user has chosen not to reuse +the buffer. If multiple dead REPLs exist, ask the user to choose one. +PARAMS is a plist as received by `cider-repl-create'." + (when-let* ((repls (seq-filter (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'cider-repl-mode) + (not (process-live-p (get-buffer-process b)))))) + (buffer-list)))) + (let* ((proj-dir (plist-get params :project-dir)) + (host (plist-get params :host)) + (port (plist-get params :port)) + (cljsp (string-match-p "cljs" (plist-get params :repl-type))) + (scored-repls + (delq nil + (mapcar (lambda (b) + (let ((bparams (cider--gather-connect-params nil b))) + (when (eq cljsp (string-match-p "cljs" (plist-get bparams :repl-type))) + (cons (buffer-name b) + (+ + (if (equal proj-dir (plist-get bparams :project-dir)) 8 0) + (if (equal host (plist-get bparams :host)) 4 0) + (if (equal port (plist-get bparams :port)) 2 0)))))) + repls)))) + (when scored-repls + (if (> (length scored-repls) 1) + (when (y-or-n-p "Dead REPLs exist. Reuse? ") + (let ((sorted-repls (seq-sort (lambda (a b) (> (cdr a) (cdr b))) scored-repls))) + (get-buffer (completing-read "REPL to reuse: " + (mapcar #'car sorted-repls) nil t nil nil (caar sorted-repls))))) + (when (y-or-n-p (format "A dead REPL %s exists. Reuse? " (caar scored-repls))) + (get-buffer (caar scored-repls)))))))) + +(declare-function cider-default-err-handler "cider-eval") +(declare-function cider-repl-mode "cider-repl") +(declare-function cider-repl--state-handler "cider-repl") +(declare-function cider-repl-reset-markers "cider-repl") +(defvar-local cider-session-name nil) +(defvar-local cider-repl-init-function nil) +(defun cider-repl-create (params) + "Create new repl buffer. +PARAMS is a plist which contains :repl-type, :host, :port, :project-dir, +:repl-init-function and :session-name. When non-nil, :repl-init-function +must be a function with no arguments which is called after repl creation +function with the repl buffer set as current." + ;; Connection might not have been set as yet. Please don't send requests in + ;; this function, but use cider--connected-handler instead. + (let ((buffer (or (plist-get params :repl-buffer) + (cider--choose-reusable-repl-buffer params) + (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*")))) + (ses-name (or (plist-get params :session-name) + (cider-make-session-name params)))) + (with-current-buffer buffer + (setq-local sesman-system 'CIDER) + (setq-local default-directory (or (plist-get params :project-dir) default-directory)) + ;; creates a new session if session with ses-name doesn't already exist + (sesman-add-object 'CIDER ses-name buffer 'allow-new) + (unless (derived-mode-p 'cider-repl-mode) + (cider-repl-mode)) + (setq nrepl-err-handler #'cider-default-err-handler + ;; used as a new-repl marker in cider-set-repl-type + mode-name nil + cider-session-name ses-name + nrepl-project-dir (plist-get params :project-dir) + ;; REPLs start with clj and then "upgrade" to a different type + cider-repl-type (plist-get params :repl-type) + ;; ran at the end of cider--connected-handler + cider-repl-init-function (plist-get params :repl-init-function)) + (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)))) + + +;;; Current/other REPLs + +(defun cider--no-repls-user-error (type) + "Throw \"No REPL\" user error customized for TYPE." + (let ((type (cond + ((equal type "multi") + "clj or cljs") + ((listp type) + (mapconcat #'identity type " or ")) + (type)))) + (user-error "No %s REPLs in current session \"%s\"" + type (car (sesman-current-session 'CIDER))))) + +(defun cider-current-repl (&optional type ensure) + "Get the most recent REPL of TYPE from the current session. +TYPE is either \"clj\", \"cljs\", \"multi\" or \"any\". +When nil, infer the type from the current buffer. \"multi\" or \"any\" +are synonyms. If ENSURE is non-nil, throw an error if either there is +no linked session or there is no REPL of TYPE within the current session." + (if (and (derived-mode-p 'cider-repl-mode) + (or (null type) + (string= cider-repl-type type))) + ;; shortcut when in REPL buffer + (current-buffer) + (let* ((type (if (equal type "any") "multi" type)) + (type (or type (cider-repl-type-for-buffer))) + (repls (cider-repls type ensure)) + (repl (if (<= (length repls) 1) + (car repls) + ;; pick the most recent one + (seq-find (lambda (b) + (member b repls)) + (buffer-list))))) + (if (and ensure (null repl)) + (cider--no-repls-user-error type) + repl)))) + +(defun cider--match-repl-type (type buffer) + "Return non-nil if TYPE matches BUFFER's REPL type." + (let ((buffer-repl-type (cider-repl-type buffer))) + (cond ((null buffer-repl-type) nil) + ((or (null type) (equal type "multi")) t) + ((listp type) (member buffer-repl-type type)) + (t (string= type buffer-repl-type))))) + +(defun cider-repls (&optional type ensure) + "Return cider REPLs of TYPE from the current session. +If TYPE is nil or \"multi\", return all repls. If TYPE is a list of types, +return only REPLs of type contained in the list. If ENSURE is non-nil, +throw an error if no linked session exists." + (let ((repls (cdr (if ensure + (sesman-ensure-session 'CIDER) + (sesman-current-session 'CIDER))))) + (or (seq-filter (lambda (b) + (cider--match-repl-type type b)) + repls) + (when ensure + (cider--no-repls-user-error type))))) + +(defun cider-map-repls (which function) + "Call FUNCTION once for each appropriate REPL as indicated by WHICH. +The function is called with one argument, the REPL buffer. The appropriate +connections are found by inspecting the current buffer. WHICH is one of +the following keywords: + :auto - Act on the connections whose type matches the current buffer. In + `cljc' files, mapping happens over both types of REPLs. + :clj (:cljs) - Map over clj (cljs)) REPLs only. + :clj-strict (:cljs-strict) - Map over clj (cljs) REPLs but signal a + `user-error' in `clojurescript-mode' (`clojure-mode'). Use this for + commands only supported in Clojure (ClojureScript). +Error is signaled if no REPL buffers of specified type exist in current +session." + (declare (indent 1)) + (let ((cur-type (cider-repl-type-for-buffer))) + (cl-case which + (:clj-strict (when (equal cur-type "cljs") + (user-error "Clojure-only operation requested in a ClojureScript buffer"))) + (:cljs-strict (when (equal cur-type "clj") + (user-error "ClojureScript-only operation requested in a Clojure buffer")))) + (let* ((type (cl-case which + ((:clj :clj-strict) "clj") + ((:cljs :cljs-strict) "cljs") + (:auto (if (equal cur-type "multi") + '("clj" "cljs") + cur-type)))) + (repls (cider-repls type 'ensure))) + (mapcar function repls)))) + +;; REPLs double as connections in CIDER, so it's useful to be able to refer to +;; them as connections in certain contexts. +(defalias 'cider-current-connection #'cider-current-repl) +(defalias 'cider-connections #'cider-repls) +(defalias 'cider-map-connections #'cider-map-repls) +(defalias 'cider-connection-type-for-buffer #'cider-repl-type-for-buffer) + + +;; Deprecation after #2324 + +(define-obsolete-function-alias 'cider-current-repl-buffer 'cider-current-repl "0.18") +(define-obsolete-function-alias 'cider-repl-buffers 'cider-repls "0.18") +(define-obsolete-function-alias 'cider-current-session 'cider-nrepl-eval-session "0.18") +(define-obsolete-function-alias 'cider-current-tooling-session 'cider-nrepl-tooling-session "0.18") +(define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-connection "0.18") +(define-obsolete-function-alias 'nrepl-connection-buffer-name 'nrepl-repl-buffer-name "0.18") +(define-obsolete-function-alias 'cider-repl-set-type 'cider-set-repl-type "0.18") + +(make-obsolete 'cider-assoc-buffer-with-connection 'sesman-link-with-buffer "0.18") +(make-obsolete 'cider-assoc-project-with-connection 'sesman-link-with-project "0.18") +(make-obsolete 'cider-change-buffers-designation nil "0.18") +(make-obsolete 'cider-clear-buffer-local-connection nil "0.18") +(make-obsolete 'cider-close-nrepl-session 'cider-quit "0.18") +(make-obsolete 'cider-create-sibling-cljs-repl 'cider-connect-sibling-cljs "0.18") +(make-obsolete 'cider-current-messages-buffer nil "0.18") +(make-obsolete 'cider-default-connection "see sesman." "0.18") +(make-obsolete 'cider-extract-designation-from-current-repl-buffer nil "0.18") +(make-obsolete 'cider-find-connection-buffer-for-project-directory 'sesman-current-sessions "0.18") +(make-obsolete 'cider-find-reusable-repl-buffer nil "0.18") +(make-obsolete 'cider-make-connection-default "see sesman." "0.18") +(make-obsolete 'cider-other-connection nil "0.18") +(make-obsolete 'cider-project-connections 'sesman-current-sessions "0.18") +(make-obsolete 'cider-project-connections-types nil "0.18") +(make-obsolete 'cider-prompt-for-project-on-connect nil "0.18") +(make-obsolete 'cider-read-connection `sesman-ask-for-session "0.18") +(make-obsolete 'cider-replicate-connection nil "0.18") +(make-obsolete 'cider-request-dispatch "see sesman." "0.18") +(make-obsolete 'cider-rotate-default-connection "see sesman." "0.18") +(make-obsolete 'cider-toggle-buffer-connection nil "0.18") +(make-obsolete 'cider-toggle-request-dispatch nil "0.18") +(make-obsolete 'nrepl-connection-buffer-name-template 'nrepl-repl-buffer-name-template "0.18") +(make-obsolete 'nrepl-create-client-buffer-function nil "0.18") +(make-obsolete 'nrepl-post-client-callback nil "0.18") +(make-obsolete 'nrepl-prompt-to-kill-server-buffer-on-quit nil "0.18") +(make-obsolete 'nrepl-use-this-as-repl-buffer nil "0.18") + +;; connection manager +(make-obsolete 'cider-client-name-repl-type "see sesman." "0.18") +(make-obsolete 'cider-connection-browser "see sesman." "0.18") +(make-obsolete 'cider-connections-buffer-mode "see sesman." "0.18") +(make-obsolete 'cider-connections-buffer-mode-map "see sesman." "0.18") +(make-obsolete 'cider-connections-close-connection "see sesman." "0.18") +(make-obsolete 'cider-connections-goto-connection "see sesman." "0.18") +(make-obsolete 'cider-connections-make-default "see sesman." "0.18") +(make-obsolete 'cider-display-connected-message "see sesman." "0.18") +(make-obsolete 'cider-project-name "see sesman." "0.18") + +(provide 'cider-connection) + +;;; cider-connection.el ends here diff --git a/elpa/cider-20170129.1941/cider-debug.el b/elpa/cider-20181110.1413/cider-debug.el similarity index 94% rename from elpa/cider-20170129.1941/cider-debug.el rename to elpa/cider-20181110.1413/cider-debug.el index 9d762cd8..b8cc2f48 100644 --- a/elpa/cider-20170129.1941/cider-debug.el +++ b/elpa/cider-20181110.1413/cider-debug.el @@ -1,6 +1,6 @@ ;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*- -;; Copyright © 2015-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; Author: Artur Malabarba @@ -27,7 +27,7 @@ (require 'nrepl-dict) (require 'nrepl-client) ; `nrepl--mark-id-completed' -(require 'cider-interaction) +(require 'cider-eval) (require 'cider-client) (require 'cider-util) (require 'cider-inspector) @@ -102,7 +102,7 @@ configure `cider-debug-prompt' instead." :package-version '(cider . "0.9.1")) (defcustom cider-debug-print-level 10 - "The print-level for values displayed by the debugger. + "The print level for values displayed by the debugger. This variable must be set before starting the repl connection." :type '(choice (const :tag "No limit" nil) (integer :tag "Max depth" 10)) @@ -110,7 +110,7 @@ This variable must be set before starting the repl connection." :package-version '(cider . "0.10.0")) (defcustom cider-debug-print-length 10 - "The print-length for values displayed by the debugger. + "The print length for values displayed by the debugger. This variable must be set before starting the repl connection." :type '(choice (const :tag "No limit" nil) (integer :tag "Max depth" 10)) @@ -122,8 +122,8 @@ This variable must be set before starting the repl connection." (defun cider-browse-instrumented-defs () "List all instrumented definitions." (interactive) - (if-let ((all (thread-first (cider-nrepl-send-sync-request (list "op" "debug-instrumented-defs")) - (nrepl-dict-get "list")))) + (if-let* ((all (thread-first (cider-nrepl-send-sync-request '("op" "debug-instrumented-defs")) + (nrepl-dict-get "list")))) (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t) (let ((inhibit-read-only t)) (erase-buffer) @@ -162,11 +162,11 @@ This variable must be set before starting the repl connection." (defun cider--debug-init-connection () "Initialize a connection with the cider.debug middleware." (cider-nrepl-send-request - (append '("op" "init-debugger") - (when cider-debug-print-level - (list "print-level" cider-debug-print-level)) - (when cider-debug-print-length - (list "print-length" cider-debug-print-length))) + (nconc '("op" "init-debugger") + (when cider-debug-print-level + `("print-level" ,cider-debug-print-level)) + (when cider-debug-print-length + `("print-length" ,cider-debug-print-length))) #'cider--debug-response-handler)) @@ -230,7 +230,7 @@ Each element of LOCALS should be a list of at least two elements." (format (propertize "%s\n" 'face 'default) (string-join (nrepl-dict-map (lambda (char cmd) - (when-let ((pos (cl-search char cmd))) + (when-let* ((pos (cl-search char cmd))) (put-text-property pos (1+ pos) 'face 'cider-debug-prompt-face cmd)) cmd) command-dict) @@ -292,7 +292,7 @@ of `cider-interactive-eval' in debug sessions." (defvar cider--debug-mode-tool-bar-map (let ((tool-bar-map (make-sparse-keymap))) (tool-bar-add-item "right-arrow" #'cider-debug-mode-send-reply :next :label "Next step") - (tool-bar-add-item "next-node" #'cider-debug-mode-send-reply :continue :label "Continue non-stop") + (tool-bar-add-item "next-node" #'cider-debug-mode-send-reply :continue :label "Continue") (tool-bar-add-item "jump-to" #'cider-debug-mode-send-reply :out :label "Out of sexp") (tool-bar-add-item "exit" #'cider-debug-mode-send-reply :quit :label "Quit") tool-bar-map)) @@ -320,7 +320,7 @@ In order to work properly, this mode must be activated by (apply-partially #'cider--debug-lexical-eval (nrepl-dict-get cider--debug-mode-response "key"))) ;; Set the keymap. - (nrepl-dict-map (lambda (char cmd) + (nrepl-dict-map (lambda (char _cmd) (unless (string= char "h") ; `here' needs a special command. (define-key cider--debug-mode-map char #'cider-debug-mode-send-reply)) (when (string= char "o") @@ -343,8 +343,8 @@ In order to work properly, this mode must be activated by ;; We wait a moment before clearing overlays and the read-onlyness, so that ;; cider-nrepl has a chance to send the next message, and so that the user ;; doesn't accidentally hit `n' between two messages (thus editing the code). - (when-let ((proc (unless nrepl-ongoing-sync-request - (get-buffer-process (cider-current-connection))))) + (when-let* ((proc (unless nrepl-ongoing-sync-request + (get-buffer-process (cider-current-repl))))) (accept-process-output proc 1)) (unless cider--debug-mode (setq buffer-read-only nil) @@ -377,7 +377,8 @@ In order to work properly, this mode must be activated by "Menu for CIDER debug mode" `("CIDER Debugger" ["Next step" (cider-debug-mode-send-reply ":next") :keys "n"] - ["Continue non-stop" (cider-debug-mode-send-reply ":continue") :keys "c"] + ["Continue" (cider-debug-mode-send-reply ":continue") :keys "c"] + ["Continue non-stop" (cider-debug-mode-send-reply ":Continue") :keys "C"] ["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"] ["Quit" (cider-debug-mode-send-reply ":quit") :keys "q"] "--" @@ -396,7 +397,7 @@ In order to work properly, this mode must be activated by ["Customize" (customize-group 'cider-debug)])) (defun cider--uppercase-command-p () - "Return true if the last command was uppercase letter." + "Return non-nil if the last command was uppercase letter." (ignore-errors (let ((case-fold-search nil)) (string-match "[[:upper:]]" (string last-command-event))))) @@ -411,14 +412,15 @@ message." (symbol-name last-command-event) (ignore-errors (concat ":" (nrepl-dict-get cider--debug-mode-commands-dict - (downcase (string last-command-event)))))) + (string last-command-event))))) nil (cider--uppercase-command-p))) (when (and (string-prefix-p ":" command) force) (setq command (format "{:response %s :force? true}" command))) (cider-nrepl-send-unhandled-request - (list "op" "debug-input" "input" (or command ":quit") - "key" (or key (nrepl-dict-get cider--debug-mode-response "key")))) + `("op" "debug-input" + "input" ,(or command ":quit") + "key" ,(or key (nrepl-dict-get cider--debug-mode-response "key")))) (ignore-errors (cider--debug-mode -1))) (defun cider--debug-quit () @@ -442,7 +444,7 @@ Return trimmed CODE." ID is the id of the message that instrumented CODE. REASON is a keyword describing why this buffer was necessary." (let ((buffer-name (format cider--debug-buffer-format id))) - (if-let ((buffer (get-buffer buffer-name))) + (if-let* ((buffer (get-buffer buffer-name))) (cider-popup-buffer-display buffer 'select) (with-current-buffer (cider-popup-buffer buffer-name 'select #'clojure-mode 'ancillary) @@ -464,7 +466,7 @@ REASON is a keyword describing why this buffer was necessary." (defun cider--debug-goto-keyval (key) "Find KEY in current sexp or return nil." - (when-let ((limit (ignore-errors (save-excursion (up-list) (point))))) + (when-let* ((limit (ignore-errors (save-excursion (up-list) (point))))) (search-forward-regexp (concat "\\_<" (regexp-quote key) "\\_>") limit 'noerror))) @@ -579,9 +581,9 @@ is a coordinate measure in sexps." (save-excursion (let ((out)) ;; We prefer in-source debugging. - (when-let ((buf (and file line column - (ignore-errors - (cider--find-buffer-for-file file))))) + (when-let* ((buf (and file line column + (ignore-errors + (cider--find-buffer-for-file file))))) ;; The logic here makes it hard to use `with-current-buffer'. (with-current-buffer buf ;; This is for restoring point inside buf. @@ -601,7 +603,7 @@ is a coordinate measure in sexps." code ns original-id (if (and line column) "you edited the code" - "your tools.nrepl version is older than 0.2.11")) + "your nREPL version is older than 0.2.11")) (save-excursion (cider--debug-move-point coor) (point-marker))))))))) @@ -647,7 +649,7 @@ needed. It is expected to contain at least \"key\", \"input-type\", and RESPONSE is a message received from the nrepl describing the value and coordinates of a sexp. Create an overlay after the specified sexp displaying its value." - (when-let ((marker (cider--debug-find-source-position response))) + (when-let* ((marker (cider--debug-find-source-position response))) (with-current-buffer (marker-buffer marker) (save-excursion (goto-char marker) @@ -709,7 +711,8 @@ TARGET is inside it. The returned list is suitable for use in (goto-char starting-point))))) (defun cider-debug-move-here (&optional force) - "Skip any breakpoints up to point." + "Skip any breakpoints up to point. +The boolean value of FORCE will be sent in the reply." (interactive (list (cider--uppercase-command-p))) (unless cider--debug-mode (user-error "`cider-debug-move-here' only makes sense during a debug session")) diff --git a/elpa/cider-20170129.1941/cider-doc.el b/elpa/cider-20181110.1413/cider-doc.el similarity index 88% rename from elpa/cider-20170129.1941/cider-doc.el rename to elpa/cider-20181110.1413/cider-doc.el index 0ee07f34..5cca0505 100644 --- a/elpa/cider-20170129.1941/cider-doc.el +++ b/elpa/cider-20181110.1413/cider-doc.el @@ -1,6 +1,6 @@ ;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- -;; Copyright © 2014-2017 Bozhidar Batsov, Jeff Valk and CIDER contributors +;; Copyright © 2014-2018 Bozhidar Batsov, Jeff Valk and CIDER contributors ;; Author: Jeff Valk @@ -36,6 +36,7 @@ (require 'org-table) (require 'button) (require 'easymenu) +(require 'cider-browse-spec) ;;; Variables @@ -45,6 +46,16 @@ :prefix "cider-doc-" :group 'cider) +(defcustom cider-doc-auto-select-buffer t + "Controls whether to auto-select the doc popup buffer." + :type 'boolean + :group 'cider-doc + :package-version '(cider . "0.15.0")) + +(declare-function cider-apropos "cider-apropos") +(declare-function cider-apropos-select "cider-apropos") +(declare-function cider-apropos-documentation "cider-apropos") +(declare-function cider-apropos-documentation-select "cider-apropos") (defvar cider-doc-map (let (cider-doc-map) @@ -96,7 +107,6 @@ :group 'cider-docview-mode :package-version '(cider . "0.7.0")) - ;; Faces @@ -135,6 +145,11 @@ "When theme is changed, update `cider-docview-code-background-color'." (setq cider-docview-code-background-color (cider-scale-background-color))) + +(defadvice disable-theme (after cider-docview-adapt-to-theme activate) + "When theme is disabled, update `cider-docview-code-background-color'." + (setq cider-docview-code-background-color (cider-scale-background-color))) + ;; Mode & key bindings @@ -169,6 +184,7 @@ \\{cider-docview-mode-map}" (setq buffer-read-only t) + (setq-local sesman-system 'CIDER) (when cider-special-mode-truncate-lines (setq-local truncate-lines t)) (setq-local electric-indent-chars nil) @@ -209,15 +225,12 @@ opposite of what that option dictates." "Javadoc for" #'cider-javadoc-handler)) -(declare-function cider-find-file "cider-common") -(declare-function cider-jump-to "cider-interaction") - (defun cider-docview-source () "Open the source for the current symbol, if available." (interactive) (if cider-docview-file - (if-let ((buffer (and (not (cider--tooling-file-p cider-docview-file)) - (cider-find-file cider-docview-file)))) + (if-let* ((buffer (and (not (cider--tooling-file-p cider-docview-file)) + (cider-find-file cider-docview-file)))) (cider-jump-to buffer (if cider-docview-line (cons cider-docview-line nil) cider-docview-symbol) @@ -248,17 +261,16 @@ opposite of what that option dictates." (error "%s cannot be looked up on Grimoire" cider-docview-symbol))) (defconst cider-doc-buffer "*cider-doc*") -(add-to-list 'cider-ancillary-buffers cider-doc-buffer) (defun cider-create-doc-buffer (symbol) "Populates *cider-doc* with the documentation for SYMBOL." - (when-let ((info (cider-var-info symbol))) - (cider-docview-render (cider-make-popup-buffer cider-doc-buffer) symbol info))) + (when-let* ((info (cider-var-info symbol))) + (cider-docview-render (cider-make-popup-buffer cider-doc-buffer nil 'ancillary) symbol info))) (defun cider-doc-lookup (symbol) "Look up documentation for SYMBOL." - (if-let ((buffer (cider-create-doc-buffer symbol))) - (cider-popup-buffer-display buffer t) + (if-let* ((buffer (cider-create-doc-buffer symbol))) + (cider-popup-buffer-display buffer cider-doc-auto-select-buffer) (user-error "Symbol %s not resolved" symbol))) (defun cider-doc (&optional arg) @@ -368,7 +380,7 @@ Tables are marked to be ignored by line wrap." (cider-docview-wrap-text buffer))))) ; ignores code, table blocks (defun cider--abbreviate-file-protocol (file-with-protocol) - "Abbreviate the file-path in `file:/path/to/file'." + "Abbreviate the file-path in `file:/path/to/file' of FILE-WITH-PROTOCOL." (if (string-match "\\`file:\\(.*\\)" file-with-protocol) (let ((file (match-string 1 file-with-protocol)) (proj-dir (clojure-project-dir))) @@ -386,8 +398,10 @@ Tables are marked to be ignored by line wrap." (depr (nrepl-dict-get info "deprecated")) (macro (nrepl-dict-get info "macro")) (special (nrepl-dict-get info "special-form")) - (forms (nrepl-dict-get info "forms-str")) - (args (nrepl-dict-get info "arglists-str")) + (forms (when-let* ((str (nrepl-dict-get info "forms-str"))) + (split-string str "\n"))) + (args (when-let* ((str (nrepl-dict-get info "arglists-str"))) + (split-string str "\n"))) (doc (or (nrepl-dict-get info "doc") "Not documented.")) (url (nrepl-dict-get info "url")) @@ -416,24 +430,14 @@ Tables are marked to be ignored by line wrap." (emit (concat " "(cider-font-lock-as 'java-mode iface))))) (when (or super ifaces) (insert "\n")) - (when (or forms args) - (insert " ") - (save-excursion - (emit (cider-font-lock-as-clojure - ;; All `defn's use ([...] [...]), but some special forms use - ;; (...). We only remove the parentheses on the former. - (replace-regexp-in-string "\\`(\\(\\[.*\\]\\))\\'" "\\1" - (or forms args))))) - ;; It normally doesn't happen, but it's technically conceivable for - ;; the args string to contain unbalanced sexps, so `ignore-errors'. - (ignore-errors - (forward-sexp 1) - (while (not (looking-at "$")) - (insert "\n") - (forward-sexp 1))) - (forward-line 1)) - (when (or special macro) - (emit (if special "Special Form" "Macro") 'font-lock-variable-name-face)) + (when-let* ((forms (or forms args))) + (dolist (form forms) + (insert " ") + (emit (cider-font-lock-as-clojure form)))) + (when special + (emit "Special Form" 'font-lock-keyword-face)) + (when macro + (emit "Macro" 'font-lock-variable-name-face)) (when added (emit (concat "Added in " added) 'font-lock-comment-face)) (when depr @@ -459,9 +463,14 @@ Tables are marked to be ignored by line wrap." (insert ".\n")) (insert "\n") (when spec - (emit "Spec: " 'font-lock-function-name-face) - (mapc (lambda (s) (insert s "\n")) spec) - (insert "\n")) + (emit "Spec:" 'font-lock-function-name-face) + (insert (cider-browse-spec--pprint-indented spec)) + (insert "\n\n") + (insert-text-button "Browse spec" + 'follow-link t + 'action (lambda (_) + (cider-browse-spec (format "%s/%s" ns name)))) + (insert "\n\n")) (if cider-docview-file (progn (insert (propertize (if class java-name clj-name) @@ -482,9 +491,9 @@ Tables are marked to be ignored by line wrap." ;; if the var belongs to the same namespace, ;; we omit the namespace to save some screen space (symbol (if (equal ns see-also-ns) see-also-sym ns-sym))) - (insert-button symbol - 'type 'help-xref - 'help-function (apply-partially #'cider-doc-lookup symbol))) + (insert-text-button symbol + 'type 'help-xref + 'help-function (apply-partially #'cider-doc-lookup symbol))) (insert " ")) see-also)) (cider--doc-make-xrefs) diff --git a/elpa/cider-20170129.1941/cider-eldoc.el b/elpa/cider-20181110.1413/cider-eldoc.el similarity index 81% rename from elpa/cider-20170129.1941/cider-eldoc.el rename to elpa/cider-20181110.1413/cider-eldoc.el index ed0a8bc4..b055824d 100644 --- a/elpa/cider-20170129.1941/cider-eldoc.el +++ b/elpa/cider-20181110.1413/cider-eldoc.el @@ -1,7 +1,7 @@ ;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -82,18 +82,27 @@ a \"& x more\" suffix. Otherwise, all the classes are displayed." So in (map inc ...) when the cursor is over inc its eldoc would be displayed. When nil, always display eldoc for first symbol of the sexp." :type 'boolean - :safe 'booleanp + :safe #'booleanp :group 'cider :package-version '(cider . "0.13.0")) +(defcustom cider-eldoc-display-context-dependent-info nil + "When non-nil, display context dependent info in the eldoc where possible. +CIDER will try to add expected function arguments based on the current context, +for example for the datomic.api/q function where it will show the expected +inputs of the query at point." + :type 'boolean + :group 'cider + :package-version '(cider . "0.15.0")) + (defun cider--eldoc-format-class-names (class-names) "Return a formatted CLASS-NAMES prefix string. CLASS-NAMES is a list of classes to which a Java interop form belongs. Only keep the first `cider-eldoc-max-class-names-to-display' names, and add a \"& x more\" suffix. Return nil if the CLASS-NAMES list is empty or mapping `cider-eldoc-ns-function' on it returns an empty list." - (when-let ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names))) - (eldoc-class-names-length (length eldoc-class-names))) + (when-let* ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names))) + (eldoc-class-names-length (length eldoc-class-names))) (cond ;; truncate class-names list and then format it ((and cider-eldoc-max-class-names-to-display @@ -116,18 +125,18 @@ mapping `cider-eldoc-ns-function' on it returns an empty list." (t (format "%s" (car eldoc-class-names)))))) (defun cider-eldoc-format-thing (ns symbol thing type) - "Format the eldoc subject defined by NS, SYMBOL and THING. + "Format the eldoc subject defined by NS, SYMBOL, THING and TYPE. THING represents the thing at point which triggered eldoc. Normally NS and SYMBOL are used (they are derived from THING), but when empty we fallback to THING (e.g. for Java methods). Format it as a function, if FUNCTION-P is non-nil. Else format it as a variable." - (if-let ((method-name (if (and symbol (not (string= symbol ""))) - symbol - thing)) - (propertized-method-name (cider-propertize method-name type)) - (ns-or-class (if (and ns (stringp ns)) - (funcall cider-eldoc-ns-function ns) - (cider--eldoc-format-class-names ns)))) + (if-let* ((method-name (if (and symbol (not (string= symbol ""))) + symbol + thing)) + (propertized-method-name (cider-propertize method-name type)) + (ns-or-class (if (and ns (stringp ns)) + (funcall cider-eldoc-ns-function ns) + (cider--eldoc-format-class-names ns)))) (format "%s/%s" ;; we set font-lock properties of classes in `cider--eldoc-format-class-names' ;; to avoid font locking the parentheses and "& x more" @@ -197,10 +206,11 @@ Otherwise, only the docstring is returned." ;; so we just display the docstring (t docstring)))) -(defun cider-eldoc-format-variable (thing pos eldoc-info) +(defun cider-eldoc-format-variable (thing eldoc-info) "Return the formatted eldoc string for a variable. -THING is the variable name. POS will always be 0 here. -ELDOC-INFO is a p-list containing the eldoc information." + +THING is the variable name. ELDOC-INFO is a p-list containing the eldoc +information." (let* ((ns (lax-plist-get eldoc-info "ns")) (symbol (lax-plist-get eldoc-info "symbol")) (docstring (lax-plist-get eldoc-info "docstring")) @@ -294,7 +304,7 @@ if the maximum number of sexps to skip is exceeded." num-skipped-sexps)) (defun cider-eldoc-thing-type (eldoc-info) - "Return the type of the thing being displayed by eldoc. + "Return the type of the ELDOC-INFO being displayed by eldoc. It can be a function or var now." (pcase (lax-plist-get eldoc-info "type") ("function" 'fn) @@ -311,26 +321,26 @@ Then go back to the point and return its eldoc." (cider-eldoc-beginning-of-sexp) (unless (member (or (char-before (point)) 0) '(?\" ?\{ ?\[)) (goto-char current-point) - (when-let (eldoc-info (cider-eldoc-info - (cider--eldoc-remove-dot (cider-symbol-at-point)))) - (list "eldoc-info" eldoc-info - "thing" (cider-symbol-at-point) - "pos" 0))))))) + (when-let* ((eldoc-info (cider-eldoc-info + (cider--eldoc-remove-dot (cider-symbol-at-point))))) + `("eldoc-info" ,eldoc-info + "thing" ,(cider-symbol-at-point) + "pos" 0))))))) (defun cider-eldoc-info-at-sexp-beginning () "Return eldoc info for first symbol in the sexp." (save-excursion - (when-let ((beginning-of-sexp (cider-eldoc-beginning-of-sexp)) - ;; If we are at the beginning of function name, this will be -1 - (argument-index (max 0 (1- beginning-of-sexp)))) + (when-let* ((beginning-of-sexp (cider-eldoc-beginning-of-sexp)) + ;; If we are at the beginning of function name, this will be -1 + (argument-index (max 0 (1- beginning-of-sexp)))) (unless (or (memq (or (char-before (point)) 0) '(?\" ?\{ ?\[)) (cider-in-comment-p)) - (when-let (eldoc-info (cider-eldoc-info - (cider--eldoc-remove-dot (cider-symbol-at-point)))) - (list "eldoc-info" eldoc-info - "thing" (cider-symbol-at-point) - "pos" argument-index)))))) + (when-let* ((eldoc-info (cider-eldoc-info + (cider--eldoc-remove-dot (cider-symbol-at-point))))) + `("eldoc-info" ,eldoc-info + "thing" ,(cider-symbol-at-point) + "pos" ,argument-index)))))) (defun cider-eldoc-info-in-current-sexp () "Return eldoc information from the sexp. @@ -379,7 +389,7 @@ This includes the arglist and ns and symbol name (if available)." ;; generic case (t (if (equal thing (car cider-eldoc-last-symbol)) (cadr cider-eldoc-last-symbol) - (when-let ((eldoc-info (cider-sync-request:eldoc thing))) + (when-let* ((eldoc-info (cider-sync-request:eldoc thing))) (let* ((arglists (nrepl-dict-get eldoc-info "eldoc")) (docstring (nrepl-dict-get eldoc-info "docstring")) (type (nrepl-dict-get eldoc-info "type")) @@ -398,10 +408,23 @@ This includes the arglist and ns and symbol name (if available)." "arglists" arglists "docstring" docstring "type" type))) - ;; middleware eldoc lookups are expensive, so we - ;; cache the last lookup. This eliminates the need - ;; for extra middleware requests within the same sexp. - (setq cider-eldoc-last-symbol (list thing eldoc-plist)) + ;; add context dependent args if requested by defcustom + ;; do not cache this eldoc info to avoid showing info + ;: of the previous context + (if cider-eldoc-display-context-dependent-info + (cond + ;; add inputs of datomic query + ((and (equal ns-or-class "datomic.api") + (equal name-or-member "q")) + (let ((arglists (lax-plist-get eldoc-plist "arglists"))) + (lax-plist-put eldoc-plist "arglists" + (cider--eldoc-add-datomic-query-inputs-to-arglists arglists)))) + ;; if none of the clauses is successful, do cache the eldoc + (t (setq cider-eldoc-last-symbol (list thing eldoc-plist)))) + ;; middleware eldoc lookups are expensive, so we + ;; cache the last lookup. This eliminates the need + ;; for extra middleware requests within the same sexp. + (setq cider-eldoc-last-symbol (list thing eldoc-plist))) eldoc-plist)))))))) (defun cider--eldoc-remove-dot (sym) @@ -413,6 +436,24 @@ Only useful for interop forms. Clojure forms would be returned unchanged." "Check whether FILE-NAME is representing an EDN file." (and file-name (equal (file-name-extension file-name) "edn"))) +(defun cider--eldoc-add-datomic-query-inputs-to-arglists (arglists) + "Add the expected inputs of the datomic query to the ARGLISTS." + (if (cider-second-sexp-in-list) + (let* ((query (cider-second-sexp-in-list)) + (query-inputs (nrepl-dict-get + (cider-sync-request:eldoc-datomic-query query) + "inputs"))) + (if query-inputs + (thread-first + (thread-last arglists + (car) + (remove "&") + (remove "inputs")) + (append (car query-inputs)) + (list)) + arglists)) + arglists)) + (defun cider-eldoc () "Backend function for eldoc to show argument list in the echo area." (when (and (cider-connected-p) @@ -427,7 +468,7 @@ Only useful for interop forms. Clojure forms would be returned unchanged." (when eldoc-info (if (equal (cider-eldoc-thing-type eldoc-info) 'fn) (cider-eldoc-format-function thing pos eldoc-info) - (cider-eldoc-format-variable thing pos eldoc-info)))))) + (cider-eldoc-format-variable thing eldoc-info)))))) (defun cider-eldoc-setup () "Setup eldoc in the current buffer. diff --git a/elpa/cider-20181110.1413/cider-eval.el b/elpa/cider-20181110.1413/cider-eval.el new file mode 100644 index 00000000..643fc93a --- /dev/null +++ b/elpa/cider-20181110.1413/cider-eval.el @@ -0,0 +1,1116 @@ +;;; 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 +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell + +;; 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 . + +;; 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 (or (eq face 'cider-warning-highlight-face) + (string-match-p "warning" note))) + 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 diff --git a/elpa/cider-20181110.1413/cider-find.el b/elpa/cider-20181110.1413/cider-find.el new file mode 100644 index 00000000..dc49ddac --- /dev/null +++ b/elpa/cider-20181110.1413/cider-find.el @@ -0,0 +1,231 @@ +;;; cider-find.el --- Functionality for finding things -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A bunch of commands for finding resources and definitions. + +;;; Code: + +(require 'cider-client) +(require 'cider-common) + +(require 'thingatpt) + +(defun cider--find-var-other-window (var &optional line) + "Find the definition of VAR, optionally at a specific LINE. + +Display the results in a different window." + (if-let* ((info (cider-var-info var))) + (progn + (if line (setq info (nrepl-dict-put info "line" line))) + (cider--jump-to-loc-from-info info t)) + (user-error "Symbol `%s' not resolved" var))) + +(defun cider--find-var (var &optional line) + "Find the definition of VAR, optionally at a specific LINE." + (if-let* ((info (cider-var-info var))) + (progn + (if line (setq info (nrepl-dict-put info "line" line))) + (cider--jump-to-loc-from-info info)) + (user-error "Symbol `%s' not resolved" var))) + +;;;###autoload +(defun cider-find-var (&optional arg var line) + "Find definition for VAR at LINE. +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point." + (interactive "P") + (cider-ensure-op-supported "info") + (if var + (cider--find-var var line) + (funcall (cider-prompt-for-symbol-function arg) + "Symbol" + (if (cider--open-other-window-p arg) + #'cider--find-var-other-window + #'cider--find-var)))) + +;;;###autoload +(defun cider-find-dwim-at-mouse (event) + "Find and display variable or resource at mouse EVENT." + (interactive "e") + (cider-ensure-op-supported "info") + (if-let* ((symbol-file (save-excursion + (mouse-set-point event) + (cider-symbol-at-point 'look-back)))) + (cider-find-dwim symbol-file) + (user-error "No variable or resource here"))) + +(defun cider--find-dwim (symbol-file callback &optional other-window) + "Find the SYMBOL-FILE at point. +CALLBACK upon failure to invoke prompt if not prompted previously. +Show results in a different window if OTHER-WINDOW is true." + (if-let* ((info (cider-var-info symbol-file))) + (cider--jump-to-loc-from-info info other-window) + (progn + (cider-ensure-op-supported "resource") + (if-let* ((resource (cider-sync-request:resource symbol-file)) + (buffer (cider-find-file resource))) + (cider-jump-to buffer 0 other-window) + (if (cider--prompt-for-symbol-p current-prefix-arg) + (error "Resource or var %s not resolved" symbol-file) + (let ((current-prefix-arg (if current-prefix-arg nil '(4)))) + (call-interactively callback))))))) + +(defun cider--find-dwim-interactive (prompt) + "Get interactive arguments for jump-to functions using PROMPT as needed." + (if (cider--prompt-for-symbol-p current-prefix-arg) + (list + (cider-read-from-minibuffer prompt (thing-at-point 'filename))) + (list (or (thing-at-point 'filename) "")))) ; No prompt. + +(defun cider-find-dwim-other-window (symbol-file) + "Jump to SYMBOL-FILE at point, place results in other window." + (interactive (cider--find-dwim-interactive "Jump to: ")) + (cider--find-dwim symbol-file 'cider-find-dwim-other-window t)) + +;;;###autoload +(defun cider-find-dwim (symbol-file) + "Find and display the SYMBOL-FILE at point. +SYMBOL-FILE could be a var or a resource. If thing at point is empty then +show dired on project. If var is not found, try to jump to resource of the +same name. When called interactively, a prompt is given according to the +variable `cider-prompt-for-symbol'. A single or double prefix argument +inverts the meaning. A prefix of `-' or a double prefix argument causes +the results to be displayed in a different window. A default value of thing +at point is given when prompted." + (interactive (cider--find-dwim-interactive "Jump to: ")) + (cider--find-dwim symbol-file `cider-find-dwim + (cider--open-other-window-p current-prefix-arg))) + +;;;###autoload +(defun cider-find-resource (path) + "Find the resource at PATH. +Prompt for input as indicated by the variable `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix +argument causes the results to be displayed in other window. The default +value is thing at point." + (interactive + (list + (if (cider--prompt-for-symbol-p current-prefix-arg) + (completing-read "Resource: " + (cider-sync-request:resources-list) + nil nil + (thing-at-point 'filename)) + (or (thing-at-point 'filename) "")))) + (cider-ensure-op-supported "resource") + (when (= (length path) 0) + (error "Cannot find resource for empty path")) + (if-let* ((resource (cider-sync-request:resource path)) + (buffer (cider-find-file resource))) + (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg)) + (if (cider--prompt-for-symbol-p current-prefix-arg) + (error "Cannot find resource %s" path) + (let ((current-prefix-arg (cider--invert-prefix-arg current-prefix-arg))) + (call-interactively 'cider-find-resource))))) + +(defun cider--invert-prefix-arg (arg) + "Invert the effect of prefix value ARG on `cider-prompt-for-symbol'. +This function preserves the `other-window' meaning of ARG." + (let ((narg (prefix-numeric-value arg))) + (pcase narg + (16 -1) ; empty empty -> - + (-1 16) ; - -> empty empty + (4 nil) ; empty -> no-prefix + (_ 4)))) ; no-prefix -> empty + +(defun cider--prefix-invert-prompt-p (arg) + "Test prefix value ARG for its effect on `cider-prompt-for-symbol`." + (let ((narg (prefix-numeric-value arg))) + (pcase narg + (16 t) ; empty empty + (4 t) ; empty + (_ nil)))) + +(defun cider--prompt-for-symbol-p (&optional prefix) + "Check if cider should prompt for symbol. +Tests againsts PREFIX and the value of `cider-prompt-for-symbol'. +Invert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be." + (if (cider--prefix-invert-prompt-p prefix) + (not cider-prompt-for-symbol) cider-prompt-for-symbol)) + +(defun cider--find-ns (ns &optional other-window) + "Find the file containing NS's definition. +Optionally open it in a different window if OTHER-WINDOW is truthy." + (if-let* ((path (cider-sync-request:ns-path ns))) + (cider-jump-to (cider-find-file path) nil other-window) + (user-error "Can't find namespace `%s'" ns))) + +;;;###autoload +(defun cider-find-ns (&optional arg ns) + "Find the file containing NS. +A prefix ARG of `-` or a double prefix argument causes +the results to be displayed in a different window." + (interactive "P") + (cider-ensure-connected) + (cider-ensure-op-supported "ns-path") + (if ns + (cider--find-ns ns) + (let* ((namespaces (cider-sync-request:ns-list)) + (ns (completing-read "Find namespace: " namespaces))) + (cider--find-ns ns (cider--open-other-window-p arg))))) + +;;;###autoload +(defun cider-find-keyword (&optional arg) + "Find the namespace of the keyword at point and its first occurrence there. + +For instance - if the keyword at point is \":cider.demo/keyword\", this command +would find the namespace \"cider.demo\" and afterwards find the first mention +of \"::keyword\" there. + +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point." + (interactive "P") + (cider-ensure-connected) + (let* ((kw (let ((kw-at-point (cider-symbol-at-point 'look-back))) + (if (or cider-prompt-for-symbol arg) + (read-string + (format "Keyword (default %s): " kw-at-point) + nil nil kw-at-point) + kw-at-point))) + (ns-qualifier (and + (string-match "^:+\\(.+\\)/.+$" kw) + (match-string 1 kw))) + (kw-ns (if ns-qualifier + (cider-resolve-alias (cider-current-ns) ns-qualifier) + (cider-current-ns))) + (kw-to-find (concat "::" (replace-regexp-in-string "^:+\\(.+/\\)?" "" kw)))) + + (when (and ns-qualifier (string= kw-ns (cider-current-ns))) + (error "Could not resolve alias `%s' in `%s'" ns-qualifier (cider-current-ns))) + (cider--find-ns kw-ns arg) + (search-forward-regexp kw-to-find nil 'noerror))) + +(provide 'cider-find) +;;; cider-find.el ends here diff --git a/elpa/cider-20181110.1413/cider-format.el b/elpa/cider-20181110.1413/cider-format.el new file mode 100644 index 00000000..8256ea8a --- /dev/null +++ b/elpa/cider-20181110.1413/cider-format.el @@ -0,0 +1,150 @@ +;;; cider-format.el --- Code and EDN formatting functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Middleware-powered code and EDN formatting functionality. + +;;; Code: + +(require 'subr-x) + +(require 'cider-client) +(require 'cider-util) + + +;; Format + +(defun cider--format-reindent (formatted start) + "Reindent FORMATTED to align with buffer position START." + (let* ((start-column (save-excursion (goto-char start) (current-column))) + (indent-line (concat "\n" (make-string start-column ? )))) + (replace-regexp-in-string "\n" indent-line formatted))) + + +;;; Format region + +(defun cider--format-region (start end formatter) + "Format the contents of the given region. + +START and END represent the region's boundaries. + +FORMATTER is a function of one argument which is used to convert +the string contents of the region into a formatted string. + +Uses the following heuristic to try to maintain point position: + +- Take a snippet of text starting at current position, up to 64 chars. +- Search for the snippet, with lax whitespace, in the formatted text. + - If snippet is less than 64 chars (point was near end of buffer), search + from end instead of beginning. +- Place point at match beginning, or `point-min' if no match." + (let* ((original (buffer-substring-no-properties start end)) + (formatted (funcall formatter original)) + (indented (cider--format-reindent formatted start))) + (unless (equal original indented) + (let* ((pos (point)) + (pos-max (1+ (buffer-size))) + (l 64) + (endp (> (+ pos l) pos-max)) + (snippet (thread-last (buffer-substring-no-properties + pos (min (+ pos l) pos-max)) + (regexp-quote) + (replace-regexp-in-string "[[:space:]\t\n\r]+" "[[:space:]\t\n\r]*")))) + (delete-region start end) + (insert indented) + (goto-char (if endp (point-max) (point-min))) + (funcall (if endp #'re-search-backward #'re-search-forward) snippet nil t) + (goto-char (or (match-beginning 0) start)) + (when (looking-at-p "\n") (forward-char)))))) + +;;;###autoload +(defun cider-format-region (start end) + "Format the Clojure code in the current region. +START and END represent the region's boundaries." + (interactive "r") + (cider-ensure-connected) + (cider--format-region start end #'cider-sync-request:format-code)) + + +;;; Format defun + +;;;###autoload +(defun cider-format-defun () + "Format the code in the current defun." + (interactive) + (cider-ensure-connected) + (let ((defun-bounds (cider-defun-at-point 't))) + (cider-format-region (car defun-bounds) (cadr defun-bounds)))) + + +;;; Format buffer + +(defun cider--format-buffer (formatter) + "Format the contents of the current buffer. + +Uses FORMATTER, a function of one argument, to convert the string contents +of the buffer into a formatted string." + (cider--format-region 1 (1+ (buffer-size)) formatter)) + +;;;###autoload +(defun cider-format-buffer () + "Format the Clojure code in the current buffer." + (interactive) + (check-parens) + (cider-ensure-connected) + (cider--format-buffer #'cider-sync-request:format-code)) + + +;;; Format EDN + +(declare-function cider--pretty-print-width "cider-repl") + +;;;###autoload +(defun cider-format-edn-buffer () + "Format the EDN data in the current buffer." + (interactive) + (check-parens) + (cider-ensure-connected) + (cider--format-buffer (lambda (edn) + (cider-sync-request:format-edn edn (cider--pretty-print-width))))) + +;;;###autoload +(defun cider-format-edn-region (start end) + "Format the EDN data in the current region. +START and END represent the region's boundaries." + (interactive "r") + (cider-ensure-connected) + (let* ((start-column (save-excursion (goto-char start) (current-column))) + (right-margin (- (cider--pretty-print-width) start-column))) + (cider--format-region start end + (lambda (edn) + (cider-sync-request:format-edn edn right-margin))))) + +;;;###autoload +(defun cider-format-edn-last-sexp () + "Format the EDN data of the last sexp." + (interactive) + (apply 'cider-format-edn-region (cider-sexp-at-point 'bounds))) + +(provide 'cider-format) +;;; cider-format.el ends here diff --git a/elpa/cider-20170129.1941/cider-grimoire.el b/elpa/cider-20181110.1413/cider-grimoire.el similarity index 84% rename from elpa/cider-20170129.1941/cider-grimoire.el rename to elpa/cider-20181110.1413/cider-grimoire.el index 20ac4eff..c07614ba 100644 --- a/elpa/cider-20170129.1941/cider-grimoire.el +++ b/elpa/cider-20181110.1413/cider-grimoire.el @@ -1,6 +1,6 @@ ;;; cider-grimoire.el --- Grimoire integration -*- lexical-binding: t -*- -;; Copyright © 2014-2017 Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors ;; ;; Author: Bozhidar Batsov @@ -35,6 +35,9 @@ (require 'url-vars) +(declare-function markdown-mode "markdown-mode.el") +(declare-function markdown-toggle-fontify-code-blocks-natively "markdown-mode.el") + (defconst cider-grimoire-url "http://conj.io/") (defconst cider-grimoire-buffer "*cider-grimoire*") @@ -55,7 +58,7 @@ (defun cider-grimoire-web-lookup (symbol) "Open the grimoire documentation for SYMBOL in a web browser." - (if-let ((var-info (cider-var-info symbol))) + (if-let* ((var-info (cider-var-info symbol))) (let ((name (nrepl-dict-get var-info "name")) (ns (nrepl-dict-get var-info "ns"))) (browse-url (cider-grimoire-url name ns))) @@ -78,15 +81,23 @@ opposite of what that option dictates." (with-current-buffer (cider-popup-buffer cider-grimoire-buffer t) (read-only-mode -1) (insert content) - (read-only-mode +1) + (when (require 'markdown-mode nil 'noerror) + (markdown-mode) + (cider-popup-buffer-mode 1) + (when (fboundp 'markdown-toggle-fontify-code-blocks-natively) + (markdown-toggle-fontify-code-blocks-natively 1))) + (view-mode 1) (goto-char (point-min)) (current-buffer))) (defun cider-grimoire-lookup (symbol) - "Look up the grimoire documentation for SYMBOL." - (if-let ((var-info (cider-var-info symbol))) + "Look up the grimoire documentation for SYMBOL. + +If SYMBOL is a special form, the clojure.core ns is used, as is +Grimoire's convention." + (if-let* ((var-info (cider-var-info symbol))) (let ((name (nrepl-dict-get var-info "name")) - (ns (nrepl-dict-get var-info "ns")) + (ns (nrepl-dict-get var-info "ns" "clojure.core")) (url-request-method "GET") (url-request-extra-headers `(("Content-Type" . "text/plain")))) (url-retrieve (cider-grimoire-url name ns) diff --git a/elpa/cider-20170129.1941/cider-inspector.el b/elpa/cider-20181110.1413/cider-inspector.el similarity index 82% rename from elpa/cider-20170129.1941/cider-inspector.el rename to elpa/cider-20181110.1413/cider-inspector.el index b173d21d..9823530d 100644 --- a/elpa/cider-20170129.1941/cider-inspector.el +++ b/elpa/cider-20181110.1413/cider-inspector.el @@ -1,7 +1,7 @@ ;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*- -;; Copyright © 2013-2017 Vital Reactor, LLC -;; Copyright © 2014-2017 Bozhidar Batsov and CIDER contributors +;; Copyright © 2013-2018 Vital Reactor, LLC +;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors ;; Author: Ian Eslick ;; Bozhidar Batsov @@ -29,7 +29,7 @@ (require 'cl-lib) (require 'seq) -(require 'cider-interaction) +(require 'cider-eval) ;; =================================== ;; Inspector Key Map and Derived Mode @@ -37,8 +37,6 @@ (defconst cider-inspector-buffer "*cider-inspect*") -(push cider-inspector-buffer cider-ancillary-buffers) - ;;; Customization (defgroup cider-inspector nil "Presentation and behaviour of the cider value inspector." @@ -85,10 +83,9 @@ The page size can be also changed interactively within the inspector." \\{cider-inspector-mode-map}" (set-syntax-table clojure-mode-syntax-table) - (setq buffer-read-only t) (setq-local electric-indent-chars nil) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) + (setq-local sesman-system 'CIDER) + (visual-line-mode 1)) ;;;###autoload (defun cider-inspect-last-sexp () @@ -122,19 +119,24 @@ With a second prefix argument it prompts for an expression to eval and inspect." (defvar cider-inspector-location-stack nil "A stack used to save point locations in inspector buffers. -These locations are used to emulate save-excursion between +These locations are used to emulate `save-excursion' between `cider-inspector-push' and `cider-inspector-pop' operations.") (defvar cider-inspector-page-location-stack nil "A stack used to save point locations in inspector buffers. -These locations are used to emulate save-excursion between +These locations are used to emulate `save-excursion' between `cider-inspector-next-page' and `cider-inspector-prev-page' operations.") (defvar cider-inspector-last-command nil "Contains the value of the most recently used `cider-inspector-*' command. -This is used as an alternative to the built-in `last-command'. Whenever we -invoke any command through M-x and its variants, the value of `last-command' -is not set to the command it invokes.") +This is used as an alternative to the built-in `last-command'. Whenever we +invoke any command through \\[execute-extended-command] and its variants, +the value of `last-command' is not set to the command it invokes.") + +(defvar cider-inspector--current-repl nil + "Contains the reference to the REPL where inspector was last invoked from. +This is needed for internal inspector buffer operations (push, +pop) to execute against the correct REPL session.") ;; Operations ;;;###autoload @@ -144,23 +146,30 @@ Interactively, EXPR is read from the minibuffer, and NS the current buffer's namespace." (interactive (list (cider-read-from-minibuffer "Inspect expression: " (cider-sexp-at-point)) (cider-current-ns))) - (when-let (value (cider-sync-request:inspect-expr expr ns (or cider-inspector-page-size 32))) + (setq cider-inspector--current-repl (cider-current-repl)) + (when-let* ((value (cider-sync-request:inspect-expr expr ns (or cider-inspector-page-size 32)))) (cider-inspector--render-value value))) (defun cider-inspector-pop () + "Pop the last value off the inspector stack and render it. +See `cider-sync-request:inspect-pop' and `cider-inspector--render-value'." (interactive) (setq cider-inspector-last-command 'cider-inspector-pop) - (when-let (value (cider-sync-request:inspect-pop)) + (when-let* ((value (cider-sync-request:inspect-pop))) (cider-inspector--render-value value))) (defun cider-inspector-push (idx) + "Inspect the value at IDX in the inspector stack and render it. +See `cider-sync-request:insepect-push' and `cider-inspector--render-value'" (push (point) cider-inspector-location-stack) - (when-let (value (cider-sync-request:inspect-push idx)) + (when-let* ((value (cider-sync-request:inspect-push idx))) (cider-inspector--render-value value))) (defun cider-inspector-refresh () + "Re-render the currently inspected value. +See `cider-sync-request:insepect-refresh' and `cider-inspector--render-value'" (interactive) - (when-let (value (cider-sync-request:inspect-refresh)) + (when-let* ((value (cider-sync-request:inspect-refresh))) (cider-inspector--render-value value))) (defun cider-inspector-next-page () @@ -169,7 +178,7 @@ current buffer's namespace." Does nothing if already on the last page." (interactive) (push (point) cider-inspector-page-location-stack) - (when-let (value (cider-sync-request:inspect-next-page)) + (when-let* ((value (cider-sync-request:inspect-next-page))) (cider-inspector--render-value value))) (defun cider-inspector-prev-page () @@ -178,7 +187,7 @@ Does nothing if already on the last page." Does nothing if already on the first page." (interactive) (setq cider-inspector-last-command 'cider-inspector-prev-page) - (when-let (value (cider-sync-request:inspect-prev-page)) + (when-let* ((value (cider-sync-request:inspect-prev-page))) (cider-inspector--render-value value))) (defun cider-inspector-set-page-size (page-size) @@ -186,60 +195,61 @@ Does nothing if already on the first page." Current page will be reset to zero." (interactive "nPage size: ") - (when-let (value (cider-sync-request:inspect-set-page-size page-size)) + (when-let* ((value (cider-sync-request:inspect-set-page-size page-size))) (cider-inspector--render-value value))) ;; nREPL interactions (defun cider-sync-request:inspect-pop () "Move one level up in the inspector stack." - (thread-first (list "op" "inspect-pop") - (cider-nrepl-send-sync-request) + (thread-first '("op" "inspect-pop") + (cider-nrepl-send-sync-request cider-inspector--current-repl) (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-push (idx) "Inspect the inside value specified by IDX." - (thread-first (list "op" "inspect-push" - "idx" idx) - (cider-nrepl-send-sync-request) + (thread-first `("op" "inspect-push" + "idx" ,idx) + (cider-nrepl-send-sync-request cider-inspector--current-repl) (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-refresh () "Re-render the currently inspected value." - (thread-first (list "op" "inspect-refresh") - (cider-nrepl-send-sync-request) + (thread-first '("op" "inspect-refresh") + (cider-nrepl-send-sync-request cider-inspector--current-repl) (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-next-page () "Jump to the next page in paginated collection view." - (thread-first (list "op" "inspect-next-page") - (cider-nrepl-send-sync-request) + (thread-first '("op" "inspect-next-page") + (cider-nrepl-send-sync-request cider-inspector--current-repl) (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-prev-page () "Jump to the previous page in paginated collection view." - (thread-first (list "op" "inspect-prev-page") - (cider-nrepl-send-sync-request) + (thread-first '("op" "inspect-prev-page") + (cider-nrepl-send-sync-request cider-inspector--current-repl) (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-set-page-size (page-size) "Set the page size in paginated view to PAGE-SIZE." - (thread-first (list "op" "inspect-set-page-size" - "page-size" page-size) - (cider-nrepl-send-sync-request) + (thread-first `("op" "inspect-set-page-size" + "page-size" ,page-size) + (cider-nrepl-send-sync-request cider-inspector--current-repl) (nrepl-dict-get "value"))) (defun cider-sync-request:inspect-expr (expr ns page-size) "Evaluate EXPR in context of NS and inspect its result. Set the page size in paginated view to PAGE-SIZE." (thread-first (append (nrepl--eval-request expr ns) - (list "inspect" "true" - "page-size" page-size)) - (cider-nrepl-send-sync-request) + `("inspect" "true" + "page-size" ,page-size)) + (cider-nrepl-send-sync-request cider-inspector--current-repl) (nrepl-dict-get "value"))) ;; Render Inspector from Structured Values (defun cider-inspector--render-value (value) - (cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode) + "Render VALUE." + (cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode 'ancillary) (cider-inspector-render cider-inspector-buffer value) (cider-popup-buffer-display cider-inspector-buffer t) (when cider-inspector-fill-frame (delete-other-windows)) @@ -259,6 +269,7 @@ Set the page size in paginated view to PAGE-SIZE." (goto-char (pop cider-inspector-page-location-stack)))))) (defun cider-inspector-render (buffer str) + "Render STR in BUFFER." (with-current-buffer buffer (cider-inspector-mode) (let ((inhibit-read-only t)) @@ -268,10 +279,12 @@ Set the page size in paginated view to PAGE-SIZE." (goto-char (point-min)))) (defun cider-inspector-render* (elements) + "Render ELEMENTS." (dolist (el elements) (cider-inspector-render-el* el))) (defun cider-inspector-render-el* (el) + "Render EL." (cond ((symbolp el) (insert (symbol-name el))) ((stringp el) (insert (propertize el 'font-lock-face 'font-lock-keyword-face))) ((and (consp el) (eq (car el) :newline)) @@ -281,6 +294,7 @@ Set the page size in paginated view to PAGE-SIZE." (t (message "Unrecognized inspector object: %s" el)))) (defun cider-inspector-render-value (value idx) + "Render VALUE at IDX." (cider-propertize-region (list 'cider-value-idx idx 'mouse-face 'highlight) @@ -346,6 +360,7 @@ If ARG is negative, move forwards." (cider-inspector-next-inspectable-object (- arg))) (defun cider-inspector-property-at-point () + "Return property at point." (let* ((properties '(cider-value-idx cider-range-button cider-action-number)) (find-property @@ -382,10 +397,6 @@ that value. (t (error "No clickable part here"))))) -;;;###autoload -(define-obsolete-function-alias 'cider-inspect-read-and-inspect - 'cider-inspect-expr "0.13.0") - (provide 'cider-inspector) ;;; cider-inspector.el ends here diff --git a/elpa/cider-20170129.1941/cider-macroexpansion.el b/elpa/cider-20181110.1413/cider-macroexpansion.el similarity index 89% rename from elpa/cider-20170129.1941/cider-macroexpansion.el rename to elpa/cider-20181110.1413/cider-macroexpansion.el index d0ca9db9..8123932a 100644 --- a/elpa/cider-20170129.1941/cider-macroexpansion.el +++ b/elpa/cider-20181110.1413/cider-macroexpansion.el @@ -1,7 +1,7 @@ ;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -37,8 +37,6 @@ (defconst cider-macroexpansion-buffer "*cider-macroexpansion*") -(push cider-macroexpansion-buffer cider-ancillary-buffers) - (defcustom cider-macroexpansion-display-namespaces 'tidy "Determines if namespaces are displayed in the macroexpansion buffer. Possible values are: @@ -66,15 +64,14 @@ Possible values are: The default for DISPLAY-NAMESPACES is taken from `cider-macroexpansion-display-namespaces'." (cider-ensure-op-supported "macroexpand") - (thread-first (list "op" "macroexpand" - "expander" expander - "code" expr - "ns" (cider-current-ns) - "display-namespaces" - (or display-namespaces - (symbol-name cider-macroexpansion-display-namespaces))) - (append (when cider-macroexpansion-print-metadata - (list "print-meta" "true"))) + (thread-first `("op" "macroexpand" + "expander" ,expander + "code" ,expr + "ns" ,(cider-current-ns) + "display-namespaces" ,(or display-namespaces + (symbol-name cider-macroexpansion-display-namespaces))) + (nconc (when cider-macroexpansion-print-metadata + '("print-meta" "true"))) (cider-nrepl-send-sync-request) (nrepl-dict-get "expansion"))) @@ -91,7 +88,7 @@ This variable specifies both what was expanded and the expander.") (defun cider-macroexpand-expr (expander expr) "Macroexpand, use EXPANDER, the given EXPR." - (when-let ((expansion (cider-sync-request:macroexpand expander expr))) + (when-let* ((expansion (cider-sync-request:macroexpand expander expr))) (setq cider-last-macroexpand-expression expr) (cider-initialize-macroexpansion-buffer expansion (cider-current-ns)))) @@ -127,12 +124,12 @@ If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of ;;;###autoload (defun cider-macroexpand-all () - "Invoke \\=`clojure.walk/macroexpand-all\\=` on the expression preceding point." + "Invoke \\=`macroexpand-all\\=` on the expression preceding point." (interactive) (cider-macroexpand-expr "macroexpand-all" (cider-last-sexp))) (defun cider-macroexpand-all-inplace () - "Perform inplace \\=`clojure.walk/macroexpand-all\\=` on the expression preceding point." + "Perform inplace \\=`macroexpand-all\\=` on the expression preceding point." (interactive) (cider-macroexpand-expr-inplace "macroexpand-all")) @@ -165,12 +162,13 @@ and point is placed after the expanded form." (defun cider-create-macroexpansion-buffer () "Create a new macroexpansion buffer." - (with-current-buffer (cider-popup-buffer cider-macroexpansion-buffer t) - (clojure-mode) + (with-current-buffer (cider-popup-buffer cider-macroexpansion-buffer 'select 'clojure-mode 'ancillary) (cider-mode -1) (cider-macroexpansion-mode 1) (current-buffer))) +(declare-function cider-find-var "cider-find") + (defvar cider-macroexpansion-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "g") #'cider-macroexpand-again) diff --git a/elpa/cider-20170129.1941/cider-mode.el b/elpa/cider-20181110.1413/cider-mode.el similarity index 65% rename from elpa/cider-20170129.1941/cider-mode.el rename to elpa/cider-20181110.1413/cider-mode.el index 7bc0a98c..f9b2189e 100644 --- a/elpa/cider-20170129.1941/cider-mode.el +++ b/elpa/cider-20181110.1413/cider-mode.el @@ -1,7 +1,7 @@ ;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -32,11 +32,13 @@ ;;; Code: (require 'clojure-mode) -(require 'cider-interaction) -(require 'cider-test) +(require 'cider-eval) +(require 'cider-test) ; required only for the menu (require 'cider-eldoc) (require 'cider-resolve) -(require 'cider-doc) +(require 'cider-doc) ; required only for the menu +(require 'cider-profile) ; required only for the menu +(require 'cider-completion) (require 'subr-x) (require 'cider-compat) @@ -47,10 +49,9 @@ :package-version '(cider "0.10.0")) (defun cider--modeline-info () - "Return info for the `cider-mode' modeline. - -Info contains project name and host:port endpoint." - (if-let ((current-connection (ignore-errors (cider-current-connection)))) + "Return info for the cider mode modeline. +Info contains the connection type, project name and host:port endpoint." + (if-let* ((current-connection (ignore-errors (cider-current-repl)))) (with-current-buffer current-connection (concat cider-repl-type @@ -66,16 +67,15 @@ Info contains project name and host:port endpoint." ;;;###autoload (defcustom cider-mode-line '(:eval (format " cider[%s]" (cider--modeline-info))) - "Mode line lighter for `cider-mode'. + "Mode line lighter for cider mode. The value of this variable is a mode line template as in -`mode-line-format'. See Info Node `(elisp)Mode Line Format' for -details about mode line templates. +`mode-line-format'. See Info Node `(elisp)Mode Line Format' for details +about mode line templates. -Customize this variable to change how `cider-mode' displays its -status in the mode line. The default value displays the current connection. -Set this variable to nil to disable the mode line -entirely." +Customize this variable to change how cider mode displays its status in the +mode line. The default value displays the current connection. Set this +variable to nil to disable the mode line entirely." :group 'cider :type 'sexp :risky t @@ -83,32 +83,11 @@ entirely." ;;; Switching between REPL & source buffers -(defvar-local cider-last-clojure-buffer nil - "A buffer-local variable holding the last Clojure source buffer. -`cider-switch-to-last-clojure-buffer' uses this variable to jump -back to last Clojure source buffer.") - -(defun cider-remember-clojure-buffer (buffer) - "Try to remember the BUFFER from which the user jumps. -The BUFFER needs to be a Clojure buffer and current major mode needs -to be `cider-repl-mode'. The user can use `cider-switch-to-last-clojure-buffer' -to jump back to the last Clojure source buffer." - (when (and buffer - (with-current-buffer buffer - (derived-mode-p 'clojure-mode)) - (derived-mode-p 'cider-repl-mode)) - (setq cider-last-clojure-buffer buffer))) (defun cider--switch-to-repl-buffer (repl-buffer &optional set-namespace) "Select the REPL-BUFFER, when possible in an existing window. - -Hint: You can use `display-buffer-reuse-frames' and -`special-display-buffer-names' to customize the frame in which -the buffer should appear. - When SET-NAMESPACE is t, sets the namespace in the REPL buffer to that of the namespace in the Clojure source buffer." - (cider-ensure-connected) (let ((buffer (current-buffer))) ;; first we switch to the REPL buffer (if cider-repl-display-in-current-window @@ -117,27 +96,19 @@ that of the namespace in the Clojure source buffer." ;; then if necessary we update its namespace (when set-namespace (cider-repl-set-ns (with-current-buffer buffer (cider-current-ns)))) - (cider-remember-clojure-buffer buffer) (goto-char (point-max)))) (defun cider-switch-to-repl-buffer (&optional set-namespace) - "Select the REPL buffer, when possible in an existing window. -The buffer chosen is based on the file open in the current buffer. - -If the REPL buffer cannot be unambiguously determined, the REPL -buffer is chosen based on the current connection buffer and a -message raised informing the user. - -Hint: You can use `display-buffer-reuse-frames' and -`special-display-buffer-names' to customize the frame in which -the buffer should appear. - -With a prefix arg SET-NAMESPACE sets the namespace in the REPL buffer to that -of the namespace in the Clojure source buffer." + "Switch to current REPL buffer, when possible in an existing window. +The type of the REPL is inferred from the mode of current buffer. With a +prefix arg SET-NAMESPACE sets the namespace in the REPL buffer to that of +the namespace in the Clojure source buffer" (interactive "P") - (cider--switch-to-repl-buffer (cider-current-repl-buffer) set-namespace)) + (cider--switch-to-repl-buffer + (cider-current-repl nil 'ensure) + set-namespace)) -(declare-function cider-load-buffer "cider-interaction") +(declare-function cider-load-buffer "cider-eval") (defun cider-load-buffer-and-switch-to-repl-buffer (&optional set-namespace) "Load the current buffer into the matching REPL buffer and switch to it. @@ -154,48 +125,180 @@ the same as `cider-switch-to-repl-buffer', so that it is very convenient to jump between a Clojure buffer and the REPL buffer." (interactive) - (if (and (derived-mode-p 'cider-repl-mode) - (buffer-live-p cider-last-clojure-buffer)) - (if cider-repl-display-in-current-window - (pop-to-buffer-same-window cider-last-clojure-buffer) - (pop-to-buffer cider-last-clojure-buffer)) - (message "Don't know the original Clojure buffer"))) + (if (derived-mode-p 'cider-repl-mode) + (let* ((a-buf) + (the-buf (let ((repl-type (cider-repl-type-for-buffer))) + (seq-find (lambda (b) + (unless (with-current-buffer b (derived-mode-p 'cider-repl-mode)) + (when-let* ((type (cider-repl-type-for-buffer b))) + (unless a-buf + (setq a-buf b)) + (or (equal type "multi") + (equal type repl-type))))) + (buffer-list))))) + (if-let* ((buf (or the-buf a-buf))) + (if cider-repl-display-in-current-window + (pop-to-buffer-same-window buf) + (pop-to-buffer buf)) + (user-error "No Clojure buffer found"))) + (user-error "Not in a CIDER REPL buffer"))) (defun cider-find-and-clear-repl-output (&optional clear-repl) "Find the current REPL buffer and clear it. -With a prefix argument CLEAR-REPL the command clears the entire REPL buffer. -Returns to the buffer in which the command was invoked." +With a prefix argument CLEAR-REPL the command clears the entire REPL +buffer. Returns to the buffer in which the command was invoked. See also +the related commands `cider-repl-clear-buffer' and +`cider-repl-clear-output'." (interactive "P") (let ((origin-buffer (current-buffer))) - (switch-to-buffer (cider-current-repl-buffer)) + (switch-to-buffer (cider-current-repl)) (if clear-repl (cider-repl-clear-buffer) (cider-repl-clear-output)) (switch-to-buffer origin-buffer))) +(defun cider-undef () + "Undefine a symbol from the current ns." + (interactive) + (cider-ensure-op-supported "undef") + (cider-read-symbol-name + "Undefine symbol: " + (lambda (sym) + (cider-nrepl-send-request + `("op" "undef" + "ns" ,(cider-current-ns) + "symbol" ,sym) + (cider-interactive-eval-handler (current-buffer)))))) + +;;; cider-run +(defvar cider--namespace-history nil + "History of user input for namespace prompts.") + +(defun cider--var-namespace (var) + "Return the namespace of VAR. +VAR is a fully qualified Clojure variable name as a string." + (replace-regexp-in-string "\\(?:#'\\)?\\(.*\\)/.*" "\\1" var)) + +(defun cider-run (&optional function) + "Run -main or FUNCTION, prompting for its namespace if necessary. +With a prefix argument, prompt for function to run instead of -main." + (interactive (list (when current-prefix-arg (read-string "Function name: ")))) + (cider-ensure-connected) + (let ((name (or function "-main"))) + (when-let* ((response (cider-nrepl-send-sync-request + `("op" "ns-list-vars-by-name" + "name" ,name)))) + (if-let* ((vars (split-string (substring (nrepl-dict-get response "var-list") 1 -1)))) + (cider-interactive-eval + (if (= (length vars) 1) + (concat "(" (car vars) ")") + (let* ((completions (mapcar #'cider--var-namespace vars)) + (def (or (car cider--namespace-history) + (car completions)))) + (format "(#'%s/%s)" + (completing-read (format "Namespace (%s): " def) + completions nil t nil + 'cider--namespace-history def) + name)))) + (user-error "No %s var defined in any namespace" (cider-propertize name 'fn)))))) + +;;; Insert (and eval) in REPL functionality +(defvar cider-insert-commands-map + (let ((map (define-prefix-command 'cider-insert-commands-map))) + ;; single key bindings defined last for display in menu + (define-key map (kbd "e") #'cider-insert-last-sexp-in-repl) + (define-key map (kbd "d") #'cider-insert-defun-in-repl) + (define-key map (kbd "r") #'cider-insert-region-in-repl) + (define-key map (kbd "n") #'cider-insert-ns-form-in-repl) + + ;; duplicates with C- for convenience + (define-key map (kbd "C-e") #'cider-insert-last-sexp-in-repl) + (define-key map (kbd "C-d") #'cider-insert-defun-in-repl) + (define-key map (kbd "C-r") #'cider-insert-region-in-repl) + (define-key map (kbd "C-n") #'cider-insert-ns-form-in-repl))) + +(defcustom cider-switch-to-repl-after-insert-p t + "Whether to switch to the repl after inserting a form into the repl." + :type 'boolean + :group 'cider + :package-version '(cider . "0.18.0")) + +(defcustom cider-invert-insert-eval-p nil + "Whether to invert the behavior of evaling. +Default behavior when inserting is to NOT eval the form and only eval with +a prefix. This allows to invert this so that default behavior is to insert +and eval and the prefix is required to prevent evaluation." + :type 'boolean + :group 'cider + :package-version '(cider . "0.18.0")) + +(defun cider-insert-in-repl (form eval) + "Insert FORM in the REPL buffer and switch to it. +If EVAL is non-nil the form will also be evaluated." + (while (string-match "\\`[ \t\n\r]+\\|[ \t\n\r]+\\'" form) + (setq form (replace-match "" t t form))) + (with-current-buffer (cider-current-repl) + (goto-char (point-max)) + (let ((beg (point))) + (insert form) + (indent-region beg (point))) + (when (if cider-invert-insert-eval-p + (not eval) + eval) + (cider-repl-return))) + (when cider-switch-to-repl-after-insert-p + (cider-switch-to-repl-buffer))) + +(defun cider-insert-last-sexp-in-repl (&optional arg) + "Insert the expression preceding point in the REPL buffer. +If invoked with a prefix ARG eval the expression after inserting it." + (interactive "P") + (cider-insert-in-repl (cider-last-sexp) arg)) + +(defun cider-insert-defun-in-repl (&optional arg) + "Insert the top level form at point in the REPL buffer. +If invoked with a prefix ARG eval the expression after inserting it." + (interactive "P") + (cider-insert-in-repl (cider-defun-at-point) arg)) + +(defun cider-insert-region-in-repl (start end &optional arg) + "Insert the curent region in the REPL buffer. +START and END represent the region's boundaries. +If invoked with a prefix ARG eval the expression after inserting it." + (interactive "rP") + (cider-insert-in-repl + (buffer-substring-no-properties start end) arg)) + +(defun cider-insert-ns-form-in-repl (&optional arg) + "Insert the current buffer's ns form in the REPL buffer. +If invoked with a prefix ARG eval the expression after inserting it." + (interactive "P") + (cider-insert-in-repl (cider-ns-form) arg)) + + ;;; The menu-bar (defconst cider-mode-menu `("CIDER" - ["Start a REPL" cider-jack-in - :help "Starts an nREPL server (with lein, boot, or maven) and connects a REPL to it."] - ["Connect to a REPL" cider-connect - :help "Connects to a REPL that's already running."] - ["Quit" cider-quit :active cider-connections] - ["Restart" cider-restart :active cider-connections] - ("Clojurescript" - ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clojurescript - :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL. -Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your build tool."] - ["Create a ClojureScript REPL from a Clojure REPL" cider-create-sibling-cljs-repl] - ["Form for launching a ClojureScript REPL via Leiningen" (customize-variable 'cider-cljs-lein-repl)] - ["Form for launching a ClojureScript REPL via Boot" (customize-variable 'cider-cljs-boot-repl)] - ["Form for launching a ClojureScript REPL via Gradle" (customize-variable 'cider-cljs-gradle-repl)]) + ["Start or connect to any REPL" cider + :help "A simple wrapper around all commands for starting/connecting to a REPL."] + ("Clojure" + ["Start a Clojure REPL" cider-jack-in + :help "Starts an nREPL server and connects a Clojure REPL to it."] + ["Connect to a Clojure REPL" cider-connect + :help "Connects to a REPL that's already running."]) + ("ClojureScript" + ["Start a ClojureScript REPL" cider-jack-in-cljs + :help "Starts an nREPL server and connects a ClojureScript REPL to it."] + ["Connect to a ClojureScript REPL" cider-connect-clojurescript + :help "Connects to a ClojureScript REPL that's already running."] + ["Create a ClojureScript REPL from a Clojure REPL" cider-jack-in-sibling-clojurescript]) + "--" + ["Quit" cider-quit :active (cider-connected-p)] + ["Restart" cider-restart :active (cider-connected-p)] "--" - ["Connection info" cider-display-connection-info - :active cider-connections] - ["Rotate default connection" cider-rotate-default-connection - :active (cdr cider-connections)] + ["Connection info" cider-describe-connection + :active (cider-connected-p)] ["Select any CIDER buffer" cider-selector] "--" ["Configure CIDER" (customize-group 'cider)] @@ -208,40 +311,55 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b "--" ["Close ancillary buffers" cider-close-ancillary-buffers :active (seq-remove #'null cider-ancillary-buffers)] - ("nREPL" :active cider-connections - ["Describe session" cider-describe-nrepl-session] - ["Close session" cider-close-nrepl-session] - ["Toggle message logging" nrepl-toggle-message-logging])) - "Menu for CIDER mode") + ("nREPL" :active (cider-connected-p) + ["Describe nrepl session" cider-describe-nrepl-session] + ["Toggle message logging" nrepl-toggle-message-logging]) + "Menu for CIDER mode.")) (defconst cider-mode-eval-menu - '("CIDER Eval" :visible cider-connections + '("CIDER Eval" :visible (cider-connected-p) ["Eval top-level sexp" cider-eval-defun-at-point] - ["Eval current sexp" cider-eval-sexp-at-point] - ["Eval last sexp" cider-eval-last-sexp] - ["Eval selected region" cider-eval-region] - ["Eval ns form" cider-eval-ns-form] + ["Eval top-level sexp to point" cider-eval-defun-up-to-point] + ["Eval top-level sexp to comment" cider-eval-defun-to-comment] + ["Eval top-level sexp and pretty-print to comment" cider-pprint-eval-defun-to-comment] "--" - ["Interrupt evaluation" cider-interrupt] + ["Eval current sexp" cider-eval-sexp-at-point] + ["Eval current sexp to point" cider-eval-sexp-up-to-point] + ["Eval current sexp in context" cider-eval-sexp-at-point-in-context] "--" + ["Eval last sexp" cider-eval-last-sexp] + ["Eval last sexp in context" cider-eval-last-sexp-in-context] ["Eval last sexp and insert" cider-eval-print-last-sexp :keys "\\[universal-argument] \\[cider-eval-last-sexp]"] ["Eval last sexp in popup buffer" cider-pprint-eval-last-sexp] ["Eval last sexp and replace" cider-eval-last-sexp-and-replace] ["Eval last sexp to REPL" cider-eval-last-sexp-to-repl] ["Eval last sexp and pretty-print to REPL" cider-pprint-eval-last-sexp-to-repl] + ["Eval last sexp and pretty-print to comment" cider-pprint-eval-last-sexp-to-comment] + "--" + ["Eval selected region" cider-eval-region] + ["Eval ns form" cider-eval-ns-form] + "--" + ["Interrupt evaluation" cider-interrupt] + "--" ["Insert last sexp in REPL" cider-insert-last-sexp-in-repl] - ["Eval top-level sexp to comment" cider-eval-defun-to-comment] + ["Insert top-level sexp in REPL" cider-insert-defun-in-repl] + ["Insert region in REPL" cider-insert-region-in-repl] + ["Insert ns form in REPL" cider-insert-ns-form-in-repl] "--" ["Load this buffer" cider-load-buffer] + ["Load this buffer and switch to REPL" cider-load-buffer-and-switch-to-repl-buffer] ["Load another file" cider-load-file] + ["Recursively load all files in directory" cider-load-all-files] ["Load all project files" cider-load-all-project-ns] - ["Refresh loaded code" cider-refresh] + ["Refresh loaded code" cider-ns-refresh] + ["Require and reload" cider-ns-reload] + ["Require and reload all" cider-ns-reload-all] ["Run project (-main function)" cider-run]) "Menu for CIDER mode eval commands.") (defconst cider-mode-interactions-menu - `("CIDER Interactions" :visible cider-connections + `("CIDER Interactions" :visible (cider-connected-p) ["Complete symbol" complete-symbol] "--" ("REPL" @@ -257,8 +375,22 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b ,cider-doc-menu ("Find (jump to)" ["Find definition" cider-find-var] + ["Find namespace" cider-find-ns] ["Find resource" cider-find-resource] + ["Find keyword" cider-find-keyword] ["Go back" cider-pop-back]) + ("Browse" + ["Browse namespace" cider-browse-ns] + ["Browse all namespaces" cider-browse-ns-all] + ["Browse spec" cider-browse-spec] + ["Browse all specs" cider-browse-spec-all] + ["Browse REPL input history" cider-repl-history] + ["Browse classpath" cider-classpath] + ["Browse classpath entry" cider-open-classpath-entry]) + ("Format" + ["Format EDN last sexp" cider-format-edn-last-sexp] + ["Format EDN region" cider-format-edn-region] + ["Format EDN buffer" cider-format-edn-buffer]) ("Macroexpand" ["Macroexpand-1" cider-macroexpand-1] ["Macroexpand-all" cider-macroexpand-all]) @@ -273,19 +405,64 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b ["List instrumented defs" cider-browse-instrumented-defs] "--" ["Configure the Debugger" (customize-group 'cider-debug)]) - ("Browse" - ["Browse namespace" cider-browse-ns] - ["Browse all namespaces" cider-browse-ns-all] - ["Browse REPL input history" cider-repl-history] - ["Browse classpath" cider-classpath] - ["Browse classpath entry" cider-open-classpath-entry])) + ,cider-profile-menu + ("Misc" + ["Clojure Cheatsheet" cider-cheatsheet] + ["Flush completion cache" cider-completion-flush-caches])) "Menu for CIDER interactions.") + +(declare-function cider-ns-refresh "cider-ns") +(declare-function cider-ns-reload "cider-ns") +(declare-function cider-ns-reload-all "cider-ns") +(declare-function cider-browse-ns "cider-browse-ns") +(declare-function cider-eval-ns-form "cider-eval") +(declare-function cider-repl-set-ns "cider-repl") +(declare-function cider-find-ns "cider-find") + +(defvar cider-ns-map + (let ((map (define-prefix-command 'cider-ns-map))) + (define-key map (kbd "b") #'cider-browse-ns) + (define-key map (kbd "M-b") #'cider-browse-ns) + (define-key map (kbd "e") #'cider-eval-ns-form) + (define-key map (kbd "M-e") #'cider-eval-ns-form) + (define-key map (kbd "f") #'cider-find-ns) + (define-key map (kbd "M-f") #'cider-find-ns) + (define-key map (kbd "n") #'cider-repl-set-ns) + (define-key map (kbd "M-n") #'cider-repl-set-ns) + (define-key map (kbd "r") #'cider-ns-refresh) + (define-key map (kbd "M-r") #'cider-ns-refresh) + (define-key map (kbd "l") #'cider-ns-reload) + (define-key map (kbd "M-l") #'cider-ns-reload-all) + map) + "CIDER NS keymap.") + +;; Those declares are needed, because we autoload all those commands when first +;; used. That optimizes CIDER's initial load time. +(declare-function cider-macroexpand-1 "cider-macroexpansion") +(declare-function cider-macroexpand-all "cider-macroexpansion") +(declare-function cider-selector "cider-selector") +(declare-function cider-toggle-trace-ns "cider-tracing") +(declare-function cider-toggle-trace-var "cider-tracing") +(declare-function cider-find-resource "cider-find") +(declare-function cider-find-keyword "cider-find") +(declare-function cider-find-var "cider-find") +(declare-function cider-find-dwim-at-mouse "cider-find") + +(defconst cider--has-many-mouse-buttons (not (memq window-system '(mac ns))) + "Non-nil if system binds forward and back buttons to and . + +As it stands Emacs fires these events on and on 'x' and +'w32'systems while on macOS it presents them on and .") + (defconst cider-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 (if cider--has-many-mouse-buttons "" "")) #'xref-pop-marker-stack) + (define-key map (kbd (if cider--has-many-mouse-buttons "" "")) #'cider-find-dwim-at-mouse) (define-key map (kbd "C-c C-.") #'cider-find-ns) + (define-key map (kbd "C-c C-:") #'cider-find-keyword) (define-key map (kbd "M-,") #'cider-pop-back) (define-key map (kbd "C-c M-.") #'cider-find-resource) (define-key map (kbd "M-TAB") #'complete-symbol) @@ -293,17 +470,18 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b (define-key map (kbd "C-c C-c") #'cider-eval-defun-at-point) (define-key map (kbd "C-x C-e") #'cider-eval-last-sexp) (define-key map (kbd "C-c C-e") #'cider-eval-last-sexp) + (define-key map (kbd "C-c C-p") #'cider-pprint-eval-last-sexp) + (define-key map (kbd "C-c C-f") #'cider-pprint-eval-defun-at-point) (define-key map (kbd "C-c C-v") 'cider-eval-commands-map) + (define-key map (kbd "C-c C-j") 'cider-insert-commands-map) (define-key map (kbd "C-c M-;") #'cider-eval-defun-to-comment) (define-key map (kbd "C-c M-e") #'cider-eval-last-sexp-to-repl) (define-key map (kbd "C-c M-p") #'cider-insert-last-sexp-in-repl) - (define-key map (kbd "C-c C-p") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "C-c C-f") #'cider-pprint-eval-defun-at-point) (define-key map (kbd "C-c M-:") #'cider-read-and-eval) (define-key map (kbd "C-c C-u") #'cider-undef) (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 M-n") #'cider-repl-set-ns) + (define-key map (kbd "C-c M-n") 'cider-ns-map) (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) @@ -312,14 +490,15 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b (define-key map (kbd "C-c C-o") #'cider-find-and-clear-repl-output) (define-key map (kbd "C-c C-k") #'cider-load-buffer) (define-key map (kbd "C-c C-l") #'cider-load-file) + (define-key map (kbd "C-c C-M-l") #'cider-load-all-files) (define-key map (kbd "C-c C-b") #'cider-interrupt) (define-key map (kbd "C-c ,") 'cider-test-commands-map) (define-key map (kbd "C-c C-t") 'cider-test-commands-map) (define-key map (kbd "C-c M-s") #'cider-selector) - (define-key map (kbd "C-c M-r") #'cider-rotate-default-connection) - (define-key map (kbd "C-c M-d") #'cider-display-connection-info) - (define-key map (kbd "C-c C-x") #'cider-refresh) + (define-key map (kbd "C-c M-d") #'cider-describe-connection) + (define-key map (kbd "C-c C-=") 'cider-profile-map) (define-key map (kbd "C-c C-q") #'cider-quit) + (define-key map (kbd "C-c M-r") #'cider-restart) (dolist (variable '(cider-mode-interactions-menu cider-mode-eval-menu cider-mode-menu)) @@ -333,20 +512,23 @@ Configure `cider-cljs-*-repl' to change the ClojureScript REPL to use for your b ;; loaded yet, this will be shown in Clojure buffers next to the "Clojure" ;; menu. ;;;###autoload -(eval-after-load 'clojure-mode - '(easy-menu-define cider-clojure-mode-menu-open clojure-mode-map - "Menu for Clojure mode. +(with-eval-after-load 'clojure-mode + (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map + "Menu for Clojure mode. This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." - `("CIDER" :visible (not cider-mode) - ["Start a REPL" cider-jack-in - :help "Starts an nREPL server (with lein, boot, or maven) and connects a REPL to it."] - ["Connect to a REPL" cider-connect - :help "Connects to a REPL that's already running."] - ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clojurescript - :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL. - Configure `cider-cljs-lein-repl', `cider-cljs-boot-repl' and `cider-cljs-gradle-repl' to change the ClojureScript REPL to use."] - "--" - ["View manual online" cider-view-manual]))) + `("CIDER" :visible (not cider-mode) + ["Start a Clojure REPL" cider-jack-in-clj + :help "Starts an nREPL server and connects a Clojure REPL to it."] + ["Connect to a Clojure REPL" cider-connect-clj + :help "Connects to a REPL that's already running."] + ["Start a ClojureScript REPL" cider-jack-in-cljs + :help "Starts an nREPL server and connects a ClojureScript REPL to it."] + ["Connect to a ClojureScript REPL" cider-connect-cljs + :help "Connects to a ClojureScript REPL that's already running."] + ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clj&cljs + :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] + "--" + ["View manual online" cider-view-manual]))) ;;; Dynamic indentation (defcustom cider-dynamic-indentation t @@ -363,10 +545,11 @@ re-visited." (defun cider--get-symbol-indent (symbol-name) "Return the indent metadata for SYMBOL-NAME in the current namespace." - (let* ((ns (cider-current-ns))) - (if-let ((meta (cider-resolve-var ns symbol-name)) - (indent (or (nrepl-dict-get meta "style/indent") - (nrepl-dict-get meta "indent")))) + (let* ((ns (let ((clojure-cache-ns t)) ; we force ns caching here for performance reasons + (cider-current-ns)))) + (if-let* ((meta (cider-resolve-var ns symbol-name)) + (indent (or (nrepl-dict-get meta "style/indent") + (nrepl-dict-get meta "indent")))) (let ((format (format ":indent metadata on ‘%s’ is unreadable! \nERROR: %%s" symbol-name))) (with-demoted-errors format @@ -374,9 +557,9 @@ re-visited." ;; There's no indent metadata, but there might be a clojure-mode ;; indent-spec with fully-qualified namespace. (when (string-match cider-resolve--prefix-regexp symbol-name) - (when-let ((sym (intern-soft (replace-match (save-match-data - (cider-resolve-alias ns (match-string 1 symbol-name))) - t t symbol-name 1)))) + (when-let* ((sym (intern-soft (replace-match (save-match-data + (cider-resolve-alias ns (match-string 1 symbol-name))) + t t symbol-name 1)))) (get sym 'clojure-indent-function)))))) @@ -390,9 +573,9 @@ variable to nil you'll still see basic syntax highlighting. The value is a list of symbols, each one indicates a different type of var that should be font-locked: - `macro' (default): Any defined macro gets the `font-lock-builtin-face'. + `macro' (default): Any defined macro gets the `font-lock-keyword-face'. `function': Any defined function gets the `font-lock-function-face'. - `var': Any non-local var gets the `font-lock-variable-face'. + `var': Any non-local var gets the `font-lock-variable-name-face'. `deprecated' (default): Any deprecated var gets the `cider-deprecated-face' face. `core' (default): Any symbol from clojure.core (face depends on type). @@ -443,7 +626,6 @@ The value can also be t, which means to font-lock as much as possible." (defconst cider-reader-conditionals-regexp "\\(?:#\\?@?[[:space:]\n]*(\\)" "Regexp for matching reader conditionals with a non-capturing group. - Starts from the reader macro characters to the opening parentheses.") (defvar cider--reader-conditionals-match-data (list nil nil) @@ -451,7 +633,6 @@ Starts from the reader macro characters to the opening parentheses.") (defun cider--search-reader-conditionals (limit) "Matcher for finding reader conditionals. - Search is done with the given LIMIT." (when (and cider-font-lock-reader-conditionals (cider-connected-p)) @@ -468,34 +649,38 @@ Search is done with the given LIMIT." (set-match-data md) t)))))))) -(defun cider--anchored-search-suppressed-forms-internal (limit) +(defun cider--anchored-search-suppressed-forms-internal (repl-types limit) "Helper function for `cider--anchored-search-suppressed-forms`. - -LIMIT is the same as the LIMIT in `cider--anchored-search-suppressed-forms`" - (let ((expr (read (current-buffer))) - (start (save-excursion (backward-sexp) (point)))) - (when (<= (point) limit) - (forward-sexp) - (if (not (string-equal (symbol-name expr) (concat ":" (cider-connection-type-for-buffer)))) - (ignore-errors - (cl-assert (<= (point) limit)) - (let ((md (match-data nil cider--reader-conditionals-match-data))) - (setf (nth 0 md) start) - (setf (nth 1 md) (point)) - (set-match-data md) - t)) - (cider--anchored-search-suppressed-forms-internal limit))))) +REPL-TYPES is a list of strings repl-type strings. LIMIT is the same as +the LIMIT in `cider--anchored-search-suppressed-forms`" + (when (= (length repl-types) 1) + (let ((type (car repl-types)) + (expr (read (current-buffer))) + (start (save-excursion (backward-sexp) (point)))) + (when (<= (point) limit) + (forward-sexp) + (if (not (string-equal (symbol-name expr) (concat ":" type))) + (ignore-errors + (cl-assert (<= (point) limit)) + (let ((md (match-data nil cider--reader-conditionals-match-data))) + (setf (nth 0 md) start) + (setf (nth 1 md) (point)) + (set-match-data md) + t)) + (cider--anchored-search-suppressed-forms-internal repl-types limit)))))) (defun cider--anchored-search-suppressed-forms (limit) "Matcher for finding unused reader conditional expressions. - An unused reader conditional expression is an expression for a platform that does not match the CIDER connection for the buffer. Search is done with the given LIMIT." - (let ((result 'retry)) + (let ((repl-types (seq-uniq (seq-map #'cider-repl-type (cider-repls)))) + (result 'retry)) (while (and (eq result 'retry) (<= (point) limit)) (condition-case condition - (setq result (cider--anchored-search-suppressed-forms-internal limit)) + (setq result + (cider--anchored-search-suppressed-forms-internal + repl-types limit)) (invalid-read-syntax (setq result 'retry)) (wrong-type-argument @@ -506,12 +691,9 @@ with the given LIMIT." (setq result nil)) (error (setq result nil) - (display-warning - '(cider warning) - (format - (concat "Caught error during fontification while searching for forms\n" - "that are suppressed by reader-conditionals. The error was: %S.") - condition))))) + (message + "Error during fontification while searching for forms: %S" + condition)))) (if (eq result 'retry) (setq result nil)) result)) @@ -553,11 +735,11 @@ with the given LIMIT." (while plist (let ((sym (pop plist)) (meta (pop plist))) - (pcase (nrepl-dict-get meta "cider.nrepl.middleware.util.instrument/breakfunction") + (pcase (nrepl-dict-get meta "cider/instrumented") (`nil nil) - (`"#'cider.nrepl.middleware.debug/breakpoint-if-interesting" + (`"\"breakpoint-if-interesting\"" (push sym instrumented)) - (`"#'cider.nrepl.middleware.enlighten/light-form" + (`"\"light-form\"" (push sym enlightened))) ;; The ::traced keywords can be inlined by MrAnderson, so ;; we catch that case too. @@ -570,7 +752,8 @@ with the given LIMIT." (push sym deprecated)) (cond ((and do-macro (nrepl-dict-get meta "macro")) (push sym macros)) - ((and do-function (nrepl-dict-get meta "arglists")) + ((and do-function (or (nrepl-dict-get meta "fn") + (nrepl-dict-get meta "arglists"))) (push sym functions)) (do-var (push sym vars)))))))) (when (memq 'core cider-font-lock-dynamically) @@ -616,8 +799,8 @@ namespace itself." (when (and cider-font-lock-dynamically font-lock-mode) (font-lock-remove-keywords nil cider--dynamic-font-lock-keywords) - (when-let ((ns (or ns (cider-current-ns))) - (symbols (cider-resolve-ns-symbols ns))) + (when-let* ((ns (or ns (cider-current-ns))) + (symbols (cider-resolve-ns-symbols ns))) (setq-local cider--dynamic-font-lock-keywords (cider--compile-font-lock-keywords symbols (cider-resolve-ns-symbols (cider-resolve-core-ns)))) @@ -748,7 +931,8 @@ before point." (cider--parse-and-apply-locals end locals-above)))))) (defun cider--docview-as-string (sym info) - "Return a string of what would be displayed by `cider-docview-render'." + "Return a string of what would be displayed by `cider-docview-render'. +SYM and INFO is passed to `cider-docview-render'" (with-temp-buffer (cider-docview-render (current-buffer) sym info) (goto-char (point-max)) @@ -770,13 +954,14 @@ before point." "Return the help-echo string for OBJ at POS. See \(info \"(elisp) Special Properties\")" (while-no-input - (when (and (bufferp obj) (cider-connected-p) + (when (and (bufferp obj) + (cider-connected-p) cider-use-tooltips (not help-at-pt-display-when-idle)) (with-current-buffer obj (ignore-errors (save-excursion (goto-char pos) - (when-let ((sym (cider-symbol-at-point))) + (when-let* ((sym (cider-symbol-at-point))) (if (member sym (get-text-property (point) 'cider-locals)) (concat (format "`%s' is a local" sym) (when cider--debug-mode @@ -818,6 +1003,7 @@ property." cider-mode-map (if cider-mode (progn + (setq-local sesman-system 'CIDER) (cider-eldoc-setup) (make-local-variable 'completion-at-point-functions) (add-to-list 'completion-at-point-functions diff --git a/elpa/cider-20181110.1413/cider-ns.el b/elpa/cider-20181110.1413/cider-ns.el new file mode 100644 index 00000000..bcb843ee --- /dev/null +++ b/elpa/cider-20181110.1413/cider-ns.el @@ -0,0 +1,265 @@ +;;; cider-ns.el --- Namespace manipulation functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Smart code refresh functionality based on ideas from: +;; http://thinkrelevance.com/blog/2013/06/04/clojure-workflow-reloaded +;; +;; Note that refresh with clojure.tools.namespace.repl is a smarter way to +;; reload code: the traditional way to reload Clojure code without restarting +;; the JVM is (require ... :reload) or an editor/IDE feature that does the same +;; thing. +;; +;; This has several problems: +;; +;; If you modify two namespaces which depend on each other, you must remember to +;; reload them in the correct order to avoid compilation errors. +;; +;; If you remove definitions from a source file and then reload it, those +;; definitions are still available in memory. If other code depends on those +;; definitions, it will continue to work but will break the next time you +;; restart the JVM. +;; +;; If the reloaded namespace contains defmulti, you must also reload all of the +;; associated defmethod expressions. +;; +;; If the reloaded namespace contains defprotocol, you must also reload any +;; records or types implementing that protocol and replace any existing +;; instances of those records/types with new instances. +;; +;; If the reloaded namespace contains macros, you must also reload any +;; namespaces which use those macros. +;; +;; If the running program contains functions which close over values in the +;; reloaded namespace, those closed-over values are not updated (This is common +;; in web applications which construct the "handler stack" as a composition of +;; functions.) + +;;; Code: + +(require 'subr-x) + +(require 'cider-client) +(require 'cider-popup) +(require 'cider-stacktrace) + +(define-obsolete-variable-alias 'cider-save-files-on-cider-ns-refresh 'cider-ns-save-files-on-refresh "0.18") +(defcustom cider-ns-save-files-on-refresh 'prompt + "Controls whether to prompt to save Clojure files on `cider-ns-refresh'. +If nil, files are not saved. +If 'prompt, the user is prompted to save files if they have been modified. +If t, save the files without confirmation." + :type '(choice (const prompt :tag "Prompt to save files if they have been modified") + (const nil :tag "Don't save the files") + (const t :tag "Save the files without confirmation")) + :group 'cider + :package-version '(cider . "0.15.0")) + +(defconst cider-ns-refresh-log-buffer "*cider-ns-refresh-log*") + +(define-obsolete-variable-alias 'cider-refresh-show-log-buffer 'cider-ns-refresh-show-log-buffer "0.18") +(defcustom cider-ns-refresh-show-log-buffer nil + "Controls when to display the refresh log buffer. +If non-nil, the log buffer will be displayed every time `cider-ns-refresh' is +called. If nil, the log buffer will still be written to, but will never be +displayed automatically. Instead, the most relevant information will be +displayed in the echo area." + :type '(choice (const :tag "always" t) + (const :tag "never" nil)) + :group 'cider + :package-version '(cider . "0.10.0")) + +(define-obsolete-variable-alias 'cider-refresh-before-fn 'cider-ns-refresh-before-fn "0.18") +(defcustom cider-ns-refresh-before-fn nil + "Clojure function for `cider-ns-refresh' to call before reloading. +If nil, nothing will be invoked before reloading. Must be a +namespace-qualified function of zero arity. Any thrown exception will +prevent reloading from occurring." + :type 'string + :group 'cider + :package-version '(cider . "0.10.0")) + +(define-obsolete-variable-alias 'cider-refresh-after-fn 'cider-ns-refresh-after-fn "0.18") +(defcustom cider-ns-refresh-after-fn nil + "Clojure function for `cider-ns-refresh' to call after reloading. +If nil, nothing will be invoked after reloading. Must be a +namespace-qualified function of zero arity." + :type 'string + :group 'cider + :package-version '(cider . "0.10.0")) + +(defun cider-ns-refresh--handle-response (response log-buffer) + "Refresh LOG-BUFFER with RESPONSE." + (nrepl-dbind-response response (out err reloading status error error-ns after before) + (cl-flet* ((log (message &optional face) + (cider-emit-into-popup-buffer log-buffer message face t)) + + (log-echo (message &optional face) + (log message face) + (unless cider-ns-refresh-show-log-buffer + (let ((message-truncate-lines t)) + (message "cider-ns-refresh: %s" message))))) + (cond + (out + (log out)) + + (err + (log err 'font-lock-warning-face)) + + ((member "invoking-before" status) + (log-echo (format "Calling %s\n" before) 'font-lock-string-face)) + + ((member "invoked-before" status) + (log-echo (format "Successfully called %s\n" before) 'font-lock-string-face)) + + ((member "invoked-not-resolved" status) + (log-echo "Could not resolve refresh function\n" 'font-lock-string-face)) + + (reloading + (log-echo (format "Reloading %s\n" reloading) 'font-lock-string-face)) + + ((member "reloading" (nrepl-dict-keys response)) + (log-echo "Nothing to reload\n" 'font-lock-string-face)) + + ((member "ok" status) + (log-echo "Reloading successful\n" 'font-lock-string-face)) + + (error-ns + (log-echo (format "Error reloading %s\n" error-ns) 'font-lock-warning-face)) + + ((member "invoking-after" status) + (log-echo (format "Calling %s\n" after) 'font-lock-string-face)) + + ((member "invoked-after" status) + (log-echo (format "Successfully called %s\n" after) 'font-lock-string-face)))) + + (with-selected-window (or (get-buffer-window cider-ns-refresh-log-buffer) + (selected-window)) + (with-current-buffer cider-ns-refresh-log-buffer + (goto-char (point-max)))) + + (when (member "error" status) + (cider--render-stacktrace-causes error)))) + +(defun cider-ns-refresh--save-project-buffers () + "Ensure modified project buffers are saved before certain operations. +Its behavior is controlled by `cider-save-files-on-cider-ns-refresh'." + (when-let* ((project-root (clojure-project-dir))) + (when cider-save-files-on-cider-ns-refresh + (save-some-buffers + (eq cider-save-files-on-cider-ns-refresh t) + (lambda () + (and + (derived-mode-p 'clojure-mode) + (string-prefix-p project-root + (file-truename default-directory) + (eq system-type 'windows-nt)))))))) + +;;;###autoload +(defun cider-ns-reload (&optional prompt) + "Send a (require 'ns :reload) to the REPL. + +With an argument PROMPT, it prompts for a namespace name. This is the +Clojure out of the box reloading experience and does not rely on +org.clojure/tools.namespace. See Commentary of this file for a longer list +of differences. From the Clojure doc: \":reload forces loading of all the +identified libs even if they are already loaded\"." + (interactive "P") + (let ((ns (if prompt + (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns))) + (clojure-find-ns)))) + (cider-interactive-eval (format "(require '%s :reload)" ns)))) + +;;;###autoload +(defun cider-ns-reload-all (&optional prompt) + "Send a (require 'ns :reload-all) to the REPL. + +With an argument PROMPT, it prompts for a namespace name. This is the +Clojure out of the box reloading experience and does not rely on +org.clojure/tools.namespace. See Commentary of this file for a longer list +of differences. From the Clojure doc: \":reload-all implies :reload and +also forces loading of all libs that the identified libs directly or +indirectly load via require\"." + (interactive "P") + (let ((ns (if prompt + (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns))) + (clojure-find-ns)))) + (cider-interactive-eval (format "(require '%s :reload-all)" ns)))) + +;;;###autoload +(defun cider-ns-refresh (&optional mode) + "Reload modified and unloaded namespaces on the classpath. + +With a single prefix argument, or if MODE is `refresh-all', reload all +namespaces on the classpath unconditionally. + +With a double prefix argument, or if MODE is `clear', clear the state of +the namespace tracker before reloading. This is useful for recovering from +some classes of error (for example, those caused by circular dependencies) +that a normal reload would not otherwise recover from. The trade-off of +clearing is that stale code from any deleted files may not be completely +unloaded. + +With a negative prefix argument, or if MODE is `inhibit-fns', prevent any +refresh functions (defined in `cider-ns-refresh-before-fn' and +`cider-ns-refresh-after-fn') from being invoked." + (interactive "p") + (cider-ensure-connected) + (cider-ensure-op-supported "refresh") + (cider-ns-refresh--save-project-buffers) + (let ((clear? (member mode '(clear 16))) + (refresh-all? (member mode '(refresh-all 4))) + (inhibit-refresh-fns (member mode '(inhibit-fns -1)))) + (cider-map-repls :clj + (lambda (conn) + ;; Inside the lambda, so the buffer is not created if we error out. + (let ((log-buffer (or (get-buffer cider-ns-refresh-log-buffer) + (cider-make-popup-buffer cider-ns-refresh-log-buffer)))) + (when cider-ns-refresh-show-log-buffer + (cider-popup-buffer-display log-buffer)) + (when inhibit-refresh-fns + (cider-emit-into-popup-buffer log-buffer + "inhibiting refresh functions\n" + nil + t)) + (when clear? + (cider-nrepl-send-sync-request '("op" "refresh-clear") conn)) + (cider-nrepl-send-request + (nconc `("op" ,(if refresh-all? "refresh-all" "refresh") + "print-length" ,cider-stacktrace-print-length + "print-level" ,cider-stacktrace-print-level) + (when (cider--pprint-fn) + `("pprint-fn" ,(cider--pprint-fn))) + (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn) + `("before" ,cider-ns-refresh-before-fn)) + (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn) + `("after" ,cider-ns-refresh-after-fn))) + (lambda (response) + (cider-ns-refresh--handle-response response log-buffer)) + conn)))))) + +;;;###autoload +(define-obsolete-function-alias 'cider-refresh 'cider-ns-refresh "0.18") + +(provide 'cider-ns) +;;; cider-ns.el ends here diff --git a/elpa/cider-20170129.1941/cider-overlays.el b/elpa/cider-20181110.1413/cider-overlays.el similarity index 95% rename from elpa/cider-20170129.1941/cider-overlays.el rename to elpa/cider-20181110.1413/cider-overlays.el index 627785a7..1a92b35f 100644 --- a/elpa/cider-20170129.1941/cider-overlays.el +++ b/elpa/cider-20181110.1413/cider-overlays.el @@ -1,6 +1,6 @@ ;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*- -;; Copyright © 2015-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; Author: Artur Malabarba @@ -133,7 +133,8 @@ This function also removes itself from `post-command-hook'." "Whether to display evaluation indicators on the left fringe." :safe #'booleanp :group 'cider - :type 'boolean) + :type 'boolean + :package-version '(cider . "0.13.0")) (defun cider--make-fringe-overlay (&optional end) "Place an eval indicator at the fringe before a sexp. @@ -152,9 +153,9 @@ END is the position where the sexp ends, and defaults to point." 'before-string cider--fringe-overlay-good))))) (cl-defun cider--make-result-overlay (value &rest props &key where duration (type 'result) - (format (concat " " cider-eval-result-prefix "%s ")) - (prepend-face 'cider-result-overlay-face) - &allow-other-keys) + (format (concat " " cider-eval-result-prefix "%s ")) + (prepend-face 'cider-result-overlay-face) + &allow-other-keys) "Place an overlay displaying VALUE at the end of line. VALUE is used as the overlay's after-string property, meaning it is displayed at the end of the overlay. The overlay itself is placed from @@ -238,11 +239,9 @@ overlay." #'cider--remove-result-overlay-after-command nil 'local) (cider--remove-result-overlay-after-command)))) - (when-let ((win (get-buffer-window buffer))) + (when-let* ((win (get-buffer-window buffer))) ;; Left edge is visible. - (when (and (<= (window-start win) (point)) - ;; In 24.3 `<=' is still a binary perdicate. - (<= (point) (window-end win)) + (when (and (<= (window-start win) (point) (window-end win)) ;; Right edge is visible. This is a little conservative ;; if the overlay contains line breaks. (or (< (+ (current-column) (string-width value)) diff --git a/elpa/cider-20181110.1413/cider-pkg.el b/elpa/cider-20181110.1413/cider-pkg.el new file mode 100644 index 00000000..0e91f236 --- /dev/null +++ b/elpa/cider-20181110.1413/cider-pkg.el @@ -0,0 +1,23 @@ +(define-package "cider" "20181110.1413" "Clojure Interactive Development Environment that Rocks" + '((emacs "25") + (clojure-mode "5.9") + (pkg-info "0.4") + (queue "0.2") + (spinner "1.7") + (seq "2.16") + (sesman "0.3.2")) + :keywords + '("languages" "clojure" "cider") + :authors + '(("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")) + :maintainer + '("Bozhidar Batsov" . "bozhidar@batsov.com") + :url "http://www.github.com/clojure-emacs/cider") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/cider-20170129.1941/cider-popup.el b/elpa/cider-20181110.1413/cider-popup.el similarity index 89% rename from elpa/cider-20170129.1941/cider-popup.el rename to elpa/cider-20181110.1413/cider-popup.el index c0069bd1..274a0666 100644 --- a/elpa/cider-20170129.1941/cider-popup.el +++ b/elpa/cider-20181110.1413/cider-popup.el @@ -1,6 +1,6 @@ ;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- -;; Copyright © 2015-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; Author: Artur Malabarba @@ -81,7 +81,9 @@ If prefix argument KILL is non-nil, kill the buffer instead of burying it." (defvar-local cider-popup-output-marker nil) -(defvar cider-ancillary-buffers nil) +(defvar cider-ancillary-buffers nil + "A list ancillary buffers created by the various CIDER commands. +We track them mostly to be able to clean them up on quit.") (defun cider-make-popup-buffer (name &optional mode ancillary) "Create a temporary buffer called NAME using major MODE (if specified). @@ -99,12 +101,16 @@ and automatically removed when killed." (when ancillary (add-to-list 'cider-ancillary-buffers name) (add-hook 'kill-buffer-hook - (lambda () (setq cider-ancillary-buffers (remove name cider-ancillary-buffers))) + (lambda () + (setq cider-ancillary-buffers + (remove name cider-ancillary-buffers))) nil 'local)) (current-buffer))) -(defun cider-emit-into-popup-buffer (buffer value &optional face) - "Emit into BUFFER the provided VALUE optionally using FACE." +(defun cider-emit-into-popup-buffer (buffer value &optional face inhibit-indent) + "Emit into BUFFER the provided VALUE optionally using FACE. +Indent emitted value (usually a sexp) unless INHIBIT-INDENT is specified +and non-nil." ;; Long string output renders Emacs unresponsive and users might intentionally ;; kill the frozen popup buffer. Therefore, we don't re-create the buffer and ;; silently ignore the output. @@ -121,7 +127,8 @@ and automatically removed when killed." (add-face-text-property 0 (length value-str) face nil value-str) (add-text-properties 0 (length value-str) (list 'face face) value-str))) (insert value-str)) - (indent-sexp) + (unless inhibit-indent + (indent-sexp)) (set-marker cider-popup-output-marker (point))) (when moving (goto-char cider-popup-output-marker)))))) diff --git a/elpa/cider-20181110.1413/cider-profile.el b/elpa/cider-20181110.1413/cider-profile.el new file mode 100644 index 00000000..79577910 --- /dev/null +++ b/elpa/cider-20181110.1413/cider-profile.el @@ -0,0 +1,208 @@ +;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*- + +;; Copyright © 2014-2018 Edwin Watkeys and CIDER contributors + +;; Author: Edwin Watkeys +;; Juan E. Maya + +;; 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 . + +;;; Commentary: + +;; Provides coarse-grained interactive profiling support. +;; Based on earlier work by Edwin Watkeys (https://github.com/thunknyc/nrepl-profile). + +;;; Code: + +(require 'cider-client) +(require 'cider-popup) +(require 'cider-eval) + +(defconst cider-profile-buffer "*cider-profile*") + +(defvar cider-profile-map + (let ((map (define-prefix-command 'cider-profile-map))) + (define-key map (kbd "t") #'cider-profile-toggle) + (define-key map (kbd "c") #'cider-profile-clear) + (define-key map (kbd "S") #'cider-profile-summary) + (define-key map (kbd "s") #'cider-profile-var-summary) + (define-key map (kbd "n") #'cider-profile-ns-toggle) + (define-key map (kbd "v") #'cider-profile-var-profiled-p) + (define-key map (kbd "+") #'cider-profile-samples) + map) + "CIDER profiler keymap.") + +(defconst cider-profile-menu + '("Profile" + ["Toggle var profiling" cider-profile-toggle] + ["Toggle namespace profiling" cider-profile-ns-toggle] + "--" + ["Display var profiling status" cider-profile-var-profiled-p] + ["Display max sample count" cider-profile-samples] + ["Display summary" cider-profile-summary] + ["Clear data" cider-profile-clear]) + "CIDER profiling submenu.") + +(defun cider-profile--make-response-handler (handler &optional buffer) + "Make a response handler using value handler HANDLER for connection BUFFER. + +Optional argument BUFFER defaults to current buffer." + (nrepl-make-response-handler + (or buffer (current-buffer)) handler nil nil nil)) + +;;;###autoload +(defun cider-profile-samples (&optional query) + "Displays current max-sample-count. +If optional QUERY is specified, set max-sample-count and display new value." + (interactive "P") + (cider-ensure-op-supported "set-max-samples") + (cider-ensure-op-supported "get-max-samples") + (if (not (null query)) + (cider-nrepl-send-request + (let ((max-samples (if (numberp query) query '()))) + (message "query: %s" max-samples) + `("op" "set-max-samples" "max-samples" ,max-samples)) + (cider-profile--make-response-handler + (lambda (_buffer value) + (let ((value (if (zerop (length value)) "unlimited" value))) + (message "max-sample-count is now %s" value))))) + (cider-nrepl-send-request + '("op" "get-max-samples") + (cider-profile--make-response-handler + (lambda (_buffer value) + (let ((value (if (zerop (length value)) "unlimited" value))) + (message "max-sample-count is now %s" value)))))) + query) + +;;;###autoload +(defun cider-profile-var-profiled-p (query) + "Displays the profiling status of var under point. +Prompts for var if none under point or QUERY is present." + (interactive "P") + (cider-ensure-op-supported "is-var-profiled") + (cider-read-symbol-name + "Report profiling status for var: " + (lambda (sym) + (let ((ns (cider-current-ns))) + (cider-nrepl-send-request + `("op" "is-var-profiled" + "ns" ,ns + "sym" ,sym) + (cider-profile--make-response-handler + (lambda (_buffer value) + (pcase value + ("profiled" (message "Profiling is currently enabled for %s/%s" ns sym)) + ("unprofiled" (message "Profiling is currently disabled for %s/%s" ns sym)) + ("unbound" (message "%s/%s is unbound" ns sym))))))))) + query) + +;;;###autoload +(defun cider-profile-ns-toggle (&optional query) + "Toggle profiling for the ns associated with optional QUERY. + +If optional argument QUERY is non-nil, prompt for ns. Otherwise use +current ns." + (interactive "P") + (cider-ensure-op-supported "toggle-profile-ns") + (let ((ns (if query + (completing-read "Toggle profiling for ns: " + (cider-sync-request:ns-list)) + (cider-current-ns)))) + (cider-nrepl-send-request + `("op" "toggle-profile-ns" + "ns" ,ns) + (cider-profile--make-response-handler + (lambda (_buffer value) + (pcase value + ("profiled" (message "Profiling enabled for %s" ns)) + ("unprofiled" (message "Profiling disabled for %s" ns))))))) + query) + +;;;###autoload +(defun cider-profile-toggle (query) + "Toggle profiling for the given QUERY. +Defaults to the symbol at point. +With prefix arg or no symbol at point, prompts for a var." + (interactive "P") + (cider-ensure-op-supported "toggle-profile") + (cider-read-symbol-name + "Toggle profiling for var: " + (lambda (sym) + (let ((ns (cider-current-ns))) + (cider-nrepl-send-request + `("op" "toggle-profile" + "ns" ,ns + "sym" ,sym) + (cider-profile--make-response-handler + (lambda (_buffer value) + (pcase value + ("profiled" (message "Profiling enabled for %s/%s" ns sym)) + ("unprofiled" (message "Profiling disabled for %s/%s" ns sym)) + ("unbound" (message "%s/%s is unbound" ns sym))))))))) + query) + +(defun cider-profile-display-stats (stats-response) + "Displays the STATS-RESPONSE on `cider-profile-buffer`." + (let ((table (nrepl-dict-get stats-response "err"))) + (if cider-profile-buffer + (let ((buffer (cider-make-popup-buffer cider-profile-buffer))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) (insert table))) + (display-buffer buffer) + (let ((window (get-buffer-window buffer))) + (set-window-point window 0) + (select-window window) + (fit-window-to-buffer window))) + (cider-emit-interactive-eval-err-output table)))) + +;;;###autoload +(defun cider-profile-summary () + "Display a summary of currently collected profile data." + (interactive) + (cider-ensure-op-supported "profile-summary") + (cider-profile-display-stats + (cider-nrepl-send-sync-request '("op" "profile-summary")))) + +;;;###autoload +(defun cider-profile-var-summary (query) + "Display profile data for var under point QUERY. +Defaults to the symbol at point. With prefix arg or no symbol at point, +prompts for a var." + (interactive "P") + (cider-ensure-op-supported "profile-var-summary") + (cider-read-symbol-name + "Profile-summary for var: " + (lambda (sym) + (cider-profile-display-stats + (cider-nrepl-send-sync-request + `("op" "profile-var-summary" + "ns" ,(cider-current-ns) + "sym" ,sym))))) + query) + +;;;###autoload +(defun cider-profile-clear () + "Clear any collected profile data." + (interactive) + (cider-ensure-op-supported "clear-profile") + (cider-nrepl-send-request + '("op" "clear-profile") + (cider-profile--make-response-handler + (lambda (_buffer value) + (when (equal value "cleared") + (message "Cleared profile data")))))) + +(provide 'cider-profile) + +;;; cider-profile.el ends here diff --git a/elpa/cider-20170129.1941/cider-repl-history.el b/elpa/cider-20181110.1413/cider-repl-history.el similarity index 96% rename from elpa/cider-20170129.1941/cider-repl-history.el rename to elpa/cider-20181110.1413/cider-repl-history.el index 3f6242ed..f6cd4c86 100644 --- a/elpa/cider-20170129.1941/cider-repl-history.el +++ b/elpa/cider-20181110.1413/cider-repl-history.el @@ -37,7 +37,6 @@ (require 'pulse) (defconst cider-repl-history-buffer "*cider-repl-history*") -(add-to-list 'cider-ancillary-buffers cider-repl-history-buffer) (defgroup cider-repl-history nil "A package for browsing and inserting the items in the CIDER command history." @@ -70,7 +69,8 @@ If `bury-and-delete-window', then bury the buffer, and (if there is more than one window) delete the window. If `delete-and-restore', then restore the window configuration to what it was -before `cider-repl-history' was called, and kill the *cider-repl-history* buffer. +before `cider-repl-history' was called, and kill the *cider-repl-history* +buffer. If `quit-window', then restore the window configuration to what it was before `cider-repl-history' was called, and bury *cider-repl-history*. @@ -257,18 +257,14 @@ call `cider-repl-history' again.") (defun cider-repl-history-read-regexp (msg use-default-p) "Get a regular expression from the user, prompting with MSG; previous entry is default if USE-DEFAULT-P." (let* ((default (car regexp-history)) + (prompt (if (and default use-default-p) + (format "%s for regexp (default `%s'): " + msg + default) + (format "%s (regexp): " msg))) (input - (read-from-minibuffer - (if (and default use-default-p) - (format "%s for regexp (default `%s'): " - msg - default) - (format "%s (regexp): " msg)) - nil - nil - nil - 'regexp-history - (if use-default-p nil default)))) + (read-from-minibuffer prompt nil nil nil 'regexp-history + (if use-default-p nil default)))) (if (equal input "") (if use-default-p default nil) input))) @@ -391,7 +387,7 @@ case retun nil." (cider-repl-history-insert-and-highlight str)))))))) (defun cider-repl-history-insert-and-quit () - "Insert the item into the REPL buffer, and close the *cider-repl-history* buffer. + "Insert the item into the REPL buffer, and close *cider-repl-history*. The text is always inserted at the very bottom of the REPL buffer. If your cursor is already at the bottom, it is advanced to the end of the inserted @@ -401,7 +397,7 @@ text is still inserted at the end." (cider-repl-history-do-insert (current-buffer) (point))) (defun cider-repl-history-mouse-insert (e) - "Insert the item at E into the REPL buffer, and close the *cider-repl-history*. + "Insert the item at E into the REPL buffer, and close *cider-repl-history*. The text is always inserted at the very bottom of the REPL buffer. If your cursor is already at the bottom, it is advanced to the end of the inserted @@ -419,13 +415,13 @@ text is still inserted at the end." "Clear the highlighted entry, when one exists." (when cider-repl-history-previous-overlay (cl-assert (overlayp cider-repl-history-previous-overlay) - t "not an overlay") + nil "not an overlay") (overlay-put cider-repl-history-previous-overlay 'face nil))) (defun cider-repl-history-update-highlighed-entry () "Update highlighted entry, when feature is turned on." (when cider-repl-history-highlight-current-entry - (if-let ((current-overlay (cider-repl-history-target-overlay-at (point) t))) + (if-let* ((current-overlay (cider-repl-history-target-overlay-at (point) t))) (unless (equal cider-repl-history-previous-overlay current-overlay) ;; We've changed overlay. Clear current highlighting, ;; and highlight the new overlay. @@ -614,7 +610,7 @@ text from the *cider-repl-history* buffer." #'copy-sequence #'substring-no-properties) cider-command-history))) - (when (not cider-repl-history-display-duplicates) + (unless cider-repl-history-display-duplicates ;; display highest or lowest duplicate. ;; if `cider-repl-history-display-duplicate-highest' is t, ;; display highest (most recent) duplicate. @@ -675,8 +671,8 @@ text from the *cider-repl-history* buffer." (interactive) (cl-assert (eq major-mode 'cider-repl-history-mode)) (cider-repl-history-setup cider-repl-history-repl-window - cider-repl-history-repl-buffer - (current-buffer)) + cider-repl-history-repl-buffer + (current-buffer)) (cider-repl-history-resize-window)) (defun cider-repl-history-occur (regexp) @@ -686,9 +682,9 @@ text from the *cider-repl-history* buffer." "Display command history entries matching" nil))) (cl-assert (eq major-mode 'cider-repl-history-mode)) (cider-repl-history-setup cider-repl-history-repl-window - cider-repl-history-repl-buffer - (current-buffer) - regexp) + cider-repl-history-repl-buffer + (current-buffer) + regexp) (cider-repl-history-resize-window)) (put 'cider-repl-history-mode 'mode-class 'special) @@ -696,6 +692,7 @@ text from the *cider-repl-history* buffer." "Major mode for browsing the entries in the command input history. \\{cider-repl-history-mode-map}" + (setq-local sesman-system 'CIDER) (define-key cider-repl-history-mode-map (kbd "n") 'cider-repl-history-forward) (define-key cider-repl-history-mode-map (kbd "p") 'cider-repl-history-previous) (define-key cider-repl-history-mode-map (kbd "SPC") 'cider-repl-history-insert-and-quit) diff --git a/elpa/cider-20170129.1941/cider-repl.el b/elpa/cider-20181110.1413/cider-repl.el similarity index 65% rename from elpa/cider-20170129.1941/cider-repl.el rename to elpa/cider-20181110.1413/cider-repl.el index 23c778a8..261b5bbb 100644 --- a/elpa/cider-20170129.1941/cider-repl.el +++ b/elpa/cider-20181110.1413/cider-repl.el @@ -1,7 +1,7 @@ -;;; cider-repl.el --- REPL interactions -*- lexical-binding: t -*- +;;; cider-repl.el --- CIDER REPL mode interactions -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -9,6 +9,7 @@ ;; Artur Malabarba ;; Hugo Duncan ;; Steve Purcell +;; Reid McKenzie ;; 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 @@ -27,7 +28,8 @@ ;;; Commentary: -;; REPL interactions. +;; This functionality concerns `cider-repl-mode' and REPL interaction. For +;; REPL/connection life-cycle management see cider-connection.el. ;;; Code: @@ -44,6 +46,7 @@ (require 'clojure-mode) (require 'easymenu) (require 'cl-lib) +(require 'sesman) (eval-when-compile (defvar paredit-version) @@ -89,7 +92,7 @@ set to `display-only' the buffer will be displayed, but it will not become focused. Otherwise the buffer is displayed and focused." :type '(choice (const :tag "Create the buffer, but don't display it" nil) (const :tag "Create and display the buffer, but don't focus it" - display-only) + display-only) (const :tag "Create, display, and focus the buffer" t)) :group 'cider-repl) @@ -112,7 +115,7 @@ If this is set to nil, no re-centering takes place." :package-version '(cider . "0.11.0")) (defcustom cider-repl-use-pretty-printing nil - "Control whether the results in REPL are pretty-printed or not. + "Control whether results in the REPL are pretty-printed or not. The `cider-toggle-pretty-printing' command can be used to interactively change the setting's value." :type 'boolean @@ -123,10 +126,28 @@ change the setting's value." This sets the wrap point for pretty printing on the repl. If nil, it defaults to the variable `fill-column'." :type '(restricted-sexp :match-alternatives - (integerp 'nil)) + (integerp 'nil)) :group 'cider-repl :package-version '(cider . "0.15.0")) +(defcustom cider-repl-use-content-types t + "Control whether REPL results are presented using content-type information. +The `cider-repl-toggle-content-types' command can be used to interactively +change the setting's value." + :type 'boolean + :group 'cider-repl + :package-version '(cider . "0.17.0")) + +(defcustom cider-repl-auto-detect-type t + "Control whether to auto-detect the REPL type using track-state information. +If you disable this you'll have to manually change the REPL type between +Clojure and ClojureScript when invoking REPL type changing forms. +Use `cider-set-repl-type' to manually change the REPL type." + :type 'boolean + :group 'cider-repl + :safe #'booleanp + :package-version '(cider . "0.18.0")) + (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' @@ -136,7 +157,9 @@ will be used." :package-version '(cider . "0.10.0")) (defcustom cider-repl-result-prefix "" - "The prefix displayed in the REPL before a result value." + "The prefix displayed in the REPL before a result value. +By default there's no prefix, but you can specify something +like \"=>\" if want results to stand out more." :type 'string :group 'cider :package-version '(cider . "0.5.0")) @@ -149,6 +172,18 @@ you'd like to use the default Emacs behavior use :type 'symbol :group 'cider-repl) +(defcustom cider-repl-print-length 100 + "Initial value for *print-length* set during REPL start." + :type 'integer + :group 'cider + :package-version '(cider . "0.17.0")) + +(defcustom cider-repl-print-level nil + "Initial value for *print-level* set during REPL start." + :type 'integer + :group 'cider + :package-version '(cider . "0.17.0")) + (defcustom cider-repl-display-help-banner t "When non-nil a bit of help text will be displayed on REPL start." :type 'boolean @@ -199,20 +234,18 @@ Currently its only purpose is to facilitate `cider-repl-clear-buffer'.") (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'.") +This cache is stored in the connection buffer.") (defvar cider-mode) (declare-function cider-refresh-dynamic-font-lock "cider-mode") (defun cider-repl--state-handler (response) - "Handle the server state contained in RESPONSE. -Currently, this is only used to keep `cider-repl-type' updated." + "Handle server state contained in RESPONSE." (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) - (when repl-type - (setq cider-repl-type repl-type)) + (when (and repl-type cider-repl-auto-detect-type) + (cider-set-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)) @@ -220,92 +253,93 @@ Currently, this is only used to keep `cider-repl-type' updated." ;; Metadata changed, so signatures may have changed too. (setq cider-eldoc-last-symbol nil) (when (or cider-mode (derived-mode-p 'cider-repl-mode)) - (when-let ((ns-dict (or (nrepl-dict-get changed-namespaces (cider-current-ns)) - (let ((ns-dict (cider-resolve--get-in (cider-current-ns)))) - (when (seq-find (lambda (ns) (nrepl-dict-get changed-namespaces ns)) - (nrepl-dict-get ns-dict "aliases")) - ns-dict))))) + (when-let* ((ns-dict (or (nrepl-dict-get changed-namespaces (cider-current-ns)) + (let ((ns-dict (cider-resolve--get-in (cider-current-ns)))) + (when (seq-find (lambda (ns) (nrepl-dict-get changed-namespaces ns)) + (nrepl-dict-get ns-dict "aliases")) + ns-dict))))) (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))) - (declare-function cider-set-buffer-ns "cider-mode") (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)." + "Require standard REPL util functions and set the ns of the REPL's BUFFER. +Namespace is \"user\" by default, but can be overridden in apps like +lein (:init-ns). Both of these operations need to be done as a sync +request at the beginning of the session. Bundling them together for +efficiency." ;; 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"))) + (let* ((response (nrepl-send-sync-request + (lax-plist-put (nrepl--eval-request "(str *ns*)") + "inhibit-cider-middleware" "true") + (cider-current-repl))) + (initial-ns (or (read (nrepl-dict-get response "value")) + "user"))) (cider-set-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-require-repl-utils () + "Require standard REPL util functions into the current REPL." + (interactive) + (nrepl-send-sync-request + (lax-plist-put + (nrepl--eval-request + "(when (clojure.core/resolve 'clojure.main/repl-requires) + (clojure.core/map clojure.core/require clojure.main/repl-requires))") + "inhibit-cider-middleware" "true") + (cider-current-repl))) + +(defun cider-repl--build-config-expression () + "Build the initial config expression." + (when (or cider-repl-print-length cider-repl-print-level) + (concat + "(do" + (when cider-repl-print-length (format " (set! *print-length* %d)" cider-repl-print-length)) + (when cider-repl-print-level (format " (set! *print-level* %d)" cider-repl-print-level)) + ")"))) + +(defun cider-repl-set-config () + "Set an inititial REPL configuration." + (interactive) + (when-let* ((config-expression (cider-repl--build-config-expression))) + (nrepl-send-sync-request + (lax-plist-put + (nrepl--eval-request config-expression) + "inhibit-cider-middleware" "true") + (cider-current-repl)))) (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))) (pcase cider-repl-pop-to-buffer-on-connect (`display-only (display-buffer buffer)) ((pred identity) (pop-to-buffer buffer))) - (cider-remember-clojure-buffer cider-current-clojure-buffer) + (cider-repl-set-initial-ns buffer) + (cider-repl-require-repl-utils) + (cider-repl-set-config) + (unless no-banner + (cider-repl--insert-banner-and-prompt buffer)) + (with-current-buffer buffer + (set-window-point (get-buffer-window) (point-max))) buffer) +(defun cider-repl--insert-banner-and-prompt (buffer) + "Insert REPL banner and REPL prompt in BUFFER." + (with-current-buffer buffer + (insert (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face)) + (when cider-repl-display-help-banner + (insert (propertize (cider-repl--help-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))) + (defun cider-repl--banner () "Generate the welcome REPL buffer banner." - (let ((host (cider--connection-host (current-buffer))) - (port (cider--connection-port (current-buffer)))) - (format ";; Connected to nREPL server - nrepl://%s:%s + (format ";; Connected to nREPL server - nrepl://%s:%s ;; CIDER %s, nREPL %s ;; Clojure %s, Java %s ;; Docs: (doc function-name) @@ -314,12 +348,12 @@ client process connection. Unless NO-BANNER is non-nil, insert a banner." ;; Javadoc: (javadoc java-object-or-class) ;; Exit: ;; Results: Stored in vars *1, *2, *3, an exception in *e;" - host - port - (cider--version) - (cider--nrepl-version) - (cider--clojure-version) - (cider--java-version)))) + (plist-get nrepl-endpoint :host) + (plist-get nrepl-endpoint :port) + (cider--version) + (cider--nrepl-version) + (cider--clojure-version) + (cider--java-version))) (defun cider-repl--help-banner () "Generate the help banner." @@ -353,24 +387,12 @@ client process connection. Unless NO-BANNER is non-nil, insert a banner." ;; Above all else - don't panic! In case of an emergency - procure ;; some (hard) cider and enjoy it responsibly! ;; -;; You can remove this message with the `cider-repl-clear-help-banner' command. +;; You can remove this message with the command. ;; You can disable it from appearing on start by setting ;; `cider-repl-display-help-banner' to nil. ;; ====================================================================== ")) -(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)) - (when cider-repl-display-help-banner - (insert (propertize (cider-repl--help-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 @@ -550,9 +572,89 @@ When there is a possible unfinished ansi control sequence, (insert-before-markers (cadr ansi-color-context)) (setq ansi-color-context nil))) +(defvar-local cider-repl--ns-forms-plist nil + "Plist holding ns->ns-form mappings within each connection.") + +(defun cider-repl--ns-form-changed-p (ns-form connection) + "Return non-nil if NS-FORM for CONNECTION changed since last eval." + (when-let* ((ns (cider-ns-from-form ns-form))) + (not (string= ns-form + (lax-plist-get + (buffer-local-value 'cider-repl--ns-forms-plist connection) + ns))))) + +(defvar cider-repl--root-ns-highlight-template "\\_<\\(%s\\)[^$/: \t\n()]+" + "Regexp used to highlight root ns in REPL buffers.") + +(defvar-local cider-repl--root-ns-regexp nil + "Cache of root ns regexp in REPLs.") + +(defvar-local cider-repl--ns-roots nil + "List holding all past root namespaces seen during interactive eval.") + +(defun cider-repl--cache-ns-form (ns-form connection) + "Given NS-FORM cache root ns in CONNECTION." + (with-current-buffer connection + (when-let* ((ns (cider-ns-from-form ns-form))) + ;; cache ns-form + (setq cider-repl--ns-forms-plist + (lax-plist-put cider-repl--ns-forms-plist ns ns-form)) + ;; cache ns roots regexp + (when (string-match "\\([^.]+\\)" ns) + (let ((root (match-string-no-properties 1 ns))) + (unless (member root cider-repl--ns-roots) + (push root cider-repl--ns-roots) + (let ((roots (mapconcat + ;; Replace _ or - with regexp pattern to accommodate "raw" namespaces + (lambda (r) (replace-regexp-in-string "[_-]+" "[_-]+" r)) + cider-repl--ns-roots "\\|"))) + (setq cider-repl--root-ns-regexp + (format cider-repl--root-ns-highlight-template roots))))))))) + +(defvar cider-repl-spec-keywords-regexp + (concat + (regexp-opt '("In:" " val:" + " at:" "fails at:" + " spec:" "fails spec:" + " predicate:" "fails predicate:")) + "\\|^" + (regexp-opt '(":clojure.spec.alpha/spec" + ":clojure.spec.alpha/value") + "\\(")) + "Regexp matching clojure.spec `explain` keywords.") + +(defun cider-repl-highlight-spec-keywords (string) + "Highlight clojure.spec `explain` keywords in STRING. +Foreground of `clojure-keyword-face' is used for highlight." + (cider-add-face cider-repl-spec-keywords-regexp + 'clojure-keyword-face t nil string) + string) + +(defun cider-repl-highlight-current-project (string) + "Fontify project's root namespace to make stacktraces more readable. +Foreground of `cider-stacktrace-ns-face' is used to propertize matched +namespaces. STRING is REPL's output." + (cider-add-face cider-repl--root-ns-regexp 'cider-stacktrace-ns-face + t nil string) + string) + +(defun cider-repl-add-locref-help-echo (string) + "Set help-echo property of STRING to `cider-locref-help-echo'." + (put-text-property 0 (length string) 'help-echo 'cider-locref-help-echo string) + string) + +(defvar cider-repl-preoutput-hook '(ansi-color-apply + cider-repl-highlight-current-project + cider-repl-highlight-spec-keywords + cider-repl-add-locref-help-echo) + "Hook run on output string before it is inserted into the REPL buffer. +Each functions takes a string and must return a modified string. Also see +`cider-run-chained-hook'.") + (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." +If BOL is non-nil insert at the beginning of line. Run +`cider-repl-preoutput-hook' on STRING." (with-current-buffer buffer (save-excursion (cider-save-marker cider-repl-output-start @@ -560,10 +662,11 @@ If BOL is non-nil insert at the beginning of line." (goto-char position) ;; TODO: Review the need for bol (when (and bol (not (bolp))) (insert-before-markers "\n")) - (insert-before-markers - (ansi-color-apply (propertize string - 'font-lock-face output-face - 'rear-nonsticky '(font-lock-face)))) + (setq string (propertize string + 'font-lock-face output-face + 'rear-nonsticky '(font-lock-face))) + (setq string (cider-run-chained-hook 'cider-repl-preoutput-hook string)) + (insert-before-markers string) (cider-repl--flush-ansi-color-context) (when (and (= (point) cider-repl-prompt-start-mark) (not (bolp))) @@ -573,7 +676,7 @@ If BOL is non-nil insert at the beginning of line." (defun cider-repl--emit-interactive-output (string face) "Emit STRING as interactive output using FACE." - (with-current-buffer (cider-current-repl-buffer) + (with-current-buffer (cider-current-repl) (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)))) @@ -586,16 +689,6 @@ If BOL is non-nil insert at the beginning of line." "Emit STRING as interactive err output." (cider-repl--emit-interactive-output string 'cider-repl-stderr-face)) -(defun cider-repl-manual-warning (section-id format &rest args) - "Emit a warning to the REPL and link to the online manual. -SECTION-ID is the section to link to. The link is added on the last line. -FORMAT is a format string to compile with ARGS and display on the REPL." - (let ((message (apply #'format format args))) - (cider-repl-emit-interactive-stderr - (concat "WARNING: " message "\n " - (cider--manual-button "More information" section-id) - ".")))) - (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." @@ -619,9 +712,10 @@ If BOL is non-nil, emit at the beginning of the line." (cider-repl--insert-prompt cider-buffer-ns)))) (cider-repl--show-maximum-output))) -(defun cider-repl-emit-result (buffer string &optional bol) +(defun cider-repl-emit-result (buffer string show-prefix &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." +If SHOW-PREFIX is non-nil insert `cider-repl-result-prefix' at the beginning +of the line. 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 @@ -629,7 +723,8 @@ If BOL is non-nil insert at the beginning of the line." (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)) + (when show-prefix + (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 @@ -684,57 +779,169 @@ the symbol." t))) (t t)))) +(defun cider-repl--display-image (buffer image &optional show-prefix bol string) + "Insert IMAGE into BUFFER at the current point. + +For compatibility with the rest of CIDER's REPL machinery, supports +SHOW-PREFIX and BOL." + (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")) + (when show-prefix + (insert-before-markers + (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) + (insert-image image string) + (set-marker cider-repl-input-start-mark (point) buffer) + (set-marker cider-repl-prompt-start-mark (point) buffer)))) + (cider-repl--show-maximum-output)) + t) + +(defcustom cider-repl-image-margin 10 + "Specifies the margin to be applied to images displayed in the REPL. +Either a single number of pixels - interpreted as a symmetric margin, or +pair of numbers `(x . y)' encoding an arbitrary margin." + :type '(choice integer (vector integer integer)) + :group 'cider-repl + :package-version '(cider . "0.17.0")) + +(defun cider-repl--image (data type datap) + "A helper for creating images with CIDER's image options. +DATA is either the path to an image or its base64 coded data. TYPE is a +symbol indicating the image type. DATAP indicates whether the image is the +raw image data or a filename. Returns an image instance with a margin per +`cider-repl-image-margin'." + (create-image data type datap + :margin cider-repl-image-margin)) + +(defun cider-repl-handle-jpeg (_type buffer image &optional show-prefix bol) + "A handler for inserting a jpeg IMAGE into a repl BUFFER. +Part of the default `cider-repl-content-type-handler-alist'." + (cider-repl--display-image buffer + (cider-repl--image image 'jpeg t) + show-prefix bol " ")) + +(defun cider-repl-handle-png (_type buffer image &optional show-prefix bol) + "A handler for inserting a png IMAGE into a repl BUFFER. +Part of the default `cider-repl-content-type-handler-alist'." + (cider-repl--display-image buffer + (cider-repl--image image 'png t) + show-prefix bol " ")) + +(defun cider-repl-handle-external-body (type buffer _ &optional _show-prefix _bol) + "Handler for slurping external content into BUFFER. +Handles an external-body TYPE by issuing a slurp request to fetch the content." + (if-let* ((args (cadr type)) + (access-type (nrepl-dict-get args "access-type"))) + (nrepl-send-request + (list "op" "slurp" "url" (nrepl-dict-get args access-type)) + (cider-repl-handler buffer) + (cider-current-repl))) + nil) + +(defvar cider-repl-content-type-handler-alist + `(("message/external-body" . ,#'cider-repl-handle-external-body) + ("image/jpeg" . ,#'cider-repl-handle-jpeg) + ("image/png" . ,#'cider-repl-handle-png)) + "Association list from content-types to handlers. +Handlers must be functions of two required and two optional arguments - the +REPL buffer to insert into, the value of the given content type as a raw +string, the REPL's show prefix as any and an `end-of-line' flag. + +The return value of the handler should be a flag, indicating whether or not +the REPL is ready for a prompt to be displayed. Most handlers should return +t, as the content-type response is (currently) an alternative to the +value response. However for handlers which themselves issue subsequent +nREPL ops, it may be convenient to prevent inserting a prompt.") + (defun cider-repl-handler (buffer) "Make an nREPL evaluation handler for the REPL BUFFER." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (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)) - nrepl-err-handler - (lambda (buffer pprint-out) - (cider-repl-emit-result buffer pprint-out nil)))) + (let (after-first-result-chunk + (show-prompt t)) + (nrepl-make-response-handler + buffer + (lambda (buffer value) + (cider-repl-emit-result buffer value (not after-first-result-chunk) t) + (setq after-first-result-chunk t)) + (lambda (buffer out) + (cider-repl-emit-stdout buffer out)) + (lambda (buffer err) + (cider-repl-emit-stderr buffer err)) + (lambda (buffer) + (when show-prompt + (cider-repl-emit-prompt buffer) + (let ((win (get-buffer-window (current-buffer) t))) + (when win + (with-selected-window win + (set-window-point win cider-repl-input-start-mark)) + (cider-repl--show-maximum-output))))) + nrepl-err-handler + (lambda (buffer pprint-out) + (cider-repl-emit-result buffer pprint-out (not after-first-result-chunk)) + (setq after-first-result-chunk t)) + (lambda (buffer value content-type) + (if-let* ((content-attrs (cadr content-type)) + (content-type* (car content-type)) + (handler (cdr (assoc content-type* + cider-repl-content-type-handler-alist)))) + (setq after-first-result-chunk t + show-prompt (funcall handler content-type buffer value + (not after-first-result-chunk) t)) + (progn (cider-repl-emit-result buffer value (not after-first-result-chunk) t) + (setq after-first-result-chunk t))))))) + +(defun cider--repl-request-plist (right-margin &optional pprint-fn) + "Plist to be appended to generic eval requests, as for the REPL. +PPRINT-FN and RIGHT-MARGIN are as in `cider--nrepl-pprint-request-plist'." + (nconc (when cider-repl-use-pretty-printing + (cider--nrepl-pprint-request-plist right-margin pprint-fn)) + (when cider-repl-use-content-types + (cider--nrepl-content-type-plist)))) (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)) - (input-start (save-excursion (cider-repl-beginning-of-defun) (point)))) - (goto-char (point-max)) - (cider-repl--mark-input-start) - (cider-repl--mark-output-start) - (cider-nrepl-request:eval - input - (cider-repl-handler (current-buffer)) - (cider-current-ns) - (line-number-at-pos input-start) - (cider-column-number-at-pos input-start) - (unless (or (not cider-repl-use-pretty-printing) - (string-match-p "\\`[ \t\r\n]*\\'" input)) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width)))))) + (let ((input (cider-repl--current-input))) + (if (string-blank-p input) + ;; don't evaluate a blank string, but erase it and emit + ;; a fresh prompt to acknowledge to the user. + (progn + (cider-repl--replace-input "") + (cider-repl-emit-prompt (current-buffer))) + ;; otherwise evaluate the input + (goto-char (point-max)) + (let ((end (point))) ; end of input, without the newline + (cider-repl--add-to-input-history input) + (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-start (save-excursion (cider-repl-beginning-of-defun) (point)))) + (goto-char (point-max)) + (cider-repl--mark-input-start) + (cider-repl--mark-output-start) + (cider-nrepl-request:eval + input + (cider-repl-handler (current-buffer)) + (cider-current-ns) + (line-number-at-pos input-start) + (cider-column-number-at-pos input-start) + (cider--repl-request-plist (cider--pretty-print-width))))))) (defun cider-repl-return (&optional end-of-input) "Evaluate the current input string, or insert a newline. @@ -805,17 +1012,28 @@ text property `cider-old-input'." (if cider-repl-use-pretty-printing "enabled" "disabled"))) (defun cider--pretty-print-width () - "Returns the width to use for pretty-printing." + "Return the width to use for pretty-printing." (or cider-repl-pretty-print-width fill-column 80)) +(defun cider-repl-toggle-content-types () + "Toggle content-type rendering in the REPL." + (interactive) + (setq cider-repl-use-content-types (not cider-repl-use-content-types)) + (message "Content-type support in REPL %s." + (if cider-repl-use-content-types "enabled" "disabled"))) + (defun cider-repl-switch-to-other () "Switch between the Clojure and ClojureScript REPLs for the current project." (interactive) - (if-let (other-connection (cider-other-connection)) - (switch-to-buffer other-connection) - (message "There's no other REPL for the current project"))) + ;; FIXME: implement cycling as session can hold more than two REPLs + (let* ((this-repl (cider-current-repl nil 'ensure)) + (other-repl (car (seq-remove (lambda (r) (eq r this-repl)) (cider-repls nil t))))) + (if other-repl + (switch-to-buffer other-repl) + (user-error "No other REPL in current session (%s)" + (car (sesman-current-session 'CIDER)))))) (defvar cider-repl-clear-buffer-hook) @@ -825,7 +1043,9 @@ text property `cider-old-input'." (delete-region start end)) (defun cider-repl-clear-buffer () - "Delete the output generated by the Clojure process." + "Clear the currently visited REPL buffer completely. +See also the related commands `cider-repl-clear-output' and +`cider-find-and-clear-repl-output'." (interactive) (let ((inhibit-read-only t)) (cider-repl--clear-region (point-min) cider-repl-prompt-start-mark) @@ -910,12 +1130,9 @@ With a prefix argument CLEAR-REPL it will clear the entire REPL buffer instead." (defun cider-repl-set-ns (ns) "Switch the namespace of the REPL buffer to NS. - -If called from a cljc or cljx buffer act on both the Clojure and -ClojureScript REPL if there are more than one REPL present. - -If invoked in a REPL buffer the command will prompt for the name of the -namespace to switch to." +If called from a cljc buffer act on both the Clojure and ClojureScript REPL +if there are more than one REPL present. If invoked in a REPL buffer the +command will prompt 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: " @@ -923,14 +1140,116 @@ namespace to switch to." (cider-current-ns)))) (when (or (not ns) (equal ns "")) (user-error "No namespace selected")) - (cider-map-connections - (lambda (connection) - (cider-nrepl-request:eval (format "(in-ns '%s)" ns) - (cider-repl-switch-ns-handler connection))) - :both)) + (cider-map-repls :auto + (lambda (connection) + (cider-nrepl-request:eval (format "(in-ns '%s)" ns) + (cider-repl-switch-ns-handler connection))))) -;;;;; History +;;; Location References + +(defcustom cider-locref-regexp-alist + '((stdout-stacktrace "[ \t]\\(at \\([^$(]+\\).*(\\([^:()]+\\):\\([0-9]+\\))\\)" 1 2 3 4) + (aviso-stacktrace "^[ \t]*\\(\\([^$/ \t]+\\).*? +\\([^:]+\\): +\\([0-9]+\\)\\)" 1 2 3 4) + (print-stacktrace "\\[\\([^][$ \t]+\\).* +\\([^ \t]+\\) +\\([0-9]+\\)\\]" 0 1 2 3) + (timbre-log "\\(TRACE\\|INFO\\|DEBUG\\|WARN\\|ERROR\\) +\\(\\[\\([^:]+\\):\\([0-9]+\\)\\]\\)" 2 3 nil 4) + (cljs-message "at line \\([0-9]+\\) +\\(.*\\)$" 0 nil 2 1) + (reflection "Reflection warning, +\\(\\([^\n:]+\\):\\([0-9]+\\):[0-9]+\\)" 1 nil 2 3)) + "Alist holding regular expressions for inline location references. +Each element in the alist has the form (NAME REGEXP HIGHLIGHT VAR FILE +LINE), where NAME is the identifier of the regexp, REGEXP - regexp matching +a location, HIGHLIGHT - sub-expression matching region to highlight on +mouse-over, VAR - sub-expression giving Clojure VAR to look up. FILE is +currently only used when VAR is nil and must be full resource path in that +case." + :type '(alist :key-type sexp) + :group 'cider-repl + :package-version '(cider. "0.16.0")) + +(defun cider--locref-at-point-1 (reg-list &optional pos) + "Workhorse for getting locref at POS. +REG-LIST is an entry in `cider-locref-regexp-alist'." + (save-excursion + (let ((pos (or pos (point)))) + (goto-char pos) + (beginning-of-line) + (when (re-search-forward (nth 1 reg-list) (point-at-eol) t) + (let ((ix-highlight (or (nth 2 reg-list) 0)) + (ix-var (nth 3 reg-list)) + (ix-file (nth 4 reg-list)) + (ix-line (nth 5 reg-list))) + (list + :type (car reg-list) + :highlight (cons (match-beginning ix-highlight) (match-end ix-highlight)) + :var (and ix-var + (replace-regexp-in-string "_" "-" + (match-string-no-properties ix-var) + nil t)) + :file (and ix-file (match-string-no-properties ix-file)) + :line (and ix-line (string-to-number (match-string-no-properties ix-line))))))))) + +(defun cider-locref-at-point (&optional pos) + "Return a plist of components of the location reference at POS. +Limit search to current line only and return nil if no location has been +found. Returned keys are :type, :highlight, :var, :file, :line, where +:highlight is a cons of positions, :var and :file are strings or nil, :line +is a number. See `cider-locref-regexp-alist' for how to specify regexes +for locref look up." + (seq-some (lambda (rl) (cider--locref-at-point-1 rl pos)) + cider-locref-regexp-alist)) + +(defun cider-jump-to-locref-at-point (&optional pos) + "Identify location reference at POS and navigate to it. +This function is used from help-echo property inside REPL buffers and uses +regexes from `cider-locref-regexp-alist' to infer locations at point." + (interactive) + (if-let* ((loc (cider-locref-at-point pos))) + (let* ((var (plist-get loc :var)) + (line (plist-get loc :line)) + (file (or + ;; retrieve from info middleware + (when var + (or (cider-sync-request:ns-path var) + (nrepl-dict-get (cider-sync-request:info var) "file"))) + ;; when not found, return the file detected by regexp + (when-let* ((file (plist-get loc :file))) + (if (file-name-absolute-p file) + file + ;; when not absolute, expand within the current project + (when-let* ((proj (clojure-project-dir))) + (expand-file-name file proj))))))) + (if file + (cider--jump-to-loc-from-info (nrepl-dict "file" file "line" line) t) + (error "No source location for %s" var))) + (user-error "No location reference at point"))) + +(defvar cider-locref-hoover-overlay + (let ((o (make-overlay 1 1))) + (overlay-put o 'category 'cider-error-hoover) + ;; (overlay-put o 'face 'highlight) + (overlay-put o 'pointer 'hand) + (overlay-put o 'mouse-face 'highlight) + (overlay-put o 'follow-link 'mouse) + (overlay-put o 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [return] 'cider-jump-to-locref-at-point) + (define-key map [mouse-2] 'cider-jump-to-locref-at-point) + map)) + o) + "Overlay used during hoovering on location references in REPL buffers. +One for all REPLs.") + +(defun cider-locref-help-echo (_win buffer pos) + "Function for help-echo property in REPL buffers. +WIN, BUFFER and POS are the window, buffer and point under mouse position." + (with-current-buffer buffer + (if-let* ((hl (plist-get (cider-locref-at-point pos) :highlight))) + (move-overlay cider-locref-hoover-overlay (car hl) (cdr hl)) + (delete-overlay cider-locref-hoover-overlay)) + nil)) + + +;;; History (defcustom cider-repl-wrap-history nil "T to wrap history around when the end is reached." @@ -1069,13 +1388,13 @@ If USE-CURRENT-INPUT is non-nil, use the current input." (defcustom cider-repl-history-size 500 "The maximum number of items to keep in the REPL history." :type 'integer - :safe 'integerp + :safe #'integerp :group 'cider-repl) (defcustom cider-repl-history-file nil "File to save the persistent REPL history to." :type 'string - :safe 'stringp + :safe #'stringp :group 'cider-repl) (defun cider-repl--history-read-filename () @@ -1162,41 +1481,45 @@ constructs." "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") -(declare-function cider-toggle-trace-ns "cider-interaction") -(declare-function cider-undef "cider-interaction") +(declare-function cider-toggle-trace-ns "cider-tracing") +(declare-function cider-undef "cider-mode") (declare-function cider-browse-ns "cider-browse-ns") (declare-function cider-classpath "cider-classpath") (declare-function cider-repl-history "cider-repl-history") -(declare-function cider-run "cider-interaction") -(declare-function cider-refresh "cider-interaction") +(declare-function cider-run "cider-mode") +(declare-function cider-ns-refresh "cider-ns") +(declare-function cider-version "cider") +(declare-function cider-test-run-loaded-tests "cider-test") +(declare-function cider-test-run-project-tests "cider-test") (cider-repl-add-shortcut "clear-output" #'cider-repl-clear-output) (cider-repl-add-shortcut "clear" #'cider-repl-clear-buffer) (cider-repl-add-shortcut "clear-banners" #'cider-repl-clear-banners) (cider-repl-add-shortcut "clear-help-banner" #'cider-repl-clear-help-banner) (cider-repl-add-shortcut "ns" #'cider-repl-set-ns) (cider-repl-add-shortcut "toggle-pretty" #'cider-repl-toggle-pretty-printing) -(cider-repl-add-shortcut "browse-ns" (lambda () (cider-browse-ns (cider-current-ns)))) +(cider-repl-add-shortcut "browse-ns" (lambda () (interactive) (cider-browse-ns (cider-current-ns)))) (cider-repl-add-shortcut "classpath" #'cider-classpath) (cider-repl-add-shortcut "history" #'cider-repl-history) (cider-repl-add-shortcut "trace-ns" #'cider-toggle-trace-ns) (cider-repl-add-shortcut "undef" #'cider-undef) -(cider-repl-add-shortcut "refresh" #'cider-refresh) +(cider-repl-add-shortcut "refresh" #'cider-ns-refresh) (cider-repl-add-shortcut "help" #'cider-repl-shortcuts-help) (cider-repl-add-shortcut "test-ns" #'cider-test-run-ns-tests) (cider-repl-add-shortcut "test-all" #'cider-test-run-loaded-tests) (cider-repl-add-shortcut "test-project" #'cider-test-run-project-tests) +(cider-repl-add-shortcut "test-ns-with-filters" #'cider-test-run-ns-tests-with-filters) +(cider-repl-add-shortcut "test-all-with-filters" (lambda () (interactive) (cider-test-run-loaded-tests 'prompt-for-filters))) +(cider-repl-add-shortcut "test-project-with-filters" (lambda () (interactive) (cider-test-run-project-tests 'prompt-for-filters))) (cider-repl-add-shortcut "test-report" #'cider-test-show-report) (cider-repl-add-shortcut "run" #'cider-run) -(cider-repl-add-shortcut "conn-info" #'cider-display-connection-info) -(cider-repl-add-shortcut "conn-rotate" #'cider-rotate-default-connection) +(cider-repl-add-shortcut "conn-info" #'cider-describe-connection) (cider-repl-add-shortcut "hasta la vista" #'cider-quit) (cider-repl-add-shortcut "adios" #'cider-quit) (cider-repl-add-shortcut "sayonara" #'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 "require-repl-utils" #'cider-repl-require-repl-utils) (defconst cider-repl-shortcuts-help-buffer "*CIDER REPL Shortcuts Help*") @@ -1227,7 +1550,7 @@ constructs." (if (not (equal command "")) (let ((command-func (gethash command cider-repl-shortcuts))) (if command-func - (call-interactively (gethash command cider-repl-shortcuts)) + (call-interactively command-func) (error "Unknown command %S. Available commands: %s" command-func (mapconcat 'identity (cider-repl--available-shortcuts) ", ")))) @@ -1241,15 +1564,21 @@ constructs." (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-eval-last-sexp "cider-eval") +(declare-function cider-toggle-trace-ns "cider-tracing") +(declare-function cider-toggle-trace-var "cider-tracing") +(declare-function cider-find-resource "cider-find") +(declare-function cider-find-ns "cider-find") +(declare-function cider-find-keyword "cider-find") +(declare-function cider-find-var "cider-find") (declare-function cider-switch-to-last-clojure-buffer "cider-mode") +(declare-function cider-macroexpand-1 "cider-macroexpansion") +(declare-function cider-macroexpand-all "cider-macroexpansion") +(declare-function cider-selector "cider-selector") +(declare-function cider-jack-in-clj "cider") +(declare-function cider-jack-in-cljs "cider") +(declare-function cider-connect-clj "cider") +(declare-function cider-connect-cljs "cider") (defvar cider-repl-mode-map (let ((map (make-sparse-keymap))) @@ -1258,6 +1587,7 @@ constructs." (define-key map (kbd "C-c C-t") 'cider-test-commands-map) (define-key map (kbd "M-.") #'cider-find-var) (define-key map (kbd "C-c C-.") #'cider-find-ns) + (define-key map (kbd "C-c C-:") #'cider-find-keyword) (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) @@ -1281,18 +1611,26 @@ constructs." (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-s") #'sesman-map) (define-key map (kbd "C-c C-z") #'cider-switch-to-last-clojure-buffer) (define-key map (kbd "C-c M-o") #'cider-repl-switch-to-other) (define-key map (kbd "C-c M-s") #'cider-selector) - (define-key map (kbd "C-c M-d") #'cider-display-connection-info) + (define-key map (kbd "C-c M-d") #'cider-describe-connection) (define-key map (kbd "C-c C-q") #'cider-quit) + (define-key map (kbd "C-c M-r") #'cider-restart) (define-key map (kbd "C-c M-i") #'cider-inspect) (define-key map (kbd "C-c M-p") #'cider-repl-history) (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-c C-x") 'cider-start-map) (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 (kbd "C-c C-r") 'clojure-refactor-map) + (define-key map (kbd "C-c C-v") 'cider-eval-commands-map) + (define-key map (kbd "C-c M-j") #'cider-jack-in-clj) + (define-key map (kbd "C-c M-J") #'cider-jack-in-cljs) + (define-key map (kbd "C-c M-c") #'cider-connect-clj) + (define-key map (kbd "C-c M-C") #'cider-connect-cljs) + (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" @@ -1303,7 +1641,9 @@ constructs." "--" ("Find" ["Find definition" cider-find-var] + ["Find namespace" cider-find-ns] ["Find resource" cider-find-resource] + ["Find keyword" cider-find-keyword] ["Go back" cider-pop-back]) "--" ["Switch to Clojure buffer" cider-switch-to-last-clojure-buffer] @@ -1319,15 +1659,18 @@ constructs." ["Inspect" cider-inspect] ["Toggle var tracing" cider-toggle-trace-var] ["Toggle ns tracing" cider-toggle-trace-ns] - ["Refresh loaded code" cider-refresh] + ["Refresh loaded code" cider-ns-refresh] "--" ["Set REPL ns" cider-repl-set-ns] ["Toggle pretty printing" cider-repl-toggle-pretty-printing] + ["Require REPL utils" cider-repl-require-repl-utils] "--" ["Browse classpath" cider-classpath] ["Browse classpath entry" cider-open-classpath-entry] ["Browse namespace" cider-browse-ns] ["Browse all namespaces" cider-browse-ns-all] + ["Browse spec" cider-browse-spec] + ["Browse all specs" cider-browse-spec-all] "--" ["Next prompt" cider-repl-next-prompt] ["Previous prompt" cider-repl-previous-prompt] @@ -1339,12 +1682,14 @@ constructs." "--" ["Interrupt evaluation" cider-interrupt] "--" - ["Connection info" cider-display-connection-info] + ["Connection info" cider-describe-connection] "--" ["Close ancillary buffers" cider-close-ancillary-buffers] ["Quit" cider-quit] ["Restart" cider-restart] "--" + ["Clojure Cheatsheet" cider-cheatsheet] + "--" ["A sip of CIDER" cider-drink-a-sip] ["View manual online" cider-view-manual] ["View refcard online" cider-view-refcard] @@ -1352,6 +1697,8 @@ constructs." ["Version info" cider-version])) map)) +(sesman-install-menu cider-repl-mode-map) + (defun cider-repl-wrap-fontify-function (func) "Return a function that will call FUNC narrowed to input region." (lambda (beg end &rest rest) @@ -1362,7 +1709,7 @@ constructs." (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") +(declare-function cider-complete-at-point "cider-completion") (defvar cider--static-font-lock-keywords) (define-derived-mode cider-repl-mode fundamental-mode "REPL" @@ -1370,10 +1717,9 @@ constructs." \\{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 sesman-system 'CIDER) (setq-local font-lock-fontify-region-function (cider-repl-wrap-fontify-function font-lock-fontify-region-function)) (setq-local font-lock-unfontify-region-function diff --git a/elpa/cider-20170129.1941/cider-resolve.el b/elpa/cider-20181110.1413/cider-resolve.el similarity index 90% rename from elpa/cider-20170129.1941/cider-resolve.el rename to elpa/cider-20181110.1413/cider-resolve.el index 6f9f8ebf..3c2dc6fd 100644 --- a/elpa/cider-20170129.1941/cider-resolve.el +++ b/elpa/cider-20181110.1413/cider-resolve.el @@ -1,6 +1,6 @@ ;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection -;; Copyright © 2015-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; Author: Artur Malabarba @@ -60,7 +60,7 @@ ;; (("m" "f"))) ;; "wrap-tracker" (dict "arglists" ;; (("handler")))) -;; "refers" (dict "set-descriptor!" "#'clojure.tools.nrepl.middleware/set-descriptor!")) +;; "refers" (dict "set-descriptor!" "#'nrepl.middleware/set-descriptor!")) ;;; Code: @@ -72,8 +72,8 @@ (defun cider-resolve--get-in (&rest keys) "Return (nrepl-dict-get-in cider-repl-ns-cache KEYS)." - (when cider-connections - (with-current-buffer (cider-current-connection) + (when-let* ((conn (cider-current-repl))) + (with-current-buffer conn (nrepl-dict-get-in cider-repl-ns-cache keys)))) (defun cider-resolve-alias (ns alias) @@ -95,7 +95,7 @@ Return nil only if VAR cannot be resolved." (cider-resolve--get-in (or var-ns ns) "interns" name) (unless var-ns ;; If the var had no prefix, it might be referred. - (if-let ((referal (cider-resolve--get-in ns "refers" name))) + (if-let* ((referal (cider-resolve--get-in ns "refers" name))) (cider-resolve-var ns referal) ;; Or it might be from core. (unless (equal ns "clojure.core") @@ -103,9 +103,10 @@ Return nil only if VAR cannot be resolved." (defun cider-resolve-core-ns () "Return a dict of the core namespace for current connection. -This will be clojure.core or cljs.core depending on `cider-repl-type'." - (when (cider-connected-p) - (with-current-buffer (cider-current-connection) +This will be clojure.core or cljs.core depending on the return value of the +function `cider-repl-type'." + (when-let* ((repl (cider-current-repl))) + (with-current-buffer repl (cider-resolve--get-in (if (equal cider-repl-type "cljs") "cljs.core" "clojure.core"))))) @@ -114,9 +115,9 @@ This will be clojure.core or cljs.core depending on `cider-repl-type'." "Return a plist of all valid symbols in NS. Each entry's value is the metadata of the var that the symbol refers to. NS can be the namespace name, or a dict of the namespace itself." - (when-let ((dict (if (stringp ns) - (cider-resolve--get-in ns) - ns))) + (when-let* ((dict (if (stringp ns) + (cider-resolve--get-in ns) + ns))) (nrepl-dbind-response dict (interns refers aliases) (append (cdr interns) (nrepl-dict-flat-map (lambda (alias namespace) diff --git a/elpa/cider-20170129.1941/cider-scratch.el b/elpa/cider-20181110.1413/cider-scratch.el similarity index 73% rename from elpa/cider-20170129.1941/cider-scratch.el rename to elpa/cider-20181110.1413/cider-scratch.el index e4e3150d..f1c3e93d 100644 --- a/elpa/cider-20170129.1941/cider-scratch.el +++ b/elpa/cider-20181110.1413/cider-scratch.el @@ -1,6 +1,6 @@ ;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*- -;; Copyright © 2014-2017 Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -30,10 +30,18 @@ ;;; Code: -(require 'cider-interaction) +(require 'cider-eval) (require 'clojure-mode) (require 'easymenu) +(defcustom cider-scratch-initial-message + ";; This buffer is for Clojure experiments and evaluation.\n +;; Press C-j to evaluate the last expression.\n\n" + "The initial message displayed in new scratch buffers." + :type 'string + :group 'cider + :package-version '(cider . "0.18.0")) + (defvar cider-clojure-interaction-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map clojure-mode-map) @@ -44,52 +52,46 @@ '("Clojure Interaction" (["Eval and print last sexp" #'cider-eval-print-last-sexp] "--" - ["Reset" #'cider-scratch-reset] - "--" - ["Set buffer connection" #'cider-assoc-buffer-with-connection] - ["Toggle buffer connection" #'cider-toggle-buffer-connection] - ["Reset buffer connection" #'cider-clear-buffer-local-connection]))) + ["Reset" #'cider-scratch-reset]))) map)) (defconst cider-scratch-buffer-name "*cider-scratch*") -(push cider-scratch-buffer-name cider-ancillary-buffers) - ;;;###autoload (defun cider-scratch () "Go to the scratch buffer named `cider-scratch-buffer-name'." (interactive) - (pop-to-buffer (cider-find-or-create-scratch-buffer))) + (pop-to-buffer (cider-scratch-find-or-create-buffer))) -(defun cider-find-or-create-scratch-buffer () +(defun cider-scratch-find-or-create-buffer () "Find or create the scratch buffer." (or (get-buffer cider-scratch-buffer-name) - (cider-create-scratch-buffer))) + (cider-scratch--create-buffer))) (define-derived-mode cider-clojure-interaction-mode clojure-mode "Clojure Interaction" "Major mode for typing and evaluating Clojure forms. Like clojure-mode except that \\[cider-eval-print-last-sexp] evals the Lisp expression before point, and prints its value into the buffer, advancing point. -\\{cider-clojure-interaction-mode-map}") +\\{cider-clojure-interaction-mode-map}" + (setq-local sesman-system 'CIDER)) -(defun cider--scratch-insert-welcome-message () +(defun cider-scratch--insert-welcome-message () "Insert the welcome message for the scratch buffer." - (insert ";; This buffer is for Clojure experiments and evaluation.\n" - ";; Press C-j to evaluate the last expression.\n\n")) + (insert cider-scratch-initial-message)) -(defun cider-create-scratch-buffer () +(defun cider-scratch--create-buffer () "Create a new scratch buffer." (with-current-buffer (get-buffer-create cider-scratch-buffer-name) (cider-clojure-interaction-mode) - (cider--scratch-insert-welcome-message) + (cider-scratch--insert-welcome-message) (current-buffer))) (defun cider-scratch-reset () "Reset the current scratch buffer." (interactive) (erase-buffer) - (cider--scratch-insert-welcome-message)) + (cider-scratch--insert-welcome-message)) (provide 'cider-scratch) diff --git a/elpa/cider-20170129.1941/cider-selector.el b/elpa/cider-20181110.1413/cider-selector.el similarity index 90% rename from elpa/cider-20170129.1941/cider-selector.el rename to elpa/cider-20181110.1413/cider-selector.el index ba85f703..a21032db 100644 --- a/elpa/cider-20170129.1941/cider-selector.el +++ b/elpa/cider-20181110.1413/cider-selector.el @@ -1,7 +1,7 @@ ;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -32,8 +32,9 @@ ;;; Code: (require 'cider-client) -(require 'cider-interaction) +(require 'cider-eval) (require 'cider-scratch) +(require 'cider-profile) (defconst cider-selector-help-buffer "*CIDER Selector Help*" "The name of the selector's help buffer.") @@ -44,9 +45,11 @@ Each element is a list (KEY DESCRIPTION FUNCTION). DESCRIPTION is a one-line description of what the key selects.") (defvar cider-selector-other-window nil - "If non-nil use `switch-to-buffer-other-window'.") + "If non-nil use `switch-to-buffer-other-window'. +Not meant to be set by users. It's used internally +by `cider-selector'.") -(defun cider--recently-visited-buffer (mode) +(defun cider-selector--recently-visited-buffer (mode) "Return the most recently visited buffer, deriving its `major-mode' from MODE. Only considers buffers that are not already visible." (cl-loop for buffer in (buffer-list) @@ -64,7 +67,6 @@ Only considers buffers that are not already visible." The user is prompted for a single character indicating the method by which to choose a new buffer. The `?' character describes then available methods. OTHER-WINDOW provides an optional target. - See `def-cider-selector-method' for defining new methods." (interactive) (message "Select [%s]: " @@ -85,7 +87,6 @@ See `def-cider-selector-method' for defining new methods." (defmacro def-cider-selector-method (key description &rest body) "Define a new `cider-select' buffer selection method. - KEY is the key the user will enter to choose this method. DESCRIPTION is a one-line sentence describing how the method @@ -127,40 +128,38 @@ is chosen. The returned buffer is selected with (def-cider-selector-method ?c "Most recently visited clojure-mode buffer." - (cider--recently-visited-buffer 'clojure-mode)) + (cider-selector--recently-visited-buffer 'clojure-mode)) (def-cider-selector-method ?e "Most recently visited emacs-lisp-mode buffer." - (cider--recently-visited-buffer 'emacs-lisp-mode)) + (cider-selector--recently-visited-buffer 'emacs-lisp-mode)) (def-cider-selector-method ?q "Abort." (top-level)) (def-cider-selector-method ?r "Current REPL buffer." - (cider-current-repl-buffer)) - -(def-cider-selector-method ?n - "Connections browser buffer." - (cider-connection-browser) - cider--connection-browser-buffer-name) + (cider-current-repl)) (def-cider-selector-method ?m "Current connection's *nrepl-messages* buffer." - (cider-current-messages-buffer)) + (nrepl-messages-buffer (cider-current-repl))) (def-cider-selector-method ?x "*cider-error* buffer." cider-error-buffer) +(def-cider-selector-method ?p + "CIDER profiler buffer." + cider-profile-buffer) + (def-cider-selector-method ?d "*cider-doc* buffer." cider-doc-buffer) -(declare-function cider-find-or-create-scratch-buffer "cider-scratch") (def-cider-selector-method ?s "*cider-scratch* buffer." - (cider-find-or-create-scratch-buffer)) + (cider-scratch-find-or-create-buffer)) (provide 'cider-selector) diff --git a/elpa/cider-20170129.1941/cider-stacktrace.el b/elpa/cider-20181110.1413/cider-stacktrace.el similarity index 66% rename from elpa/cider-20170129.1941/cider-stacktrace.el rename to elpa/cider-20181110.1413/cider-stacktrace.el index 6a244daa..321d4bbd 100644 --- a/elpa/cider-20170129.1941/cider-stacktrace.el +++ b/elpa/cider-20181110.1413/cider-stacktrace.el @@ -1,6 +1,6 @@ ;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*- -;; Copyright © 2014-2017 Jeff Valk, Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors ;; Author: Jeff Valk @@ -89,14 +89,15 @@ cyclical data structures." (defvar-local cider-stacktrace-hidden-frame-count 0) (defvar-local cider-stacktrace-filters nil) -(defvar-local cider-stacktrace-prior-filters nil) (defvar-local cider-stacktrace-cause-visibility nil) +(defvar-local cider-stacktrace-positive-filters nil) (defconst cider-error-buffer "*cider-error*") -(add-to-list 'cider-ancillary-buffers cider-error-buffer) + +(make-obsolete 'cider-visit-error-buffer 'cider-selector "0.18") (defcustom cider-stacktrace-suppressed-errors '() - "A set of errors that won't make the stacktrace buffer 'pop-over' your active window. + "Errors that won't make the stacktrace buffer 'pop-over' your active window. The error types are represented as strings." :type 'list :group 'cider-stacktrace @@ -116,13 +117,13 @@ The error types are represented as strings." :group 'cider-stacktrace :package-version '(cider . "0.7.0")) -(defface cider-stacktrace-filter-shown-face +(defface cider-stacktrace-filter-active-face '((t (:inherit button :underline t :weight normal))) "Face for filter buttons representing frames currently visible" :group 'cider-stacktrace :package-version '(cider . "0.6.0")) -(defface cider-stacktrace-filter-hidden-face +(defface cider-stacktrace-filter-inactive-face '((t (:inherit button :underline nil :weight normal))) "Face for filter buttons representing frames currently filtered out" :group 'cider-stacktrace @@ -158,7 +159,7 @@ The error types are represented as strings." (defface cider-stacktrace-suppressed-button-face '((((type graphic)) :box (:line-width 3 :style pressed-button) - :inherit widget-inactive-face) + :inherit widget-inactive) (t :inverse-video t)) "A button with this face represents a suppressed error type." :group 'cider-stacktrace @@ -175,6 +176,11 @@ The error types are represented as strings." (setq cider-stacktrace-frames-background-color (cider-scale-background-color))) +(defadvice disable-theme (after cider-stacktrace-adapt-to-theme activate) + "When theme is disabled, update `cider-stacktrace-frames-background-color'." + (setq cider-stacktrace-frames-background-color (cider-scale-background-color))) + + ;; Mode & key bindings (defvar cider-stacktrace-mode-map @@ -188,6 +194,7 @@ The error types are represented as strings." (define-key map "r" #'cider-stacktrace-toggle-repl) (define-key map "t" #'cider-stacktrace-toggle-tooling) (define-key map "d" #'cider-stacktrace-toggle-duplicates) + (define-key map "p" #'cider-stacktrace-show-only-project) (define-key map "a" #'cider-stacktrace-toggle-all) (define-key map "1" #'cider-stacktrace-cycle-cause-1) (define-key map "2" #'cider-stacktrace-cycle-cause-2) @@ -218,6 +225,7 @@ The error types are represented as strings." ["Show/hide REPL frames" cider-stacktrace-toggle-repl] ["Show/hide tooling frames" cider-stacktrace-toggle-tooling] ["Show/hide duplicate frames" cider-stacktrace-toggle-duplicates] + ["Toggle only project frames" cider-stacktrace-show-only-project] ["Show/hide all frames" cider-stacktrace-toggle-all])) map)) @@ -225,11 +233,10 @@ The error types are represented as strings." "Major mode for filtering and navigating CIDER stacktraces. \\{cider-stacktrace-mode-map}" - (setq buffer-read-only t) (when cider-special-mode-truncate-lines (setq-local truncate-lines t)) + (setq-local sesman-system 'CIDER) (setq-local electric-indent-chars nil) - (setq-local cider-stacktrace-prior-filters nil) (setq-local cider-stacktrace-hidden-frame-count 0) (setq-local cider-stacktrace-filters cider-stacktrace-default-filters) (setq-local cider-stacktrace-cause-visibility (make-vector 10 0))) @@ -237,29 +244,50 @@ The error types are represented as strings." ;; Stacktrace filtering -(defun cider-stacktrace-indicate-filters (filters) +(defvar cider-stacktrace--all-negative-filters + '(clj tooling dup java repl) + "Filters that remove stackframes.") + +(defvar cider-stacktrace--all-positive-filters + '(project all) + "Filters that ensure stackframes are shown.") + +(defun cider-stacktrace--face-for-filter (filter neg-filters pos-filters) + "Return whether we should mark the FILTER is active or not. + +NEG-FILTERS and POS-FILTERS are lists of filters to check FILTER's type. + +NEG-FILTERS dictate which frames should be hidden while POS-FILTERS can +override this and ensure that those frames are shown." + (cond ((member filter cider-stacktrace--all-negative-filters) + (if (member filter neg-filters) + 'cider-stacktrace-filter-active-face + 'cider-stacktrace-filter-inactive-face)) + ((member filter cider-stacktrace--all-positive-filters) + (if (member filter pos-filters) + 'cider-stacktrace-filter-active-face + 'cider-stacktrace-filter-inactive-face)))) + +(defun cider-stacktrace-indicate-filters (filters pos-filters) "Update enabled state of filter buttons. Find buttons with a 'filter property; if filter is a member of FILTERS, or if filter is nil ('show all') and the argument list is non-nil, fontify the button as disabled. Upon finding text with a 'hidden-count property, stop -searching and update the hidden count text." +searching and update the hidden count text. POS-FILTERS is the list of +positive filters to always include." (with-current-buffer cider-error-buffer (save-excursion (goto-char (point-min)) - (let ((inhibit-read-only t) - (get-face (lambda (hide) - (if hide - 'cider-stacktrace-filter-hidden-face - 'cider-stacktrace-filter-shown-face)))) + (let ((inhibit-read-only t)) ;; Toggle buttons (while (not (or (get-text-property (point) 'hidden-count) (eobp))) (let ((button (button-at (point)))) (when button (let* ((filter (button-get button 'filter)) - (face (funcall get-face (if filter - (member filter filters) - filters)))) + (face (cider-stacktrace--face-for-filter filter + filters + pos-filters))) (button-put button 'face face))) (goto-char (or (next-property-change (point)) (point-max))))) @@ -269,26 +297,77 @@ searching and update the hidden count text." (replace-match (number-to-string cider-stacktrace-hidden-frame-count))))))) -(defun cider-stacktrace-apply-filters (filters) - "Set visibility on stack frames using FILTERS. -Update `cider-stacktrace-hidden-frame-count' and indicate filters applied. -Currently collapsed stacktraces are ignored, and do not contribute to the -hidden count." +(defun cider-stacktrace-frame-p () + "Indicate if the text at point is a stack frame." + (get-text-property (point) 'cider-stacktrace-frame)) + +(defun cider-stacktrace-collapsed-p () + "Indicate if the stackframe was collapsed." + (get-text-property (point) 'collapsed)) + +(defun cider-stacktrace--should-hide-p (neg-filters pos-filters flags) + "Decide whether a stackframe should be hidden or not. +NEG-FILTERS dictate which frames should be hidden while POS-FILTERS can +override this and ensure that those frames are shown. +Argument FLAGS are the flags set on the stackframe, ie: clj dup, etc." + (let ((neg (seq-intersection neg-filters flags)) + (pos (seq-intersection pos-filters flags)) + (all (memq 'all pos-filters))) + (cond (all nil) ;; if all filter is on then we should not hide + ((and pos neg) nil) ;; if hidden and "resurrected" we should not hide + (pos nil) + (neg t) + (t nil)))) + +(defun cider-stacktrace--apply-filters (neg-filters pos-filters) + "Set visibility on stack frames. +Should be called by `cider-stacktrace-apply-filters' which has the logic of +how to interpret the combinations of the positive and negative filters. +For instance, the presence of the positive filter `project' requires all of +the other negative filters to be applied so that only project frames are +shown. NEG-FILTERS are the tags that should be hidden. POS-FILTERS are +the tags that must be shown." (with-current-buffer cider-error-buffer (save-excursion (goto-char (point-min)) (let ((inhibit-read-only t) (hidden 0)) (while (not (eobp)) - (unless (get-text-property (point) 'collapsed) + (when (and (cider-stacktrace-frame-p) + (not (cider-stacktrace-collapsed-p))) (let* ((flags (get-text-property (point) 'flags)) - (hide (if (seq-intersection filters flags) t nil))) + (hide (cider-stacktrace--should-hide-p neg-filters + pos-filters + flags))) (when hide (cl-incf hidden)) - (put-text-property (point) (line-beginning-position 2) 'invisible hide))) + (put-text-property (point) (line-beginning-position 2) + 'invisible hide))) (forward-line 1)) (setq cider-stacktrace-hidden-frame-count hidden))) - (cider-stacktrace-indicate-filters filters))) + (cider-stacktrace-indicate-filters neg-filters pos-filters))) +(defun cider-stacktrace-apply-filters (filters) + "Takes a single list of filters and applies them. +Update `cider-stacktrace-hidden-frame-count' and indicate +filters applied. Currently collapsed stacktraces are ignored, and do not +contribute to the hidden count. FILTERS is the list of filters to be +applied, positive and negative all together. This function defines how +those choices interact and separates them into positive and negative +filters for the resulting machinery." + (let ((neg-filters (seq-intersection filters cider-stacktrace--all-negative-filters)) + (pos-filters (seq-intersection filters cider-stacktrace--all-positive-filters))) + ;; project and all are mutually exclusive. when both are present we check to + ;; see the most recent one (as cons onto the list would put it) and use that + ;; interaction. + (cond + ((memq 'all (memq 'project pos-filters)) ;; project is most recent + (cider-stacktrace--apply-filters cider-stacktrace--all-negative-filters '(project))) + ((memq 'project (memq 'all pos-filters)) ;; all is most recent + (cider-stacktrace--apply-filters nil '(all))) + ((memq 'all pos-filters) (cider-stacktrace--apply-filters nil '(all))) + ((memq 'project pos-filters) (cider-stacktrace--apply-filters cider-stacktrace--all-negative-filters + pos-filters)) + (t (cider-stacktrace--apply-filters neg-filters pos-filters))))) (defun cider-stacktrace-apply-cause-visibility () "Apply `cider-stacktrace-cause-visibility' to causes and reapply filters." @@ -296,7 +375,7 @@ hidden count." (save-excursion (goto-char (point-min)) (cl-flet ((next-detail (end) - (when-let ((pos (next-single-property-change (point) 'detail))) + (when-let* ((pos (next-single-property-change (point) 'detail))) (when (< pos end) (goto-char pos))))) (let ((inhibit-read-only t)) @@ -313,17 +392,16 @@ hidden count." (add-text-properties (point) detail-end (list 'invisible hide 'collapsed hide)))))))) - (cider-stacktrace-apply-filters - cider-stacktrace-filters)))) + (cider-stacktrace-apply-filters cider-stacktrace-filters)))) ;;; Internal/Middleware error suppression (defun cider-stacktrace-some-suppressed-errors-p (error-types) "Return intersection of ERROR-TYPES and CIDER-STACKTRACE-SUPPRESSED-ERRORS. I.e, Return non-nil if the seq ERROR-TYPES shares any elements with -`cider-stacktrace-suppressed-errors'. This means that even a 'well-behaved' (ie, -promoted) error type will be 'guilty by association' if grouped with a -suppressed error type." +`cider-stacktrace-suppressed-errors'. This means that even a +'well-behaved' (ie, promoted) error type will be 'guilty by association' if +grouped with a suppressed error type." (seq-intersection error-types cider-stacktrace-suppressed-errors)) (defun cider-stacktrace-suppress-error (error-type) @@ -346,20 +424,20 @@ suppressed error type." "Move point to the previous exception cause, if one exists." (interactive) (with-current-buffer cider-error-buffer - (when-let ((pos (previous-single-property-change (point) 'cause))) + (when-let* ((pos (previous-single-property-change (point) 'cause))) (goto-char pos)))) (defun cider-stacktrace-next-cause () "Move point to the next exception cause, if one exists." (interactive) (with-current-buffer cider-error-buffer - (when-let ((pos (next-single-property-change (point) 'cause))) + (when-let* ((pos (next-single-property-change (point) 'cause))) (goto-char pos)))) (defun cider-stacktrace-cycle-cause (num &optional level) - "Update element NUM of `cider-stacktrace-cause-visibility', optionally to LEVEL. -If LEVEL is not specified, its current value is incremented. When it reaches 3, -it wraps to 0." + "Update element NUM of `cider-stacktrace-cause-visibility'. +If LEVEL is specified, it is useed, otherwise its current value is incremented. +When it reaches 3, it wraps to 0." (let ((level (or level (1+ (elt cider-stacktrace-cause-visibility num))))) (aset cider-stacktrace-cause-visibility num (mod level 3)) (cider-stacktrace-apply-cause-visibility))) @@ -385,7 +463,7 @@ it wraps to 0." "Cycle the visibility of current exception at point, if any." (interactive) (with-current-buffer cider-error-buffer - (when-let ((num (get-text-property (point) 'cause))) + (when-let* ((num (get-text-property (point) 'cause))) (cider-stacktrace-cycle-cause num)))) (defun cider-stacktrace-cycle-cause-1 () @@ -413,18 +491,6 @@ it wraps to 0." (interactive) (cider-stacktrace-cycle-cause 5)) - -(defun cider-stacktrace-toggle-all () - "Reset `cider-stacktrace-filters' if present; otherwise restore prior filters." - (interactive) - (when cider-stacktrace-filters - (setq-local cider-stacktrace-prior-filters - cider-stacktrace-filters)) - (cider-stacktrace-apply-filters - (setq cider-stacktrace-filters - (unless cider-stacktrace-filters ; when current filters are nil, - cider-stacktrace-prior-filters)))) ; reenable prior filter set - (defun cider-stacktrace-toggle (flag) "Update `cider-stacktrace-filters' to add or remove FLAG, and apply filters." (cider-stacktrace-apply-filters @@ -433,6 +499,16 @@ it wraps to 0." (remq flag cider-stacktrace-filters) (cons flag cider-stacktrace-filters))))) +(defun cider-stacktrace-toggle-all () + "Toggle `all' in filter list." + (interactive) + (cider-stacktrace-toggle 'all)) + +(defun cider-stacktrace-show-only-project () + "Display only the stackframes from the project." + (interactive) + (cider-stacktrace-toggle 'project)) + (defun cider-stacktrace-toggle-java () "Toggle display of Java stack frames." (interactive) @@ -464,9 +540,11 @@ it wraps to 0." "Apply filter(s) indicated by the BUTTON." (with-temp-message "Filters may also be toggled with the keyboard." (let ((flag (button-get button 'filter))) - (if flag - (cider-stacktrace-toggle flag) - (cider-stacktrace-toggle-all))) + (cond ((member flag cider-stacktrace--all-negative-filters) + (cider-stacktrace-toggle flag)) + ((member flag cider-stacktrace--all-positive-filters) + (cider-stacktrace-show-only-project)) + (t (cider-stacktrace-toggle-all)))) (sit-for 5))) (defun cider-stacktrace-toggle-suppression (button) @@ -499,13 +577,18 @@ Achieved by destructively manipulating the `cider-stacktrace-suppressed-errors' ;; Set `line-shift' to the number of lines from the beginning of defn. (line-shift (- (or (button-get button 'line) 0) (or (nrepl-dict-get info "line") 1))) + (file (or + (and (null var) (cider-resolve-java-class class)) + (nrepl-dict-get info "file") + (button-get button 'file))) ;; give priority to `info` files as `info` returns full paths. - (info (nrepl-dict-put info "file" (or (nrepl-dict-get info "file") - (button-get button 'file))))) + (info (nrepl-dict-put info "file" file))) (cider--jump-to-loc-from-info info t) (forward-line line-shift) (back-to-indentation))) +(declare-function cider-find-var "cider-find") + (defun cider-stacktrace-jump (&optional arg) "Find definition for stack frame at point, if available. The prefix ARG and `cider-prompt-for-symbol' decide whether to @@ -518,12 +601,27 @@ prompt and whether to use a new window. Similar to `cider-find-var'." ;; Rendering - -(defun cider-stacktrace-emit-indented (text indent &optional fill) - "Insert TEXT, and INDENT and optionally FILL the entire block." - (let ((beg (point))) +(defvar cider-use-tooltips) +(defun cider-stacktrace-tooltip (tooltip) + "Return TOOLTIP if `cider-use-tooltips' is set to true, nil otherwise." + (when cider-use-tooltips tooltip)) + +(defun cider-stacktrace-emit-indented (text &optional indent fill fontify) + "Insert TEXT, and optionally FILL and FONTIFY as clojure the entire block. +INDENT is a string to insert before each line. When INDENT is nil, first +line is not indented and INDENT defaults to a white-spaced string with +length given by `current-column'." + (let ((text (if fontify + (cider-font-lock-as-clojure text) + text)) + (do-first indent) + (indent (or indent (make-string (current-column) ? ))) + (beg (point))) (insert text) (goto-char beg) + (when do-first + (insert indent)) + (forward-line) (while (not (eobp)) (insert indent) (forward-line)) @@ -533,18 +631,33 @@ prompt and whether to use a new window. Similar to `cider-find-var'." (setq-local fill-prefix indent) (fill-region beg (point))))) -(defun cider-stacktrace-render-filters (buffer filters) - "Emit into BUFFER toggle buttons for each of the FILTERS." +(defun cider-stacktrace-render-filters (buffer special-filters filters) + "Emit into BUFFER toggle buttons for each of the FILTERS. +SPECIAL-FILTERS are filters that show stack certain stack frames, hiding +others." (with-current-buffer buffer (insert " Show: ") + (dolist (filter special-filters) + (insert-text-button (car filter) + 'filter (cadr filter) + 'follow-link t + 'action 'cider-stacktrace-filter + 'help-echo (cider-stacktrace-tooltip + (format "Toggle %s stack frames" + (car filter)))) + (insert " ")) + (insert "\n") + (insert " Hide: ") (dolist (filter filters) (insert-text-button (car filter) 'filter (cadr filter) 'follow-link t 'action 'cider-stacktrace-filter - 'help-echo (format "Toggle %s stack frames" - (car filter))) + 'help-echo (cider-stacktrace-tooltip + (format "Toggle %s stack frames" + (car filter)))) (insert " ")) + (let ((hidden "(0 frames hidden)")) (put-text-property 0 (length hidden) 'hidden-count t hidden) (insert " " hidden "\n")))) @@ -557,7 +670,8 @@ prompt and whether to use a new window. Similar to `cider-find-var'." (insert-text-button "M-x cider-report-bug" 'follow-link t 'action (lambda (_button) (cider-report-bug)) - 'help-echo "Report bug to the CIDER team.") + 'help-echo (cider-stacktrace-tooltip + "Report bug to the CIDER team.")) (insert "`.\n\n") (insert "\ If these stacktraces are occuring frequently, consider using the @@ -575,8 +689,9 @@ prompt and whether to use a new window. Similar to `cider-find-var'." 'face (if suppressed 'cider-stacktrace-suppressed-button-face 'cider-stacktrace-promoted-button-face) - 'help-echo (format "Click to %s these stacktraces." - (if suppressed "promote" "suppress")))) + 'help-echo (cider-stacktrace-tooltip + (format "Click to %s these stacktraces." + (if suppressed "promote" "suppress"))))) (insert " "))))) (defun cider-stacktrace-render-frame (buffer frame) @@ -593,7 +708,8 @@ This associates text properties to enable filtering and source navigation." 'name name 'file file 'line line 'flags flags 'follow-link t 'action 'cider-stacktrace-navigate - 'help-echo "View source at this location" + 'help-echo (cider-stacktrace-tooltip + "View source at this location") 'font-lock-face 'cider-stacktrace-face 'type 'cider-plain-button) (save-excursion @@ -602,11 +718,11 @@ This associates text properties to enable filtering and source navigation." (p2 (search-forward "/")) (p3 (search-forward-regexp "[^/$]+"))) (put-text-property p1 p4 'font-lock-face 'cider-stacktrace-ns-face) - (put-text-property p2 p3 'font-lock-face 'cider-stacktrace-fn-face))) + (put-text-property p2 p3 'font-lock-face 'cider-stacktrace-fn-face) + (put-text-property (line-beginning-position) (line-end-position) + 'cider-stacktrace-frame t))) (insert "\n"))))) -(declare-function cider-jump-to "cider-interaction") - (defun cider-stacktrace-render-compile-error (buffer cause) "Emit into BUFFER the compile error CAUSE, and enable jumping to it." (with-current-buffer buffer @@ -619,14 +735,87 @@ This associates text properties to enable filtering and source navigation." 'file file 'line line 'column column 'follow-link t 'action (lambda (_button) (cider-jump-to (cider-find-file file) - (cons line column)))) + (cons line column))) + 'help-echo (cider-stacktrace-tooltip + "Jump to the line that caused the error")) (insert (propertize (format " at (%d:%d)" line column) 'font-lock-face message-face)))))) +(defun cider-stacktrace--toggle-visibility (id) + "Toggle visibility of the region with ID invisibility prop. +ID can also be a button, in which case button's property :id is used +instead. This function can be used directly in button actions." + (let ((id (if (or (numberp id) (symbolp id)) + ;; There is no proper way to identify buttons. Assuming that + ;; id's can be either numbers or symbols. + id + (button-get id :id)))) + (if (and (consp buffer-invisibility-spec) + (assoc id buffer-invisibility-spec)) + (remove-from-invisibility-spec (cons id t)) + (add-to-invisibility-spec (cons id t))))) + +(defun cider-stacktrace--insert-named-group (indent name &rest vals) + "Insert named group with the ability to toggle visibility. +NAME is a string naming the group. VALS are strings to be inserted after +the NAME. The whole group is prefixed by string INDENT." + (let* ((str (and vals (replace-regexp-in-string "\n+\\'" "" (apply #'concat vals)))) + (id (and str + (string-match "\n" str) + (cl-gensym name)))) + (insert indent) + (if id + (let* ((beg-link (string-match "[^ :]" name)) + (end-link (string-match "[ :]" name (1+ beg-link)))) + (insert (substring name 0 beg-link)) + (insert-text-button (substring name beg-link end-link) + :id id + 'face '((:weight bold) (:underline t)) + 'follow-link t + 'help-echo "Toggle visibility" + 'action #'cider-stacktrace--toggle-visibility) + (insert (substring name end-link))) + (insert (propertize name 'face '((:weight bold))))) + (let ((pos (point))) + (when str + (cider-stacktrace-emit-indented (concat str "\n") nil nil t) + (when id + (remove-from-invisibility-spec (cons id t)) + (let ((hide-beg (save-excursion (goto-char pos) (point-at-eol))) + (hide-end (1- (point-at-bol)))) + (overlay-put (make-overlay hide-beg hide-end) 'invisible id))))))) + +(defun cider-stacktrace--emit-spec-problems (spec-data indent) + "Emit SPEC-DATA indented with INDENT." + (nrepl-dbind-response spec-data (spec value problems) + (insert "\n") + (cider-stacktrace--insert-named-group indent " Spec: " spec) + (cider-stacktrace--insert-named-group indent " Value: " value) + (insert "\n") + (cider-stacktrace--insert-named-group indent "Problems: \n") + (let ((indent2 (concat indent " "))) + (dolist (prob problems) + (nrepl-dbind-response prob (in val predicate reason spec at extra) + (insert "\n") + (when (not (string= val value)) + (cider-stacktrace--insert-named-group indent2 " val: " val)) + (when in + (cider-stacktrace--insert-named-group indent2 " in: " in)) + (cider-stacktrace--insert-named-group indent2 "failed: " predicate) + (when spec + (cider-stacktrace--insert-named-group indent2 " spec: " spec)) + (when at + (cider-stacktrace--insert-named-group indent2 " at: " at)) + (when reason + (cider-stacktrace--insert-named-group indent2 "reason: " reason)) + (when extra + (cider-stacktrace--insert-named-group indent2 "extras: \n") + (cider-stacktrace-emit-indented extra (concat indent2 " ") nil t))))))) + (defun cider-stacktrace-render-cause (buffer cause num note) "Emit into BUFFER the CAUSE NUM, exception class, message, data, and NOTE." (with-current-buffer buffer - (nrepl-dbind-response cause (class message data stacktrace) + (nrepl-dbind-response cause (class message data spec stacktrace) (let ((indent " ") (class-face 'cider-stacktrace-error-class-face) (message-face 'cider-stacktrace-error-message-face)) @@ -643,11 +832,13 @@ This associates text properties to enable filtering and source navigation." (cider-stacktrace-render-compile-error buffer cause) (cider-stacktrace-emit-indented (propertize (or message "(No message)") - 'font-lock-face message-face) indent t)) + 'font-lock-face message-face) + indent t)) (insert "\n") + (when spec + (cider-stacktrace--emit-spec-problems spec (concat indent " "))) (when data - (cider-stacktrace-emit-indented - (cider-font-lock-as-clojure data) indent nil))) + (cider-stacktrace-emit-indented data indent nil t))) ;; Detail level 2: stacktrace (cider-propertize-region '(detail 2) (insert "\n") @@ -697,8 +888,9 @@ through the `cider-stacktrace-suppressed-errors' variable." ;; Stacktrace filters (cider-stacktrace-render-filters buffer + `(("Project-Only" project) ("All" all)) `(("Clojure" clj) ("Java" java) ("REPL" repl) - ("Tooling" tooling) ("Duplicates" dup) ("All" ,nil))) + ("Tooling" tooling) ("Duplicates" dup))) (insert "\n") ;; Option to suppress internal/middleware errors (when error-types diff --git a/elpa/cider-20170129.1941/cider-test.el b/elpa/cider-20181110.1413/cider-test.el similarity index 65% rename from elpa/cider-20170129.1941/cider-test.el rename to elpa/cider-20181110.1413/cider-test.el index e5b8570e..a7b3e984 100644 --- a/elpa/cider-20170129.1941/cider-test.el +++ b/elpa/cider-20181110.1413/cider-test.el @@ -1,6 +1,6 @@ ;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*- -;; Copyright © 2014-2017 Jeff Valk, Bozhidar Batsov and CIDER contributors +;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors ;; Author: Jeff Valk @@ -37,6 +37,7 @@ (require 'cider-overlays) (require 'button) +(require 'cl-lib) (require 'easymenu) (require 'seq) @@ -61,8 +62,8 @@ (defcustom cider-test-defining-forms '("deftest" "defspec") "Forms that define individual tests. -CIDER considers the top-level form around point to define a test if the -form starts with one of these forms. +CIDER considers the \"top-level\" form around point to define a test if +the form starts with one of these forms. Add to this list to have CIDER recognize additional test defining macros." :type '(repeat string) :group 'cider-test @@ -76,8 +77,6 @@ Add to this list to have CIDER recognize additional test defining macros." (defconst cider-test-report-buffer "*cider-test-report*" "Buffer name in which to display test reports.") -(add-to-list 'cider-ancillary-buffers cider-test-report-buffer) - ;;; Faces @@ -122,7 +121,13 @@ Add to this list to have CIDER recognize additional test defining macros." (setq cider-test-items-background-color (cider-scale-background-color))) +(defadvice disable-theme (after cider-test-adapt-to-theme activate) + "When theme is disabled, update `cider-test-items-background-color'." + (setq cider-test-items-background-color (cider-scale-background-color))) + + ;;; Report mode & key bindings +;; ;; The primary mode of interacting with test results is the report buffer, which ;; allows navigation among tests, jumping to test definitions, expected/actual ;; diff-ing, and cause/stacktrace inspection for test errors. @@ -134,6 +139,7 @@ Add to this list to have CIDER recognize additional test defining macros." (define-key map (kbd "C-t") #'cider-test-run-test) (define-key map (kbd "C-g") #'cider-test-rerun-test) (define-key map (kbd "C-n") #'cider-test-run-ns-tests) + (define-key map (kbd "C-s") #'cider-test-run-ns-tests-with-filters) (define-key map (kbd "C-l") #'cider-test-run-loaded-tests) (define-key map (kbd "C-p") #'cider-test-run-project-tests) (define-key map (kbd "C-b") #'cider-test-show-report) @@ -142,6 +148,7 @@ Add to this list to have CIDER recognize additional test defining macros." (define-key map (kbd "t") #'cider-test-run-test) (define-key map (kbd "g") #'cider-test-rerun-test) (define-key map (kbd "n") #'cider-test-run-ns-tests) + (define-key map (kbd "s") #'cider-test-run-ns-tests-with-filters) (define-key map (kbd "l") #'cider-test-run-loaded-tests) (define-key map (kbd "p") #'cider-test-run-project-tests) (define-key map (kbd "b") #'cider-test-show-report) @@ -151,8 +158,11 @@ Add to this list to have CIDER recognize additional test defining macros." '("Test" ["Run test" cider-test-run-test] ["Run namespace tests" cider-test-run-ns-tests] + ["Run namespace tests with filters" cider-test-run-ns-tests-with-filters] ["Run all loaded tests" cider-test-run-loaded-tests] + ["Run all loaded tests with filters" (apply-partially cider-test-run-loaded-tests 'prompt-for-filters)] ["Run all project tests" cider-test-run-project-tests] + ["Run all project tests with filters" (apply-partially cider-test-run-project-tests 'prompt-for-filters)] ["Run tests after load-file" cider-auto-test-mode :style toggle :selected cider-auto-test-mode] "--" @@ -179,6 +189,7 @@ Add to this list to have CIDER recognize additional test defining macros." ;; `f' for "run failed". (define-key map "f" #'cider-test-rerun-failed-tests) (define-key map "n" #'cider-test-run-ns-tests) + (define-key map "s" #'cider-test-run-ns-tests-with-filters) (define-key map "l" #'cider-test-run-loaded-tests) (define-key map "p" #'cider-test-run-project-tests) ;; `g' generally reloads the buffer. The closest thing we have to that is @@ -195,8 +206,11 @@ Add to this list to have CIDER recognize additional test defining macros." ["Rerun current test" cider-test-run-test] ["Rerun failed/erring tests" cider-test-rerun-failed-tests] ["Run all ns tests" cider-test-run-ns-tests] + ["Run all ns tests with filters" cider-test-run-ns-tests-with-filters] ["Run all loaded tests" cider-test-run-loaded-tests] + ["Run all loaded tests with filters" (apply-partially cider-test-run-loaded-tests 'prompt-for-filters)] ["Run all project tests" cider-test-run-project-tests] + ["Run all project tests with filters" (apply-partially cider-test-run-project-tests 'prompt-for-filters)] "--" ["Jump to test definition" cider-test-jump] ["Display test error" cider-test-stacktrace] @@ -210,6 +224,7 @@ Add to this list to have CIDER recognize additional test defining macros." (setq buffer-read-only t) (when cider-special-mode-truncate-lines (setq-local truncate-lines t)) + (setq-local sesman-system 'CIDER) (setq-local electric-indent-chars nil)) ;; Report navigation @@ -217,7 +232,7 @@ Add to this list to have CIDER recognize additional test defining macros." (defun cider-test-show-report () "Show the test report buffer, if one exists." (interactive) - (if-let ((report-buffer (get-buffer cider-test-report-buffer))) + (if-let* ((report-buffer (get-buffer cider-test-report-buffer))) (switch-to-buffer report-buffer) (message "No test report buffer"))) @@ -225,22 +240,24 @@ Add to this list to have CIDER recognize additional test defining macros." "Move point to the previous test result, if one exists." (interactive) (with-current-buffer (get-buffer cider-test-report-buffer) - (when-let ((pos (previous-single-property-change (point) 'type))) + (when-let* ((pos (previous-single-property-change (point) 'type))) (if (get-text-property pos 'type) (goto-char pos) - (when-let ((pos (previous-single-property-change pos 'type))) + (when-let* ((pos (previous-single-property-change pos 'type))) (goto-char pos)))))) (defun cider-test-next-result () "Move point to the next test result, if one exists." (interactive) (with-current-buffer (get-buffer cider-test-report-buffer) - (when-let ((pos (next-single-property-change (point) 'type))) + (when-let* ((pos (next-single-property-change (point) 'type))) (if (get-text-property pos 'type) (goto-char pos) - (when-let ((pos (next-single-property-change pos 'type))) + (when-let* ((pos (next-single-property-change pos 'type))) (goto-char pos)))))) +(declare-function cider-find-var "cider-find") + (defun cider-test-jump (&optional arg) "Find definition for test at point, if available. The prefix ARG and `cider-prompt-for-symbol' decide whether to @@ -261,15 +278,16 @@ prompt and whether to use a new window. Similar to `cider-find-var'." "Display stacktrace for the erring NS VAR test with the assertion INDEX." (let (causes) (cider-nrepl-send-request - (append - (list "op" "test-stacktrace" - "ns" ns "var" var "index" index) - (when (cider--pprint-fn) - (list "pprint-fn" (cider--pprint-fn))) - (when cider-stacktrace-print-length - (list "print-length" cider-stacktrace-print-length)) - (when cider-stacktrace-print-level - (list "print-level" cider-stacktrace-print-level))) + (nconc `("op" "test-stacktrace" + "ns" ,ns + "var" ,var + "index" ,index) + (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) (nrepl-dbind-response response (class status) (cond (class (setq causes (cons response causes))) @@ -277,7 +295,8 @@ prompt and whether to use a new window. Similar to `cider-find-var'." (cider-stacktrace-render (cider-popup-buffer cider-error-buffer cider-auto-select-error-buffer - #'cider-stacktrace-mode) + #'cider-stacktrace-mode + 'ancillary) (reverse causes)))))))))) (defun cider-test-stacktrace () @@ -297,35 +316,48 @@ prompt and whether to use a new window. Similar to `cider-find-var'." (defvar cider-test-ediff-buffers nil "The expected/actual buffers used to display diff.") +(defun cider-test--extract-from-actual (actual n) + "Extract form N from ACTUAL, ignoring outermost not. + +ACTUAL is a string like \"(not (= 3 4))\", of the sort returned by +clojure.test. + +N = 1 => 3, N = 2 => 4, etc." + (with-temp-buffer + (insert actual) + (clojure-mode) + (goto-char (point-min)) + (re-search-forward "(" nil t 2) + (clojure-forward-logical-sexp n) + (forward-whitespace 1) + (let ((beg (point))) + (clojure-forward-logical-sexp) + (buffer-substring beg (point))))) + (defun cider-test-ediff () "Show diff of the expected vs actual value for the test at point. With the actual value, the outermost '(not ...)' s-expression is removed." (interactive) - (let ((expected (get-text-property (point) 'expected)) - (actual (get-text-property (point) 'actual))) - (if (and expected actual) - (let ((expected-buffer (generate-new-buffer " *expected*")) - (actual-buffer (generate-new-buffer " *actual*"))) - (with-current-buffer expected-buffer - (insert expected) - (clojure-mode)) - (with-current-buffer actual-buffer - (insert actual) - (goto-char (point-min)) - (forward-char) - (forward-sexp) - (forward-whitespace 1) - (let ((beg (point))) - (forward-sexp) - (let ((actual* (buffer-substring beg (point)))) - (erase-buffer) - (insert actual*))) - (clojure-mode)) - (apply 'ediff-buffers - (setq cider-test-ediff-buffers - (list (buffer-name expected-buffer) - (buffer-name actual-buffer))))) - (message "No test failure at point")))) + (let* ((expected-buffer (generate-new-buffer " *expected*")) + (actual-buffer (generate-new-buffer " *actual*")) + (diffs (get-text-property (point) 'diffs)) + (actual* (get-text-property (point) 'actual)) + (expected (cond (diffs (get-text-property (point) 'expected)) + (actual* (cider-test--extract-from-actual actual* 1)))) + (actual (cond (diffs (caar diffs)) + (actual* (cider-test--extract-from-actual actual* 2))))) + (if (not (and expected actual)) + (message "No test failure at point") + (with-current-buffer expected-buffer + (insert expected) + (clojure-mode)) + (with-current-buffer actual-buffer + (insert actual) + (clojure-mode)) + (apply #'ediff-buffers + (setq cider-test-ediff-buffers + (list (buffer-name expected-buffer) + (buffer-name actual-buffer))))))) (defun cider-test-ediff-cleanup () "Cleanup expected/actual buffers used for diff." @@ -368,36 +400,57 @@ With the actual value, the outermost '(not ...)' s-expression is removed." (defun cider-test-render-assertion (buffer test) "Emit into BUFFER report detail for the TEST assertion." (with-current-buffer buffer - (nrepl-dbind-response test (var context type message expected actual error gen-input) - (cider-propertize-region (cider-intern-keys (cdr test)) - (let ((beg (point)) - (type-face (cider-test-type-simple-face type)) - (bg `(:background ,cider-test-items-background-color))) - (cider-insert (capitalize type) type-face nil " in ") - (cider-insert var 'font-lock-function-name-face t) - (when context (cider-insert context 'font-lock-doc-face t)) - (when message (cider-insert message 'font-lock-doc-string-face t)) - (when expected - (cider-insert "expected: " 'font-lock-comment-face nil - (cider-font-lock-as-clojure expected))) - (when actual - (cider-insert " actual: " 'font-lock-comment-face nil - (cider-font-lock-as-clojure actual))) - (when error - (cider-insert " error: " 'font-lock-comment-face nil) - (insert-text-button error - 'follow-link t - 'action '(lambda (_button) (cider-test-stacktrace)) - 'help-echo "View causes and stacktrace") - (insert "\n")) - (when gen-input - (cider-insert " input: " 'font-lock-comment-face nil - (cider-font-lock-as-clojure gen-input))) - (overlay-put (make-overlay beg (point)) 'font-lock-face bg)) - (insert "\n"))))) + (nrepl-dbind-response test (var context type message expected actual diffs error gen-input) + (cl-flet ((insert-label (s) + (cider-insert (format "%8s: " s) 'font-lock-comment-face)) + (insert-align-label (s) + (insert (format "%12s" s))) + (insert-rect (s) + (insert-rectangle (thread-first s + cider-font-lock-as-clojure + (split-string "\n"))) + (beginning-of-line))) + (cider-propertize-region (cider-intern-keys (cdr test)) + (let ((beg (point)) + (type-face (cider-test-type-simple-face type)) + (bg `(:background ,cider-test-items-background-color))) + (cider-insert (capitalize type) type-face nil " in ") + (cider-insert var 'font-lock-function-name-face t) + (when context (cider-insert context 'font-lock-doc-face t)) + (when message (cider-insert message 'font-lock-string-face t)) + (when expected + (insert-label "expected") + (insert-rect expected) + (insert "\n")) + (if diffs + (dolist (d diffs) + (cl-destructuring-bind (actual (removed added)) d + (insert-label "actual") + (insert-rect actual) + (insert-label "diff") + (insert "- ") + (insert-rect removed) + (insert-align-label "+ ") + (insert-rect added) + (insert "\n"))) + (when actual + (insert-label "actual") + (insert-rect actual))) + (when error + (insert-label "error") + (insert-text-button error + 'follow-link t + 'action '(lambda (_button) (cider-test-stacktrace)) + 'help-echo "View causes and stacktrace") + (insert "\n")) + (when gen-input + (insert-label "input") + (insert (cider-font-lock-as-clojure gen-input))) + (overlay-put (make-overlay beg (point)) 'font-lock-face bg)) + (insert "\n")))))) (defun cider-test-non-passing (tests) - "For a list of TESTS, each an nrepl-dict, return only those that did not pass." + "For a list of TESTS, each an `nrepl-dict`, return only those that did not pass." (seq-filter (lambda (test) (unless (equal (nrepl-dict-get test "type") "pass") test)) @@ -471,6 +524,7 @@ The optional arg TEST denotes an individual test name." test var fail error)))) ;;; Test definition highlighting +;; ;; On receipt of test results, failing/erring test definitions are highlighted. ;; Highlights are cleared on the next report run, and may be cleared manually ;; by the user. @@ -484,11 +538,11 @@ The optional arg TEST denotes an individual test name." (defun cider-test-highlight-problem (buffer test) "Highlight the BUFFER test definition for the non-passing TEST." (with-current-buffer buffer - (nrepl-dbind-response test (type file line message expected actual) - ;; we have to watch out for vars without proper location metadata - ;; right now everything evaluated interactively lacks this data - ;; TODO: Figure out what to do when the metadata is missing - (when (and file line (not (cider--tooling-file-p file))) + ;; we don't need the file name here, as we always operate on the current + ;; buffer and the line data is correct even for vars that were + ;; defined interactively + (nrepl-dbind-response test (type line message expected actual) + (when line (save-excursion (goto-char (point-min)) (forward-line (1- line)) @@ -507,8 +561,8 @@ The optional arg TEST denotes an individual test name." "Return the buffer visiting the file in which the NS VAR is defined. Or nil if not found." (cider-ensure-op-supported "info") - (when-let ((info (cider-var-info (concat ns "/" var))) - (file (nrepl-dict-get info "file"))) + (when-let* ((info (cider-var-info (concat ns "/" var))) + (file (nrepl-dict-get info "file"))) (cider-find-file file))) (defun cider-test-highlight-problems (results) @@ -517,7 +571,7 @@ Or nil if not found." (lambda (ns vars) (nrepl-dict-map (lambda (var tests) - (when-let ((buffer (cider-find-var-file ns var))) + (when-let* ((buffer (cider-find-var-file ns var))) (dolist (test tests) (nrepl-dbind-response test (type) (unless (equal "pass" type) @@ -532,13 +586,14 @@ Or nil if not found." (nrepl-dict-map (lambda (ns vars) (dolist (var (nrepl-dict-keys vars)) - (when-let ((buffer (cider-find-var-file ns var))) + (when-let* ((buffer (cider-find-var-file ns var))) (with-current-buffer buffer (remove-overlays nil nil 'category 'cider-test))))) cider-test-last-results))) ;;; Test namespaces +;; ;; Test namespace inference exists to enable DWIM test running functions: the ;; same "run-tests" function should be able to be used in a source file, and in ;; its corresponding test namespace. To provide this, we need to map the @@ -557,72 +612,95 @@ The default implementation uses the simple Leiningen convention of appending This uses the Leiningen convention of appending '-test' to the namespace name." (when ns (let ((suffix "-test")) - ;; string-suffix-p is only available in Emacs 24.4+ - (if (string-match-p (rx-to-string `(: ,suffix eos) t) ns) + (if (string-suffix-p suffix ns) ns (concat ns suffix))))) ;;; Test execution -(declare-function cider-emit-interactive-eval-output "cider-interaction") -(declare-function cider-emit-interactive-eval-err-output "cider-interaction") +(declare-function cider-emit-interactive-eval-output "cider-eval") +(declare-function cider-emit-interactive-eval-err-output "cider-eval") -(defun cider-test-execute (ns &optional tests silent) - "Run tests for NS, which may be a keyword, optionally specifying TESTS. +(defun cider-test--prompt-for-selectors (message) + "Prompt for test selectors with MESSAGE. +The selectors can be either keywords or strings." + (mapcar + (lambda (string) (replace-regexp-in-string "^:+" "" string)) + (split-string + (cider-read-from-minibuffer message)))) +(defun cider-test-execute (ns &optional tests silent prompt-for-filters) + "Run tests for NS, which may be a keyword, optionally specifying TESTS. This tests a single NS, or multiple namespaces when using keywords `:project', `:loaded' or `:non-passing'. Optional TESTS are only honored when a single namespace is specified. Upon test completion, results are echoed and a test report is optionally displayed. When test failures/errors occur, their sources are highlighted. -If SILENT is non-nil, suppress all messages other then test results." +If SILENT is non-nil, suppress all messages other then test results. +If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selector filters. +The include/exclude selectors will be used to filter the tests before + running them." (cider-test-clear-highlights) - (cider-map-connections - (lambda (conn) - (unless silent - (if (and tests (= (length tests) 1)) - ;; we generate a different message when running individual tests - (cider-test-echo-running ns (car tests)) - (cider-test-echo-running ns))) - (cider-nrepl-send-request - (list "op" (cond ((stringp ns) "test") - ((eq :project ns) "test-all") - ((eq :loaded ns) "test-all") - ((eq :non-passing ns) "retest")) - "ns" (when (stringp ns) ns) - "tests" (when (stringp ns) tests) - "load?" (when (or (stringp ns) - (eq :project ns)) - "true")) - (lambda (response) - (nrepl-dbind-response response (summary results status out err) - (cond ((member "namespace-not-found" status) - (unless silent - (message "No test namespace: %s" (cider-propertize ns 'ns)))) - (out (cider-emit-interactive-eval-output out)) - (err (cider-emit-interactive-eval-err-output err)) - (results - (nrepl-dbind-response summary (error fail) - (setq cider-test-last-summary summary) - (setq cider-test-last-results results) - (cider-test-highlight-problems results) - (cider-test-echo-summary summary results) - (if (or (not (zerop (+ error fail))) - cider-test-show-report-on-success) - (cider-test-render-report - (cider-popup-buffer cider-test-report-buffer - cider-auto-select-test-report-buffer) - summary results) - (when (get-buffer cider-test-report-buffer) - (with-current-buffer cider-test-report-buffer - (let ((inhibit-read-only t)) - (erase-buffer))) - (cider-test-render-report - cider-test-report-buffer - summary results)))))))) - conn)) - :clj)) + (let ((include-selectors + (when prompt-for-filters + (cider-test--prompt-for-selectors "Test selectors to include (space separated): "))) + (exclude-selectors + (when prompt-for-filters + (cider-test--prompt-for-selectors "Test selectors to exclude (space separated): ")))) + (cider-map-repls :clj-strict + (lambda (conn) + (unless silent + (if (and tests (= (length tests) 1)) + ;; we generate a different message when running individual tests + (cider-test-echo-running ns (car tests)) + (cider-test-echo-running ns))) + (let ((request `("op" ,(cond ((stringp ns) "test") + ((eq :project ns) "test-all") + ((eq :loaded ns) "test-all") + ((eq :non-passing ns) "retest"))))) + ;; we add optional parts of the request only when relevant + (when (and (listp include-selectors) include-selectors) + (setq request (append request `("include" ,include-selectors)))) + (when (and (listp exclude-selectors) exclude-selectors) + (setq request (append request `("exclude" ,exclude-selectors)))) + (when (stringp ns) + (setq request (append request `("ns" ,ns)))) + (when (stringp ns) + (setq request (append request `("tests" ,tests)))) + (when (or (stringp ns) (eq :project ns)) + (setq request (append request `("load?" ,"true")))) + (cider-nrepl-send-request + request + (lambda (response) + (nrepl-dbind-response response (summary results status out err) + (cond ((member "namespace-not-found" status) + (unless silent + (message "No test namespace: %s" (cider-propertize ns 'ns)))) + (out (cider-emit-interactive-eval-output out)) + (err (cider-emit-interactive-eval-err-output err)) + (results + (nrepl-dbind-response summary (error fail) + (setq cider-test-last-summary summary) + (setq cider-test-last-results results) + (cider-test-highlight-problems results) + (cider-test-echo-summary summary results) + (if (or (not (zerop (+ error fail))) + cider-test-show-report-on-success) + (cider-test-render-report + (cider-popup-buffer + cider-test-report-buffer + cider-auto-select-test-report-buffer) + summary + results) + (when (get-buffer cider-test-report-buffer) + (with-current-buffer cider-test-report-buffer + (let ((inhibit-read-only t)) + (erase-buffer))) + (cider-test-render-report + cider-test-report-buffer + summary results)))))))) + conn)))))) (defun cider-test-rerun-failed-tests () "Rerun failed and erring tests from the last test run." @@ -634,27 +712,40 @@ If SILENT is non-nil, suppress all messages other then test results." (message "No prior failures to retest"))) (message "No prior results to retest"))) -(defun cider-test-run-loaded-tests () - "Run all tests defined in currently loaded namespaces." - (interactive) - (cider-test-execute :loaded)) +(defun cider-test-run-loaded-tests (prompt-for-filters) + "Run all tests defined in currently loaded namespaces. -(defun cider-test-run-project-tests () - "Run all tests defined in all project namespaces, loading these as needed." - (interactive) - (cider-test-execute :project)) +If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selectors to filter the tests with." + (interactive "P") + (cider-test-execute :loaded nil nil prompt-for-filters)) + +(defun cider-test-run-project-tests (prompt-for-filters) + "Run all tests defined in all project namespaces, loading these as needed. + +If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selectors to filter the tests with." + (interactive "P") + (cider-test-execute :project nil nil prompt-for-filters)) -(defun cider-test-run-ns-tests (suppress-inference &optional silent) +(defun cider-test-run-ns-tests-with-filters (suppress-inference) + "Run tests filtered by selectors for the current Clojure namespace context. + +With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the +current ns." + (interactive "P") + (cider-test-run-ns-tests suppress-inference nil 't)) + +(defun cider-test-run-ns-tests (suppress-inference &optional silent prompt-for-filters) "Run all tests for the current Clojure namespace context. If SILENT is non-nil, suppress all messages other then test results. With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the -current ns." +current ns. If PROMPT-FOR-FILTERS is non-nil, prompt the user for +test selectors to filter the tests with." (interactive "P") - (if-let ((ns (if suppress-inference - (cider-current-ns t) - (funcall cider-test-infer-test-ns (cider-current-ns t))))) - (cider-test-execute ns nil silent) + (if-let* ((ns (if suppress-inference + (cider-current-ns t) + (funcall cider-test-infer-test-ns (cider-current-ns t))))) + (cider-test-execute ns nil silent prompt-for-filters) (if (eq major-mode 'cider-test-report-mode) (when (y-or-n-p (concat "Test report does not define a namespace. " "Rerun failed/erring tests?")) @@ -683,15 +774,20 @@ is searched." (let ((ns (get-text-property (point) 'ns)) (var (get-text-property (point) 'var))) (if (and ns var) + ;; we're in a `cider-test-report-mode' buffer + ;; or on a highlighted failed/erred test definition (progn (cider-test-update-last-test ns var) (cider-test-execute ns (list var))) - (let ((ns (clojure-find-ns)) - (def (clojure-find-def))) - (if (and ns (member (car def) cider-test-defining-forms)) + ;; we're in a `clojure-mode' buffer + (let* ((ns (clojure-find-ns)) + (def (clojure-find-def)) ; it's a list of the form (deftest something) + (deftype (car def)) + (var (cadr def))) + (if (and ns (member deftype cider-test-defining-forms)) (progn - (cider-test-update-last-test ns (cdr def)) - (cider-test-execute ns (cdr def))) + (cider-test-update-last-test ns (list var)) + (cider-test-execute ns (list var))) (message "No test at point")))))) (defun cider-test-rerun-test () diff --git a/elpa/cider-20181110.1413/cider-tracing.el b/elpa/cider-20181110.1413/cider-tracing.el new file mode 100644 index 00000000..c00e7b7f --- /dev/null +++ b/elpa/cider-20181110.1413/cider-tracing.el @@ -0,0 +1,90 @@ +;;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A couple of commands for tracing the execution of functions. + +;;; Code: + +(require 'cider-client) +(require 'cider-common) ; for `cider-prompt-for-symbol-function' +(require 'cider-util) ; for `cider-propertize' +(require 'cider-connection) ; for `cider-map-repls' +(require 'nrepl-dict) + +(defun cider-sync-request:toggle-trace-var (symbol) + "Toggle var tracing for SYMBOL." + (thread-first `("op" "toggle-trace-var" + "ns" ,(cider-current-ns) + "sym" ,symbol) + (cider-nrepl-send-sync-request))) + +(defun cider--toggle-trace-var (sym) + "Toggle var tracing for SYM." + (let* ((trace-response (cider-sync-request:toggle-trace-var sym)) + (var-name (nrepl-dict-get trace-response "var-name")) + (var-status (nrepl-dict-get trace-response "var-status"))) + (pcase var-status + ("not-found" (error "Var %s not found" (cider-propertize sym 'fn))) + ("not-traceable" (error "Var %s can't be traced because it's not bound to a function" (cider-propertize var-name 'fn))) + (_ (message "Var %s %s" (cider-propertize var-name 'fn) var-status))))) + +;;;###autoload +(defun cider-toggle-trace-var (arg) + "Toggle var tracing. +Prompts for the symbol to use, or uses the symbol at point, depending on +the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the +opposite of what that option dictates." + (interactive "P") + (cider-ensure-op-supported "toggle-trace-var") + (funcall (cider-prompt-for-symbol-function arg) + "Toggle trace for var" + #'cider--toggle-trace-var)) + +(defun cider-sync-request:toggle-trace-ns (ns) + "Toggle namespace tracing for NS." + (thread-first `("op" "toggle-trace-ns" + "ns" ,ns) + (cider-nrepl-send-sync-request))) + +;;;###autoload +(defun cider-toggle-trace-ns (query) + "Toggle ns tracing. +Defaults to the current ns. With prefix arg QUERY, prompts for a ns." + (interactive "P") + (cider-map-repls :clj-strict + (lambda (conn) + (with-current-buffer conn + (cider-ensure-op-supported "toggle-trace-ns") + (let ((ns (if query + (completing-read "Toggle trace for ns: " + (cider-sync-request:ns-list)) + (cider-current-ns)))) + (let* ((trace-response (cider-sync-request:toggle-trace-ns ns)) + (ns-status (nrepl-dict-get trace-response "ns-status"))) + (pcase ns-status + ("not-found" (error "Namespace %s not found" (cider-propertize ns 'ns))) + (_ (message "Namespace %s %s" (cider-propertize ns 'ns) ns-status))))))))) + +(provide 'cider-tracing) +;;; cider-tracing.el ends here diff --git a/elpa/cider-20170129.1941/cider-util.el b/elpa/cider-20181110.1413/cider-util.el similarity index 75% rename from elpa/cider-20170129.1941/cider-util.el rename to elpa/cider-20181110.1413/cider-util.el index 2c3eafb0..f09d580f 100644 --- a/elpa/cider-20170129.1941/cider-util.el +++ b/elpa/cider-20181110.1413/cider-util.el @@ -1,7 +1,7 @@ -;;; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*- +;; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -31,11 +31,16 @@ ;;; Code: +;; Built-ins +(require 'ansi-color) +(require 'color) (require 'seq) -(require 'cl-lib) -(require 'clojure-mode) (require 'subr-x) +(require 'thingatpt) + +;; clojure-mode and CIDER (require 'cider-compat) +(require 'clojure-mode) (require 'nrepl-dict) (defalias 'cider-pop-back 'pop-tag-mark) @@ -67,12 +72,12 @@ Setting this to nil removes the fontification restriction." default-directory)) (defun cider-in-string-p () - "Return true if point is in a string." + "Return non-nil if point is in a string." (let ((beg (save-excursion (beginning-of-defun) (point)))) (nth 3 (parse-partial-sexp beg (point))))) (defun cider-in-comment-p () - "Return true if point is in a comment." + "Return non-nil if point is in a comment." (let ((beg (save-excursion (beginning-of-defun) (point)))) (nth 4 (parse-partial-sexp beg (point))))) @@ -83,17 +88,25 @@ which nREPL uses for temporary evaluation file names." (let ((fname (file-name-nondirectory file-name))) (string-match-p "^form-init" fname))) -(defun cider--cljc-or-cljx-buffer-p (&optional buffer) - "Return true if the current buffer is visiting a cljc or cljx file. +(defun cider--cljc-buffer-p (&optional buffer) + "Return non-nil if the current buffer is visiting a cljc file. If BUFFER is provided act on that buffer instead." (with-current-buffer (or buffer (current-buffer)) - (or (derived-mode-p 'clojurec-mode) (derived-mode-p 'clojurex-mode)))) + (or (derived-mode-p 'clojurec-mode)))) ;;; Thing at point + +(defun cider--text-or-limits (bounds start end) + "Returns the substring or the bounds of text. +If BOUNDS is non-nil, returns the list (START END) of character +positions. Else returns the substring from START to END." + (funcall (if bounds #'list #'buffer-substring-no-properties) + start end)) + (defun cider-defun-at-point (&optional bounds) - "Return the text of the top-level sexp at point. + "Return the text of the top level sexp at point. If BOUNDS is non-nil, return a list of its starting and ending position instead." (save-excursion @@ -101,8 +114,7 @@ instead." (end-of-defun) (let ((end (point))) (clojure-backward-logical-sexp 1) - (funcall (if bounds #'list #'buffer-substring-no-properties) - (point) end))))) + (cider--text-or-limits bounds (point) end))))) (defun cider-ns-form () "Retrieve the ns form." @@ -115,7 +127,7 @@ instead." "Return the name of the symbol at point, otherwise nil. Ignores the REPL prompt. If LOOK-BACK is non-nil, move backwards trying to find a symbol if there isn't one at point." - (or (when-let ((str (thing-at-point 'symbol))) + (or (when-let* ((str (thing-at-point 'symbol))) (unless (text-property-any 0 (length str) 'field 'cider-repl-prompt str) (substring-no-properties str))) (when look-back @@ -131,13 +143,13 @@ find a symbol if there isn't one at point." "Return the sexp at point as a string, otherwise nil. If BOUNDS is non-nil, return a list of its starting and ending position instead." - (when-let ((b (or (and (equal (char-after) ?\() - (member (char-before) '(?\' ?\, ?\@)) - ;; hide stuff before ( to avoid quirks with '( etc. - (save-restriction - (narrow-to-region (point) (point-max)) - (bounds-of-thing-at-point 'sexp))) - (bounds-of-thing-at-point 'sexp)))) + (when-let* ((b (or (and (equal (char-after) ?\() + (member (char-before) '(?\' ?\, ?\@)) + ;; hide stuff before ( to avoid quirks with '( etc. + (save-restriction + (narrow-to-region (point) (point-max)) + (bounds-of-thing-at-point 'sexp))) + (bounds-of-thing-at-point 'sexp)))) (funcall (if bounds #'list #'buffer-substring-no-properties) (car b) (cdr b)))) @@ -166,6 +178,15 @@ Can only error if SKIP is non-nil." (forward-sexp 1) (cider-start-of-next-sexp)))) +(defun cider-second-sexp-in-list () + "Return the second sexp in the list at point." + (condition-case nil + (save-excursion + (backward-up-list) + (forward-char) + (forward-sexp 2) + (cider-sexp-at-point)) + (error nil))) ;;; Text properties @@ -183,7 +204,8 @@ Can only error if SKIP is non-nil." "Execute BODY and add PROPS to all the inserted text. More precisely, PROPS are added to the region between the point's positions before and after executing BODY." - (declare (indent 1)) + (declare (indent 1) + (debug (sexp body))) (let ((start (make-symbol "start"))) `(let ((,start (point))) (prog1 (progn ,@body) @@ -203,6 +225,28 @@ PROP is the name of a text property." (when more-text (insert more-text)) (when break (insert "\n"))) + +;;; Hooks + +(defun cider-run-chained-hook (hook arg) + "Like `run-hook-with-args' but pass intermediate return values through. +HOOK is a name of a hook (a symbol). You can use `add-hook' or +`remove-hook' to add functions to this variable. ARG is passed to first +function. Its return value is passed to the second function and so forth +till all functions are called or one of them returns nil. Return the value +return by the last called function." + (let ((functions (copy-sequence (symbol-value hook)))) + (while (and functions arg) + (if (eq (car functions) t) + ;; global value of the hook + (let ((functions (default-value hook))) + (while (and functions arg) + (setq arg (funcall (car functions) arg)) + (setq functions (cdr functions)))) + (setq arg (funcall (car functions) arg))) + (setq functions (cdr functions))) + arg)) + ;;; Font lock @@ -226,7 +270,7 @@ PROP is the name of a text property." "A list of buffers for different major modes.") (defun cider--make-buffer-for-mode (mode) - "Return a temp buffer using major-mode MODE. + "Return a temp buffer using `major-mode' MODE. This buffer is not designed to display anything to the user. For that, use `cider-make-popup-buffer' instead." (setq cider--mode-buffers (seq-filter (lambda (x) (buffer-live-p (cdr x))) @@ -242,16 +286,23 @@ This buffer is not designed to display anything to the user. For that, use (funcall mode)) b))) +(defun cider-ansi-color-string-p (string) + "Return non-nil if STRING is an ANSI string." + (string-match "^\\[" string)) + (defun cider-font-lock-as (mode string) "Use MODE to font-lock the STRING." - (if (or (null cider-font-lock-max-length) - (< (length string) cider-font-lock-max-length)) - (with-current-buffer (cider--make-buffer-for-mode mode) - (erase-buffer) - (insert string) - (font-lock-fontify-region (point-min) (point-max)) - (buffer-string)) - string)) + (let ((string (if (cider-ansi-color-string-p string) + (substring-no-properties (ansi-color-apply string)) + string))) + (if (or (null cider-font-lock-max-length) + (< (length string) cider-font-lock-max-length)) + (with-current-buffer (cider--make-buffer-for-mode mode) + (erase-buffer) + (insert string) + (font-lock-fontify-region (point-min) (point-max)) + (buffer-string)) + string))) (defun cider-font-lock-region-as (mode beg end &optional buffer) "Use MODE to font-lock text between BEG and END. @@ -271,21 +322,38 @@ Unless you specify a BUFFER it will default to the current one." (define-button-type 'cider-plain-button 'face nil) -;;; Colors +(defun cider-add-face (regexp face &optional foreground-only sub-expr object) + "Propertize all occurrences of REGEXP with FACE. +If FOREGROUND-ONLY is non-nil, change only the foreground of matched +regions. SUB-EXPR is a sub-expression of REGEXP to be +propertized (defaults to 0). OBJECT is an object to be +propertized (defaults to current buffer)." + (setq sub-expr (or sub-expr 0)) + (when (and regexp face) + (let ((beg 0) + (end 0)) + (with-current-buffer (or (and (bufferp object) object) + (current-buffer)) + (while (if (stringp object) + (string-match regexp object end) + (re-search-forward regexp nil t)) + (setq beg (match-beginning sub-expr) + end (match-end sub-expr)) + (if foreground-only + (let ((face-spec (list (cons 'foreground-color + (face-attribute face :foreground nil t))))) + (font-lock-prepend-text-property beg end 'face face-spec object)) + (put-text-property beg end 'face face object))))))) -(defun cider-scale-color (color scale) - "For a COLOR hex string or name, adjust intensity of RGB components by SCALE." - (let* ((rgb (color-values color)) - (scaled-rgb (mapcar (lambda (n) - (format "%04x" (round (+ n (* scale 65535))))) - rgb))) - (apply #'concat "#" scaled-rgb))) + +;;; Colors (defun cider-scale-background-color () "Scale the current background color to get a slighted muted version." (let ((color (frame-parameter nil 'background-color)) - (dark (eq (frame-parameter nil 'background-mode) 'dark))) - (cider-scale-color color (if dark 0.05 -0.05)))) + (darkp (eq (frame-parameter nil 'background-mode) 'dark))) + (unless (equal "unspecified-bg" color) + (color-lighten-name color (if darkp 5 -5))))) (autoload 'pkg-info-version-info "pkg-info.el") @@ -326,7 +394,7 @@ plugin or dependency with: (cider-add-to-alist 'cider-jack-in-lein-plugins \"plugin/artifact-name\" \"THE-NEW-VERSION\")" (let ((alist (symbol-value symbol))) - (if-let ((cons (assoc car alist))) + (if-let* ((cons (assoc car alist))) (setcdr cons (list cadr)) (set symbol (cons (list car cadr) alist))))) @@ -336,7 +404,7 @@ plugin or dependency with: (defvar cider-version) -(defconst cider-manual-url "http://cider.readthedocs.org/en/%s/" +(defconst cider-manual-url "https://docs.cider.mx/en/%s/" "The URL to CIDER's manual.") (defun cider--manual-version () @@ -447,7 +515,7 @@ restore it properly when going back." :package-version '(cider . "0.13.0")) (defun cider--find-symbol-xref () - "Parse and return the first clojure symbol in current-buffer. + "Parse and return the first clojure symbol in current buffer. Use `cider-doc-xref-regexp' for the search. Set match data and return a string of the Clojure symbol. Return nil if there are no more matches in the buffer." @@ -457,9 +525,32 @@ the buffer." (declare-function cider-doc-lookup "cider-doc") (declare-function cider--eldoc-remove-dot "cider-eldoc") +;; Taken from: https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L551-L565 +(defun cider--make-back-forward-xrefs (&optional buffer) + "Insert special references `back' and `forward', as in `help-make-xrefs'. + +Optional argument BUFFER is the buffer in which to insert references. +Default is current buffer." + (with-current-buffer (or buffer (current-buffer)) + (insert "\n") + (when (or help-xref-stack help-xref-forward-stack) + (insert "\n")) + ;; Make a back-reference in this buffer if appropriate. + (when help-xref-stack + (help-insert-xref-button help-back-label 'help-back + (current-buffer))) + ;; Make a forward-reference in this buffer if appropriate. + (when help-xref-forward-stack + (when help-xref-stack + (insert "\t")) + (help-insert-xref-button help-forward-label 'help-forward + (current-buffer))) + (when (or help-xref-stack help-xref-forward-stack) + (insert "\n")))) + ;; Similar to https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L404 (defun cider--doc-make-xrefs () - "Parse and hyperlink documentation cross-references in current-buffer. + "Parse and hyperlink documentation cross-references in current buffer. Find cross-reference information in a buffer and activate such cross references for selection with `help-xref'. Cross-references are parsed using `cider--find-symbol-xref'. @@ -479,23 +570,7 @@ through a stack of help buffers. Variables `help-back-label' and 'type 'help-xref 'help-function (apply-partially #'cider-doc-lookup (cider--eldoc-remove-dot symbol)))))) - - ;; create back and forward buttons if appropiate - (insert "\n") - (when (or help-xref-stack help-xref-forward-stack) - (insert "\n")) - ;; Make a back-reference in this buffer if appropriate. - (when help-xref-stack - (help-insert-xref-button help-back-label 'help-back - (current-buffer))) - ;; Make a forward-reference in this buffer if appropriate. - (when help-xref-forward-stack - (when help-xref-stack - (insert "\t")) - (help-insert-xref-button help-forward-label 'help-forward - (current-buffer))) - (when (or help-xref-stack help-xref-forward-stack) - (insert "\n"))) + (cider--make-back-forward-xrefs)) ;;; Words of inspiration @@ -541,6 +616,7 @@ through a stack of help buffers. Variables `help-back-label' and "Don't wish it were easier. Wish you were better. -Jim Rohn" "One chord is fine. Two chords is pushing it. Three chords and you're into jazz. -Lou Reed" "We are all apprentices in a craft where no one ever becomes a master. -Ernest Hemingway" + "A designer knows he has achieved perfection not when there is nothing left to add, but when there is nothing left to take away. -Antoine de Saint-Exupery" "Clojure isn't a language, it's a building material." "Think big!" "Think bold!" @@ -575,6 +651,10 @@ through a stack of help buffers. Variables `help-back-label' and "Oh, what a day... what a lovely day!" "What a day! What cannot be accomplished on such a splendid day!" "Home is where your REPL is." + "The worst day programming is better than the best day working." + "The only thing worse than a rebel without a cause is a REPL without a clause." + "In the absence of parentheses, chaos prevails." + "One REPL to rule them all, One REPL to find them, One REPL to bring them all, and in parentheses bind them!" ,(format "%s, I've a feeling we're not in Kansas anymore." (cider-user-first-name)) ,(format "%s, this could be the start of a beautiful program." @@ -594,9 +674,9 @@ through a stack of help buffers. Variables `help-back-label' and "Press <\\[describe-mode]> to see a list of the keybindings available (this will work in every Emacs buffer)." "Press <\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command." "Press <\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure source buffer." - "Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a Java method)." "Press <\\[cider-doc]> to view the documentation for something (e.g. a var, a Java method)." "Press <\\[cider-find-resource]> to find a resource on the classpath." + "Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a Java method)." "Press <\\[cider-selector]> to quickly select a CIDER buffer." "Press <\\[cider-test-run-ns-tests]> to run the tests for the current namespace." "Press <\\[cider-test-run-loaded-tests]> to run all loaded tests." @@ -604,6 +684,10 @@ through a stack of help buffers. Variables `help-back-label' and "Press <\\[cider-apropos]> to look for a symbol by some search string." "Press <\\[cider-apropos-documentation]> to look for a symbol that has some string in its docstring." "Press <\\[cider-eval-defun-at-point]> to eval the top-level form at point." + "Press <\\[cider-eval-defun-up-to-point]> to eval the top-level form up to the point." + "Press <\\[cider-eval-sexp-up-to-point]> to eval the current form up to the point." + "Press <\\[cider-eval-sexp-at-point]> to eval the current form around the point." + "Press <\\[cider-eval-sexp-at-point-in-context]> to eval the current form around the point in a user-provided context." "Press <\\[cider-eval-buffer]> to eval the entire source buffer." "Press <\\[cider-scratch]> to create a Clojure scratchpad. Pretty handy for prototyping." "Press <\\[cider-read-and-eval]> to evaluate some Clojure expression directly in the minibuffer." @@ -615,9 +699,9 @@ through a stack of help buffers. Variables `help-back-label' and "Press <\\[cider-inspect]> to inspect the preceding expression's result." "Press to inspect the defun at point's result." "Press to read Clojure code from the minibuffer and inspect its result." - "Press <\\[cider-refresh]> to reload modified and unloaded namespaces." - "You can define Clojure functions to be called before and after `cider-refresh' (see `cider-refresh-before-fn' and `cider-refresh-after-fn'." - "Press <\\[cider-display-connection-info]> to view information about the connection." + "Press <\\[cider-ns-refresh]> to reload modified and unloaded namespaces." + "You can define Clojure functions to be called before and after `cider-ns-refresh' (see `cider-ns-refresh-before-fn' and `cider-ns-refresh-after-fn'." + "Press <\\[cider-describe-connection]> to view information about the connection." "Press <\\[cider-undef]> to undefine a symbol in the current namespace." "Press <\\[cider-interrupt]> to interrupt an ongoing evaluation." "Use to see every possible setting you can customize." @@ -628,7 +712,9 @@ through a stack of help buffers. Variables `help-back-label' and "Exploring CIDER's menu-bar entries is a great way to discover features." "Keep in mind that some commands don't have a keybinding by default. Explore CIDER!" "Tweak `cider-repl-prompt-function' to customize your REPL prompt." - "Tweak `cider-eldoc-ns-function' to customize the way namespaces are displayed by eldoc.") + "Tweak `cider-eldoc-ns-function' to customize the way namespaces are displayed by eldoc." + "For no middleware, low-tech and reliable namespace reloading use <\\[cider-ns-reload]>." + "Press <\\[cider-load-buffer-and-switch-to-repl-buffer]> to load the current buffer and switch to the REPL buffer afterwards.") "Some handy CIDER tips." ) @@ -672,6 +758,34 @@ KIND can be the symbols `ns', `var', `emph', `fn', or a face name." (t x))) menu-list)) +(defcustom cider-jdk-src-paths '("/usr/lib/jvm/openjdk-8/src.zip") + "Used by `cider-stacktrace-navigate'. +Zip/jar files work, but it's better to extract them and put the directory +paths here. Clojure sources here: +https://repo1.maven.org/maven2/org/clojure/clojure/1.8.0/." + :group 'cider + :package-version '(cider . "0.17.0") + :type '(list string)) + +(defun cider-resolve-java-class (class) + "Return a path to a Java source file that corresponds to CLASS. + +This will be a zip/jar path for archived sources and a normal +file path otherwise." + (when class + (let ((file-name (concat (replace-regexp-in-string "\\." "/" class) ".java"))) + (cl-find-if + 'file-exists-p + (mapcar + (lambda (d) + (cond ((file-directory-p d) + (expand-file-name file-name d)) + ((and (file-exists-p d) + (member (file-name-extension d) '("jar" "zip"))) + (format "zip:file:%s!/%s" d file-name)) + (t (error "Unexpected archive: %s" d)))) + cider-jdk-src-paths))))) + (provide 'cider-util) ;;; cider-util.el ends here diff --git a/elpa/cider-20181110.1413/cider.el b/elpa/cider-20181110.1413/cider.el new file mode 100644 index 00000000..0f920e7a --- /dev/null +++ b/elpa/cider-20181110.1413/cider.el @@ -0,0 +1,1452 @@ +;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- 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 +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell +;; Maintainer: Bozhidar Batsov +;; URL: http://www.github.com/clojure-emacs/cider +;; Version: 0.19.0-snapshot +;; Package-Requires: ((emacs "25") (clojure-mode "5.9") (pkg-info "0.4") (queue "0.2") (spinner "1.7") (seq "2.16") (sesman "0.3.2")) +;; Keywords: languages, clojure, cider + +;; 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 . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Provides a Clojure interactive development environment for Emacs, built on +;; top of nREPL. + +;;; Installation: + +;; Available as a package in melpa.org and stable.melpa.org + +;; (add-to-list 'package-archives +;; '("melpa" . "https://melpa.org/packages/")) +;; +;; or +;; +;; (add-to-list 'package-archives +;; '("melpa-stable" . "https://stable.melpa.org/packages/") t) +;; +;; M-x package-install cider + +;;; Usage: + +;; M-x cider-jack-in-clj +;; M-x cider-jack-in-cljs +;; +;; M-x cider-connect-sibling-clj +;; M-x cider-connect-sibling-cljs +;; +;; M-x cider-connect-clj +;; M-x cider-connect-cljs + +;;; Code: + +(defgroup cider nil + "Clojure Interactive Development Environment that Rocks." + :prefix "cider-" + :group 'applications + :link '(url-link :tag "GitHub" "https://github.com/clojure-emacs/cider") + :link '(url-link :tag "Online Manual" "https://docs.cider.mx") + :link '(emacs-commentary-link :tag "Commentary" "cider")) + +(require 'cider-client) +(require 'cider-eldoc) +(require 'cider-repl) +(require 'cider-repl-history) +(require 'cider-connection) +(require 'cider-mode) +(require 'cider-common) +(require 'cider-compat) +(require 'cider-debug) +(require 'cider-util) + +(require 'tramp-sh) +(require 'subr-x) +(require 'seq) +(require 'sesman) + +(defconst cider-version "0.19.0-snapshot" + "Fallback version used when it cannot be extracted automatically. +Normally it won't be used, unless `pkg-info' fails to extract the +version from the CIDER package or library.") + +(defconst cider-codename "Saigon" + "Codename used to denote stable releases.") + +(defcustom cider-lein-command + "lein" + "The command used to execute Leiningen." + :type 'string + :group 'cider) + +(defcustom cider-lein-global-options + nil + "Command global options used to execute Leiningen (e.g.: -o for offline)." + :type 'string + :group 'cider + :safe #'stringp) + +(defcustom cider-lein-parameters + "repl :headless :host localhost" + "Params passed to Leiningen to start an nREPL server via `cider-jack-in'." + :type 'string + :group 'cider + :safe #'stringp) + +(defcustom cider-boot-command + "boot" + "The command used to execute Boot." + :type 'string + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-boot-global-options + nil + "Command global options used to execute Boot (e.g.: -c for checkouts)." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.14.0")) + +(defcustom cider-boot-parameters + "cider.tasks/nrepl-server -b localhost wait" + "Params passed to boot to start an nREPL server via `cider-jack-in'." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.9.0")) + +(defcustom cider-clojure-cli-command + "clojure" + "The command used to execute clojure with tools.deps (requires Clojure 1.9+). +Don't use clj here, as it doesn't work when spawned from Emacs due to +it using rlwrap." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-clojure-cli-global-options + nil + "Command line options used to execute clojure with tools.deps." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-clojure-cli-parameters + "-m nrepl.cmdline --middleware '%s'" + "Params passed to clojure to start an nREPL server via `cider-jack-in'. +This is evaluated using `format', with the first argument being the Clojure +vector of middleware variables as a string." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-shadow-cljs-command + "npx shadow-cljs" + "The command used to execute shadow-cljs. + +By default we favor the project-specific shadow-cljs over the system-wide." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-shadow-cljs-global-options + "" + "Command line options used to execute shadow-cljs (e.g.: -v for verbose mode)." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-shadow-cljs-parameters + "server" + "Params passed to shadow-cljs to start an nREPL server via `cider-jack-in'." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-gradle-command + "gradle" + "The command used to execute Gradle." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.10.0")) + +(defcustom cider-gradle-global-options + "--no-daemon" + "Command line options used to execute Gradle (e.g.: -m for dry run)." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.14.0")) + +(defcustom cider-gradle-parameters + "clojureRepl" + "Params passed to gradle to start an nREPL server via `cider-jack-in'." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.10.0")) + +(define-obsolete-variable-alias 'cider-default-repl-command 'cider-jack-in-default) +(defcustom cider-jack-in-default (if (executable-find "clojure") 'clojure-cli 'lein) + "The default tool to use when doing `cider-jack-in' outside a project. +This value will only be consulted when no identifying file types, i.e. +project.clj for leiningen or build.boot for boot, could be found. + +As the Clojure CLI is bundled with Clojure itself, it's the default. +In the absence of the Clojure CLI (e.g. on Windows), we fallback +to Leiningen." + :type '(choice (const 'lein) + (const 'boot) + (const 'clojure-cli) + (const 'shadow-cljs) + (const 'gradle)) + :group 'cider + :safe #'symbolp + :package-version '(cider . "0.9.0")) + +(defcustom cider-preferred-build-tool + nil + "Allow choosing a build system when there are many. +When there are project markers from multiple build systems (e.g. lein and +boot) the user is prompted to select one of them. When non-nil, this +variable will suppress this behavior and will select whatever build system +is indicated by the variable if present. Note, this is only when CIDER +cannot decide which of many build systems to use and will never override a +command when there is no ambiguity." + :type '(choice (const 'lein) + (const 'boot) + (const 'clojure-cli) + (const 'shadow-cljs) + (const 'gradle) + (const :tag "Always ask" nil)) + :group 'cider + :safe #'symbolp + :package-version '(cider . "0.13.0")) + +(defcustom cider-allow-jack-in-without-project 'warn + "Controls what happens when doing `cider-jack-in' outside a project. +When set to 'warn you'd prompted to confirm the command. +When set to t `cider-jack-in' will quietly continue. +When set to nil `cider-jack-in' will fail." + :type '(choice (const :tag "always" t) + (const 'warn) + (const :tag "never" nil)) + :group 'cider + :safe #'stringp + :package-version '(cider . "0.15.0")) + +(defcustom cider-known-endpoints nil + "A list of connection endpoints where each endpoint is a list. +For example: \\='((\"label\" \"host\" \"port\")). +The label is optional so that \\='(\"host\" \"port\") will suffice. +This variable is used by `cider-connect'." + :type '(repeat (list (string :tag "label") + (string :tag "host") + (string :tag "port"))) + :group 'cider) + +(defcustom cider-connected-hook nil + "List of functions to call when connected to Clojure nREPL server." + :type 'hook + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-disconnected-hook nil + "List of functions to call when disconnected from the Clojure nREPL server." + :type 'hook + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-inject-dependencies-at-jack-in t + "When nil, do not inject repl dependencies (most likely nREPL middlewares) at `cider-jack-in' time." + :type 'boolean + :safe #'booleanp + :version '(cider . "0.11.0")) + +(defcustom cider-offer-to-open-cljs-app-in-browser t + "When nil, do not offer to open ClojureScript apps in a browser on connect." + :type 'boolean + :safe #'booleanp + :version '(cider . "0.15.0")) + +(defvar cider-ps-running-nrepls-command "ps u | grep leiningen" + "Process snapshot command used in `cider-locate-running-nrepl-ports'.") + +(defvar cider-ps-running-nrepl-path-regexp-list + '("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D" + "\\(?:-classpath +:?\\(.+?\\)/self-installs\\)") + "Regexp list to get project paths. +Extract project paths from output of `cider-ps-running-nrepls-command'. +Sub-match 1 must be the project path.") + +(defvar cider-host-history nil + "Completion history for connection hosts.") + +;;;###autoload +(defun cider-version () + "Display CIDER's version." + (interactive) + (message "CIDER %s" (cider--version))) + +(defun cider-jack-in-command (project-type) + "Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE." + (pcase project-type + ('lein cider-lein-command) + ('boot cider-boot-command) + ('clojure-cli cider-clojure-cli-command) + ('shadow-cljs cider-shadow-cljs-command) + ('gradle cider-gradle-command) + (_ (user-error "Unsupported project type `%S'" project-type)))) + +(defun cider-jack-in-resolve-command (project-type) + "Determine the resolved file path to `cider-jack-in-command'. +Throws an error if PROJECT-TYPE is unknown." + (pcase project-type + ('lein (cider--resolve-command cider-lein-command)) + ('boot (cider--resolve-command cider-boot-command)) + ('clojure-cli (cider--resolve-command cider-clojure-cli-command)) + ;; here we have to account for the possibility that the command is either + ;; "npx shadow-cljs" or just "shadow-cljs" + ('shadow-cljs (let ((parts (split-string cider-shadow-cljs-command))) + (when-let* ((command (cider--resolve-command (car parts)))) + (mapconcat #'identity (cons command (cdr parts)) " ")))) + ('gradle (cider--resolve-command cider-gradle-command)) + (_ (user-error "Unsupported project type `%S'" project-type)))) + +(defun cider-jack-in-global-options (project-type) + "Determine the command line options for `cider-jack-in' for the PROJECT-TYPE." + (pcase project-type + ('lein cider-lein-global-options) + ('boot cider-boot-global-options) + ('clojure-cli cider-clojure-cli-global-options) + ('shadow-cljs cider-shadow-cljs-global-options) + ('gradle cider-gradle-global-options) + (_ (user-error "Unsupported project type `%S'" project-type)))) + +(defun cider-jack-in-params (project-type) + "Determine the commands params for `cider-jack-in' for the PROJECT-TYPE." + (pcase project-type + ('lein cider-lein-parameters) + ('boot cider-boot-parameters) + ('clojure-cli (format cider-clojure-cli-parameters + (concat + "[" + (mapconcat + (apply-partially #'format "\"%s\"") + (cider-jack-in-normalized-nrepl-middlewares) + ", ") + "]"))) + ('shadow-cljs cider-shadow-cljs-parameters) + ('gradle cider-gradle-parameters) + (_ (user-error "Unsupported project type `%S'" project-type)))) + + +;;; Jack-in dependencies injection +(defvar cider-jack-in-dependencies nil + "List of dependencies where elements are lists of artifact name and version.") +(put 'cider-jack-in-dependencies 'risky-local-variable t) +;; We inject the newest known version of nREPL just in case +;; your version of Boot or Leiningen is bundling an older one. +(cider-add-to-alist 'cider-jack-in-dependencies + "nrepl" "0.4.5") + +(defvar cider-jack-in-cljs-dependencies nil + "List of dependencies where elements are lists of artifact name and version. +Added to `cider-jack-in-dependencies' when doing `cider-jack-in-cljs'.") +(put 'cider-jack-in-cljs-dependencies 'risky-local-variable t) +(cider-add-to-alist 'cider-jack-in-cljs-dependencies "cider/piggieback" "0.3.10") + +(defvar cider-jack-in-dependencies-exclusions nil + "List of exclusions for jack in dependencies. +Elements of the list are artifact name and list of exclusions to apply for the artifact.") +(put 'cider-jack-in-dependencies-exclusions 'risky-local-variable t) +(cider-add-to-alist 'cider-jack-in-dependencies-exclusions + "org.clojure/tools.nrepl" '("org.clojure/clojure")) + +(defconst cider-clojure-artifact-id "org.clojure/clojure" + "Artifact identifier for Clojure.") + +(defconst cider-minimum-clojure-version "1.8.0" + "Minimum supported version of Clojure.") + +(defconst cider-latest-clojure-version "1.10.0" + "Latest supported version of Clojure.") + +(defconst cider-required-middleware-version "0.18.0" + "The minimum CIDER nREPL version that's known to work properly with CIDER.") + +(defconst cider-latest-middleware-version "0.19.0-SNAPSHOT" + "The latest CIDER nREPL version that's known to work properly with CIDER.") + +(defcustom cider-jack-in-auto-inject-clojure nil + "Version of clojure to auto-inject into REPL. +If nil, do not inject Clojure into the REPL. If `latest', inject +`cider-latest-clojure-version', which should approximate to the most recent +version of Clojure. If `minimal', inject `cider-minimum-clojure-version', +which will be the lowest version CIDER supports. If a string, use this as +the version number. If it is a list, the first element should be a string, +specifying the artifact ID, and the second element the version number." + :type '(choice (const :tag "None" nil) + (const :tag "Latest" 'latest) + (const :tag "Minimal" 'minimal) + (string :tag "Specific Version") + (list :tag "Artifact ID and Version" + (string :tag "Artifact ID") + (string :tag "Version")))) + +(defvar cider-jack-in-lein-plugins nil + "List of Leiningen plugins to be injected at jack-in. +Each element is a list of artifact name and version, followed optionally by +keyword arguments. The only keyword argument currently accepted is +`:predicate', which should be given a function that takes the list (name, +version, and keyword arguments) and returns non-nil to indicate that the +plugin should actually be injected. (This is useful primarily for packages +that extend CIDER, not for users. For example, a refactoring package might +want to inject some middleware only when within a project context.)") +(put 'cider-jack-in-lein-plugins 'risky-local-variable t) +(cider-add-to-alist 'cider-jack-in-lein-plugins + "cider/cider-nrepl" cider-latest-middleware-version) + +(defvar cider-jack-in-cljs-lein-plugins nil + "List of Leiningen plugins to be injected at jack-in. +Added to `cider-jack-in-lein-plugins' (which see) when doing +`cider-jack-in-cljs'.") +(put 'cider-jack-in-cljs-lein-plugins 'risky-local-variable t) + +(defun cider-jack-in-normalized-lein-plugins () + "Return a normalized list of Leiningen plugins to be injected. +See `cider-jack-in-lein-plugins' for the format, except that the list +returned by this function does not include keyword arguments." + (thread-last cider-jack-in-lein-plugins + (seq-filter + (lambda (spec) + (if-let* ((pred (plist-get (seq-drop spec 2) :predicate))) + (funcall pred spec) + t))) + (mapcar + (lambda (spec) + (seq-take spec 2))))) + +(defvar cider-jack-in-nrepl-middlewares nil + "List of Clojure variable names. +Each of these Clojure variables should hold a vector of nREPL middlewares. +Instead of a string, an element can be a list containing a string followed +by optional keyword arguments. The only keyword argument currently +accepted is `:predicate', which should be given a function that takes the +list (string and keyword arguments) and returns non-nil to indicate that +the middlewares should actually be injected.") +(put 'cider-jack-in-nrepl-middlewares 'risky-local-variable t) +(add-to-list 'cider-jack-in-nrepl-middlewares "cider.nrepl/cider-middleware") + +(defvar cider-jack-in-cljs-nrepl-middlewares nil + "List of Clojure variable names. +Added to `cider-jack-in-nrepl-middlewares' (which see) when doing +`cider-jack-in-cljs'.") +(put 'cider-jack-in-cljs-nrepl-middlewares 'risky-local-variable t) +(add-to-list 'cider-jack-in-cljs-nrepl-middlewares "cider.piggieback/wrap-cljs-repl") + +(defun cider-jack-in-normalized-nrepl-middlewares () + "Return a normalized list of middleware variable names. +See `cider-jack-in-nrepl-middlewares' for the format, except that the list +returned by this function only contains strings." + (thread-last cider-jack-in-nrepl-middlewares + (seq-filter + (lambda (spec) + (or (not (listp spec)) + (if-let* ((pred (plist-get (cdr spec) :predicate))) + (funcall pred spec) + t)))) + (mapcar + (lambda (spec) + (if (listp spec) + (car spec) + spec))))) + +(defun cider--list-as-boot-artifact (list) + "Return a boot artifact string described by the elements of LIST. +LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). The returned +string is quoted for passing as argument to an inferior shell." + (concat "-d " (shell-quote-argument (format "%s:%s" (car list) (cadr list))))) + +(defun cider-boot-dependencies (dependencies) + "Return a list of boot artifact strings created from DEPENDENCIES." + (concat (mapconcat #'cider--list-as-boot-artifact dependencies " ") + (unless (seq-empty-p dependencies) " "))) + +(defun cider-boot-middleware-task (params middlewares) + "Create a command to add MIDDLEWARES with corresponding PARAMS." + (concat "cider.tasks/add-middleware " + (mapconcat (lambda (middleware) + (format "-m %s" (shell-quote-argument middleware))) + middlewares + " ") + " " params)) + +(defun cider-boot-jack-in-dependencies (global-opts params dependencies plugins middlewares) + "Create boot jack-in dependencies. +Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, +PLUGINS and MIDDLEWARES. PARAMS and MIDDLEWARES are passed on to +`cider-boot-middleware-task` before concatenating and DEPENDENCIES and PLUGINS + are passed on to `cider-boot-dependencies`." + (concat global-opts + (unless (seq-empty-p global-opts) " ") + "-i \"(require 'cider.tasks)\" " ;; Note the space at the end here + (cider-boot-dependencies (append dependencies plugins)) + (cider-boot-middleware-task params middlewares))) + +(defun cider--lein-artifact-exclusions (exclusions) + "Return an exclusions vector described by the elements of EXCLUSIONS." + (if exclusions + (format " :exclusions [%s]" (mapconcat #'identity exclusions " ")) + "")) + +(defun cider--list-as-lein-artifact (list &optional exclusions) + "Return an artifact string described by the elements of LIST. +LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). Optionally a list +of EXCLUSIONS can be provided as well. The returned +string is quoted for passing as argument to an inferior shell." + (shell-quote-argument (format "[%s %S%s]" (car list) (cadr list) (cider--lein-artifact-exclusions exclusions)))) + +(defun cider-lein-jack-in-dependencies (global-opts params dependencies dependencies-exclusions lein-plugins) + "Create lein jack-in dependencies. +Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, with DEPENDENCIES-EXCLUSIONS +removed, LEIN-PLUGINS, and finally PARAMS." + (concat + global-opts + (unless (seq-empty-p global-opts) " ") + (mapconcat #'identity + (append (seq-map (lambda (dep) + (let ((exclusions (cadr (assoc (car dep) dependencies-exclusions)))) + (concat "update-in :dependencies conj " + (cider--list-as-lein-artifact dep exclusions)))) + dependencies) + (seq-map (lambda (plugin) + (concat "update-in :plugins conj " + (cider--list-as-lein-artifact plugin))) + lein-plugins)) + " -- ") + " -- " + params)) + +(defun cider-clojure-cli-jack-in-dependencies (global-opts params dependencies) + "Create Clojure tools.deps jack-in dependencies. +Does so by concatenating GLOBAL-OPTS, DEPENDENCIES finally PARAMS." + (let ((dependencies (append dependencies cider-jack-in-lein-plugins))) + (concat + global-opts + (unless (seq-empty-p global-opts) " ") + "-Sdeps '{:deps {" + (mapconcat #'identity + (seq-map (lambda (dep) (format "%s {:mvn/version \"%s\"}" (car dep) (cadr dep))) dependencies) + " ") + "}}' " + params))) + +(defun cider-shadow-cljs-jack-in-dependencies (global-opts params dependencies) + "Create shadow-cljs jack-in deps. +Does so by concatenating GLOBAL-OPTS, DEPENDENCIES finally PARAMS." + (let ((dependencies (append dependencies cider-jack-in-lein-plugins))) + (concat + global-opts + (unless (seq-empty-p global-opts) " ") + (mapconcat #'identity + (seq-map (lambda (dep) (format "-d %s:%s" (car dep) (cadr dep))) dependencies) + " ") + " " + params))) + +(defun cider-add-clojure-dependencies-maybe (dependencies) + "Return DEPENDENCIES with an added Clojure dependency if requested. +See also `cider-jack-in-auto-inject-clojure'." + (if cider-jack-in-auto-inject-clojure + (if (consp cider-jack-in-auto-inject-clojure) + (cons cider-jack-in-auto-inject-clojure dependencies) + (cons (list cider-clojure-artifact-id + (cond + ((stringp cider-jack-in-auto-inject-clojure) + cider-jack-in-auto-inject-clojure) + ((eq cider-jack-in-auto-inject-clojure 'minimal) + cider-minimum-clojure-version) + ((eq cider-jack-in-auto-inject-clojure 'latest) + cider-latest-clojure-version))) + dependencies)) + dependencies)) + +(defun cider-inject-jack-in-dependencies (global-opts params project-type) + "Return GLOBAL-OPTS and PARAMS with injected REPL dependencies. +These are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' and +`cider-jack-in-nrepl-middlewares' are injected from the CLI according to +the used PROJECT-TYPE. Eliminates the need for hacking profiles.clj or the +boot script for supporting cider with its nREPL middleware and +dependencies." + (pcase project-type + ('lein (cider-lein-jack-in-dependencies + global-opts + params + (cider-add-clojure-dependencies-maybe + cider-jack-in-dependencies) + cider-jack-in-dependencies-exclusions + (cider-jack-in-normalized-lein-plugins))) + ('boot (cider-boot-jack-in-dependencies + global-opts + params + (cider-add-clojure-dependencies-maybe + cider-jack-in-dependencies) + (cider-jack-in-normalized-lein-plugins) + (cider-jack-in-normalized-nrepl-middlewares))) + ('clojure-cli (cider-clojure-cli-jack-in-dependencies + global-opts + params + (cider-add-clojure-dependencies-maybe + cider-jack-in-dependencies))) + ('shadow-cljs (cider-shadow-cljs-jack-in-dependencies + global-opts + params + (cider-add-clojure-dependencies-maybe + cider-jack-in-dependencies))) + ('gradle (concat + global-opts + (unless (seq-empty-p global-opts) " ") + params)) + (_ (error "Unsupported project type `%S'" project-type)))) + + +;;; ClojureScript REPL creation + +(defcustom cider-check-cljs-repl-requirements t + "When non-nil will run the requirement checks for the different cljs repls. +Generally you should not disable this unless you run into some faulty check." + :type 'boolean + :safe #'booleanp + :package-version '(cider . "0.17.0")) + +(defun cider-verify-clojurescript-is-present () + "Check whether ClojureScript is present." + (unless (cider-library-present-p "clojure/clojurescript") + (user-error "ClojureScript is not available. See https://docs.cider.mx/en/latest/clojurescript for details"))) + +(defun cider-verify-piggieback-is-present () + "Check whether the piggieback middleware is present." + (unless (cider-library-present-p "cider/piggieback") + (user-error "Piggieback 0.3.x (aka cider/piggieback) is not available. See https://docs.cider.mx/en/latest/clojurescript for details"))) + +(defun cider-check-nashorn-requirements () + "Check whether we can start a Nashorn ClojureScript REPL." + (cider-verify-piggieback-is-present)) + +(defun cider-check-node-requirements () + "Check whether we can start a Node ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (executable-find "node") + (user-error "Node.js is not present on the exec-path. Make sure you've installed it and your exec-path is properly set"))) + +(defun cider-check-figwheel-requirements () + "Check whether we can start a Figwheel ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (cider-library-present-p "figwheel-sidecar/figwheel-sidecar") + (user-error "Figwheel-sidecar is not available. Please check https://docs.cider.mx/en/latest/clojurescript"))) + +(defun cider-check-figwheel-main-requirements () + "Check whether we can start a Figwheel ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (cider-library-present-p "bhauman/figwheel-main") + (user-error "Figwheel-main is not available. Please check https://docs.cider.mx/en/latest/clojurescript"))) + +(defun cider-check-weasel-requirements () + "Check whether we can start a Weasel ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (cider-library-present-p "weasel/weasel") + (user-error "Weasel in not available. Please check https://docs.cider.mx/en/latest/clojurescript/#browser-connected-clojurescript-repl"))) + +(defun cider-check-boot-requirements () + "Check whether we can start a Boot ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (cider-library-present-p "adzerk/boot-cljs-repl") + (user-error "The Boot ClojureScript REPL is not available. Please check https://github.com/adzerk-oss/boot-cljs-repl/blob/master/README.md"))) + +(defun cider-check-shadow-cljs-requirements () + "Check whether we can start a shadow-cljs REPL." + (unless (cider-library-present-p "thheller/shadow-cljs") + (user-error "The shadow-cljs ClojureScript REPL is not available"))) + +(defun cider-normalize-cljs-init-options (options) + "Normalize the OPTIONS string used for initializing a ClojureScript REPL." + (if (or (string-prefix-p "{" options) + (string-prefix-p "(" options) + (string-prefix-p "[" options) + (string-prefix-p ":" options)) + options + (concat ":" options))) + +(defcustom cider-shadow-default-options nil + "Defines default `shadow-cljs' options." + :type 'string + :safe (lambda (s) (or (null s) (stringp s))) + :package-version '(cider . "0.18.0")) + +(defun cider-shadow-select-cljs-init-form () + "Generate the init form for a shadow-cljs select-only REPL. +We have to prompt the user to select a build, that's why this is a command, +not just a string." + (let ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/nrepl-select %s))") + (options (or cider-shadow-default-options + (read-from-minibuffer "Select shadow-cljs build (e.g. dev): ")))) + (format form (cider-normalize-cljs-init-options options)))) + +(defun cider-shadow-cljs-init-form () + "Generate the init form for a shadow-cljs REPL. +We have to prompt the user to select a build, that's why +this is a command, not just a string." + (let* ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/watch %s) (shadow/nrepl-select %s))") + (options (or cider-shadow-default-options + (read-from-minibuffer "Select shadow-cljs build (e.g. dev): "))) + (build (cider-normalize-cljs-init-options options))) + (format form build build))) + +(defcustom cider-figwheel-main-default-options nil + "Defines the `figwheel.main/start' options. + +Note that figwheel-main/start can also accept a map of options, refer to +Figwheel for details." + :type 'string + :safe (lambda (s) (or (null s) (stringp s))) + :package-version '(cider . "0.18.0")) + +(defun cider-figwheel-main-init-form () + "Produce the figwheel-main ClojureScript init form." + (let ((form "(do (require 'figwheel.main) (figwheel.main/start %s))") + (options (string-trim + (or cider-figwheel-main-default-options + (read-from-minibuffer "Select figwheel-main build (e.g. :dev): "))))) + (format form (cider-normalize-cljs-init-options options)))) + +(defun cider-custom-cljs-repl-init-form () + "Prompt for a form that would start a ClojureScript REPL. +The supplied string will be wrapped in a do form if needed." + (let ((form (read-from-minibuffer "Please, provide a form to start a ClojureScript REPL: "))) + ;; TODO: We should probably make this more robust (e.g. by using a regexp or + ;; parsing the form). + (if (string-prefix-p "(do" form) + form + (format "(do %s)" form)))) + +(defvar cider-cljs-repl-types + '((nashorn "(do (require 'cljs.repl.nashorn) (cider.piggieback/cljs-repl (cljs.repl.nashorn/repl-env)))" + cider-check-nashorn-requirements) + (figwheel "(do (require 'figwheel-sidecar.repl-api) (figwheel-sidecar.repl-api/start-figwheel!) (figwheel-sidecar.repl-api/cljs-repl))" + cider-check-figwheel-requirements) + (figwheel-main cider-figwheel-main-init-form cider-check-figwheel-main-requirements) + (node "(do (require 'cljs.repl.node) (cider.piggieback/cljs-repl (cljs.repl.node/repl-env)))" + cider-check-node-requirements) + (weasel "(do (require 'weasel.repl.websocket) (cider.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \"127.0.0.1\" :port 9001)))" + cider-check-weasel-requirements) + (boot "(do (require 'adzerk.boot-cljs-repl) (adzerk.boot-cljs-repl/start-repl))" + cider-check-boot-requirements) + (shadow cider-shadow-cljs-init-form cider-check-shadow-cljs-requirements) + (shadow-select cider-shadow-select-cljs-init-form cider-check-shadow-cljs-requirements) + (custom cider-custom-cljs-repl-init-form nil)) + "A list of supported ClojureScript REPLs. + +For each one we have its name, the form we need to evaluate in a Clojure +REPL to start the ClojureScript REPL and functions to very their requirements. + +The form should be either a string or a function producing a string.") + +(defun cider-register-cljs-repl-type (type init-form &optional requirements-fn) + "Register a new ClojureScript REPL type. + +Types are defined by the following: + +- TYPE - symbol identifier that will be used to refer to the REPL type +- INIT-FORM - string or function (symbol) producing string +- REQUIREMENTS-FN - function to check whether the REPL can be started. +This param is optional. + +All this function does is modifying `cider-cljs-repl-types'. +It's intended to be used in your Emacs config." + (unless (symbolp type) + (user-error "The REPL type must be a symbol")) + (unless (or (stringp init-form) (symbolp init-form)) + (user-error "The init form must be a string or a symbol referring to a function")) + (unless (or (null requirements-fn) (symbolp requirements-fn)) + (user-error "The requirements-fn must be a symbol referring to a function")) + (add-to-list 'cider-cljs-repl-types (list type init-form requirements-fn))) + +(defcustom cider-default-cljs-repl nil + "The default ClojureScript REPL to start. +This affects commands like `cider-jack-in-cljs'. Generally it's +intended to be set via .dir-locals.el for individual projects, as its +relatively unlikely you'd like to use the same type of REPL in each project +you're working on." + :type '(choice (const :tag "Nashorn" nashorn) + (const :tag "Figwheel" figwheel) + (const :tag "Figwheel Main" figwheel-main) + (const :tag "Node" node) + (const :tag "Weasel" weasel) + (const :tag "Boot" boot) + (const :tag "Shadow" shadow) + (const :tag "Shadow w/o Server" shadow-select) + (const :tag "Custom" custom)) + :group 'cider + :safe #'symbolp + :package-version '(cider . "0.17.0")) + +(make-obsolete-variable 'cider-cljs-lein-repl 'cider-default-cljs-repl "0.17") +(make-obsolete-variable 'cider-cljs-boot-repl 'cider-default-cljs-repl "0.17") +(make-obsolete-variable 'cider-cljs-gradle-repl 'cider-default-cljs-repl "0.17") + +(defvar cider--select-cljs-repl-history nil) +(defun cider-select-cljs-repl (&optional default) + "Select the ClojureScript REPL to use with `cider-jack-in-cljs'. +DEFAULT is the default ClojureScript REPL to offer in completion." + (let ((repl-types (mapcar #'car cider-cljs-repl-types))) + (intern (completing-read "Select ClojureScript REPL type: " repl-types + nil nil nil 'cider--select-cljs-repl-history + (or default (car cider--select-cljs-repl-history)))))) + +(defun cider-cljs-repl-form (repl-type) + "Get the cljs REPL form for REPL-TYPE." + (if-let* ((repl-form (cadr (seq-find + (lambda (entry) + (eq (car entry) repl-type)) + cider-cljs-repl-types)))) + ;; repl-form can be either a string or a function producing a string + (if (symbolp repl-form) + (funcall repl-form) + repl-form) + (user-error "No ClojureScript REPL type %s found. Please make sure that `cider-cljs-repl-types' has an entry for it" repl-type))) + +(defun cider-verify-cljs-repl-requirements (&optional repl-type) + "Verify that the requirements for REPL-TYPE are met. +Return REPL-TYPE if requirements are met." + (let ((repl-type (or repl-type + cider-default-cljs-repl + (cider-select-cljs-repl)))) + (when cider-check-cljs-repl-requirements + (when-let* ((fun (nth 2 (seq-find + (lambda (entry) + (eq (car entry) repl-type)) + cider-cljs-repl-types)))) + (funcall fun))) + repl-type)) + +(defun cider--check-cljs (&optional cljs-type no-error) + "Verify that all cljs requirements are met for CLJS-TYPE connection. +Return REPL-TYPE of requirement are met, and throw an ‘user-error’ otherwise. +When NO-ERROR is non-nil, don't throw an error, issue a message and return +nil." + (if no-error + (condition-case ex + (progn + (cider-verify-clojurescript-is-present) + (cider-verify-cljs-repl-requirements cljs-type)) + (error + (message "Invalid ClojureScript dependency: %S" ex) + nil)) + (cider-verify-clojurescript-is-present) + (cider-verify-cljs-repl-requirements cljs-type))) + +(defun cider--offer-to-open-app-in-browser (server-buffer) + "Look for a server address in SERVER-BUFFER and offer to open it." + (when (buffer-live-p server-buffer) + (with-current-buffer server-buffer + (save-excursion + (goto-char (point-min)) + (when-let* ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror) + (match-string 0)))) + (when (y-or-n-p (format "Visit ‘%s’ in a browser? " url)) + (browse-url url))))))) + + +;;; User Level Connectors + +;;;###autoload (autoload 'cider-start-map "cider" "CIDER jack-in and connect keymap." t 'keymap) +(defvar cider-start-map + (let ((map (define-prefix-command 'cider-start-map))) + (define-key map (kbd "x") #'cider) + (define-key map (kbd "C-x") #'cider) + (define-key map (kbd "j j") #'cider-jack-in-clj) + (define-key map (kbd "j s") #'cider-jack-in-cljs) + (define-key map (kbd "j m") #'cider-jack-in-clj&cljs) + (define-key map (kbd "C-j j") #'cider-jack-in-clj) + (define-key map (kbd "C-j s") #'cider-jack-in-cljs) + (define-key map (kbd "C-j m") #'cider-jack-in-clj&cljs) + (define-key map (kbd "C-j C-j") #'cider-jack-in-clj) + (define-key map (kbd "C-j C-s") #'cider-jack-in-cljs) + (define-key map (kbd "C-j C-m") #'cider-jack-in-clj&cljs) + (define-key map (kbd "c j") #'cider-connect-clj) + (define-key map (kbd "c s") #'cider-connect-cljs) + (define-key map (kbd "c m") #'cider-connect-clj&cljs) + (define-key map (kbd "C-c j") #'cider-connect-clj) + (define-key map (kbd "C-c s") #'cider-connect-cljs) + (define-key map (kbd "C-c m") #'cider-connect-clj&cljs) + (define-key map (kbd "C-c C-j") #'cider-connect-clj) + (define-key map (kbd "C-c C-s") #'cider-connect-cljs) + (define-key map (kbd "C-c C-m") #'cider-connect-clj&cljs) + (define-key map (kbd "s j") #'cider-connect-sibling-clj) + (define-key map (kbd "s s") #'cider-connect-sibling-cljs) + (define-key map (kbd "C-s j") #'cider-connect-sibling-clj) + (define-key map (kbd "C-s s") #'cider-connect-sibling-cljs) + (define-key map (kbd "C-s C-j") #'cider-connect-sibling-clj) + (define-key map (kbd "C-s C-s") #'cider-connect-sibling-cljs) + map) + "CIDER jack-in and connect keymap.") + +;;;###autoload +(defun cider-jack-in-clj (params) + "Start an nREPL server for the current project and connect to it. +PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. +With the prefix argument, prompt for all these parameters." + (interactive "P") + (let ((params (thread-first params + (cider--update-project-dir) + (cider--check-existing-session) + (cider--update-jack-in-cmd)))) + (nrepl-start-server-process + (plist-get params :project-dir) + (plist-get params :jack-in-cmd) + (lambda (server-buffer) + (cider-connect-sibling-clj params server-buffer))))) + +;;;###autoload +(defun cider-jack-in-cljs (params) + "Start an nREPL server for the current project and connect to it. +PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and +:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, +prompt for all these parameters." + (interactive "P") + (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) + (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) + (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) + (orig-buffer (current-buffer))) + ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars + (let ((params (thread-first params + (cider--update-project-dir) + (cider--check-existing-session) + (cider--update-jack-in-cmd)))) + (nrepl-start-server-process + (plist-get params :project-dir) + (plist-get params :jack-in-cmd) + (lambda (server-buffer) + (with-current-buffer orig-buffer + (cider-connect-sibling-cljs params server-buffer))))))) + +;;;###autoload +(defun cider-jack-in-clj&cljs (&optional params soft-cljs-start) + "Start an nREPL server and connect with clj and cljs REPLs. +PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and +:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, +prompt for all these parameters. When SOFT-CLJS-START is non-nil, start +cljs REPL only when the ClojureScript dependencies are met." + (interactive "P") + (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) + (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) + (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) + (orig-buffer (current-buffer))) + ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars + (let ((params (thread-first params + (cider--update-project-dir) + (cider--check-existing-session) + (cider--update-jack-in-cmd) + (cider--update-cljs-type) + ;; already asked, don't ask on sibling connect + (plist-put :do-prompt nil)))) + (nrepl-start-server-process + (plist-get params :project-dir) + (plist-get params :jack-in-cmd) + (lambda (server-buffer) + (with-current-buffer orig-buffer + (let ((clj-repl (cider-connect-sibling-clj params server-buffer))) + (if soft-cljs-start + (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) + (cider-connect-sibling-cljs params clj-repl)) + (cider-connect-sibling-cljs params clj-repl))))))))) + +;;;###autoload +(defun cider-connect-sibling-clj (params &optional other-repl) + "Create a Clojure REPL with the same server as OTHER-REPL. +PARAMS is for consistency with other connection commands and is currently +ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can +also be a server buffer, in which case a new session with a REPL for that +server is created." + (interactive "P") + (cider-nrepl-connect + (let* ((other-repl (or other-repl (cider-current-repl nil 'ensure))) + (other-params (cider--gather-connect-params nil other-repl)) + (ses-name (unless (nrepl-server-p other-repl) + (sesman-session-name-for-object 'CIDER other-repl)))) + (thread-first params + (cider--update-do-prompt) + (append other-params) + (plist-put :repl-init-function nil) + (plist-put :repl-type "clj") + (plist-put :session-name ses-name))))) + +;;;###autoload +(defun cider-connect-sibling-cljs (params &optional other-repl) + "Create a ClojureScript REPL with the same server as OTHER-REPL. +PARAMS is a plist optionally containing :cljs-repl-type (e.g. Node, +Figwheel, etc). All other parameters are inferred from the OTHER-REPL. +OTHER-REPL defaults to `cider-current-repl' but in programs can also be a +server buffer, in which case a new session for that server is created." + (interactive "P") + (let* ((other-repl (or other-repl (cider-current-repl nil 'ensure))) + (other-params (cider--gather-connect-params nil other-repl)) + (ses-name (unless (nrepl-server-p other-repl) + (sesman-session-name-for-object 'CIDER other-repl)))) + (cider-nrepl-connect + (thread-first params + (cider--update-do-prompt) + (append other-params) + (cider--update-cljs-type) + (cider--update-cljs-init-function) + (plist-put :session-name ses-name) + (plist-put :repl-type "pending-cljs"))))) + +;;;###autoload +(defun cider-connect-clj (&optional params) + "Initialize a Clojure connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port and :project-dir. On +prefix argument, prompt for all the parameters." + (interactive "P") + (cider-nrepl-connect + (thread-first params + (cider--update-project-dir) + (cider--update-host-port) + (cider--check-existing-session) + (plist-put :repl-init-function nil) + (plist-put :session-name nil) + (plist-put :repl-type "clj")))) + +;;;###autoload +(defun cider-connect-cljs (&optional params) + "Initialize a ClojureScript connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port, :project-dir and +:cljs-repl-type (e.g. Node, Figwheel, etc). On prefix, prompt for all the +parameters regardless of their supplied or default values." + (interactive "P") + (cider-nrepl-connect + (thread-first params + (cider--update-project-dir) + (cider--update-host-port) + (cider--check-existing-session) + (cider--update-cljs-type) + (cider--update-cljs-init-function) + (plist-put :session-name nil) + (plist-put :repl-type "pending-cljs")))) + +;;;###autoload +(defun cider-connect-clj&cljs (params &optional soft-cljs-start) + "Initialize a Clojure and ClojureScript connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port, :project-dir and +:cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is +non-nil, don't start if ClojureScript requirements are not met." + (interactive "P") + (let* ((params (thread-first params + (cider--update-project-dir) + (cider--update-host-port) + (cider--check-existing-session) + (cider--update-cljs-type))) + (clj-repl (cider-connect-clj params))) + (if soft-cljs-start + (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) + (cider-connect-sibling-cljs params clj-repl)) + (cider-connect-sibling-cljs params clj-repl)))) + +(defvar cider-connection-init-commands + '(cider-jack-in-clj + cider-jack-in-cljs + cider-jack-in-clj&cljs + cider-connect-clj + cider-connect-cljs + cider-connect-clj&cljs + cider-connect-sibling-clj + cider-connect-sibling-cljs) + "A list of all user-level connection init commands in CIDER.") + +;;;###autoload +(defun cider () + "Start a connection of any type interactively." + (interactive) + (when-let* ((command (intern (completing-read "Select command: " cider-connection-init-commands)))) + (call-interactively command))) + + +;;; PARAMS updating + +(defun cider--update-do-prompt (params) + "Update :do-prompt in PARAMS." + (if (equal params '(4)) + (list :do-prompt t) + params)) + +(defun cider--update-project-dir (params) + "Update :project-dir in PARAMS." + (let* ((params (cider--update-do-prompt params)) + (proj-dir (if (plist-get params :do-prompt) + (read-directory-name "Project: " + (clojure-project-dir (cider-current-dir))) + (plist-get params :project-dir))) + (orig-buffer (current-buffer))) + (if (or (null proj-dir) + (file-in-directory-p default-directory proj-dir)) + (plist-put params :project-dir + (or proj-dir + (clojure-project-dir (cider-current-dir)))) + ;; If proj-dir is not a parent of default-directory, transfer all local + ;; variables and hack dir-local variables into a temporary buffer and keep + ;; that buffer within `params` for the later use by other --update- + ;; functions. The context buffer should not be used outside of the param + ;; initialization pipeline. Therefore, we don't bother with making it + ;; unique or killing it anywhere. + (let ((context-buf-name " *cider-context-buffer*")) + (when (get-buffer context-buf-name) + (kill-buffer context-buf-name)) + (with-current-buffer (get-buffer-create context-buf-name) + (dolist (pair (buffer-local-variables orig-buffer)) + (pcase pair + (`(,name . ,value) ;ignore unbound variables + (ignore-errors (set (make-local-variable name) value)))) + (setq-local buffer-file-name nil)) + (let ((default-directory proj-dir)) + (hack-dir-local-variables-non-file-buffer) + (thread-first params + (plist-put :project-dir proj-dir) + (plist-put :--context-buffer (current-buffer))))))))) + +(defun cider--update-cljs-type (params) + "Update :cljs-repl-type in PARAMS." + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let ((params (cider--update-do-prompt params)) + (inferred-type (or (plist-get params :cljs-repl-type) + cider-default-cljs-repl))) + (plist-put params :cljs-repl-type + (if (plist-get params :do-prompt) + (cider-select-cljs-repl inferred-type) + (or inferred-type + (cider-select-cljs-repl))))))) + +(defun cider--update-jack-in-cmd (params) + "Update :jack-in-cmd key in PARAMS." + (let* ((params (cider--update-do-prompt params)) + (project-dir (plist-get params :project-dir)) + (project-type (cider-project-type project-dir)) + (command (cider-jack-in-command project-type)) + (command-resolved (cider-jack-in-resolve-command project-type)) + (command-global-opts (cider-jack-in-global-options project-type)) + (command-params (cider-jack-in-params project-type))) + (if command-resolved + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let* ((command-params (if (plist-get params :do-prompt) + (read-string (format "nREPL server command: %s " command-params) + command-params) + command-params)) + (cmd-params (if cider-inject-dependencies-at-jack-in + (cider-inject-jack-in-dependencies command-global-opts command-params project-type) + command-params))) + (if (or project-dir cider-allow-jack-in-without-project) + (when (or project-dir + (eq cider-allow-jack-in-without-project t) + (and (null project-dir) + (eq cider-allow-jack-in-without-project 'warn) + (y-or-n-p "Are you sure you want to run `cider-jack-in' without a Clojure project? "))) + (let* ((cmd (format "%s %s" command-resolved cmd-params))) + (plist-put params :jack-in-cmd cmd))) + (user-error "`cider-jack-in' is not allowed without a Clojure project")))) + (user-error "The %s executable isn't on your `exec-path'" command)))) + +(defun cider--update-host-port (params) + "Update :host and :port in PARAMS." + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let* ((params (cider--update-do-prompt params)) + (host (plist-get params :host)) + (port (plist-get params :port)) + (endpoint (if (plist-get params :do-prompt) + (cider-select-endpoint) + (if (and host port) + (cons host port) + (cider-select-endpoint))))) + (thread-first params + (plist-put :host (car endpoint)) + (plist-put :port (cdr endpoint)))))) + +(defun cider--update-cljs-init-function (params) + "Update PARAMS :repl-init-function for cljs connections." + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let ((cljs-type (plist-get params :cljs-repl-type))) + (plist-put params :repl-init-function + (lambda () + (cider--check-cljs cljs-type) + ;; FIXME: ideally this should be done in the state handler + (setq-local cider-cljs-repl-type cljs-type) + (cider-nrepl-send-request + (list "op" "eval" + "ns" (cider-current-ns) + "code" (cider-cljs-repl-form cljs-type)) + (cider-repl-handler (current-buffer))) + (when (and (buffer-live-p nrepl-server-buffer) + cider-offer-to-open-cljs-app-in-browser) + (cider--offer-to-open-app-in-browser nrepl-server-buffer))))))) + +(defun cider--check-existing-session (params) + "Ask for confirmation if a session with similar PARAMS already exists. +If no session exists or user chose to proceed, return PARAMS. If the user +canceled the action, signal quit." + (let* ((proj-dir (plist-get params :project-dir)) + (host (plist-get params :host)) + (port (plist-get params :port)) + (session (seq-find (lambda (ses) + (let ((ses-params (cider--gather-session-params ses))) + (and (equal proj-dir (plist-get ses-params :project-dir)) + (or (null port) + (equal port (plist-get ses-params :port))) + (or (null host) + (equal host (plist-get ses-params :host)))))) + (sesman-current-sessions 'CIDER '(project))))) + (when session + (unless (y-or-n-p + (concat + "A session with the same parameters exists (" (car session) "). " + "You can connect a sibling instead. Proceed? ")) + (let ((debug-on-quit nil)) + (signal 'quit nil))))) + params) + + +;;; Aliases + + ;;;###autoload +(defalias 'cider-jack-in #'cider-jack-in-clj) + ;;;###autoload +(defalias 'cider-jack-in-clojure #'cider-jack-in-clj) +;;;###autoload +(defalias 'cider-jack-in-clojurescript #'cider-jack-in-cljs) + +;;;###autoload +(defalias 'cider-connect #'cider-connect-clj) +;;;###autoload +(defalias 'cider-connect-clojure #'cider-connect-clj) +;;;###autoload +(defalias 'cider-connect-clojurescript #'cider-connect-cljs) + +;;;###autoload +(defalias 'cider-connect-sibling-clojure #'cider-connect-sibling-clj) +;;;###autoload +(defalias 'cider-connect-sibling-clojurescript #'cider-connect-sibling-cljs) + + +;;; Helpers + +(defun cider-current-host () + "Retrieve the current host." + (or (when (stringp buffer-file-name) + (file-remote-p buffer-file-name 'host)) + "localhost")) + +(defun cider-select-endpoint () + "Interactively select the host and port to connect to." + (dolist (endpoint cider-known-endpoints) + (unless (stringp (or (nth 2 endpoint) + (nth 1 endpoint))) + (user-error "The port for %s in `cider-known-endpoints' should be a string" + (nth 0 endpoint)))) + (let* ((ssh-hosts (cider--ssh-hosts)) + (hosts (seq-uniq (append (when cider-host-history + ;; history elements are strings of the form "host:port" + (list (split-string (car cider-host-history) ":"))) + (list (list (cider-current-host))) + cider-known-endpoints + ssh-hosts + ;; always add localhost + '(("localhost"))))) + (sel-host (cider--completing-read-host hosts)) + (host (car sel-host)) + (port (or (cadr sel-host) + (cider--completing-read-port host (cider--infer-ports host ssh-hosts))))) + (cons host port))) + +(defun cider--ssh-hosts () + "Retrieve all ssh host from local configuration files." + (seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s))) + ;; `tramp-completion-mode' is obsoleted in 26 + (cl-progv (if (version< emacs-version "26") + '(tramp-completion-mode) + '(non-essential)) '(t) + (tramp-completion-handle-file-name-all-completions "" "/ssh:")))) + +(defun cider--completing-read-host (hosts) + "Interactively select host from HOSTS. +Each element in HOSTS is one of: (host), (host port) or (label host port). +Return a list of the form (HOST PORT), where PORT can be nil." + (let* ((hosts (cider-join-into-alist hosts)) + (sel-host (completing-read "Host: " hosts nil nil nil + 'cider-host-history (caar hosts))) + (host (or (cdr (assoc sel-host hosts)) (list sel-host)))) + ;; remove the label + (if (= 3 (length host)) (cdr host) host))) + +(defun cider--tramp-file-name (vec) + "A simple compatibility wrapper around `make-tramp-file-name'. +Tramp version starting 26.1 is using a `cl-defstruct' rather than vanilla VEC." + (if (version< emacs-version "26.1") + vec + (with-no-warnings + (make-tramp-file-name :method (elt vec 0) + :host (elt vec 2))))) + +(defun cider--infer-ports (host ssh-hosts) + "Infer nREPL ports on HOST. +Return a list of elements of the form (directory port). SSH-HOSTS is a list +of remote SSH hosts." + (let ((localp (or (nrepl-local-host-p host) + (not (assoc-string host ssh-hosts))))) + (if localp + ;; change dir: current file might be remote + (let* ((change-dir-p (file-remote-p default-directory)) + (default-directory (if change-dir-p "~/" default-directory))) + (cider-locate-running-nrepl-ports (unless change-dir-p default-directory))) + (let ((vec (vector "sshx" nil host "" nil)) + ;; change dir: user might want to connect to a different remote + (dir (when (file-remote-p default-directory) + (with-parsed-tramp-file-name default-directory cur + (when (string= cur-host host) default-directory))))) + (tramp-maybe-open-connection (cider--tramp-file-name vec)) + (with-current-buffer (tramp-get-connection-buffer (cider--tramp-file-name vec)) + (cider-locate-running-nrepl-ports dir)))))) + +(defun cider--completing-read-port (host ports) + "Interactively select port for HOST from PORTS." + (let* ((ports (cider-join-into-alist ports)) + (sel-port (completing-read (format "Port for %s: " host) ports + nil nil nil nil (caar ports))) + (port (or (cdr (assoc sel-port ports)) sel-port)) + (port (if (listp port) (cadr port) port))) + (if (stringp port) (string-to-number port) port))) + +(defun cider-locate-running-nrepl-ports (&optional dir) + "Locate ports of running nREPL servers. +When DIR is non-nil also look for nREPL port files in DIR. Return a list +of list of the form (project-dir port)." + (let* ((paths (cider--running-nrepl-paths)) + (proj-ports (mapcar (lambda (d) + (when-let* ((port (and d (nrepl-extract-port (cider--file-path d))))) + (list (file-name-nondirectory (directory-file-name d)) port))) + (cons (clojure-project-dir dir) paths)))) + (seq-uniq (delq nil proj-ports)))) + +(defun cider--running-nrepl-paths () + "Retrieve project paths of running nREPL servers. +Use `cider-ps-running-nrepls-command' and `cider-ps-running-nrepl-path-regexp-list'." + (let (paths) + (with-temp-buffer + (insert (shell-command-to-string cider-ps-running-nrepls-command)) + (dolist (regexp cider-ps-running-nrepl-path-regexp-list) + (goto-char 1) + (while (re-search-forward regexp nil t) + (setq paths (cons (match-string 1) paths))))) + (seq-uniq paths))) + +(defun cider--identify-buildtools-present (&optional project-dir) + "Identify build systems present by their build files in PROJECT-DIR. +PROJECT-DIR defaults to current project." + (let* ((default-directory (or project-dir (clojure-project-dir (cider-current-dir)))) + (build-files '((lein . "project.clj") + (boot . "build.boot") + (clojure-cli . "deps.edn") + (shadow-cljs . "shadow-cljs.edn") + (gradle . "build.gradle")))) + (delq nil + (mapcar (lambda (candidate) + (when (file-exists-p (cdr candidate)) + (car candidate))) + build-files)))) + +(defun cider-project-type (&optional project-dir) + "Determine the type of the project in PROJECT-DIR. +When multiple project file markers are present, check for a preferred build +tool in `cider-preferred-build-tool', otherwise prompt the user to choose. +PROJECT-DIR defaults to the current project." + (let* ((choices (cider--identify-buildtools-present project-dir)) + (multiple-project-choices (> (length choices) 1)) + ;; this needs to be a string to be used in `completing-read' + (default (symbol-name (car choices))) + ;; `cider-preferred-build-tool' used to be a string prior to CIDER + ;; 0.18, therefore the need for `cider-maybe-intern' + (preferred-build-tool (cider-maybe-intern cider-preferred-build-tool))) + (cond ((and multiple-project-choices + (member preferred-build-tool choices)) + preferred-build-tool) + (multiple-project-choices + (intern + (completing-read + (format "Which command should be used (default %s): " default) + choices nil t nil nil default))) + (choices + (car choices)) + ;; TODO: Move this fallback outside the project-type check + ;; if we're outside a project we fallback to whatever tool + ;; is specified in `cider-jack-in-default' (normally clojure-cli) + ;; `cider-jack-in-default' used to be a string prior to CIDER + ;; 0.18, therefore the need for `cider-maybe-intern' + (t (cider-maybe-intern cider-jack-in-default))))) + + +;; TODO: Implement a check for command presence over tramp +(defun cider--resolve-command (command) + "Find COMMAND in exec path (see variable `exec-path'). +Return nil if not found. In case `default-directory' is non-local we +assume the command is available." + (when-let* ((command (or (and (file-remote-p default-directory) command) + (executable-find command) + (executable-find (concat command ".bat"))))) + (shell-quote-argument command))) + +;;;###autoload +(with-eval-after-load 'clojure-mode + (define-key clojure-mode-map (kbd "C-c M-x") #'cider) + (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) + (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) + (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) + (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) + (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) + (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) + (require 'sesman) + (sesman-install-menu clojure-mode-map) + (add-hook 'clojure-mode-hook (lambda () (setq-local sesman-system 'CIDER)))) + +(provide 'cider) + +;;; cider.el ends here diff --git a/elpa/cider-20170129.1941/nrepl-client.el b/elpa/cider-20181110.1413/nrepl-client.el similarity index 73% rename from elpa/cider-20170129.1941/nrepl-client.el rename to elpa/cider-20181110.1413/nrepl-client.el index 177f8ff4..b250f74a 100644 --- a/elpa/cider-20170129.1941/nrepl-client.el +++ b/elpa/cider-20181110.1413/nrepl-client.el @@ -1,7 +1,7 @@ ;;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -9,6 +9,7 @@ ;; Artur Malabarba ;; Hugo Duncan ;; Steve Purcell +;; Reid McKenzie ;; ;; 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 @@ -38,7 +39,7 @@ ;; The nREPL communication process can be broadly represented as follows: ;; ;; 1) The server process is started as an Emacs subprocess (usually by -;; `cider-jack-in', which in turn fires up leiningen or boot). Note that +;; `cider-jack-in', which in turn fires up leiningen or boot). Note that ;; if a connection was established using `cider-connect' there won't be ;; a server process. ;; @@ -84,16 +85,18 @@ :prefix "nrepl-" :group 'applications) -(defcustom nrepl-buffer-name-separator " " - "Used in constructing the REPL buffer name. -The `nrepl-buffer-name-separator' separates cider-repl from the project name." - :type '(string) - :group 'nrepl) +;; (defcustom nrepl-buffer-name-separator " " +;; "Used in constructing the REPL buffer name. +;; The `nrepl-buffer-name-separator' separates cider-repl from the project name." +;; :type '(string) +;; :group 'nrepl) +(make-obsolete-variable 'nrepl-buffer-name-separator 'cider-session-name-template "0.18") -(defcustom nrepl-buffer-name-show-port nil - "Show the connection port in the nrepl REPL buffer name, if set to t." - :type 'boolean - :group 'nrepl) +;; (defcustom nrepl-buffer-name-show-port nil +;; "Show the connection port in the nrepl REPL buffer name, if set to t." +;; :type 'boolean +;; :group 'nrepl) +(make-obsolete-variable 'nrepl-buffer-name-show-port 'cider-session-name-template "0.18") (defcustom nrepl-connected-hook nil "List of functions to call when connecting to the nREPL server." @@ -132,30 +135,17 @@ When true some special buffers like the server buffer will be hidden." :type 'boolean :group 'nrepl) -(defcustom nrepl-prompt-to-kill-server-buffer-on-quit t - "If non-nil, prompt the user for confirmation before killing the nrepl server buffer and associated process." - :type 'boolean - :group 'nrepl) - -(defvar nrepl-create-client-buffer-function 'nrepl-create-client-buffer-default - "Name of a function that returns a client process buffer. -It is called with one argument, a plist containing :host, :port and :proc -as returned by `nrepl-connect'.") - -(defvar nrepl-use-this-as-repl-buffer 'new - "Name of the buffer to use as REPL buffer. -In case of a special value 'new, a new buffer is created.") - ;;; Buffer Local Declarations ;; These variables are used to track the state of nREPL connections -(defvar-local nrepl-client-buffers nil - "List of buffers connected to this server.") (defvar-local nrepl-connection-buffer nil) (defvar-local nrepl-server-buffer nil) +(defvar-local nrepl-messages-buffer nil) (defvar-local nrepl-endpoint nil) (defvar-local nrepl-project-dir nil) +(defvar-local nrepl-is-server nil) +(defvar-local nrepl-server-command nil) (defvar-local nrepl-tunnel-buffer nil) (defvar-local nrepl-session nil @@ -190,40 +180,18 @@ To be used for tooling calls (i.e. completion, eldoc, etc)") ;;; nREPL Buffer Names -(defconst nrepl-message-buffer-name-template "*nrepl-messages %s*") +(defconst nrepl-message-buffer-name-template "*nrepl-messages %s(%r:%S)*") (defconst nrepl-error-buffer-name "*nrepl-error*") -(defconst nrepl-repl-buffer-name-template "*cider-repl%s*") -(defconst nrepl-connection-buffer-name-template "*nrepl-connection%s*") -(defconst nrepl-server-buffer-name-template "*nrepl-server%s*") -(defconst nrepl-tunnel-buffer-name-template "*nrepl-tunnel%s*") - -(defun nrepl-format-buffer-name-template (buffer-name-template designation) - "Apply the DESIGNATION to the corresponding BUFFER-NAME-TEMPLATE." - (format buffer-name-template - (if (> (length designation) 0) - (concat nrepl-buffer-name-separator designation) - ""))) - -(defun nrepl-make-buffer-name (buffer-name-template &optional project-dir host port dup-ok) - "Generate a buffer name using BUFFER-NAME-TEMPLATE. - -If not supplied PROJECT-DIR, HOST and PORT default to the buffer local -value of the `nrepl-project-dir' and `nrepl-endpoint'. - -The name will include the project name if available or the endpoint host if -it is not. The name will also include the connection port if -`nrepl-buffer-name-show-port' is true. - -If optional DUP-OK is non-nil, the returned buffer is not \"uniquified\" by -`generate-new-buffer-name'." - (let* ((project-dir (or project-dir nrepl-project-dir)) - (project-name (when project-dir (file-name-nondirectory (directory-file-name project-dir)))) - (nrepl-proj-port (or port (cadr nrepl-endpoint))) - (name (nrepl-format-buffer-name-template - buffer-name-template - (concat (if project-name project-name (or host (car nrepl-endpoint))) - (if (and nrepl-proj-port nrepl-buffer-name-show-port) - (format ":%s" nrepl-proj-port) ""))))) +(defconst nrepl-repl-buffer-name-template "*cider-repl %s(%r:%S)*") +(defconst nrepl-server-buffer-name-template "*nrepl-server %s*") +(defconst nrepl-tunnel-buffer-name-template "*nrepl-tunnel %s*") + +(defun nrepl-make-buffer-name (template params &optional dup-ok) + "Generate a buffer name using TEMPLATE and PARAMS. +TEMPLATE and PARAMS are as in `cider-format-connection-params'. If +optional DUP-OK is non-nil, the returned buffer is not \"uniquified\" by a +call to `generate-new-buffer-name'." + (let ((name (cider-format-connection-params template params))) (if dup-ok name (generate-new-buffer-name name)))) @@ -232,39 +200,34 @@ If optional DUP-OK is non-nil, the returned buffer is not \"uniquified\" by "Apply a prefix to BUFFER-NAME that will hide the buffer." (concat (if nrepl-hide-special-buffers " " "") buffer-name)) -(defun nrepl-connection-buffer-name (&optional project-dir host port) - "Return the name of the connection buffer. -PROJECT-DIR, HOST and PORT are as in `/nrepl-make-buffer-name'." - (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-connection-buffer-name-template - project-dir host port))) - -(defun nrepl-connection-identifier (conn) - "Return the string which identifies a connection CONN." - (thread-last (buffer-name conn) - (replace-regexp-in-string "\\`*cider-repl " "") - (replace-regexp-in-string "*\\'" "" ))) +(defun nrepl-repl-buffer-name (params &optional dup-ok) + "Return the name of the repl buffer. +PARAMS and DUP-OK are as in `nrepl-make-buffer-name'." + (nrepl-make-buffer-name nrepl-repl-buffer-name-template params dup-ok)) -(defun nrepl-server-buffer-name (&optional project-dir host port) +(defun nrepl-server-buffer-name (params) "Return the name of the server buffer. -PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." +PARAMS is as in `nrepl-make-buffer-name'." (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-server-buffer-name-template - project-dir host port))) + (nrepl-make-buffer-name nrepl-server-buffer-name-template params))) -(defun nrepl-tunnel-buffer-name (&optional project-dir host port) +(defun nrepl-tunnel-buffer-name (params) "Return the name of the tunnel buffer. -PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." +PARAMS is as in `nrepl-make-buffer-name'." (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-tunnel-buffer-name-template - project-dir host port))) + (nrepl-make-buffer-name nrepl-tunnel-buffer-name-template params))) + +(defun nrepl-messages-buffer-name (params) + "Return the name for the message buffer given connection PARAMS." + (nrepl-make-buffer-name nrepl-message-buffer-name-template params)) ;;; Utilities (defun nrepl-op-supported-p (op connection) "Return t iff the given operation OP is supported by the nREPL CONNECTION." - (with-current-buffer connection - (and nrepl-ops (nrepl-dict-get nrepl-ops op)))) + (when (buffer-live-p connection) + (with-current-buffer connection + (and nrepl-ops (nrepl-dict-get nrepl-ops op))))) (defun nrepl-aux-info (key connection) "Return KEY's aux info, as returned via the :describe op for CONNECTION." @@ -279,7 +242,8 @@ PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." "Read port from .nrepl-port, nrepl-port or target/repl-port files in directory DIR." (or (nrepl--port-from-file (expand-file-name "repl-port" dir)) (nrepl--port-from-file (expand-file-name ".nrepl-port" dir)) - (nrepl--port-from-file (expand-file-name "target/repl-port" dir)))) + (nrepl--port-from-file (expand-file-name "target/repl-port" dir)) + (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir)))) (defun nrepl--port-from-file (file) "Attempts to read port from a file named by FILE." @@ -501,14 +465,23 @@ and kill the process buffer." (message "[nREPL] Connection closed unexpectedly (%s)" (substring message 0 -1))) (when (equal (process-status process) 'closed) - (when-let ((client-buffer (process-buffer process))) + (when-let* ((client-buffer (process-buffer process))) + (sesman-remove-object 'CIDER nil client-buffer + (not (process-get process :keep-server)) + 'no-error) (nrepl--clear-client-sessions client-buffer) (with-current-buffer client-buffer + (goto-char (point-max)) + (insert-before-markers + (propertize + (format "\n*** Closed on %s ***\n" (current-time-string)) + 'face 'cider-repl-stderr-face)) (run-hooks 'nrepl-disconnected-hook) - (when (buffer-live-p nrepl-server-buffer) - (with-current-buffer nrepl-server-buffer - (setq nrepl-client-buffers (delete client-buffer nrepl-client-buffers))) - (nrepl--maybe-kill-server-buffer nrepl-server-buffer)))))) + (let ((server-buffer nrepl-server-buffer)) + (when (and (buffer-live-p server-buffer) + (not (process-get process :keep-server))) + (setq nrepl-server-buffer nil) + (nrepl--maybe-kill-server-buffer server-buffer))))))) ;;; Network @@ -529,35 +502,50 @@ key-values depending on the connection type." (nrepl--direct-connect (or host "localhost") port) ;; we're dealing with a remote host (if (and host (not nrepl-force-ssh-for-remote-hosts)) - (nrepl--direct-connect host port 'no-error) - ;; direct connection failed or `nrepl-force-ssh-for-remote-hosts' is non-nil - (when (or nrepl-use-ssh-fallback-for-remote-hosts - nrepl-force-ssh-for-remote-hosts) - (nrepl--ssh-tunnel-connect host port)))))) + (or (nrepl--direct-connect host port 'no-error) + ;; direct connection failed + ;; fallback to ssh tunneling if enabled + (and nrepl-use-ssh-fallback-for-remote-hosts + (message "[nREPL] Falling back to SSH tunneled connection ...") + (nrepl--ssh-tunnel-connect host port)) + ;; fallback is either not enabled or it failed as well + (if (and (null nrepl-use-ssh-fallback-for-remote-hosts) + (not localp)) + (error "[nREPL] Direct connection to %s:%s failed; try setting `nrepl-use-ssh-fallback-for-remote-hosts' to t" + host port) + (error "[nREPL] Cannot connect to %s:%s" host port))) + ;; `nrepl-force-ssh-for-remote-hosts' is non-nil + (nrepl--ssh-tunnel-connect host port))))) (defun nrepl--direct-connect (host port &optional no-error) "If HOST and PORT are given, try to `open-network-stream'. If NO-ERROR is non-nil, show messages instead of throwing an error." (if (not (and host port)) (unless no-error - (error "Host (%s) and port (%s) must be provided" host port)) + (unless host + (error "[nREPL] Host not provided")) + (unless port + (error "[nREPL] Port not provided"))) (message "[nREPL] Establishing direct connection to %s:%s ..." host port) (condition-case nil (prog1 (list :proc (open-network-stream "nrepl-connection" nil host port) :host host :port port) - (message "[nREPL] Direct connection established")) - (error (let ((mes "[nREPL] Direct connection failed")) - (if no-error (message mes) (error mes)) + (message "[nREPL] Direct connection to %s:%s established" host port)) + (error (let ((msg (format "[nREPL] Direct connection to %s:%s failed" host port))) + (if no-error + (message msg) + (error msg)) nil))))) (defun nrepl--ssh-tunnel-connect (host port) "Connect to a remote machine identified by HOST and PORT through SSH tunnel." - (message "[nREPL] Establishing SSH tunneled connection ...") + (message "[nREPL] Establishing SSH tunneled connection to %s:%s ..." host port) (let* ((remote-dir (if host (format "/ssh:%s:" host) default-directory)) (ssh (or (executable-find "ssh") (error "[nREPL] Cannot locate 'ssh' executable"))) (cmd (nrepl--ssh-tunnel-command ssh remote-dir port)) - (tunnel-buf (nrepl-tunnel-buffer-name)) + (tunnel-buf (nrepl-tunnel-buffer-name + `((:host ,host) (:port ,port)))) (tunnel (start-process-shell-command "nrepl-tunnel" tunnel-buf cmd))) (process-put tunnel :waiting-for-port t) (set-process-filter tunnel (nrepl--ssh-tunnel-filter port)) @@ -574,7 +562,7 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." (defun nrepl--ssh-tunnel-command (ssh dir port) "Command string to open SSH tunnel to the host associated with DIR's PORT." - (with-parsed-tramp-file-name dir nil + (with-parsed-tramp-file-name dir v ;; this abuses the -v option for ssh to get output when the port ;; forwarding is set up, which is used to synchronise on, so that ;; the port forwarding is up when we try to connect. @@ -582,8 +570,8 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." "%s -v -N -L %p:localhost:%p %u'%h'" `((?s . ,ssh) (?p . ,port) - (?h . ,host) - (?u . ,(if user (format "-l '%s' " user) "")))))) + (?h . ,v-host) + (?u . ,(if v-user (format "-l '%s' " v-user) "")))))) (autoload 'comint-watch-for-password-prompt "comint" "(autoload).") @@ -607,35 +595,46 @@ If NO-ERROR is non-nil, show messages instead of throwing an error." ;;; Client: Process Handling +(defun nrepl--kill-process (proc) + "Kill PROC using the appropriate, os specific way. +Implement a workaround to clean up an orphaned JVM process left around +after exiting the REPL on some windows machines." + (if (memq system-type '(cygwin windows-nt)) + (interrupt-process proc) + (kill-process proc))) + +(defun nrepl-kill-server-buffer (server-buf) + "Kill SERVER-BUF and its process." + (when (buffer-live-p server-buf) + (let ((proc (get-buffer-process server-buf))) + (when (process-live-p proc) + (set-process-query-on-exit-flag proc nil) + (nrepl--kill-process proc)) + (kill-buffer server-buf)))) + (defun nrepl--maybe-kill-server-buffer (server-buf) - "Kill SERVER-BUF and its process, subject to user confirmation. -Do nothing if there is a REPL connected to that server." - (with-current-buffer server-buf - ;; Don't kill the server if there is a REPL connected to it. - (when (and (not nrepl-client-buffers) - (or (not nrepl-prompt-to-kill-server-buffer-on-quit) - (y-or-n-p "Also kill server process and buffer? "))) - (let ((proc (get-buffer-process server-buf))) - (when (process-live-p proc) - (set-process-query-on-exit-flag proc nil) - (kill-process proc)) - (kill-buffer server-buf))))) - -;; `nrepl-start-client-process' is called from `nrepl-server-filter'. It -;; starts the client process described by `nrepl-client-filter' and -;; `nrepl-client-sentinel'. -(defun nrepl-start-client-process (&optional host port server-proc) + "Kill SERVER-BUF and its process. +Do not kill the server if there is a REPL connected to that server." + (when (buffer-live-p server-buf) + (with-current-buffer server-buf + ;; Don't kill if there is at least one REPL connected to it. + (when (not (seq-find (lambda (b) + (eq (buffer-local-value 'nrepl-server-buffer b) + server-buf)) + (buffer-list))) + (nrepl-kill-server-buffer server-buf))))) + +(defun nrepl-start-client-process (&optional host port server-proc buffer-builder) "Create new client process identified by HOST and PORT. In remote buffers, HOST and PORT are taken from the current tramp connection. SERVER-PROC must be a running nREPL server process within -Emacs. This function creates connection buffer by a call to -`nrepl-create-client-buffer-function'. Return newly created client -process." +Emacs. BUFFER-BUILDER is a function of one argument (endpoint returned by +`nrepl-connect') which returns a client buffer. Return the newly created +client process." (let* ((endpoint (nrepl-connect host port)) (client-proc (plist-get endpoint :proc)) - (host (plist-get endpoint :host)) - (port (plist-get endpoint :port)) - (client-buf (funcall nrepl-create-client-buffer-function endpoint))) + (builder (or buffer-builder (error "`buffer-builder' must be provided"))) + (client-buf (funcall builder endpoint))) (set-process-buffer client-proc client-buf) @@ -647,11 +646,11 @@ process." (process-put client-proc :response-q (nrepl-response-queue)) (with-current-buffer client-buf - (when-let ((server-buf (and server-proc (process-buffer server-proc)))) + (when-let* ((server-buf (and server-proc (process-buffer server-proc)))) (setq nrepl-project-dir (buffer-local-value 'nrepl-project-dir server-buf) nrepl-server-buffer server-buf)) - (setq nrepl-endpoint `(,host ,port) - nrepl-tunnel-buffer (when-let ((tunnel (plist-get endpoint :tunnel))) + (setq nrepl-endpoint endpoint + nrepl-tunnel-buffer (when-let* ((tunnel (plist-get endpoint :tunnel))) (process-buffer tunnel)) nrepl-pending-requests (make-hash-table :test 'equal) nrepl-completed-requests (make-hash-table :test 'equal))) @@ -665,7 +664,6 @@ process." (defun nrepl--init-client-sessions (client) "Initialize CLIENT connection nREPL sessions. - We create two client nREPL sessions per connection - a main session and a tooling session. The main session is general purpose and is used for pretty much every request that needs a session. The tooling session is used only @@ -715,19 +713,36 @@ CONN-BUFFER refers to a (presumably) dead connection, which we can eventually re It is safe to call this function multiple times on the same ID." ;; FIXME: This should go away eventually when we get rid of ;; pending-request hash table - (when-let ((handler (gethash id nrepl-pending-requests))) + (when-let* ((handler (gethash id nrepl-pending-requests))) (puthash id handler nrepl-completed-requests) (remhash id nrepl-pending-requests))) +(declare-function cider-repl--emit-interactive-output "cider-repl") +(defun nrepl-notify (msg type) + "Handle \"notification\" server request. +MSG is a string to be displayed. TYPE is the type of the message. All +notifications are currently displayed with `message' function and emitted +to the REPL." + (let* ((face (pcase type + ((or "message" `nil) 'font-lock-builtin-face) + ("warning" 'warning) + ("error" 'error))) + (msg (if face + (propertize msg 'face face) + (format "%s: %s" (upcase type) msg)))) + (cider-repl--emit-interactive-output msg (or face 'font-lock-builtin-face)) + (message msg))) + (defvar cider-buffer-ns) (defvar cider-special-mode-truncate-lines) -(declare-function cider-need-input "cider-interaction") +(declare-function cider-need-input "cider-client") (declare-function cider-set-buffer-ns "cider-mode") (defun nrepl-make-response-handler (buffer value-handler stdout-handler stderr-handler done-handler &optional eval-error-handler - pprint-out-handler) + pprint-out-handler + content-type-handler) "Make a response handler for connection BUFFER. A handler is a function that takes one argument - response received from the server process. The response is an alist that contains at least 'id' @@ -736,20 +751,35 @@ and 'session' keys. Other standard response keys are 'value', 'out', 'err', The presence of a particular key determines the type of the response. For example, if 'value' key is present, the response is of type 'value', if -'out' key is present the response is 'stdout' etc. Depending on the type, -the handler dispatches the appropriate value to one of the supplied -handlers: VALUE-HANDLER, STDOUT-HANDLER, STDERR-HANDLER, DONE-HANDLER, -EVAL-ERROR-HANDLER, and PPRINT-OUT-HANDLER. If the optional -EVAL-ERROR-HANDLER is nil, the default `nrepl-err-handler' is used. If any -of the other supplied handlers are nil nothing happens for the -corresponding type of response." +'out' key is present the response is 'stdout' etc. + +Depending on the type, the handler dispatches the appropriate value to one +of the supplied handlers: VALUE-HANDLER, STDOUT-HANDLER, STDERR-HANDLER, +DONE-HANDLER, EVAL-ERROR-HANDLER, PPRINT-OUT-HANDLER and +CONTENT-TYPE-HANDLER. + +Handlers are functions of the buffer and the value they handle, except for +the optional CONTENT-TYPE-HANDLER which should be a function of the buffer, +content, the content-type to be handled as a list `(type attrs)'. + +If the optional EVAL-ERROR-HANDLER is nil, the default `nrepl-err-handler' +is used. If any of the other supplied handlers are nil nothing happens for +the corresponding type of response." (lambda (response) - (nrepl-dbind-response response (value ns out err status id pprint-out) + (nrepl-dbind-response response (content-type content-transfer-encoding body + value ns out err status id + pprint-out) (when (buffer-live-p buffer) (with-current-buffer buffer (when (and ns (not (derived-mode-p 'clojure-mode))) (cider-set-buffer-ns ns)))) - (cond (value + (cond ((and content-type content-type-handler) + (funcall content-type-handler buffer + (if (string= content-transfer-encoding "base64") + (base64-decode-string body) + body) + content-type)) + (value (when value-handler (funcall value-handler buffer value))) (out @@ -762,12 +792,18 @@ corresponding type of response." (when stderr-handler (funcall stderr-handler buffer err))) (status + (when (member "notification" status) + (nrepl-dbind-response response (msg type) + (nrepl-notify msg type))) (when (member "interrupted" status) (message "Evaluation interrupted.")) (when (member "eval-error" status) (funcall (or eval-error-handler nrepl-err-handler))) (when (member "namespace-not-found" status) - (message "Namespace not found.")) + ;; nREPL 0.4.3 started echoing back the name of the missing ns + (if ns + (message "Namespace `%s' not found." ns) + (message "Namespace not found."))) (when (member "need-input" status) (cider-need-input buffer)) (when (member "done" status) @@ -782,7 +818,7 @@ corresponding type of response." ;; Requests can be asynchronous (sent with `nrepl-send-request') or ;; synchronous (send with `nrepl-send-sync-request'). The request is a pair list ;; of operation name and operation parameters. The core operations are described -;; at https://github.com/clojure/tools.nrepl/blob/master/doc/ops.md. CIDER adds +;; at https://github.com/nrepl/nrepl/blob/master/doc/ops.md. CIDER adds ;; many more operations through nREPL middleware. See ;; https://github.com/clojure-emacs/cider-nrepl#supplied-nrepl-middleware for ;; the up-to-date list. @@ -802,9 +838,8 @@ connection/session drift. Return the ID of the sent message. Optional argument TOOLING Set to t if desiring the tooling session rather than the standard session." (with-current-buffer connection - (when-let ((session (if tooling nrepl-tooling-session nrepl-session))) - (setq request (append request - (list "session" session)))) + (when-let* ((session (if tooling nrepl-tooling-session nrepl-session))) + (setq request (append request `("session" ,session)))) (let* ((id (nrepl-next-request-id connection)) (request (cons 'dict (lax-plist-put request "id" id))) (message (nrepl-bencode request))) @@ -817,7 +852,7 @@ Optional argument TOOLING Set to t if desiring the tooling session rather than t "Dynamically bound to t while a sync request is ongoing.") (declare-function cider-repl-emit-interactive-stderr "cider-repl") -(declare-function cider--render-stacktrace-causes "cider-interaction") +(declare-function cider--render-stacktrace-causes "cider-eval") (defun nrepl-send-sync-request (request connection &optional abort-on-input tooling) "Send REQUEST to the nREPL server synchronously using CONNECTION. @@ -868,8 +903,8 @@ If TOOLING, use the tooling session rather than the standard session." (defun nrepl-request:stdin (input callback connection) "Send a :stdin request with INPUT using CONNECTION. Register CALLBACK as the response handler." - (nrepl-send-request (list "op" "stdin" - "stdin" input) + (nrepl-send-request `("op" "stdin" + "stdin" ,input) callback connection)) @@ -877,8 +912,8 @@ Register CALLBACK as the response handler." "Send an :interrupt request for PENDING-REQUEST-ID. The request is dispatched using CONNECTION. Register CALLBACK as the response handler." - (nrepl-send-request (list "op" "interrupt" - "interrupt-id" pending-request-id) + (nrepl-send-request `("op" "interrupt" + "interrupt-id" ,pending-request-id) callback connection)) @@ -890,16 +925,16 @@ Register CALLBACK as the response handler." NS provides context for the request. If LINE and COLUMN are non-nil and current buffer is a file buffer, \"line\", \"column\" and \"file\" are added to the message." - (append (and ns (list "ns" ns)) - (list "op" "eval" - "code" input) - (when cider-enlighten-mode - (list "enlighten" "true")) - (let ((file (or (buffer-file-name) (buffer-name)))) - (when (and line column file) - (list "file" file - "line" line - "column" column))))) + (nconc (and ns `("ns" ,ns)) + `("op" "eval" + "code" ,(substring-no-properties input)) + (when cider-enlighten-mode + '("enlighten" "true")) + (let ((file (or (buffer-file-name) (buffer-name)))) + (when (and line column file) + `("file" ,file + "line" ,line + "column" ,column))))) (defun nrepl-request:eval (input callback connection &optional ns line column additional-params tooling) "Send the request INPUT and register the CALLBACK as the response handler. @@ -924,10 +959,8 @@ Optional argument TOOLING Tooling is set to t if wanting the tooling session fro (defun nrepl-sync-request:close (connection) "Sent a :close request to close CONNECTION's SESSION." - (nrepl-send-sync-request (list "op" "close") - connection) - (nrepl-send-sync-request (list "op" "close") - connection nil t)) ;; close tooling session + (nrepl-send-sync-request '("op" "close") connection) + (nrepl-send-sync-request '("op" "close") connection nil t)) ;; close tooling session (defun nrepl-sync-request:describe (connection) "Perform :describe request for CONNECTION and SESSION." @@ -938,13 +971,17 @@ Optional argument TOOLING Tooling is set to t if wanting the tooling session fro "Perform :ls-sessions request for CONNECTION." (nrepl-send-sync-request '("op" "ls-sessions") connection)) -(defun nrepl-sync-request:eval (input connection &optional ns) +(defun nrepl-sync-request:eval (input connection &optional ns tooling) "Send the INPUT to the nREPL server synchronously. The request is dispatched via CONNECTION. -If NS is non-nil, include it in the request." +If NS is non-nil, include it in the request +If TOOLING is non-nil the evaluation is done using the tooling nREPL +session." (nrepl-send-sync-request (nrepl--eval-request input ns) - connection)) + connection + nil + tooling)) (defun nrepl-sessions (connection) "Get a list of active sessions on the nREPL server using CONNECTION." @@ -959,39 +996,41 @@ If NS is non-nil, include it in the request." ;; nrepl communication client (`nrepl-client-filter') when the message "nREPL ;; server started on port ..." is detected. -(defvar-local nrepl-post-client-callback nil - "Function called after the client process is started. -Used by `nrepl-start-server-process'.") +;; internal variables used for state transfer between nrepl-start-server-process +;; and nrepl-server-filter. +(defvar-local nrepl-on-port-callback nil) -(defun nrepl-start-server-process (directory cmd &optional callback) +(defun nrepl-server-p (buffer-or-process) + "Return t if BUFFER-OR-PROCESS is an nREPL server." + (let ((buffer (if (processp buffer-or-process) + (process-buffer buffer-or-process) + buffer-or-process))) + (buffer-local-value 'nrepl-is-server buffer))) + +(defun nrepl-start-server-process (directory cmd on-port-callback) "Start nREPL server process in DIRECTORY using shell command CMD. -Return a newly created process. -Set `nrepl-server-filter' as the process filter, which starts REPL process -with its own buffer once the server has started. -If CALLBACK is non-nil, it should be function of 1 argument. Once the -client process is started, the function is called with the client buffer." +Return a newly created process. Set `nrepl-server-filter' as the process +filter, which starts REPL process with its own buffer once the server has +started. ON-PORT-CALLBACK is a function of one argument (server buffer) +which is called by the process filter once the port of the connection has +been determined." (let* ((default-directory (or directory default-directory)) - (serv-buf (get-buffer-create (generate-new-buffer-name - (nrepl-server-buffer-name directory)))) - (serv-proc (start-file-process-shell-command - "nrepl-server" serv-buf cmd))) - (set-process-filter serv-proc 'nrepl-server-filter) - (set-process-sentinel serv-proc 'nrepl-server-sentinel) - (set-process-coding-system serv-proc 'utf-8-unix 'utf-8-unix) + (serv-buf (get-buffer-create + (nrepl-server-buffer-name + `(:project-dir ,default-directory))))) (with-current-buffer serv-buf - (setq nrepl-project-dir directory) - (setq nrepl-post-client-callback callback) - ;; Ensure that `nrepl-start-client-process' sees right things. This - ;; causes warnings about making a local within a let-bind. This is safe - ;; as long as `serv-buf' is not the buffer where the let-binding was - ;; started. http://www.gnu.org/software/emacs/manual/html_node/elisp/Creating-Buffer_002dLocal.html - (setq-local nrepl-create-client-buffer-function - nrepl-create-client-buffer-function) - (setq-local nrepl-use-this-as-repl-buffer - nrepl-use-this-as-repl-buffer)) - (message "Starting nREPL server via %s..." - (propertize cmd 'face 'font-lock-keyword-face)) - serv-proc)) + (setq nrepl-is-server t + nrepl-project-dir default-directory + nrepl-server-command cmd + nrepl-on-port-callback on-port-callback)) + (let ((serv-proc (start-file-process-shell-command + "nrepl-server" serv-buf cmd))) + (set-process-filter serv-proc 'nrepl-server-filter) + (set-process-sentinel serv-proc 'nrepl-server-sentinel) + (set-process-coding-system serv-proc 'utf-8-unix 'utf-8-unix) + (message "[nREPL] Starting server via %s..." + (propertize cmd 'face 'font-lock-keyword-face)) + serv-proc))) (defun nrepl-server-filter (process output) "Process nREPL server output from PROCESS contained in OUTPUT." @@ -1008,28 +1047,27 @@ client process is started, the function is called with the client buffer." (set-marker (process-mark process) (point))) (when moving (goto-char (process-mark process)) - (when-let ((win (get-buffer-window))) - (set-window-point win (point)))))) - ;; detect the port the server is listening on from its output - (when (string-match "nREPL server started on port \\([0-9]+\\)" output) - (let ((port (string-to-number (match-string 1 output)))) - (message "nREPL server started on %s" port) - (with-current-buffer server-buffer - (let* ((client-proc (nrepl-start-client-process nil port process)) - (client-buffer (process-buffer client-proc))) - (setq nrepl-client-buffers - (cons client-buffer - (delete client-buffer nrepl-client-buffers))) - - (when (functionp nrepl-post-client-callback) - (funcall nrepl-post-client-callback client-buffer))))))))) - -(declare-function cider--close-connection-buffer "cider-client") - + (when-let* ((win (get-buffer-window))) + (set-window-point win (point))))) + ;; detect the port the server is listening on from its output + (when (and (null nrepl-endpoint) + (string-match "nREPL server started on port \\([0-9]+\\)" output)) + (let ((port (string-to-number (match-string 1 output)))) + (setq nrepl-endpoint (list :host (or (file-remote-p default-directory 'host) + "localhost") + :port port)) + (message "[nREPL] server started on %s" port) + (when nrepl-on-port-callback + (funcall nrepl-on-port-callback (process-buffer process))))))))) + +(declare-function cider--close-connection "cider-connection") (defun nrepl-server-sentinel (process event) "Handle nREPL server PROCESS EVENT." (let* ((server-buffer (process-buffer process)) - (clients (buffer-local-value 'nrepl-client-buffers server-buffer)) + (clients (seq-filter (lambda (b) + (eq (buffer-local-value 'nrepl-server-buffer b) + server-buffer)) + (buffer-list))) (problem (if (and server-buffer (buffer-live-p server-buffer)) (with-current-buffer server-buffer (buffer-substring (point-min) (point-max))) @@ -1040,7 +1078,7 @@ client process is started, the function is called with the client buffer." ((string-match-p "^killed\\|^interrupt" event) nil) ((string-match-p "^hangup" event) - (mapc #'cider--close-connection-buffer clients)) + (mapc #'cider--close-connection clients)) ;; On Windows, a failed start sends the "finished" event. On Linux it sends ;; "exited abnormally with code 1". (t (error "Could not start nREPL server: %s" problem))))) @@ -1050,15 +1088,13 @@ client process is started, the function is called with the client buffer." (defcustom nrepl-log-messages nil "If non-nil, log protocol messages to an nREPL messages buffer. - -This is extremely useful for debug purposes, as it allows you to -inspect the communication between Emacs and an nREPL server. - -Enabling the logging might have a negative impact on performance, -so it's not recommended to keep it enabled unless you need to -debug something." +This is extremely useful for debug purposes, as it allows you to inspect +the communication between Emacs and an nREPL server. Enabling the logging +might have a negative impact on performance, so it's not recommended to +keep it enabled unless you need to debug something." :type 'boolean - :group 'nrepl) + :group 'nrepl + :safe #'booleanp) (defconst nrepl-message-buffer-max-size 1000000 "Maximum size for the nREPL message buffer. @@ -1088,9 +1124,9 @@ operations.") "Major mode for displaying nREPL messages. \\{nrepl-messages-mode-map}" - (setq buffer-read-only t) (when cider-special-mode-truncate-lines (setq-local truncate-lines t)) + (setq-local sesman-system 'CIDER) (setq-local electric-indent-chars nil) (setq-local comment-start ";") (setq-local comment-end "") @@ -1108,6 +1144,11 @@ operations.") TYPE is either request or response. The message is logged to a buffer described by `nrepl-message-buffer-name-template'." (when nrepl-log-messages + ;; append a time-stamp to the message before logging it + ;; the time-stamps are quite useful for debugging + (setq msg (cons (car msg) + (lax-plist-put (cdr msg) "time-stamp" + (format-time-string "%Y-%m-%0d %H:%M:%S.%N")))) (with-current-buffer (nrepl-messages-buffer (current-buffer)) (setq buffer-read-only nil) (when (> (buffer-size) nrepl-message-buffer-max-size) @@ -1118,7 +1159,7 @@ described by `nrepl-message-buffer-name-template'." (nrepl-log-pp-object (nrepl-decorate-msg msg type) (nrepl-log--message-color (lax-plist-get (cdr msg) "id")) t) - (when-let ((win (get-buffer-window))) + (when-let* ((win (get-buffer-window))) (set-window-point win (point-max))) (setq buffer-read-only t)))) @@ -1134,7 +1175,7 @@ This in effect enables or disables the logging of nREPL messages." (defcustom nrepl-message-colors '("red" "brown" "coral" "orange" "green" "deep sky blue" "blue" "dark violet") - "Colors used in `nrepl-messages-buffer'." + "Colors used in the messages buffer." :type '(repeat color) :group 'nrepl) @@ -1142,7 +1183,7 @@ This in effect enables or disables the logging of nREPL messages." "Expand the objects hidden in BUTTON's :nrepl-object property. BUTTON defaults the button at point." (interactive) - (if-let ((button (or button (button-at (point))))) + (if-let* ((button (or button (button-at (point))))) (let* ((start (overlay-start button)) (end (overlay-end button)) (obj (overlay-get button :nrepl-object)) @@ -1206,18 +1247,29 @@ FOREGROUND and BUTTON are as in `nrepl-log-pp-object'." (when foreground `(:foreground ,foreground)))))) (let ((head (format "(%s" (car object)))) (insert (color head)) - (let ((indent (+ 2 (- (current-column) (length head)))) - (l (point))) - (if (null (cdr object)) - (insert ")\n") - (insert " \n") - (cl-loop for l on (cdr object) by #'cddr - do (let ((str (format "%s%s " (make-string indent ?\s) - (propertize (car l) 'face - ;; Only highlight top-level keys. - (unless (eq (car object) 'dict) - 'font-lock-keyword-face))))) - (insert str) + (if (null (cdr object)) + (insert ")\n") + (let* ((indent (+ 2 (- (current-column) (length head)))) + (sorted-pairs (sort (seq-partition (cl-copy-list (cdr object)) 2) + (lambda (a b) + (string< (car a) (car b))))) + (name-lengths (seq-map (lambda (pair) (length (car pair))) sorted-pairs)) + (longest-name (seq-max name-lengths)) + ;; Special entries are displayed first + (specialq (lambda (pair) (seq-contains '("id" "op" "session" "time-stamp") (car pair)))) + (special-pairs (seq-filter specialq sorted-pairs)) + (not-special-pairs (seq-remove specialq sorted-pairs)) + (all-pairs (seq-concatenate 'list special-pairs not-special-pairs)) + (sorted-object (apply 'seq-concatenate 'list all-pairs))) + (insert "\n") + (cl-loop for l on sorted-object by #'cddr + do (let ((indent-str (make-string indent ?\s)) + (name-str (propertize (car l) 'face + ;; Only highlight top-level keys. + (unless (eq (car object) 'dict) + 'font-lock-keyword-face))) + (spaces-str (make-string (- longest-name (length (car l))) ?\s))) + (insert (format "%s%s%s " indent-str name-str spaces-str)) (nrepl-log-pp-object (cadr l) nil button))) (when (eq (car object) 'dict) (delete-char -1)) @@ -1230,7 +1282,7 @@ it into the buffer." (let ((min-dict-fold-size 1) (min-list-fold-size 10) (min-string-fold-size 60)) - (if-let ((head (car-safe object))) + (if-let* ((head (car-safe object))) ;; list-like objects (cond ;; top level dicts (always expanded) @@ -1254,20 +1306,20 @@ it into the buffer." (pp object (current-buffer)) (insert "\n"))))) -(defun nrepl-messages-buffer-name (conn) - "Return the name for the message buffer matching CONN." - (format nrepl-message-buffer-name-template (nrepl-connection-identifier conn))) - (defun nrepl-messages-buffer (conn) "Return or create the buffer for CONN. The default buffer name is *nrepl-messages connection*." - (let ((msg-buffer-name (nrepl-messages-buffer-name conn))) - (or (get-buffer msg-buffer-name) - (let ((buffer (get-buffer-create msg-buffer-name))) - (with-current-buffer buffer - (buffer-disable-undo) - (nrepl-messages-mode) - buffer))))) + (with-current-buffer conn + (or (and (buffer-live-p nrepl-messages-buffer) + nrepl-messages-buffer) + (setq nrepl-messages-buffer + (let ((buffer (get-buffer-create + (nrepl-messages-buffer-name + (cider--gather-connect-params))))) + (with-current-buffer buffer + (buffer-disable-undo) + (nrepl-messages-mode) + buffer)))))) (defun nrepl-error-buffer () "Return or create the buffer. @@ -1285,21 +1337,11 @@ The default buffer name is *nrepl-error*." (setq buffer-read-only nil) (goto-char (point-max)) (insert msg) - (when-let ((win (get-buffer-window))) + (when-let* ((win (get-buffer-window))) (set-window-point win (point-max))) (setq buffer-read-only t))) -(defun nrepl-create-client-buffer-default (endpoint) - "Create an nREPL client process buffer. -ENDPOINT is a plist returned by `nrepl-connect'." - (let ((buffer (generate-new-buffer - (nrepl-connection-buffer-name default-directory - (plist-get endpoint :host) - (plist-get endpoint :port))))) - (with-current-buffer buffer - (buffer-disable-undo) - (setq-local kill-buffer-query-functions nil)) - buffer)) +(make-obsolete 'nrepl-default-client-buffer-builder nil "0.18") (provide 'nrepl-client) diff --git a/elpa/cider-20170129.1941/nrepl-dict.el b/elpa/cider-20181110.1413/nrepl-dict.el similarity index 97% rename from elpa/cider-20170129.1941/nrepl-dict.el rename to elpa/cider-20181110.1413/nrepl-dict.el index afdaece5..be143860 100644 --- a/elpa/cider-20170129.1941/nrepl-dict.el +++ b/elpa/cider-20181110.1413/nrepl-dict.el @@ -1,7 +1,7 @@ ;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*- ;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2017 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors ;; ;; Author: Tim King ;; Phil Hagelberg @@ -27,7 +27,7 @@ ;; ;;; Commentary: ;; -;; Provides functions to interact with and create `nrepl-dict's. These are +;; Provides functions to interact with and create `nrepl-dict's. These are ;; simply plists with an extra element at the head. ;;; Code: @@ -69,7 +69,7 @@ return nil. If DICT is not an nREPL dict object, an error is thrown." "Associate in DICT, KEY to VALUE. Return new dict. Dict is modified by side effects." (if (null dict) - (list 'dict key value) + `(dict ,key ,value) (if (not (nrepl-dict-p dict)) (error "Not an nREPL dict object: %s" dict) (setcdr dict (lax-plist-put (cdr dict) key value)) @@ -169,7 +169,7 @@ If NO-JOIN is given, return the first non nil dict." dict1) ((and (listp dict2) (listp dict1)) (append dict1 dict2)) ((listp dict1) (append dict1 (list dict2))) - (t (list dict1 dict2))))) + (t `(,dict1 ,dict2))))) ;;; Dbind -- 2.47.3