From dc69a7ed04c1c7637351646afb4b0981c321e711 Mon Sep 17 00:00:00 2001 From: Gergely Polonkai Date: Thu, 6 Oct 2016 10:53:40 +0200 Subject: [PATCH] Remove Clojure-related packages --- elpa/cider-20160927.2135/cider-apropos.el | 202 -- elpa/cider-20160927.2135/cider-autoloads.el | 315 --- elpa/cider-20160927.2135/cider-browse-ns.el | 219 -- elpa/cider-20160927.2135/cider-classpath.el | 112 - elpa/cider-20160927.2135/cider-client.el | 1129 --------- elpa/cider-20160927.2135/cider-common.el | 257 -- elpa/cider-20160927.2135/cider-compat.el | 157 -- elpa/cider-20160927.2135/cider-debug.el | 752 ------ elpa/cider-20160927.2135/cider-doc.el | 522 ---- elpa/cider-20160927.2135/cider-eldoc.el | 430 ---- elpa/cider-20160927.2135/cider-grimoire.el | 118 - elpa/cider-20160927.2135/cider-inspector.el | 389 --- elpa/cider-20160927.2135/cider-interaction.el | 1787 -------------- .../cider-macroexpansion.el | 207 -- elpa/cider-20160927.2135/cider-mode.el | 750 ------ elpa/cider-20160927.2135/cider-overlays.el | 311 --- elpa/cider-20160927.2135/cider-pkg.el | 12 - elpa/cider-20160927.2135/cider-popup.el | 129 - elpa/cider-20160927.2135/cider-repl.el | 1377 ----------- elpa/cider-20160927.2135/cider-resolve.el | 129 - elpa/cider-20160927.2135/cider-scratch.el | 75 - elpa/cider-20160927.2135/cider-selector.el | 167 -- elpa/cider-20160927.2135/cider-stacktrace.el | 716 ------ elpa/cider-20160927.2135/cider-test.el | 690 ------ elpa/cider-20160927.2135/cider-util.el | 691 ------ elpa/cider-20160927.2135/cider.el | 790 ------ elpa/cider-20160927.2135/nrepl-client.el | 1227 ---------- elpa/cider-20160927.2135/nrepl-dict.el | 187 -- .../clojure-mode-autoloads.el | 121 - .../clojure-mode-pkg.el | 2 - .../clojure-mode.el | 2116 ----------------- .../clojure-quick-repls-autoloads.el | 22 - .../clojure-quick-repls-pkg.el | 1 - .../clojure-quick-repls.el | 155 -- .../flycheck-clojure-autoloads.el | 29 - .../flycheck-clojure-pkg.el | 1 - .../flycheck-clojure.el | 221 -- init.el | 2 +- 38 files changed, 1 insertion(+), 16516 deletions(-) delete mode 100644 elpa/cider-20160927.2135/cider-apropos.el delete mode 100644 elpa/cider-20160927.2135/cider-autoloads.el delete mode 100644 elpa/cider-20160927.2135/cider-browse-ns.el delete mode 100644 elpa/cider-20160927.2135/cider-classpath.el delete mode 100644 elpa/cider-20160927.2135/cider-client.el delete mode 100644 elpa/cider-20160927.2135/cider-common.el delete mode 100644 elpa/cider-20160927.2135/cider-compat.el delete mode 100644 elpa/cider-20160927.2135/cider-debug.el delete mode 100644 elpa/cider-20160927.2135/cider-doc.el delete mode 100644 elpa/cider-20160927.2135/cider-eldoc.el delete mode 100644 elpa/cider-20160927.2135/cider-grimoire.el delete mode 100644 elpa/cider-20160927.2135/cider-inspector.el delete mode 100644 elpa/cider-20160927.2135/cider-interaction.el delete mode 100644 elpa/cider-20160927.2135/cider-macroexpansion.el delete mode 100644 elpa/cider-20160927.2135/cider-mode.el delete mode 100644 elpa/cider-20160927.2135/cider-overlays.el delete mode 100644 elpa/cider-20160927.2135/cider-pkg.el delete mode 100644 elpa/cider-20160927.2135/cider-popup.el delete mode 100644 elpa/cider-20160927.2135/cider-repl.el delete mode 100644 elpa/cider-20160927.2135/cider-resolve.el delete mode 100644 elpa/cider-20160927.2135/cider-scratch.el delete mode 100644 elpa/cider-20160927.2135/cider-selector.el delete mode 100644 elpa/cider-20160927.2135/cider-stacktrace.el delete mode 100644 elpa/cider-20160927.2135/cider-test.el delete mode 100644 elpa/cider-20160927.2135/cider-util.el delete mode 100644 elpa/cider-20160927.2135/cider.el delete mode 100644 elpa/cider-20160927.2135/nrepl-client.el delete mode 100644 elpa/cider-20160927.2135/nrepl-dict.el delete mode 100644 elpa/clojure-mode-20161004.2314/clojure-mode-autoloads.el delete mode 100644 elpa/clojure-mode-20161004.2314/clojure-mode-pkg.el delete mode 100644 elpa/clojure-mode-20161004.2314/clojure-mode.el delete mode 100644 elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-autoloads.el delete mode 100644 elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-pkg.el delete mode 100644 elpa/clojure-quick-repls-20150814.36/clojure-quick-repls.el delete mode 100644 elpa/flycheck-clojure-20160704.1221/flycheck-clojure-autoloads.el delete mode 100644 elpa/flycheck-clojure-20160704.1221/flycheck-clojure-pkg.el delete mode 100644 elpa/flycheck-clojure-20160704.1221/flycheck-clojure.el diff --git a/elpa/cider-20160927.2135/cider-apropos.el b/elpa/cider-20160927.2135/cider-apropos.el deleted file mode 100644 index 43b4e19..0000000 --- a/elpa/cider-20160927.2135/cider-apropos.el +++ /dev/null @@ -1,202 +0,0 @@ -;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014-2016 Jeff Valk, Bozhidar Batsov and CIDER contributors -;; -;; Author: Jeff Valk - -;; 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: - -;; Apropos functionality for Clojure. - -;;; Code: - -(require 'cider-doc) -(require 'cider-util) -(require 'cider-compat) - -(require 'cider-client) -(require 'cider-popup) -(require 'nrepl-dict) - -(require 'clojure-mode) -(require 'apropos) -(require 'button) - -(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)) - "Controls the actions to be applied on the symbol found by an apropos search. -The first action key in the list will be selected as default. If the list -contains only one action key, the associated action function will be -applied automatically. An action function can be any function that receives -the symbol found by the apropos search as argument." - :type '(alist :key-type string :value-type function) - :group 'cider - :package-version '(cider . "0.13.0")) - -(defun cider-apropos-doc (button) - "Display documentation for the symbol represented at BUTTON." - (cider-doc-lookup (button-get button 'apropos-symbol))) - -(defun cider-apropos-summary (query ns docs-p include-private-p case-sensitive-p) - "Return a short description for the performed apropos search. - -QUERY can be a regular expression 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 INCLUDE-PRIVATE-P), -and be case-sensitive (based on CASE-SENSITIVE-P)." - (concat (if case-sensitive-p "Case-sensitive " "") - (if docs-p "Documentation " "") - (format "Apropos for %S" query) - (if ns (format " in namespace %S" ns) "") - (if include-private-p - " (public and private symbols)" - " (public symbols only)"))) - -(defun cider-apropos-highlight (doc query) - "Return the DOC string propertized to highlight QUERY matches." - (let ((pos 0)) - (while (string-match query doc pos) - (setq pos (match-end 0)) - (put-text-property (match-beginning 0) - (match-end 0) - 'font-lock-face apropos-match-face doc))) - doc) - -(defun cider-apropos-result (result query docs-p) - "Emit a RESULT matching QUERY into current buffer, formatted for DOCS-P." - (nrepl-dbind-response result (name type doc) - (let* ((label (capitalize (if (string= type "variable") "var" type))) - (help (concat "Display doc for this " (downcase label)))) - (cider-propertize-region (list 'apropos-symbol name - 'action 'cider-apropos-doc - 'help-echo help) - (insert-text-button name 'type 'apropos-symbol) - (insert "\n ") - (insert-text-button label 'type (intern (concat "apropos-" type))) - (insert ": ") - (let ((beg (point))) - (if docs-p - (insert (cider-apropos-highlight doc query) "\n") - (insert doc) - (fill-region beg (point)))) - (insert "\n"))))) - -(declare-function cider-mode "cider-mode") - -(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) - (let ((inhibit-read-only t)) - (apropos-mode) - (if (boundp 'header-line-format) - (setq-local header-line-format summary) - (insert summary "\n\n")) - (dolist (result results) - (cider-apropos-result result query docs-p)) - (goto-char (point-min))))) - -;;;###autoload -(defun cider-apropos (query &optional ns docs-p privates-p case-sensitive-p) - "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)." - (interactive - (cons (read-string "Search for Clojure symbol (a regular expression): ") - (when current-prefix-arg - (list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list)))) - (if (string= ns "") nil ns)) - (y-or-n-p "Search doc strings? ") - (y-or-n-p "Include private symbols? ") - (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))) - (cider-show-apropos summary results query docs-p) - (message "No apropos matches for %S" query))) - -;;;###autoload -(defun cider-apropos-documentation () - "Shortcut for (cider-apropos nil t)." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (cider-apropos (read-string "Search for Clojure documentation (a regular expression): ") nil t)) - -(defun cider-apropos-act-on-symbol (symbol) - "Apply selected action on SYMBOL." - (let* ((first-action-key (car (car cider-apropos-actions))) - (action-key (if (= 1 (length cider-apropos-actions)) - first-action-key - (completing-read (format "Choose action to apply to `%s` (default %s): " - symbol first-action-key) - cider-apropos-actions nil nil nil nil first-action-key))) - (action-fn (cdr (assoc action-key cider-apropos-actions)))) - (if action-fn - (funcall action-fn symbol) - (user-error "Unknown action `%s`" action-key)))) - -;;;###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 -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)." - (interactive - (cons (read-string "Search for Clojure symbol (a regular expression): ") - (when current-prefix-arg - (list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list)))) - (if (string= ns "") nil ns)) - (y-or-n-p "Search doc strings? ") - (y-or-n-p "Include private symbols? ") - (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)))) - (cider-apropos-act-on-symbol (completing-read (concat summary ": ") results)) - (message "No apropos matches for %S" query))) - -;;;###autoload -(defun cider-apropos-documentation-select () - "Shortcut for (cider-apropos-select nil t)." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (cider-apropos-select (read-string "Search for Clojure documentation (a regular expression): ") nil t)) - -(provide 'cider-apropos) - -;;; cider-apropos.el ends here diff --git a/elpa/cider-20160927.2135/cider-autoloads.el b/elpa/cider-20160927.2135/cider-autoloads.el deleted file mode 100644 index e85d9f9..0000000 --- a/elpa/cider-20160927.2135/cider-autoloads.el +++ /dev/null @@ -1,315 +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" (22508 49905 421980 342000)) -;;; 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" (22508 49905 -;;;;;; 341980 175000)) -;;; 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" (22508 -;;;;;; 49905 313980 117000)) -;;; 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" (22508 -;;;;;; 49905 433980 367000)) -;;; 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" (22508 49905 -;;;;;; 325980 141000)) -;;; 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" (22508 -;;;;;; 49905 377980 250000)) -;;; 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" (22508 -;;;;;; 49905 369980 234000)) -;;; 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" -;;;;;; (22508 49905 413980 326000)) -;;; 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" (22508 49905 349980 -;;;;;; 192000)) -;;; 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' 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-scratch" "cider-scratch.el" (22508 49905 -;;;;;; 357980 209000)) -;;; 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" (22508 -;;;;;; 49905 425980 351000)) -;;; 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" (22508 49905 405980 -;;;;;; 309000)) -;;; 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" (22508 49905 417980 -;;;;;; 334000)) -;;; 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") -;;;;;; (22508 49905 437980 375000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; cider-autoloads.el ends here diff --git a/elpa/cider-20160927.2135/cider-browse-ns.el b/elpa/cider-20160927.2135/cider-browse-ns.el deleted file mode 100644 index db694f2..0000000 --- a/elpa/cider-20160927.2135/cider-browse-ns.el +++ /dev/null @@ -1,219 +0,0 @@ -;;; cider-browse-ns.el --- CIDER namespace browser - -;; Copyright © 2014-2016 John Andrews, Bozhidar Batsov and CIDER contributors - -;; Author: John Andrews - -;; 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-ns -;; -;; Display a list of all vars in a namespace. -;; Pressing will take you to the cider-doc buffer for that var. -;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode'). - -;; M-x cider-browse-ns-all -;; -;; Explore Clojure namespaces by browsing a list of all namespaces. -;; Pressing expands into a list of that namespace's vars as if by -;; executing the command (cider-browse-ns "my.ns"). - -;;; Code: - -(require 'cider-interaction) -(require 'cider-client) -(require 'cider-compat) -(require 'cider-util) -(require 'nrepl-dict) - -(defconst cider-browse-ns-buffer "*cider-ns-browser*") - -(push cider-browse-ns-buffer cider-ancillary-buffers) - -(defvar-local cider-browse-ns-current-ns nil) - -;; Mode Definition - -(defvar cider-browse-ns-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map "d" #'cider-browse-ns-doc-at-point) - (define-key map "s" #'cider-browse-ns-find-at-point) - (define-key map (kbd "RET") #'cider-browse-ns-operate-at-point) - (define-key map "^" #'cider-browse-ns-all) - (define-key map "n" #'next-line) - (define-key map "p" #'previous-line) - map)) - -(defvar cider-browse-ns-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'cider-browse-ns-handle-mouse) - map)) - -(define-derived-mode cider-browse-ns-mode special-mode "browse-ns" - "Major mode for browsing Clojure namespaces. - -\\{cider-browse-ns-mode-map}" - (setq buffer-read-only t) - (setq-local electric-indent-chars nil) - (setq-local truncate-lines t) - (setq-local cider-browse-ns-current-ns nil)) - -(defun cider-browse-ns--text-face (var-meta) - "Return font-lock-face for a var. -VAR-META contains the metadata information used to decide a face. -Presence of \"arglists-str\" and \"macro\" indicates a macro form. -Only \"arglists-str\" indicates a function. Otherwise, its a variable. -If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn." - (cond - ((not var-meta) 'font-lock-function-name-face) - ((and (nrepl-dict-contains var-meta "arglists") - (string= (nrepl-dict-get var-meta "macro") "true")) - 'font-lock-keyword-face) - ((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face) - (t 'font-lock-variable-name-face))) - -(defun cider-browse-ns--properties (var var-meta) - "Decorate VAR with a clickable keymap and a face. -VAR-META is used to decide a font-lock face." - (let ((face (cider-browse-ns--text-face var-meta))) - (propertize var - 'font-lock-face face - 'mouse-face 'highlight - 'keymap cider-browse-ns-mouse-map))) - -(defun cider-browse-ns--list (buffer title items &optional ns noerase) - "Reset contents of BUFFER. -Display TITLE at the top and ITEMS are indented underneath. -If NS is non-nil, it is added to each item as the -`cider-browse-ns-current-ns' text property. If NOERASE is non-nil, the -contents of the buffer are not reset before inserting TITLE and ITEMS." - (with-current-buffer buffer - (cider-browse-ns-mode) - (let ((inhibit-read-only t)) - (unless noerase (erase-buffer)) - (goto-char (point-max)) - (insert (cider-propertize title 'ns) "\n") - (dolist (item items) - (insert (propertize (concat " " item "\n") - 'cider-browse-ns-current-ns ns))) - (goto-char (point-min))))) - -(defun cider-browse-ns--first-doc-line (doc) - "Return the first line of the given DOC string. -If the first line of the DOC string contains multiple sentences, only -the first sentence is returned. If the DOC string is nil, a Not documented -string is returned." - (if doc - (let* ((split-newline (split-string doc "\n")) - (first-line (car split-newline))) - (cond - ((string-match "\\. " first-line) (substring first-line 0 (match-end 0))) - ((= 1 (length split-newline)) first-line) - (t (concat first-line "...")))) - "Not documented.")) - -(defun cider-browse-ns--items (namespace) - "Return the items to show in the namespace browser of the given NAMESPACE. -Each item consists of a ns-var and the first line of its docstring." - (let* ((ns-vars-with-meta (cider-sync-request:ns-vars-with-meta namespace)) - (propertized-ns-vars (nrepl-dict-map #'cider-browse-ns--properties ns-vars-with-meta))) - (mapcar (lambda (ns-var) - (let* ((doc (nrepl-dict-get-in ns-vars-with-meta (list ns-var "doc"))) - ;; to avoid (read nil) - ;; it prompts the user for a Lisp expression - (doc (when doc (read doc))) - (first-doc-line (cider-browse-ns--first-doc-line doc))) - (concat ns-var " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face)))) - propertized-ns-vars))) - -;; Interactive Functions - -;;;###autoload -(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) - (cider-browse-ns--list (current-buffer) - namespace - (cider-browse-ns--items namespace)) - (setq-local cider-browse-ns-current-ns namespace))) - -;;;###autoload -(defun cider-browse-ns-all () - "List all loaded namespaces in BUFFER." - (interactive) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t) - (let ((names (cider-sync-request:ns-list))) - (cider-browse-ns--list (current-buffer) - "All loaded namespaces" - (mapcar (lambda (name) - (cider-browse-ns--properties name nil)) - names)) - (setq-local cider-browse-ns-current-ns nil)))) - -(defun cider-browse-ns--thing-at-point () - "Get the thing at point. -Return a list of the type ('ns or 'var) and the value." - (let ((line (car (split-string (cider-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))))) - -(defun cider-browse-ns-doc-at-point () - "Show the documentation for the thing at current point." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (value (cadr thing))) - ;; value is either some ns or a var - (cider-doc-lookup value))) - -(defun cider-browse-ns-operate-at-point () - "Expand browser according to thing at current point. -If the thing at point is a ns it will be browsed, -and if the thing at point is some var - its documentation will -be displayed." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (type (car thing)) - (value (cadr thing))) - (if (eq type 'ns) - (cider-browse-ns value) - (cider-doc-lookup value)))) - -(defun cider-browse-ns-find-at-point () - "Find the definition of the thing at point." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (type (car thing)) - (value (cadr thing))) - (if (eq type 'ns) - (cider-find-ns nil value) - (cider-find-var current-prefix-arg value)))) - -(defun cider-browse-ns-handle-mouse (event) - "Handle mouse click EVENT." - (interactive "e") - (cider-browse-ns-operate-at-point)) - -(provide 'cider-browse-ns) - -;;; cider-browse-ns.el ends here diff --git a/elpa/cider-20160927.2135/cider-classpath.el b/elpa/cider-20160927.2135/cider-classpath.el deleted file mode 100644 index 19e6d1b..0000000 --- a/elpa/cider-20160927.2135/cider-classpath.el +++ /dev/null @@ -1,112 +0,0 @@ -;;; cider-classpath.el --- Basic Java classpath browser - -;; Copyright © 2014-2016 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 -;; 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: - -;; Basic Java classpath browser for CIDER. - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-compat) - -(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) - (define-key map (kbd "RET") #'cider-classpath-operate-on-point) - (define-key map "n" #'next-line) - (define-key map "p" #'previous-line) - map)) - -(defvar cider-classpath-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'cider-classpath-handle-mouse) - map)) - -(define-derived-mode cider-classpath-mode special-mode "classpath" - "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 truncate-lines t)) - -(defun cider-classpath-list (buffer items) - "Populate BUFFER with ITEMS." - (with-current-buffer buffer - (cider-classpath-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (dolist (item items) - (insert item "\n")) - (goto-char (point-min))))) - -(defun cider-classpath-properties (text) - "Decorate TEXT with a clickable keymap and function face." - (let ((face (cond - ((not (file-exists-p text)) 'font-lock-warning-face) - ((file-directory-p text) 'dired-directory) - (t 'default)))) - (propertize text - 'font-lock-face face - 'mouse-face 'highlight - 'keymap cider-classpath-mouse-map))) - -(defun cider-classpath-operate-on-point () - "Expand browser according to thing at current point." - (interactive) - (let* ((bol (line-beginning-position)) - (eol (line-end-position)) - (line (buffer-substring-no-properties bol eol))) - (find-file-other-window line))) - -(defun cider-classpath-handle-mouse (event) - "Handle mouse click EVENT." - (interactive "e") - (cider-classpath-operate-on-point)) - -;;;###autoload -(defun cider-classpath () - "List all classpath entries." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "classpath") - (with-current-buffer (cider-popup-buffer cider-classpath-buffer t) - (cider-classpath-list (current-buffer) - (mapcar (lambda (name) - (cider-classpath-properties name)) - (cider-sync-request:classpath))))) - -;;;###autoload -(defun cider-open-classpath-entry () - "Open a classpath entry." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "classpath") - (when-let ((entry (completing-read "Classpath entries: " (cider-sync-request:classpath)))) - (find-file-other-window entry))) - -(provide 'cider-classpath) - -;;; cider-classpath.el ends here diff --git a/elpa/cider-20160927.2135/cider-client.el b/elpa/cider-20160927.2135/cider-client.el deleted file mode 100644 index c6b5959..0000000 --- a/elpa/cider-20160927.2135/cider-client.el +++ /dev/null @@ -1,1129 +0,0 @@ -;;; cider-client.el --- A layer of abstraction above the actual client code. -*- lexical-binding: t -*- - -;; Copyright © 2013-2016 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 '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-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}" - (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 - (cider-current-session) - 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) - (cider-current-session) - 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) - (cider-current-tooling-session) - ns)) - -(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) - (cider-current-session)))))) - -(defun cider-current-session () - "The REPL session to use for this buffer." - (with-current-buffer (cider-current-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 current tooling session." - (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" - "session" (cider-current-session) - "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" - "session" ,(cider-current-session) - "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" - "session" (cider-current-session)) - (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" - "session" (cider-current-session) - "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" - "session" ,(cider-current-session) - "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" - "session" ,(cider-current-session) - "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 - "session" (cider-current-session)) - (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" - "session" (cider-current-session) - "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" - "session" (cider-current-session) - "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" - "session" (cider-current-session)) - (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" - "session" (cider-current-session) - "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" - "session" (cider-current-session)) - (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" - "session" (cider-current-session) - "code" code) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "formatted-code"))) - -(defun cider-sync-request:format-edn (edn &optional right-margin) - "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." - (let* ((response (thread-first (list "op" "format-edn" - "session" (cider-current-session) - "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-20160927.2135/cider-common.el b/elpa/cider-20160927.2135/cider-common.el deleted file mode 100644 index d6166d4..0000000 --- a/elpa/cider-20160927.2135/cider-common.el +++ /dev/null @@ -1,257 +0,0 @@ -;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- - -;; Copyright © 2015-2016 Artur Malabarba - -;; Author: 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 . - -;;; Commentary: - -;; Common functions that are useful in both Clojure buffers and REPL -;; buffers. - -;;; Code: - -(require 'cider-compat) -(require 'nrepl-dict) -(require 'cider-util) -(require 'tramp) - -(defcustom cider-prompt-for-symbol t - "Controls when to prompt for symbol when a command requires one. - -When non-nil, always prompt, and use the symbol at point as the default -value at the prompt. - -When nil, attempt to use the symbol at point for the command, and only -prompt if that throws an error." - :type '(choice (const :tag "always" t) - (const :tag "dwim" nil)) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defun cider--should-prompt-for-symbol (&optional invert) - "Return the value of the variable `cider-prompt-for-symbol'. -Optionally invert the value, if INVERT is truthy." - (if invert (not cider-prompt-for-symbol) cider-prompt-for-symbol)) - -(defun cider-prompt-for-symbol-function (&optional invert) - "Prompt for symbol if funcall `cider--should-prompt-for-symbol' is truthy. -Otherwise attempt to use the symbol at point for the command, and only -prompt if that throws an error. - -INVERT is used to invert the semantics of the function `cider--should-prompt-for-symbol'." - (if (cider--should-prompt-for-symbol invert) - #'cider-read-symbol-name - #'cider-try-symbol-at-point)) - -(defun cider--kw-to-symbol (kw) - "Convert the keyword KW to a symbol." - (when kw - (replace-regexp-in-string "\\`:+" "" kw))) - -(declare-function cider-read-from-minibuffer "cider-interaction") - -(defun cider-read-symbol-name (prompt callback) - "Read a symbol name using PROMPT with a default of the one at point. -Use CALLBACK as the completing read var callback." - (funcall callback (cider-read-from-minibuffer - prompt - ;; if the thing at point is a keyword we treat it as symbol - (cider--kw-to-symbol (cider-symbol-at-point 'look-back))))) - -(defun cider-try-symbol-at-point (prompt callback) - "Call CALLBACK with symbol at point. -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") - -(defun cider--find-buffer-for-file (file) - "Return a buffer visiting FILE. -If FILE is a temp buffer name, return that buffer." - (if (string-prefix-p "*" file) - file - (and file - (not (cider--tooling-file-p file)) - (cider-find-file file)))) - -(defun cider--jump-to-loc-from-info (info &optional other-window) - "Jump to location give by INFO. -INFO object is returned by `cider-var-info' or `cider-member-info'. -OTHER-WINDOW is passed to `cider-jump-to'." - (let* ((line (nrepl-dict-get info "line")) - (file (nrepl-dict-get info "file")) - (name (nrepl-dict-get info "name")) - ;; the filename might actually be a REPL buffer name - (buffer (cider--find-buffer-for-file file))) - (if buffer - (cider-jump-to buffer (if line (cons line nil) name) other-window) - (error "No source location")))) - -(declare-function url-filename "url-parse" (cl-x) t) - -(defun cider--url-to-file (url) - "Return the filename from the resource URL. -Uses `url-generic-parse-url' to parse the url. The filename is extracted and -then url decoded. If the decoded filename has a Windows device letter followed -by a colon immediately after the leading '/' then the leading '/' is dropped to -create a valid path." - (let ((filename (url-unhex-string (url-filename (url-generic-parse-url url))))) - (if (string-match "^/\\([a-zA-Z]:/.*\\)" filename) - (match-string 1 filename) - filename))) - -(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." - (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))))) - -(defun cider--client-tramp-filename (name &optional buffer) - "Return the tramp filename for path NAME relative to BUFFER. -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 (concat (cider-tramp-prefix buffer) name))) - (if (tramp-handle-file-exists-p name) - name))) - -(defun cider--server-filename (name) - "Return the nREPL server-relative filename for NAME." - (if (tramp-tramp-file-p name) - (with-parsed-tramp-file-name name nil - localname) - name)) - -(defvar cider-from-nrepl-filename-function - (with-no-warnings - (if (eq system-type 'cygwin) - #'cygwin-convert-file-name-from-windows - #'identity)) - "Function to translate nREPL namestrings to Emacs filenames.") - -(defcustom cider-prefer-local-resources nil - "Prefer local resources to remote (tramp) ones when both are available." - :type 'boolean - :group 'cider) - -(defun cider--file-path (path) - "Return PATH's local or tramp path using `cider-prefer-local-resources'. -If no local or remote file exists, return nil." - (let* ((local-path (funcall cider-from-nrepl-filename-function path)) - (tramp-path (and local-path (cider--client-tramp-filename local-path)))) - (cond ((equal local-path "") "") - ((and cider-prefer-local-resources (file-exists-p local-path)) - local-path) - ((and tramp-path (file-exists-p tramp-path)) - tramp-path) - ((and local-path (file-exists-p local-path)) - local-path)))) - -(declare-function archive-extract "arc-mode") -(declare-function archive-zip-extract "arc-mode") - -(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." - (require 'arc-mode) - (cond ((string-match "^file:\\(.+\\)" url) - (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))) - (find-file-noselect path) - (unless (file-name-absolute-p url) - (let ((cider-buffers (cider-util--clojure-buffers)) - (url (file-name-nondirectory url))) - (or (cl-loop for bf in cider-buffers - for path = (with-current-buffer bf - (expand-file-name url)) - if (and path (file-exists-p path)) - return (find-file-noselect path)) - (cl-loop for bf in cider-buffers - if (string= (buffer-name bf) url) - return bf)))))))) - -(defun cider--open-other-window-p (arg) - "Test prefix value ARG to see if it indicates displaying results in other window." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (-1 t) ; - - (16 t) ; empty empty - (_ nil)))) - -(defun cider-abbreviate-ns (namespace) - "Return a string that abbreviates NAMESPACE." - (when namespace - (let* ((names (reverse (split-string namespace "\\."))) - (lastname (car names))) - (concat (mapconcat (lambda (s) (concat (substring s 0 1) ".")) - (reverse (cdr names)) - "") - lastname)))) - -(defun cider-last-ns-segment (namespace) - "Return the last segment of NAMESPACE." - (when namespace - (car (reverse (split-string namespace "\\."))))) - - -(provide 'cider-common) -;;; cider-common.el ends here diff --git a/elpa/cider-20160927.2135/cider-compat.el b/elpa/cider-20160927.2135/cider-compat.el deleted file mode 100644 index 9585a52..0000000 --- a/elpa/cider-20160927.2135/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-2016 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.3 and 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-20160927.2135/cider-debug.el b/elpa/cider-20160927.2135/cider-debug.el deleted file mode 100644 index c7856d8..0000000 --- a/elpa/cider-20160927.2135/cider-debug.el +++ /dev/null @@ -1,752 +0,0 @@ -;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*- - -;; Copyright © 2015-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: 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 . - -;;; Commentary: - -;; Instrument code with `cider-debug-defun-at-point', and when the code is -;; executed cider-debug will kick in. See this function's doc for more -;; information. - -;;; Code: - -(require 'nrepl-dict) -(require 'nrepl-client) ; `nrepl--mark-id-completed' -(require 'cider-interaction) -(require 'cider-client) -(require 'cider-util) -(require 'cider-inspector) -(require 'cider-browse-ns) -(require 'cider-common) -(require 'cider-compat) -(require 'seq) -(require 'spinner) - - -;;; Customization -(defgroup cider-debug nil - "Presentation and behaviour of the cider debugger." - :prefix "cider-debug-" - :group 'cider - :package-version '(cider . "0.10.0")) - -(defface cider-debug-code-overlay-face - '((((class color) (background light)) :background "grey80") - (((class color) (background dark)) :background "grey30")) - "Face used to mark code being debugged." - :group 'cider-debug - :package-version '(cider . "0.9.1")) - -(defface cider-debug-prompt-face - '((t :underline t :inherit font-lock-builtin-face)) - "Face used to highlight keys in the debug prompt." - :group 'cider-debug - :package-version '(cider . "0.10.0")) - -(defface cider-enlightened-face - '((((class color) (background light)) :inherit cider-result-overlay-face - :box (:color "darkorange" :line-width -1)) - (((class color) (background dark)) :inherit cider-result-overlay-face - ;; "#dd0" is a dimmer yellow. - :box (:color "#990" :line-width -1))) - "Face used to mark enlightened sexps and their return values." - :group 'cider-debug - :package-version '(cider . "0.11.0")) - -(defface cider-enlightened-local-face - '((((class color) (background light)) :weight bold :foreground "darkorange") - (((class color) (background dark)) :weight bold :foreground "yellow")) - "Face used to mark enlightened locals (not their values)." - :group 'cider-debug - :package-version '(cider . "0.11.0")) - -(defcustom cider-debug-prompt 'overlay - "If and where to show the keys while debugging. -If `minibuffer', show it in the minibuffer along with the return value. -If `overlay', show it in an overlay above the current function. -If t, do both. -If nil, don't list available keys at all." - :type '(choice (const :tag "Show in minibuffer" minibuffer) - (const :tag "Show above function" overlay) - (const :tag "Show in both places" t) - (const :tag "Don't list keys" nil)) - :group 'cider-debug - :package-version '(cider . "0.10.0")) - -(defcustom cider-debug-use-overlays t - "Whether to higlight debugging information with overlays. -Takes the same possible values as `cider-use-overlays', but only applies to -values displayed during debugging sessions. -To control the overlay that lists possible keys above the current function, -configure `cider-debug-prompt' instead." - :type '(choice (const :tag "End of line" t) - (const :tag "Bottom of screen" nil) - (const :tag "Both" both)) - :group 'cider-debug - :package-version '(cider . "0.9.1")) - -(defcustom cider-debug-print-level 10 - "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)) - :group 'cider-debug - :package-version '(cider . "0.10.0")) - -(defcustom cider-debug-print-length 10 - "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)) - :group 'cider-debug - :package-version '(cider . "0.10.0")) - - -;;; Implementation -(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")))) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t) - (let ((inhibit-read-only t)) - (erase-buffer) - (dolist (list all) - (let* ((ns (car list)) - (ns-vars-with-meta (cider-sync-request:ns-vars-with-meta ns)) - ;; seq of metadata maps of the instrumented vars - (instrumented-meta (mapcar (apply-partially #'nrepl-dict-get ns-vars-with-meta) - (cdr list)))) - (cider-browse-ns--list (current-buffer) ns - (seq-mapn #'cider-browse-ns--properties - (cdr list) - instrumented-meta) - - ns 'noerase) - (goto-char (point-max)) - (insert "\n")))) - (goto-char (point-min))) - (message "No currently instrumented definitions"))) - -(defun cider--debug-response-handler (response) - "Handles RESPONSE from the cider.debug middleware." - (nrepl-dbind-response response (status id causes) - (when (member "enlighten" status) - (cider--handle-enlighten response)) - (when (or (member "eval-error" status) - (member "stack" status)) - ;; TODO: Make the error buffer a bit friendlier when we're just printing - ;; the stack. - (cider--render-stacktrace-causes causes)) - (when (member "need-debug-input" status) - (cider--handle-debug response)) - (when (member "done" status) - (nrepl--mark-id-completed id)))) - -(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))) - #'cider--debug-response-handler)) - - -;;; Debugging overlays -(defconst cider--fringe-arrow-string - #("." 0 1 (display (left-fringe right-triangle))) - "Used as an overlay's before-string prop to place a fringe arrow.") - -(defun cider--debug-display-result-overlay (value) - "Place an overlay at point displaying VALUE." - (when cider-debug-use-overlays - ;; This is cosmetic, let's ensure it doesn't break the session no matter what. - (ignore-errors - ;; Result - (cider--make-result-overlay (cider-font-lock-as-clojure value) - :where (point-marker) - :type 'debug-result - 'before-string cider--fringe-arrow-string) - ;; Code - (cider--make-overlay (save-excursion (clojure-backward-logical-sexp 1) (point)) - (point) 'debug-code - 'face 'cider-debug-code-overlay-face - ;; Higher priority than `show-paren'. - 'priority 2000)))) - - -;;; Minor mode -(defvar-local cider--debug-mode-commands-dict nil - "An nrepl-dict from keys to debug commands. -Autogenerated by `cider--turn-on-debug-mode'.") - -(defvar-local cider--debug-mode-response nil - "Response that triggered current debug session. -Set by `cider--turn-on-debug-mode'.") - -(defcustom cider-debug-display-locals nil - "If non-nil, local variables are displayed while debugging. -Can be toggled at any time with `\\[cider-debug-toggle-locals]'." - :type 'boolean - :group 'cider-debug - :package-version '(cider . "0.10.0")) - -(defun cider--debug-format-locals-list (locals) - "Return a string description of list LOCALS. -Each element of LOCALS should be a list of at least two elements." - (if locals - (let ((left-col-width - ;; To right-indent the variable names. - (apply #'max (mapcar (lambda (l) (string-width (car l))) locals)))) - ;; A format string to build a format string. :-P - (mapconcat (lambda (l) (format (format " %%%ds: %%s\n" left-col-width) - (propertize (car l) 'face 'font-lock-variable-name-face) - (cider-font-lock-as-clojure (cadr l)))) - locals "")) - "")) - -(defun cider--debug-prompt (command-dict) - "Return prompt to display for COMMAND-DICT." - ;; Force `default' face, otherwise the overlay "inherits" the face of the text - ;; after it. - (format (propertize "%s\n" 'face 'default) - (cider-string-join - (nrepl-dict-map (lambda (char cmd) - (when-let ((pos (cl-search char cmd))) - (put-text-property pos (1+ pos) 'face 'cider-debug-prompt-face cmd)) - cmd) - command-dict) - " "))) - -(defvar-local cider--debug-prompt-overlay nil) - -(defun cider--debug-mode-redisplay () - "Display the input prompt to the user." - (nrepl-dbind-response cider--debug-mode-response (debug-value input-type locals) - (when (or (eq cider-debug-prompt t) - (eq cider-debug-prompt 'overlay)) - (if (overlayp cider--debug-prompt-overlay) - (overlay-put cider--debug-prompt-overlay - 'before-string (cider--debug-prompt input-type)) - (setq cider--debug-prompt-overlay - (cider--make-overlay - (max (car (cider-defun-at-point 'bounds)) - (window-start)) - nil 'debug-prompt - 'before-string (cider--debug-prompt input-type))))) - (let* ((value (concat " " cider-eval-result-prefix - (cider-font-lock-as-clojure - (or debug-value "#unknown#")))) - (to-display - (concat (when cider-debug-display-locals - (cider--debug-format-locals-list locals)) - (when (or (eq cider-debug-prompt t) - (eq cider-debug-prompt 'minibuffer)) - (cider--debug-prompt input-type)) - (when (or (not cider-debug-use-overlays) - (eq cider-debug-use-overlays 'both)) - value)))) - (if (> (string-width to-display) 0) - (message "%s" to-display) - ;; If there's nothing to display in the minibuffer. Just send the value - ;; to the Messages buffer. - (message "%s" value) - (message nil))))) - -(defun cider-debug-toggle-locals () - "Toggle display of local variables." - (interactive) - (setq cider-debug-display-locals (not cider-debug-display-locals)) - (cider--debug-mode-redisplay)) - -(defun cider--debug-lexical-eval (key form &optional callback _point) - "Eval FORM in the lexical context of debug session given by KEY. -Do nothing if CALLBACK is provided. -Designed to be used as `cider-interactive-eval-override' and called instead -of `cider-interactive-eval' in debug sessions." - ;; The debugger uses its own callback, so if the caller is passing a callback - ;; we return nil and let `cider-interactive-eval' do its thing. - (unless callback - (cider-debug-mode-send-reply (format "{:response :eval, :code %s}" form) - key) - t)) - -(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 "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)) - -(defvar cider--debug-mode-map) - -(define-minor-mode cider--debug-mode - "Mode active during debug sessions. -In order to work properly, this mode must be activated by -`cider--turn-on-debug-mode'." - nil " DEBUG" '() - (if cider--debug-mode - (if cider--debug-mode-response - (nrepl-dbind-response cider--debug-mode-response (input-type) - ;; A debug session is an ongoing eval, but it's annoying to have the - ;; spinner spinning while you debug. - (when spinner-current (spinner-stop)) - (setq-local tool-bar-map cider--debug-mode-tool-bar-map) - (add-hook 'kill-buffer-hook #'cider--debug-quit nil 'local) - (add-hook 'before-revert-hook #'cider--debug-quit nil 'local) - (unless (consp input-type) - (error "Activated debug-mode on a message not asking for commands: %s" cider--debug-mode-response)) - ;; Integrate with eval commands. - (setq cider-interactive-eval-override - (apply-partially #'cider--debug-lexical-eval - (nrepl-dict-get cider--debug-mode-response "key"))) - ;; Set the keymap. - (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") - (define-key cider--debug-mode-map (upcase char) #'cider-debug-mode-send-reply))) - input-type) - (setq cider--debug-mode-commands-dict input-type) - ;; Show the prompt. - (cider--debug-mode-redisplay) - ;; If a sync request is ongoing, the user can't act normally to - ;; provide input, so we enter `recursive-edit'. - (when nrepl-ongoing-sync-request - (recursive-edit))) - (cider--debug-mode -1) - (if (called-interactively-p 'any) - (user-error (substitute-command-keys "Don't call this mode manually, use `\\[universal-argument] \\[cider-eval-defun-at-point]' instead")) - (error "Attempt to activate `cider--debug-mode' without setting `cider--debug-mode-response' first"))) - (setq cider-interactive-eval-override nil) - (setq cider--debug-mode-commands-dict nil) - (setq cider--debug-mode-response nil) - ;; 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))))) - (accept-process-output proc 1)) - (unless cider--debug-mode - (setq buffer-read-only nil) - (cider--debug-remove-overlays (current-buffer))) - (when nrepl-ongoing-sync-request - (ignore-errors (exit-recursive-edit))))) - -;;; Bind the `:here` command to both h and H, because it behaves differently if -;;; invoked with an uppercase letter. -(define-key cider--debug-mode-map "h" #'cider-debug-move-here) -(define-key cider--debug-mode-map "H" #'cider-debug-move-here) - -(defun cider--debug-remove-overlays (&optional buffer) - "Remove CIDER debug overlays from BUFFER if variable `cider--debug-mode' is nil." - (when (or (not buffer) (buffer-live-p buffer)) - (with-current-buffer (or buffer (current-buffer)) - (unless cider--debug-mode - (kill-local-variable 'tool-bar-map) - (remove-overlays nil nil 'category 'debug-result) - (remove-overlays nil nil 'category 'debug-code) - (setq cider--debug-prompt-overlay nil) - (remove-overlays nil nil 'category 'debug-prompt))))) - -(defun cider--debug-set-prompt (value) - "Set `cider-debug-prompt' to VALUE, then redisplay." - (setq cider-debug-prompt value) - (cider--debug-mode-redisplay)) - -(easy-menu-define cider-debug-mode-menu cider--debug-mode-map - "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"] - ["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"] - ["Quit" (cider-debug-mode-send-reply ":quit") :keys "q"] - "--" - ["Evaluate in current scope" (cider-debug-mode-send-reply ":eval") :keys "e"] - ["Inject value" (cider-debug-mode-send-reply ":inject") :keys "i"] - ["Inspect value" (cider-debug-mode-send-reply ":inspect")] - ["Inspect local variables" (cider-debug-mode-send-reply ":locals") :keys "l"] - "--" - ("Configure keys prompt" - ["Don't show keys" (cider--debug-set-prompt nil) :style toggle :selected (eq cider-debug-prompt nil)] - ["Show in minibuffer" (cider--debug-set-prompt 'minibuffer) :style toggle :selected (eq cider-debug-prompt 'minibuffer)] - ["Show above function" (cider--debug-set-prompt 'overlay) :style toggle :selected (eq cider-debug-prompt 'overlay)] - ["Show in both places" (cider--debug-set-prompt t) :style toggle :selected (eq cider-debug-prompt t)] - "--" - ["List locals" cider-debug-toggle-locals :style toggle :selected cider-debug-display-locals]) - ["Customize" (customize-group 'cider-debug)])) - -(defun cider--uppercase-command-p () - "Return true if the last command was uppercase letter." - (ignore-errors - (let ((case-fold-search nil)) - (string-match "[[:upper:]]" (string last-command-event))))) - -(defun cider-debug-mode-send-reply (command &optional key force) - "Reply to the message that started current bufer's debugging session. -COMMAND is sent as the input option. KEY can be provided to reply to a -specific message. If FORCE is non-nil, send a \"force?\" argument in the -message." - (interactive (list - (if (symbolp last-command-event) - (symbol-name last-command-event) - (ignore-errors - (concat ":" (nrepl-dict-get cider--debug-mode-commands-dict - (downcase (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")))) - (ignore-errors (cider--debug-mode -1))) - -(defun cider--debug-quit () - "Send a :quit reply to the debugger. Used in hooks." - (when cider--debug-mode - (cider-debug-mode-send-reply ":quit") - (message "Quitting debug session"))) - - -;;; Movement logic -(defconst cider--debug-buffer-format "*cider-debug %s*") - -(defun cider--debug-trim-code (code) - "Remove whitespace and reader macros from the start of the CODE. -Return trimmed CODE." - (replace-regexp-in-string "\\`#[a-z]+[\n\r[:blank:]]*" "" code)) - -(declare-function cider-set-buffer-ns "cider-mode") -(defun cider--initialize-debug-buffer (code ns id &optional reason) - "Create a new debugging buffer with CODE and namespace NS. -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))) - (cider-popup-buffer-display buffer 'select) - (with-current-buffer (cider-popup-buffer buffer-name 'select - #'clojure-mode 'ancillary) - (cider-set-buffer-ns ns) - (setq buffer-undo-list nil) - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (erase-buffer) - (insert (format "%s" (cider--debug-trim-code code))) - (when code - (insert "\n\n\n;; We had to create this temporary buffer because we couldn't find the original definition. That probably happened because " - reason - ".") - (fill-paragraph)) - (cider--font-lock-ensure) - (set-buffer-modified-p nil)))) - (switch-to-buffer buffer-name) - (goto-char (point-min)))) - -(defun cider--debug-goto-keyval (key) - "Find KEY in current sexp or return nil." - (when-let ((limit (ignore-errors (save-excursion (up-list) (point))))) - (search-forward-regexp (concat "\\_<" (regexp-quote key) "\\_>") - limit 'noerror))) - -(defun cider--debug-move-point (coordinates) - "Place point on after the sexp specified by COORDINATES. -COORDINATES is a list of integers that specify how to navigate into the -sexp that is after point when this function is called. - -As an example, a COORDINATES list of '(1 0 2) means: - - enter next sexp then `forward-sexp' once, - - enter next sexp, - - enter next sexp then `forward-sexp' twice. - -In the following snippet, this takes us to the (* x 2) sexp (point is left -at the end of the given sexp). - - (letfn [(twice [x] - (* x 2))] - (twice 15)) - -In addition to numbers, a coordinate can be a string. This string names the -key of a map, and it means \"go to the value associated with this key\"." - (condition-case-unless-debug nil - ;; Navigate through sexps inside the sexp. - (let ((in-syntax-quote nil)) - (while coordinates - (while (clojure--looking-at-non-logical-sexp) - (forward-sexp)) - ;; An `@x` is read as (deref x), so we pop coordinates once to account - ;; for the extra depth, and move past the @ char. - (if (eq ?@ (char-after)) - (progn (forward-char 1) - (pop coordinates)) - (down-list) - ;; Are we entering a syntax-quote? - (when (looking-back "`\\(#{\\|[{[(]\\)" (line-beginning-position)) - ;; If we are, this affects all nested structures until the next `~', - ;; so we set this variable for all following steps in the loop. - (setq in-syntax-quote t)) - (when in-syntax-quote - ;; A `(. .) is read as (seq (concat (list .) (list .))). This pops - ;; the `seq', since the real coordinates are inside the `concat'. - (pop coordinates) - ;; Non-list seqs like `[] and `{} are read with - ;; an extra (apply vector ...), so pop it too. - (unless (eq ?\( (char-before)) - (pop coordinates))) - ;; #(...) is read as (fn* ([] ...)), so we patch that here. - (when (looking-back "#(" (line-beginning-position)) - (pop coordinates)) - (if coordinates - (let ((next (pop coordinates))) - (when in-syntax-quote - ;; We're inside the `concat' form, but we need to discard the - ;; actual `concat' symbol from the coordinate. - (setq next (1- next))) - ;; String coordinates are map keys. - (if (stringp next) - (cider--debug-goto-keyval next) - (clojure-forward-logical-sexp next) - (when in-syntax-quote - (clojure-forward-logical-sexp 1) - (forward-sexp -1) - ;; Here a syntax-quote is ending. - (let ((match (when (looking-at "~@?") - (match-string 0)))) - (when match - (setq in-syntax-quote nil)) - ;; A `~@' is read as the object itself, so we don't pop - ;; anything. - (unless (equal "~@" match) - ;; Anything else (including a `~') is read as a `list' - ;; form inside the `concat', so we need to pop the list - ;; from the coordinates. - (pop coordinates)))))) - ;; If that extra pop was the last coordinate, this represents the - ;; entire #(...), so we should move back out. - (backward-up-list)))) - ;; Place point at the end of instrumented sexp. - (clojure-forward-logical-sexp 1)) - ;; Avoid throwing actual errors, since this happens on every breakpoint. - (error (message "Can't find instrumented sexp, did you edit the source?")))) - -(defun cider--debug-position-for-code (code) - "Return non-nil if point is roughly before CODE. -This might move point one line above." - (or (looking-at-p (regexp-quote code)) - (let ((trimmed (regexp-quote (cider--debug-trim-code code)))) - (or (looking-at-p trimmed) - ;; If this is a fake #dbg injected by `C-u - ;; C-M-x', then the sexp we want is actually on - ;; the line above. - (progn (forward-line -1) - (looking-at-p trimmed)))))) - -(defun cider--debug-find-source-position (response &optional create-if-needed) - "Return a marker of the position after the sexp specified in RESPONSE. -This marker might be in a different buffer! If the sexp can't be -found (file that contains the code is no longer visited or has been -edited), return nil. However, if CREATE-IF-NEEDED is non-nil, a new buffer -is created in this situation and the return value is never nil. - -Follow the \"line\" and \"column\" entries in RESPONSE, and check whether -the code at point matches the \"code\" entry in RESPONSE. If it doesn't, -assume that the code in this file has been edited, and create a temp buffer -holding the original code. -Either way, navigate inside the code by following the \"coor\" entry which -is a coordinate measure in sexps." - (nrepl-dbind-response response (code file line column ns original-id coor) - (when (or code (and file line column)) - ;; This is for restoring current-buffer. - (save-excursion - (let ((out)) - ;; We prefer in-source debugging. - (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. - (save-excursion - ;; Get to the proper line & column in the file - (forward-line (- line (line-number-at-pos))) - (move-to-column column) - ;; Check if it worked - (when (cider--debug-position-for-code code) - ;; Find the desired sexp. - (cider--debug-move-point coor) - (setq out (point-marker)))))) - ;; But we can create a temp buffer if that fails. - (or out - (when create-if-needed - (cider--initialize-debug-buffer - code ns original-id - (if (and line column) - "you edited the code" - "your tools.nrepl version is older than 0.2.11")) - (save-excursion - (cider--debug-move-point coor) - (point-marker))))))))) - -(defun cider--handle-debug (response) - "Handle debugging notification. -RESPONSE is a message received from the nrepl describing the input -needed. It is expected to contain at least \"key\", \"input-type\", and -\"prompt\", and possibly other entries depending on the input-type." - (nrepl-dbind-response response (debug-value key input-type prompt inspect) - (condition-case-unless-debug e - (progn - (pcase input-type - ("expression" (cider-debug-mode-send-reply - (condition-case nil - (cider-read-from-minibuffer - (or prompt "Expression: ")) - (quit "nil")) - key)) - ((pred sequencep) - (let* ((marker (cider--debug-find-source-position response 'create-if-needed))) - (pop-to-buffer (marker-buffer marker)) - (goto-char marker)) - ;; The overlay code relies on window boundaries, but point could have been - ;; moved outside the window by some other code. Redisplay here to ensure the - ;; visible window includes point. - (redisplay) - ;; Remove overlays AFTER redisplaying! Otherwise there's a visible - ;; flicker even if we immediately recreate the overlays. - (cider--debug-remove-overlays) - (when cider-debug-use-overlays - (cider--debug-display-result-overlay debug-value)) - (setq cider--debug-mode-response response) - (cider--debug-mode 1))) - (when inspect - (cider-inspector--render-value inspect))) - ;; If something goes wrong, we send a "quit" or the session hangs. - (error (cider-debug-mode-send-reply ":quit" key) - (message "Error encountered while handling the debug message: %S" e))))) - -(defun cider--handle-enlighten (response) - "Handle an enlighten notification. -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))) - (with-current-buffer (marker-buffer marker) - (save-excursion - (goto-char marker) - (clojure-backward-logical-sexp 1) - (nrepl-dbind-response response (debug-value erase-previous) - (when erase-previous - (remove-overlays (point) marker 'category 'enlighten)) - (when debug-value - (if (memq (char-before marker) '(?\) ?\] ?})) - ;; Enlightening a sexp looks like a regular return value, except - ;; for a different border. - (cider--make-result-overlay (cider-font-lock-as-clojure debug-value) - :where (cons marker marker) - :type 'enlighten - :prepend-face 'cider-enlightened-face) - ;; Enlightening a symbol uses a more abbreviated format. The - ;; result face is the same as a regular result, but we also color - ;; the symbol with `cider-enlightened-local-face'. - (cider--make-result-overlay (cider-font-lock-as-clojure debug-value) - :format "%s" - :where (cons (point) marker) - :type 'enlighten - 'face 'cider-enlightened-local-face)))))))) - - -;;; Move here command -;; This is the inverse of `cider--debug-move-point'. However, that algorithm is -;; complicated, and trying to code its inverse would probably be insane. -;; Instead, we find the coordinate by trial and error. -(defun cider--debug-find-coordinates-for-point (target &optional list-so-far) - "Return the coordinates list for reaching TARGET. -Assumes that the next thing after point is a logical Clojure sexp and that -TARGET is inside it. The returned list is suitable for use in -`cider--debug-move-point'. LIST-SO-FAR is for internal use." - (when (looking-at (rx (or "(" "[" "#{" "{"))) - (let ((starting-point (point))) - (unwind-protect - (let ((x 0)) - ;; Keep incrementing the last coordinate until we've moved - ;; past TARGET. - (while (condition-case nil - (progn (goto-char starting-point) - (cider--debug-move-point (append list-so-far (list x))) - (< (point) target)) - ;; Not a valid coordinate. Move back a step and stop here. - (scan-error (setq x (1- x)) - nil)) - (setq x (1+ x))) - (setq list-so-far (append list-so-far (list x))) - ;; We have moved past TARGET, now determine whether we should - ;; stop, or if target is deeper inside the previous sexp. - (if (or (= target (point)) - (progn (forward-sexp -1) - (<= target (point)))) - list-so-far - (goto-char starting-point) - (cider--debug-find-coordinates-for-point target list-so-far))) - ;; `unwind-protect' clause. - (goto-char starting-point))))) - -(defun cider-debug-move-here (&optional force) - "Skip any breakpoints up to point." - (interactive (list (cider--uppercase-command-p))) - (unless cider--debug-mode - (user-error "`cider-debug-move-here' only makes sense during a debug session")) - (let ((here (point))) - (nrepl-dbind-response cider--debug-mode-response (line column) - (if (and line column (buffer-file-name)) - (progn ;; Get to the proper line & column in the file - (forward-line (1- (- line (line-number-at-pos)))) - (move-to-column column)) - (beginning-of-defun)) - ;; Is HERE inside the sexp being debugged? - (when (or (< here (point)) - (save-excursion - (forward-sexp 1) - (> here (point)))) - (user-error "Point is outside the sexp being debugged")) - ;; Move forward untill start of sexp. - (comment-normalize-vars) - (comment-forward (point-max)) - ;; Find the coordinate and send it. - (cider-debug-mode-send-reply - (format "{:response :here, :coord %s :force? %s}" - (cider--debug-find-coordinates-for-point here) - (if force "true" "false")))))) - - -;;; User commands -;;;###autoload -(defun cider-debug-defun-at-point () - "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." - (interactive) - (cider-eval-defun-at-point 'debug-it)) - -(provide 'cider-debug) -;;; cider-debug.el ends here diff --git a/elpa/cider-20160927.2135/cider-doc.el b/elpa/cider-20160927.2135/cider-doc.el deleted file mode 100644 index 667aab4..0000000 --- a/elpa/cider-20160927.2135/cider-doc.el +++ /dev/null @@ -1,522 +0,0 @@ -;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- - -;; Copyright © 2014-2016 Bozhidar Batsov, Jeff Valk and CIDER contributors - -;; Author: Jeff Valk - -;; 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: - -;; Mode for formatting and presenting documentation - -;;; Code: - -(require 'cider-common) -(require 'cider-compat) -(require 'cider-util) -(require 'cider-popup) -(require 'cider-client) -(require 'cider-grimoire) -(require 'nrepl-dict) -(require 'org-table) -(require 'button) -(require 'easymenu) - - -;;; Variables - -(defgroup cider-doc nil - "Documentation for CIDER." - :prefix "cider-doc-" - :group 'cider) - - -(defvar cider-doc-map - (let (cider-doc-map) - (define-prefix-command 'cider-doc-map) - (define-key cider-doc-map (kbd "a") #'cider-apropos) - (define-key cider-doc-map (kbd "C-a") #'cider-apropos) - (define-key cider-doc-map (kbd "s") #'cider-apropos-select) - (define-key cider-doc-map (kbd "C-s") #'cider-apropos-select) - (define-key cider-doc-map (kbd "f") #'cider-apropos-documentation) - (define-key cider-doc-map (kbd "C-f") #'cider-apropos-documentation) - (define-key cider-doc-map (kbd "e") #'cider-apropos-documentation-select) - (define-key cider-doc-map (kbd "C-e") #'cider-apropos-documentation-select) - (define-key cider-doc-map (kbd "d") #'cider-doc) - (define-key cider-doc-map (kbd "C-d") #'cider-doc) - (define-key cider-doc-map (kbd "r") #'cider-grimoire) - (define-key cider-doc-map (kbd "C-r") #'cider-grimoire) - (define-key cider-doc-map (kbd "w") #'cider-grimoire-web) - (define-key cider-doc-map (kbd "C-w") #'cider-grimoire-web) - (define-key cider-doc-map (kbd "j") #'cider-javadoc) - (define-key cider-doc-map (kbd "C-j") #'cider-javadoc) - cider-doc-map) - "CIDER documentation keymap.") - -(defconst cider-doc-menu - '("Documentation" - ["CiderDoc" cider-doc] - ["JavaDoc in browser" cider-javadoc] - ["Grimoire" cider-grimoire] - ["Grimoire in browser" cider-grimoire-web] - ["Search symbols" cider-apropos] - ["Search symbols & select" cider-apropos-select] - ["Search documentation" cider-apropos-documentation] - ["Search documentation & select" cider-apropos-documentation-select] - "--" - ["Configure Doc buffer" (customize-group 'cider-docview-mode)]) - "CIDER documentation submenu.") - - -;;; cider-docview-mode - -(defgroup cider-docview-mode nil - "Formatting/fontifying documentation viewer." - :prefix "cider-docview-" - :group 'cider) - -(defcustom cider-docview-fill-column fill-column - "Fill column for docstrings in doc buffer." - :type 'list - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - - - -;; Faces - -(defface cider-docview-emphasis-face - '((t (:inherit default :underline t))) - "Face for emphasized text" - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - -(defface cider-docview-strong-face - '((t (:inherit default :underline t :weight bold))) - "Face for strongly emphasized text" - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - -(defface cider-docview-literal-face - '((t (:inherit font-lock-string-face))) - "Face for literal text" - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - -(defface cider-docview-table-border-face - '((t (:inherit shadow))) - "Face for table borders" - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - - -;; Colors & Theme Support - -(defvar cider-docview-code-background-color - (cider-scale-background-color) - "Background color for code blocks.") - -(defadvice enable-theme (after cider-docview-adapt-to-theme activate) - "When theme is changed, update `cider-docview-code-background-color'." - (setq cider-docview-code-background-color (cider-scale-background-color))) - - -;; Mode & key bindings - -(defvar cider-docview-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "q" #'cider-popup-buffer-quit-function) - (define-key map "g" #'cider-docview-grimoire) - (define-key map "G" #'cider-docview-grimoire-web) - (define-key map "j" #'cider-docview-javadoc) - (define-key map "s" #'cider-docview-source) - (define-key map (kbd "") #'backward-button) - (define-key map (kbd "TAB") #'forward-button) - (easy-menu-define cider-docview-mode-menu map - "Menu for CIDER's doc mode" - `("CiderDoc" - ["Look up in Grimoire" cider-docview-grimoire] - ["Look up in Grimoire (browser)" cider-docview-grimoire-web] - ["JavaDoc in browser" cider-docview-javadoc] - ["Jump to source" cider-docview-source] - "--" - ["Quit" cider-popup-buffer-quit-function] - )) - map)) - -(defvar cider-docview-symbol) -(defvar cider-docview-javadoc-url) -(defvar cider-docview-file) -(defvar cider-docview-line) - -(define-derived-mode cider-docview-mode help-mode "Doc" - "Major mode for displaying CIDER documentation - -\\{cider-docview-mode-map}" - (setq buffer-read-only t) - (setq-local truncate-lines t) - (setq-local electric-indent-chars nil) - (setq-local cider-docview-symbol nil) - (setq-local cider-docview-javadoc-url nil) - (setq-local cider-docview-file nil) - (setq-local cider-docview-line nil)) - - -;;; Interactive functions - -(defun cider-docview-javadoc () - "Open the Javadoc for the current class, if available." - (interactive) - (if cider-docview-javadoc-url - (browse-url cider-docview-javadoc-url) - (error "No Javadoc available for %s" cider-docview-symbol))) - -(defun cider-javadoc-handler (symbol-name) - "Invoke the nREPL \"info\" op on SYMBOL-NAME if available." - (when symbol-name - (let* ((info (cider-var-info symbol-name)) - (url (nrepl-dict-get info "javadoc"))) - (if url - (browse-url url) - (user-error "No Javadoc available for %s" symbol-name))))) - -(defun cider-javadoc (arg) - "Open Javadoc 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." - (interactive "P") - (cider-ensure-connected) - (cider-ensure-op-supported "info") - (funcall (cider-prompt-for-symbol-function arg) - "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)))) - (cider-jump-to buffer (if cider-docview-line - (cons cider-docview-line nil) - cider-docview-symbol) - nil) - (user-error - (substitute-command-keys - "Can't find the source because it wasn't defined with `cider-eval-buffer'"))) - (error "No source location for %s" cider-docview-symbol))) - -(defvar cider-buffer-ns) - -(declare-function cider-grimoire-lookup "cider-grimoire") - -(defun cider-docview-grimoire () - "Return the grimoire documentation for `cider-docview-symbol'." - (interactive) - (if cider-buffer-ns - (cider-grimoire-lookup cider-docview-symbol) - (error "%s cannot be looked up on Grimoire" cider-docview-symbol))) - -(declare-function cider-grimoire-web-lookup "cider-grimoire") - -(defun cider-docview-grimoire-web () - "Open the grimoire documentation for `cider-docview-symbol' in a web browser." - (interactive) - (if cider-buffer-ns - (cider-grimoire-web-lookup cider-docview-symbol) - (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))) - -(defun cider-doc-lookup (symbol) - "Look up documentation for SYMBOL." - (if-let ((buffer (cider-create-doc-buffer symbol))) - (cider-popup-buffer-display buffer t) - (user-error "Symbol %s not resolved" symbol))) - -(defun cider-doc (&optional arg) - "Open Clojure 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." - (interactive "P") - (cider-ensure-connected) - (funcall (cider-prompt-for-symbol-function arg) - "Doc for" - #'cider-doc-lookup)) - - -;;; Font Lock and Formatting - -(defun cider-docview-fontify-code-blocks (buffer mode) - "Font lock BUFFER code blocks using MODE and remove markdown characters. -This processes the triple backtick GFM markdown extension. An overlay is used -to shade the background. Blocks are marked to be ignored by other fonification -and line wrap." - (with-current-buffer buffer - (save-excursion - (while (search-forward-regexp "```\n" nil t) - (replace-match "") - (let ((beg (point)) - (bg `(:background ,cider-docview-code-background-color))) - (when (search-forward-regexp "```\n" nil t) - (replace-match "") - (cider-font-lock-region-as mode beg (point)) - (overlay-put (make-overlay beg (point)) 'font-lock-face bg) - (put-text-property beg (point) 'block 'code))))))) - -(defun cider-docview-fontify-literals (buffer) - "Font lock BUFFER literal text and remove backtick markdown characters. -Preformatted code text blocks are ignored." - (with-current-buffer buffer - (save-excursion - (while (search-forward "`" nil t) - (if (eq (get-text-property (point) 'block) 'code) - (forward-char) - (progn - (replace-match "") - (let ((beg (point))) - (when (search-forward "`" (line-end-position) t) - (replace-match "") - (put-text-property beg (point) 'font-lock-face 'cider-docview-literal-face))))))))) - -(defun cider-docview-fontify-emphasis (buffer) - "Font lock BUFFER emphasized text and remove markdown characters. -One '*' represents emphasis, multiple '**'s represent strong emphasis. -Preformatted code text blocks are ignored." - (with-current-buffer buffer - (save-excursion - (while (search-forward-regexp "\\(*+\\)\\(\\w\\)" nil t) - (if (eq (get-text-property (point) 'block) 'code) - (forward-char) - (progn - (replace-match "\\2") - (let ((beg (1- (point))) - (face (if (> (length (match-string 1)) 1) - 'cider-docview-strong-face - 'cider-docview-emphasis-face))) - (when (search-forward-regexp "\\(\\w\\)\\*+" (line-end-position) t) - (replace-match "\\1") - (put-text-property beg (point) 'font-lock-face face))))))))) - -(defun cider-docview-format-tables (buffer) - "Align BUFFER tables and dim borders. -This processes the GFM table markdown extension using `org-table'. -Tables are marked to be ignored by line wrap." - (with-current-buffer buffer - (save-excursion - (let ((border 'cider-docview-table-border-face)) - (org-table-map-tables - (lambda () - (org-table-align) - (goto-char (org-table-begin)) - (while (search-forward-regexp "[+|-]" (org-table-end) t) - (put-text-property (match-beginning 0) (match-end 0) 'font-lock-face border)) - (put-text-property (org-table-begin) (org-table-end) 'block 'table))))))) - -(defun cider-docview-wrap-text (buffer) - "For text in BUFFER not propertized as 'block', apply line wrap." - (with-current-buffer buffer - (save-excursion - (while (not (eobp)) - (unless (get-text-property (point) 'block) - (fill-region (point) (line-end-position))) - (forward-line))))) - - -;;; Rendering - -(defun cider-docview-render-java-doc (buffer text) - "Emit into BUFFER formatted doc TEXT for a Java class or member." - (with-current-buffer buffer - (let ((beg (point))) - (insert text) - (save-excursion - (goto-char beg) - (cider-docview-fontify-code-blocks buffer 'java-mode) ; left alone hereafter - (cider-docview-fontify-literals buffer) - (cider-docview-fontify-emphasis buffer) - (cider-docview-format-tables buffer) ; may contain literals, emphasis - (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'." - (if (string-match "\\`file:\\(.*\\)" file-with-protocol) - (let ((file (match-string 1 file-with-protocol)) - (proj-dir (clojure-project-dir))) - (if (and proj-dir - (file-in-directory-p file proj-dir)) - (file-relative-name file proj-dir) - file)) - file-with-protocol)) - -(defun cider-docview-render-info (buffer info) - "Emit into BUFFER formatted INFO for the Clojure or Java symbol." - (let* ((ns (nrepl-dict-get info "ns")) - (name (nrepl-dict-get info "name")) - (added (nrepl-dict-get info "added")) - (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")) - (doc (or (nrepl-dict-get info "doc") - "Not documented.")) - (url (nrepl-dict-get info "url")) - (class (nrepl-dict-get info "class")) - (member (nrepl-dict-get info "member")) - (javadoc (nrepl-dict-get info "javadoc")) - (super (nrepl-dict-get info "super")) - (ifaces (nrepl-dict-get info "interfaces")) - (spec (nrepl-dict-get info "spec")) - (clj-name (if ns (concat ns "/" name) name)) - (java-name (if member (concat class "/" member) class)) - (see-also (nrepl-dict-get info "see-also"))) - (cider--help-setup-xref (list #'cider-doc-lookup (format "%s/%s" ns name)) nil buffer) - (with-current-buffer buffer - (cl-flet ((emit (text &optional face) - (insert (if face - (propertize text 'font-lock-face face) - text) - "\n"))) - (emit (if class java-name clj-name) 'font-lock-function-name-face) - (when super - (emit (concat " Extends: " (cider-font-lock-as 'java-mode super)))) - (when ifaces - (emit (concat "Implements: " (cider-font-lock-as 'java-mode (car ifaces)))) - (dolist (iface (cdr ifaces)) - (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 added - (emit (concat "Added in " added) 'font-lock-comment-face)) - (when depr - (emit (concat "Deprecated in " depr) 'font-lock-keyword-face)) - (if class - (cider-docview-render-java-doc (current-buffer) doc) - (emit (concat " " doc))) - (when url - (insert "\n Please see ") - (insert-text-button url - 'url url - 'follow-link t - 'action (lambda (x) - (browse-url (button-get x 'url)))) - (insert "\n")) - (when javadoc - (insert "\n\nFor additional documentation, see the ") - (insert-text-button "Javadoc" - 'url javadoc - 'follow-link t - 'action (lambda (x) - (browse-url (button-get x 'url)))) - (insert ".\n")) - (insert "\n") - (when spec - (emit "Spec: " 'font-lock-function-name-face) - (mapc (lambda (s) (insert s "\n")) spec) - (insert "\n")) - (if cider-docview-file - (progn - (insert (propertize (if class java-name clj-name) - 'font-lock-face 'font-lock-function-name-face) - " is defined in ") - (insert-text-button (cider--abbreviate-file-protocol cider-docview-file) - 'follow-link t - 'action (lambda (_x) - (cider-docview-source))) - (insert ".")) - (insert "Definition location unavailable.")) - (when see-also - (insert "\n\n Also see: ") - (mapc (lambda (ns-sym) - (let* ((ns-sym-split (split-string ns-sym "/")) - (see-also-ns (car ns-sym-split)) - (see-also-sym (cadr ns-sym-split)) - ;; 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 " ")) - see-also)) - (cider--doc-make-xrefs) - (let ((beg (point-min)) - (end (point-max))) - (nrepl-dict-map (lambda (k v) - (put-text-property beg end k v)) - info))) - (current-buffer)))) - -(declare-function cider-set-buffer-ns "cider-mode") -(defun cider-docview-render (buffer symbol info) - "Emit into BUFFER formatted documentation for SYMBOL's INFO." - (with-current-buffer buffer - (let ((javadoc (nrepl-dict-get info "javadoc")) - (file (nrepl-dict-get info "file")) - (line (nrepl-dict-get info "line")) - (ns (nrepl-dict-get info "ns")) - (inhibit-read-only t)) - (cider-docview-mode) - - (cider-set-buffer-ns ns) - (setq-local cider-docview-symbol symbol) - (setq-local cider-docview-javadoc-url javadoc) - (setq-local cider-docview-file file) - (setq-local cider-docview-line line) - - (remove-overlays) - (cider-docview-render-info buffer info) - - (goto-char (point-min)) - (current-buffer)))) - - -(provide 'cider-doc) - -;;; cider-doc.el ends here diff --git a/elpa/cider-20160927.2135/cider-eldoc.el b/elpa/cider-20160927.2135/cider-eldoc.el deleted file mode 100644 index 5b66d15..0000000 --- a/elpa/cider-20160927.2135/cider-eldoc.el +++ /dev/null @@ -1,430 +0,0 @@ -;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2016 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: - -;; eldoc support for Clojure. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) ; for cider-symbol-at-point -(require 'cider-compat) -(require 'cider-util) -(require 'nrepl-dict) - -(require 'seq) - -(require 'eldoc) - -(defvar cider-extra-eldoc-commands '("yas-expand") - "Extra commands to be added to eldoc's safe commands list.") - -(defvar cider-eldoc-max-num-sexps-to-skip 30 - "The maximum number of sexps to skip while searching the beginning of current sexp.") - -(defvar-local cider-eldoc-last-symbol nil - "The eldoc information for the last symbol we checked.") - -(defcustom cider-eldoc-ns-function #'identity - "A function that returns a ns string to be used by eldoc. -Takes one argument, a namespace name. -For convenience, some functions are already provided for this purpose: -`cider-abbreviate-ns', and `cider-last-ns-segment'." - :type '(choice (const :tag "Full namespace" identity) - (const :tag "Abbreviated namespace" cider-abbreviate-ns) - (const :tag "Last name in namespace" cider-last-ns-segment) - (function :tag "Custom function")) - :group 'cider - :package-version '(cider . "0.13.0")) - -(defcustom cider-eldoc-max-class-names-to-display 3 - "The maximum number of classes to display in an eldoc string. -An eldoc string for Java interop forms can have a number of classes prefixed to -it, when the form belongs to more than 1 class. When, not nil we only display -the names of first `cider-eldoc-max-class-names-to-display' classes and add -a \"& x more\" suffix. Otherwise, all the classes are displayed." - :type 'integer - :safe #'integerp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defcustom cider-eldoc-display-for-symbol-at-point t - "When non-nil, display eldoc for symbol at point if available. -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 - :group 'cider - :package-version '(cider . "0.13.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))) - (cond - ;; truncate class-names list and then format it - ((and cider-eldoc-max-class-names-to-display - (> eldoc-class-names-length cider-eldoc-max-class-names-to-display)) - (format "(%s & %s more)" - (thread-first eldoc-class-names - (seq-take cider-eldoc-max-class-names-to-display) - (cider-string-join " ") - (cider-propertize 'ns)) - (- eldoc-class-names-length cider-eldoc-max-class-names-to-display))) - - ;; format the whole list but add surrounding parentheses - ((> eldoc-class-names-length 1) - (format "(%s)" - (thread-first eldoc-class-names - (cider-string-join " ") - (cider-propertize 'ns)))) - - ;; don't add the parentheses - (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. -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)))) - (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" - ;; so we only propertize ns-or-class if not already done - (if (get-text-property 1 'face ns-or-class) - ;; it is already propertized - ns-or-class - (cider-propertize ns-or-class 'ns)) - propertized-method-name) - ;; in case ns-or-class is nil - propertized-method-name)) - -(defun cider-eldoc-format-sym-doc (var ns docstring) - "Return the formatted eldoc string for VAR and DOCSTRING. - -Consider the value of `eldoc-echo-area-use-multiline-p' while formatting. -If the entire line cannot fit in the echo area, the var name may be -truncated or eliminated entirely from the output to make room for the -description. - -Try to truncate the var with various strategies, so that the var and -the docstring can be displayed in the minibuffer without resizing the window. -We start with `cider-abbreviate-ns' and `cider-last-ns-segment'. -Next, if the var is in current namespace, we remove NS from the eldoc string. -Otherwise, only the docstring is returned." - (let* ((ea-multi eldoc-echo-area-use-multiline-p) - ;; Subtract 1 from window width since emacs will not write - ;; any chars to the last column, or in later versions, will - ;; cause a wraparound and resize of the echo area. - (ea-width (1- (window-width (minibuffer-window)))) - (strip (- (+ (length var) (length docstring)) ea-width)) - (newline (string-match-p "\n" docstring)) - ;; Truncated var can be ea-var long - ;; Subtract 2 to account for the : and / added when including - ;; the namespace prefixed form in eldoc string - (ea-var (- (- ea-width (length docstring)) 2))) - (cond - ((or (eq ea-multi t) - (and (<= strip 0) (null newline)) - (and ea-multi (or (> (length docstring) ea-width) newline))) - (format "%s: %s" var docstring)) - - ;; Now we have to truncate either the docstring or the var - (newline (cider-eldoc-format-sym-doc var ns (substring docstring 0 newline))) - - ;; Only return the truncated docstring - ((> (length docstring) ea-width) - (substring docstring 0 ea-width)) - - ;; Try to truncate the var with cider-abbreviate-ns - ((<= (length (cider-abbreviate-ns var)) ea-var) - (format "%s: %s" (cider-abbreviate-ns var) docstring)) - - ;; Try to truncate var with cider-last-ns-segment - ((<= (length (cider-last-ns-segment var)) ea-var) - (format "%s: %s" (cider-last-ns-segment var) docstring)) - - ;; If the var is in current namespace, we try to truncate the var by - ;; skipping the namespace from the returned eldoc string - ((and (string-equal ns (cider-current-ns)) - (<= (- (length var) (length ns)) ea-var)) - (format "%s: %s" - (replace-regexp-in-string (format "%s/" ns) "" var) - docstring)) - - ;; We couldn't fit the var and docstring in the available space, - ;; so we just display the docstring - (t docstring)))) - -(defun cider-eldoc-format-variable (thing pos 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." - (let* ((ns (lax-plist-get eldoc-info "ns")) - (symbol (lax-plist-get eldoc-info "symbol")) - (docstring (lax-plist-get eldoc-info "docstring")) - (formatted-var (cider-eldoc-format-thing ns symbol thing 'var))) - (when docstring - (cider-eldoc-format-sym-doc formatted-var ns docstring)))) - -(defun cider-eldoc-format-function (thing pos eldoc-info) - "Return the formatted eldoc string for a function. -THING is the function name. POS is the argument-index of the functions -arglists. 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")) - (arglists (lax-plist-get eldoc-info "arglists"))) - (format "%s: %s" - (cider-eldoc-format-thing ns symbol thing 'fn) - (cider-eldoc-format-arglist arglists pos)))) - -(defun cider-highlight-args (arglist pos) - "Format the the function ARGLIST for eldoc. -POS is the index of the currently highlighted argument." - (let* ((rest-pos (cider--find-rest-args-position arglist)) - (i 0)) - (mapconcat - (lambda (arg) - (let ((argstr (format "%s" arg))) - (if (string= arg "&") - argstr - (prog1 - (if (or (= (1+ i) pos) - (and rest-pos - (> (1+ i) rest-pos) - (> pos rest-pos))) - (propertize argstr 'face - 'eldoc-highlight-function-argument) - argstr) - (setq i (1+ i)))))) arglist " "))) - -(defun cider--find-rest-args-position (arglist) - "Find the position of & in the ARGLIST vector." - (seq-position arglist "&")) - -(defun cider-highlight-arglist (arglist pos) - "Format the ARGLIST for eldoc. -POS is the index of the argument to highlight." - (concat "[" (cider-highlight-args arglist pos) "]")) - -(defun cider-eldoc-format-arglist (arglist pos) - "Format all the ARGLIST for eldoc. -POS is the index of current argument." - (concat "(" - (mapconcat (lambda (args) (cider-highlight-arglist args pos)) - arglist - " ") - ")")) - -(defun cider-eldoc-beginning-of-sexp () - "Move to the beginning of current sexp. - -Return the number of nested sexp the point was over or after. Return nil -if the maximum number of sexps to skip is exceeded." - (let ((parse-sexp-ignore-comments t) - (num-skipped-sexps 0)) - (condition-case _ - (progn - ;; First account for the case the point is directly over a - ;; beginning of a nested sexp. - (condition-case _ - (let ((p (point))) - (forward-sexp -1) - (forward-sexp 1) - (when (< (point) p) - (setq num-skipped-sexps 1))) - (error)) - (while - (let ((p (point))) - (forward-sexp -1) - (when (< (point) p) - (setq num-skipped-sexps - (unless (and cider-eldoc-max-num-sexps-to-skip - (>= num-skipped-sexps - cider-eldoc-max-num-sexps-to-skip)) - ;; Without the above guard, - ;; `cider-eldoc-beginning-of-sexp' could traverse the - ;; whole buffer when the point is not within a - ;; list. This behavior is problematic especially with - ;; a buffer containing a large number of - ;; non-expressions like a REPL buffer. - (1+ num-skipped-sexps))))))) - (error)) - num-skipped-sexps)) - -(defun cider-eldoc-thing-type (eldoc-info) - "Return the type of the thing being displayed by eldoc. -It can be a function or var now." - (pcase (lax-plist-get eldoc-info "type") - ("function" 'fn) - ("variable" 'var))) - -(defun cider-eldoc-info-at-point () - "Return eldoc info at point. -First go to the beginning of the sexp and check if the eldoc is to be -considered (i.e sexp is a method call) and not a map or vector literal. -Then go back to the point and return its eldoc." - (save-excursion - (unless (cider-in-comment-p) - (let* ((current-point (point))) - (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))))))) - -(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)))) - (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)))))) - -(defun cider-eldoc-info-in-current-sexp () - "Return eldoc information from the sexp. -If `cider-eldoc-display-for-symbol-at-poin' is non-nil and -the symbol at point has a valid eldoc available, return that. -Otherwise return the eldoc of the first symbol of the sexp." - (or (when cider-eldoc-display-for-symbol-at-point - (cider-eldoc-info-at-point)) - (cider-eldoc-info-at-sexp-beginning))) - -(defun cider-eldoc--convert-ns-keywords (thing) - "Convert THING values that match ns macro keywords to function names." - (pcase thing - (":import" "clojure.core/import") - (":refer-clojure" "clojure.core/refer-clojure") - (":use" "clojure.core/use") - (":refer" "clojure.core/refer") - (_ thing))) - -(defun cider-eldoc-info (thing) - "Return the info for THING. -This includes the arglist and ns and symbol name (if available)." - (let ((thing (cider-eldoc--convert-ns-keywords thing))) - (when (and (cider-nrepl-op-supported-p "eldoc") - thing - ;; ignore empty strings - (not (string= thing "")) - ;; ignore strings - (not (string-prefix-p "\"" thing)) - ;; ignore regular expressions - (not (string-prefix-p "#" thing)) - ;; ignore chars - (not (string-prefix-p "\\" thing)) - ;; ignore numbers - (not (string-match-p "^[0-9]" thing))) - ;; check if we can used the cached eldoc info - (cond - ;; handle keywords for map access - ((string-prefix-p ":" thing) (list "symbol" thing - "type" "function" - "arglists" '(("map") ("map" "not-found")))) - ;; handle Classname. by displaying the eldoc for new - ((string-match-p "^[A-Z].+\\.$" thing) (list "symbol" thing - "type" "function" - "arglists" '(("args*")))) - ;; 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))) - (let* ((arglists (nrepl-dict-get eldoc-info "eldoc")) - (docstring (nrepl-dict-get eldoc-info "docstring")) - (type (nrepl-dict-get eldoc-info "type")) - (ns (nrepl-dict-get eldoc-info "ns")) - (class (nrepl-dict-get eldoc-info "class")) - (name (nrepl-dict-get eldoc-info "name")) - (member (nrepl-dict-get eldoc-info "member")) - (ns-or-class (if (and ns (not (string= ns ""))) - ns - class)) - (name-or-member (if (and name (not (string= name ""))) - name - (format ".%s" member))) - (eldoc-plist (list "ns" ns-or-class - "symbol" name-or-member - "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)) - eldoc-plist)))))))) - -(defun cider--eldoc-remove-dot (sym) - "Remove the preceding \".\" from a namespace qualified SYM and return sym. -Only useful for interop forms. Clojure forms would be returned unchanged." - (when sym (replace-regexp-in-string "/\\." "/" sym))) - -(defun cider-eldoc () - "Backend function for eldoc to show argument list in the echo area." - (when (and (cider-connected-p) - ;; don't clobber an error message in the minibuffer - (not (member last-command '(next-error previous-error)))) - (let* ((sexp-eldoc-info (cider-eldoc-info-in-current-sexp)) - (eldoc-info (lax-plist-get sexp-eldoc-info "eldoc-info")) - (pos (lax-plist-get sexp-eldoc-info "pos")) - (thing (lax-plist-get sexp-eldoc-info "thing"))) - (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)))))) - -(defun cider-eldoc-setup () - "Setup eldoc in the current buffer. -eldoc mode has to be enabled for this to have any effect." - (setq-local eldoc-documentation-function #'cider-eldoc) - (apply #'eldoc-add-command cider-extra-eldoc-commands)) - -(provide 'cider-eldoc) - -;;; cider-eldoc.el ends here diff --git a/elpa/cider-20160927.2135/cider-grimoire.el b/elpa/cider-20160927.2135/cider-grimoire.el deleted file mode 100644 index 0616b20..0000000 --- a/elpa/cider-20160927.2135/cider-grimoire.el +++ /dev/null @@ -1,118 +0,0 @@ -;;; cider-grimoire.el --- Grimoire integration -*- lexical-binding: t -*- - -;; Copyright © 2014-2016 Bozhidar Batsov and CIDER contributors -;; -;; 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 few commands for Grimoire documentation lookup. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) -(require 'cider-compat) -(require 'cider-popup) - -(require 'nrepl-dict) - -(require 'url-vars) - -(defconst cider-grimoire-url "http://conj.io/") - -(defconst cider-grimoire-buffer "*cider-grimoire*") - -(defun cider-grimoire-replace-special (name) - "Convert the dashes in NAME to a grimoire friendly format." - (thread-last name - (replace-regexp-in-string "\\?" "_QMARK_") - (replace-regexp-in-string "\\." "_DOT_") - (replace-regexp-in-string "\\/" "_SLASH_") - (replace-regexp-in-string "\\(\\`_\\)\\|\\(_\\'\\)" ""))) - -(defun cider-grimoire-url (name ns) - "Generate a grimoire search v0 url from NAME, NS." - (let ((base-url cider-grimoire-url)) - (when (and name ns) - (concat base-url "search/v0/" ns "/" (cider-grimoire-replace-special name) "/")))) - -(defun cider-grimoire-web-lookup (symbol) - "Open the grimoire documentation for SYMBOL in a web browser." - (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))) - (error "Symbol %s not resolved" symbol))) - -;;;###autoload -(defun cider-grimoire-web (&optional arg) - "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." - (interactive "P") - (funcall (cider-prompt-for-symbol-function arg) - "Grimoire doc for" - #'cider-grimoire-web-lookup)) - -(defun cider-create-grimoire-buffer (content) - "Create a new grimoire buffer with CONTENT." - (with-current-buffer (cider-popup-buffer cider-grimoire-buffer t) - (read-only-mode -1) - (insert content) - (read-only-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))) - (let ((name (nrepl-dict-get var-info "name")) - (ns (nrepl-dict-get var-info "ns")) - (url-request-method "GET") - (url-request-extra-headers `(("Content-Type" . "text/plain")))) - (url-retrieve (cider-grimoire-url name ns) - (lambda (_status) - ;; we need to strip the http header - (goto-char (point-min)) - (re-search-forward "^$") - (delete-region (point-min) (point)) - (delete-blank-lines) - ;; and create a new buffer with whatever is left - (pop-to-buffer (cider-create-grimoire-buffer (buffer-string)))))) - (error "Symbol %s not resolved" symbol))) - -;;;###autoload -(defun cider-grimoire (&optional arg) - "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." - (interactive "P") - (when (derived-mode-p 'clojurescript-mode) - (user-error "`cider-grimoire' doesn't support ClojureScript")) - (funcall (cider-prompt-for-symbol-function arg) - "Grimoire doc for" - #'cider-grimoire-lookup)) - -(provide 'cider-grimoire) - -;;; cider-grimoire.el ends here diff --git a/elpa/cider-20160927.2135/cider-inspector.el b/elpa/cider-20160927.2135/cider-inspector.el deleted file mode 100644 index ce33e83..0000000 --- a/elpa/cider-20160927.2135/cider-inspector.el +++ /dev/null @@ -1,389 +0,0 @@ -;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*- - -;; Copyright © 2013-2016 Vital Reactor, LLC -;; Copyright © 2014-2016 Bozhidar Batsov and CIDER contributors - -;; Author: Ian Eslick -;; 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: - -;; Clojure object inspector inspired by SLIME. - -;;; Code: - -(require 'cl-lib) -(require 'seq) -(require 'cider-interaction) - -;; =================================== -;; Inspector Key Map and Derived Mode -;; =================================== - -(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." - :prefix "cider-inspector-" - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-inspector-page-size 32 - "Default page size in paginated inspector view. -The page size can be also changed interactively within the inspector." - :type '(integer :tag "Page size" 32) - :group 'cider-inspector - :package-version '(cider . "0.10.0")) - -(defvar cider-inspector-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map (kbd "RET") #'cider-inspector-operate-on-point) - (define-key map [mouse-1] #'cider-inspector-operate-on-click) - (define-key map "l" #'cider-inspector-pop) - (define-key map "g" #'cider-inspector-refresh) - ;; Page-up/down - (define-key map [next] #'cider-inspector-next-page) - (define-key map [prior] #'cider-inspector-prev-page) - (define-key map " " #'cider-inspector-next-page) - (define-key map (kbd "M-SPC") #'cider-inspector-prev-page) - (define-key map (kbd "S-SPC") #'cider-inspector-prev-page) - (define-key map "s" #'cider-inspector-set-page-size) - (define-key map [tab] #'cider-inspector-next-inspectable-object) - (define-key map "\C-i" #'cider-inspector-next-inspectable-object) - (define-key map [(shift tab)] #'cider-inspector-previous-inspectable-object) - ;; Emacs translates S-TAB to BACKTAB on X. - (define-key map [backtab] #'cider-inspector-previous-inspectable-object) - map)) - -(define-derived-mode cider-inspector-mode special-mode "Inspector" - "Major mode for inspecting Clojure data structures. - -\\{cider-inspector-mode-map}" - (set-syntax-table clojure-mode-syntax-table) - (setq buffer-read-only t) - (setq-local electric-indent-chars nil) - (setq-local truncate-lines t)) - -;;;###autoload -(defun cider-inspect-last-sexp () - "Inspect the result of the the expression preceding point." - (interactive) - (cider-inspect-expr (cider-last-sexp) (cider-current-ns))) - -;;;###autoload -(defun cider-inspect-defun-at-point () - "Inspect the result of the \"top-level\" expression at point." - (interactive) - (cider-inspect-expr (cider-defun-at-point) (cider-current-ns))) - -;;;###autoload -(defun cider-inspect-last-result () - "Inspect the most recent eval result." - (interactive) - (cider-inspect-expr "*1" (cider-current-ns))) - -;;;###autoload -(defun cider-inspect (&optional arg) - "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." - (interactive "p") - (pcase arg - (1 (cider-inspect-last-sexp)) - (4 (cider-inspect-defun-at-point)) - (16 (call-interactively #'cider-inspect-expr)))) - -(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 -`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 -`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.") - -;; Operations -;;;###autoload -(defun cider-inspect-expr (expr ns) - "Evaluate EXPR in NS and inspect its value. -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))) - (cider-inspector--render-value value))) - -(defun cider-inspector-pop () - (interactive) - (setq cider-inspector-last-command 'cider-inspector-pop) - (when-let (value (cider-sync-request:inspect-pop)) - (cider-inspector--render-value value))) - -(defun cider-inspector-push (idx) - (push (point) cider-inspector-location-stack) - (when-let (value (cider-sync-request:inspect-push idx)) - (cider-inspector--render-value value))) - -(defun cider-inspector-refresh () - (interactive) - (when-let (value (cider-sync-request:inspect-refresh)) - (cider-inspector--render-value value))) - -(defun cider-inspector-next-page () - "Jump to the next page when inspecting a paginated sequence/map. - -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)) - (cider-inspector--render-value value))) - -(defun cider-inspector-prev-page () - "Jump to the previous page when expecting a paginated sequence/map. - -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)) - (cider-inspector--render-value value))) - -(defun cider-inspector-set-page-size (page-size) - "Set the page size in pagination mode to the specified PAGE-SIZE. - -Current page will be reset to zero." - (interactive "nPage 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" - "session" (cider-current-session)) - (cider-nrepl-send-sync-request) - (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 - "session" (cider-current-session)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "value"))) - -(defun cider-sync-request:inspect-refresh () - "Re-render the currently inspected value." - (thread-first (list "op" "inspect-refresh" - "session" (cider-current-session)) - (cider-nrepl-send-sync-request) - (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" - "session" (cider-current-session)) - (cider-nrepl-send-sync-request) - (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" - "session" (cider-current-session)) - (cider-nrepl-send-sync-request) - (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 - "session" (cider-current-session)) - (cider-nrepl-send-sync-request) - (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 (cider-current-session) ns) - (list "inspect" "true" - "page-size" page-size)) - (cider-nrepl-send-sync-request) - (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) - (cider-inspector-render cider-inspector-buffer value) - (cider-popup-buffer-display cider-inspector-buffer t) - (with-current-buffer cider-inspector-buffer - (when (eq cider-inspector-last-command 'cider-inspector-pop) - (setq cider-inspector-last-command nil) - ;; Prevents error message being displayed when we try to pop - ;; from the top-level of a data struture - (when cider-inspector-location-stack - (goto-char (pop cider-inspector-location-stack)))) - - (when (eq cider-inspector-last-command 'cider-inspector-prev-page) - (setq cider-inspector-last-command nil) - ;; Prevents error message being displayed when we try to - ;; go to a prev-page from the first page - (when cider-inspector-page-location-stack - (goto-char (pop cider-inspector-page-location-stack)))))) - -(defun cider-inspector-render (buffer str) - (with-current-buffer buffer - (cider-inspector-mode) - (let ((inhibit-read-only t)) - (condition-case nil - (cider-inspector-render* (car (read-from-string str))) - (error (insert "\nInspector error for: " str)))) - (goto-char (point-min)))) - -(defun cider-inspector-render* (elements) - (dolist (el elements) - (cider-inspector-render-el* el))) - -(defun cider-inspector-render-el* (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)) - (insert "\n")) - ((and (consp el) (eq (car el) :value)) - (cider-inspector-render-value (cadr el) (cl-caddr el))) - (t (message "Unrecognized inspector object: %s" el)))) - -(defun cider-inspector-render-value (value idx) - (cider-propertize-region - (list 'cider-value-idx idx - 'mouse-face 'highlight) - (cider-inspector-render-el* (cider-font-lock-as-clojure value)))) - - -;; =================================================== -;; Inspector Navigation (lifted from SLIME inspector) -;; =================================================== - -(defun cider-find-inspectable-object (direction limit) - "Find the next/previous inspectable object. -DIRECTION can be either 'next or 'prev. -LIMIT is the maximum or minimum position in the current buffer. - -Return a list of two values: If an object could be found, the -starting position of the found object and T is returned; -otherwise LIMIT and NIL is returned." - (let ((finder (cl-ecase direction - (next 'next-single-property-change) - (prev 'previous-single-property-change)))) - (let ((prop nil) (curpos (point))) - (while (and (not prop) (not (= curpos limit))) - (let ((newpos (funcall finder curpos 'cider-value-idx nil limit))) - (setq prop (get-text-property newpos 'cider-value-idx)) - (setq curpos newpos))) - (list curpos (and prop t))))) - -(defun cider-inspector-next-inspectable-object (arg) - "Move point to the next inspectable object. -With optional ARG, move across that many objects. -If ARG is negative, move backwards." - (interactive "p") - (let ((maxpos (point-max)) (minpos (point-min)) - (previously-wrapped-p nil)) - ;; Forward. - (while (> arg 0) - (seq-let (pos foundp) (cider-find-inspectable-object 'next maxpos) - (if foundp - (progn (goto-char pos) (setq arg (1- arg)) - (setq previously-wrapped-p nil)) - (if (not previously-wrapped-p) ; cycle detection - (progn (goto-char minpos) (setq previously-wrapped-p t)) - (error "No inspectable objects"))))) - ;; Backward. - (while (< arg 0) - (seq-let (pos foundp) (cider-find-inspectable-object 'prev minpos) - ;; CIDER-OPEN-INSPECTOR inserts the title of an inspector page - ;; as a presentation at the beginning of the buffer; skip - ;; that. (Notice how this problem can not arise in ``Forward.'') - (if (and foundp (/= pos minpos)) - (progn (goto-char pos) (setq arg (1+ arg)) - (setq previously-wrapped-p nil)) - (if (not previously-wrapped-p) ; cycle detection - (progn (goto-char maxpos) (setq previously-wrapped-p t)) - (error "No inspectable objects"))))))) - -(defun cider-inspector-previous-inspectable-object (arg) - "Move point to the previous inspectable object. -With optional ARG, move across that many objects. -If ARG is negative, move forwards." - (interactive "p") - (cider-inspector-next-inspectable-object (- arg))) - -(defun cider-inspector-property-at-point () - (let* ((properties '(cider-value-idx cider-range-button - cider-action-number)) - (find-property - (lambda (point) - (cl-loop for property in properties - for value = (get-text-property point property) - when value - return (list property value))))) - (or (funcall find-property (point)) - (funcall find-property (1- (point)))))) - -(defun cider-inspector-operate-on-point () - "Invoke the command for the text at point. -1. If point is on a value then recursively call the inspector on -that value. -2. If point is on an action then call that action. -3. If point is on a range-button fetch and insert the range." - (interactive) - (seq-let (property value) (cider-inspector-property-at-point) - (cl-case property - (cider-value-idx - (cider-inspector-push value)) - ;; TODO: range and action handlers - (t (error "No object at point"))))) - -(defun cider-inspector-operate-on-click (event) - "Move to EVENT's position and operate the part." - (interactive "@e") - (let ((point (posn-point (event-end event)))) - (cond ((and point - (or (get-text-property point 'cider-value-idx))) - (goto-char point) - (cider-inspector-operate-on-point)) - (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-20160927.2135/cider-interaction.el b/elpa/cider-20160927.2135/cider-interaction.el deleted file mode 100644 index 7742e82..0000000 --- a/elpa/cider-20160927.2135/cider-interaction.el +++ /dev/null @@ -1,1787 +0,0 @@ -;;; cider-interaction.el --- IDE for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2016 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 '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.") - -(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))))) - -(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" "session" (cider-current-session)) - (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) - (cider-current-session)))) - -(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-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)) - (right-margin (max fill-column - (1- (window-width (get-buffer-window result-buffer)))))) - (cider-interactive-eval (when (stringp form) form) - handler - (when (consp form) form) - (cider--nrepl-pprint-request-plist (or right-margin fill-column))))) - -(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" - "session" (cider-current-session) - "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" - "session" (cider-current-session) - "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" - "session" (cider-current-session) - "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)) - - (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." - (interactive "p") - (cider-ensure-connected) - (cider-ensure-op-supported "refresh") - (let ((clear? (member mode '(clear 16))) - (refresh-all? (member mode '(refresh-all 4)))) - (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 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 cider-refresh-before-fn (list "before" cider-refresh-before-fn)) - (when 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 fill-column)))) - -(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 (- fill-column 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) selected-session)) - (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) - (let ((selected-session (completing-read "Close nREPL session: " (nrepl-sessions (cider-current-connection))))) - (when selected-session - (nrepl-sync-request:close (cider-current-connection) selected-session) - (message "Closed nREPL session %s" selected-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 nrepl-session - (nrepl-sync-request:close buffer nrepl-session)) - (when nrepl-tooling-session - (nrepl-sync-request:close buffer nrepl-tooling-session))) - (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))) - (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) - (if project-dir - (let ((default-directory project-dir)) - (cider-jack-in)) - (error "Can't restart CIDER connection for unknown project")))) - -(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" - "session" (cider-current-session) - "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-20160927.2135/cider-macroexpansion.el b/elpa/cider-20160927.2135/cider-macroexpansion.el deleted file mode 100644 index 63f3335..0000000 --- a/elpa/cider-20160927.2135/cider-macroexpansion.el +++ /dev/null @@ -1,207 +0,0 @@ -;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2016 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: - -;; Macro expansion support. - -;;; Code: - -(require 'cider-mode) -(require 'cider-compat) - -(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: - - 'qualified ;=> Vars are fully-qualified in the expansion - 'none ;=> Vars are displayed without namespace qualification - 'tidy ;=> Vars that are :refer-ed or defined in the current namespace are - displayed with their simple name, non-refered vars from other - namespaces are refered using the alias for that namespace (if - defined), other vars are displayed fully qualified." - :type '(choice (const :tag "Suppress namespaces" none) - (const :tag "Show fully-qualified namespaces" qualified) - (const :tag "Show namespace aliases" tidy)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-macroexpansion-print-metadata nil - "Determines if metadata is included in macroexpansion results." - :type 'boolean - :group 'cider - :package-version '(cider . "0.9.0")) - -(defun cider-sync-request:macroexpand (expander expr &optional display-namespaces) - "Macroexpand, using EXPANDER, the given EXPR. -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"))) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "expansion"))) - -(defun cider-macroexpand-undo (&optional arg) - "Undo the last macroexpansion, using `undo-only'. -ARG is passed along to `undo-only'." - (interactive) - (let ((inhibit-read-only t)) - (undo-only arg))) - -(defvar cider-last-macroexpand-expression nil - "Specify the last macroexpansion preformed. -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))) - (setq cider-last-macroexpand-expression expr) - (cider-initialize-macroexpansion-buffer expansion (cider-current-ns)))) - -(defun cider-macroexpand-expr-inplace (expander) - "Substitute the form preceding point with its macroexpansion using EXPANDER." - (interactive) - (let* ((expansion (cider-sync-request:macroexpand expander (cider-last-sexp))) - (bounds (cons (save-excursion (clojure-backward-logical-sexp 1) (point)) (point)))) - (cider-redraw-macroexpansion-buffer - expansion (current-buffer) (car bounds) (cdr bounds)))) - -(defun cider-macroexpand-again () - "Repeat the last macroexpansion." - (interactive) - (cider-initialize-macroexpansion-buffer cider-last-macroexpand-expression (cider-current-ns))) - -;;;###autoload -(defun cider-macroexpand-1 (&optional prefix) - "Invoke \\=`macroexpand-1\\=` on the expression preceding point. -If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of -\\=`macroexpand-1\\=`." - (interactive "P") - (let ((expander (if prefix "macroexpand" "macroexpand-1"))) - (cider-macroexpand-expr expander (cider-last-sexp)))) - -(defun cider-macroexpand-1-inplace (&optional prefix) - "Perform inplace \\=`macroexpand-1\\=` on the expression preceding point. -If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of -\\=`macroexpand-1\\=`." - (interactive "P") - (let ((expander (if prefix "macroexpand" "macroexpand-1"))) - (cider-macroexpand-expr-inplace expander))) - -;;;###autoload -(defun cider-macroexpand-all () - "Invoke \\=`clojure.walk/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." - (interactive) - (cider-macroexpand-expr-inplace "macroexpand-all")) - -(defun cider-initialize-macroexpansion-buffer (expansion ns) - "Create a new Macroexpansion buffer with EXPANSION and namespace NS." - (pop-to-buffer (cider-create-macroexpansion-buffer)) - (setq cider-buffer-ns ns) - (setq buffer-undo-list nil) - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (erase-buffer) - (insert (format "%s" expansion)) - (goto-char (point-max)) - (cider--font-lock-ensure))) - -(defun cider-redraw-macroexpansion-buffer (expansion buffer start end) - "Redraw the macroexpansion with new EXPANSION. -Text in BUFFER from START to END is replaced with new expansion, -and point is placed after the expanded form." - (with-current-buffer buffer - (let ((buffer-read-only nil)) - (goto-char start) - (delete-region start end) - (insert (format "%s" expansion)) - (goto-char start) - (indent-sexp) - (forward-sexp)))) - -(declare-function cider-mode "cider-mode") - -(defun cider-create-macroexpansion-buffer () - "Create a new macroexpansion buffer." - (with-current-buffer (cider-popup-buffer cider-macroexpansion-buffer t) - (clojure-mode) - (cider-mode -1) - (cider-macroexpansion-mode 1) - (current-buffer))) - -(defvar cider-macroexpansion-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "g") #'cider-macroexpand-again) - (define-key map (kbd "q") #'cider-popup-buffer-quit-function) - (define-key map (kbd "d") #'cider-doc) - (define-key map (kbd "j") #'cider-javadoc) - (define-key map (kbd ".") #'cider-find-var) - (define-key map (kbd "m") #'cider-macroexpand-1-inplace) - (define-key map (kbd "a") #'cider-macroexpand-all-inplace) - (define-key map (kbd "u") #'cider-macroexpand-undo) - (define-key map [remap undo] #'cider-macroexpand-undo) - (easy-menu-define cider-macroexpansion-mode-menu map - "Menu for CIDER's doc mode" - '("Macroexpansion" - ["Restart expansion" cider-macroexpand-again] - ["Macroexpand-1" cider-macroexpand-1-inplace] - ["Macroexpand-all" cider-macroexpand-all-inplace] - ["Macroexpand-undo" cider-macroexpand-undo] - ["Go to source" cider-find-var] - ["Go to doc" cider-doc] - ["Go to Javadoc" cider-docview-javadoc] - ["Quit" cider-popup-buffer-quit-function])) - map)) - -(define-minor-mode cider-macroexpansion-mode - "Minor mode for CIDER macroexpansion. - -\\{cider-macroexpansion-mode-map}" - nil - " Macroexpand" - cider-macroexpansion-mode-map) - -(provide 'cider-macroexpansion) - -;;; cider-macroexpansion.el ends here diff --git a/elpa/cider-20160927.2135/cider-mode.el b/elpa/cider-20160927.2135/cider-mode.el deleted file mode 100644 index df7d7d8..0000000 --- a/elpa/cider-20160927.2135/cider-mode.el +++ /dev/null @@ -1,750 +0,0 @@ -;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2016 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: - -;; Minor mode for REPL interactions. - -;;; Code: - -(require 'clojure-mode) -(require 'cider-interaction) -(require 'cider-test) -(require 'cider-eldoc) -(require 'cider-resolve) -(require 'cider-doc) -(require 'cider-compat) - -(defcustom cider-mode-line-show-connection t - "If the mode-line lighter should detail the connection." - :group 'cider - :type 'boolean - :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)))) - (with-current-buffer current-connection - (concat - cider-repl-type - (when cider-mode-line-show-connection - (format ":%s@%s:%s" - (or (cider--project-name nrepl-project-dir) "") - (pcase (car nrepl-endpoint) - ("localhost" "") - (x x)) - (cadr nrepl-endpoint))))) - "not connected")) - -;;;###autoload -(defcustom 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." - :group 'cider - :type 'sexp - :risky t - :package-version '(cider "0.7.0")) - - -;;; 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 - (pop-to-buffer-same-window repl-buffer) - (pop-to-buffer repl-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." - (interactive "P") - (cider--switch-to-repl-buffer (cider-current-repl-buffer) set-namespace)) - -(declare-function cider-load-buffer "cider-interaction") - -(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. -When SET-NAMESPACE is true, we'll also set the REPL's ns to match that of the -Clojure buffer." - (interactive "P") - (cider-load-buffer) - (cider-switch-to-repl-buffer set-namespace)) - -(defun cider-switch-to-last-clojure-buffer () - "Switch to the last Clojure buffer. -The default keybinding for this command is -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"))) - -(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." - (interactive "P") - (let ((origin-buffer (current-buffer))) - (switch-to-buffer (cider-current-repl-buffer)) - (if clear-repl - (cider-repl-clear-buffer) - (cider-repl-clear-output)) - (switch-to-buffer origin-buffer))) - - -;;; 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-lein-repl' to change the ClojureScript REPL to use."] - ["Create a ClojureScript REPL from a Clojure REPL" cider-create-sibling-cljs-repl] - ["Configure the ClojureScript REPL to use" (customize-variable 'cider-cljs-lein-repl)]) - "--" - ["Connection info" cider-display-connection-info - :active cider-connections] - ["Rotate default connection" cider-rotate-default-connection - :active (cdr cider-connections)] - ["Select any CIDER buffer" cider-selector] - "--" - ["Configure CIDER" (customize-group 'cider)] - "--" - ["A sip of CIDER" cider-drink-a-sip] - ["View manual online" cider-view-manual] - ["View refcard online" cider-view-refcard] - ["Report a bug" cider-report-bug] - ["Version info" cider-version] - "--" - ["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])) - "Menu for CIDER mode") - -(defconst cider-mode-eval-menu - '("CIDER Eval" :visible cider-connections - ["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] - "--" - ["Interrupt evaluation" cider-interrupt] - "--" - ["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] - ["Insert last sexp in REPL" cider-insert-last-sexp-in-repl] - ["Eval top-level sexp to comment" cider-eval-defun-to-comment] - "--" - ["Load this buffer" cider-load-buffer] - ["Load another file" cider-load-file] - ["Load all project files" cider-load-all-project-ns] - ["Refresh loaded code" cider-refresh] - ["Run project (-main function)" cider-run]) - "Menu for CIDER mode eval commands.") - -(defconst cider-mode-interactions-menu - `("CIDER Interactions" :visible cider-connections - ["Complete symbol" complete-symbol] - "--" - ("REPL" - ["Set REPL to this ns" cider-repl-set-ns] - ["Switch to REPL" cider-switch-to-repl-buffer] - ["REPL Pretty Print" cider-repl-toggle-pretty-printing - :style toggle :selected cider-repl-use-pretty-printing] - ["Clear latest output" cider-find-and-clear-repl-output] - ["Clear all output" (cider-find-and-clear-repl-output t) - :keys "\\[universal-argument] \\[cider-find-and-clear-repl-output]"] - "--" - ["Configure the REPL" (customize-group 'cider-repl)]) - ,cider-doc-menu - ("Find (jump to)" - ["Find definition" cider-find-var] - ["Find resource" cider-find-resource] - ["Go back" cider-pop-back]) - ("Macroexpand" - ["Macroexpand-1" cider-macroexpand-1] - ["Macroexpand-all" cider-macroexpand-all]) - ,cider-test-menu - ("Debug" - ["Inspect" cider-inspect] - ["Toggle var tracing" cider-toggle-trace-var] - ["Toggle ns tracing" cider-toggle-trace-ns] - "--" - ["Debug top-level form" cider-debug-defun-at-point - :keys "\\[universal-argument] \\[cider-eval-defun-at-point]"] - ["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 classpath" cider-classpath] - ["Browse classpath entry" cider-open-classpath-entry])) - "Menu for CIDER interactions.") - -(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 "C-c C-.") #'cider-find-ns) - (define-key map (kbd "M-,") #'cider-pop-back) - (define-key map (kbd "C-c M-.") #'cider-find-resource) - (define-key map (kbd "M-TAB") #'complete-symbol) - (define-key map (kbd "C-M-x") #'cider-eval-defun-at-point) - (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-v") 'cider-eval-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-i") #'cider-inspect) - (define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var) - (define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns) - (define-key map (kbd "C-c C-z") #'cider-switch-to-repl-buffer) - (define-key map (kbd "C-c M-z") #'cider-load-buffer-and-switch-to-repl-buffer) - (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-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 C-q") #'cider-quit) - (dolist (variable '(cider-mode-interactions-menu - cider-mode-eval-menu - cider-mode-menu)) - (easy-menu-do-define (intern (format "%s-open" variable)) - map - (get variable 'variable-documentation) - (cider--menu-add-help-strings (symbol-value variable)))) - map)) - -;; This menu works as an easy entry-point into CIDER. Even if cider.el isn't -;; 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. - 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' to change the ClojureScript REPL to use."] - "--" - ["View manual online" cider-view-manual]))) - -;;; Dynamic indentation -(defcustom cider-dynamic-indentation t - "Whether CIDER should aid Clojure(Script) indentation. -If non-nil, CIDER uses runtime information (such as the \":style/indent\" -metadata) to improve standard `clojure-mode' indentation. -If nil, CIDER won't interfere with `clojure-mode's indentation. - -Toggling this variable only takes effect after a file is closed and -re-visited." - :type 'boolean - :package-version '(cider . "0.11.0") - :group 'cider) - -(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 ((format (format ":indent metadata on ‘%s’ is unreadable! \nERROR: %%s" - symbol-name))) - (with-demoted-errors format - (cider--deep-vector-to-list (read indent)))) - ;; 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)))) - (get sym 'clojure-indent-function)))))) - - -;;; Dynamic font locking -(defcustom cider-font-lock-dynamically '(macro core deprecated) - "Specifies how much dynamic font-locking CIDER should use. -Dynamic font-locking this refers to applying syntax highlighting to vars -defined in the currently active nREPL connection. This is done in addition -to `clojure-mode's usual (static) font-lock, so even if you set this -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'. - `function': Any defined function gets the `font-lock-function-face'. - `var': Any non-local var gets the `font-lock-variable-face'. - `deprecated' (default): Any deprecated var gets the `cider-deprecated-face' - face. - `core' (default): Any symbol from clojure.core (face depends on type). - -The value can also be t, which means to font-lock as much as possible." - :type '(choice (set :tag "Fine-tune font-locking" - (const :tag "Any defined macro" macro) - (const :tag "Any defined function" function) - (const :tag "Any defined var" var) - (const :tag "Any defined deprecated" deprecated) - (const :tag "Any symbol from clojure.core" core)) - (const :tag "Font-lock as much as possible" t)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(defface cider-deprecated-face - '((((background light)) :background "light goldenrod") - (((background dark)) :background "#432")) - "Face used on deprecated vars." - :group 'cider) - -(defface cider-instrumented-face - '((((type graphic)) :box (:color "#c00" :line-width -1)) - (t :underline t :background "#800")) - "Face used to mark code being debugged." - :group 'cider-debug - :group 'cider - :package-version '(cider . "0.10.0")) - -(defface cider-traced-face - '((((type graphic)) :box (:color "cyan" :line-width -1)) - (t :underline t :background "#066")) - "Face used to mark code being traced." - :group 'cider - :package-version '(cider . "0.11.0")) - -(defun cider--unless-local-match (value) - "Return VALUE, unless `match-string' is a local var." - (unless (or (get-text-property (point) 'cider-block-dynamic-font-lock) - (member (match-string 0) - (get-text-property (point) 'cider-locals))) - value)) - -(defun cider--compile-font-lock-keywords (symbols-plist core-plist) - "Return a list of font-lock rules for the symbols in SYMBOLS-PLIST and CORE-PLIST." - (let ((cider-font-lock-dynamically (if (eq cider-font-lock-dynamically t) - '(function var macro core deprecated) - cider-font-lock-dynamically)) - deprecated enlightened - macros functions vars instrumented traced) - (cl-labels ((handle-plist - (plist) - (let ((do-function (memq 'function cider-font-lock-dynamically)) - (do-var (memq 'var cider-font-lock-dynamically)) - (do-macro (memq 'macro cider-font-lock-dynamically)) - (do-deprecated (memq 'deprecated cider-font-lock-dynamically))) - (while plist - (let ((sym (pop plist)) - (meta (pop plist))) - (pcase (nrepl-dict-get meta "cider.nrepl.middleware.util.instrument/breakfunction") - (`nil nil) - (`"#'cider.nrepl.middleware.debug/breakpoint-if-interesting" - (push sym instrumented)) - (`"#'cider.nrepl.middleware.enlighten/light-form" - (push sym enlightened))) - ;; The ::traced keywords can be inlined by MrAnderson, so - ;; we catch that case too. - ;; FIXME: This matches values too, not just keys. - (when (seq-find (lambda (k) (and (stringp k) - (string-match (rx "clojure.tools.trace/traced" eos) k))) - meta) - (push sym traced)) - (when (and do-deprecated (nrepl-dict-get meta "deprecated")) - (push sym deprecated)) - (cond ((and do-macro (nrepl-dict-get meta "macro")) - (push sym macros)) - ((and do-function (nrepl-dict-get meta "arglists")) - (push sym functions)) - (do-var (push sym vars)))))))) - (when (memq 'core cider-font-lock-dynamically) - (let ((cider-font-lock-dynamically '(function var macro core deprecated))) - (handle-plist core-plist))) - (handle-plist symbols-plist)) - `( - ,@(when macros - `((,(concat (rx (or "(" "#'")) ; Can't take the value of macros. - "\\(" (regexp-opt macros 'symbols) "\\)") - 1 (cider--unless-local-match font-lock-keyword-face)))) - ,@(when functions - `((,(regexp-opt functions 'symbols) 0 - (cider--unless-local-match font-lock-function-name-face)))) - ,@(when vars - `((,(regexp-opt vars 'symbols) 0 - (cider--unless-local-match font-lock-variable-name-face)))) - ,@(when deprecated - `((,(regexp-opt deprecated 'symbols) 0 - (cider--unless-local-match 'cider-deprecated-face) append))) - ,@(when enlightened - `((,(regexp-opt enlightened 'symbols) 0 - (cider--unless-local-match 'cider-enlightened-face) append))) - ,@(when instrumented - `((,(regexp-opt instrumented 'symbols) 0 - (cider--unless-local-match 'cider-instrumented-face) append))) - ,@(when traced - `((,(regexp-opt traced 'symbols) 0 - (cider--unless-local-match 'cider-traced-face) append)))))) - -(defconst cider--static-font-lock-keywords - (eval-when-compile - `((,(regexp-opt '("#break" "#dbg" "#light") 'symbols) 0 font-lock-warning-face))) - "Default expressions to highlight in CIDER mode.") - -(defvar-local cider--dynamic-font-lock-keywords nil) - -(defun cider-refresh-dynamic-font-lock (&optional ns) - "Ensure that the current buffer has up-to-date font-lock rules. -NS defaults to `cider-current-ns', and it can also be a dict describing the -namespace itself." - (interactive) - (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))) - (setq-local cider--dynamic-font-lock-keywords - (cider--compile-font-lock-keywords - symbols (cider-resolve-ns-symbols (cider-resolve-core-ns)))) - (font-lock-add-keywords nil cider--dynamic-font-lock-keywords 'end)) - (cider--font-lock-flush))) - - -;;; Detecting local variables -(defun cider--read-locals-from-next-sexp () - "Return a list of all locals inside the next logical sexp." - (save-excursion - (ignore-errors - (clojure-forward-logical-sexp 1) - (let ((out nil) - (end (point))) - (forward-sexp -1) - ;; FIXME: This returns locals found inside the :or clause of a - ;; destructuring map. - (while (search-forward-regexp "\\_<[^:&]\\(\\sw\\|\\s_\\)*\\_>" end 'noerror) - (push (match-string-no-properties 0) out)) - out)))) - -(defun cider--read-locals-from-bindings-vector () - "Return a list of all locals inside the next bindings vector." - (save-excursion - (ignore-errors - (cider-start-of-next-sexp) - (when (eq (char-after) ?\[) - (forward-char 1) - (let ((out nil)) - (setq out (append (cider--read-locals-from-next-sexp) out)) - (while (ignore-errors (clojure-forward-logical-sexp 3) - (unless (eobp) - (forward-sexp -1) - t)) - (setq out (append (cider--read-locals-from-next-sexp) out))) - out))))) - -(defun cider--read-locals-from-arglist () - "Return a list of all locals in current form's arglist(s)." - (let ((out nil)) - (save-excursion - (ignore-errors - (cider-start-of-next-sexp) - ;; Named fn - (when (looking-at-p "\\s_\\|\\sw") - (cider-start-of-next-sexp 1)) - ;; Docstring - (when (eq (char-after) ?\") - (cider-start-of-next-sexp 1)) - ;; Attribute map - (when (eq (char-after) ?{) - (cider-start-of-next-sexp 1)) - ;; The arglist - (pcase (char-after) - (?\[ (setq out (cider--read-locals-from-next-sexp))) - ;; FIXME: This returns false positives. It takes all arglists of a - ;; function and returns all args it finds. The logic should be changed - ;; so that each arglist applies to its own scope. - (?\( (ignore-errors - (while (eq (char-after) ?\() - (save-excursion - (forward-char 1) - (setq out (append (cider--read-locals-from-next-sexp) out))) - (cider-start-of-next-sexp 1))))))) - out)) - -(defun cider--parse-and-apply-locals (end &optional outer-locals) - "Figure out local variables between point and END. -A list of these variables is set as the `cider-locals' text property over -the code where they are in scope. -Optional argument OUTER-LOCALS is used to specify local variables defined -before point." - (while (search-forward-regexp "(\\(ns\\_>\\|def\\|fn\\|for\\b\\|loop\\b\\|with-\\|do[a-z]+\\|\\([a-z]+-\\)?let\\b\\)" - end 'noerror) - (goto-char (match-beginning 0)) - (let ((sym (match-string 1)) - (sexp-end (save-excursion - (or (ignore-errors (forward-sexp 1) - (point)) - end)))) - ;; #1324: Don't do dynamic font-lock in `ns' forms, they are special - ;; macros where nothing is evaluated, so we'd get a lot of false - ;; positives. - (if (equal sym "ns") - (add-text-properties (point) sexp-end '(cider-block-dynamic-font-lock t)) - (forward-char 1) - (forward-sexp 1) - (let ((locals (append outer-locals - (pcase sym - ((or "fn" "def" "") (cider--read-locals-from-arglist)) - (_ (cider--read-locals-from-bindings-vector)))))) - (add-text-properties (point) sexp-end (list 'cider-locals locals)) - (clojure-forward-logical-sexp 1) - (cider--parse-and-apply-locals sexp-end locals))) - (goto-char sexp-end)))) - -(defun cider--update-locals-for-region (beg end) - "Update the `cider-locals' text property for region from BEG to END." - (save-excursion - (goto-char beg) - ;; If the inside of a `ns' form changed, reparse it from the start. - (when (and (not (bobp)) - (get-text-property (1- (point)) 'cider-block-dynamic-font-lock)) - (ignore-errors (beginning-of-defun))) - (save-excursion - ;; Move up until we reach a sexp that encloses the entire region (or - ;; a top-level sexp), and set that as the new BEG. - (goto-char end) - (while (and (or (> (point) beg) - (not (eq (char-after) ?\())) - (condition-case nil - (progn (backward-up-list) t) - (scan-error nil)))) - (setq beg (min beg (point))) - ;; If there are locals above the current sexp, reapply them to the - ;; current sexp. - (let ((locals-above (when (> beg (point-min)) - (get-text-property (1- beg) 'cider-locals)))) - (condition-case nil - (clojure-forward-logical-sexp 1) - (error (goto-char end))) - (add-text-properties beg (point) `(cider-locals ,locals-above)) - ;; Extend the region being font-locked to include whole sexps. - (setq end (max end (point))) - (goto-char beg) - (ignore-errors - (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'." - (with-temp-buffer - (cider-docview-render (current-buffer) sym info) - (goto-char (point-max)) - (forward-line -1) - (replace-regexp-in-string - "[`']" "\\\\=\\&" - (buffer-substring-no-properties (point-min) (1- (point)))))) - -(defcustom cider-use-tooltips t - "If non-nil, CIDER displays mouse-over tooltips." - :group 'cider - :type 'boolean - :package-version '(cider "0.12.0")) - -(defvar cider--debug-mode-response) -(defvar cider--debug-mode) - -(defun cider--help-echo (_ obj pos) - "Return the help-echo string for OBJ at POS. -See \(info \"(elisp) Special Properties\")" - (while-no-input - (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))) - (if (member sym (get-text-property (point) 'cider-locals)) - (concat (format "`%s' is a local" sym) - (when cider--debug-mode - (let* ((locals (nrepl-dict-get cider--debug-mode-response "locals")) - (local-val (cadr (assoc sym locals)))) - (format " with value:\n%s" local-val)))) - (let* ((info (cider-sync-request:info sym)) - (candidates (nrepl-dict-get info "candidates"))) - (if candidates - (concat "There were ambiguities resolving this symbol:\n\n" - (mapconcat (lambda (x) (cider--docview-as-string sym x)) - candidates - (concat "\n\n" (make-string 60 ?-) "\n\n"))) - (cider--docview-as-string sym info))))))))))) - -(defun cider--wrap-fontify-locals (func) - "Return a function that will call FUNC after parsing local variables. -The local variables are stored in a list under the `cider-locals' text -property." - (lambda (beg end &rest rest) - (with-silent-modifications - (remove-text-properties beg end '(cider-locals nil cider-block-dynamic-font-lock nil)) - (add-text-properties beg end '(help-echo cider--help-echo)) - (when cider-font-lock-dynamically - (cider--update-locals-for-region beg end))) - (apply func beg end rest))) - - -;;; Minor-mode definition -(defvar x-gtk-use-system-tooltips) - -;;;###autoload -(define-minor-mode cider-mode - "Minor mode for REPL interaction from a Clojure buffer. - -\\{cider-mode-map}" - nil - cider-mode-line - cider-mode-map - (if cider-mode - (progn - (cider-eldoc-setup) - (make-local-variable 'completion-at-point-functions) - (add-to-list 'completion-at-point-functions - #'cider-complete-at-point) - (font-lock-add-keywords nil cider--static-font-lock-keywords) - (cider-refresh-dynamic-font-lock) - ;; `font-lock-mode' might get enabled after `cider-mode'. - (add-hook 'font-lock-mode-hook #'cider-refresh-dynamic-font-lock nil 'local) - (setq-local font-lock-fontify-region-function - (cider--wrap-fontify-locals font-lock-fontify-region-function)) - ;; GTK tooltips look bad, and we have no control over the face. - (setq-local x-gtk-use-system-tooltips nil) - ;; `tooltip' has variable-width by default, which looks terrible. - (set-face-attribute 'tooltip nil :inherit 'unspecified) - (when cider-dynamic-indentation - (setq-local clojure-get-indent-function #'cider--get-symbol-indent)) - (setq-local clojure-expected-ns-function #'cider-expected-ns) - (setq next-error-function #'cider-jump-to-compilation-error)) - (mapc #'kill-local-variable '(completion-at-point-functions - next-error-function - x-gtk-use-system-tooltips - font-lock-fontify-region-function - clojure-get-indent-function)) - (remove-hook 'font-lock-mode-hook #'cider-refresh-dynamic-font-lock 'local) - (font-lock-remove-keywords nil cider--dynamic-font-lock-keywords) - (font-lock-remove-keywords nil cider--static-font-lock-keywords) - (cider--font-lock-flush))) - -(defun cider-set-buffer-ns (ns) - "Set this buffer's namespace to NS and refresh font-locking." - (setq-local cider-buffer-ns ns) - (when (or cider-mode (derived-mode-p 'cider-repl-mode)) - (cider-refresh-dynamic-font-lock ns))) - -(provide 'cider-mode) - -;;; cider-mode.el ends here diff --git a/elpa/cider-20160927.2135/cider-overlays.el b/elpa/cider-20160927.2135/cider-overlays.el deleted file mode 100644 index b64dce5..0000000 --- a/elpa/cider-20160927.2135/cider-overlays.el +++ /dev/null @@ -1,311 +0,0 @@ -;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*- - -;; Copyright © 2015-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: 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 . - -;;; Commentary: - -;; Use `cider--make-overlay' to place a generic overlay at point. Or use -;; `cider--make-result-overlay' to place an interactive eval result overlay at -;; the end of a specified line. - -;;; Code: - -(require 'cider-common) -(require 'cider-compat) -(require 'cl-lib) - - -;;; Customization -(defface cider-result-overlay-face - '((((class color) (background light)) - :background "grey90" :box (:line-width -1 :color "yellow")) - (((class color) (background dark)) - :background "grey10" :box (:line-width -1 :color "black"))) - "Face used to display evaluation results at the end of line. -If `cider-overlays-use-font-lock' is non-nil, this face is -applied with lower priority than the syntax highlighting." - :group 'cider - :package-version '(cider "0.9.1")) - -(defcustom cider-result-use-clojure-font-lock t - "If non-nil, interactive eval results are font-locked as Clojure code." - :group 'cider - :type 'boolean - :package-version '(cider . "0.10.0")) - -(defcustom cider-overlays-use-font-lock t - "If non-nil, results overlays are font-locked as Clojure code. -If nil, apply `cider-result-overlay-face' to the entire overlay instead of -font-locking it." - :group 'cider - :type 'boolean - :package-version '(cider . "0.10.0")) - -(defcustom cider-use-overlays 'both - "Whether to display evaluation results with overlays. -If t, use overlays. If nil, display on the echo area. If both, display on -both places. - -Only applies to evaluation commands. To configure the debugger overlays, -see `cider-debug-use-overlays'." - :type '(choice (const :tag "End of line" t) - (const :tag "Bottom of screen" nil) - (const :tag "Both" both)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-eval-result-prefix "=> " - "The prefix displayed in the minibuffer before a result value." - :type 'string - :group 'cider - :package-version '(cider . "0.5.0")) - -(defcustom cider-eval-result-duration 'command - "Duration, in seconds, of CIDER's eval-result overlays. -If nil, overlays last indefinitely. -If the symbol `command', they're erased after the next command. -Also see `cider-use-overlays'." - :type '(choice (integer :tag "Duration in seconds") - (const :tag "Until next command" command) - (const :tag "Last indefinitely" nil)) - :group 'cider - :package-version '(cider . "0.10.0")) - - -;;; Overlay logic -(defun cider--delete-overlay (ov &rest _) - "Safely delete overlay OV. -Never throws errors, and can be used in an overlay's modification-hooks." - (ignore-errors (delete-overlay ov))) - -(defun cider--make-overlay (l r type &rest props) - "Place an overlay between L and R and return it. -TYPE is a symbol put on the overlay's category property. It is used to -easily remove all overlays from a region with: - (remove-overlays start end 'category TYPE) -PROPS is a plist of properties and values to add to the overlay." - (let ((o (make-overlay l (or r l) (current-buffer)))) - (overlay-put o 'category type) - (overlay-put o 'cider-temporary t) - (while props (overlay-put o (pop props) (pop props))) - (push #'cider--delete-overlay (overlay-get o 'modification-hooks)) - o)) - -(defun cider--remove-result-overlay () - "Remove result overlay from current buffer. -This function also removes itself from `post-command-hook'." - (remove-hook 'post-command-hook #'cider--remove-result-overlay 'local) - (remove-overlays nil nil 'category 'result)) - -(defun cider--remove-result-overlay-after-command () - "Add `cider--remove-result-overlay' locally to `post-command-hook'. -This function also removes itself from `post-command-hook'." - (remove-hook 'post-command-hook #'cider--remove-result-overlay-after-command 'local) - (add-hook 'post-command-hook #'cider--remove-result-overlay nil 'local)) - -(defface cider-fringe-good-face - '((((class color) (background light)) :foreground "lightgreen") - (((class color) (background dark)) :foreground "darkgreen")) - "Face used on the fringe indicator for successful evaluation." - :group 'cider) - -(defconst cider--fringe-overlay-good - (propertize " " 'display '(left-fringe empty-line cider-fringe-good-face)) - "The before-string property that adds a green indicator on the fringe.") - -(defcustom cider-use-fringe-indicators t - "Whether to display evaluation indicators on the left fringe." - :safe #'booleanp - :group 'cider - :type 'boolean) - -(defun cider--make-fringe-overlay (&optional end) - "Place an eval indicator at the fringe before a sexp. -END is the position where the sexp ends, and defaults to point." - (when cider-use-fringe-indicators - (with-current-buffer (if (markerp end) - (marker-buffer end) - (current-buffer)) - (save-excursion - (if end - (goto-char end) - (setq end (point))) - (clojure-forward-logical-sexp -1) - ;; Create the green-circle overlay. - (cider--make-overlay (point) end 'cider-fringe-indicator - '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) - "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 -beginning to end of current line. -Return nil if the overlay was not placed or if it might not be visible, and -return the overlay otherwise. - -Return the overlay if it was placed successfully, and nil if it failed. - -This function takes some optional keyword arguments: - - If WHERE is a number or a marker, apply the overlay over - the entire line at that place (defaulting to `point'). If - it is a cons cell, the car and cdr determine the start and - end of the overlay. - DURATION takes the same possible values as the - `cider-eval-result-duration' variable. - TYPE is passed to `cider--make-overlay' (defaults to `result'). - FORMAT is a string passed to `format'. It should have - exactly one %s construct (for VALUE). - -All arguments beyond these (PROPS) are properties to be used on the -overlay." - (declare (indent 1)) - (while (keywordp (car props)) - (setq props (cdr (cdr props)))) - ;; If the marker points to a dead buffer, don't do anything. - (let ((buffer (cond - ((markerp where) (marker-buffer where)) - ((markerp (car-safe where)) (marker-buffer (car where))) - (t (current-buffer))))) - (with-current-buffer buffer - (save-excursion - (when (number-or-marker-p where) - (goto-char where)) - ;; Make sure the overlay is actually at the end of the sexp. - (skip-chars-backward "\r\n[:blank:]") - (let* ((beg (if (consp where) - (car where) - (save-excursion - (clojure-backward-logical-sexp 1) - (point)))) - (end (if (consp where) - (cdr where) - (line-end-position))) - (display-string (format format value)) - (o nil)) - (remove-overlays beg end 'category type) - (funcall (if cider-overlays-use-font-lock - #'font-lock-prepend-text-property - #'put-text-property) - 0 (length display-string) - 'face prepend-face - display-string) - ;; If the display spans multiple lines or is very long, display it at - ;; the beginning of the next line. - (when (or (string-match "\n." display-string) - (> (string-width display-string) - (- (window-width) (current-column)))) - (setq display-string (concat " \n" display-string))) - ;; Put the cursor property only once we're done manipulating the - ;; string, since we want it to be at the first char. - (put-text-property 0 1 'cursor 0 display-string) - (when (> (string-width display-string) (* 3 (window-width))) - (setq display-string - (concat (substring display-string 0 (* 3 (window-width))) - (substitute-command-keys - "...\nResult truncated. Type `\\[cider-inspect-last-result]' to inspect it.")))) - ;; Create the result overlay. - (setq o (apply #'cider--make-overlay - beg end type - 'after-string display-string - props)) - (pcase duration - ((pred numberp) (run-at-time duration nil #'cider--delete-overlay o)) - (`command - ;; If inside a command-loop, tell `cider--remove-result-overlay' - ;; to only remove after the *next* command. - (if this-command - (add-hook 'post-command-hook - #'cider--remove-result-overlay-after-command - nil 'local) - (cider--remove-result-overlay-after-command)))) - (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)) - ;; Right edge is visible. This is a little conservative - ;; if the overlay contains line breaks. - (or (< (+ (current-column) (string-width value)) - (window-width win)) - (not truncate-lines))) - o))))))) - - -;;; Displaying eval result -(defun cider--display-interactive-eval-result (value &optional point) - "Display the result VALUE of an interactive eval operation. -VALUE is syntax-highlighted and displayed in the echo area. -If POINT and `cider-use-overlays' are non-nil, it is also displayed in an -overlay at the end of the line containing POINT. -Note that, while POINT can be a number, it's preferable to be a marker, as -that will better handle some corner cases where the original buffer is not -focused." - (let* ((font-value (if cider-result-use-clojure-font-lock - (cider-font-lock-as-clojure value) - value)) - (used-overlay (when (and point cider-use-overlays) - (cider--make-result-overlay font-value - :where point - :duration cider-eval-result-duration)))) - (message - "%s" - (propertize (format "%s%s" cider-eval-result-prefix font-value) - ;; The following hides the message from the echo-area, but - ;; displays it in the Messages buffer. We only hide the message - ;; if the user wants to AND if the overlay succeeded. - 'invisible (and used-overlay - (not (eq cider-use-overlays 'both))))))) - - -;;; Fragile buttons -(defface cider-fragile-button-face - '((((type graphic)) - :box (:line-width 3 :style released-button) - :inherit font-lock-warning-face) - (t :inverse-video t)) - "Face for buttons that vanish when clicked." - :package-version '(cider . "0.12.0") - :group 'cider) - -(define-button-type 'cider-fragile - 'action 'cider--overlay-destroy - 'follow-link t - 'face nil - 'modification-hooks '(cider--overlay-destroy) - 'help-echo "RET: delete this.") - -(defun cider--overlay-destroy (ov &rest r) - "Delete overlay OV and its underlying text. -If any other arguments are given (collected in R), only actually do anything -if the first one is non-nil. This is so it works in `modification-hooks'." - (unless (and r (not (car r))) - (let ((inhibit-modification-hooks t) - (beg (copy-marker (overlay-start ov))) - (end (copy-marker (overlay-end ov)))) - (delete-overlay ov) - (delete-region beg end) - (goto-char beg) - (when (= (char-after) (char-before) ?\n) - (delete-char 1))))) - -(provide 'cider-overlays) -;;; cider-overlays.el ends here diff --git a/elpa/cider-20160927.2135/cider-pkg.el b/elpa/cider-20160927.2135/cider-pkg.el deleted file mode 100644 index 80948ef..0000000 --- a/elpa/cider-20160927.2135/cider-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -(define-package "cider" "20160927.2135" "Clojure Interactive Development Environment that Rocks" - '((emacs "24.3") - (clojure-mode "5.5.2") - (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-20160927.2135/cider-popup.el b/elpa/cider-20160927.2135/cider-popup.el deleted file mode 100644 index 7c235f8..0000000 --- a/elpa/cider-20160927.2135/cider-popup.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- - -;; Copyright © 2015-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: 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 . - -;;; Commentary: - -;; Common functionality for dealing with popup buffers. - -;;; Code: - -(require 'cider-compat) - -(define-minor-mode cider-popup-buffer-mode - "Mode for CIDER popup buffers" - nil - (" cider-tmp") - '(("q" . cider-popup-buffer-quit-function))) - -(defvar-local cider-popup-buffer-quit-function #'cider-popup-buffer-quit - "The function that is used to quit a temporary popup buffer.") - -(defun cider-popup-buffer-quit-function (&optional kill-buffer-p) - "Wrapper to invoke the function `cider-popup-buffer-quit-function'. -KILL-BUFFER-P is passed along." - (interactive) - (funcall cider-popup-buffer-quit-function kill-buffer-p)) - -(defun cider-popup-buffer (name &optional select mode ancillary) - "Create new popup buffer called NAME. -If SELECT is non-nil, select the newly created window. -If major MODE is non-nil, enable it for the popup buffer. -If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' -and automatically removed when killed." - (thread-first (cider-make-popup-buffer name mode ancillary) - (cider-popup-buffer-display select))) - -(defun cider-popup-buffer-display (buffer &optional select) - "Display BUFFER. -If SELECT is non-nil, select the BUFFER." - (let ((window (get-buffer-window buffer 'visible))) - (when window - (with-current-buffer buffer - (set-window-point window (point)))) - ;; If the buffer we are popping up is already displayed in the selected - ;; window, the below `inhibit-same-window' logic will cause it to be - ;; displayed twice - so we early out in this case. Note that we must check - ;; `selected-window', as async request handlers are executed in the context - ;; of the current connection buffer (i.e. `current-buffer' is dynamically - ;; bound to that). - (unless (eq window (selected-window)) - ;; Non nil `inhibit-same-window' ensures that current window is not covered - ;; Non nil `inhibit-switch-frame' ensures that the other frame is not selected - ;; if that's where the buffer is being shown. - (funcall (if select #'pop-to-buffer #'display-buffer) - buffer `(nil . ((inhibit-same-window . ,pop-up-windows) - (reusable-frames . visible)))))) - buffer) - -(defun cider-popup-buffer-quit (&optional kill) - "Quit the current (temp) window. -Bury its buffer using `quit-restore-window'. -If prefix argument KILL is non-nil, kill the buffer instead of burying it." - (interactive) - (quit-restore-window (selected-window) (if kill 'kill 'append))) - -(defvar-local cider-popup-output-marker nil) - -(defvar cider-ancillary-buffers nil) - -(defun cider-make-popup-buffer (name &optional mode ancillary) - "Create a temporary buffer called NAME using major MODE (if specified). -If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' -and automatically removed when killed." - (with-current-buffer (get-buffer-create name) - (kill-all-local-variables) - (setq buffer-read-only nil) - (erase-buffer) - (when mode - (funcall mode)) - (cider-popup-buffer-mode 1) - (setq cider-popup-output-marker (point-marker)) - (setq buffer-read-only t) - (when ancillary - (add-to-list 'cider-ancillary-buffers name) - (add-hook 'kill-buffer-hook - (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." - ;; 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. - (when (buffer-live-p buffer) - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t) - (moving (= (point) cider-popup-output-marker))) - (save-excursion - (goto-char cider-popup-output-marker) - (let ((value-str (format "%s" value))) - (when face - (if (fboundp 'add-face-text-property) - (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) - (set-marker cider-popup-output-marker (point))) - (when moving (goto-char cider-popup-output-marker)))))) - -(provide 'cider-popup) - -;;; cider-popup.el ends here diff --git a/elpa/cider-20160927.2135/cider-repl.el b/elpa/cider-20160927.2135/cider-repl.el deleted file mode 100644 index 1199f3f..0000000 --- a/elpa/cider-20160927.2135/cider-repl.el +++ /dev/null @@ -1,1377 +0,0 @@ -;;; cider-repl.el --- REPL interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2016 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: - -;; REPL interactions. - -;;; Code: - -(require 'cider-client) -(require 'cider-doc) -(require 'cider-test) -(require 'cider-eldoc) ; for cider-eldoc-setup -(require 'cider-common) -(require 'cider-compat) -(require 'cider-util) -(require 'cider-resolve) - -(require 'clojure-mode) -(require 'easymenu) -(require 'cl-lib) - -(eval-when-compile - (defvar paredit-version) - (defvar paredit-space-for-delimiter-predicates)) - - -(defgroup cider-repl nil - "Interaction with the REPL." - :prefix "cider-repl-" - :group 'cider) - -(defface cider-repl-prompt-face - '((t (:inherit font-lock-keyword-face))) - "Face for the prompt in the REPL buffer." - :group 'cider-repl) - -(defface cider-repl-stdout-face - '((t (:inherit font-lock-string-face))) - "Face for STDOUT output in the REPL buffer." - :group 'cider-repl) - -(defface cider-repl-stderr-face - '((t (:inherit font-lock-warning-face))) - "Face for STDERR output in the REPL buffer." - :group 'cider-repl - :package-version '(cider . "0.6.0")) - -(defface cider-repl-input-face - '((t (:bold t))) - "Face for previous input in the REPL buffer." - :group 'cider-repl) - -(defface cider-repl-result-face - '((t ())) - "Face for the result of an evaluation in the REPL buffer." - :group 'cider-repl) - -(defcustom cider-repl-pop-to-buffer-on-connect t - "Controls whether to pop to the REPL buffer on connect. - -When set to nil the buffer will only be created." - :type 'boolean - :group 'cider-repl) - -(defcustom cider-repl-display-in-current-window nil - "Controls whether the REPL buffer is displayed in the current window." - :type 'boolean - :group 'cider-repl) - -(defcustom cider-repl-scroll-on-output t - "Controls whether the REPL buffer auto-scrolls on new output. - -When set to t (the default), if the REPL buffer contains more lines than the -size of the window, the buffer is automatically re-centered upon completion -of evaluating an expression, so that the bottom line of output is on the -bottom line of the window. - -If this is set to nil, no re-centering takes place." - :type 'boolean - :group 'cider-repl - :package-version '(cider . "0.11.0")) - -(defcustom cider-repl-use-pretty-printing nil - "Control whether the results in REPL are pretty-printed or not. -The `cider-toggle-pretty-printing' command can be used to interactively -change the setting's value." - :type 'boolean - :group 'cider-repl) - -(defcustom cider-repl-use-clojure-font-lock t - "Non-nil means to use Clojure mode font-locking for input and result. -Nil means that `cider-repl-input-face' and `cider-repl-result-face' -will be used." - :type 'boolean - :group 'cider-repl - :package-version '(cider . "0.10.0")) - -(defcustom cider-repl-result-prefix "" - "The prefix displayed in the REPL before a result value." - :type 'string - :group 'cider - :package-version '(cider . "0.5.0")) - -(defcustom cider-repl-tab-command 'cider-repl-indent-and-complete-symbol - "Select the command to be invoked by the TAB key. -The default option is `cider-repl-indent-and-complete-symbol'. If -you'd like to use the default Emacs behavior use -`indent-for-tab-command'." - :type 'symbol - :group 'cider-repl) - -(defcustom cider-repl-display-help-banner t - "When non-nil a bit of help text will be displayed on REPL start." - :type 'boolean - :group 'cider-repl - :package-version '(cider . "0.11.0")) - - -;;;; REPL buffer local variables -(defvar-local cider-repl-input-start-mark nil) - -(defvar-local cider-repl-prompt-start-mark nil) - -(defvar-local cider-repl-old-input-counter 0 - "Counter used to generate unique `cider-old-input' properties. -This property value must be unique to avoid having adjacent inputs be -joined together.") - -(defvar-local cider-repl-input-history '() - "History list of strings read from the REPL buffer.") - -(defvar-local cider-repl-input-history-items-added 0 - "Variable counting the items added in the current session.") - -(defvar-local cider-repl-output-start nil - "Marker for the start of output. -Currently its only purpose is to facilitate `cider-repl-clear-buffer'.") - -(defvar-local cider-repl-output-end nil - "Marker for the end of output. -Currently its only purpose is to facilitate `cider-repl-clear-buffer'.") - -(defun cider-repl-tab () - "Invoked on TAB keystrokes in `cider-repl-mode' buffers." - (interactive) - (funcall cider-repl-tab-command)) - -(defun cider-repl-reset-markers () - "Reset all REPL markers." - (dolist (markname '(cider-repl-output-start - cider-repl-output-end - cider-repl-prompt-start-mark - cider-repl-input-start-mark)) - (set markname (make-marker)) - (set-marker (symbol-value markname) (point)))) - - -;;; REPL init - -(defvar-local cider-repl-ns-cache nil - "A dict holding information about all currently loaded namespaces. -This cache is stored in the connection buffer. Other buffer's access it -via `cider-current-connection'.") - -(defvar cider-mode) -(declare-function cider-refresh-dynamic-font-lock "cider-mode") - -(defun cider-repl--state-handler (response) - "Handle the server state contained in RESPONSE. -Currently, this is only used to keep `cider-repl-type' updated." - (with-demoted-errors "Error in `cider-repl--state-handler': %s" - (when (member "state" (nrepl-dict-get response "status")) - (nrepl-dbind-response response (repl-type changed-namespaces) - (when repl-type - (setq cider-repl-type repl-type)) - (unless (nrepl-dict-empty-p changed-namespaces) - (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces)) - (dolist (b (buffer-list)) - (with-current-buffer b - ;; 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))))) - (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)." - ;; 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"))) - (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-init (buffer &optional no-banner) - "Initialize the REPL in BUFFER. -BUFFER must be a REPL buffer with `cider-repl-mode' and a running -client process connection. Unless NO-BANNER is non-nil, insert a banner." - (cider-repl-set-initial-ns buffer) - (cider-repl-require-repl-utils) - (unless no-banner - (cider-repl--insert-banner-and-prompt buffer)) - (when cider-repl-display-in-current-window - (add-to-list 'same-window-buffer-names (buffer-name buffer))) - (when cider-repl-pop-to-buffer-on-connect - (pop-to-buffer buffer)) - (cider-remember-clojure-buffer cider-current-clojure-buffer) - buffer) - -(defun cider-repl--banner () - "Generate the welcome REPL buffer banner." - (let ((host (cider--connection-host (current-buffer))) - (port (cider--connection-port (current-buffer)))) - (format ";; Connected to nREPL server - nrepl://%s:%s -;; CIDER %s, nREPL %s -;; Clojure %s, Java %s -;; Docs: (doc function-name) -;; (find-doc part-of-name) -;; Source: (source function-name) -;; 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)))) - -(defun cider-repl--help-banner () - "Generate the help banner." - (substitute-command-keys - "\n;; ====================================================================== -;; If you’re new to CIDER it is highly recommended to go through its -;; manual first. Type to view it. -;; In case you’re seeing any warnings you should consult the manual’s -;; \"Troubleshooting\" section. -;; -;; Here are few tips to get you started: -;; -;; * 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 file -;; * 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) -;; * Enable `eldoc-mode' to display function & method signatures in the minibuffer. -;; * Print CIDER's refcard and keep it close to your keyboard. -;; -;; CIDER is super customizable - try to -;; get a feel for this. If you’re thirsty for knowledge you should try -;; . -;; -;; If you think you’ve encountered a bug (or have some suggestions for -;; improvements) use to report it. -;; -;; 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 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 - -(defun cider-repl--in-input-area-p () - "Return t if in input area." - (<= cider-repl-input-start-mark (point))) - -(defun cider-repl--current-input (&optional until-point-p) - "Return the current input as string. -The input is the region from after the last prompt to the end of -buffer. If UNTIL-POINT-P is non-nil, the input is until the current -point." - (buffer-substring-no-properties cider-repl-input-start-mark - (if until-point-p - (point) - (point-max)))) - -(defun cider-repl-previous-prompt () - "Move backward to the previous prompt." - (interactive) - (cider-repl--find-prompt t)) - -(defun cider-repl-next-prompt () - "Move forward to the next prompt." - (interactive) - (cider-repl--find-prompt)) - -(defun cider-repl--find-prompt (&optional backward) - "Find the next prompt. -If BACKWARD is non-nil look backward." - (let ((origin (point)) - (cider-repl-prompt-property 'field)) - (while (progn - (cider-search-property-change cider-repl-prompt-property backward) - (not (or (cider-end-of-proprange-p cider-repl-prompt-property) (bobp) (eobp))))) - (unless (cider-end-of-proprange-p cider-repl-prompt-property) - (goto-char origin)))) - -(defun cider-search-property-change (prop &optional backward) - "Search forward for a property change to PROP. -If BACKWARD is non-nil search backward." - (cond (backward - (goto-char (previous-single-char-property-change (point) prop))) - (t - (goto-char (next-single-char-property-change (point) prop))))) - -(defun cider-end-of-proprange-p (property) - "Return t if at the the end of a property range for PROPERTY." - (and (get-char-property (max (point-min) (1- (point))) property) - (not (get-char-property (point) property)))) - -(defun cider-repl--mark-input-start () - "Mark the input start." - (set-marker cider-repl-input-start-mark (point) (current-buffer))) - -(defun cider-repl--mark-output-start () - "Mark the output start." - (set-marker cider-repl-output-start (point)) - (set-marker cider-repl-output-end (point))) - -(defun cider-repl-mode-beginning-of-defun (&optional arg) - "Move to the beginning of defun. -If given a negative value of ARG, move to the end of defun." - (if (and arg (< arg 0)) - (cider-repl-mode-end-of-defun (- arg)) - (dotimes (_ (or arg 1)) - (cider-repl-previous-prompt)))) - -(defun cider-repl-mode-end-of-defun (&optional arg) - "Move to the end of defun. -If given a negative value of ARG, move to the beginning of defun." - (if (and arg (< arg 0)) - (cider-repl-mode-beginning-of-defun (- arg)) - (dotimes (_ (or arg 1)) - (cider-repl-next-prompt)))) - -(defun cider-repl-beginning-of-defun () - "Move to beginning of defun." - (interactive) - ;; We call `beginning-of-defun' if we're at the start of a prompt - ;; already, to trigger `cider-repl-mode-beginning-of-defun' by means - ;; of the locally bound `beginning-of-defun-function', in order to - ;; jump to the start of the previous prompt. - (if (and (not (cider-repl--at-prompt-start-p)) - (cider-repl--in-input-area-p)) - (goto-char cider-repl-input-start-mark) - (beginning-of-defun))) - -(defun cider-repl-end-of-defun () - "Move to end of defun." - (interactive) - ;; C.f. `cider-repl-beginning-of-defun' - (if (and (not (= (point) (point-max))) - (cider-repl--in-input-area-p)) - (goto-char (point-max)) - (end-of-defun))) - -(defun cider-repl-bol-mark () - "Set the mark and go to the beginning of line or the prompt." - (interactive) - (unless mark-active - (set-mark (point))) - (move-beginning-of-line 1)) - -(defun cider-repl--at-prompt-start-p () - "Return t if point is at the start of prompt. -This will not work on non-current prompts." - (= (point) cider-repl-input-start-mark)) - -(defun cider-repl--show-maximum-output () - "Put the end of the buffer at the bottom of the window." - (when (and cider-repl-scroll-on-output (eobp)) - (let ((win (get-buffer-window (current-buffer) t))) - (when win - (with-selected-window win - (set-window-point win (point-max)) - (recenter -1)))))) - -(defmacro cider-save-marker (marker &rest body) - "Save MARKER and execute BODY." - (declare (debug t)) - (let ((pos (make-symbol "pos"))) - `(let ((,pos (marker-position ,marker))) - (prog1 (progn . ,body) - (set-marker ,marker ,pos))))) - -(put 'cider-save-marker 'lisp-indent-function 1) - -(defun cider-repl-prompt-default (namespace) - "Return a prompt string that mentions NAMESPACE." - (format "%s> " namespace)) - -(defun cider-repl-prompt-abbreviated (namespace) - "Return a prompt string that abbreviates NAMESPACE." - (format "%s> " (cider-abbreviate-ns namespace))) - -(defun cider-repl-prompt-lastname (namespace) - "Return a prompt string with the last name in NAMESPACE." - (format "%s> " (cider-last-ns-segment namespace))) - -(defcustom cider-repl-prompt-function #'cider-repl-prompt-default - "A function that returns a prompt string. -Takes one argument, a namespace name. -For convenience, three functions are already provided for this purpose: -`cider-repl-prompt-lastname', `cider-repl-prompt-abbreviated', and -`cider-repl-prompt-default'" - :type '(choice (const :tag "Full namespace" cider-repl-prompt-default) - (const :tag "Abbreviated namespace" cider-repl-prompt-abbreviated) - (const :tag "Last name in namespace" cider-repl-prompt-lastname) - (function :tag "Custom function")) - :group 'cider-repl - :package-version '(cider . "0.9.0")) - -(defun cider-repl--insert-prompt (namespace) - "Insert the prompt (before markers!), taking into account NAMESPACE. -Set point after the prompt. -Return the position of the prompt beginning." - (goto-char cider-repl-input-start-mark) - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (unless (bolp) (insert-before-markers "\n")) - (let ((prompt-start (point)) - (prompt (funcall cider-repl-prompt-function namespace))) - (cider-propertize-region - '(font-lock-face cider-repl-prompt-face read-only t intangible t - field cider-repl-prompt - rear-nonsticky (field read-only font-lock-face intangible)) - (insert-before-markers prompt)) - (set-marker cider-repl-prompt-start-mark prompt-start) - prompt-start)))) - -(defun cider-repl--flush-ansi-color-context () - "Flush ansi color context after printing. -When there is a possible unfinished ansi control sequence, - `ansi-color-context` maintains this list." - (when (and ansi-color-context (stringp (cadr ansi-color-context))) - (insert-before-markers (cadr ansi-color-context)) - (setq ansi-color-context nil))) - -(defun cider-repl--emit-output-at-pos (buffer string output-face position &optional bol) - "Using BUFFER, insert STRING (applying to it OUTPUT-FACE) at POSITION. -If BOL is non-nil insert at the beginning of line." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (goto-char position) - ;; TODO: Review the need for bol - (when (and bol (not (bolp))) (insert-before-markers "\n")) - (insert-before-markers - (ansi-color-apply (propertize string - 'font-lock-face output-face - 'rear-nonsticky '(font-lock-face)))) - (cider-repl--flush-ansi-color-context) - (when (and (= (point) cider-repl-prompt-start-mark) - (not (bolp))) - (insert-before-markers "\n") - (set-marker cider-repl-output-end (1- (point))))))) - (cider-repl--show-maximum-output))) - -(defun cider-repl--emit-interactive-output (string face) - "Emit STRING as interactive output using FACE." - (with-current-buffer (cider-current-repl-buffer) - (let ((pos (cider-repl--end-of-line-before-input-start)) - (string (replace-regexp-in-string "\n\\'" "" string))) - (cider-repl--emit-output-at-pos (current-buffer) string face pos t)))) - -(defun cider-repl-emit-interactive-stdout (string) - "Emit STRING as interactive output." - (cider-repl--emit-interactive-output string 'cider-repl-stdout-face)) - -(defun cider-repl-emit-interactive-stderr (string) - "Emit STRING as interactive err output." - (cider-repl--emit-interactive-output string 'cider-repl-stderr-face)) - -(defun cider-repl-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." - (with-current-buffer buffer - (cider-repl--emit-output-at-pos buffer string face cider-repl-input-start-mark bol))) - -(defun cider-repl-emit-stdout (buffer string) - "Using BUFFER, emit STRING as standard output." - (cider-repl--emit-output buffer string 'cider-repl-stdout-face)) - -(defun cider-repl-emit-stderr (buffer string) - "Using BUFFER, emit STRING as error output." - (cider-repl--emit-output buffer string 'cider-repl-stderr-face)) - -(defun cider-repl-emit-prompt (buffer) - "Emit the REPL prompt into BUFFER." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (cider-repl--insert-prompt cider-buffer-ns)))) - (cider-repl--show-maximum-output))) - -(defun cider-repl-emit-result (buffer string &optional bol) - "Emit into BUFFER the result STRING and mark it as an evaluation result. -If BOL is non-nil insert at the beginning of the line." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (goto-char cider-repl-input-start-mark) - (when (and bol (not (bolp))) - (insert-before-markers "\n")) - (insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face)) - (if cider-repl-use-clojure-font-lock - (insert-before-markers (cider-font-lock-as-clojure string)) - (cider-propertize-region - '(font-lock-face cider-repl-result-face rear-nonsticky (font-lock-face)) - (insert-before-markers string)))))) - (cider-repl--show-maximum-output))) - -(defun cider-repl-newline-and-indent () - "Insert a newline, then indent the next line. -Restrict the buffer from the prompt for indentation, to avoid being -confused by strange characters (like unmatched quotes) appearing -earlier in the buffer." - (interactive) - (save-restriction - (narrow-to-region cider-repl-prompt-start-mark (point-max)) - (insert "\n") - (lisp-indent-line))) - -(defun cider-repl-indent-and-complete-symbol () - "Indent the current line and perform symbol completion. -First indent the line. If indenting doesn't move point, complete -the symbol." - (interactive) - (let ((pos (point))) - (lisp-indent-line) - (when (= pos (point)) - (if (save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t)) - (completion-at-point))))) - -(defun cider-repl-kill-input () - "Kill all text from the prompt to point." - (interactive) - (cond ((< (marker-position cider-repl-input-start-mark) (point)) - (kill-region cider-repl-input-start-mark (point))) - ((= (point) (marker-position cider-repl-input-start-mark)) - (cider-repl-delete-current-input)))) - -(defun cider-repl--input-complete-p (start end) - "Return t if the region from START to END is a complete sexp." - (save-excursion - (goto-char start) - (cond ((looking-at-p "\\s *[@'`#]?[(\"]") - (ignore-errors - (save-restriction - (narrow-to-region start end) - ;; Keep stepping over blanks and sexps until the end of - ;; buffer is reached or an error occurs. Tolerate extra - ;; close parens. - (cl-loop do (skip-chars-forward " \t\r\n)") - until (eobp) - do (forward-sexp)) - t))) - (t t)))) - -(defun cider-repl-handler (buffer) - "Make 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)))) - -(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 (1- (window-width))))))) - -(defun cider-repl-return (&optional end-of-input) - "Evaluate the current input string, or insert a newline. -Send the current input ony if a whole expression has been entered, -i.e. the parenthesis are matched. -When END-OF-INPUT is non-nil, send the input even if the parentheses -are not balanced." - (interactive "P") - (cond - (end-of-input - (cider-repl--send-input)) - ((and (get-text-property (point) 'cider-old-input) - (< (point) cider-repl-input-start-mark)) - (cider-repl--grab-old-input end-of-input) - (cider-repl--recenter-if-needed)) - ((cider-repl--input-complete-p cider-repl-input-start-mark (point-max)) - (cider-repl--send-input t)) - (t - (cider-repl-newline-and-indent) - (message "[input not complete]")))) - -(defun cider-repl--recenter-if-needed () - "Make sure that the point is visible." - (unless (pos-visible-in-window-p (point-max)) - (save-excursion - (goto-char (point-max)) - (recenter -1)))) - -(defun cider-repl--grab-old-input (replace) - "Resend the old REPL input at point. -If REPLACE is non-nil the current input is replaced with the old -input; otherwise the new input is appended. The old input has the -text property `cider-old-input'." - (cl-multiple-value-bind (beg end) (cider-property-bounds 'cider-old-input) - (let ((old-input (buffer-substring beg end)) ;;preserve - ;;properties, they will be removed later - (offset (- (point) beg))) - ;; Append the old input or replace the current input - (cond (replace (goto-char cider-repl-input-start-mark)) - (t (goto-char (point-max)) - (unless (eq (char-before) ?\ ) - (insert " ")))) - (delete-region (point) (point-max)) - (save-excursion - (insert old-input) - (when (equal (char-before) ?\n) - (delete-char -1))) - (forward-char offset)))) - -(defun cider-repl-closing-return () - "Evaluate the current input string after closing all open parenthesized or bracketed expressions." - (interactive) - (goto-char (point-max)) - (save-restriction - (narrow-to-region cider-repl-input-start-mark (point)) - (let ((matching-delimiter nil)) - (while (ignore-errors (save-excursion - (backward-up-list 1) - (setq matching-delimiter (cdr (syntax-after (point))))) t) - (insert-char matching-delimiter)))) - (cider-repl-return)) - -(defun cider-repl-toggle-pretty-printing () - "Toggle pretty-printing in the REPL." - (interactive) - (setq cider-repl-use-pretty-printing (not cider-repl-use-pretty-printing)) - (message "Pretty printing in REPL %s." - (if cider-repl-use-pretty-printing "enabled" "disabled"))) - -(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"))) - -(defvar cider-repl-clear-buffer-hook) - -(defun cider-repl--clear-region (start end) - "Delete the output and its overlays between START and END." - (mapc #'delete-overlay (overlays-in start end)) - (delete-region start end)) - -(defun cider-repl-clear-buffer () - "Delete the output generated by the Clojure process." - (interactive) - (let ((inhibit-read-only t)) - (cider-repl--clear-region (point-min) cider-repl-prompt-start-mark) - (cider-repl--clear-region cider-repl-output-start cider-repl-output-end) - (when (< (point) cider-repl-input-start-mark) - (goto-char cider-repl-input-start-mark)) - (recenter t)) - (run-hooks 'cider-repl-clear-buffer-hook)) - -(defun cider-repl--end-of-line-before-input-start () - "Return the position of the end of the line preceding the beginning of input." - (1- (previous-single-property-change cider-repl-input-start-mark 'field nil - (1+ (point-min))))) - -(defun cider-repl-clear-output (&optional clear-repl) - "Delete the output inserted since the last input. -With a prefix argument CLEAR-REPL it will clear the entire REPL buffer instead." - (interactive "P") - (if clear-repl - (cider-repl-clear-buffer) - (let ((start (save-excursion - (cider-repl-previous-prompt) - (ignore-errors (forward-sexp)) - (forward-line) - (point))) - (end (cider-repl--end-of-line-before-input-start))) - (when (< start end) - (let ((inhibit-read-only t)) - (cider-repl--clear-region start end) - (save-excursion - (goto-char start) - (insert - (propertize ";; output cleared" 'font-lock-face 'font-lock-comment-face)))))))) - -(defun cider-repl-clear-banners () - "Delete the REPL banners." - (interactive) - ;; TODO: Improve the boundaries detecting logic - ;; probably it should be based on text properties - ;; the current implemetation will clear warnings as well - (let ((start (point-min)) - (end (save-excursion - (goto-char (point-min)) - (cider-repl-next-prompt) - (forward-line -1) - (end-of-line) - (point)))) - (when (< start end) - (let ((inhibit-read-only t)) - (cider-repl--clear-region start (1+ end)))))) - -(defun cider-repl-clear-help-banner () - "Delete the help REPL banner." - (interactive) - ;; TODO: Improve the boundaries detecting logic - ;; probably it should be based on text properties - (let ((start (save-excursion - (goto-char (point-min)) - (search-forward ";; =") - (beginning-of-line) - (point))) - (end (save-excursion - (goto-char (point-min)) - (cider-repl-next-prompt) - (search-backward ";; =") - (end-of-line) - (point)))) - (when (< start end) - (let ((inhibit-read-only t)) - (cider-repl--clear-region start (1+ end)))))) - -(defun cider-repl-switch-ns-handler (buffer) - "Make an nREPL evaluation handler for the REPL BUFFER's ns switching." - (nrepl-make-response-handler buffer - (lambda (_buffer _value)) - (lambda (buffer out) - (cider-repl-emit-stdout buffer out)) - (lambda (buffer err) - (cider-repl-emit-stderr buffer err)) - (lambda (buffer) - (cider-repl-emit-prompt buffer)))) - -(defun cider-repl-set-ns (ns) - "Switch the namespace of the REPL buffer to NS. - -If 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." - (interactive (list (if (or (derived-mode-p 'cider-repl-mode) - (null (cider-ns-form))) - (completing-read "Switch to namespace: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (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)) - - -;;;;; History - -(defcustom cider-repl-wrap-history nil - "T to wrap history around when the end is reached." - :type 'boolean - :group 'cider-repl) - -;; These two vars contain the state of the last history search. We -;; only use them if `last-command' was `cider-repl--history-replace', -;; otherwise we reinitialize them. - -(defvar cider-repl-input-history-position -1 - "Newer items have smaller indices.") - -(defvar cider-repl-history-pattern nil - "The regexp most recently used for finding input history.") - -(defun cider-repl--add-to-input-history (string) - "Add STRING to the input history. -Empty strings and duplicates are ignored." - (unless (or (equal string "") - (equal string (car cider-repl-input-history))) - (push string cider-repl-input-history) - (cl-incf cider-repl-input-history-items-added))) - -(defun cider-repl-delete-current-input () - "Delete all text after the prompt." - (goto-char (point-max)) - (delete-region cider-repl-input-start-mark (point-max))) - -(defun cider-repl--replace-input (string) - "Replace the current REPL input with STRING." - (cider-repl-delete-current-input) - (insert-and-inherit string)) - -(defun cider-repl--position-in-history (start-pos direction regexp) - "Return the position of the history item starting at START-POS. -Search in DIRECTION for REGEXP. -Return -1 resp the length of the history if no item matches." - ;; Loop through the history list looking for a matching line - (let* ((step (cl-ecase direction - (forward -1) - (backward 1))) - (history cider-repl-input-history) - (len (length history))) - (cl-loop for pos = (+ start-pos step) then (+ pos step) - if (< pos 0) return -1 - if (<= len pos) return len - if (string-match-p regexp (nth pos history)) return pos))) - -(defun cider-repl--history-replace (direction &optional regexp) - "Replace the current input with the next line in DIRECTION. -DIRECTION is 'forward' or 'backward' (in the history list). -If REGEXP is non-nil, only lines matching REGEXP are considered." - (setq cider-repl-history-pattern regexp) - (let* ((min-pos -1) - (max-pos (length cider-repl-input-history)) - (pos0 (cond ((cider-history-search-in-progress-p) - cider-repl-input-history-position) - (t min-pos))) - (pos (cider-repl--position-in-history pos0 direction (or regexp ""))) - (msg nil)) - (cond ((and (< min-pos pos) (< pos max-pos)) - (cider-repl--replace-input (nth pos cider-repl-input-history)) - (setq msg (format "History item: %d" pos))) - ((not cider-repl-wrap-history) - (setq msg (cond ((= pos min-pos) "End of history") - ((= pos max-pos) "Beginning of history")))) - (cider-repl-wrap-history - (setq pos (if (= pos min-pos) max-pos min-pos)) - (setq msg "Wrapped history"))) - (when (or (<= pos min-pos) (<= max-pos pos)) - (when regexp - (setq msg (concat msg "; no matching item")))) - (message "%s%s" msg (cond ((not regexp) "") - (t (format "; current regexp: %s" regexp)))) - (setq cider-repl-input-history-position pos) - (setq this-command 'cider-repl--history-replace))) - -(defun cider-history-search-in-progress-p () - "Return t if a current history search is in progress." - (eq last-command 'cider-repl--history-replace)) - -(defun cider-terminate-history-search () - "Terminate the current history search." - (setq last-command this-command)) - -(defun cider-repl-previous-input () - "Cycle backwards through input history. -If the `last-command' was a history navigation command use the -same search pattern for this command. -Otherwise use the current input as search pattern." - (interactive) - (cider-repl--history-replace 'backward (cider-repl-history-pattern t))) - -(defun cider-repl-next-input () - "Cycle forwards through input history. -See `cider-previous-input'." - (interactive) - (cider-repl--history-replace 'forward (cider-repl-history-pattern t))) - -(defun cider-repl-forward-input () - "Cycle forwards through input history." - (interactive) - (cider-repl--history-replace 'forward (cider-repl-history-pattern))) - -(defun cider-repl-backward-input () - "Cycle backwards through input history." - (interactive) - (cider-repl--history-replace 'backward (cider-repl-history-pattern))) - -(defun cider-repl-previous-matching-input (regexp) - "Find the previous input matching REGEXP." - (interactive "sPrevious element matching (regexp): ") - (cider-terminate-history-search) - (cider-repl--history-replace 'backward regexp)) - -(defun cider-repl-next-matching-input (regexp) - "Find then next input matching REGEXP." - (interactive "sNext element matching (regexp): ") - (cider-terminate-history-search) - (cider-repl--history-replace 'forward regexp)) - -(defun cider-repl-history-pattern (&optional use-current-input) - "Return the regexp for the navigation commands. -If USE-CURRENT-INPUT is non-nil, use the current input." - (cond ((cider-history-search-in-progress-p) - cider-repl-history-pattern) - (use-current-input - (cl-assert (<= cider-repl-input-start-mark (point))) - (let ((str (cider-repl--current-input t))) - (cond ((string-match-p "^[ \n]*$" str) nil) - (t (concat "^" (regexp-quote str)))))) - (t nil))) - -;;; persistent history -(defcustom cider-repl-history-size 500 - "The maximum number of items to keep in the REPL history." - :type 'integer - :safe 'integerp - :group 'cider-repl) - -(defcustom cider-repl-history-file nil - "File to save the persistent REPL history to." - :type 'string - :safe 'stringp - :group 'cider-repl) - -(defun cider-repl--history-read-filename () - "Ask the user which file to use, defaulting `cider-repl-history-file'." - (read-file-name "Use CIDER REPL history file: " - cider-repl-history-file)) - -(defun cider-repl--history-read (filename) - "Read history from FILENAME and return it. -It does not yet set the input history." - (if (file-readable-p filename) - (with-temp-buffer - (insert-file-contents filename) - (when (> (buffer-size (current-buffer)) 0) - (read (current-buffer)))) - '())) - -(defun cider-repl-history-load (&optional filename) - "Load history from FILENAME into current session. -FILENAME defaults to the value of `cider-repl-history-file' but user -defined filenames can be used to read special history files. - -The value of `cider-repl-input-history' is set by this function." - (interactive (list (cider-repl--history-read-filename))) - (let ((f (or filename cider-repl-history-file))) - ;; TODO: probably need to set cider-repl-input-history-position as well. - ;; in a fresh connection the newest item in the list is currently - ;; not available. After sending one input, everything seems to work. - (setq cider-repl-input-history (cider-repl--history-read f)))) - -(defun cider-repl--history-write (filename) - "Write history to FILENAME. -Currently coding system for writing the contents is hardwired to -utf-8-unix." - (let* ((mhist (cider-repl--histories-merge cider-repl-input-history - cider-repl-input-history-items-added - (cider-repl--history-read filename))) - ;; newest items are at the beginning of the list, thus 0 - (hist (cl-subseq mhist 0 (min (length mhist) cider-repl-history-size)))) - (unless (file-writable-p filename) - (error (format "History file not writable: %s" filename))) - (let ((print-length nil) (print-level nil)) - (with-temp-file filename - ;; TODO: really set cs for output - ;; TODO: does cs need to be customizable? - (insert ";; -*- coding: utf-8-unix -*-\n") - (insert ";; Automatically written history of CIDER REPL session\n") - (insert ";; Edit at your own risk\n\n") - (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))) - -(defun cider-repl-history-save (&optional filename) - "Save the current REPL input history to FILENAME. -FILENAME defaults to the value of `cider-repl-history-file'." - (interactive (list (cider-repl--history-read-filename))) - (let* ((file (or filename cider-repl-history-file))) - (cider-repl--history-write file))) - -(defun cider-repl-history-just-save () - "Just save the history to `cider-repl-history-file'. -This function is meant to be used in hooks to avoid lambda -constructs." - (cider-repl-history-save cider-repl-history-file)) - -;; SLIME has different semantics and will not save any duplicates. -;; we keep track of how many items were added to the history in the -;; current session in `cider-repl--add-to-input-history' and merge only the -;; new items with the current history found in the file, which may -;; have been changed in the meantime by another session. -(defun cider-repl--histories-merge (session-hist n-added-items file-hist) - "Merge histories from SESSION-HIST adding N-ADDED-ITEMS into FILE-HIST." - (append (cl-subseq session-hist 0 n-added-items) - file-hist)) - - -;;; REPL shortcuts -(defcustom cider-repl-shortcut-dispatch-char ?\, - "Character used to distinguish REPL commands from Lisp forms." - :type '(character) - :group 'cider-repl) - -(defvar cider-repl-shortcuts (make-hash-table :test 'equal)) - -(defun cider-repl-add-shortcut (name handler) - "Add a REPL shortcut command, defined by NAME and HANDLER." - (puthash name handler cider-repl-shortcuts)) - -(declare-function cider-restart "cider-interaction") -(declare-function cider-quit "cider-interaction") -(declare-function cider-toggle-trace-ns "cider-interaction") -(declare-function cider-undef "cider-interaction") -(declare-function cider-browse-ns "cider-browse-ns") -(declare-function cider-classpath "cider-classpath") -(declare-function cider-run "cider-interaction") -(declare-function cider-refresh "cider-interaction") -(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 "classpath" #'cider-classpath) -(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 "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-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 "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) - -(defconst cider-repl-shortcuts-help-buffer "*CIDER REPL Shortcuts Help*") - -(defun cider-repl-shortcuts-help () - "Display a help buffer." - (interactive) - (ignore-errors (kill-buffer cider-repl-shortcuts-help-buffer)) - (with-current-buffer (get-buffer-create cider-repl-shortcuts-help-buffer) - (insert "CIDER REPL shortcuts:\n\n") - (maphash (lambda (k v) (insert (format "%s:\n\t%s\n" k v))) cider-repl-shortcuts) - (goto-char (point-min)) - (help-mode) - (display-buffer (current-buffer) t)) - (cider-repl-handle-shortcut) - (current-buffer)) - -(defun cider-repl--available-shortcuts () - "Return the available REPL shortcuts." - (cider-util--hash-keys cider-repl-shortcuts)) - -(defun cider-repl-handle-shortcut () - "Execute a REPL shortcut." - (interactive) - (if (> (point) cider-repl-input-start-mark) - (insert (string cider-repl-shortcut-dispatch-char)) - (let ((command (completing-read "Command: " - (cider-repl--available-shortcuts)))) - (if (not (equal command "")) - (let ((command-func (gethash command cider-repl-shortcuts))) - (if command-func - (call-interactively (gethash command cider-repl-shortcuts)) - (error "Unknown command %S. Available commands: %s" - command-func - (mapconcat 'identity (cider-repl--available-shortcuts) ", ")))) - (error "No command selected"))))) - - -;;;;; CIDER REPL mode -(defvar cider-repl-mode-hook nil - "Hook executed when entering `cider-repl-mode'.") - -(defvar cider-repl-mode-syntax-table - (copy-syntax-table clojure-mode-syntax-table)) - -(declare-function cider-eval-region "cider-interaction") -(declare-function cider-eval-last-sexp "cider-interaction") -(declare-function cider-refresh "cider-interaction") -(declare-function cider-toggle-trace-ns "cider-interaction") -(declare-function cider-toggle-trace-var "cider-interaction") -(declare-function cider-find-resource "cider-interaction") -(declare-function cider-restart "cider-interaction") -(declare-function cider-find-ns "cider-interaction") -(declare-function cider-switch-to-last-clojure-buffer "cider-mode") - -(defvar cider-repl-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-d") 'cider-doc-map) - (define-key map (kbd "C-c ,") 'cider-test-commands-map) - (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 "M-,") #'cider-pop-back) - (define-key map (kbd "C-c M-.") #'cider-find-resource) - (define-key map (kbd "RET") #'cider-repl-return) - (define-key map (kbd "TAB") #'cider-repl-tab) - (define-key map (kbd "C-") #'cider-repl-closing-return) - (define-key map (kbd "C-j") #'cider-repl-newline-and-indent) - (define-key map (kbd "C-c C-o") #'cider-repl-clear-output) - (define-key map (kbd "C-c M-n") #'cider-repl-set-ns) - (define-key map (kbd "C-c C-u") #'cider-repl-kill-input) - (define-key map (kbd "C-S-a") #'cider-repl-bol-mark) - (define-key map [S-home] #'cider-repl-bol-mark) - (define-key map (kbd "C-") #'cider-repl-backward-input) - (define-key map (kbd "C-") #'cider-repl-forward-input) - (define-key map (kbd "M-p") #'cider-repl-previous-input) - (define-key map (kbd "M-n") #'cider-repl-next-input) - (define-key map (kbd "M-r") #'cider-repl-previous-matching-input) - (define-key map (kbd "M-s") #'cider-repl-next-matching-input) - (define-key map (kbd "C-c C-n") #'cider-repl-next-prompt) - (define-key map (kbd "C-c C-p") #'cider-repl-previous-prompt) - (define-key map (kbd "C-c C-b") #'cider-interrupt) - (define-key map (kbd "C-c C-c") #'cider-interrupt) - (define-key map (kbd "C-c C-m") #'cider-macroexpand-1) - (define-key map (kbd "C-c M-m") #'cider-macroexpand-all) - (define-key map (kbd "C-c C-z") #'cider-switch-to-last-clojure-buffer) - (define-key map (kbd "C-c M-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 C-q") #'cider-quit) - (define-key map (kbd "C-c M-i") #'cider-inspect) - (define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var) - (define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns) - (define-key map (kbd "C-c C-x") #'cider-refresh) - (define-key map (kbd "C-x C-e") #'cider-eval-last-sexp) - (define-key map (kbd "C-c C-r") #'cider-eval-region) - (define-key map (string cider-repl-shortcut-dispatch-char) #'cider-repl-handle-shortcut) - (easy-menu-define cider-repl-mode-menu map - "Menu for CIDER's REPL mode" - `("REPL" - ["Complete symbol" complete-symbol] - "--" - ,cider-doc-menu - "--" - ("Find" - ["Find definition" cider-find-var] - ["Find resource" cider-find-resource] - ["Go back" cider-pop-back]) - "--" - ["Switch to Clojure buffer" cider-switch-to-last-clojure-buffer] - ["Switch to other REPL" cider-repl-switch-to-other] - "--" - ("Macroexpand" - ["Macroexpand-1" cider-macroexpand-1] - ["Macroexpand-all" cider-macroexpand-all]) - "--" - ,cider-test-menu - "--" - ["Run project (-main function)" cider-run] - ["Inspect" cider-inspect] - ["Toggle var tracing" cider-toggle-trace-var] - ["Toggle ns tracing" cider-toggle-trace-ns] - ["Refresh loaded code" cider-refresh] - "--" - ["Set REPL ns" cider-repl-set-ns] - ["Toggle pretty printing" cider-repl-toggle-pretty-printing] - "--" - ["Browse classpath" cider-classpath] - ["Browse classpath entry" cider-open-classpath-entry] - ["Browse namespace" cider-browse-ns] - ["Browse all namespaces" cider-browse-ns-all] - "--" - ["Next prompt" cider-repl-next-prompt] - ["Previous prompt" cider-repl-previous-prompt] - ["Clear output" cider-repl-clear-output] - ["Clear buffer" cider-repl-clear-buffer] - ["Clear banners" cider-repl-clear-banners] - ["Clear help banner" cider-repl-clear-help-banner] - ["Kill input" cider-repl-kill-input] - "--" - ["Interrupt evaluation" cider-interrupt] - "--" - ["Connection info" cider-display-connection-info] - "--" - ["Close ancillary buffers" cider-close-ancillary-buffers] - ["Quit" cider-quit] - ["Restart" cider-restart] - "--" - ["A sip of CIDER" cider-drink-a-sip] - ["View manual online" cider-view-manual] - ["View refcard online" cider-view-refcard] - ["Report a bug" cider-report-bug] - ["Version info" cider-version])) - map)) - -(defun cider-repl-wrap-fontify-function (func) - "Return a function that will call FUNC narrowed to input region." - (lambda (beg end &rest rest) - (when (and cider-repl-input-start-mark - (> end cider-repl-input-start-mark)) - (save-restriction - (narrow-to-region cider-repl-input-start-mark (point-max)) - (let ((font-lock-dont-widen t)) - (apply func (max beg cider-repl-input-start-mark) end rest)))))) - -(declare-function cider-complete-at-point "cider-interaction") -(defvar cider--static-font-lock-keywords) - -(define-derived-mode cider-repl-mode fundamental-mode "REPL" - "Major mode for Clojure REPL interactions. - -\\{cider-repl-mode-map}" - (clojure-mode-variables) - (setq-local lisp-indent-function #'clojure-indent-function) - (setq-local indent-line-function #'lisp-indent-line) - (clojure-font-lock-setup) - (font-lock-add-keywords nil cider--static-font-lock-keywords) - (setq-local font-lock-fontify-region-function - (cider-repl-wrap-fontify-function font-lock-fontify-region-function)) - (setq-local font-lock-unfontify-region-function - (cider-repl-wrap-fontify-function font-lock-unfontify-region-function)) - (make-local-variable 'completion-at-point-functions) - (add-to-list 'completion-at-point-functions - #'cider-complete-at-point) - (set-syntax-table cider-repl-mode-syntax-table) - (cider-eldoc-setup) - ;; At the REPL, we define beginning-of-defun and end-of-defun to be - ;; the start of the previous prompt or next prompt respectively. - ;; Notice the interplay with `cider-repl-beginning-of-defun'. - (setq-local beginning-of-defun-function #'cider-repl-mode-beginning-of-defun) - (setq-local end-of-defun-function #'cider-repl-mode-end-of-defun) - (setq-local prettify-symbols-alist clojure--prettify-symbols-alist) - ;; apply dir-local variables to REPL buffers - (hack-dir-local-variables-non-file-buffer) - (when cider-repl-history-file - (cider-repl-history-load cider-repl-history-file) - (add-hook 'kill-buffer-hook #'cider-repl-history-just-save t t) - (add-hook 'kill-emacs-hook #'cider-repl-history-just-save)) - (add-hook 'paredit-mode-hook (lambda () (clojure-paredit-setup cider-repl-mode-map)))) - -(provide 'cider-repl) - -;;; cider-repl.el ends here diff --git a/elpa/cider-20160927.2135/cider-resolve.el b/elpa/cider-20160927.2135/cider-resolve.el deleted file mode 100644 index b8094a9..0000000 --- a/elpa/cider-20160927.2135/cider-resolve.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection - -;; Copyright © 2015-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: 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 . - -;;; Commentary: - -;; The ns cache is a dict of namespaces stored in the connection buffer. This -;; file offers functions to easily get information about variables from this -;; cache, given the variable's name and the file's namespace. This -;; functionality is similar to that offered by the `cider-var-info' function -;; (and others). The difference is that all functions in this file operate -;; without contacting the server (they still rely on an active connection -;; buffer, but no messages are actually exchanged). - -;; For this reason, the functions here are well suited for very -;; performance-sentitive operations, such as font-locking or -;; indentation. Meanwhile, operations like code-jumping are better off -;; communicating with the middleware, just in the off chance that the cache is -;; outdated. - -;; Below is a typical entry on this cache dict. Note that clojure.core symbols -;; are excluded from the refers to save space. - -;; "cider.nrepl.middleware.track-state" -;; (dict "aliases" -;; (dict "cljs" "cider.nrepl.middleware.util.cljs" -;; "misc" "cider.nrepl.middleware.util.misc" -;; "set" "clojure.set") -;; "interns" (dict a -;; "assoc-state" (dict "arglists" -;; (("response" -;; (dict "as" "msg" "keys" -;; ("session"))))) -;; "filter-core" (dict "arglists" -;; (("refers"))) -;; "make-transport" (dict "arglists" -;; (((dict "as" "msg" "keys" -;; ("transport"))))) -;; "ns-as-map" (dict "arglists" -;; (("ns"))) -;; "ns-cache" (dict) -;; "relevant-meta" (dict "arglists" -;; (("var"))) -;; "update-vals" (dict "arglists" -;; (("m" "f"))) -;; "wrap-tracker" (dict "arglists" -;; (("handler")))) -;; "refers" (dict "set-descriptor!" "#'clojure.tools.nrepl.middleware/set-descriptor!")) - -;;; Code: - -(require 'cider-client) -(require 'nrepl-dict) -(require 'cider-util) - -(defvar cider-repl-ns-cache) - -(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) - (nrepl-dict-get-in cider-repl-ns-cache keys)))) - -(defun cider-resolve-alias (ns alias) - "Return the namespace that ALIAS refers to in namespace NS. -If it doesn't point anywhere, returns ALIAS." - (or (cider-resolve--get-in ns "aliases" alias) - alias)) - -(defconst cider-resolve--prefix-regexp "\\`\\(?:#'\\)?\\([^/]+\\)/") - -(defun cider-resolve-var (ns var) - "Return a dict of the metadata of a clojure var VAR in namespace NS. -VAR is a string. -Return nil only if VAR cannot be resolved." - (let* ((var-ns (when (string-match cider-resolve--prefix-regexp var) - (cider-resolve-alias ns (match-string 1 var)))) - (name (replace-regexp-in-string cider-resolve--prefix-regexp "" var))) - (or - (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))) - (cider-resolve-var ns referal) - ;; Or it might be from core. - (unless (equal ns "clojure.core") - (cider-resolve-var "clojure.core" name))))))) - -(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) - (cider-resolve--get-in (if (equal cider-repl-type "cljs") - "cljs.core" - "clojure.core"))))) - -(defun cider-resolve-ns-symbols (ns) - "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))) - (nrepl-dbind-response dict (interns refers aliases) - (append (cdr interns) - (nrepl-dict-flat-map (lambda (alias namespace) - (nrepl-dict-flat-map (lambda (sym meta) - (list (concat alias "/" sym) meta)) - (cider-resolve--get-in namespace "interns"))) - aliases))))) - -(provide 'cider-resolve) -;;; cider-resolve.el ends here diff --git a/elpa/cider-20160927.2135/cider-scratch.el b/elpa/cider-20160927.2135/cider-scratch.el deleted file mode 100644 index e794afd..0000000 --- a/elpa/cider-20160927.2135/cider-scratch.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014-2016 Bozhidar Batsov 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: - -;; Imitate Emacs's *scratch* buffer. - -;;; Code: - -(require 'cider-interaction) -(require 'clojure-mode) - -(defvar cider-clojure-interaction-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map clojure-mode-map) - (define-key map (kbd "C-j") #'cider-eval-print-last-sexp) - (define-key map [remap paredit-newline] #'cider-eval-print-last-sexp) - 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))) - -(defun cider-find-or-create-scratch-buffer () - "Find or create the scratch buffer." - (or (get-buffer cider-scratch-buffer-name) - (cider-create-scratch-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}") - -(defun cider-create-scratch-buffer () - "Create a new scratch buffer." - (with-current-buffer (get-buffer-create cider-scratch-buffer-name) - (cider-clojure-interaction-mode) - (insert ";; This buffer is for Clojure experiments and evaluation.\n" - ";; Press C-j to evaluate the last expression.\n\n") - (current-buffer))) - -(provide 'cider-scratch) - -;;; cider-scratch.el ends here diff --git a/elpa/cider-20160927.2135/cider-selector.el b/elpa/cider-20160927.2135/cider-selector.el deleted file mode 100644 index 9b771d6..0000000 --- a/elpa/cider-20160927.2135/cider-selector.el +++ /dev/null @@ -1,167 +0,0 @@ -;;; 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-2016 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: - -;; Buffer selection command inspired by SLIME's selector. - -;;; Code: - -(require 'cider-client) -(require 'cider-interaction) -(require 'cider-scratch) - -(defconst cider-selector-help-buffer "*CIDER Selector Help*" - "The name of the selector's help buffer.") - -(defvar cider-selector-methods nil - "List of buffer-selection methods for the `cider-selector' command. -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'.") - -(defun cider--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) - when (and (with-current-buffer buffer - (derived-mode-p mode)) - ;; names starting with space are considered hidden by Emacs - (not (string-match-p "^ " (buffer-name buffer))) - (null (get-buffer-window buffer 'visible))) - return buffer - finally (error "Can't find unshown buffer in %S" mode))) - -;;;###autoload -(defun cider-selector (&optional other-window) - "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." - (interactive) - (message "Select [%s]: " - (apply #'string (mapcar #'car cider-selector-methods))) - (let* ((cider-selector-other-window other-window) - (ch (save-window-excursion - (select-window (minibuffer-window)) - (read-char))) - (method (cl-find ch cider-selector-methods :key #'car))) - (cond (method - (funcall (cl-caddr method))) - (t - (message "No method for character: ?\\%c" ch) - (ding) - (sleep-for 1) - (discard-input) - (cider-selector))))) - -(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 -selects a buffer. - -BODY is a series of forms which are evaluated when the selector -is chosen. The returned buffer is selected with -`switch-to-buffer'." - (let ((method `(lambda () - (let ((buffer (progn ,@body))) - (cond ((not (get-buffer buffer)) - (message "No such buffer: %S" buffer) - (ding)) - ((get-buffer-window buffer) - (select-window (get-buffer-window buffer))) - (cider-selector-other-window - (switch-to-buffer-other-window buffer)) - (t - (switch-to-buffer buffer))))))) - `(setq cider-selector-methods - (cl-sort (cons (list ,key ,description ,method) - (cl-remove ,key cider-selector-methods :key #'car)) - #'< :key #'car)))) - -(def-cider-selector-method ?? "Selector help buffer." - (ignore-errors (kill-buffer cider-selector-help-buffer)) - (with-current-buffer (get-buffer-create cider-selector-help-buffer) - (insert "CIDER Selector Methods:\n\n") - (cl-loop for (key line nil) in cider-selector-methods - do (insert (format "%c:\t%s\n" key line))) - (goto-char (point-min)) - (help-mode) - (display-buffer (current-buffer) t)) - (cider-selector) - (current-buffer)) - -(cl-pushnew (list ?4 "Select in other window" (lambda () (cider-selector t))) - cider-selector-methods :key #'car) - -(def-cider-selector-method ?c - "Most recently visited clojure-mode buffer." - (cider--recently-visited-buffer 'clojure-mode)) - -(def-cider-selector-method ?e - "Most recently visited emacs-lisp-mode buffer." - (cider--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) - -(def-cider-selector-method ?m - "Current connection's *nrepl-messages* buffer." - (cider-current-messages-buffer)) - -(def-cider-selector-method ?x - "*cider-error* buffer." - cider-error-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)) - -(provide 'cider-selector) - -;;; cider-selector.el ends here diff --git a/elpa/cider-20160927.2135/cider-stacktrace.el b/elpa/cider-20160927.2135/cider-stacktrace.el deleted file mode 100644 index 3d31243..0000000 --- a/elpa/cider-20160927.2135/cider-stacktrace.el +++ /dev/null @@ -1,716 +0,0 @@ -;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*- - -;; Copyright © 2014-2016 Jeff Valk, Bozhidar Batsov and CIDER contributors - -;; Author: Jeff Valk - -;; 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: - -;; Stacktrace filtering and stack frame source navigation - -;;; Code: - -(require 'cl-lib) -(require 'cider-popup) -(require 'button) -(require 'easymenu) -(require 'cider-common) -(require 'cider-compat) -(require 'cider-client) -(require 'cider-util) - -(require 'seq) - -;; Variables - -(defgroup cider-stacktrace nil - "Stacktrace filtering and navigation." - :prefix "cider-stacktrace-" - :group 'cider) - -(defcustom cider-stacktrace-fill-column t - "Fill column for error messages in stacktrace display. -If nil, messages will not be wrapped. If truthy but non-numeric, -`fill-column' will be used." - :type 'list - :group 'cider-stacktrace - :package-version '(cider . "0.7.0")) - -(defcustom cider-stacktrace-default-filters '(tooling dup) - "Frame types to omit from initial stacktrace display." - :type 'list - :group 'cider-stacktrace - :package-version '(cider . "0.6.0")) - -(defcustom cider-stacktrace-print-length 50 - "Set the maximum length of sequences in displayed cause data. - -This sets the value of Clojure's `*print-length*` when pretty printing the -`ex-data` map for exception causes in the stacktrace that are instances of -`IExceptionInfo`. - -Be advised that setting this to `nil` will cause the attempted printing of -infinite data structures." - :type '(choice integer (const nil)) - :group 'cider-stacktrace - :package-version '(cider . "0.9.0")) - -(defcustom cider-stacktrace-print-level 50 - "Set the maximum level of nesting in displayed cause data. - -This sets the value of Clojure's `*print-level*` when pretty printing the -`ex-data` map for exception causes in the stacktrace that are instances of -`IExceptionInfo`. - -Be advised that setting this to `nil` will cause the attempted printing of -cyclical data structures." - :type '(choice integer (const nil)) - :group 'cider-stacktrace - :package-version '(cider . "0.8.0")) - -(defvar cider-stacktrace-detail-max 2 - "The maximum detail level for causes.") - -(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) - -(defconst cider-error-buffer "*cider-error*") -(add-to-list 'cider-ancillary-buffers cider-error-buffer) - -(defcustom cider-stacktrace-suppressed-errors '() - "A set of 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 - :package-version '(cider . "0.12.0")) - -;; Faces - -(defface cider-stacktrace-error-class-face - '((t (:inherit font-lock-warning-face))) - "Face for exception class names" - :group 'cider-stacktrace - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-error-message-face - '((t (:inherit font-lock-doc-face))) - "Face for exception messages" - :group 'cider-stacktrace - :package-version '(cider . "0.7.0")) - -(defface cider-stacktrace-filter-shown-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 - '((t (:inherit button :underline nil :weight normal))) - "Face for filter buttons representing frames currently filtered out" - :group 'cider-stacktrace - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-face - '((t (:inherit default))) - "Face for stack frame text" - :group 'cider-stacktrace - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-ns-face - '((t (:inherit font-lock-comment-face))) - "Face for stack frame namespace name" - :group 'cider-stacktrace - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-fn-face - '((t (:inherit default :weight bold))) - "Face for stack frame function name" - :group 'cider-stacktrace - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-promoted-button-face - '((((type graphic)) - :box (:line-width 3 :style released-button) - :inherit error) - (t :inverse-video t)) - "A button with this face represents a promoted (non-suppressed) error type." - :group 'cider-stacktrace - :package-version '(cider . "0.12.0")) - -(defface cider-stacktrace-suppressed-button-face - '((((type graphic)) - :box (:line-width 3 :style pressed-button) - :inherit widget-inactive-face) - (t :inverse-video t)) - "A button with this face represents a suppressed error type." - :group 'cider-stacktrace - :package-version '(cider . "0.12.0")) - -;; Colors & Theme Support - -(defvar cider-stacktrace-frames-background-color - (cider-scale-background-color) - "Background color for stacktrace frames.") - -(defadvice enable-theme (after cider-stacktrace-adapt-to-theme activate) - "When theme is changed, update `cider-stacktrace-frames-background-color'." - (setq cider-stacktrace-frames-background-color (cider-scale-background-color))) - - -;; Mode & key bindings - -(defvar cider-stacktrace-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-p") #'cider-stacktrace-previous-cause) - (define-key map (kbd "M-n") #'cider-stacktrace-next-cause) - (define-key map (kbd "M-.") #'cider-stacktrace-jump) - (define-key map "q" #'cider-popup-buffer-quit-function) - (define-key map "j" #'cider-stacktrace-toggle-java) - (define-key map "c" #'cider-stacktrace-toggle-clj) - (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 "a" #'cider-stacktrace-toggle-all) - (define-key map "1" #'cider-stacktrace-cycle-cause-1) - (define-key map "2" #'cider-stacktrace-cycle-cause-2) - (define-key map "3" #'cider-stacktrace-cycle-cause-3) - (define-key map "4" #'cider-stacktrace-cycle-cause-4) - (define-key map "5" #'cider-stacktrace-cycle-cause-5) - (define-key map "0" #'cider-stacktrace-cycle-all-causes) - (define-key map [tab] #'cider-stacktrace-cycle-current-cause) - (define-key map [backtab] #'cider-stacktrace-cycle-all-causes) - (easy-menu-define cider-stacktrace-mode-menu map - "Menu for CIDER's stacktrace mode" - '("Stacktrace" - ["Previous cause" cider-stacktrace-previous-cause] - ["Next cause" cider-stacktrace-next-cause] - "--" - ["Jump to frame source" cider-stacktrace-jump] - "--" - ["Cycle current cause detail" cider-stacktrace-cycle-current-cause] - ["Cycle cause #1 detail" cider-stacktrace-cycle-cause-1] - ["Cycle cause #2 detail" cider-stacktrace-cycle-cause-2] - ["Cycle cause #3 detail" cider-stacktrace-cycle-cause-3] - ["Cycle cause #4 detail" cider-stacktrace-cycle-cause-4] - ["Cycle cause #5 detail" cider-stacktrace-cycle-cause-5] - ["Cycle all cause detail" cider-stacktrace-cycle-all-causes] - "--" - ["Show/hide Java frames" cider-stacktrace-toggle-java] - ["Show/hide Clojure frames" cider-stacktrace-toggle-clj] - ["Show/hide REPL frames" cider-stacktrace-toggle-repl] - ["Show/hide tooling frames" cider-stacktrace-toggle-tooling] - ["Show/hide duplicate frames" cider-stacktrace-toggle-duplicates] - ["Show/hide all frames" cider-stacktrace-toggle-all])) - map)) - -(define-derived-mode cider-stacktrace-mode special-mode "Stacktrace" - "Major mode for filtering and navigating CIDER stacktraces. - -\\{cider-stacktrace-mode-map}" - (setq buffer-read-only t) - (setq-local truncate-lines t) - (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))) - - -;; Stacktrace filtering - -(defun cider-stacktrace-indicate-filters (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." - (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)))) - ;; 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)))) - (button-put button 'face face))) - (goto-char (or (next-property-change (point)) - (point-max))))) - ;; Update hidden count - (when (and (get-text-property (point) 'hidden-count) - (re-search-forward "[0-9]+" (line-end-position) t)) - (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." - (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) - (let* ((flags (get-text-property (point) 'flags)) - (hide (if (seq-intersection filters flags) t nil))) - (when hide (cl-incf hidden)) - (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))) - - -(defun cider-stacktrace-apply-cause-visibility () - "Apply `cider-stacktrace-cause-visibility' to causes and reapply filters." - (with-current-buffer cider-error-buffer - (save-excursion - (goto-char (point-min)) - (cl-flet ((next-detail (end) - (when-let ((pos (next-single-property-change (point) 'detail))) - (when (< pos end) - (goto-char pos))))) - (let ((inhibit-read-only t)) - ;; For each cause... - (while (cider-stacktrace-next-cause) - (let* ((num (get-text-property (point) 'cause)) - (level (elt cider-stacktrace-cause-visibility num)) - (cause-end (cadr (cider-property-bounds 'cause)))) - ;; For each detail level within the cause, set visibility. - (while (next-detail cause-end) - (let* ((detail (get-text-property (point) 'detail)) - (detail-end (cadr (cider-property-bounds 'detail))) - (hide (if (> detail level) t nil))) - (add-text-properties (point) detail-end - (list 'invisible hide - 'collapsed hide)))))))) - (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." - (seq-intersection error-types cider-stacktrace-suppressed-errors)) - -(defun cider-stacktrace-suppress-error (error-type) - "Destructively add element ERROR-TYPE to the `cider-stacktrace-suppressed-errors' set." - (setq cider-stacktrace-suppressed-errors - (cl-adjoin error-type cider-stacktrace-suppressed-errors :test 'equal))) - -(defun cider-stacktrace-promote-error (error-type) - "Destructively remove element ERROR-TYPE from the `cider-stacktrace-suppressed-errors' set." - (setq cider-stacktrace-suppressed-errors - (remove error-type cider-stacktrace-suppressed-errors))) - -(defun cider-stacktrace-suppressed-error-p (error-type) - "Return non-nil if element ERROR-TYPE is a member of the `cider-stacktrace-suppressed-errors' set." - (member error-type cider-stacktrace-suppressed-errors)) - -;; Interactive functions - -(defun cider-stacktrace-previous-cause () - "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))) - (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))) - (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." - (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))) - -(defun cider-stacktrace-cycle-all-causes () - "Cycle the visibility of all exception causes." - (interactive) - (with-current-buffer cider-error-buffer - (save-excursion - ;; Find nearest cause. - (unless (get-text-property (point) 'cause) - (cider-stacktrace-next-cause) - (unless (get-text-property (point) 'cause) - (cider-stacktrace-previous-cause))) - ;; Cycle its level, and apply that to all causes. - (let* ((num (get-text-property (point) 'cause)) - (level (1+ (elt cider-stacktrace-cause-visibility num)))) - (setq-local cider-stacktrace-cause-visibility - (make-vector 10 (mod level 3))) - (cider-stacktrace-apply-cause-visibility))))) - -(defun cider-stacktrace-cycle-current-cause () - "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))) - (cider-stacktrace-cycle-cause num)))) - -(defun cider-stacktrace-cycle-cause-1 () - "Cycle the visibility of exception cause #1." - (interactive) - (cider-stacktrace-cycle-cause 1)) - -(defun cider-stacktrace-cycle-cause-2 () - "Cycle the visibility of exception cause #2." - (interactive) - (cider-stacktrace-cycle-cause 2)) - -(defun cider-stacktrace-cycle-cause-3 () - "Cycle the visibility of exception cause #3." - (interactive) - (cider-stacktrace-cycle-cause 3)) - -(defun cider-stacktrace-cycle-cause-4 () - "Cycle the visibility of exception cause #4." - (interactive) - (cider-stacktrace-cycle-cause 4)) - -(defun cider-stacktrace-cycle-cause-5 () - "Cycle the visibility of exception cause #5." - (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 - (setq cider-stacktrace-filters - (if (memq flag cider-stacktrace-filters) - (remq flag cider-stacktrace-filters) - (cons flag cider-stacktrace-filters))))) - -(defun cider-stacktrace-toggle-java () - "Toggle display of Java stack frames." - (interactive) - (cider-stacktrace-toggle 'java)) - -(defun cider-stacktrace-toggle-clj () - "Toggle display of Clojure stack frames." - (interactive) - (cider-stacktrace-toggle 'clj)) - -(defun cider-stacktrace-toggle-repl () - "Toggle display of REPL stack frames." - (interactive) - (cider-stacktrace-toggle 'repl)) - -(defun cider-stacktrace-toggle-tooling () - "Toggle display of Tooling stack frames (compiler, nREPL middleware, etc)." - (interactive) - (cider-stacktrace-toggle 'tooling)) - -(defun cider-stacktrace-toggle-duplicates () - "Toggle display of stack frames that are duplicates of their descendents." - (interactive) - (cider-stacktrace-toggle 'dup)) - -;; Text button functions - -(defun cider-stacktrace-filter (button) - "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))) - (sit-for 5))) - -(defun cider-stacktrace-toggle-suppression (button) - "Toggle stacktrace pop-over/pop-under behavior for the `error-type' in BUTTON. -Achieved by destructively manipulating the `cider-stacktrace-suppressed-errors' set." - (with-current-buffer cider-error-buffer - (let ((inhibit-read-only t) - (suppressed (button-get button 'suppressed)) - (error-type (button-get button 'error-type))) - (if suppressed - (progn - (cider-stacktrace-promote-error error-type) - (button-put button 'face 'cider-stacktrace-promoted-button-face) - (button-put button 'help-echo "Click to suppress these stacktraces.")) - (cider-stacktrace-suppress-error error-type) - (button-put button 'face 'cider-stacktrace-suppressed-button-face) - (button-put button 'help-echo "Click to promote these stacktraces.")) - (button-put button 'suppressed (not suppressed))))) - -(defun cider-stacktrace-navigate (button) - "Navigate to the stack frame source represented by the BUTTON." - (let* ((var (button-get button 'var)) - (class (button-get button 'class)) - (method (button-get button 'method)) - (info (or (and var (cider-var-info var)) - (and class method (cider-member-info class method)) - (nrepl-dict))) - ;; Stacktrace returns more accurate line numbers, but if the function's - ;; line was unreliable, then so is the stacktrace by the same amount. - ;; 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))) - ;; 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))))) - (cider--jump-to-loc-from-info info t) - (forward-line line-shift) - (back-to-indentation))) - -(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 -prompt and whether to use a new window. Similar to `cider-find-var'." - (interactive "P") - (let ((button (button-at (point)))) - (if (and button (button-get button 'line)) - (cider-stacktrace-navigate button) - (cider-find-var arg)))) - - -;; Rendering - -(defun cider-stacktrace-emit-indented (text indent &optional fill) - "Insert TEXT, and INDENT and optionally FILL the entire block." - (let ((beg (point))) - (insert text) - (goto-char beg) - (while (not (eobp)) - (insert indent) - (forward-line)) - (when (and fill cider-stacktrace-fill-column) - (when (and (numberp cider-stacktrace-fill-column)) - (setq-local fill-column cider-stacktrace-fill-column)) - (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." - (with-current-buffer buffer - (insert " Show: ") - (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))) - (insert " ")) - (let ((hidden "(0 frames hidden)")) - (put-text-property 0 (length hidden) 'hidden-count t hidden) - (insert " " hidden "\n")))) - -(defun cider-stacktrace-render-suppression-toggle (buffer error-types) - "Emit into BUFFER toggle buttons for each of the ERROR-TYPES leading this stacktrace buffer." - (with-current-buffer buffer - (when error-types - (insert " This is an unexpected CIDER middleware error.\n Please submit a bug report via `") - (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.") - (insert "`.\n\n") - (insert "\ - If these stacktraces are occuring frequently, consider using the - button(s) below to suppress these types of errors for the duration of - your current CIDER session. The stacktrace buffer will still be - generated, but it will \"pop under\" your current buffer instead of - \"popping over\". The button toggles this behavior.\n\n ") - (dolist (error-type error-types) - (let ((suppressed (cider-stacktrace-suppressed-error-p error-type))) - (insert-text-button (format "%s %s" (if suppressed "Promote" "Suppress") error-type) - 'follow-link t - 'error-type error-type - 'action 'cider-stacktrace-toggle-suppression - 'suppressed suppressed - '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")))) - (insert " "))))) - -(defun cider-stacktrace-render-frame (buffer frame) - "Emit into BUFFER function call site info for the stack FRAME. -This associates text properties to enable filtering and source navigation." - (with-current-buffer buffer - (nrepl-dbind-response frame (file line flags class method name var ns fn) - (let ((flags (mapcar 'intern flags))) ; strings -> symbols - (insert-text-button (format "%26s:%5d %s/%s" - (if (member 'repl flags) "REPL" file) line - (if (member 'clj flags) ns class) - (if (member 'clj flags) fn method)) - 'var var 'class class 'method method - 'name name 'file file 'line line - 'flags flags 'follow-link t - 'action 'cider-stacktrace-navigate - 'help-echo "View source at this location" - 'font-lock-face 'cider-stacktrace-face - 'type 'cider-plain-button) - (save-excursion - (let ((p4 (point)) - (p1 (search-backward " ")) - (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))) - (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 - (nrepl-dbind-response cause (file path line column) - (let ((indent " ") - (message-face 'cider-stacktrace-error-message-face)) - (insert indent) - (insert (propertize "Error compiling " 'font-lock-face message-face)) - (insert-text-button path 'compile-error t - 'file file 'line line 'column column 'follow-link t - 'action (lambda (_button) - (cider-jump-to (cider-find-file file) - (cons line column)))) - (insert (propertize (format " at (%d:%d)" line column) - 'font-lock-face message-face)))))) - -(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) - (let ((indent " ") - (class-face 'cider-stacktrace-error-class-face) - (message-face 'cider-stacktrace-error-message-face)) - (cider-propertize-region `(cause ,num) - ;; Detail level 0: exception class - (cider-propertize-region '(detail 0) - (insert (format "%d. " num) - (propertize note 'font-lock-face 'font-lock-comment-face) " " - (propertize class 'font-lock-face class-face) - "\n")) - ;; Detail level 1: message + ex-data - (cider-propertize-region '(detail 1) - (if (equal class "clojure.lang.Compiler$CompilerException") - (cider-stacktrace-render-compile-error buffer cause) - (cider-stacktrace-emit-indented - (propertize (or message "(No message)") - 'font-lock-face message-face) indent t)) - (insert "\n") - (when data - (cider-stacktrace-emit-indented - (cider-font-lock-as-clojure data) indent nil))) - ;; Detail level 2: stacktrace - (cider-propertize-region '(detail 2) - (insert "\n") - (let ((beg (point)) - (bg `(:background ,cider-stacktrace-frames-background-color))) - (dolist (frame stacktrace) - (cider-stacktrace-render-frame buffer frame)) - (overlay-put (make-overlay beg (point)) 'font-lock-face bg))) - ;; Add line break between causes, even when collapsed. - (cider-propertize-region '(detail 0) - (insert "\n"))))))) - -(defun cider-stacktrace-initialize (causes) - "Set and apply CAUSES initial visibility, filters, and cursor position." - (nrepl-dbind-response (car causes) (class) - (let ((compile-error-p (equal class "clojure.lang.Compiler$CompilerException"))) - ;; Partially display outermost cause if it's a compiler exception (the - ;; description reports reader location of the error). - (when compile-error-p - (cider-stacktrace-cycle-cause (length causes) 1)) - ;; Fully display innermost cause. This also applies visibility/filters. - (cider-stacktrace-cycle-cause 1 cider-stacktrace-detail-max) - ;; Move point (DWIM) to the compile error location if present, or to the - ;; first stacktrace frame in displayed cause otherwise. If the error - ;; buffer is visible in a window, ensure that window is selected while moving - ;; point, so as to move both the buffer's and the window's point. - (with-selected-window (or (get-buffer-window cider-error-buffer) - (selected-window)) - (with-current-buffer cider-error-buffer - (goto-char (point-min)) - (if compile-error-p - (goto-char (next-single-property-change (point) 'compile-error)) - (progn - (while (cider-stacktrace-next-cause)) - (goto-char (next-single-property-change (point) 'flags))))))))) - -(defun cider-stacktrace-render (buffer causes &optional error-types) - "Emit into BUFFER useful stacktrace information for the CAUSES. -Takes an optional ERROR-TYPES list which will render a 'suppression' toggle -that alters the pop-over/pop-under behavorior of the stacktrace buffers -created by these types of errors. The suppressed errors set can be customized -through the `cider-stacktrace-suppressed-errors' variable." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert "\n") - ;; Stacktrace filters - (cider-stacktrace-render-filters - buffer - `(("Clojure" clj) ("Java" java) ("REPL" repl) - ("Tooling" tooling) ("Duplicates" dup) ("All" ,nil))) - (insert "\n") - ;; Option to suppress internal/middleware errors - (when error-types - (cider-stacktrace-render-suppression-toggle buffer error-types) - (insert "\n\n")) - ;; Stacktrace exceptions & frames - (let ((num (length causes))) - (dolist (cause causes) - (let ((note (if (= num (length causes)) "Unhandled" "Caused by"))) - (cider-stacktrace-render-cause buffer cause num note) - (setq num (1- num)))))) - (cider-stacktrace-initialize causes) - (font-lock-refresh-defaults))) - -(provide 'cider-stacktrace) - -;;; cider-stacktrace.el ends here diff --git a/elpa/cider-20160927.2135/cider-test.el b/elpa/cider-20160927.2135/cider-test.el deleted file mode 100644 index 1ef963c..0000000 --- a/elpa/cider-20160927.2135/cider-test.el +++ /dev/null @@ -1,690 +0,0 @@ -;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*- - -;; Copyright © 2014-2016 Jeff Valk, Bozhidar Batsov and CIDER contributors - -;; Author: Jeff Valk - -;; 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 provides execution, reporting, and navigation support for Clojure tests, -;; specifically using the `clojure.test' machinery. This functionality replaces -;; the venerable `clojure-test-mode' (deprecated in June 2014), and relies on -;; nREPL middleware for report running and session support. - -;;; Code: - -(require 'cider-common) -(require 'cider-client) -(require 'cider-popup) -(require 'cider-stacktrace) -(require 'cider-compat) -(require 'cider-overlays) - -(require 'button) -(require 'easymenu) -(require 'seq) - -;;; Variables - -(defgroup cider-test nil - "Presentation and navigation for test results." - :prefix "cider-test-" - :group 'cider) - -(defcustom cider-test-show-report-on-success nil - "Whether to show the `*cider-test-report*` buffer on passing tests." - :type 'boolean - :group 'cider-test - :package-version '(cider . "0.8.0")) - -(defcustom cider-auto-select-test-report-buffer t - "Determines if the test-report buffer should be auto-selected." - :type 'boolean - :group 'cider-test - :package-version '(cider . "0.9.0")) - -(defvar cider-test-last-summary nil - "The summary of the last run test.") - -(defvar cider-test-last-results nil - "The results of the last run test.") - -(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 - -(defface cider-test-failure-face - '((((class color) (background light)) - :background "orange red") - (((class color) (background dark)) - :background "firebrick")) - "Face for failed tests." - :group 'cider-test - :package-version '(cider . "0.7.0")) - -(defface cider-test-error-face - '((((class color) (background light)) - :background "orange1") - (((class color) (background dark)) - :background "orange4")) - "Face for erring tests." - :group 'cider-test - :package-version '(cider . "0.7.0")) - -(defface cider-test-success-face - '((((class color) (background light)) - :foreground "black" - :background "green") - (((class color) (background dark)) - :foreground "black" - :background "green")) - "Face for passing tests." - :group 'cider-test - :package-version '(cider . "0.7.0")) - - -;; Colors & Theme Support - -(defvar cider-test-items-background-color - (cider-scale-background-color) - "Background color for test assertion items.") - -(defadvice enable-theme (after cider-test-adapt-to-theme activate) - "When theme is changed, 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. - -(defvar cider-test-commands-map - (let ((map (define-prefix-command 'cider-test-commands-map))) - ;; Duplicates of keys below with C- for convenience - (define-key map (kbd "C-r") #'cider-test-rerun-tests) - (define-key map (kbd "C-t") #'cider-test-run-test) - (define-key map (kbd "C-n") #'cider-test-run-ns-tests) - (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) - ;; Single-key bindings defined last for display in menu - (define-key map (kbd "r") #'cider-test-rerun-tests) - (define-key map (kbd "t") #'cider-test-run-test) - (define-key map (kbd "n") #'cider-test-run-ns-tests) - (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) - map)) - -(defconst cider-test-menu - '("Test" - ["Run test" cider-test-run-test] - ["Run namespace tests" cider-test-run-ns-tests] - ["Run all loaded tests" cider-test-run-loaded-tests] - ["Run all project tests" cider-test-run-project-tests] - ["Run tests after load-file" cider-auto-test-mode - :style toggle :selected cider-auto-test-mode] - "--" - ["Interrupt running tests" cider-interrupt] - ["Rerun failed/erring tests" cider-test-rerun-tests] - ["Show test report" cider-test-show-report] - "--" - ["Configure testing" (customize-group 'cider-test)]) - "CIDER test submenu.") - -(defvar cider-test-report-mode-map - (let ((map (make-sparse-keymap))) - (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 "M-p") #'cider-test-previous-result) - (define-key map (kbd "M-n") #'cider-test-next-result) - (define-key map (kbd "M-.") #'cider-test-jump) - (define-key map (kbd "") #'cider-test-previous-result) - (define-key map (kbd "TAB") #'cider-test-next-result) - (define-key map (kbd "RET") #'cider-test-jump) - (define-key map (kbd "t") #'cider-test-jump) - (define-key map (kbd "d") #'cider-test-ediff) - (define-key map (kbd "e") #'cider-test-stacktrace) - ;; `f' for "run failed". - (define-key map "f" #'cider-test-rerun-tests) - ;; `g' generally reloads the buffer. The closest thing we have to that is - ;; "run the test at point". But it's not as nice as rerunning all tests in - ;; this buffer. - (define-key map "g" #'cider-test-run-test) - (define-key map "q" #'cider-popup-buffer-quit-function) - (easy-menu-define cider-test-report-mode-menu map - "Menu for CIDER's test result mode" - '("Test-Report" - ["Previous result" cider-test-previous-result] - ["Next result" cider-test-next-result] - "--" - ["Rerun current test" cider-test-run-test] - ["Rerun failed/erring tests" cider-test-rerun-tests] - ["Run all loaded tests" cider-test-run-loaded-tests] - ["Run all project tests" cider-test-run-project-tests] - "--" - ["Jump to test definition" cider-test-jump] - ["Display test error" cider-test-stacktrace] - ["Display expected/actual diff" cider-test-ediff])) - map)) - -(define-derived-mode cider-test-report-mode fundamental-mode "Test Report" - "Major mode for presenting Clojure test results. - -\\{cider-test-report-mode-map}" - (setq buffer-read-only t) - (setq-local truncate-lines t) - (setq-local electric-indent-chars nil)) - -;; Report navigation - -(defun cider-test-show-report () - "Show the test report buffer, if one exists." - (interactive) - (if-let ((report-buffer (get-buffer cider-test-report-buffer))) - (switch-to-buffer report-buffer) - (message "No test report buffer"))) - -(defun cider-test-previous-result () - "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))) - (if (get-text-property pos 'type) - (goto-char pos) - (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))) - (if (get-text-property pos 'type) - (goto-char pos) - (when-let ((pos (next-single-property-change pos 'type))) - (goto-char pos)))))) - -(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 -prompt and whether to use a new window. Similar to `cider-find-var'." - (interactive "P") - (let ((ns (get-text-property (point) 'ns)) - (var (get-text-property (point) 'var)) - (line (get-text-property (point) 'line))) - (if (and ns var) - (cider-find-var arg (concat ns "/" var) line) - (cider-find-var arg)))) - -;;; Error stacktraces - -(defvar cider-auto-select-error-buffer) - -(defun cider-test-stacktrace-for (ns var index) - "Display stacktrace for the erring NS VAR test with the assertion INDEX." - (let (causes) - (cider-nrepl-send-request - (append - (list "op" "test-stacktrace" "session" (cider-current-session) - "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))) - (lambda (response) - (nrepl-dbind-response response (class status) - (cond (class (setq causes (cons response causes))) - (status (when causes - (cider-stacktrace-render - (cider-popup-buffer cider-error-buffer - cider-auto-select-error-buffer - #'cider-stacktrace-mode) - (reverse causes)))))))))) - -(defun cider-test-stacktrace () - "Display stacktrace for the erring test at point." - (interactive) - (let ((ns (get-text-property (point) 'ns)) - (var (get-text-property (point) 'var)) - (index (get-text-property (point) 'index)) - (err (get-text-property (point) 'error))) - (if (and err ns var index) - (cider-test-stacktrace-for ns var index) - (message "No test error at point")))) - - -;;; Expected vs actual diffing - -(defvar cider-test-ediff-buffers nil - "The expected/actual buffers used to display diff.") - -(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")))) - -(defun cider-test-ediff-cleanup () - "Cleanup expected/actual buffers used for diff." - (interactive) - (mapc (lambda (b) (when (get-buffer b) (kill-buffer b))) - cider-test-ediff-buffers)) - -(add-hook 'ediff-cleanup-hook #'cider-test-ediff-cleanup) - - -;;; Report rendering - -(defun cider-test-type-face (type) - "Return the font lock face for the test result TYPE." - (pcase type - ("pass" 'cider-test-success-face) - ("fail" 'cider-test-failure-face) - ("error" 'cider-test-error-face) - (_ 'default))) - -(defun cider-test-type-simple-face (type) - "Return a face for the test result TYPE using the highlight color as foreground." - (let ((face (cider-test-type-face type))) - `(:foreground ,(face-attribute face :background)))) - -(defun cider-test-render-summary (buffer summary) - "Emit into BUFFER the report SUMMARY statistics." - (with-current-buffer buffer - (nrepl-dbind-response summary (ns var test pass fail error) - (insert (format "Tested %d namespaces\n" ns)) - (insert (format "Ran %d assertions, in %d test functions\n" test var)) - (unless (zerop fail) - (cider-insert (format "%d failures" fail) 'cider-test-failure-face t)) - (unless (zerop error) - (cider-insert (format "%d errors" error) 'cider-test-error-face t)) - (when (zerop (+ fail error)) - (cider-insert (format "%d passed" pass) 'cider-test-success-face t)) - (insert "\n\n")))) - -(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"))))) - -(defun cider-test-non-passing (tests) - "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)) - tests)) - -(defun cider-test-render-report (buffer summary results) - "Emit into BUFFER the report for the SUMMARY, and test RESULTS." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (cider-test-report-mode) - (cider-insert "Test Summary" 'bold t) - (dolist (ns (nrepl-dict-keys results)) - (insert (cider-propertize ns 'ns) "\n")) - (cider-insert "\n") - (cider-test-render-summary buffer summary) - (nrepl-dbind-response summary (fail error) - (unless (zerop (+ fail error)) - (cider-insert "Results" 'bold t "\n") - ;; Results are a nested dict, keyed first by ns, then var. Within each - ;; var is a sequence of test assertion results. - (nrepl-dict-map - (lambda (ns vars) - (nrepl-dict-map - (lambda (_var tests) - (let* ((problems (cider-test-non-passing tests)) - (count (length problems))) - (when (< 0 count) - (insert (format "%s\n%d non-passing tests:\n\n" - (cider-propertize ns 'ns) count)) - (dolist (test problems) - (cider-test-render-assertion buffer test))))) - vars)) - results))) - (goto-char (point-min)) - (current-buffer)))) - - -;;; Message echo - -(defun cider-test-echo-running (ns &optional test) - "Echo a running message for the test NS, which may be a keyword. -The optional arg TEST denotes an individual test name." - (if test - (message "Running test %s in %s..." - (cider-propertize test 'bold) - (cider-propertize ns 'ns)) - (message "Running tests in %s..." - (concat (cider-propertize - (cond ((stringp ns) ns) - ((eq :non-passing ns) "failing") - ((eq :loaded ns) "all loaded") - ((eq :project ns) "all project")) - 'ns) - (unless (stringp ns) " namespaces"))))) - -(defun cider-test-echo-summary (summary results) - "Echo SUMMARY statistics for a test run returning RESULTS." - (nrepl-dbind-response summary (ns test var fail error) - (if (nrepl-dict-empty-p results) - (message (concat (propertize "No assertions (or no tests) were run." 'face 'cider-test-error-face) - "Did you forget to use `is' in your tests?")) - (message (propertize - "%sRan %d assertions, in %d test functions. %d failures, %d errors." - 'face (cond ((not (zerop error)) 'cider-test-error-face) - ((not (zerop fail)) 'cider-test-failure-face) - (t 'cider-test-success-face))) - (concat (if (= 1 ns) ; ns count from summary - (cider-propertize (car (nrepl-dict-keys results)) 'ns) - (propertize (format "%d namespaces" ns) 'face 'default)) - (propertize ": " 'face 'default)) - 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. - -;; NOTE If keybindings specific to test sources are desired, it would be -;; straightforward to turn this into a `cider-test-mode' minor mode, which we -;; enable on test sources, much like the legacy `clojure-test-mode'. At present, -;; though, there doesn't seem to be much value in this, since the report buffer -;; provides the primary means of interacting with test results. - -(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))) - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (search-forward "(" nil t) - (let ((beg (point))) - (forward-sexp) - (cider--make-overlay beg (point) 'cider-test - 'font-lock-face (cider-test-type-face type) - 'type type - 'help-echo message - 'message message - 'expected expected - 'actual actual))))))) - -(defun cider-find-var-file (ns var) - "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"))) - (cider-find-file file))) - -(defun cider-test-highlight-problems (results) - "Highlight all non-passing tests in the test RESULTS." - (nrepl-dict-map - (lambda (ns vars) - (nrepl-dict-map - (lambda (var tests) - (when-let ((buffer (cider-find-var-file ns var))) - (dolist (test tests) - (nrepl-dbind-response test (type) - (unless (equal "pass" type) - (cider-test-highlight-problem buffer test)))))) - vars)) - results)) - -(defun cider-test-clear-highlights () - "Clear highlighting of non-passing tests from the last test run." - (interactive) - (when cider-test-last-results - (nrepl-dict-map - (lambda (ns vars) - (dolist (var (nrepl-dict-keys vars)) - (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 -;; relationship between those namespaces. - -(defcustom cider-test-infer-test-ns 'cider-test-default-test-ns-fn - "Function to infer the test namespace for NS. -The default implementation uses the simple Leiningen convention of appending -'-test' to the namespace name." - :type 'symbol - :group 'cider-test - :package-version '(cider . "0.7.0")) - -(defun cider-test-default-test-ns-fn (ns) - "For a NS, return the test namespace, which may be the argument itself. -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) - 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") - -(defun cider-test-execute (ns &optional tests silent) - "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." - (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") - "session" (cider-current-session)) - (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)) - -(defun cider-test-rerun-tests () - "Rerun failed and erring tests from the last test run." - (interactive) - (if cider-test-last-summary - (nrepl-dbind-response cider-test-last-summary (fail error) - (if (not (zerop (+ error fail))) - (cider-test-execute :non-passing) - (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-project-tests () - "Run all tests defined in all project namespaces, loading these as needed." - (interactive) - (cider-test-execute :project)) - -(defun cider-test-run-ns-tests (suppress-inference &optional silent) - "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." - (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 (eq major-mode 'cider-test-report-mode) - (when (y-or-n-p (concat "Test report does not define a namespace. " - "Rerun failed/erring tests?")) - (cider-test-rerun-tests)) - (unless silent - (message "No namespace to test in current context"))))) - -(defun cider-test-run-test () - "Run the test at point. -The test ns/var exist as text properties on report items and on highlighted -failed/erred test definitions. When not found, a test definition at point -is searched." - (interactive) - (let ((ns (get-text-property (point) 'ns)) - (var (get-text-property (point) 'var))) - (if (and ns var) - (cider-test-execute ns (list var)) - (let ((ns (clojure-find-ns)) - (def (clojure-find-def))) - (if (and ns (member (car def) '("deftest" "defspec"))) - (cider-test-execute ns (cdr def)) - (message "No test at point")))))) - -;;; Auto-test mode -(defun cider--test-silently () - "Like `cider-test-run-tests', but with less feedback. -Only notify the user if there actually were any tests to run and only after -the results are received." - (when (cider-connected-p) - (let ((cider-auto-select-test-report-buffer nil) - (cider-test-show-report-on-success nil)) - (cider-test-run-ns-tests nil 'soft)))) - -;;;###autoload -(define-minor-mode cider-auto-test-mode - "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." - nil (cider-mode " Test") nil - :global t - (if cider-auto-test-mode - (add-hook 'cider-file-loaded-hook #'cider--test-silently) - (remove-hook 'cider-file-loaded-hook #'cider--test-silently))) - -(provide 'cider-test) - -;;; cider-test.el ends here diff --git a/elpa/cider-20160927.2135/cider-util.el b/elpa/cider-20160927.2135/cider-util.el deleted file mode 100644 index 59cb3d6..0000000 --- a/elpa/cider-20160927.2135/cider-util.el +++ /dev/null @@ -1,691 +0,0 @@ -;;; 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-2016 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: - -;; Common utility functions that don't belong anywhere else. - -;;; Code: - -(require 'seq) -(require 'cl-lib) -(require 'clojure-mode) -(require 'cider-compat) -(require 'nrepl-dict) - -(defalias 'cider-pop-back 'pop-tag-mark) - -(defcustom cider-font-lock-max-length 10000 - "The max length of strings to fontify in `cider-font-lock-as'. - -Setting this to nil removes the fontification restriction." - :group 'cider - :type 'boolean - :package-version '(cider . "0.10.0")) - -(defun cider-util--hash-keys (hashtable) - "Return a list of keys in HASHTABLE." - (let ((keys '())) - (maphash (lambda (k _v) (setq keys (cons k keys))) hashtable) - keys)) - -(defun cider-util--clojure-buffers () - "Return a list of all existing `clojure-mode' buffers." - (seq-filter - (lambda (buffer) (with-current-buffer buffer (derived-mode-p 'clojure-mode))) - (buffer-list))) - -(defun cider-current-dir () - "Return the directory of the current buffer." - (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - -(defun cider-in-string-p () - "Return true 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." - (let ((beg (save-excursion (beginning-of-defun) (point)))) - (nth 4 (parse-partial-sexp beg (point))))) - -(defun cider--tooling-file-p (file-name) - "Return t if FILE-NAME is not a 'real' source file. -Currently, only check if the relative file name starts with 'form-init' -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. - -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)))) - - -;;; Thing at point -(defun cider-defun-at-point (&optional bounds) - "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 - (save-match-data - (end-of-defun) - (let ((end (point))) - (clojure-backward-logical-sexp 1) - (funcall (if bounds #'list #'buffer-substring-no-properties) - (point) end))))) - -(defun cider-ns-form () - "Retrieve the ns form." - (when (clojure-find-ns) - (save-excursion - (goto-char (match-beginning 0)) - (cider-defun-at-point)))) - -(defun cider-symbol-at-point (&optional look-back) - "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))) - (unless (text-property-any 0 (length str) 'field 'cider-repl-prompt str) - (substring-no-properties str))) - (when look-back - (save-excursion - (ignore-errors - (while (not (looking-at "\\sw\\|\\s_\\|\\`")) - (forward-sexp -1))) - (cider-symbol-at-point))))) - - -;;; sexp navigation -(defun cider-sexp-at-point (&optional bounds) - "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)))) - (funcall (if bounds #'list #'buffer-substring-no-properties) - (car b) (cdr b)))) - -(defun cider-last-sexp (&optional bounds) - "Return the sexp preceding the point. -If BOUNDS is non-nil, return a list of its starting and ending position -instead." - (apply (if bounds #'list #'buffer-substring-no-properties) - (save-excursion - (clojure-backward-logical-sexp 1) - (list (point) - (progn (clojure-forward-logical-sexp 1) - (skip-chars-forward "[:blank:]") - (when (looking-at-p "\n") (forward-char 1)) - (point)))))) - -(defun cider-start-of-next-sexp (&optional skip) - "Move to the start of the next sexp. -Skip any non-logical sexps like ^metadata or #reader macros. -If SKIP is an integer, also skip that many logical sexps first. -Can only error if SKIP is non-nil." - (while (clojure--looking-at-non-logical-sexp) - (forward-sexp 1)) - (when (and skip (> skip 0)) - (dotimes (_ skip) - (forward-sexp 1) - (cider-start-of-next-sexp)))) - - -;;; Text properties - -(defun cider-maybe-intern (name) - "If NAME is a symbol, return it; otherwise, intern it." - (if (symbolp name) name (intern name))) - -(defun cider-intern-keys (plist) - "Copy PLIST, with any non-symbol keys replaced with symbols." - (when plist - (cons (cider-maybe-intern (pop plist)) - (cons (pop plist) (cider-intern-keys plist))))) - -(defmacro cider-propertize-region (props &rest body) - "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)) - (let ((start (make-symbol "start"))) - `(let ((,start (point))) - (prog1 (progn ,@body) - (add-text-properties ,start (point) ,props))))) - -(put 'cider-propertize-region 'lisp-indent-function 1) - -(defun cider-property-bounds (prop) - "Return the the positions of the previous and next change to PROP. -PROP is the name of a text property." - (let ((end (next-single-char-property-change (point) prop))) - (list (previous-single-char-property-change end prop) end))) - -(defun cider-insert (text &optional face break more-text) - "Insert TEXT with FACE, optionally followed by a line BREAK and MORE-TEXT." - (insert (if face (propertize text 'font-lock-face face) text)) - (when more-text (insert more-text)) - (when break (insert "\n"))) - - -;;; Font lock - -(defalias 'cider--font-lock-ensure - (if (fboundp 'font-lock-ensure) - #'font-lock-ensure - (with-no-warnings - (lambda (&optional _beg _end) - (when font-lock-mode - (font-lock-fontify-buffer)))))) - -(defalias 'cider--font-lock-flush - (if (fboundp 'font-lock-flush) - #'font-lock-flush - (with-no-warnings - (lambda (&optional _beg _end) - (when font-lock-mode - (font-lock-fontify-buffer)))))) - -(defvar cider--mode-buffers nil - "A list of buffers for different major modes.") - -(defun cider--make-buffer-for-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))) - cider--mode-buffers)) - (or (cdr (assq mode cider--mode-buffers)) - (let ((b (generate-new-buffer (format " *cider-temp %s*" mode)))) - (push (cons mode b) cider--mode-buffers) - (with-current-buffer b - ;; suppress major mode hooks as we care only about their font-locking - ;; otherwise modes like whitespace-mode and paredit might interfere - (setq-local delay-mode-hooks t) - (setq delayed-mode-hooks nil) - (funcall mode)) - b))) - -(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)) - -(defun cider-font-lock-region-as (mode beg end &optional buffer) - "Use MODE to font-lock text between BEG and END. - -Unless you specify a BUFFER it will default to the current one." - (with-current-buffer (or buffer (current-buffer)) - (let ((text (buffer-substring beg end))) - (delete-region beg end) - (goto-char beg) - (insert (cider-font-lock-as mode text))))) - -(defun cider-font-lock-as-clojure (string) - "Font-lock STRING as Clojure code." - (cider-font-lock-as 'clojure-mode string)) - -;; Button allowing use of `font-lock-face', ignoring any inherited `face' -(define-button-type 'cider-plain-button - 'face nil) - -;;; Colors - -(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))) - -(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)))) - -(autoload 'pkg-info-version-info "pkg-info.el") - -(defvar cider-version) -(defvar cider-codename) - -(defun cider--version () - "Retrieve CIDER's version. -A codename is added to stable versions." - (let ((version (condition-case nil - (pkg-info-version-info 'cider) - (error cider-version)))) - (if (string-match-p "-snapshot" cider-version) - version - (format "%s (%s)" version cider-codename)))) - - -;;; Strings - -(defun cider-string-trim-left (string) - "Remove leading whitespace from STRING." - (if (string-match "\\`[ \t\n\r]+" string) - (replace-match "" t t string) - string)) - -(defun cider-string-trim-right (string) - "Remove trailing whitespace from STRING." - (if (string-match "[ \t\n\r]+\\'" string) - (replace-match "" t t string) - string)) - -(defun cider-string-trim (string) - "Remove leading and trailing whitespace from STRING." - (cider-string-trim-left (cider-string-trim-right string))) - -(defun cider-string-join (strings &optional separator) - "Join all STRINGS using SEPARATOR." - (mapconcat #'identity strings separator)) - -(defun cider-join-into-alist (candidates &optional separator) - "Make an alist from CANDIDATES. -The keys are the elements joined with SEPARATOR and values are the original -elements. Useful for `completing-read' when candidates are complex -objects." - (mapcar (lambda (el) - (if (listp el) - (cons (cider-string-join el (or separator ":")) el) - (cons el el))) - candidates)) - -(defun cider-add-to-alist (symbol car cadr) - "Add '(CAR CADR) to the alist stored in SYMBOL. -If CAR already corresponds to an entry in the alist, destructively replace -the entry's second element with CADR. - -This can be used, for instance, to update the version of an injected -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))) - (setcdr cons (list cadr)) - (set symbol (cons (list car cadr) alist))))) - -(defun cider-namespace-qualified-p (sym) - "Return t if SYM is namespace-qualified." - (string-match-p "[^/]+/" sym)) - -(defvar cider-version) - -(defconst cider-manual-url "http://cider.readthedocs.org/en/%s/" - "The URL to CIDER's manual.") - -(defun cider--manual-version () - "Convert the version to a ReadTheDocs-friendly version." - (if (string-match-p "-snapshot" cider-version) - "latest" - "stable")) - -(defun cider-manual-url () - "The CIDER manual's url." - (format cider-manual-url (cider--manual-version))) - -;;;###autoload -(defun cider-view-manual () - "View the manual in your default browser." - (interactive) - (browse-url (cider-manual-url))) - -(defun cider--manual-button (label section-id) - "Return a button string that links to the online manual. -LABEL is the displayed string, and SECTION-ID is where it points -to." - (with-temp-buffer - (insert-text-button - label - 'follow-link t - 'action (lambda (&rest _) (interactive) - (browse-url (concat (cider-manual-url) - section-id)))) - (buffer-string))) - -(defconst cider-refcard-url "https://github.com/clojure-emacs/cider/raw/%s/doc/cider-refcard.pdf" - "The URL to CIDER's refcard.") - -(defun cider--github-version () - "Convert the version to a GitHub-friendly version." - (if (string-match-p "-snapshot" cider-version) - "master" - (concat "v" cider-version))) - -(defun cider-refcard-url () - "The CIDER manual's url." - (format cider-refcard-url (cider--github-version))) - -(defun cider-view-refcard () - "View the refcard in your default browser." - (interactive) - (browse-url (cider-refcard-url))) - -(defconst cider-report-bug-url "https://github.com/clojure-emacs/cider/issues/new" - "The URL to report a CIDER issue.") - -(defun cider-report-bug () - "Report a bug in your default browser." - (interactive) - (browse-url cider-report-bug-url)) - -(defun cider--project-name (dir) - "Extracts a project name from DIR, possibly nil. -The project name is the final component of DIR if not nil." - (when dir - (file-name-nondirectory (directory-file-name dir)))) - -;;; Vectors -(defun cider--deep-vector-to-list (x) - "Convert vectors in X to lists. -If X is a sequence, return a list of `cider--deep-vector-to-list' applied to -each of its elements. -Any other value is just returned." - (if (sequencep x) - (mapcar #'cider--deep-vector-to-list x) - x)) - - -;;; Help mode - -;; Same as https://github.com/emacs-mirror/emacs/blob/86d083438dba60dc00e9e96414bf7e832720c05a/lisp/help-mode.el#L355 -;; the original function uses some buffer local variables, but the buffer used -;; is not configurable. It defaults to (help-buffer) - -(defun cider--help-setup-xref (item interactive-p buffer) - "Invoked from commands using the \"*Help*\" buffer to install some xref info. - -ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help -buffer after following a reference. INTERACTIVE-P is non-nil if the -calling command was invoked interactively. In this case the stack of -items for help buffer \"back\" buttons is cleared. Use BUFFER for the -buffer local variables. - -This should be called very early, before the output buffer is cleared, -because we want to record the \"previous\" position of point so we can -restore it properly when going back." - (with-current-buffer buffer - (when help-xref-stack-item - (push (cons (point) help-xref-stack-item) help-xref-stack) - (setq help-xref-forward-stack nil)) - (when interactive-p - (let ((tail (nthcdr 10 help-xref-stack))) - ;; Truncate the stack. - (if tail (setcdr tail nil)))) - (setq help-xref-stack-item item))) - -(defcustom cider-doc-xref-regexp "`\\(.*?\\)`" - "The regexp used to search Clojure vars in doc buffers." - :type 'regexp - :safe #'stringp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defun cider--find-symbol-xref () - "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." - (when (re-search-forward cider-doc-xref-regexp nil t) - (match-string 1))) - -(declare-function cider-doc-lookup "cider-doc") -(declare-function cider--eldoc-remove-dot "cider-eldoc") - -;; 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. -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'. - -Special references `back' and `forward' are made to go back and forth -through a stack of help buffers. Variables `help-back-label' and -`help-forward-label' specify the text for that." - (interactive "b") - - ;; parse the docstring and create xrefs for symbols - (save-excursion - (goto-char (point-min)) - (let ((symbol)) - (while (setq symbol (cider--find-symbol-xref)) - (replace-match "") - (insert-text-button symbol - '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"))) - - -;;; Words of inspiration -(defun cider-user-first-name () - "Find the current user's first name." - (let ((name (if (string= (user-full-name) "") - (user-login-name) - (user-full-name)))) - (string-match "^[^ ]*" name) - (capitalize (match-string 0 name)))) - -(defvar cider-words-of-inspiration - `("The best way to predict the future is to invent it. -Alan Kay" - "A point of view is worth 80 IQ points. -Alan Kay" - "Lisp isn't a language, it's a building material. -Alan Kay" - "Simple things should be simple, complex things should be possible. -Alan Kay" - "Everything should be as simple as possible, but not simpler. -Albert Einstein" - "Measuring programming progress by lines of code is like measuring aircraft building progress by weight. -Bill Gates" - "Controlling complexity is the essence of computer programming. -Brian Kernighan" - "The unavoidable price of reliability is simplicity. -C.A.R. Hoare" - "You're bound to be unhappy if you optimize everything. -Donald Knuth" - "Simplicity is prerequisite for reliability. -Edsger W. Dijkstra" - "Elegance is not a dispensable luxury but a quality that decides between success and failure. -Edsger W. Dijkstra" - "Deleted code is debugged code. -Jeff Sickel" - "The key to performance is elegance, not battalions of special cases. -Jon Bentley and Doug McIlroy" - "First, solve the problem. Then, write the code. -John Johnson" - "Simplicity is the ultimate sophistication. -Leonardo da Vinci" - "Programming is not about typing... it's about thinking. -Rich Hickey" - "Design is about pulling things apart. -Rich Hickey" - "Programmers know the benefits of everything and the tradeoffs of nothing. -Rich Hickey" - "Code never lies, comments sometimes do. -Ron Jeffries" - "The true delight is in the finding out rather than in the knowing. -Isaac Asimov" - "If paredit is not for you, then you need to become the sort of person that paredit is for. -Phil Hagelberg" - "Express Yourself. -Madonna" - "Put on your red shoes and dance the blues. -David Bowie" - "Do. Or do not. There is no try. -Yoda" - "The enjoyment of one's tools is an essential ingredient of successful work. -Donald E. Knuth" - "Not all those who wander are lost. -J.R.R. Tolkien" - "The best way to learn is to do. -P.R. Halmos" - "If you wish to make an apple pie from scratch, you must first invent the universe. -Carl Sagan" - "Learn the rules like a pro, so you can break them like an artist. -Pablo Picasso" - "The only way of discovering the limits of the possible is to venture a little way past them into the impossible. -Arthur C. Clarke" - "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" - "Clojure isn't a language, it's a building material." - "Think big!" - "Think bold!" - "Think fun!" - "Code big!" - "Code bold!" - "Code fun!" - "Take this REPL, fellow hacker, and may it serve you well." - "Let the hacking commence!" - "Hacks and glory await!" - "Hack and be merry!" - "Your hacking starts... NOW!" - "May the Source be with you!" - "May the Source shine upon thy REPL!" - "Code long and prosper!" - "Happy hacking!" - "nREPL server is up, CIDER REPL is online!" - "CIDER REPL operational!" - "Your imagination is the only limit to what you can do with this REPL!" - "This REPL is yours to command!" - "Fame is but a hack away!" - "The REPL is not enough, but it is such a perfect place to start..." - "Keep on codin' in the free world!" - "What we do in the REPL echoes in eternity!" - "Evaluating is believing." - "To infinity... and beyond." - "Showtime!" - "Unfortunately, no one can be told what CIDER is. You have to figure this out yourself." - "Procure a bottle of cider to achieve optimum programming results." - "In parentheses we trust!" - "Write you some Clojure for Great Good!" - "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." - ,(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." - (cider-user-first-name))) - "Scientifically-proven optimal words of hackerish encouragement.") - -(defun cider-random-words-of-inspiration () - "Select a random entry from `cider-words-of-inspiration'." - (eval (nth (random (length cider-words-of-inspiration)) - cider-words-of-inspiration))) - -(defvar cider-tips - '("Press <\\[cider-connect]> to connect to a running nREPL server." - "Press <\\[cider-quit]> to quit the current connection." - "Press <\\[cider-view-manual]> to view CIDER's manual." - "Press <\\[cider-view-refcard]> to view CIDER's refcard." - "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-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." - "Press <\\[cider-test-run-project-tests]> to run all tests for the current project." - "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-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." - "Press <\\[cider-drink-a-sip]> to get more CIDER tips." - "Press <\\[cider-browse-ns-all]> to start CIDER's namespace browser." - "Press <\\[cider-classpath]> to start CIDER's classpath browser." - "Press <\\[cider-macroexpand-1]> to expand the preceding macro." - "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-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." - "Use to see every possible REPL setting you can customize." - "Enable `eldoc-mode' to display function & method signatures in the minibuffer." - "Enable `cider-enlighten-mode' to display the locals of a function when it's executed." - "Use <\\[cider-close-ancillary-buffers]> to close all ancillary buffers created by CIDER (e.g. *cider-doc*)." - "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.") - "Some handy CIDER tips." - ) - -(defun cider-random-tip () - "Select a random tip from `cider-tips'." - (substitute-command-keys (nth (random (length cider-tips)) cider-tips))) - -(defun cider-drink-a-sip () - "Show a random tip." - (interactive) - (message (cider-random-tip))) - -(defun cider-column-number-at-pos (pos) - "Analog to `line-number-at-pos'. -Return buffer column number at position POS." - (save-excursion (goto-char pos) (current-column))) - -(defun cider-propertize (text kind) - "Propertize TEXT as KIND. -KIND can be the symbols `ns', `var', `emph', `fn', or a face name." - (propertize text 'face (pcase kind - (`fn 'font-lock-function-name-face) - (`var 'font-lock-variable-name-face) - (`ns 'font-lock-type-face) - (`emph 'font-lock-keyword-face) - (face face)))) - -(defun cider--menu-add-help-strings (menu-list) - "Add a :help entries to items in MENU-LIST." - (mapcar (lambda (x) - (cond - ((listp x) (cider--menu-add-help-strings x)) - ((and (vectorp x) - (not (plist-get (append x nil) :help)) - (functionp (elt x 1))) - (vconcat x `[:help ,(documentation (elt x 1))])) - (t x))) - menu-list)) - -(provide 'cider-util) - -;;; cider-util.el ends here diff --git a/elpa/cider-20160927.2135/cider.el b/elpa/cider-20160927.2135/cider.el deleted file mode 100644 index 04a2556..0000000 --- a/elpa/cider-20160927.2135/cider.el +++ /dev/null @@ -1,790 +0,0 @@ -;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2016 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.14.0-cvs -;; Package-Requires: ((emacs "24.3") (clojure-mode "5.5.2") (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 'cider-compat) -(require 'cider-debug) -(require 'tramp-sh) - -(require 'seq) - -(defconst cider-version "0.14.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 "Berlin" - "Codename used to denote stable releases.") - -(defcustom cider-lein-command - "lein" - "The command used to execute Leiningen." - :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-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-parameters - "--no-daemon 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-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-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-command-prefix (dependencies) - "Return a list of boot artifact strings created from DEPENDENCIES." - (concat (mapconcat #'cider--list-as-boot-artifact dependencies " ") - " ")) - -(defun cider-boot-repl-task-params (params middlewares) - (if (string-match "\\_" params) - (replace-match (concat "repl " - (mapconcat (lambda (middleware) - (format "-m %s" (shell-quote-argument middleware))) - middlewares - " ")) - 'fixed 'literal params) - (message "Warning: `cider-boot-parameters' doesn't call the \"repl\" task, jacking-in might not work") - params)) - -(defun cider-boot-jack-in-dependencies (params dependencies plugins middlewares) - (concat (cider-boot-command-prefix (append dependencies plugins)) - (cider-boot-repl-task-params 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 (params dependencies dependencies-exclusions lein-plugins) - (concat - (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 (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 - 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 - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - cider-jack-in-lein-plugins - cider-jack-in-nrepl-middlewares)) - ("gradle" 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 Readme for additional configuration)"))) - -(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)) - :group 'cider) - -(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))) - (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 cider-cljs-lein-repl 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) - "session" nrepl-session - "code" cider-cljs-lein-repl) - (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-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 params project-type) - params)) - - (cmd (format "%s %s" command-resolved params))) - (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 "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)))) - (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 (file-remote-p default-directory) - (executable-find cider-lein-command) - (executable-find (concat cider-lein-command ".bat"))))) - (shell-quote-argument command))) - -(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 (file-remote-p default-directory) - (executable-find cider-boot-command) - (executable-find (concat cider-boot-command ".exe"))))) - (shell-quote-argument command))) - -(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 (file-remote-p default-directory) - (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" - "Clojure version information could not be determined. Requires a minimum version %s." - 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 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 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-20160927.2135/nrepl-client.el b/elpa/cider-20160927.2135/nrepl-client.el deleted file mode 100644 index fc26d3a..0000000 --- a/elpa/cider-20160927.2135/nrepl-client.el +++ /dev/null @@ -1,1227 +0,0 @@ -;;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2016 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. -;; -;; A connection is an abstract idea of the communication between Emacs (client) -;; and nREPL server. On the Emacs side connections are represented by two -;; running processes. The two processes are the server process and client -;; process (the connection to the server). Each of these is represented by its -;; own process buffer, filter and sentinel. -;; -;; 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 -;; if a connection was established using `cider-connect' there won't be -;; a server process. -;; -;; 2) The server's process filter (`nrepl-server-filter') detects the -;; connection port from the first plain text response from the server and -;; starts a communication process (socket connection) as another Emacs -;; subprocess. This is the nREPL client process (`nrepl-client-filter'). -;; All requests and responses handling happens through this client -;; connection. -;; -;; 3) Requests are sent by `nrepl-send-request' and -;; `nrepl-send-sync-request'. A request is simply a list containing a -;; requested operation name and the parameters required by the -;; operation. Each request has an associated callback that is called once -;; the response for the request has arrived. Besides the above functions -;; there are specialized request senders for each type of common -;; operations. Examples are `nrepl-request:eval', `nrepl-request:clone', -;; `nrepl-sync-request:describe'. -;; -;; 4) Responses from the server are decoded in `nrepl-client-filter' and are -;; physically represented by alists whose structure depends on the type of -;; the response. After having been decoded, the data from the response is -;; passed over to the callback that was registered by the original -;; request. -;; -;; Please see the comments in dedicated sections of this file for more detailed -;; description. - -;;; Code: -(require 'seq) -(require 'cider-compat) -(require 'cl-lib) -(require 'nrepl-dict) -(require 'queue) -(require 'tramp) - - -;;; Custom - -(defgroup nrepl nil - "Interaction with the Clojure nREPL Server." - :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-show-port nil - "Show the connection port in the nrepl REPL buffer name, if set to t." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-connected-hook nil - "List of functions to call when connecting to the nREPL server." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-disconnected-hook nil - "List of functions to call when disconnected from the nREPL server." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-file-loaded-hook nil - "List of functions to call when a load file has completed." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-force-ssh-for-remote-hosts nil - "If non-nil, do not attempt a direct connection for remote hosts." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-sync-request-timeout 10 - "The number of seconds to wait for a sync response. -Setting this to nil disables the timeout functionality." - :type 'integer - :group 'nrepl) - -(defcustom nrepl-hide-special-buffers nil - "Control the display of some special buffers in buffer switching commands. -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-endpoint nil) -(defvar-local nrepl-project-dir nil) -(defvar-local nrepl-tunnel-buffer nil) - -(defvar-local nrepl-session nil - "Current nREPL session id.") - -(defvar-local nrepl-tooling-session nil - "Current nREPL tooling session id. -To be used for tooling calls (i.e. completion, eldoc, etc)") - -(defvar-local nrepl-request-counter 0 - "Continuation serial number counter.") - -(defvar-local nrepl-pending-requests nil) - -(defvar-local nrepl-completed-requests nil) - -(defvar-local nrepl-last-sync-response nil - "Result of the last sync request.") - -(defvar-local nrepl-last-sync-request-timestamp nil - "The time when the last sync request was initiated.") - -(defvar-local nrepl-ops nil - "Available nREPL server ops (from describe).") - -(defvar-local nrepl-versions nil - "Version information received from the describe op.") - -(defvar-local nrepl-aux nil - "Auxillary information received from the describe op.") - - -;;; nREPL Buffer Names - -(defconst nrepl-message-buffer-name-template "*nrepl-messages %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) ""))))) - (if dup-ok - name - (generate-new-buffer-name name)))) - -(defun nrepl--make-hidden-name (buffer-name) - "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-server-buffer-name (&optional project-dir host port) - "Return the name of the server buffer. -PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." - (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-server-buffer-name-template - project-dir host port))) - -(defun nrepl-tunnel-buffer-name (&optional project-dir host port) - "Return the name of the tunnel buffer. -PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." - (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-tunnel-buffer-name-template - project-dir host port))) - - -;;; 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)))) - -(defun nrepl-aux-info (key connection) - "Return KEY's aux info, as returned via the :describe op for CONNECTION." - (with-current-buffer connection - (and nrepl-aux (nrepl-dict-get nrepl-aux key)))) - -(defun nrepl-local-host-p (host) - "Return t if HOST is local." - (string-match-p tramp-local-host-regexp host)) - -(defun nrepl-extract-port (dir) - "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)))) - -(defun nrepl--port-from-file (file) - "Attempts to read port from a file named by FILE." - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents file) - (buffer-string)))) - - -;;; Bencode - -(cl-defstruct (nrepl-response-queue - (:include queue) - (:constructor nil) - (:constructor nrepl-response-queue (&optional stub))) - stub) - -(put 'nrepl-response-queue 'function-documentation - "Create queue object used by nREPL to store decoded server responses. -The STUB slot stores a stack of nested, incompletely parsed objects.") - -(defun nrepl--bdecode-list (&optional stack) - "Decode a bencode list or dict starting at point. -STACK is as in `nrepl--bdecode-1'." - ;; skip leading l or d - (forward-char 1) - (let* ((istack (nrepl--bdecode-1 stack)) - (pos0 (point)) - (info (car istack))) - (while (null info) - (setq istack (nrepl--bdecode-1 (cdr istack)) - pos0 (point) - info (car istack))) - (cond ((eq info :e) - (cons nil (cdr istack))) - ((eq info :stub) - (goto-char pos0) - istack) - (t istack)))) - -(defun nrepl--bdecode-1 (&optional stack) - "Decode one elementary bencode object starting at point. -Bencoded object is either list, dict, integer or string. See -http://en.wikipedia.org/wiki/Bencode#Encoding_algorithm for the encoding -rules. - -STACK is a list of so far decoded components of the current message. Car -of STACK is the innermost incompletely decoded object. The algorithm pops -this list when inner object was completely decoded or grows it by one when -new list or dict was encountered. - -The returned value is of the form (INFO . STACK) where INFO is -:stub, nil, :end or :eob and STACK is either an incomplete parsing state as -above (INFO is :stub, nil or :eob) or a list of one component representing -the completely decoded message (INFO is :end). INFO is nil when an -elementary non-root object was successfully decoded. INFO is :end when this -object is a root list or dict." - (cond - ;; list - ((eq (char-after) ?l) - (nrepl--bdecode-list (cons () stack))) - ;; dict - ((eq (char-after) ?d) - (nrepl--bdecode-list (cons '(dict) stack))) - ;; end of a list or a dict - ((eq (char-after) ?e) - (forward-char 1) - (cons (if (cdr stack) :e :end) - (nrepl--push (nrepl--nreverse (car stack)) - (cdr stack)))) - ;; string - ((looking-at "\\([0-9]+\\):") - (let ((pos0 (point)) - (beg (goto-char (match-end 0))) - (end (byte-to-position (+ (position-bytes (point)) - (string-to-number (match-string 1)))))) - (if (null end) - (progn (goto-char pos0) - (cons :stub stack)) - (goto-char end) - ;; normalise any platform-specific newlines - (let* ((original (buffer-substring-no-properties beg end)) - ;; handle both \n\r and \r\n - (result (replace-regexp-in-string "\r\n\\|\n\r" "\n" original)) - ;; we don't handle single carriage returns, insert newline - (result (replace-regexp-in-string "\r" "\n" result))) - (cons nil (nrepl--push result stack)))))) - ;; integer - ((looking-at "i\\(-?[0-9]+\\)e") - (goto-char (match-end 0)) - (cons nil (nrepl--push (string-to-number (match-string 1)) - stack))) - ;; should happen in tests only as eobp is checked in nrepl-bdecode. - ((eobp) - (cons :eob stack)) - ;; truncation in the middle of an integer or in 123: string prefix - ((looking-at-p "[0-9i]") - (cons :stub stack)) - ;; else, throw a quiet error - (t - (message "Invalid bencode message detected. See the %s buffer for details." - nrepl-error-buffer-name) - (nrepl-log-error - (format "Decoder error at position %d (`%s'):" - (point) (buffer-substring (point) (min (+ (point) 10) (point-max))))) - (nrepl-log-error (buffer-string)) - (ding) - ;; Ensure loop break and clean queues' states in nrepl-bdecode: - (goto-char (point-max)) - (cons :end nil)))) - -(defun nrepl--bdecode-message (&optional stack) - "Decode one full message starting at point. -STACK is as in `nrepl--bdecode-1'. Return a cons (INFO . STACK)." - (let* ((istack (nrepl--bdecode-1 stack)) - (info (car istack)) - (stack (cdr istack))) - (while (or (null info) - (eq info :e)) - (setq istack (nrepl--bdecode-1 stack) - info (car istack) - stack (cdr istack))) - istack)) - -(defun nrepl-bdecode (string-q &optional response-q) - "Decode STRING-Q and place the results into RESPONSE-Q. -STRING-Q is either a queue of strings or a string. RESPONSE-Q is a queue of -server requests (nREPL dicts). STRING-Q and RESPONSE-Q are modified by side -effects. - -Return a cons (STRING-Q . RESPONSE-Q) where STRING-Q is the original queue -containing the remainder of the input strings which could not be -decoded. RESPONSE-Q is the original queue with successfully decoded messages -enqueued and with slot STUB containing a nested stack of an incompletely -decoded message or nil if the strings were completely decoded." - (with-temp-buffer - (if (queue-p string-q) - (while (queue-head string-q) - (insert (queue-dequeue string-q))) - (insert string-q) - (setq string-q (queue-create))) - (goto-char 1) - (unless response-q - (setq response-q (nrepl-response-queue))) - (let ((istack (nrepl--bdecode-message - (nrepl-response-queue-stub response-q)))) - (while (and (eq (car istack) :end) - (not (eobp))) - (queue-enqueue response-q (cadr istack)) - (setq istack (nrepl--bdecode-message))) - (unless (eobp) - (queue-enqueue string-q (buffer-substring (point) (point-max)))) - (if (not (eq (car istack) :end)) - (setf (nrepl-response-queue-stub response-q) (cdr istack)) - (queue-enqueue response-q (cadr istack)) - (setf (nrepl-response-queue-stub response-q) nil)) - (cons string-q response-q)))) - -(defun nrepl-bencode (object) - "Encode OBJECT with bencode. -Integers, lists and nrepl-dicts are treated according to bencode -specification. Everything else is encoded as string." - (cond - ((integerp object) (format "i%de" object)) - ((nrepl-dict-p object) (format "d%se" (mapconcat #'nrepl-bencode (cdr object) ""))) - ((listp object) (format "l%se" (mapconcat #'nrepl-bencode object ""))) - (t (format "%s:%s" (string-bytes object) object)))) - - -;;; Client: Process Filter - -(defvar nrepl-response-handler-functions nil - "List of functions to call on each nREPL message. -Each of these functions should be a function with one argument, which will -be called by `nrepl-client-filter' on every response received. The current -buffer will be connection (REPL) buffer of the process. These functions -should take a single argument, a dict representing the message. See -`nrepl--dispatch-response' for an example. - -These functions are called before the message's own callbacks, so that they -can affect the behaviour of the callbacks. Errors signaled by these -functions are demoted to messages, so that they don't prevent the -callbacks from running.") - -(defun nrepl-client-filter (proc string) - "Decode message(s) from PROC contained in STRING and dispatch them." - (let ((string-q (process-get proc :string-q))) - (queue-enqueue string-q string) - ;; Start decoding only if the last letter is 'e' - (when (eq ?e (aref string (1- (length string)))) - (let ((response-q (process-get proc :response-q))) - (nrepl-bdecode string-q response-q) - (while (queue-head response-q) - (with-current-buffer (process-buffer proc) - (let ((response (queue-dequeue response-q))) - (with-demoted-errors "Error in one of the `nrepl-response-handler-functions': %s" - (run-hook-with-args 'nrepl-response-handler-functions response)) - (nrepl--dispatch-response response)))))))) - -(defun nrepl--dispatch-response (response) - "Dispatch the RESPONSE to associated callback. -First we check the callbacks of pending requests. If no callback was found, -we check the completed requests, since responses could be received even for -older requests with \"done\" status." - (nrepl-dbind-response response (id) - (nrepl-log-message response 'response) - (let ((callback (or (gethash id nrepl-pending-requests) - (gethash id nrepl-completed-requests)))) - (if callback - (funcall callback response) - (error "[nREPL] No response handler with id %s found" id))))) - -(defun nrepl-client-sentinel (process message) - "Handle sentinel events from PROCESS. -Notify MESSAGE and if the process is closed run `nrepl-disconnected-hook' -and kill the process buffer." - (if (string-match "deleted\\b" message) - (message "[nREPL] Connection closed") - (message "[nREPL] Connection closed unexpectedly (%s)" - (substring message 0 -1))) - (when (equal (process-status process) 'closed) - (when-let ((client-buffer (process-buffer process))) - (nrepl--clear-client-sessions client-buffer) - (with-current-buffer client-buffer - (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)))))) - - -;;; Network - -(defun nrepl-connect (host port) - "Connect to the nREPL server identified by HOST and PORT. -For local hosts use a direct connection. For remote hosts, if -`nrepl-force-ssh-for-remote-hosts' is nil, attempt a direct connection -first. If `nrepl-force-ssh-for-remote-hosts' is non-nil or the direct -connection failed, try to start a SSH tunneled connection. Return a plist -of the form (:proc PROC :host \"HOST\" :port PORT) that might contain -additional key-values depending on the connection type." - (let ((localp (if host - (nrepl-local-host-p host) - (not (file-remote-p default-directory))))) - (if localp - (nrepl--direct-connect (or host "localhost") port) - (or (and host (not nrepl-force-ssh-for-remote-hosts) - (nrepl--direct-connect host port 'no-error)) - (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)) - (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)) - 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 ...") - (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 (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)) - (while (and (process-live-p tunnel) - (process-get tunnel :waiting-for-port)) - (accept-process-output nil 0.005)) - (if (not (process-live-p tunnel)) - (error "[nREPL] SSH port forwarding failed. Check the '%s' buffer" tunnel-buf) - (message "[nREPL] SSH port forwarding established to localhost:%s" port) - (let ((endpoint (nrepl--direct-connect "localhost" port))) - (thread-first endpoint - (plist-put :tunnel tunnel) - (plist-put :remote-host host)))))) - -(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 - ;; 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. - (format-spec - "%s -v -N -L %p:localhost:%p %u'%h'" - `((?s . ,ssh) - (?p . ,port) - (?h . ,host) - (?u . ,(if user (format "-l '%s' " user) "")))))) - -(autoload 'comint-watch-for-password-prompt "comint" "(autoload).") - -(defun nrepl--ssh-tunnel-filter (port) - "Return a process filter that waits for PORT to appear in process output." - (let ((port-string (format "LOCALHOST:%s" port))) - (lambda (proc string) - (when (string-match-p port-string string) - (process-put proc :waiting-for-port nil)) - (when (and (process-live-p proc) - (buffer-live-p (process-buffer proc))) - (with-current-buffer (process-buffer proc) - (let ((moving (= (point) (process-mark proc)))) - (save-excursion - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point)) - (comint-watch-for-password-prompt string)) - (if moving (goto-char (process-mark proc))))))))) - - -;;; Client: Process Handling - -(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) - "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." - (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))) - - (set-process-buffer client-proc client-buf) - - (set-process-filter client-proc 'nrepl-client-filter) - (set-process-sentinel client-proc 'nrepl-client-sentinel) - (set-process-coding-system client-proc 'utf-8-unix 'utf-8-unix) - - (process-put client-proc :string-q (queue-create)) - (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)))) - (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))) - (process-buffer tunnel)) - nrepl-pending-requests (make-hash-table :test 'equal) - nrepl-completed-requests (make-hash-table :test 'equal))) - - (with-current-buffer client-buf - (nrepl--init-client-sessions client-proc) - (nrepl--init-capabilities client-buf) - (run-hooks 'nrepl-connected-hook)) - - client-proc)) - -(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 -for functionality that's implemented in terms of the \"eval\" op, so that -eval requests for functionality like pretty-printing won't clobber the -values of *1, *2, etc." - (let* ((client-conn (process-buffer client)) - (response-main (nrepl-sync-request:clone client-conn)) - (response-tooling (nrepl-sync-request:clone client-conn))) - (nrepl-dbind-response response-main (new-session err) - (if new-session - (with-current-buffer client-conn - (setq nrepl-session new-session)) - (error "Could not create new session (%s)" err))) - (nrepl-dbind-response response-tooling (new-session err) - (if new-session - (with-current-buffer client-conn - (setq nrepl-tooling-session new-session)) - (error "Could not create new tooling session (%s)" err))))) - -(defun nrepl--init-capabilities (conn-buffer) - "Store locally in CONN-BUFFER the capabilities of nREPL server." - (let ((description (nrepl-sync-request:describe conn-buffer))) - (nrepl-dbind-response description (ops versions aux) - (with-current-buffer conn-buffer - (setq nrepl-ops ops) - (setq nrepl-versions versions) - (setq nrepl-aux aux))))) - -(defun nrepl--clear-client-sessions (conn-buffer) - "Clear information about nREPL sessions in CONN-BUFFER. -CONN-BUFFER refers to a (presumably) dead connection, which we can eventually reuse." - (with-current-buffer conn-buffer - (setq nrepl-session nil) - (setq nrepl-tooling-session nil))) - - -;;; Client: Response Handling -;; After being decoded, responses (aka, messages from the server) are dispatched -;; to handlers. Handlers are constructed with `nrepl-make-response-handler'. - -(defvar nrepl-err-handler nil - "Evaluation error handler.") - -(defun nrepl--mark-id-completed (id) - "Move ID from `nrepl-pending-requests' to `nrepl-completed-requests'. -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))) - (puthash id handler nrepl-completed-requests) - (remhash id nrepl-pending-requests))) - -(defvar cider-buffer-ns) -(declare-function cider-need-input "cider-interaction") -(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) - "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' -and 'session' keys. Other standard response keys are 'value', 'out', 'err', -'pprint-out' and 'status'. - -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." - (lambda (response) - (nrepl-dbind-response response (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 - (when value-handler - (funcall value-handler buffer value))) - (out - (when stdout-handler - (funcall stdout-handler buffer out))) - (pprint-out - (cond (pprint-out-handler (funcall pprint-out-handler buffer pprint-out)) - (stdout-handler (funcall stdout-handler buffer pprint-out)))) - (err - (when stderr-handler - (funcall stderr-handler buffer err))) - (status - (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.")) - (when (member "need-input" status) - (cider-need-input buffer)) - (when (member "done" status) - (nrepl--mark-id-completed id) - (when done-handler - (funcall done-handler buffer)))))))) - - -;;; Client: Request Core API - -;; Requests are messages from an nREPL client (like CIDER) to an nREPL server. -;; 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 -;; many more operations through nREPL middleware. See -;; https://github.com/clojure-emacs/cider-nrepl#supplied-nrepl-middleware for -;; the up-to-date list. - -(defun nrepl-next-request-id (connection) - "Return the next request id for CONNECTION." - (with-current-buffer connection - (number-to-string (cl-incf nrepl-request-counter)))) - -(defun nrepl-send-request (request callback connection) - "Send REQUEST and register response handler CALLBACK using CONNECTION. -REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" -\"par1\" ... ). See the code of `nrepl-request:clone', -`nrepl-request:stdin', etc. -Return the ID of the sent message." - (with-current-buffer connection - (when (and (not (lax-plist-get request "session")) - nrepl-session) - (setq request (append request (list "session" nrepl-session)))) - (let* ((id (nrepl-next-request-id connection)) - (request (cons 'dict (lax-plist-put request "id" id))) - (message (nrepl-bencode request))) - (nrepl-log-message request 'request) - (puthash id callback nrepl-pending-requests) - (process-send-string nil message) - id))) - -(defvar nrepl-ongoing-sync-request nil - "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") - -(defun nrepl-send-sync-request (request connection &optional 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. -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." - (let* ((time0 (current-time)) - (response (cons 'dict nil)) - (nrepl-ongoing-sync-request t) - status) - (nrepl-send-request request - (lambda (resp) (nrepl--merge response resp)) - connection) - (while (and (not (member "done" status)) - (not (and abort-on-input - (input-pending-p)))) - (setq status (nrepl-dict-get response "status")) - ;; If we get a need-input message then the repl probably isn't going - ;; anywhere, and we'll just timeout. So we forward it to the user. - (if (member "need-input" status) - (progn (cider-need-input (current-buffer)) - ;; If the used took a few seconds to respond, we might - ;; unnecessarily timeout, so let's reset the timer. - (setq time0 (current-time))) - ;; break out in case we don't receive a response for a while - (when (and nrepl-sync-request-timeout - (> (cadr (time-subtract (current-time) time0)) - nrepl-sync-request-timeout)) - (error "Sync nREPL request timed out %s" request))) - ;; Clean up the response, otherwise we might repeatedly ask for input. - (nrepl-dict-put response "status" (remove "need-input" status)) - (accept-process-output nil 0.01)) - ;; If we couldn't finish, return nil. - (when (member "done" status) - (nrepl-dbind-response response (ex err eval-error pp-stacktrace id) - (when (and ex err) - (cond (eval-error (funcall nrepl-err-handler)) - (pp-stacktrace (cider--render-stacktrace-causes - pp-stacktrace (remove "done" status))))) ;; send the error type - (when id - (with-current-buffer connection - (nrepl--mark-id-completed id))) - response)))) - -(defun nrepl-request:stdin (input callback connection session) - "Send a :stdin request with INPUT using CONNECTION and SESSION. -Register CALLBACK as the response handler." - (nrepl-send-request (list "op" "stdin" - "stdin" input - "session" session) - callback - connection)) - -(defun nrepl-request:interrupt (pending-request-id callback connection session) - "Send an :interrupt request for PENDING-REQUEST-ID. -The request is dispatched using CONNECTION and SESSION. -Register CALLBACK as the response handler." - (nrepl-send-request (list "op" "interrupt" - "session" session - "interrupt-id" pending-request-id) - callback - connection)) - -(define-minor-mode cider-enlighten-mode nil nil (cider-mode " light") - :global t) - -(defun nrepl--eval-request (input session &optional ns line column) - "Prepare :eval request message for INPUT. -SESSION and NS provide 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" - "session" session - "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))))) - -(defun nrepl-request:eval (input callback connection &optional session ns line column additional-params) - "Send the request INPUT and register the CALLBACK as the response handler. -The request is dispatched via CONNECTION and SESSION. 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." - (nrepl-send-request (append (nrepl--eval-request input session ns line column) additional-params) - callback - connection)) - -(defun nrepl-sync-request:clone (connection) - "Sent a :clone request to create a new client session. -The request is dispatched via CONNECTION." - (nrepl-send-sync-request '("op" "clone") - connection)) - -(defun nrepl-sync-request:close (connection session) - "Sent a :close request to close CONNECTION's SESSION." - (nrepl-send-sync-request (list "op" "close" "session" session) - connection)) - -(defun nrepl-sync-request:describe (connection &optional session) - "Perform :describe request for CONNECTION and SESSION." - (if session - (nrepl-send-sync-request (list "session" session "op" "describe") - connection) - (nrepl-send-sync-request '("op" "describe") - connection))) - -(defun nrepl-sync-request:ls-sessions (connection) - "Perform :ls-sessions request for CONNECTION." - (nrepl-send-sync-request '("op" "ls-sessions") connection)) - -(defun nrepl-sync-request:eval (input connection session &optional ns) - "Send the INPUT to the nREPL server synchronously. -The request is dispatched via CONNECTION and SESSION. -If NS is non-nil, include it in the request." - (nrepl-send-sync-request - (nrepl--eval-request input session ns) - connection)) - -(defun nrepl-sessions (connection) - "Get a list of active sessions on the nREPL server using CONNECTION." - (nrepl-dict-get (nrepl-sync-request:ls-sessions connection) "sessions")) - - -;;; Server - -;; The server side process is started by `nrepl-start-server-process' and has a -;; very simple filter that pipes its output directly into its process buffer -;; (*nrepl-server*). The main purpose of this process is to start the actual -;; 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'.") - -(defun nrepl-start-server-process (directory cmd &optional 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 3 arguments. Once the -client process is started, the function is called with the server process, -the port, and the client buffer." - (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) - (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)) - -(defun nrepl-server-filter (process output) - "Process nREPL server output from PROCESS contained in OUTPUT." - ;; In Windows this can be false: - (let ((server-buffer (process-buffer process))) - (when (buffer-live-p server-buffer) - (with-current-buffer server-buffer - ;; auto-scroll on new output - (let ((moving (= (point) (process-mark process)))) - (save-excursion - (goto-char (process-mark process)) - (insert output) - (ansi-color-apply-on-region (process-mark process) (point)) - (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") - -(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)) - (problem (if (and server-buffer (buffer-live-p server-buffer)) - (with-current-buffer server-buffer - (buffer-substring (point-min) (point-max))) - ""))) - (when server-buffer - (kill-buffer server-buffer)) - (cond - ((string-match-p "^killed\\|^interrupt" event) - nil) - ((string-match-p "^hangup" event) - (mapc #'cider--close-connection-buffer 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))))) - - -;;; Messages - -(defcustom nrepl-log-messages t - "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." - :type 'boolean - :group 'nrepl) - -(defconst nrepl-message-buffer-max-size 1000000 - "Maximum size for the nREPL message buffer. -Defaults to 1000000 characters, which should be an insignificant -memory burden, while providing reasonable history.") - -(defconst nrepl-message-buffer-reduce-denominator 4 - "Divisor by which to reduce message buffer size. -When the maximum size for the nREPL message buffer is exceeded, the size of -the buffer is reduced by one over this value. Defaults to 4, so that 1/4 -of the buffer is removed, which should ensure the buffer's maximum is -reasonably utilized, while limiting the number of buffer shrinking -operations.") - -(defvar nrepl-messages-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "n") #'next-line) - (define-key map (kbd "p") #'previous-line) - (define-key map (kbd "TAB") #'forward-button) - (define-key map (kbd "") #'backward-button) - map)) - -(define-derived-mode nrepl-messages-mode special-mode "nREPL Messages" - "Major mode for displaying nREPL messages. - -\\{nrepl-messages-mode-map}" - (setq buffer-read-only t) - (setq-local truncate-lines t) - (setq-local electric-indent-chars nil) - (setq-local comment-start ";") - (setq-local comment-end "") - (setq-local paragraph-start "(-->\\|(<--") - (setq-local paragraph-separate "(<--")) - -(defun nrepl-decorate-msg (msg type) - "Decorate nREPL MSG according to its TYPE." - (pcase type - (`request (cons '--> (cdr msg))) - (`response (cons '<-- (cdr msg))))) - -(defun nrepl-log-message (msg type) - "Log the nREPL MSG. - -TYPE is either request or response. - -The message is logged to a buffer described by -`nrepl-message-buffer-name-template'." - (when nrepl-log-messages - (with-current-buffer (nrepl-messages-buffer (current-buffer)) - (setq buffer-read-only nil) - (when (> (buffer-size) nrepl-message-buffer-max-size) - (goto-char (/ (buffer-size) nrepl-message-buffer-reduce-denominator)) - (re-search-forward "^(" nil t) - (delete-region (point-min) (- (point) 1))) - (goto-char (point-max)) - (nrepl--pp (nrepl-decorate-msg msg type) - (nrepl--message-color (lax-plist-get (cdr msg) "id"))) - (when-let ((win (get-buffer-window))) - (set-window-point win (point-max))) - (setq buffer-read-only t)))) - -(defcustom nrepl-message-colors - '("red" "brown" "coral" "orange" "green" "deep sky blue" "blue" "dark violet") - "Colors used in `nrepl-messages-buffer'." - :type '(repeat color) - :group 'nrepl) - -(defun nrepl--message-color (id) - "Return the color to use when pretty-printing the nREPL message with ID. -If ID is nil, return nil." - (when id - (thread-first (string-to-number id) - (mod (length nrepl-message-colors)) - (nth nrepl-message-colors)))) - -(defcustom nrepl-dict-max-message-size 5 - "Max number of lines a dict can have before being truncated. -Set this to nil to prevent truncation." - :type 'integer) - -(defun nrepl--expand-button (button) - "Expand the text hidden under overlay BUTTON." - (delete-overlay button)) - -(defun nrepl--expand-button-mouse (event) - "Expand the text hidden under overlay button. -EVENT gives the button position on window." - (interactive "e") - (pcase (elt event 1) - (`(,window ,_ ,_ ,_ ,_ ,point . ,_) - (with-selected-window window - (nrepl--expand-button (button-at point)))))) - -(define-button-type 'nrepl--collapsed-dict - 'display "..." - 'action #'nrepl--expand-button - 'face 'link - 'help-echo "RET: Expand dict.") - -(defun nrepl--pp (object &optional foreground) - "Pretty print nREPL OBJECT, delimited using FOREGROUND." - (if (not (and (listp object) - (memq (car object) '(<-- --> dict)))) - (progn (when (stringp object) - (setq object (substring-no-properties object))) - (pp object (current-buffer)) - (unless (listp object) (insert "\n"))) - (let ((head (format "(%s" (car object)))) - (cl-flet ((color (str) - (propertize str 'face (append '(:weight ultra-bold) - (when foreground `(:foreground ,foreground)))))) - (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) - (nrepl--pp (cadr l)))) - (when (eq (car object) 'dict) - (delete-char -1) - (let ((truncate-lines t)) - (when (and nrepl-dict-max-message-size - (> (count-screen-lines l (point) t) - nrepl-dict-max-message-size)) - (make-button (1+ l) (point) - :type 'nrepl--collapsed-dict - ;; Workaround for bug#1568. - 'local-map '(keymap (mouse-1 . nrepl--expand-button-mouse)))))) - (insert (color ")\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))))) - -(defun nrepl-error-buffer () - "Return or create the buffer. -The default buffer name is *nrepl-error*." - (or (get-buffer nrepl-error-buffer-name) - (let ((buffer (get-buffer-create nrepl-error-buffer-name))) - (with-current-buffer buffer - (buffer-disable-undo) - (fundamental-mode) - buffer)))) - -(defun nrepl-log-error (msg) - "Log the given MSG to the buffer given by `nrepl-error-buffer'." - (with-current-buffer (nrepl-error-buffer) - (setq buffer-read-only nil) - (goto-char (point-max)) - (insert msg) - (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)) - -(provide 'nrepl-client) - -;;; nrepl-client.el ends here diff --git a/elpa/cider-20160927.2135/nrepl-dict.el b/elpa/cider-20160927.2135/nrepl-dict.el deleted file mode 100644 index b6c77bb..0000000 --- a/elpa/cider-20160927.2135/nrepl-dict.el +++ /dev/null @@ -1,187 +0,0 @@ -;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2016 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 functions to interact with and create `nrepl-dict's. These are -;; simply plists with an extra element at the head. - -;;; Code: -(require 'cl-lib) - - -(defun nrepl-dict (&rest key-vals) - "Create nREPL dict from KEY-VALS." - (cons 'dict key-vals)) - -(defun nrepl-dict-p (object) - "Return t if OBJECT is an nREPL dict." - (and (listp object) - (eq (car object) 'dict))) - -(defun nrepl-dict-empty-p (dict) - "Return t if nREPL dict DICT is empty." - (null (cdr dict))) - -(defun nrepl-dict-contains (dict key) - "Return nil if nREPL dict DICT doesn't contain KEY. -If DICT does contain KEY, then a non-nil value is returned. Due to the -current implementation, this return value is the tail of DICT's key-list -whose car is KEY. Comparison is done with `equal'." - (member key (nrepl-dict-keys dict))) - -(defun nrepl-dict-get (dict key &optional default) - "Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT. -If dict is nil, return nil. If DEFAULT not provided, and KEY not in DICT, -return nil. If DICT is not an nREPL dict object, an error is thrown." - (when dict - (if (nrepl-dict-p dict) - (if (nrepl-dict-contains dict key) - (lax-plist-get (cdr dict) key) - default) - (error "Not an nREPL dict object: %s" dict)))) - -(defun nrepl-dict-put (dict key value) - "Associate in DICT, KEY to VALUE. -Return new dict. Dict is modified by side effects." - (if (null dict) - (list '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)) - dict))) - -(defun nrepl-dict-keys (dict) - "Return all the keys in the nREPL DICT." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (car l)) - (error "Not an nREPL dict"))) - -(defun nrepl-dict-vals (dict) - "Return all the values in the nREPL DICT." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (cadr l)) - (error "Not an nREPL dict"))) - -(defun nrepl-dict-map (fn dict) - "Map FN on nREPL DICT. -FN must accept two arguments key and value." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (funcall fn (car l) (cadr l))) - (error "Not an nREPL dict"))) - -(defun nrepl-dict-merge (dict1 dict2) - "Destructively merge DICT2 into DICT1. -Keys in DICT2 override those in DICT1." - (let ((base (or dict1 '(dict)))) - (nrepl-dict-map (lambda (k v) - (nrepl-dict-put base k v)) - (or dict2 '(dict))) - base)) - -(defun nrepl-dict-get-in (dict keys) - "Return the value in a nested DICT. -KEYS is a list of keys. Return nil if any of the keys is not present or if -any of the values is nil." - (let ((out dict)) - (while (and keys out) - (setq out (nrepl-dict-get out (pop keys)))) - out)) - -(defun nrepl-dict-flat-map (function dict) - "Map FUNCTION over DICT and flatten the result. -FUNCTION follows the same restrictions as in `nrepl-dict-map', and it must -also alway return a sequence (since the result will be flattened)." - (when dict - (apply #'append (nrepl-dict-map function dict)))) - - -;;; More specific functions -(defun nrepl--cons (car list-or-dict) - "Generic cons of CAR to LIST-OR-DICT." - (if (eq (car list-or-dict) 'dict) - (cons 'dict (cons car (cdr list-or-dict))) - (cons car list-or-dict))) - -(defun nrepl--nreverse (list-or-dict) - "Generic `nreverse' which works on LIST-OR-DICT." - (if (eq (car list-or-dict) 'dict) - (cons 'dict (nreverse (cdr list-or-dict))) - (nreverse list-or-dict))) - -(defun nrepl--push (obj stack) - "Cons OBJ to the top element of the STACK." - ;; stack is assumed to be a list - (if (eq (caar stack) 'dict) - (cons (cons 'dict (cons obj (cdar stack))) - (cdr stack)) - (cons (if (null stack) - obj - (cons obj (car stack))) - (cdr stack)))) - -(defun nrepl--merge (dict1 dict2 &optional no-join) - "Join nREPL dicts DICT1 and DICT2 in a meaningful way. -String values for non \"id\" and \"session\" keys are concatenated. Lists -are appended. nREPL dicts merged recursively. All other objects are -accumulated into a list. DICT1 is modified destructively and -then returned. -If NO-JOIN is given, return the first non nil dict." - (if no-join - (or dict1 dict2) - (cond ((null dict1) dict2) - ((null dict2) dict1) - ((stringp dict1) (concat dict1 dict2)) - ((nrepl-dict-p dict1) - (nrepl-dict-map - (lambda (k2 v2) - (nrepl-dict-put dict1 k2 - (nrepl--merge (nrepl-dict-get dict1 k2) v2 - (member k2 '("id" "session"))))) - dict2) - dict1) - ((and (listp dict2) (listp dict1)) (append dict1 dict2)) - ((listp dict1) (append dict1 (list dict2))) - (t (list dict1 dict2))))) - - -;;; Dbind -(defmacro nrepl-dbind-response (response keys &rest body) - "Destructure an nREPL RESPONSE dict. -Bind the value of the provided KEYS and execute BODY." - (declare (debug (form (&rest symbolp) body))) - `(let ,(cl-loop for key in keys - collect `(,key (nrepl-dict-get ,response ,(format "%s" key)))) - ,@body)) -(put 'nrepl-dbind-response 'lisp-indent-function 2) - -(provide 'nrepl-dict) - -;;; nrepl-dict.el ends here diff --git a/elpa/clojure-mode-20161004.2314/clojure-mode-autoloads.el b/elpa/clojure-mode-20161004.2314/clojure-mode-autoloads.el deleted file mode 100644 index f3b7fc0..0000000 --- a/elpa/clojure-mode-20161004.2314/clojure-mode-autoloads.el +++ /dev/null @@ -1,121 +0,0 @@ -;;; clojure-mode-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) - -;;;### (autoloads nil "clojure-mode" "clojure-mode.el" (22516 57909 -;;;;;; 485546 83000)) -;;; Generated autoloads from clojure-mode.el - -(autoload 'clojure-mode "clojure-mode" "\ -Major mode for editing Clojure code. - -\\{clojure-mode-map} - -\(fn)" t nil) - -(autoload 'clojure-unwind "clojure-mode" "\ -Unwind thread at point or above point by one level. -Return nil if there are no more levels to unwind. - -\(fn)" t nil) - -(autoload 'clojure-unwind-all "clojure-mode" "\ -Fully unwind thread at point or above point. - -\(fn)" t nil) - -(autoload 'clojure-thread "clojure-mode" "\ -Thread by one more level an existing threading macro. - -\(fn)" t nil) - -(autoload 'clojure-thread-first-all "clojure-mode" "\ -Fully thread the form at point using ->. -When BUT-LAST is passed the last expression is not threaded. - -\(fn BUT-LAST)" t nil) - -(autoload 'clojure-thread-last-all "clojure-mode" "\ -Fully thread the form at point using ->>. -When BUT-LAST is passed the last expression is not threaded. - -\(fn BUT-LAST)" t nil) - -(autoload 'clojure-cycle-privacy "clojure-mode" "\ -Make public the current private def, or vice-versa. -See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-privacy - -\(fn)" t nil) - -(autoload 'clojure-convert-collection-to-list "clojure-mode" "\ -Convert collection at (point) to list. - -\(fn)" t nil) - -(autoload 'clojure-convert-collection-to-quoted-list "clojure-mode" "\ -Convert collection at (point) to quoted list. - -\(fn)" t nil) - -(autoload 'clojure-convert-collection-to-map "clojure-mode" "\ -Convert collection at (point) to map. - -\(fn)" t nil) - -(autoload 'clojure-convert-collection-to-vector "clojure-mode" "\ -Convert collection at (point) to vector. - -\(fn)" t nil) - -(autoload 'clojure-convert-collection-to-set "clojure-mode" "\ -Convert collection at (point) to set. - -\(fn)" t nil) - -(autoload 'clojure-cycle-if "clojure-mode" "\ -Change a surrounding if to if-not, or vice-versa. - -See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-if - -\(fn)" t nil) - -(autoload 'clojurescript-mode "clojure-mode" "\ -Major mode for editing ClojureScript code. - -\\{clojurescript-mode-map} - -\(fn)" t nil) - -(autoload 'clojurec-mode "clojure-mode" "\ -Major mode for editing ClojureC code. - -\\{clojurec-mode-map} - -\(fn)" t nil) - -(autoload 'clojurex-mode "clojure-mode" "\ -Major mode for editing ClojureX code. - -\\{clojurex-mode-map} - -\(fn)" t nil) - -(add-to-list 'auto-mode-alist '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-mode)) - -(add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-mode)) - -(add-to-list 'auto-mode-alist '("\\.cljx\\'" . clojurex-mode)) - -(add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-mode)) - -(add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-mode)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; clojure-mode-autoloads.el ends here diff --git a/elpa/clojure-mode-20161004.2314/clojure-mode-pkg.el b/elpa/clojure-mode-20161004.2314/clojure-mode-pkg.el deleted file mode 100644 index 489d2e9..0000000 --- a/elpa/clojure-mode-20161004.2314/clojure-mode-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; -*- no-byte-compile: t -*- -(define-package "clojure-mode" "20161004.2314" "Major mode for Clojure code" '((emacs "24.3")) :url "http://github.com/clojure-emacs/clojure-mode" :keywords '("languages" "clojure" "clojurescript" "lisp")) diff --git a/elpa/clojure-mode-20161004.2314/clojure-mode.el b/elpa/clojure-mode-20161004.2314/clojure-mode.el deleted file mode 100644 index 3f76383..0000000 --- a/elpa/clojure-mode-20161004.2314/clojure-mode.el +++ /dev/null @@ -1,2116 +0,0 @@ -;;; clojure-mode.el --- Major mode for Clojure code -*- lexical-binding: t; -*- - -;; Copyright © 2007-2016 Jeffrey Chu, Lennart Staflin, Phil Hagelberg -;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba -;; -;; Authors: Jeffrey Chu -;; Lennart Staflin -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; URL: http://github.com/clojure-emacs/clojure-mode -;; Package-Version: 20161004.2314 -;; Keywords: languages clojure clojurescript lisp -;; Version: 5.6.0-cvs -;; Package-Requires: ((emacs "24.3")) - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides font-lock, indentation, navigation and basic refactoring for the -;; Clojure programming language (http://clojure.org). - -;; Using clojure-mode with paredit or smartparens is highly recommended. - -;; Here are some example configurations: - -;; ;; require or autoload paredit-mode -;; (add-hook 'clojure-mode-hook #'paredit-mode) - -;; ;; require or autoload smartparens -;; (add-hook 'clojure-mode-hook #'smartparens-strict-mode) - -;; See inf-clojure (http://github.com/clojure-emacs/inf-clojure) for -;; basic interaction with Clojure subprocesses. - -;; See CIDER (http://github.com/clojure-emacs/cider) for -;; better interaction with subprocesses via nREPL. - -;;; License: - -;; 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 GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Code: - - -(eval-when-compile - (defvar calculate-lisp-indent-last-sexp) - (defvar font-lock-beg) - (defvar font-lock-end) - (defvar paredit-space-for-delimiter-predicates) - (defvar paredit-version) - (defvar paredit-mode)) - -(require 'cl-lib) -(require 'imenu) -(require 'newcomment) -(require 'align) - -(declare-function lisp-fill-paragraph "lisp-mode" (&optional justify)) - -(defgroup clojure nil - "Major mode for editing Clojure code." - :prefix "clojure-" - :group 'languages - :link '(url-link :tag "Github" "https://github.com/clojure-emacs/clojure-mode") - :link '(emacs-commentary-link :tag "Commentary" "clojure-mode")) - -(defconst clojure-mode-version "5.5.2" - "The current version of `clojure-mode'.") - -(defface clojure-keyword-face - '((t (:inherit font-lock-constant-face))) - "Face used to font-lock Clojure keywords (:something)." - :package-version '(clojure-mode . "3.0.0")) - -(defface clojure-character-face - '((t (:inherit font-lock-string-face))) - "Face used to font-lock Clojure character literals." - :package-version '(clojure-mode . "3.0.0")) - -(defface clojure-interop-method-face - '((t (:inherit font-lock-preprocessor-face))) - "Face used to font-lock interop method names (camelCase)." - :package-version '(clojure-mode . "3.0.0")) - -(defcustom clojure-indent-style :always-align - "Indentation style to use for function forms and macro forms. -There are two cases of interest configured by this variable. - -- Case (A) is when at least one function argument is on the same - line as the function name. -- Case (B) is the opposite (no arguments are on the same line as - the function name). Note that the body of macros is not - affected by this variable, it is always indented by - `lisp-body-indent' (default 2) spaces. - -Note that this variable configures the indentation of function -forms (and function-like macros), it does not affect macros that -already use special indentation rules. - -The possible values for this variable are keywords indicating how -to indent function forms. - - `:always-align' - Follow the same rules as `lisp-mode'. All - args are vertically aligned with the first arg in case (A), - and vertically aligned with the function name in case (B). - For instance: - (reduce merge - some-coll) - (reduce - merge - some-coll) - - `:always-indent' - All args are indented like a macro body. - (reduce merge - some-coll) - (reduce - merge - some-coll) - - `:align-arguments' - Case (A) is indented like `lisp', and - case (B) is indented like a macro body. - (reduce merge - some-coll) - (reduce - merge - some-coll)" - :safe #'keywordp - :type '(choice (const :tag "Same as `lisp-mode'" :always-align) - (const :tag "Indent like a macro body" :always-indent) - (const :tag "Indent like a macro body unless first arg is on the same line" - :align-arguments)) - :package-version '(clojure-mode . "5.2.0")) - -(define-obsolete-variable-alias 'clojure-defun-style-default-indent - 'clojure-indent-style "5.2.0") - -(defcustom clojure-use-backtracking-indent t - "When non-nil, enable context sensitive indentation." - :type 'boolean - :safe 'booleanp) - -(defcustom clojure-max-backtracking 3 - "Maximum amount to backtrack up a list to check for context." - :type 'integer - :safe 'integerp) - -(defcustom clojure-docstring-fill-column fill-column - "Value of `fill-column' to use when filling a docstring." - :type 'integer - :safe 'integerp) - -(defcustom clojure-docstring-fill-prefix-width 2 - "Width of `fill-prefix' when filling a docstring. -The default value conforms with the de facto convention for -Clojure docstrings, aligning the second line with the opening -double quotes on the third column." - :type 'integer - :safe 'integerp) - -(defcustom clojure-omit-space-between-tag-and-delimiters '(?\[ ?\{) - "Allowed opening delimiter characters after a reader literal tag. -For example, \[ is allowed in :db/id[:db.part/user]." - :type '(set (const :tag "[" ?\[) - (const :tag "{" ?\{) - (const :tag "(" ?\() - (const :tag "\"" ?\")) - :safe (lambda (value) - (and (listp value) - (cl-every 'characterp value)))) - -(defcustom clojure-build-tool-files '("project.clj" "build.boot" "build.gradle") - "A list of files, which identify a Clojure project's root. -Out-of-the box clojure-mode understands lein, boot and gradle." - :type '(repeat string) - :package-version '(clojure-mode . "5.0.0") - :safe (lambda (value) - (and (listp value) - (cl-every 'stringp value)))) - -(defcustom clojure-refactor-map-prefix (kbd "C-c C-r") - "Clojure refactor keymap prefix." - :group 'clojure - :type 'string - :package-version '(clojure-mode . "5.6.0")) - -(defvar clojure-refactor-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-t") #'clojure-thread) - (define-key map (kbd "t") #'clojure-thread) - (define-key map (kbd "C-u") #'clojure-unwind) - (define-key map (kbd "u") #'clojure-unwind) - (define-key map (kbd "C-f") #'clojure-thread-first-all) - (define-key map (kbd "f") #'clojure-thread-first-all) - (define-key map (kbd "C-l") #'clojure-thread-last-all) - (define-key map (kbd "l") #'clojure-thread-last-all) - (define-key map (kbd "C-a") #'clojure-unwind-all) - (define-key map (kbd "a") #'clojure-unwind-all) - (define-key map (kbd "C-p") #'clojure-cycle-privacy) - (define-key map (kbd "p") #'clojure-cycle-privacy) - (define-key map (kbd "C-(") #'clojure-convert-collection-to-list) - (define-key map (kbd "(") #'clojure-convert-collection-to-list) - (define-key map (kbd "C-'") #'clojure-convert-collection-to-quoted-list) - (define-key map (kbd "'") #'clojure-convert-collection-to-quoted-list) - (define-key map (kbd "C-{") #'clojure-convert-collection-to-map) - (define-key map (kbd "{") #'clojure-convert-collection-to-map) - (define-key map (kbd "C-[") #'clojure-convert-collection-to-vector) - (define-key map (kbd "[") #'clojure-convert-collection-to-vector) - (define-key map (kbd "C-#") #'clojure-convert-collection-to-set) - (define-key map (kbd "#") #'clojure-convert-collection-to-set) - (define-key map (kbd "C-i") #'clojure-cycle-if) - (define-key map (kbd "i") #'clojure-cycle-if) - (define-key map (kbd "n i") #'clojure-insert-ns-form) - (define-key map (kbd "n h") #'clojure-insert-ns-form-at-point) - (define-key map (kbd "n u") #'clojure-update-ns) - (define-key map (kbd "n s") #'clojure-sort-ns)) - "Keymap for Clojure refactoring commands.") -(fset 'clojure-refactor-map clojure-refactor-map) - -(defvar clojure-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-:") #'clojure-toggle-keyword-string) - (define-key map (kbd "C-c SPC") #'clojure-align) - (define-key map clojure-refactor-map-prefix 'clojure-refactor-map) - (easy-menu-define clojure-mode-menu map "Clojure Mode Menu" - '("Clojure" - ["Toggle between string & keyword" clojure-toggle-keyword-string] - ["Align expression" clojure-align] - ["Cycle privacy" clojure-cycle-privacy] - ["Cycle if, if-not" clojure-cycle-if] - ("ns forms" - ["Insert ns form at the top" clojure-insert-ns-form] - ["Insert ns form here" clojure-insert-ns-form-at-point] - ["Update ns form" clojure-update-ns] - ["Sort ns form" clojure-sort-ns]) - ("Convert collection" - ["Convert to list" clojure-convert-collection-to-list] - ["Convert to quoted list" clojure-convert-collection-to-quoted-list] - ["Convert to map" clojure-convert-collection-to-map] - ["Convert to vector" clojure-convert-collection-to-vector] - ["Convert to set" clojure-convert-collection-to-set]) - ("Refactor -> and ->>" - ["Thread once more" clojure-thread] - ["Fully thread a form with ->" clojure-thread-first-all] - ["Fully thread a form with ->>" clojure-thread-last-all] - "--" - ["Unwind once" clojure-unwind] - ["Fully unwind a threading macro" clojure-unwind-all]) - ("Documentation" - ["View a Clojure guide" clojure-view-guide] - ["View a Clojure reference section" clojure-view-reference-section] - ["View the Clojure cheatsheet" clojure-view-cheatsheet] - ["View the Clojure Grimoire" clojure-view-grimoire] - ["View the Clojure style guide" clojure-view-style-guide]) - "--" - ["Report a clojure-mode bug" clojure-mode-report-bug] - ["Clojure-mode version" clojure-mode-display-version])) - map) - "Keymap for Clojure mode.") - -(defvar clojure-mode-syntax-table - (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) - (modify-syntax-entry ?\{ "(}" table) - (modify-syntax-entry ?\} "){" table) - (modify-syntax-entry ?\[ "(]" table) - (modify-syntax-entry ?\] ")[" table) - (modify-syntax-entry ?? "_ p" table) ; ? is a prefix outside symbols - (modify-syntax-entry ?# "_ p" table) ; # is allowed inside keywords (#399) - (modify-syntax-entry ?~ "'" table) - (modify-syntax-entry ?^ "'" table) - (modify-syntax-entry ?@ "'" table) - table) - "Syntax table for Clojure mode. -Inherits from `emacs-lisp-mode-syntax-table'.") - -(defconst clojure--prettify-symbols-alist - '(("fn" . ?λ))) - -(defvar-local clojure-expected-ns-function nil - "The function used to determine the expected namespace of a file. -`clojure-mode' ships a basic function named `clojure-expected-ns' -that does basic heuristics to figure this out. -CIDER provides a more complex version which does classpath analysis.") - -(defun clojure-mode-display-version () - "Display the current `clojure-mode-version' in the minibuffer." - (interactive) - (message "clojure-mode (version %s)" clojure-mode-version)) - -(defconst clojure-mode-report-bug-url "https://github.com/clojure-emacs/clojure-mode/issues/new" - "The URL to report a clojure-mode issue.") - -(defun clojure-mode-report-bug () - "Report a bug in your default browser." - (interactive) - (browse-url clojure-mode-report-bug-url)) - -(defconst clojure-guides-base-url "https://clojure.org/guides/" - "The base URL for official Clojure guides.") - -(defconst clojure-guides '(("Getting Started" . "getting_started") - ("FAQ" . "faq") - ("spec" . "spec") - ("Destructuring" . "destructuring") - ("Threading Macros" . "threading_macros") - ("Comparators" . "comparators") - ("Reader Conditionals" . "reader_conditionals")) - "A list of all official Clojure guides.") - -(defun clojure-view-guide () - "Open a Clojure guide in your default browser. - -The command will prompt you to select one of the available guides." - (interactive) - (let ((guide (completing-read "Select a guide: " (mapcar #'car clojure-guides)))) - (when guide - (let ((guide-url (concat clojure-guides-base-url (cdr (assoc guide clojure-guides))))) - (browse-url guide-url))))) - -(defconst clojure-reference-base-url "https://clojure.org/reference/" - "The base URL for the official Clojure reference.") - -(defconst clojure-reference-sections '(("The Reader" . "reader") - ("The REPL and main" . "repl_and_main") - ("Evaluation" . "evaluation") - ("Special Forms" . "special_forms") - ("Macros" . "macros") - ("Other Functions" . "other_functions") - ("Data Structures" . "data_structures") - ("Datatypes" . "datatypes") - ("Sequences" . "sequences") - ("Transients" . "transients") - ("Transducers" . "transducers") - ("Multimethods and Hierarchies" . "multimethods") - ("Protocols" . "protocols") - ("Metadata" . "metadata") - ("Namespaces" . "namespaces") - ("Libs" . "libs") - ("Vars and Environments" . "vars") - ("Refs and Transactions" . "refs") - ("Agents" . "agents") - ("Atoms" . "atoms") - ("Reducers" . "reducers") - ("Java Interop" . "java_interop") - ("Compilation and Class Generation" . "compilation") - ("Other Libraries" . "other_libraries") - ("Differences with Lisps" . "lisps"))) - -(defun clojure-view-reference-section () - "Open a Clojure reference section in your default browser. - -The command will prompt you to select one of the available sections." - (interactive) - (let ((section (completing-read "Select a reference section: " (mapcar #'car clojure-reference-sections)))) - (when section - (let ((section-url (concat clojure-reference-base-url (cdr (assoc section clojure-reference-sections))))) - (browse-url section-url))))) - -(defconst clojure-cheatsheet-url "http://clojure.org/api/cheatsheet" - "The URL of the official Clojure cheatsheet.") - -(defun clojure-view-cheatsheet () - "Open the Clojure cheatsheet in your default browser." - (interactive) - (browse-url clojure-cheatsheet-url)) - -(defconst clojure-grimoire-url "https://www.conj.io/" - "The URL of the Grimoire community documentation site.") - -(defun clojure-view-grimoire () - "Open the Clojure Grimoire in your default browser." - (interactive) - (browse-url clojure-grimoire-url)) - -(defconst clojure-style-guide-url "https://github.com/bbatsov/clojure-style-guide" - "The URL of the Clojure style guide.") - -(defun clojure-view-style-guide () - "Open the Clojure style guide in your default browser." - (interactive) - (browse-url clojure-style-guide-url)) - -(defun clojure-space-for-delimiter-p (endp delim) - "Prevent paredit from inserting useless spaces. -See `paredit-space-for-delimiter-predicates' for the meaning of -ENDP and DELIM." - (or endp - (not (memq delim '(?\" ?{ ?\( ))) - (not (or (derived-mode-p 'clojure-mode) - (derived-mode-p 'cider-repl-mode))) - (save-excursion - (backward-char) - (cond ((eq (char-after) ?#) - (and (not (bobp)) - (or (char-equal ?w (char-syntax (char-before))) - (char-equal ?_ (char-syntax (char-before)))))) - ((and (eq delim ?\() - (eq (char-after) ??) - (eq (char-before) ?#)) - nil) - (t))))) - -(defun clojure-no-space-after-tag (endp delimiter) - "Prevent inserting a space after a reader-literal tag? - -When a reader-literal tag is followed be an opening delimiter -listed in `clojure-omit-space-between-tag-and-delimiters', this -function returns t. - -This allows you to write things like #db/id[:db.part/user] -without inserting a space between the tag and the opening -bracket. - -See `paredit-space-for-delimiter-predicates' for the meaning of -ENDP and DELIMITER." - (if endp - t - (or (not (member delimiter clojure-omit-space-between-tag-and-delimiters)) - (save-excursion - (let ((orig-point (point))) - (not (and (re-search-backward - "#\\([a-zA-Z0-9._-]+/\\)?[a-zA-Z0-9._-]+" - (line-beginning-position) - t) - (= orig-point (match-end 0))))))))) - -(declare-function paredit-open-curly "ext:paredit") -(declare-function paredit-close-curly "ext:paredit") - -(defun clojure-paredit-setup (&optional keymap) - "Make \"paredit-mode\" play nice with `clojure-mode'. - -If an optional KEYMAP is passed the changes are applied to it, -instead of to `clojure-mode-map'." - (when (>= paredit-version 21) - (let ((keymap (or keymap clojure-mode-map))) - (define-key keymap "{" #'paredit-open-curly) - (define-key keymap "}" #'paredit-close-curly)) - (add-to-list 'paredit-space-for-delimiter-predicates - #'clojure-space-for-delimiter-p) - (add-to-list 'paredit-space-for-delimiter-predicates - #'clojure-no-space-after-tag))) - -(defun clojure-mode-variables () - "Set up initial buffer-local variables for Clojure mode." - (add-to-list 'imenu-generic-expression '(nil clojure-match-next-def 0)) - (setq-local indent-tabs-mode nil) - (setq-local paragraph-ignore-fill-prefix t) - (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\)\\|(") - (setq-local outline-level 'lisp-outline-level) - (setq-local comment-start ";") - (setq-local comment-start-skip ";+ *") - (setq-local comment-add 1) ; default to `;;' in comment-region - (setq-local comment-column 40) - (setq-local comment-use-syntax t) - (setq-local multibyte-syntax-as-symbol t) - (setq-local electric-pair-skip-whitespace 'chomp) - (setq-local electric-pair-open-newline-between-pairs nil) - (setq-local fill-paragraph-function #'clojure-fill-paragraph) - (setq-local adaptive-fill-function #'clojure-adaptive-fill-function) - (setq-local normal-auto-fill-function #'clojure-auto-fill-function) - (setq-local comment-start-skip - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") - (setq-local indent-line-function #'clojure-indent-line) - (setq-local indent-region-function #'clojure-indent-region) - (setq-local lisp-indent-function #'clojure-indent-function) - (setq-local lisp-doc-string-elt-property 'clojure-doc-string-elt) - (setq-local clojure-expected-ns-function #'clojure-expected-ns) - (setq-local parse-sexp-ignore-comments t) - (setq-local prettify-symbols-alist clojure--prettify-symbols-alist) - (setq-local open-paren-in-column-0-is-defun-start nil)) - -;;;###autoload -(define-derived-mode clojure-mode prog-mode "Clojure" - "Major mode for editing Clojure code. - -\\{clojure-mode-map}" - (clojure-mode-variables) - (clojure-font-lock-setup) - (add-hook 'paredit-mode-hook #'clojure-paredit-setup)) - -(defcustom clojure-verify-major-mode t - "If non-nil, warn when activating the wrong major-mode." - :type 'boolean - :safe #'booleanp - :package-version '(clojure-mode "5.3.0")) - -(defun clojure--check-wrong-major-mode () - "Check if the current major-mode matches the file extension. -If it doesn't, issue a warning if `clojure-verify-major-mode' is -non-nil." - (when (and clojure-verify-major-mode - (stringp (buffer-file-name))) - (let* ((case-fold-search t) - (problem (cond ((and (string-match "\\.clj\\'" (buffer-file-name)) - (not (eq major-mode 'clojure-mode))) - 'clojure-mode) - ((and (string-match "\\.cljs\\'" (buffer-file-name)) - (not (eq major-mode 'clojurescript-mode))) - 'clojurescript-mode) - ((and (string-match "\\.cljc\\'" (buffer-file-name)) - (not (eq major-mode 'clojurec-mode))) - 'clojurec-mode) - ((and (string-match "\\.cljx\\'" (buffer-file-name)) - (not (eq major-mode 'clojurex-mode))) - 'clojurex-mode)))) - (when problem - (message "[WARNING] %s activated `%s' instead of `%s' in this buffer. -This could cause problems. -\(See `clojure-verify-major-mode' to disable this message.)" - (if (eq major-mode real-this-command) - "You have" - "Something in your configuration") - major-mode - problem))))) - -(add-hook 'clojure-mode-hook #'clojure--check-wrong-major-mode) - -(defsubst clojure-in-docstring-p () - "Check whether point is in a docstring." - (eq (get-text-property (point) 'face) 'font-lock-doc-face)) - -(defsubst clojure-docstring-fill-prefix () - "The prefix string used by `clojure-fill-paragraph'. - -It is simply `clojure-docstring-fill-prefix-width' number of spaces." - (make-string clojure-docstring-fill-prefix-width ? )) - -(defun clojure-adaptive-fill-function () - "Clojure adaptive fill function. -This only takes care of filling docstring correctly." - (when (clojure-in-docstring-p) - (clojure-docstring-fill-prefix))) - -(defun clojure-fill-paragraph (&optional justify) - "Like `fill-paragraph', but can handle Clojure docstrings. - -If JUSTIFY is non-nil, justify as well as fill the paragraph." - (if (clojure-in-docstring-p) - (let ((paragraph-start - (concat paragraph-start - "\\|\\s-*\\([(;:\"[]\\|~@\\|`(\\|#'(\\)")) - (paragraph-separate - (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) - (fill-column (or clojure-docstring-fill-column fill-column)) - (fill-prefix (clojure-docstring-fill-prefix))) - (fill-paragraph justify)) - (let ((paragraph-start (concat paragraph-start - "\\|\\s-*\\([(;:\"[]\\|`(\\|#'(\\)")) - (paragraph-separate - (concat paragraph-separate "\\|\\s-*\".*[,\\.[]$"))) - (or (fill-comment-paragraph justify) - (fill-paragraph justify)) - ;; Always return `t' - t))) - -(defun clojure-auto-fill-function () - "Clojure auto-fill function." - ;; Check if auto-filling is meaningful. - (let ((fc (current-fill-column))) - (when (and fc (> (current-column) fc)) - (let ((fill-column (if (clojure-in-docstring-p) - clojure-docstring-fill-column - fill-column)) - (fill-prefix (clojure-adaptive-fill-function))) - (do-auto-fill))))) - - -;;; #_ comments font-locking -;; Code heavily borrowed from Slime. -;; https://github.com/slime/slime/blob/master/contrib/slime-fontifying-fu.el#L186 -(defvar clojure--comment-macro-regexp - (rx "#_" (* " ") (group-n 1 (not (any " ")))) - "Regexp matching the start of a comment sexp. -The beginning of match-group 1 should be before the sexp to be -marked as a comment. The end of sexp is found with -`clojure-forward-logical-sexp'. - -By default, this only applies to code after the `#_' reader -macro. In order to also font-lock the `(comment ...)' macro as a -comment, you can set the value to: - \"#_ *\\\\(?1:[^ ]\\\\)\\\\|\\\\(?1:(comment\\\\_>\\\\)\"") - -(defun clojure--search-comment-macro-internal (limit) - (when (search-forward-regexp clojure--comment-macro-regexp limit t) - (let* ((md (match-data)) - (start (match-beginning 1)) - (state (syntax-ppss start))) - ;; inside string or comment? - (if (or (nth 3 state) - (nth 4 state)) - (clojure--search-comment-macro-internal limit) - (goto-char start) - (clojure-forward-logical-sexp 1) - ;; Data for (match-end 1). - (setf (elt md 3) (point)) - (set-match-data md) - t)))) - -(defun clojure--search-comment-macro (limit) - "Find comment macros and set the match data. -Search from point up to LIMIT. The region that should be -considered a comment is between `(match-beginning 1)' -and `(match-end 1)'." - (let ((result 'retry)) - (while (and (eq result 'retry) (<= (point) limit)) - (condition-case nil - (setq result (clojure--search-comment-macro-internal limit)) - (end-of-file (setq result nil)) - (scan-error (setq result 'retry)))) - result)) - - -;;; General font-locking -(defun clojure-match-next-def () - "Scans the buffer backwards for the next \"top-level\" definition. -Called by `imenu--generic-function'." - ;; we have to take into account namespace-definition forms - ;; e.g. s/defn - (when (re-search-backward "^(\\([a-z0-9.-]+/\\)?def\\sw*" nil t) - (save-excursion - (let (found? - (start (point))) - (down-list) - (forward-sexp) - (while (not found?) - (forward-sexp) - (or (if (char-equal ?[ (char-after (point))) - (backward-sexp)) - (if (char-equal ?) (char-after (point))) - (backward-sexp))) - (cl-destructuring-bind (def-beg . def-end) (bounds-of-thing-at-point 'sexp) - (if (char-equal ?^ (char-after def-beg)) - (progn (forward-sexp) (backward-sexp)) - (setq found? t) - (set-match-data (list def-beg def-end))))) - (goto-char start))))) - -(eval-and-compile - (defconst clojure--sym-forbidden-rest-chars "][\";\'@\\^`~\(\)\{\}\\,\s\t\n\r" - "A list of chars that a Clojure symbol cannot contain. -See definition of 'macros': URL `http://git.io/vRGLD'.") - (defconst clojure--sym-forbidden-1st-chars (concat clojure--sym-forbidden-rest-chars "0-9:") - "A list of chars that a Clojure symbol cannot start with. -See the for-loop: URL `http://git.io/vRGTj' lines: URL -`http://git.io/vRGIh', URL `http://git.io/vRGLE' and value -definition of 'macros': URL `http://git.io/vRGLD'.") - (defconst clojure--sym-regexp - (concat "[^" clojure--sym-forbidden-1st-chars "][^" clojure--sym-forbidden-rest-chars "]*") - "A regexp matching a Clojure symbol or namespace alias. -Matches the rule `clojure--sym-forbidden-1st-chars' followed by -any number of matches of `clojure--sym-forbidden-rest-chars'.")) - -(defconst clojure-font-lock-keywords - (eval-when-compile - `( ;; Top-level variable definition - (,(concat "(\\(?:clojure.core/\\)?\\(" - (regexp-opt '("def" "defonce")) - ;; variable declarations - "\\)\\>" - ;; Any whitespace - "[ \r\n\t]*" - ;; Possibly type or metadata - "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" - "\\(\\sw+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-variable-name-face nil t)) - ;; Type definition - (,(concat "(\\(?:clojure.core/\\)?\\(" - (regexp-opt '("defstruct" "deftype" "defprotocol" - "defrecord")) - ;; type declarations - "\\)\\>" - ;; Any whitespace - "[ \r\n\t]*" - ;; Possibly type or metadata - "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" - "\\(\\sw+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-type-face nil t)) - ;; Function definition (anything that starts with def and is not - ;; listed above) - (,(concat "(\\(?:" clojure--sym-regexp "/\\)?" - "\\(def[^ \r\n\t]*\\)" - ;; Function declarations - "\\>" - ;; Any whitespace - "[ \r\n\t]*" - ;; Possibly type or metadata - "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" - "\\(\\sw+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-function-name-face nil t)) - ;; (fn name? args ...) - (,(concat "(\\(?:clojure.core/\\)?\\(fn\\)[ \t]+" - ;; Possibly type - "\\(?:#?^\\sw+[ \t]*\\)?" - ;; Possibly name - "\\(\\sw+\\)?" ) - (1 font-lock-keyword-face) - (2 font-lock-function-name-face nil t)) - ;; lambda arguments - %, %&, %1, %2, etc - ("\\<%[&1-9]?" (0 font-lock-variable-name-face)) - ;; Special forms - (,(concat - "(" - (regexp-opt - '("def" "do" "if" "let" "let*" "var" "fn" "fn*" "loop" "loop*" - "recur" "throw" "try" "catch" "finally" - "set!" "new" "." - "monitor-enter" "monitor-exit" "quote") t) - "\\>") - 1 font-lock-keyword-face) - ;; Built-in binding and flow of control forms - (,(concat - "(\\(?:clojure.core/\\)?" - (regexp-opt - '("letfn" "case" "cond" "cond->" "cond->>" "condp" - "for" "when" "when-not" "when-let" "when-first" "when-some" - "if-let" "if-not" "if-some" - ".." "->" "->>" "as->" "doto" "and" "or" - "dosync" "doseq" "dotimes" "dorun" "doall" - "ns" "in-ns" - "with-open" "with-local-vars" "binding" - "with-redefs" "with-redefs-fn" - "declare") t) - "\\>") - 1 font-lock-keyword-face) - ;; Macros similar to let, when, and while - (,(rx symbol-start - (or "let" "when" "while") "-" - (1+ (or (syntax word) (syntax symbol))) - symbol-end) - 0 font-lock-keyword-face) - (,(concat - "\\<" - (regexp-opt - '("*1" "*2" "*3" "*agent*" - "*allow-unresolved-vars*" "*assert*" "*clojure-version*" - "*command-line-args*" "*compile-files*" - "*compile-path*" "*data-readers*" "*default-data-reader-fn*" - "*e" "*err*" "*file*" "*flush-on-newline*" - "*in*" "*macro-meta*" "*math-context*" "*ns*" "*out*" - "*print-dup*" "*print-length*" "*print-level*" - "*print-meta*" "*print-readably*" - "*read-eval*" "*source-path*" - "*unchecked-math*" - "*use-context-classloader*" "*warn-on-reflection*") - t) - "\\>") - 0 font-lock-builtin-face) - ;; Dynamic variables - *something* or @*something* - ("\\(?:\\<\\|/\\)@?\\(\\*[a-z-]*\\*\\)\\>" 1 font-lock-variable-name-face) - ;; Global constants - nil, true, false - (,(concat - "\\<" - (regexp-opt - '("true" "false" "nil") t) - "\\>") - 0 font-lock-constant-face) - ;; Character literals - \1, \a, \newline, \u0000 - ("\\\\\\([[:punct:]]\\|[a-z0-9]+\\>\\)" 0 'clojure-character-face) - ;; foo/ Foo/ @Foo/ /FooBar - (,(concat "\\(?:\\<:?\\|\\.\\)@?\\(" clojure--sym-regexp "\\)\\(/\\)") - (1 font-lock-type-face) (2 'default)) - ;; Constant values (keywords), including as metadata e.g. ^:static - ("\\<^?\\(:\\(\\sw\\|\\s_\\)+\\(\\>\\|\\_>\\)\\)" 1 'clojure-keyword-face append) - ;; Java interop highlighting - ;; CONST SOME_CONST (optionally prefixed by /) - ("\\(?:\\<\\|/\\)\\([A-Z]+\\|\\([A-Z]+_[A-Z1-9_]+\\)\\)\\>" 1 font-lock-constant-face) - ;; .foo .barBaz .qux01 .-flibble .-flibbleWobble - ("\\<\\.-?[a-z][a-zA-Z0-9]*\\>" 0 'clojure-interop-method-face) - ;; Foo Bar$Baz Qux_ World_OpenUDP Foo. Babylon15. - ("\\(?:\\<\\|\\.\\|/\\|#?^\\)\\([A-Z][a-zA-Z0-9_]*[a-zA-Z0-9$_]+\\.?\\>\\)" 1 font-lock-type-face) - ;; foo.bar.baz - ("\\<^?\\([a-z][a-z0-9_-]+\\.\\([a-z][a-z0-9_-]*\\.?\\)+\\)" 1 font-lock-type-face) - ;; (ns namespace) - special handling for single segment namespaces - (,(concat "(\\[ \r\n\t]*" - ;; Possibly metadata - "\\(?:\\^?{[^}]+}[ \r\n\t]*\\)*" - ;; namespace - "\\([a-z0-9-]+\\)") - (1 font-lock-type-face nil t)) - ;; fooBar - ("\\(?:\\<\\|/\\)\\([a-z]+[A-Z]+[a-zA-Z0-9$]*\\>\\)" 1 'clojure-interop-method-face) - ;; #_ and (comment ...) macros. - (clojure--search-comment-macro 1 font-lock-comment-face t) - ;; Highlight `code` marks, just like `elisp'. - (,(rx "`" (group-n 1 (optional "#'") - (+ (or (syntax symbol) (syntax word)))) "`") - (1 'font-lock-constant-face prepend)) - ;; Highlight escaped characters in strings. - (clojure-font-lock-escaped-chars 0 'bold prepend) - ;; Highlight grouping constructs in regular expressions - (clojure-font-lock-regexp-groups - (1 'font-lock-regexp-grouping-construct prepend)))) - "Default expressions to highlight in Clojure mode.") - -(defun clojure-font-lock-syntactic-face-function (state) - "Find and highlight text with a Clojure-friendly syntax table. - -This function is passed to `font-lock-syntactic-face-function', -which is called with a single parameter, STATE (which is, in -turn, returned by `parse-partial-sexp' at the beginning of the -highlighted region)." - (if (nth 3 state) - ;; This might be a (doc)string or a |...| symbol. - (let ((startpos (nth 8 state))) - (if (eq (char-after startpos) ?|) - ;; This is not a string, but a |...| symbol. - nil - (let* ((listbeg (nth 1 state)) - (firstsym (and listbeg - (save-excursion - (goto-char listbeg) - (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") - (match-string 1))))) - (docelt (and firstsym - (function-get (intern-soft firstsym) - lisp-doc-string-elt-property)))) - (if (and docelt - ;; It's a string in a form that can have a docstring. - ;; Check whether it's in docstring position. - (save-excursion - (when (functionp docelt) - (goto-char (match-end 1)) - (setq docelt (funcall docelt))) - (goto-char listbeg) - (forward-char 1) - (condition-case nil - (while (and (> docelt 0) (< (point) startpos) - (progn (forward-sexp 1) t)) - ;; ignore metadata and type hints - (unless (looking-at "[ \n\t]*\\(\\^[A-Z:].+\\|\\^?{.+\\)") - (setq docelt (1- docelt)))) - (error nil)) - (and (zerop docelt) (<= (point) startpos) - (progn (forward-comment (point-max)) t) - (= (point) (nth 8 state))))) - font-lock-doc-face - font-lock-string-face)))) - font-lock-comment-face)) - -(defun clojure-font-lock-setup () - "Configures font-lock for editing Clojure code." - (setq-local font-lock-multiline t) - (add-to-list 'font-lock-extend-region-functions - #'clojure-font-lock-extend-region-def t) - (setq font-lock-defaults - '(clojure-font-lock-keywords ; keywords - nil nil - (("+-*/.<>=!?$%_&:" . "w")) ; syntax alist - nil - (font-lock-mark-block-function . mark-defun) - (font-lock-syntactic-face-function - . clojure-font-lock-syntactic-face-function)))) - -(defun clojure-font-lock-def-at-point (point) - "Range between the top-most def* and the fourth element after POINT. -Note that this means that there is no guarantee of proper font -locking in def* forms that are not at top level." - (goto-char point) - (condition-case nil - (beginning-of-defun) - (error nil)) - - (let ((beg-def (point))) - (when (and (not (= point beg-def)) - (looking-at "(def")) - (condition-case nil - (progn - ;; move forward as much as possible until failure (or success) - (forward-char) - (dotimes (_ 4) - (forward-sexp))) - (error nil)) - (cons beg-def (point))))) - -(defun clojure-font-lock-extend-region-def () - "Set region boundaries to include the first four elements of def* forms." - (let ((changed nil)) - (let ((def (clojure-font-lock-def-at-point font-lock-beg))) - (when def - (cl-destructuring-bind (def-beg . def-end) def - (when (and (< def-beg font-lock-beg) - (< font-lock-beg def-end)) - (setq font-lock-beg def-beg - changed t))))) - (let ((def (clojure-font-lock-def-at-point font-lock-end))) - (when def - (cl-destructuring-bind (def-beg . def-end) def - (when (and (< def-beg font-lock-end) - (< font-lock-end def-end)) - (setq font-lock-end def-end - changed t))))) - changed)) - -(defun clojure--font-locked-as-string-p (&optional regexp) - "Non-nil if the char before point is font-locked as a string. -If REGEXP is non-nil, also check whether current string is -preceeded by a #." - (let ((face (get-text-property (1- (point)) 'face))) - (and (or (and (listp face) - (memq 'font-lock-string-face face)) - (eq 'font-lock-string-face face)) - (or (clojure-string-start t) - (unless regexp - (clojure-string-start nil)))))) - -(defun clojure-font-lock-escaped-chars (bound) - "Highlight \escaped chars in strings. -BOUND denotes a buffer position to limit the search." - (let ((found nil)) - (while (and (not found) - (re-search-forward "\\\\." bound t)) - - (setq found (clojure--font-locked-as-string-p))) - found)) - -(defun clojure-font-lock-regexp-groups (bound) - "Highlight grouping constructs in regular expression. - -BOUND denotes the maximum number of characters (relative to the -point) to check." - (let ((found nil)) - (while (and (not found) - (re-search-forward (eval-when-compile - (concat - ;; A group may start using several alternatives: - "\\(\\(?:" - ;; 1. (? special groups - "(\\?\\(?:" - ;; a) non-capturing group (?:X) - ;; b) independent non-capturing group (?>X) - ;; c) zero-width positive lookahead (?=X) - ;; d) zero-width negative lookahead (?!X) - "[:=!>]\\|" - ;; e) zero-width positive lookbehind (?<=X) - ;; f) zero-width negative lookbehind (?X) - "<[[:alnum:]]+>" - "\\)\\|" ;; end of special groups - ;; 2. normal capturing groups ( - ;; 3. we also highlight alternative - ;; separarators |, and closing parens ) - "[|()]" - "\\)\\)")) - bound t)) - (setq found (clojure--font-locked-as-string-p 'regexp))) - found)) - -;; Docstring positions -(put 'ns 'clojure-doc-string-elt 2) -(put 'def 'clojure-doc-string-elt 2) -(put 'defn 'clojure-doc-string-elt 2) -(put 'defn- 'clojure-doc-string-elt 2) -(put 'defmulti 'clojure-doc-string-elt 2) -(put 'defmacro 'clojure-doc-string-elt 2) -(put 'definline 'clojure-doc-string-elt 2) -(put 'defprotocol 'clojure-doc-string-elt 2) - -;;; Vertical alignment -(defcustom clojure-align-forms-automatically nil - "If non-nil, vertically align some forms automatically. -Automatically means it is done as part of indenting code. This -applies to binding forms (`clojure-align-binding-forms'), to cond -forms (`clojure-align-cond-forms') and to map literals. For -instance, selecting a map a hitting \\`\\[indent-for-tab-command]' -will align the values like this: - {:some-key 10 - :key2 20}" - :package-version '(clojure-mode . "5.1") - :safe #'booleanp - :type 'boolean) - -(defcustom clojure-align-binding-forms - '("let" "when-let" "when-some" "if-let" "if-some" "binding" "loop" - "doseq" "for" "with-open" "with-local-vars" "with-redefs") - "List of strings matching forms that have binding forms." - :package-version '(clojure-mode . "5.1") - :safe #'listp - :type '(repeat string)) - -(defcustom clojure-align-cond-forms '("condp" "cond" "cond->" "cond->>" "case" "are") - "List of strings identifying cond-like forms." - :package-version '(clojure-mode . "5.1") - :safe #'listp - :type '(repeat string)) - -(defun clojure--position-for-alignment () - "Non-nil if the sexp around point should be automatically aligned. -This function expects to be called immediately after an -open-brace or after the function symbol in a function call. - -First check if the sexp around point is a map literal, or is a -call to one of the vars listed in `clojure-align-cond-forms'. If -it isn't, return nil. If it is, return non-nil and place point -immediately before the forms that should be aligned. - -For instance, in a map literal point is left immediately before -the first key; while, in a let-binding, point is left inside the -binding vector and immediately before the first binding -construct." - ;; Are we in a map? - (or (and (eq (char-before) ?{) - (not (eq (char-before (1- (point))) ?\#))) - ;; Are we in a cond form? - (let* ((fun (car (member (thing-at-point 'symbol) clojure-align-cond-forms))) - (method (and fun (clojure--get-indent-method fun))) - ;; The number of special arguments in the cond form is - ;; the number of sexps we skip before aligning. - (skip (cond ((numberp method) method) - ((null method) 0) - ((sequencep method) (elt method 0))))) - (when (and fun (numberp skip)) - (clojure-forward-logical-sexp skip) - (comment-forward (point-max)) - fun)) ; Return non-nil (the var name). - ;; Are we in a let-like form? - (when (member (thing-at-point 'symbol) - clojure-align-binding-forms) - ;; Position inside the binding vector. - (clojure-forward-logical-sexp) - (backward-sexp) - (when (eq (char-after) ?\[) - (forward-char 1) - (comment-forward (point-max)) - ;; Return non-nil. - t)))) - -(defun clojure--find-sexp-to-align (end) - "Non-nil if there's a sexp ahead to be aligned before END. -Place point as in `clojure--position-for-alignment'." - ;; Look for a relevant sexp. - (let ((found)) - (while (and (not found) - (search-forward-regexp - (concat "{\\|(" (regexp-opt - (append clojure-align-binding-forms - clojure-align-cond-forms) - 'symbols)) - end 'noerror)) - - (let ((ppss (syntax-ppss))) - ;; If we're in a string or comment. - (unless (or (elt ppss 3) - (elt ppss 4)) - ;; Only stop looking if we successfully position - ;; the point. - (setq found (clojure--position-for-alignment))))) - found)) - -(defun clojure--search-whitespace-after-next-sexp (&optional bound _noerror) - "Move point after all whitespace after the next sexp. -Set the match data group 1 to be this region of whitespace and -return point." - (unwind-protect - (ignore-errors - (clojure-forward-logical-sexp 1) - (search-forward-regexp "\\([,\s\t]*\\)" bound) - (pcase (syntax-after (point)) - ;; End-of-line, try again on next line. - (`(12) (clojure--search-whitespace-after-next-sexp bound)) - ;; Closing paren, stop here. - (`(5 . ,_) nil) - ;; Anything else is something to align. - (_ (point)))) - (when (and bound (> (point) bound)) - (goto-char bound)))) - -(defun clojure-align (beg end) - "Vertically align the contents of the sexp around point. -If region is active, align it. Otherwise, align everything in the -current \"top-level\" sexp. -When called from lisp code align everything between BEG and END." - (interactive (if (use-region-p) - (list (region-beginning) (region-end)) - (save-excursion - (let ((end (progn (end-of-defun) - (point)))) - (clojure-backward-logical-sexp) - (list (point) end))))) - (setq end (copy-marker end)) - (save-excursion - (goto-char beg) - (while (clojure--find-sexp-to-align end) - (let ((sexp-end (save-excursion - (backward-up-list) - (forward-sexp 1) - (point-marker))) - (clojure-align-forms-automatically nil) - (count 1)) - ;; For some bizarre reason, we need to `align-region' once for each - ;; group. - (save-excursion - (while (search-forward-regexp "^ *\n" sexp-end 'noerror) - (cl-incf count))) - (dotimes (_ count) - (align-region (point) sexp-end nil - '((clojure-align (regexp . clojure--search-whitespace-after-next-sexp) - (group . 1) - (separate . "^ *$") - (repeat . t))) - nil)) - ;; Reindent after aligning because of #360. - (indent-region (point) sexp-end))))) - -;;; Indentation -(defun clojure-indent-region (beg end) - "Like `indent-region', but also maybe align forms. -Forms between BEG and END are aligned according to -`clojure-align-forms-automatically'." - (prog1 (let ((indent-region-function nil)) - (indent-region beg end)) - (when clojure-align-forms-automatically - (condition-case nil - (clojure-align beg end) - (scan-error nil))))) - -(defun clojure-indent-line () - "Indent current line as Clojure code." - (if (clojure-in-docstring-p) - (save-excursion - (beginning-of-line) - (when (and (looking-at "^\\s-*") - (<= (string-width (match-string-no-properties 0)) - (string-width (clojure-docstring-fill-prefix)))) - (replace-match (clojure-docstring-fill-prefix)))) - (lisp-indent-line))) - -(defvar clojure-get-indent-function nil - "Function to get the indent spec of a symbol. -This function should take one argument, the name of the symbol as -a string. This name will be exactly as it appears in the buffer, -so it might start with a namespace alias. - -This function is analogous to the `clojure-indent-function' -symbol property, and its return value should match one of the -allowed values of this property. See `clojure-indent-function' -for more information.") - -(defun clojure--get-indent-method (function-name) - "Return the indent spec for the symbol named FUNCTION-NAME. -FUNCTION-NAME is a string. If it contains a `/', also try only -the part after the `/'. - -Look for a spec using `clojure-get-indent-function', then try the -`clojure-indent-function' and `clojure-backtracking-indent' -symbol properties." - (or (when (functionp clojure-get-indent-function) - (funcall clojure-get-indent-function function-name)) - (get (intern-soft function-name) 'clojure-indent-function) - (get (intern-soft function-name) 'clojure-backtracking-indent) - (when (string-match "/\\([^/]+\\)\\'" function-name) - (or (get (intern-soft (match-string 1 function-name)) - 'clojure-indent-function) - (get (intern-soft (match-string 1 function-name)) - 'clojure-backtracking-indent))) - (when (string-match (rx (or "let" "when" "while") (syntax symbol)) - function-name) - (clojure--get-indent-method (substring (match-string 0 function-name) 0 -1))))) - -(defvar clojure--current-backtracking-depth 0) - -(defun clojure--find-indent-spec-backtracking () - "Return the indent sexp that applies to the sexp at point. -Implementation function for `clojure--find-indent-spec'." - (when (and (>= clojure-max-backtracking clojure--current-backtracking-depth) - (not (looking-at "^"))) - (let ((clojure--current-backtracking-depth (1+ clojure--current-backtracking-depth)) - (pos 0)) - ;; Count how far we are from the start of the sexp. - (while (ignore-errors (clojure-backward-logical-sexp 1) - (not (or (bobp) - (eq (char-before) ?\n)))) - (cl-incf pos)) - (let* ((function (thing-at-point 'symbol)) - (method (or (when function ;; Is there a spec here? - (clojure--get-indent-method function)) - (ignore-errors - ;; Otherwise look higher up. - (pcase (syntax-ppss) - (`(,(pred (< 0)) ,start . ,_) - (goto-char start) - (clojure--find-indent-spec-backtracking))))))) - (when (numberp method) - (setq method (list method))) - (pcase method - ((pred functionp) - (when (= pos 0) - method)) - ((pred sequencep) - (pcase (length method) - (`0 nil) - (`1 (let ((head (elt method 0))) - (when (or (= pos 0) (sequencep head)) - head))) - (l (if (>= pos l) - (elt method (1- l)) - (elt method pos))))) - ((or `defun `:defn) - (when (= pos 0) - :defn)) - (_ - (message "Invalid indent spec for `%s': %s" function method) - nil)))))) - -(defun clojure--find-indent-spec () - "Return the indent spec that applies to current sexp. -If `clojure-use-backtracking-indent' is non-nil, also do -backtracking up to a higher-level sexp in order to find the -spec." - (if clojure-use-backtracking-indent - (save-excursion - (clojure--find-indent-spec-backtracking)) - (let ((function (thing-at-point 'symbol))) - (clojure--get-indent-method function)))) - -(defun clojure--normal-indent (last-sexp indent-mode) - "Return the normal indentation column for a sexp. -Point should be after the open paren of the _enclosing_ sexp, and -LAST-SEXP is the start of the previous sexp (immediately before -the sexp being indented). INDENT-MODE is any of the values -accepted by `clojure-indent-style'." - (goto-char last-sexp) - (forward-sexp 1) - (clojure-backward-logical-sexp 1) - (let ((last-sexp-start nil)) - (if (ignore-errors - ;; `backward-sexp' until we reach the start of a sexp that is the - ;; first of its line (the start of the enclosing sexp). - (while (string-match - "[^[:blank:]]" - (buffer-substring (line-beginning-position) (point))) - (setq last-sexp-start (prog1 (point) - (forward-sexp -1)))) - t) - ;; Here we have found an arg before the arg we're indenting which is at - ;; the start of a line. Every mode simply aligns on this case. - (current-column) - ;; Here we have reached the start of the enclosing sexp (point is now at - ;; the function name), so the behaviour depends on INDENT-MODE and on - ;; whether there's also an argument on this line (case A or B). - (let ((case-a ; The meaning of case-a is explained in `clojure-indent-style'. - (and last-sexp-start - (< last-sexp-start (line-end-position))))) - (cond - ;; For compatibility with the old `clojure-defun-style-default-indent', any - ;; value other than these 3 is equivalent to `always-body'. - ((not (memq indent-mode '(:always-align :align-arguments nil))) - (+ (current-column) lisp-body-indent -1)) - ;; There's an arg after the function name, so align with it. - (case-a (goto-char last-sexp-start) - (current-column)) - ;; Not same line. - ((eq indent-mode :align-arguments) - (+ (current-column) lisp-body-indent -1)) - ;; Finally, just align with the function name. - (t (current-column))))))) - -(defun clojure--not-function-form-p () - "Non-nil if form at point doesn't represent a function call." - (or (member (char-after) '(?\[ ?\{)) - (save-excursion ;; Catch #?@ (:cljs ...) - (skip-chars-backward "\r\n[:blank:]") - (when (eq (char-before) ?@) - (forward-char -1)) - (and (eq (char-before) ?\?) - (eq (char-before (1- (point))) ?\#))) - ;; Car of form is not a symbol. - (not (looking-at ".\\(?:\\sw\\|\\s_\\)")))) - -;; Check the general context, and provide indentation for data structures and -;; special macros. If current form is a function (or non-special macro), -;; delegate indentation to `clojure--normal-indent'. -(defun clojure-indent-function (indent-point state) - "When indenting a line within a function call, indent properly. - -INDENT-POINT is the position where the user typed TAB, or equivalent. -Point is located at the point to indent under (for default indentation); -STATE is the `parse-partial-sexp' state for that position. - -If the current line is in a call to a Clojure function with a -non-nil property `clojure-indent-function', that specifies how to do -the indentation. - -The property value can be - -- `defun', meaning indent `defun'-style; -- an integer N, meaning indent the first N arguments specially - like ordinary function arguments and then indent any further - arguments like a body; -- a function to call just as this function was called. - If that function returns nil, that means it doesn't specify - the indentation. -- a list, which is used by `clojure-backtracking-indent'. - -This function also returns nil meaning don't specify the indentation." - ;; Goto to the open-paren. - (goto-char (elt state 1)) - ;; Maps, sets, vectors and reader conditionals. - (if (clojure--not-function-form-p) - (1+ (current-column)) - ;; Function or macro call. - (forward-char 1) - (let ((method (clojure--find-indent-spec)) - (last-sexp calculate-lisp-indent-last-sexp) - (containing-form-column (1- (current-column)))) - (pcase method - ((or (pred integerp) `(,method)) - (let ((pos -1)) - (condition-case nil - (while (and (<= (point) indent-point) - (not (eobp))) - (clojure-forward-logical-sexp 1) - (cl-incf pos)) - ;; If indent-point is _after_ the last sexp in the - ;; current sexp, we detect that by catching the - ;; `scan-error'. In that case, we should return the - ;; indentation as if there were an extra sexp at point. - (scan-error (cl-incf pos))) - (cond - ;; The first non-special arg. Rigidly reduce indentation. - ((= pos (1+ method)) - (+ lisp-body-indent containing-form-column)) - ;; Further non-special args, align with the arg above. - ((> pos (1+ method)) - (clojure--normal-indent last-sexp :always-align)) - ;; Special arg. Rigidly indent with a large indentation. - (t - (+ (* 2 lisp-body-indent) containing-form-column))))) - (`:defn - (+ lisp-body-indent containing-form-column)) - ((pred functionp) - (funcall method indent-point state)) - ;; No indent spec, do the default. - (`nil - (let ((function (thing-at-point 'symbol))) - (cond - ;; Preserve useful alignment of :require (and friends) in `ns' forms. - ((and function (string-match "^:" function)) - (clojure--normal-indent last-sexp :always-align)) - ;; This is should be identical to the :defn above. - ((and function - (string-match "\\`\\(?:\\S +/\\)?\\(def[a-z]*\\|with-\\)" - function) - (not (string-match "\\`default" (match-string 1 function)))) - (+ lisp-body-indent containing-form-column)) - ;; Finally, nothing special here, just respect the user's - ;; preference. - (t (clojure--normal-indent last-sexp clojure-indent-style))))))))) - -;;; Setting indentation -(defun put-clojure-indent (sym indent) - "Instruct `clojure-indent-function' to indent the body of SYM by INDENT." - (put sym 'clojure-indent-function indent)) - -(defmacro define-clojure-indent (&rest kvs) - "Call `put-clojure-indent' on a series, KVS." - `(progn - ,@(mapcar (lambda (x) `(put-clojure-indent - (quote ,(car x)) ,(cadr x))) - kvs))) - -(defun add-custom-clojure-indents (name value) - "Allow `clojure-defun-indents' to indent user-specified macros. - -Requires the macro's NAME and a VALUE." - (custom-set-default name value) - (mapcar (lambda (x) - (put-clojure-indent x 'defun)) - value)) - -(defcustom clojure-defun-indents nil - "List of additional symbols with defun-style indentation in Clojure. - -You can use this to let Emacs indent your own macros the same way -that it indents built-in macros like with-open. This variable -only works when set via the customize interface (`setq' won't -work). To set it from Lisp code, use - (put-clojure-indent \\='some-symbol :defn)." - :type '(repeat symbol) - :set 'add-custom-clojure-indents) - -(define-clojure-indent - ;; built-ins - (ns 1) - (fn :defn) - (def :defn) - (defn :defn) - (bound-fn :defn) - (if 1) - (if-not 1) - (case 1) - (cond 0) - (condp 2) - (cond-> 1) - (cond->> 1) - (when 1) - (while 1) - (when-not 1) - (when-first 1) - (do 0) - (future 0) - (comment 0) - (doto 1) - (locking 1) - (proxy '(2 nil nil (:defn))) - (as-> 2) - - (reify '(:defn (1))) - (deftype '(2 nil nil (:defn))) - (defrecord '(2 nil nil (:defn))) - (defprotocol '(1 (:defn))) - (definterface '(1 (:defn))) - (extend 1) - (extend-protocol '(1 :defn)) - (extend-type '(1 :defn)) - ;; specify and specify! are from ClojureScript - (specify '(1 :defn)) - (specify! '(1 :defn)) - (try 0) - (catch 2) - (finally 0) - - ;; binding forms - (let 1) - (letfn '(1 ((:defn)) nil)) - (binding 1) - (loop 1) - (for 1) - (doseq 1) - (dotimes 1) - (when-let 1) - (if-let 1) - (when-some 1) - (if-some 1) - (this-as 1) ; ClojureScript - - (defmethod :defn) - - ;; clojure.test - (testing 1) - (deftest :defn) - (are 2) - (use-fixtures :defn) - - ;; core.logic - (run :defn) - (run* :defn) - (fresh :defn) - - ;; core.async - (alt! 0) - (alt!! 0) - (go 0) - (go-loop 1) - (thread 0)) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Better docstring filling for clojure-mode -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun clojure-string-start (&optional regex) - "Return the position of the \" that begins the string at point. -If REGEX is non-nil, return the position of the # that begins the -regex at point. If point is not inside a string or regex, return -nil." - (when (nth 3 (syntax-ppss)) ;; Are we really in a string? - (save-excursion - (save-match-data - ;; Find a quote that appears immediately after whitespace, - ;; beginning of line, hash, or an open paren, brace, or bracket - (re-search-backward "\\(\\s-\\|^\\|#\\|(\\|\\[\\|{\\)\\(\"\\)") - (let ((beg (match-beginning 2))) - (when beg - (if regex - (and (char-before beg) (eq ?# (char-before beg)) (1- beg)) - (when (not (eq ?# (char-before beg))) - beg)))))))) - -(defun clojure-char-at-point () - "Return the char at point or nil if at buffer end." - (when (not (= (point) (point-max))) - (buffer-substring-no-properties (point) (1+ (point))))) - -(defun clojure-char-before-point () - "Return the char before point or nil if at buffer beginning." - (when (not (= (point) (point-min))) - (buffer-substring-no-properties (point) (1- (point))))) - -(defun clojure-toggle-keyword-string () - "Convert the string or keyword at point to keyword or string." - (interactive) - (let ((original-point (point))) - (while (and (> (point) 1) - (not (equal "\"" (buffer-substring-no-properties (point) (+ 1 (point))))) - (not (equal ":" (buffer-substring-no-properties (point) (+ 1 (point)))))) - (backward-char)) - (cond - ((equal 1 (point)) - (error "Beginning of file reached, this was probably a mistake")) - ((equal "\"" (buffer-substring-no-properties (point) (+ 1 (point)))) - (insert ":" (substring (clojure-delete-and-extract-sexp) 1 -1))) - ((equal ":" (buffer-substring-no-properties (point) (+ 1 (point)))) - (insert "\"" (substring (clojure-delete-and-extract-sexp) 1) "\""))) - (goto-char original-point))) - -(defun clojure-delete-and-extract-sexp () - "Delete the surrounding sexp and return it." - (let ((begin (point))) - (forward-sexp) - (let ((result (buffer-substring begin (point)))) - (delete-region begin (point)) - result))) - - - -(defun clojure-project-dir (&optional dir-name) - "Return the absolute path to the project's root directory. - -Use `default-directory' if DIR-NAME is nil. -Return nil if not inside a project." - (let* ((dir-name (or dir-name default-directory)) - (choices (delq nil - (mapcar (lambda (fname) - (locate-dominating-file dir-name fname)) - clojure-build-tool-files)))) - (when (> (length choices) 0) - (car (sort choices #'file-in-directory-p))))) - -(defun clojure-project-relative-path (path) - "Denormalize PATH by making it relative to the project root." - (file-relative-name path (clojure-project-dir))) - - -;;; ns manipulation -(defun clojure-expected-ns (&optional path) - "Return the namespace matching PATH. - -PATH is expected to be an absolute file path. - -If PATH is nil, use the path to the file backing the current buffer." - (let* ((path (or path (file-truename (buffer-file-name)))) - (relative (clojure-project-relative-path path)) - (sans-file-type (substring relative 0 (- (length (file-name-extension path t))))) - (sans-file-sep (mapconcat 'identity (cdr (split-string sans-file-type "/")) ".")) - (sans-underscores (replace-regexp-in-string "_" "-" sans-file-sep))) - ;; Drop prefix from ns for projects with structure src/{clj,cljs,cljc} - (replace-regexp-in-string "\\`clj[scx]?\\." "" sans-underscores))) - -(defun clojure-insert-ns-form-at-point () - "Insert a namespace form at point." - (interactive) - (insert (format "(ns %s)" (funcall clojure-expected-ns-function)))) - -(defun clojure-insert-ns-form () - "Insert a namespace form at the beginning of the buffer." - (interactive) - (widen) - (goto-char (point-min)) - (clojure-insert-ns-form-at-point)) - -(defun clojure-update-ns () - "Update the namespace of the current buffer. -Useful if a file has been renamed." - (interactive) - (let ((nsname (funcall clojure-expected-ns-function))) - (when nsname - (save-excursion - (save-match-data - (if (clojure-find-ns) - (progn (replace-match nsname nil nil nil 4) - (message "ns form updated")) - (error "Namespace not found"))))))) - -(defun clojure--sort-following-sexps () - "Sort sexps between point and end of current sexp. -Comments at the start of a line are considered part of the -following sexp. Comments at the end of a line (after some other -content) are considered part of the preceding sexp." - ;; Here we're after the :require/:import symbol. - (save-restriction - (narrow-to-region (point) (save-excursion - (up-list) - (1- (point)))) - (skip-chars-forward "\r\n[:blank:]") - (sort-subr nil - (lambda () (skip-chars-forward "\r\n[:blank:]")) - ;; Move to end of current top-level thing. - (lambda () - (condition-case nil - (while t (up-list)) - (scan-error nil)) - ;; We could be inside a symbol instead of a sexp. - (unless (looking-at "\\s-\\|$") - (clojure-forward-logical-sexp)) - ;; move past comments at the end of the line. - (search-forward-regexp "$")) - ;; Move to start of ns name. - (lambda () - (comment-forward) - (skip-chars-forward "[:blank:]\n\r[(") - (clojure-forward-logical-sexp) - (forward-sexp -1) - nil) - ;; Move to end of ns name. - (lambda () - (clojure-forward-logical-sexp))) - (goto-char (point-max)) - ;; Does the last line now end in a comment? - (when (nth 4 (parse-partial-sexp (point-min) (point))) - (insert "\n")))) - -(defun clojure-sort-ns () - "Internally sort each sexp inside the ns form." - (interactive) - (comment-normalize-vars) - (if (clojure-find-ns) - (save-excursion - (goto-char (match-beginning 0)) - (redisplay) - (let ((beg (point)) - (ns)) - (forward-sexp 1) - (setq ns (buffer-substring beg (point))) - (forward-char -1) - (while (progn (forward-sexp -1) - (looking-at "(:[a-z]")) - (save-excursion - (forward-char 1) - (forward-sexp 1) - (clojure--sort-following-sexps))) - (goto-char beg) - (if (looking-at (regexp-quote ns)) - (message "ns form is already sorted") - (sleep-for 0.1) - (redisplay) - (message "ns form has been sorted") - (sleep-for 0.1)))) - (user-error "Namespace not found"))) - -(defconst clojure-namespace-name-regex - (rx line-start - "(" - (zero-or-one (group (regexp "clojure.core/"))) - (zero-or-one (submatch "in-")) - "ns" - (zero-or-one "+") - (one-or-more (any whitespace "\n")) - (zero-or-more (or (submatch (zero-or-one "#") - "^{" - (zero-or-more (not (any "}"))) - "}") - (zero-or-more "^:" - (one-or-more (not (any whitespace))))) - (one-or-more (any whitespace "\n"))) - (zero-or-one (any ":'")) ;; (in-ns 'foo) or (ns+ :user) - (group (one-or-more (not (any "()\"" whitespace))) symbol-end))) - -(defun clojure-find-ns () - "Return the namespace of the current Clojure buffer. -Return the namespace closest to point and above it. If there are -no namespaces above point, return the first one in the buffer." - (save-excursion - (save-restriction - (widen) - ;; The closest ns form above point. - (when (or (re-search-backward clojure-namespace-name-regex nil t) - ;; Or any form at all. - (and (goto-char (point-min)) - (re-search-forward clojure-namespace-name-regex nil t))) - (match-string-no-properties 4))))) - -(defconst clojure-def-type-and-name-regex - (concat "(\\(?:\\(?:\\sw\\|\\s_\\)+/\\)?" - ;; Declaration - "\\(def\\(?:\\sw\\|\\s_\\)*\\)\\>" - ;; Any whitespace - "[ \r\n\t]*" - ;; Possibly type or metadata - "\\(?:#?^\\(?:{[^}]*}\\|\\(?:\\sw\\|\\s_\\)+\\)[ \r\n\t]*\\)*" - ;; Symbol name - "\\(\\(?:\\sw\\|\\s_\\)+\\)")) - -(defun clojure-find-def () - "Find the var declaration macro and symbol name of the current form. -Returns a list pair, e.g. (\"defn\" \"abc\") or (\"deftest\" \"some-test\")." - (save-excursion - (unless (looking-at clojure-def-type-and-name-regex) - (beginning-of-defun)) - (when (search-forward-regexp clojure-def-type-and-name-regex nil t) - (list (match-string-no-properties 1) - (match-string-no-properties 2))))) - - -;;; Sexp navigation -(defun clojure--looking-at-non-logical-sexp () - "Return non-nil if sexp after point represents code. -Sexps that don't represent code are ^metadata or #reader.macros." - (comment-normalize-vars) - (comment-forward (point-max)) - (looking-at-p "\\^\\|#[?[:alpha:]]")) - -(defun clojure-forward-logical-sexp (&optional n) - "Move forward N logical sexps. -This will skip over sexps that don't represent objects, so that ^hints and -#reader.macros are considered part of the following sexp." - (interactive "p") - (unless n (setq n 1)) - (if (< n 0) - (clojure-backward-logical-sexp (- n)) - (let ((forward-sexp-function nil)) - (while (> n 0) - (while (clojure--looking-at-non-logical-sexp) - (forward-sexp 1)) - ;; The actual sexp - (forward-sexp 1) - (skip-chars-forward ",") - (setq n (1- n)))))) - -(defun clojure-backward-logical-sexp (&optional n) - "Move backward N logical sexps. -This will skip over sexps that don't represent objects, so that ^hints and -#reader.macros are considered part of the following sexp." - (interactive "p") - (unless n (setq n 1)) - (if (< n 0) - (clojure-forward-logical-sexp (- n)) - (let ((forward-sexp-function nil)) - (while (> n 0) - ;; The actual sexp - (backward-sexp 1) - ;; Non-logical sexps. - (while (and (not (bobp)) - (ignore-errors - (save-excursion - (backward-sexp 1) - (clojure--looking-at-non-logical-sexp)))) - (backward-sexp 1)) - (setq n (1- n)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Refactoring support -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; Threading macros related -(defcustom clojure-thread-all-but-last nil - "Non-nil means do not thread the last expression. -This means that `clojure-thread-first-all' and -`clojure-thread-last-all' not thread the deepest sexp inside the -current sexp." - :package-version '(clojure-mode . "5.4.0") - :safe #'booleanp - :type 'boolean) - -(defun clojure--maybe-unjoin-line () - "Undo a `join-line' done by a threading command." - (when (get-text-property (point) 'clojure-thread-line-joined) - (remove-text-properties (point) (1+ (point)) '(clojure-thread-line-joined t)) - (insert "\n"))) - -(defun clojure--unwind-last () - (forward-sexp) - (save-excursion - (let ((beg (point)) - (contents (clojure-delete-and-extract-sexp))) - (when (looking-at " *\n") - (join-line 'following)) - (clojure--ensure-parens-around-function-names) - (let* ((sexp-beg-line (line-number-at-pos)) - (sexp-end-line (progn (forward-sexp) - (line-number-at-pos))) - (multiline-sexp-p (not (= sexp-beg-line sexp-end-line)))) - (down-list -1) - (if multiline-sexp-p - (insert "\n") - ;; `clojure--maybe-unjoin-line' only works when unwinding sexps that were - ;; threaded in the same Emacs session, but it also catches cases that - ;; `multiline-sexp-p' doesn't. - (clojure--maybe-unjoin-line)) - (insert contents)))) - (forward-char)) - -(defun clojure--ensure-parens-around-function-names () - (clojure--looking-at-non-logical-sexp) - (unless (looking-at "(") - (insert-parentheses 1) - (backward-up-list))) - -(defun clojure--unwind-first () - "Unwind a thread first macro once. -Point must be between the opening paren and the -> symbol." - (forward-sexp) - (save-excursion - (let ((contents (clojure-delete-and-extract-sexp))) - (when (looking-at " *\n") - (join-line 'following)) - (clojure--ensure-parens-around-function-names) - (down-list) - (forward-sexp) - (insert contents) - (forward-sexp -1) - (clojure--maybe-unjoin-line))) - (forward-char)) - -(defun clojure--pop-out-of-threading () - (save-excursion - (down-list 2) - (backward-up-list) - (raise-sexp))) - -(defun clojure--nothing-more-to-unwind () - (save-excursion - (let ((beg (point))) - (forward-sexp) - (down-list -1) - (backward-sexp 2) ;; the last sexp, the threading macro - (when (looking-back "(\\s-*" (line-beginning-position)) - (backward-up-list)) ;; and the paren - (= beg (point))))) - -(defun clojure--fix-sexp-whitespace (&optional move-out) - (save-excursion - (when move-out (backward-up-list)) - (let ((sexp (bounds-of-thing-at-point 'sexp))) - (clojure-indent-region (car sexp) (cdr sexp)) - (delete-trailing-whitespace (car sexp) (cdr sexp))))) - -;;;###autoload -(defun clojure-unwind () - "Unwind thread at point or above point by one level. -Return nil if there are no more levels to unwind." - (interactive) - (save-excursion - (let ((limit (save-excursion - (beginning-of-defun) - (point)))) - (ignore-errors - (when (looking-at "(") - (forward-char 1) - (forward-sexp 1))) - (search-backward-regexp "([^-]*->" limit) - (if (clojure--nothing-more-to-unwind) - (progn (clojure--pop-out-of-threading) - (clojure--fix-sexp-whitespace) - nil) - (down-list) - (prog1 (cond - ((looking-at "[^-]*->\\_>") (clojure--unwind-first)) - ((looking-at "[^-]*->>\\_>") (clojure--unwind-last))) - (clojure--fix-sexp-whitespace 'move-out)) - t)))) - -;;;###autoload -(defun clojure-unwind-all () - "Fully unwind thread at point or above point." - (interactive) - (while (clojure-unwind))) - -(defun clojure--remove-superfluous-parens () - (when (looking-at "([^ )]+)") - (delete-pair))) - -(defun clojure--thread-first () - (down-list) - (forward-symbol 1) - (unless (looking-at ")") - (let ((contents (clojure-delete-and-extract-sexp))) - (backward-up-list) - (just-one-space 0) - (save-excursion - (insert contents "\n") - (clojure--remove-superfluous-parens)) - (when (looking-at "\\s-*\n") - (join-line 'following) - (forward-char 1) - (put-text-property (point) (1+ (point)) - 'clojure-thread-line-joined t)) - t))) - -(defun clojure--thread-last () - (forward-sexp 2) - (down-list -1) - (backward-sexp) - (unless (eq (char-before) ?\() - (let ((contents (clojure-delete-and-extract-sexp))) - (just-one-space 0) - (backward-up-list) - (insert contents "\n") - (clojure--remove-superfluous-parens) - ;; cljr #255 Fix dangling parens - (forward-sexp) - (when (looking-back "^\\s-*\\()+\\)\\s-*" (line-beginning-position)) - (let ((pos (match-beginning 1))) - (put-text-property pos (1+ pos) 'clojure-thread-line-joined t)) - (join-line)) - t))) - -(defun clojure--threadable-p () - (save-excursion - (forward-symbol 1) - (looking-at "[\n\r\t ]*("))) - -;;;###autoload -(defun clojure-thread () - "Thread by one more level an existing threading macro." - (interactive) - (ignore-errors - (when (looking-at "(") - (forward-char 1) - (forward-sexp 1))) - (search-backward-regexp "([^-]*->") - (down-list) - (when (clojure--threadable-p) - (prog1 (cond - ((looking-at "[^-]*->\\_>") (clojure--thread-first)) - ((looking-at "[^-]*->>\\_>") (clojure--thread-last))) - (clojure--fix-sexp-whitespace 'move-out)))) - -(defun clojure--thread-all (first-or-last-thread but-last) - (save-excursion - (insert-parentheses 1) - (insert first-or-last-thread)) - (while (save-excursion (clojure-thread))) - (when (or but-last clojure-thread-all-but-last) - (clojure-unwind))) - -;;;###autoload -(defun clojure-thread-first-all (but-last) - "Fully thread the form at point using ->. -When BUT-LAST is passed the last expression is not threaded." - (interactive "P") - (clojure--thread-all "-> " but-last)) - -;;;###autoload -(defun clojure-thread-last-all (but-last) - "Fully thread the form at point using ->>. -When BUT-LAST is passed the last expression is not threaded." - (interactive "P") - (clojure--thread-all "->> " but-last)) - -;;; Cycling stuff - -(defcustom clojure-use-metadata-for-privacy nil - "If nil, `clojure-cycle-privacy' will use (defn- f []). -If t, it will use (defn ^:private f [])." - :package-version '(clojure-mode . "5.5.0") - :safe #'booleanp - :type 'boolean) - -;;;###autoload -(defun clojure-cycle-privacy () - "Make public the current private def, or vice-versa. -See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-privacy" - (interactive) - (save-excursion - (ignore-errors (forward-char 7)) - (search-backward-regexp "(defn?\\(-\\| ^:private\\)?\\_>") - (if (match-string 1) - (replace-match "" nil nil nil 1) - (goto-char (match-end 0)) - (insert (if (or clojure-use-metadata-for-privacy - (equal (match-string 0) "(def")) - " ^:private" - "-"))))) - -(defun clojure--convert-collection (coll-open coll-close) - "Convert the collection at (point) by unwrapping it an wrapping it between COLL-OPEN and COLL-CLOSE." - (save-excursion - (while (and - (not (bobp)) - (not (looking-at "(\\|{\\|\\["))) - (backward-char)) - (when (or (eq ?\# (char-before)) - (eq ?\' (char-before))) - (delete-char -1)) - (when (and (bobp) - (not (memq (char-after) '(?\{ ?\( ?\[)))) - (user-error "Beginning of file reached, collection is not found")) - (insert coll-open (substring (clojure-delete-and-extract-sexp) 1 -1) coll-close))) - -;;;###autoload -(defun clojure-convert-collection-to-list () - "Convert collection at (point) to list." - (interactive) - (clojure--convert-collection "(" ")")) - -;;;###autoload -(defun clojure-convert-collection-to-quoted-list () - "Convert collection at (point) to quoted list." - (interactive) - (clojure--convert-collection "'(" ")")) - -;;;###autoload -(defun clojure-convert-collection-to-map () - "Convert collection at (point) to map." - (interactive) - (clojure--convert-collection "{" "}")) - -;;;###autoload -(defun clojure-convert-collection-to-vector () - "Convert collection at (point) to vector." - (interactive) - (clojure--convert-collection "[" "]")) - -;;;###autoload -(defun clojure-convert-collection-to-set () - "Convert collection at (point) to set." - (interactive) - (clojure--convert-collection "#{" "}")) - -(defun clojure--goto-if () - (when (in-string-p) - (while (or (not (looking-at "(")) - (in-string-p)) - (backward-char))) - (while (not (looking-at "\\((if \\)\\|\\((if-not \\)")) - (condition-case nil - (backward-up-list) - (scan-error (user-error "No if or if-not found"))))) - -;;;###autoload -(defun clojure-cycle-if () - "Change a surrounding if to if-not, or vice-versa. - -See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-if" - (interactive) - (save-excursion - (clojure--goto-if) - (cond - ((looking-at "(if-not") - (forward-char 3) - (delete-char 4) - (forward-sexp 2) - (transpose-sexps 1)) - ((looking-at "(if") - (forward-char 3) - (insert "-not") - (forward-sexp 2) - (transpose-sexps 1))))) - - -;;; ClojureScript -(defconst clojurescript-font-lock-keywords - (eval-when-compile - `(;; ClojureScript built-ins - (,(concat "(\\(?:\.*/\\)?" - (regexp-opt '("js-obj" "js-delete" "clj->js" "js->clj")) - "\\>") - 0 font-lock-builtin-face))) - "Additional font-locking for `clojurescrip-mode'.") - -;;;###autoload -(define-derived-mode clojurescript-mode clojure-mode "ClojureScript" - "Major mode for editing ClojureScript code. - -\\{clojurescript-mode-map}" - (font-lock-add-keywords nil clojurescript-font-lock-keywords)) - -;;;###autoload -(define-derived-mode clojurec-mode clojure-mode "ClojureC" - "Major mode for editing ClojureC code. - -\\{clojurec-mode-map}") - -(defconst clojurex-font-lock-keywords - ;; cljx annotations (#+clj and #+cljs) - '(("#\\+cljs?\\>" 0 font-lock-preprocessor-face)) - "Additional font-locking for `clojurex-mode'.") - -;;;###autoload -(define-derived-mode clojurex-mode clojure-mode "ClojureX" - "Major mode for editing ClojureX code. - -\\{clojurex-mode-map}" - (font-lock-add-keywords nil clojurex-font-lock-keywords)) - -;;;###autoload -(progn - (add-to-list 'auto-mode-alist - '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-mode)) - (add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-mode)) - (add-to-list 'auto-mode-alist '("\\.cljx\\'" . clojurex-mode)) - (add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-mode)) - ;; boot build scripts are Clojure source files - (add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-mode))) - -(provide 'clojure-mode) - -;; Local Variables: -;; coding: utf-8 -;; End: - -;;; clojure-mode.el ends here diff --git a/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-autoloads.el b/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-autoloads.el deleted file mode 100644 index 41c37b9..0000000 --- a/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-autoloads.el +++ /dev/null @@ -1,22 +0,0 @@ -;;; clojure-quick-repls-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil "clojure-quick-repls" "clojure-quick-repls.el" -;;;;;; (22500 1822 828219 293000)) -;;; Generated autoloads from clojure-quick-repls.el - -(autoload 'clojure-quick-repls-connect "clojure-quick-repls" "\ -Launch Clojure and ClojureScript repls for the current project - -\(fn)" t nil) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; clojure-quick-repls-autoloads.el ends here diff --git a/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-pkg.el b/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-pkg.el deleted file mode 100644 index 85a7a95..0000000 --- a/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "clojure-quick-repls" "20150814.36" "Quickly create Clojure and ClojureScript repls for a project." '((cider "0.8.1") (dash "2.9.0")) :url "https://github.com/symfrog/clojure-quick-repls" :keywords '("languages" "clojure" "cider" "clojurescript")) diff --git a/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls.el b/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls.el deleted file mode 100644 index 50e4778..0000000 --- a/elpa/clojure-quick-repls-20150814.36/clojure-quick-repls.el +++ /dev/null @@ -1,155 +0,0 @@ -;;; clojure-quick-repls.el --- Quickly create Clojure and ClojureScript repls for a project. - -;; Copyright (C) 2014 symfrog - -;; URL: https://github.com/symfrog/clojure-quick-repls -;; Package-Version: 20150814.36 -;; Keywords: languages, clojure, cider, clojurescript -;; Version: 0.2.0-cvs -;; Package-Requires: ((cider "0.8.1") (dash "2.9.0")) - -;; 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: - -;; Quickly create Clojure and ClojureScript repls for a project. -;; Once the repls are created the usual CIDER commands can be used in either a clj/cljs buffer and the forms will be routed automatically via the correct connection. -;; So no need to manually switch connections! - -;;; Installation: - -;; Available as a package in melpa.org. -;; M-x package-install clojure-quick-repls - -;;; Usage: - -;; (require 'clojure-quick-repls) - -;;; Code: - -(require 'cider) -(require 'dash) - -(defcustom clojure-quick-repls-cljs-setup - "(require 'cljs.repl.browser) - (cemerick.piggieback/cljs-repl - :repl-env (cljs.repl.browser/repl-env :port 9000))" - "Default form to initialize ClojureScript REPL" - :type '(string) - :group 'clojure-quick-repls) - -(defvar clojure-quick-repls-nrepl-connected-fn nil) - -(defvar clojure-quick-repls-current-buffer nil) -(defvar clojure-quick-repls-nrepl-connect-done nil) - -(defvar clojure-quick-repls-clj-con-buf nil) -(defvar clojure-quick-repls-cljs-con-buf nil) - -(defun clojure-quick-repls-noop-nrepl-connected-fn () - (fset 'clojure-quick-repls-nrepl-connected-fn (lambda (buf) nil))) - -(clojure-quick-repls-noop-nrepl-connected-fn) - -(defun clojure-quick-repls-clear-con-bufs () - (setq clojure-quick-repls-clj-con-buf nil) - (setq clojure-quick-repls-cljs-con-buf nil)) - -(add-hook 'nrepl-connected-hook (lambda () - (clojure-quick-repls-nrepl-connected-fn clojure-quick-repls-current-buffer))) - -(add-hook 'nrepl-disconnected-hook #'clojure-quick-repls-clear-con-bufs) - -;;;###autoload -(defun clojure-quick-repls-connect () - "Launch Clojure and ClojureScript repls for the current project" - (interactive) - (setq clojure-quick-repls-current-buffer (current-buffer)) - (clojure-quick-repls-noop-nrepl-connected-fn) - (cider-jack-in) - - (clojure-quick-repls-clear-con-bufs) - - (lexical-let* ((cljs-fn (lambda (buf) - (with-current-buffer buf - (clojure-quick-repls-noop-nrepl-connected-fn) - (if (string= "ex" (cadr (nrepl-sync-request:eval clojure-quick-repls-cljs-setup))) - (message "Failed to initialize cljs connection with form %s" clojure-quick-repls-cljs-setup) - (progn - (setq clojure-quick-repls-cljs-con-buf (nrepl-current-connection-buffer)) - (message "Clj connection buffer: %s Cljs connection buffer %s" clojure-quick-repls-clj-con-buf clojure-quick-repls-cljs-con-buf) - (message "Cljs browser repl ready") - ; Make the clj buf default after completion - (nrepl-make-connection-default clojure-quick-repls-clj-con-buf)))))) - (clj-fn (lambda (buf) - (with-current-buffer buf - (clojure-quick-repls-noop-nrepl-connected-fn ) - (fset 'clojure-quick-repls-nrepl-connected-fn cljs-fn) - (setq clojure-quick-repls-clj-con-buf (nrepl-current-connection-buffer)) - (message "Creating nrepl connection for cljs") - (clojure-quick-repls-new-repl-connection))))) - (fset 'clojure-quick-repls-nrepl-connected-fn clj-fn))) - -(defun clojure-quick-repls-new-repl-connection () - (let* ((host (nrepl-current-host)) - (port (nrepl-extract-port))) - (message "Creating repl connection to nrepl server on port %s, host %s" host port) - (cider-connect host port))) - -(defun clojure-quick-repls-bound-truthy-p (s) - (and (boundp s) (symbol-value s))) - -(defun clojure-quick-repls-buffer-extension (buffer) - (let ((name (buffer-name buffer))) - (-when-let (p-loc (string-match-p "\\." name)) - (substring name (1+ p-loc) nil))) ) - -(defun clojure-quick-repls-set-connection (f h) - (let ((ext (clojure-quick-repls-buffer-extension (current-buffer)))) - (if (and (clojure-quick-repls-bound-truthy-p 'clojure-quick-repls-clj-con-buf) - (clojure-quick-repls-bound-truthy-p 'clojure-quick-repls-cljs-con-buf) - ext - (or (string= ext "clj") (string= ext "boot") (string= ext "cljs"))) - (progn - (if (string= ext "cljs") - (nrepl-make-connection-default clojure-quick-repls-cljs-con-buf) - (nrepl-make-connection-default clojure-quick-repls-clj-con-buf)) - (when f - (funcall f))) - (when h - (funcall h))))) - -(defun clojure-quick-repls-switch-to-relevant-repl (arg) - (interactive) - (lexical-let ((a arg)) - (clojure-quick-repls-set-connection (lambda () (cider-switch-to-current-repl-buffer a)) - (lambda () (cider-switch-to-relevant-repl-buffer a))))) - -(if (version< emacs-version "24.4") - (progn - (defadvice cider-interactive-eval (before clojure-quick-repls-nrepl-current-session activate) - (clojure-quick-repls-set-connection nil nil)) - (defadvice cider-tooling-eval (before clojure-quick-repls-nrepl-current-session activate) - (clojure-quick-repls-set-connection nil nil)) - (defadvice cider-complete-at-point (before clojure-quick-repls-nrepl-current-session activate) - (clojure-quick-repls-set-connection nil nil))) - (defun clojure-quick-repls-nrepl-current-session (&optional arg1 arg2 arg3) - (clojure-quick-repls-set-connection nil nil)) - (advice-add 'cider-interactive-eval :before #'clojure-quick-repls-nrepl-current-session) - (advice-add 'cider-tooling-eval :before #'clojure-quick-repls-nrepl-current-session) - (advice-add 'cider-complete-at-point :before #'clojure-quick-repls-nrepl-current-session)) - -(provide 'clojure-quick-repls) - -;;; clojure-quick-repls.el ends here diff --git a/elpa/flycheck-clojure-20160704.1221/flycheck-clojure-autoloads.el b/elpa/flycheck-clojure-20160704.1221/flycheck-clojure-autoloads.el deleted file mode 100644 index 640d409..0000000 --- a/elpa/flycheck-clojure-20160704.1221/flycheck-clojure-autoloads.el +++ /dev/null @@ -1,29 +0,0 @@ -;;; flycheck-clojure-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) - -;;;### (autoloads nil "flycheck-clojure" "flycheck-clojure.el" (22500 -;;;;;; 1821 852214 67000)) -;;; Generated autoloads from flycheck-clojure.el - -(autoload 'flycheck-clojure-parse-cider-errors "flycheck-clojure" "\ -Parse cider errors from JSON VALUE from CHECKER. - -Return a list of parsed `flycheck-error' objects. - -\(fn VALUE CHECKER)" nil nil) - -(autoload 'flycheck-clojure-setup "flycheck-clojure" "\ -Setup Flycheck for Clojure. - -\(fn)" t nil) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; flycheck-clojure-autoloads.el ends here diff --git a/elpa/flycheck-clojure-20160704.1221/flycheck-clojure-pkg.el b/elpa/flycheck-clojure-20160704.1221/flycheck-clojure-pkg.el deleted file mode 100644 index 72d1866..0000000 --- a/elpa/flycheck-clojure-20160704.1221/flycheck-clojure-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "flycheck-clojure" "20160704.1221" "Flycheck: Clojure support" '((cider "0.8.1") (flycheck "0.22alpha1") (let-alist "1.0.1") (emacs "24")) :url "https://github.com/clojure-emacs/squiggly-clojure") diff --git a/elpa/flycheck-clojure-20160704.1221/flycheck-clojure.el b/elpa/flycheck-clojure-20160704.1221/flycheck-clojure.el deleted file mode 100644 index c24645b..0000000 --- a/elpa/flycheck-clojure-20160704.1221/flycheck-clojure.el +++ /dev/null @@ -1,221 +0,0 @@ -;;; flycheck-clojure.el --- Flycheck: Clojure support -*- lexical-binding: t; -*- - -;; Copyright © 2014 Peter Fraenkel -;; Copyright (C) 2014 Sebastian Wiesner -;; -;; Author: Peter Fraenkel -;; Sebastian Wiesner -;; Maintainer: Peter Fraenkel -;; URL: https://github.com/clojure-emacs/squiggly-clojure -;; Package-Version: 20160704.1221 -;; Version: 1.1.0 -;; Package-Requires: ((cider "0.8.1") (flycheck "0.22-cvs1") (let-alist "1.0.1") (emacs "24")) - -;; This file is not part of GNU Emacs. - -;; 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: - -;; Add Clojure support to Flycheck. -;; -;; Provide syntax checkers to check Clojure code using a running Cider repl. -;; -;; Installation: -;; -;; (eval-after-load 'flycheck '(flycheck-clojure-setup)) - -;;; Code: - -(require 'cider-client) -(require 'flycheck) -(require 'json) -(require 'url-parse) -(eval-when-compile (require 'let-alist)) - -(defcustom flycheck-clojure-inject-dependencies-at-jack-in t - "When nil, do not inject repl dependencies (i.e. the linters/checkers) at `cider-jack-in' time." - :group 'flycheck-clojure - :type 'boolean) - -(defvar flycheck-clojure-dep-version "0.1.6" - "Version of `acyclic/squiggly-clojure' compatible with this version of flycheck-clojure.") - -;;;###autoload -(defun flycheck-clojure-parse-cider-errors (value checker) - "Parse cider errors from JSON VALUE from CHECKER. - -Return a list of parsed `flycheck-error' objects." - ;; Parse the nested JSON from Cider. The outer JSON contains the return value - ;; from Cider, and the inner JSON the errors returned by the individual - ;; checker. - (let ((error-objects (json-read-from-string (json-read-from-string value)))) - (mapcar (lambda (o) - (let-alist o - ;; Use the file name reported by the syntax checker, but only if - ;; its absolute, because typed reports relative file names that - ;; are hard to expand correctly, since they are relative to the - ;; source directory (not the project directory). - (let* ((parsed-file (when .file - (url-filename - (url-generic-parse-url .file)))) - (filename (if (and parsed-file - (file-name-absolute-p parsed-file)) - parsed-file - (buffer-file-name)))) - (flycheck-error-new-at .line .column (intern .level) .msg - :checker checker - :filename filename)))) - error-objects))) - -(defun cider-flycheck-eval (input callback) - "Send the request INPUT and register the CALLBACK as the response handler. -Uses the tooling session, with no specified namespace." - (cider-tooling-eval input callback)) - -(defun flycheck-clojure-may-use-cider-checker () - "Determine whether a cider checker may be used. - -Checks for `cider-mode', and a current nREPL connection. - -Standard predicate for cider checkers." - (let ((connection-buffer (cider-default-connection :no-error))) - (and (bound-and-true-p cider-mode) - connection-buffer - (buffer-live-p (get-buffer connection-buffer)) - (clojure-find-ns)))) - -(defun flycheck-clojure-start-cider (checker callback) - "Start a cider syntax CHECKER with CALLBACK." - (let ((ns (clojure-find-ns)) - (form (get checker 'flycheck-clojure-form))) - (cider-flycheck-eval - (funcall form ns) - (nrepl-make-response-handler - (current-buffer) - (lambda (buffer value) - (funcall callback 'finished - (with-current-buffer buffer - (flycheck-clojure-parse-cider-errors value checker)))) - nil ; stdout - nil ; stderr - (lambda (_) - ;; If the evaluation completes without returning any value, there has - ;; gone something wrong. Ideally, we'd report *what* was wrong, but - ;; `nrepl-make-response-handler' is close to useless for this :(, - ;; because it just `message's for many status codes that are errors for - ;; us :( - (funcall callback 'errored "Done with no errors")) - (lambda (_buffer ex _rootex _sess) - (funcall callback 'errored - (format "Form %s of checker %s failed: %s" - form checker ex)))))) -) - -(defun flycheck-clojure-define-cider-checker (name docstring &rest properties) - "Define a Cider syntax checker with NAME, DOCSTRING and PROPERTIES. - -NAME, DOCSTRING, and PROPERTIES are like for -`flycheck-define-generic-checker', except that `:start' and -`:modes' are invalid PROPERTIES. A syntax checker defined with -this function will always check in `clojure-mode', and only if -`cider-mode' is enabled. - -Instead of `:start', this syntax checker requires a `:form -FUNCTION' property. FUNCTION takes the current Clojure namespace -as single argument, and shall return a string containing a -Clojure form to be sent to Cider to check the current buffer." - (declare (indent 1) - (doc-string 2)) - (let* ((form (plist-get properties :form)) - (orig-predicate (plist-get properties :predicate))) - - (when (plist-get :start properties) - (error "Checker %s may not have :start" name)) - (when (plist-get :modes properties) - (error "Checker %s may not have :modes" name)) - (unless (functionp form) - (error ":form %s of %s not a valid function" form name)) - (apply #'flycheck-define-generic-checker - name docstring - :start #'flycheck-clojure-start-cider - :modes '(clojure-mode) - :predicate (if orig-predicate - (lambda () - (and (flycheck-clojure-may-use-cider-checker) - (funcall orig-predicate))) - #'flycheck-clojure-may-use-cider-checker) - properties) - - (put name 'flycheck-clojure-form form))) - -(flycheck-clojure-define-cider-checker 'clojure-cider-eastwood - "A syntax checker for Clojure, using Eastwood in Cider. - -See URL `https://github.com/jonase/eastwood' and URL -`https://github.com/clojure-emacs/cider/' for more information." - :form (lambda (ns) - (format "(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-ew '%s))" - ns)) - :next-checkers '(clojure-cider-kibit clojure-cider-typed)) - -(flycheck-clojure-define-cider-checker 'clojure-cider-kibit - "A syntax checker for Clojure, using Kibit in Cider. - -See URL `https://github.com/jonase/kibit' and URL -`https://github.com/clojure-emacs/cider/' for more information." - :form (lambda (ns) - (format - "(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-kb '%s %s))" - ns - ;; Escape file name for Clojure - (flycheck-sexp-to-string (buffer-file-name)))) - :predicate (lambda () (buffer-file-name)) - :next-checkers '(clojure-cider-typed)) - -(flycheck-clojure-define-cider-checker 'clojure-cider-typed - "A syntax checker for Clojure, using Typed Clojure in Cider. - -See URL `https://github.com/clojure-emacs/cider/' and URL -`https://github.com/clojure/core.typed' for more information." - :form (lambda (ns) - (format - "(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-tc '%s))" - ns))) - -(defun flycheck-clojure-inject-jack-in-dependencies () - "Inject the REPL dependencies of flycheck-clojure at `cider-jack-in'. -If injecting the dependencies is not preferred set `flycheck-clojure-inject-dependencies-at-jack-in' to nil." - (when (and flycheck-clojure-inject-dependencies-at-jack-in - (boundp 'cider-jack-in-dependencies)) - (add-to-list 'cider-jack-in-dependencies `("acyclic/squiggly-clojure" ,flycheck-clojure-dep-version)))) - -;;;###autoload -(defun flycheck-clojure-setup () - "Setup Flycheck for Clojure." - (interactive) - ;; Add checkers in reverse order, because `add-to-list' adds to front. - (dolist (checker '(clojure-cider-typed - clojure-cider-kibit - clojure-cider-eastwood)) - (add-to-list 'flycheck-checkers checker)) - (flycheck-clojure-inject-jack-in-dependencies)) - -(provide 'flycheck-clojure) - -;; Local Variables: -;; indent-tabs-mode: nil -;; End: - -;;; flycheck-clojure.el ends here diff --git a/init.el b/init.el index 0563695..ec2f1fa 100644 --- a/init.el +++ b/init.el @@ -73,7 +73,7 @@ ("e6h" . "http://www.e6h.org/packages/")))) '(package-selected-packages (quote - (gobgen goto-last-change wakatime-mode command-log-mode magithub nyan-prompt zone-nyan helm-google helm-projectile helm-spotify helm-swoop helm-unicode id-manager identica-mode mc-extras multiple-cursors electric-spacing flycheck-clojure flycheck-pkg-config focus git-messenger gitconfig github-notifier gnome-calendar gnugo google helm-chrome helm-company helm-flycheck clojure-quick-repls electric-case emamux flycheck drag-stuff django-manage clojure-mode hyde org-jekyll smart-mode-line-powerline-theme yaml-mode xlicense vala-mode sass-mode nyan-mode muse markdown-mode mark magit-gerrit json-mode js2-mode jinja2-mode helm-make helm-gtags helm-flyspell helm-ag go-mode gitignore-mode gitconfig-mode git-gutter ggtags fiplr erlang django-mode company-shell company-quickhelp company-c-headers coffee-mode buffer-move ag))) + (gobgen goto-last-change wakatime-mode command-log-mode magithub nyan-prompt zone-nyan helm-google helm-projectile helm-spotify helm-swoop helm-unicode id-manager identica-mode mc-extras multiple-cursors electric-spacing flycheck-pkg-config focus git-messenger gitconfig github-notifier gnome-calendar gnugo google helm-chrome helm-company helm-flycheck electric-case emamux flycheck drag-stuff django-manage hyde org-jekyll smart-mode-line-powerline-theme yaml-mode xlicense vala-mode sass-mode nyan-mode muse markdown-mode mark magit-gerrit json-mode js2-mode jinja2-mode helm-make helm-gtags helm-flyspell helm-ag go-mode gitignore-mode gitconfig-mode git-gutter ggtags fiplr erlang django-mode company-shell company-quickhelp company-c-headers coffee-mode buffer-move ag))) '(safe-local-variable-values (quote ((company-clang-arguments "-I.." "-I/home/polesz/jhbuild/install/include/atk-1.0" "-I/home/polesz/jhbuild/install/include/at-spi-2.0" "-I/home/polesz/jhbuild/install/include/at-spi2-atk/2.0" "-I/home/polesz/jhbuild/install/include/cairo" "-I/home/polesz/jhbuild/install/include/gdk-pixbuf-2.0" "-I/home/polesz/jhbuild/install/include/gio-unix-2.0/" "-I/home/polesz/jhbuild/install/include/glib-2.0" "-I/home/polesz/jhbuild/install/include/gtk-3.0" "-I/home/polesz/jhbuild/install/include/harfbuzz" "-I/home/polesz/jhbuild/install/include/libgda-5.0" "-I/home/polesz/jhbuild/install/include/libgda-5.0/libgda" "-I/home/polesz/jhbuild/install/include/librsvg-2.0" "-I/home/polesz/jhbuild/install/include/libsoup-2.4" "-I/home/polesz/jhbuild/install/include/pango-1.0" "-I/home/polesz/jhbuild/install/include/swe-glib" "-I/home/polesz/jhbuild/install/include/webkitgtk-4.0" "-I/home/polesz/jhbuild/install/lib/glib-2.0/include" "-I/usr/include/dbus-1.0" "-I/usr/include/freetype2" "-I/usr/include/libdrm" "-I/usr/include/libpng16" "-I/usr/include/libxml2" "-I/usr/include/pixman-1" "-I/usr/lib64/dbus-1.0/include")