diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925')
74 files changed, 0 insertions, 18631 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-apropos.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-apropos.el deleted file mode 100644 index 97be9aa62a36..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-apropos.el +++ /dev/null @@ -1,208 +0,0 @@ -;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors -;; -;; Author: Jeff Valk <jv@jeffvalk.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Apropos functionality for Clojure. - -;;; Code: - -(require 'cider-doc) -(require 'cider-util) -(require 'subr-x) -(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*") - -(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")) - -(define-button-type 'apropos-special-form - 'apropos-label "Special form" - 'apropos-short-label "s" - 'face 'font-lock-keyword-face - 'help-echo "mouse-2, RET: Display more help on this special form" - 'follow-link t - 'action (lambda (button) - (describe-function (button-get button 'apropos-symbol)))) - -(defun cider-apropos-doc (button) - "Display documentation for the symbol represented at BUTTON." - (cider-doc-lookup (button-get button 'apropos-symbol))) - -(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 'select 'apropos-mode 'ancillary) - (let ((inhibit-read-only t)) - (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 <query> 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 <query> 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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-apropos.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-apropos.elc deleted file mode 100644 index 1b2d8c643e3c..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-apropos.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-autoloads.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-autoloads.el deleted file mode 100644 index 244e2ecbc759..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-autoloads.el +++ /dev/null @@ -1,637 +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" (23450 31943 257069 372000)) -;;; Generated autoloads from cider.el - -(autoload 'cider-version "cider" "\ -Display CIDER's version. - -\(fn)" t nil) - -(autoload 'cider-jack-in-clj "cider" "\ -Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. -With the prefix argument, prompt for all these parameters. - -\(fn PARAMS)" t nil) - -(autoload 'cider-jack-in-cljs "cider" "\ -Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, -prompt for all these parameters. - -\(fn PARAMS)" t nil) - -(autoload 'cider-jack-in-clj&cljs "cider" "\ -Start an nREPL server and connect with clj and cljs REPLs. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, -prompt for all these parameters. When SOFT-CLJS-START is non-nil, start -cljs REPL only when the ClojureScript dependencies are met. - -\(fn &optional PARAMS SOFT-CLJS-START)" t nil) - -(autoload 'cider-connect-sibling-clj "cider" "\ -Create a Clojure REPL with the same server as OTHER-REPL. -PARAMS is for consistency with other connection commands and is currently -ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can -also be a server buffer, in which case a new session with a REPL for that -server is created. - -\(fn PARAMS &optional OTHER-REPL)" t nil) - -(autoload 'cider-connect-sibling-cljs "cider" "\ -Create a ClojureScript REPL with the same server as OTHER-REPL. -PARAMS is a plist optionally containing :cljs-repl-type (e.g. Node, -Figwheel, etc). All other parameters are inferred from the OTHER-REPL. -OTHER-REPL defaults to `cider-current-repl' but in programs can also be a -server buffer, in which case a new session for that server is created. - -\(fn PARAMS &optional OTHER-REPL)" t nil) - -(autoload 'cider-connect-clj "cider" "\ -Initialize a CLJ connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port and :project-dir. On -prefix argument, prompt for all the parameters. - -\(fn &optional PARAMS)" t nil) - -(autoload 'cider-connect-cljs "cider" "\ -Initialize a CLJS connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. Node, Figwheel, etc). On prefix, prompt for all the -parameters regardless of their supplied or default values. - -\(fn &optional PARAMS)" t nil) - -(autoload 'cider-connect-clj&cljs "cider" "\ -Initialize a CLJ and CLJS connection to an nREPL server.. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is -non-nil, don't start if ClojureScript requirements are not met. - -\(fn PARAMS &optional SOFT-CLJS-START)" t nil) - -(autoload 'cider "cider" "\ -Start a connection of any type interactively. - -\(fn)" t nil) - -(defalias 'cider-jack-in #'cider-jack-in-clj) - -(defalias 'cider-jack-in-clojure #'cider-jack-in-clj) - -(defalias 'cider-jack-in-clojurescript #'cider-jack-in-cljs) - -(defalias 'cider-connect #'cider-connect-clj) - -(defalias 'cider-connect-clojure #'cider-connect-clj) - -(defalias 'cider-connect-clojurescript #'cider-connect-cljs) - -(defalias 'cider-connect-sibling-clojure #'cider-connect-sibling-clj) - -(defalias 'cider-connect-sibling-clojurescript #'cider-connect-sibling-cljs) - -(eval-after-load 'clojure-mode '(progn (define-key clojure-mode-map (kbd "C-c M-x") #'cider) (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) (require 'sesman) (sesman-install-menu clojure-mode-map) (add-hook 'clojure-mode-hook (lambda nil (setq-local sesman-system 'CIDER))))) - -;;;*** - -;;;### (autoloads nil "cider-apropos" "cider-apropos.el" (23450 31943 -;;;;;; 250662 276000)) -;;; 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 <query> 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 <query> nil t). - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-browse-ns" "cider-browse-ns.el" (23450 -;;;;;; 31943 249079 688000)) -;;; 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-browse-spec" "cider-browse-spec.el" -;;;;;; (23450 31943 285210 198000)) -;;; Generated autoloads from cider-browse-spec.el - -(autoload 'cider-browse-spec "cider-browse-spec" "\ -Browse SPEC definition. - -\(fn SPEC)" t nil) - -(autoload 'cider-browse-spec-all "cider-browse-spec" "\ -Open list of specs in a popup buffer. - -With a prefix argument ARG, prompts for a regexp to filter specs. -No filter applied if the regexp is the empty string. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-cheatsheet" "cider-cheatsheet.el" (23450 -;;;;;; 31943 288051 894000)) -;;; Generated autoloads from cider-cheatsheet.el - -(autoload 'cider-cheatsheet "cider-cheatsheet" "\ -Navigate `cider-cheatsheet-hierarchy' with `completing-read'. - -When you make it to a Clojure var its doc buffer gets displayed. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-classpath" "cider-classpath.el" (23450 -;;;;;; 31943 271013 238000)) -;;; 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" (23450 31943 -;;;;;; 269492 83000)) -;;; 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-find" "cider-find.el" (23450 31943 268063 -;;;;;; 602000)) -;;; Generated autoloads from cider-find.el - -(autoload 'cider-find-var "cider-find" "\ -Find definition for VAR at LINE. -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point. - -\(fn &optional ARG VAR LINE)" t nil) - -(autoload 'cider-find-dwim-at-mouse "cider-find" "\ -Find and display variable or resource at mouse EVENT. - -\(fn EVENT)" t nil) - -(autoload 'cider-find-dwim "cider-find" "\ -Find and display the SYMBOL-FILE at point. -SYMBOL-FILE could be a var or a resource. If thing at point is empty then -show dired on project. If var is not found, try to jump to resource of the -same name. When called interactively, a prompt is given according to the -variable `cider-prompt-for-symbol'. A single or double prefix argument -inverts the meaning. A prefix of `-' or a double prefix argument causes -the results to be displayed in a different window. A default value of thing -at point is given when prompted. - -\(fn SYMBOL-FILE)" t nil) - -(autoload 'cider-find-resource "cider-find" "\ -Find the resource at PATH. -Prompt for input as indicated by the variable `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix -argument causes the results to be displayed in other window. The default -value is thing at point. - -\(fn PATH)" t nil) - -(autoload 'cider-find-ns "cider-find" "\ -Find the file containing NS. -A prefix ARG of `-` or a double prefix argument causes -the results to be displayed in a different window. - -\(fn &optional ARG NS)" t nil) - -(autoload 'cider-find-keyword "cider-find" "\ -Find the namespace of the keyword at point and its first occurrence there. - -For instance - if the keyword at point is \":cider.demo/keyword\", this command -would find the namespace \"cider.demo\" and afterwards find the first mention -of \"::keyword\" there. - -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-format" "cider-format.el" (23450 31943 -;;;;;; 275392 561000)) -;;; Generated autoloads from cider-format.el - -(autoload 'cider-format-region "cider-format" "\ -Format the Clojure code in the current region. -START and END represent the region's boundaries. - -\(fn START END)" t nil) - -(autoload 'cider-format-defun "cider-format" "\ -Format the code in the current defun. - -\(fn)" t nil) - -(autoload 'cider-format-buffer "cider-format" "\ -Format the Clojure code in the current buffer. - -\(fn)" t nil) - -(autoload 'cider-format-edn-buffer "cider-format" "\ -Format the EDN data in the current buffer. - -\(fn)" t nil) - -(autoload 'cider-format-edn-region "cider-format" "\ -Format the EDN data in the current region. -START and END represent the region's boundaries. - -\(fn START END)" t nil) - -(autoload 'cider-format-edn-last-sexp "cider-format" "\ -Format the EDN data of the last sexp. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-grimoire" "cider-grimoire.el" (23450 -;;;;;; 31943 282389 333000)) -;;; 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" (23450 -;;;;;; 31943 243754 126000)) -;;; 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) - -;;;*** - -;;;### (autoloads nil "cider-macroexpansion" "cider-macroexpansion.el" -;;;;;; (23450 31943 283758 481000)) -;;; Generated autoloads from cider-macroexpansion.el - -(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\ -Invoke \\=`macroexpand-1\\=` on the expression preceding point. -If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of -\\=`macroexpand-1\\=`. - -\(fn &optional PREFIX)" t nil) - -(autoload 'cider-macroexpand-all "cider-macroexpansion" "\ -Invoke \\=`macroexpand-all\\=` on the expression preceding point. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-mode" "cider-mode.el" (23450 31943 236744 -;;;;;; 916000)) -;;; 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 Clojure REPL" cider-jack-in :help "Starts an nREPL server (with Leiningen, Boot, or Gradle) and connects a REPL to it."] ["Connect to a Clojure REPL" cider-connect :help "Connects to a REPL that's already running."] ["Connect to a ClojureScript REPL" cider-connect-clojurescript :help "Connects to a ClojureScript REPL that's already running."] ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-cljs :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] "--" ["View manual online" cider-view-manual]))) - -(autoload 'cider-mode "cider-mode" "\ -Minor mode for REPL interaction from a Clojure buffer. - -\\{cider-mode-map} - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-ns" "cider-ns.el" (23450 31943 261868 -;;;;;; 186000)) -;;; Generated autoloads from cider-ns.el - -(autoload 'cider-ns-reload "cider-ns" "\ -Send a (require 'ns :reload) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload forces loading of all the -identified libs even if they are already loaded\". - -\(fn &optional PROMPT)" t nil) - -(autoload 'cider-ns-reload-all "cider-ns" "\ -Send a (require 'ns :reload-all) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload-all implies :reload and -also forces loading of all libs that the identified libs directly or -indirectly load via require\". - -\(fn &optional PROMPT)" t nil) - -(autoload 'cider-ns-refresh "cider-ns" "\ -Reload modified and unloaded namespaces on the classpath. - -With a single prefix argument, or if MODE is `refresh-all', reload all -namespaces on the classpath unconditionally. - -With a double prefix argument, or if MODE is `clear', clear the state of -the namespace tracker before reloading. This is useful for recovering from -some classes of error (for example, those caused by circular dependencies) -that a normal reload would not otherwise recover from. The trade-off of -clearing is that stale code from any deleted files may not be completely -unloaded. - -With a negative prefix argument, or if MODE is `inhibit-fns', prevent any -refresh functions (defined in `cider-ns-refresh-before-fn' and -`cider-ns-refresh-after-fn') from being invoked. - -\(fn &optional MODE)" t nil) - -(define-obsolete-function-alias 'cider-refresh 'cider-ns-refresh "0.18") - -;;;*** - -;;;### (autoloads nil "cider-profile" "cider-profile.el" (23450 31943 -;;;;;; 260359 378000)) -;;; Generated autoloads from cider-profile.el - -(autoload 'cider-profile-samples "cider-profile" "\ -Displays current max-sample-count. -If optional QUERY is specified, set max-sample-count and display new value. - -\(fn &optional QUERY)" t nil) - -(autoload 'cider-profile-var-profiled-p "cider-profile" "\ -Displays the profiling status of var under point. -Prompts for var if none under point or QUERY is present. - -\(fn QUERY)" t nil) - -(autoload 'cider-profile-ns-toggle "cider-profile" "\ -Toggle profiling for the ns associated with optional QUERY. - -If optional argument QUERY is non-nil, prompt for ns. Otherwise use -current ns. - -\(fn &optional QUERY)" t nil) - -(autoload 'cider-profile-toggle "cider-profile" "\ -Toggle profiling for the given QUERY. -Defaults to the symbol at point. -With prefix arg or no symbol at point, prompts for a var. - -\(fn QUERY)" t nil) - -(autoload 'cider-profile-summary "cider-profile" "\ -Display a summary of currently collected profile data. - -\(fn)" t nil) - -(autoload 'cider-profile-var-summary "cider-profile" "\ -Display profile data for var under point QUERY. -Defaults to the symbol at point. With prefix arg or no symbol at point, -prompts for a var. - -\(fn QUERY)" t nil) - -(autoload 'cider-profile-clear "cider-profile" "\ -Clear any collected profile data. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-repl-history" "cider-repl-history.el" -;;;;;; (23450 31943 238481 545000)) -;;; Generated autoloads from cider-repl-history.el - -(autoload 'cider-repl-history "cider-repl-history" "\ -Display items in the CIDER command history in another buffer. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-scratch" "cider-scratch.el" (23450 31943 -;;;;;; 263445 43000)) -;;; 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" (23450 -;;;;;; 31943 272524 257000)) -;;; 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" (23450 31943 232877 -;;;;;; 761000)) -;;; 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-tracing" "cider-tracing.el" (23450 31943 -;;;;;; 245586 221000)) -;;; Generated autoloads from cider-tracing.el - -(autoload 'cider-toggle-trace-var "cider-tracing" "\ -Toggle var tracing. -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -\(fn ARG)" t nil) - -(autoload 'cider-toggle-trace-ns "cider-tracing" "\ -Toggle ns tracing. -Defaults to the current ns. With prefix arg QUERY, prompts for a ns. - -\(fn QUERY)" t nil) - -;;;*** - -;;;### (autoloads nil "cider-util" "cider-util.el" (23450 31943 281050 -;;;;;; 359000)) -;;; 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-completion.el" "cider-connection.el" "cider-doc.el" -;;;;;; "cider-eldoc.el" "cider-eval.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") (23450 31943 286612 426000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; cider-autoloads.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-ns.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-ns.el deleted file mode 100644 index 6f7353532b9a..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-ns.el +++ /dev/null @@ -1,232 +0,0 @@ -;;; cider-browse-ns.el --- CIDER namespace browser - -;; Copyright © 2014-2018 John Andrews, Bozhidar Batsov and CIDER contributors - -;; Author: John Andrews <john.m.andrews@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; M-x cider-browse-ns -;; -;; Display a list of all vars in a namespace. -;; Pressing <enter> 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 <enter> expands into a list of that namespace's vars as if by -;; executing the command (cider-browse-ns "my.ns"). - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-compat) -(require 'cider-util) -(require 'nrepl-dict) - -(require 'subr-x) -(require 'easymenu) -(require 'thingatpt) - -(defconst cider-browse-ns-buffer "*cider-ns-browser*") - -(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) - (easy-menu-define cider-browse-ns-mode-menu map - "Menu for CIDER's namespace browser" - '("Namespace Browser" - ["Show doc" cider-browse-ns-doc-at-point] - ["Go to definition" cider-browse-ns-find-at-point] - "--" - ["Browse all namespaces" cider-browse-ns-all])) - map)) - -(defvar cider-browse-ns-mouse-map - (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-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local cider-browse-ns-current-ns nil)) - -(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 'select nil 'ancillary) - (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 'select nil 'ancillary) - (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 (string-trim (thing-at-point 'line)) " ")))) - (if (string-match "\\." line) - `(ns ,line) - `(var ,(format "%s/%s" - (or (get-text-property (point) 'cider-browse-ns-current-ns) - cider-browse-ns-current-ns) - line))))) - -(defun cider-browse-ns-doc-at-point () - "Show the documentation for the thing at current point." - (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)))) - -(declare-function cider-find-ns "cider-find") -(declare-function cider-find-var "cider-find") - -(defun cider-browse-ns-find-at-point () - "Find the definition of the thing at point." - (interactive) - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-ns.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-ns.elc deleted file mode 100644 index e452c7e4a28c..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-ns.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-spec.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-spec.el deleted file mode 100644 index d58352b16896..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-spec.el +++ /dev/null @@ -1,357 +0,0 @@ -;;; cider-browse-spec.el --- CIDER spec browser - -;; Copyright © 2017 Juan Monetta, Bozhidar Batsov and CIDER contributors - -;; Author: Juan Monetta <jpmonettas@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; M-x cider-browse-spec -;; -;; Display a spec description you can browse. -;; Pressing <enter> over a sub spec will take you to the description of that sub spec. -;; Pressing ^ takes you to the list of all specs. - -;; M-x cider-browse-spec-all -;; -;; Explore clojure.spec registry by browsing a list of all specs. -;; Pressing <enter> over a spec display the spec description you can browse. - -;;; Code: - -(require 'cider-client) -(require 'cider-compat) -(require 'cider-util) -(require 'cl-lib) -(require 'nrepl-dict) -(require 'seq) -(require 'subr-x) -(require 'help-mode) - -;; The buffer names used by the spec browser -(defconst cider-browse-spec-buffer "*cider-spec-browser*") -(defconst cider-browse-spec-example-buffer "*cider-spec-example*") - -;; Mode Definition - -(defvar cider-browse-spec-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (make-composed-keymap button-buffer-map - cider-popup-buffer-mode-map)) - (define-key map (kbd "RET") #'cider-browse-spec--browse-at) - (define-key map "n" #'forward-button) - (define-key map "p" #'backward-button) - map) - "Keymap for `cider-browse-spec-mode'.") - -(define-derived-mode cider-browse-spec-mode special-mode "Specs" - "Major mode for browsing Clojure specs. - -\\{cider-browse-spec-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -(defvar cider-browse-spec--current-spec nil) - -(defvar cider-browse-spec-view-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map help-mode-map) - (define-key map (kbd "RET") #'cider-browse-spec--browse-at) - (define-key map "^" #'cider-browse-spec-all) - (define-key map "e" #'cider-browse-spec--print-curr-spec-example) - (define-key map "n" #'forward-button) - (define-key map "p" #'backward-button) - map) - "Keymap for `cider-browse-spec-view-mode'.") - -(define-derived-mode cider-browse-spec-view-mode help-mode "Spec" - "Major mode for displaying CIDER spec. - -\\{cider-browse-spec-view-mode-map}" - (setq-local cider-browse-spec--current-spec nil) - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -(defvar cider-browse-spec-example-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map "^" #'cider-browse-spec-all) - (define-key map "e" #'cider-browse-spec--print-curr-spec-example) - (define-key map "g" #'revert-buffer) - map) - "Keymap for `cider-browse-spec-example-mode'.") - -(define-derived-mode cider-browse-spec-example-mode special-mode "Example" - "Major mode for Clojure spec examples. - -\\{cider-browse-spec-example-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -;; Non interactive functions - -(define-button-type 'cider-browse-spec--spec - 'action #'cider-browse-spec--browse-at - 'face nil - 'follow-link t - 'help-echo "View spec") - -(defun cider-browse-spec--draw-list-buffer (buffer title specs) - "Reset contents of BUFFER. -Display TITLE at the top and SPECS are indented underneath." - (with-current-buffer buffer - (cider-browse-spec-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (goto-char (point-max)) - (insert (cider-propertize title 'emph) "\n") - (dolist (spec-name specs) - (insert (propertize " " 'spec-name spec-name)) - (thread-first (cider-font-lock-as-clojure spec-name) - (insert-text-button 'type 'cider-browse-spec--spec) - (button-put 'spec-name spec-name)) - (insert (propertize "\n" 'spec-name spec-name))) - (goto-char (point-min))))) - -(defun cider--qualified-keyword-p (str) - "Return non nil if STR is a namespaced keyword." - (string-match-p "^:.+/.+$" str)) - -(defun cider--spec-fn-p (value fn-name) - "Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME." - (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\)/" fn-name "$") value)) - -(defun cider-browse-spec--pprint (form) - "Given a spec FORM builds a multi line string with a pretty render of that FORM." - (cond ((stringp form) - (if (cider--qualified-keyword-p form) - (with-temp-buffer - (thread-first form - (insert-text-button 'type 'cider-browse-spec--spec) - (button-put 'spec-name form)) - (buffer-string)) - ;; to make it easier to read replace all clojure.spec ns with s/ - ;; and remove all clojure.core ns - (thread-last form - (replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\)/" "s/") - (replace-regexp-in-string "^\\(clojure.core\\)/" "")))) - - ((and (listp form) (stringp (cl-first form))) - (let ((form-tag (cl-first form))) - (cond - ;; prettier fns #() - ((string-equal form-tag "clojure.core/fn") - (if (equal (cl-second form) '("%")) - (format "#%s" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))) - (format "(fn [%%] %s)" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))))) - ;; prettier (s/and ) - ((cider--spec-fn-p form-tag "and") - (format "(s/and\n%s)" (string-join (thread-last (cl-rest form) - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n"))) - ;; prettier (s/or ) - ((cider--spec-fn-p form-tag "or") - (let ((name-spec-pair (seq-partition (cl-rest form) 2))) - (format "(s/or\n%s)" (string-join - (thread-last name-spec-pair - (mapcar (lambda (s) (format "%s %s" (cl-first s) (cider-browse-spec--pprint (cl-second s)))))) - "\n")))) - ;; prettier (s/merge ) - ((cider--spec-fn-p form-tag "merge") - (format "(s/merge\n%s)" (string-join (thread-last (cl-rest form) - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n"))) - ;; prettier (s/keys ) - ((cider--spec-fn-p form-tag "keys") - (let ((keys-args (seq-partition (cl-rest form) 2))) - (format "(s/keys%s)" (thread-last - keys-args - (mapcar (lambda (s) - (let ((key-type (cl-first s)) - (specs-vec (cl-second s))) - (concat "\n" key-type - " [" - (string-join (thread-last specs-vec - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n") - "]")))) - (cl-reduce #'concat))))) - ;; prettier (s/multi-spec) - ((cider--spec-fn-p form-tag "multi-spec") - (let ((multi-method (cl-second form)) - (retag (cl-third form)) - (sub-specs (cl-rest (cl-rest (cl-rest form))))) - (format "(s/multi-spec %s %s\n%s)" - multi-method - retag - (string-join - (thread-last sub-specs - (mapcar (lambda (s) - (concat "\n\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) - "\n")))) - ;; prettier (s/cat ) - ((cider--spec-fn-p form-tag "cat") - (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) - (format "(s/cat %s)" - (thread-last name-spec-pairs - (mapcar (lambda (s) - (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat))))) - ;; prettier (s/alt ) - ((cider--spec-fn-p form-tag "alt") - (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) - (format "(s/alt %s)" - (thread-last name-spec-pairs - (mapcar (lambda (s) - (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat))))) - ;; prettier (s/fspec ) - ((cider--spec-fn-p form-tag "fspec") - (thread-last (seq-partition (cl-rest form) 2) - (cl-remove-if (lambda (s) (and (stringp (cl-second s)) - (string-empty-p (cl-second s))))) - (mapcar (lambda (s) - (format "\n%-11s: %s" (pcase (cl-first s) - (":args" "arguments") - (":ret" "returns") - (":fn" "invariants")) - (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat) - (format "%s"))) - ;; every other with no special management - (t (format "(%s %s)" - (cider-browse-spec--pprint form-tag) - (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " ")))))) - (t (format "%s" form)))) - -(defun cider-browse-spec--pprint-indented (spec-form) - "Indent (pretty-print) and font-lock SPEC-FORM. -Return the result as a string." - (with-temp-buffer - (clojure-mode) - (insert (cider-browse-spec--pprint spec-form)) - (indent-region (point-min) (point-max)) - (cider--font-lock-ensure) - (buffer-string))) - -(defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form) - "Reset contents of BUFFER and draws everything needed to browse the SPEC-FORM. -Display SPEC as a title and uses `cider-browse-spec--pprint' to display -a more user friendly representation of SPEC-FORM." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer) - (goto-char (point-max)) - (insert (cider-font-lock-as-clojure spec) "\n\n") - (insert (cider-browse-spec--pprint-indented spec-form)) - (cider--make-back-forward-xrefs) - (current-buffer)))) - -(defun cider-browse-spec--browse (spec) - "Browse SPEC." - (cider-ensure-connected) - (cider-ensure-op-supported "spec-form") - (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select #'cider-browse-spec-view-mode 'ancillary) - (setq-local cider-browse-spec--current-spec spec) - (cider-browse-spec--draw-spec-buffer (current-buffer) - spec - (cider-sync-request:spec-form spec)) - (goto-char (point-min)) - (current-buffer))) - -(defun cider-browse-spec--browse-at (&optional pos) - "View the definition of a spec. - -Optional argument POS is the position of a spec, defaulting to point. POS -may also be a button, so this function can be used a the button's `action' -property." - (interactive) - (let ((pos (or pos (point)))) - (when-let* ((spec (button-get pos 'spec-name))) - (cider-browse-spec--browse spec)))) - -;; Interactive Functions - -(defun cider-browse-spec--print-curr-spec-example () - "Generate and print an example of the current spec." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "spec-example") - (if-let* ((spec cider-browse-spec--current-spec)) - (if-let* ((example (cider-sync-request:spec-example spec))) - (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer 'select #'cider-browse-spec-example-mode 'ancillary) - (setq-local cider-browse-spec--current-spec spec) - (let ((inhibit-read-only t)) - (insert "Example of " (cider-font-lock-as-clojure spec)) - (insert "\n\n") - (insert (cider-font-lock-as-clojure example)) - (goto-char (point-min)))) - (error (format "No example for spec %s" spec))) - (error "No current spec"))) - -(defun cider-browse-spec--example-revert-buffer-function (&rest _) - "`revert-buffer' function for `cider-browse-spec-example-mode'. - -Generates a new example for the current spec." - (cider-browse-spec--print-curr-spec-example)) - -;;;###autoload -(defun cider-browse-spec (spec) - "Browse SPEC definition." - (interactive (list (completing-read "Browse spec: " - (cider-sync-request:spec-list) - nil nil - (cider-symbol-at-point)))) - (cider-browse-spec--browse spec)) - -(defun cider-browse-spec-regex (regex) - "Open the list of specs that matches REGEX in a popup buffer. -Displays all specs when REGEX is nil." - (cider-ensure-connected) - (cider-ensure-op-supported "spec-list") - (let ((filter-regex (or regex ""))) - (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select nil 'ancillary) - (let ((specs (cider-sync-request:spec-list filter-regex))) - (cider-browse-spec--draw-list-buffer (current-buffer) - (if (string-empty-p filter-regex) - "All specs in registry" - (format "All specs matching regex `%s' in registry" filter-regex)) - specs))))) - -;;;###autoload -(defun cider-browse-spec-all (&optional arg) - "Open list of specs in a popup buffer. - -With a prefix argument ARG, prompts for a regexp to filter specs. -No filter applied if the regexp is the empty string." - (interactive "P") - (cider-browse-spec-regex (if arg (read-string "Filter regex: ") ""))) - -(provide 'cider-browse-spec) - -;;; cider-browse-spec.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-spec.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-spec.elc deleted file mode 100644 index a7b18881b3ba..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-spec.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-cheatsheet.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-cheatsheet.el deleted file mode 100644 index d870c5a5a822..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-cheatsheet.el +++ /dev/null @@ -1,577 +0,0 @@ -;;; cider-cheatsheet.el --- Quick reference for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2018 Kris Jenkins, Bozhidar Batsov and CIDER contributors -;; -;; Author: Kris Jenkins <krisajenkins@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A quick reference system for Clojure. Fast, searchable & available offline. - -;; Mostly taken from Kris Jenkins' `clojure-cheatsheet' -;; See: https://github.com/clojure-emacs/clojure-cheatsheet - -;;; Code: - -(require 'cider-doc) -(require 'seq) - -(defconst cider-cheatsheet-hierarchy - '(("Primitives" - ("Numbers" - ("Arithmetic" - (clojure.core + - * / quot rem mod dec inc max min)) - ("Compare" - (clojure.core = == not= < > <= >= compare)) - ("Bitwise" - (clojure.core bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set bit-shift-left bit-shift-right bit-test bit-xor unsigned-bit-shift-right)) - ("Cast" - (clojure.core byte short long int float double bigdec bigint biginteger num rationalize)) - ("Test" - (clojure.core nil? some? identical? zero? pos? neg? even? odd?)) - ("Random" - (clojure.core rand rand-int)) - ("BigDecimal" - (clojure.core with-precision)) - ("Ratios" - (clojure.core numerator denominator ratio?)) - ("Arbitrary Precision Arithmetic" - (clojure.core +\' -\' *\' inc\' dec\')) - ("Unchecked" - (clojure.core *unchecked-math* - unchecked-add - unchecked-add-int - unchecked-byte - unchecked-char - unchecked-dec - unchecked-dec-int - unchecked-divide-int - unchecked-double - unchecked-float - unchecked-inc - unchecked-inc-int - unchecked-int - unchecked-long - unchecked-multiply - unchecked-multiply-int - unchecked-negate - unchecked-negate-int - unchecked-remainder-int - unchecked-short - unchecked-subtract - unchecked-subtract-int))) - - ("Strings" - ("Create" - (clojure.core str format)) - ("Use" - (clojure.core count get subs compare) - (clojure.string join escape split split-lines replace replace-first reverse re-quote-replacement index-of last-index-of starts-with? ends-with? includes?)) - ("Regex" - (clojure.core re-find re-seq re-matches re-pattern re-matcher re-groups) - (clojure.string replace replace-first re-quote-replacement)) - ("Letters" - (clojure.string capitalize lower-case upper-case)) - ("Trim" - (clojure.string trim trim-newline triml trimr)) - ("Test" - (clojure.core char char? string?) - (clojure.string blank?))) - - ("Other" - ("Characters" - (clojure.core char char-name-string char-escape-string)) - ("Keywords" - (clojure.core keyword keyword? find-keyword)) - ("Symbols" - (clojure.core symbol symbol? gensym)) - ("Data Readers" - (clojure.core *data-readers* default-data-readers *default-data-reader-fn*)))) - - ("Collections" - ("Generic Ops" - (clojure.core count bounded-count empty not-empty into conj)) - ("Tree Walking" - (clojure.walk walk prewalk prewalk-demo prewalk-replace postwalk postwalk-demo postwalk-replace keywordize-keys stringify-keys)) - ("Content tests" - (clojure.core distinct? empty? every? not-every? some not-any?)) - ("Capabilities" - (clojure.core sequential? associative? sorted? counted? reversible?)) - ("Type tests" - (clojure.core type class coll? list? vector? set? map? seq? - number? integer? float? decimal? class? rational? ratio? - chunked-seq? reduced? special-symbol? record?)) - ("Lists" - ("Create" - (clojure.core list list*)) - ("Examine" - (clojure.core first nth peek)) - ("Change" - (clojure.core cons conj rest pop))) - - ("Vectors" - ("Create" - (clojure.core vec vector vector-of)) - ("Examine" - (clojure.core get peek)) - - ("Change" - (clojure.core assoc pop subvec replace conj rseq)) - ("Ops" - (clojure.core mapv filterv reduce-kv))) - - ("Sets" - ("Create" - (clojure.core set hash-set sorted-set sorted-set-by)) - ("Examine" - (clojure.core get contains?)) - ("Change" - (clojure.core conj disj)) - ("Relational Algebra" - (clojure.set join select project union difference intersection)) - ("Get map" - (clojure.set index rename-keys rename map-invert)) - ("Test" - (clojure.set subset? superset?)) - ("Sorted Sets" - (clojure.core rseq subseq rsubseq))) - - ("Maps" - ("Create" - (clojure.core hash-map array-map zipmap sorted-map sorted-map-by bean frequencies group-by)) - ("Examine" - (clojure.core get get-in contains? find keys vals map-entry?)) - ("Change" - (clojure.core assoc assoc-in dissoc merge merge-with select-keys update update-in)) - ("Entry" - (clojure.core key val)) - ("Sorted Maps" - (clojure.core rseq subseq rsubseq))) - - ("Hashes" - (clojure.core hash hash-ordered-coll hash-unordered-coll mix-collection-hash)) - - ("Volatiles" - (clojure.core volatile! volatile? vreset! vswap!))) - - ("Functions" - ("Create" - (clojure.core fn defn defn- definline identity constantly comp complement partial juxt memfn memoize fnil every-pred some-fn trampoline)) - ("Call" - (clojure.core -> ->> some-> some->> as-> cond-> cond->>)) - ("Test" - (clojure.core fn? ifn?))) - - ("Transducers" - ("Create" - (clojure.core cat dedupe distinct drop drop-while filter halt-when interpose keep keep-indexed map map-indexed mapcat partition-all partition-by random-sample remove replace take take-nth take-while)) - ("Call" - (clojure.core ->Eduction eduction into sequence transduce completing run!)) - ("Early Termination" - (clojure.core deref reduced reduced? ensure-reduced unreduced))) - - ("Spec" - ("Operations" - (clojure.spec.alpha valid? conform unform explain explain-data explain-str explain-out form describe assert check-asserts check-asserts?)) - ("Generator Ops" - (clojure.spec.alpha gen exercise exercise-fn)) - ("Defn & Registry" - (clojure.spec.alpha def fdef registry get-spec spec? spec with-gen)) - ("Logical" - (clojure.spec.alpha and or)) - ("Collection" - (clojure.spec.alpha coll-of map-of every every-kv keys merge)) - ("Regex " - (clojure.spec.alpha cat alt * + \? & keys*)) - ("Range" - (clojure.spec.alpha int-in inst-in double-in int-in-range? inst-in-range?)) - ("Custom Explain" - (clojure.spec.alpha explain-printer *explain-out*)) - ("Other" - (clojure.spec.alpha nilable multi-spec fspec conformer)) - - ("Predicates with test.check generators" - ("Numbers" - (clojure.core number? rational? integer? ratio? decimal? float? zero? double? int? nat-int? neg-int? pos-int?)) - ("Symbols & Keywords" - (clojure.core keyword? symbol? ident? qualified-ident? qualified-keyword? qualified-symbol? simple-ident? simple-keyword? simple-symbol?)) - ("Scalars" - (clojure.core string? true? false? nil? some? boolean? bytes? inst? uri? uuid?)) - ("Collections" - (clojure.core list? map? set? vector? associative? coll? sequential? seq? empty? indexed? seqable?)) - ("Other" - (clojure.core any?)))) - - ("Other" - ("XML" - (clojure.core xml-seq) - (clojure.xml parse)) - ("REPL" - (clojure.core *1 *2 *3 *e *print-dup* *print-length* *print-level* *print-meta* *print-readably*)) - ("EDN" - (clojure.edn read read-string)) - ("Compiling Code & Class Generation" - (clojure.core *compile-files* *compile-path* *file* *warn-on-reflection* compile gen-class gen-interface loaded-libs test)) - ("Misc" - (clojure.core eval force name *clojure-version* clojure-version *command-line-args*)) - ("Pretty Printing" - (clojure.pprint pprint print-table pp *print-right-margin*)) - ("Browser / Shell" - (clojure.java.browse browse-url) - (clojure.java.shell sh with-sh-dir with-sh-env))) - - ("Vars & Global Environment" - ("Def Variants" - (:special def) - (clojure.core defn defn- definline defmacro defmethod defmulti defonce defrecord)) - ("Interned Vars" - (:special var) - (clojure.core declare intern binding find-var)) - ("Var Objects" - (clojure.core with-local-vars var-get var-set alter-var-root var?)) - ("Var Validators" - (clojure.core set-validator! get-validator))) - - ("Reader Conditionals" - (clojure.core reader-conditional reader-conditional? tagged-literal tagged-literal?)) - - ("Abstractions" - ("Protocols" - (clojure.core defprotocol extend extend-type extend-protocol reify extends? satisfies? extenders)) - ("Records & Types" - (clojure.core defrecord deftype)) - ("Multimethods" - ("Define" - (clojure.core defmulti defmethod)) - ("Dispatch" - (clojure.core get-method methods)) - ("Remove" - (clojure.core remove-method remove-all-methods)) - ("Prefer" - (clojure.core prefer-method prefers)) - ("Relation" - (clojure.core derive isa? parents ancestors descendants make-hierarchy)))) - - ("Macros" - ("Create" - (clojure.core defmacro definline)) - ("Debug" - (clojure.core macroexpand-1 macroexpand) - (clojure.walk macroexpand-all)) - ("Branch" - (clojure.core and or when when-not when-let when-first if-not if-let cond condp case)) - ("Loop" - (clojure.core for doseq dotimes while)) - ("Arrange" - (clojure.core .. doto ->)) - ("Scope" - (clojure.core binding locking time) - (clojure.core with-in-str with-local-vars with-open with-out-str with-precision with-redefs with-redefs-fn)) - ("Lazy" - (clojure.core lazy-cat lazy-seq delay delay?)) - ("Doc" - (clojure.core assert comment) - (clojure.repl doc dir dir-fn source-fn))) - - ("Java Interop" - ("General" - (:special new set!) - (clojure.core .. doto bean comparator enumeration-seq import iterator-seq memfn definterface supers bases)) - ("Cast" - (clojure.core boolean byte short char int long float double bigdec bigint num cast biginteger)) - ("Exceptions" - (:special throw try catch finally) - (clojure.core ex-info ex-data Throwable->map StackTraceElement->vec) - (clojure.repl pst)) - ("Arrays" - ("Create" - (clojure.core boolean-array byte-array double-array char-array float-array int-array long-array make-array object-array short-array to-array)) - ("Manipulate" - (clojure.core aclone aget aset alength amap areduce aset-int aset-long aset-short aset-boolean aset-byte aset-char aset-double aset-float)) - ("Cast" - (clojure.core booleans bytes chars doubles floats ints longs shorts))) - ("Proxy" - ("Create" - (clojure.core proxy get-proxy-class construct-proxy init-proxy)) - ("Misc" - (clojure.core proxy-mappings proxy-super update-proxy)))) - - ("Namespaces" - ("Current" - (clojure.core *ns*)) - ("Create Switch" - (clojure.core ns in-ns create-ns)) - ("Add" - (clojure.core alias import intern refer refer-clojure)) - ("Find" - (clojure.core all-ns find-ns)) - ("Examine" - (clojure.core ns-aliases ns-imports ns-interns ns-map ns-name ns-publics ns-refers)) - ("From symbol" - (clojure.core resolve namespace ns-resolve the-ns)) - ("Remove" - (clojure.core ns-unalias ns-unmap remove-ns))) - ("Loading" - ("Load libs" - (clojure.core require use import refer)) - ("List Loaded" - (clojure.core loaded-libs)) - ("Load Misc" - (clojure.core load load-file load-reader load-string))) - - ("Concurrency" - ("Atoms" - (clojure.core atom swap! swap-vals! reset! reset-vals! compare-and-set!)) - ("Futures" - (clojure.core future future-call future-cancel future-cancelled? future-done? future?)) - ("Threads" - (clojure.core bound-fn bound-fn* get-thread-bindings pop-thread-bindings push-thread-bindings)) - - ("Misc" - (clojure.core locking pcalls pvalues pmap seque promise deliver)) - - ("Refs & Transactions" - ("Create" - (clojure.core ref)) - ("Examine" - (clojure.core deref)) - ("Transaction" - (clojure.core sync dosync io!)) - ("In Transaction" - (clojure.core ensure ref-set alter commute)) - ("Validators" - (clojure.core get-validator set-validator!)) - ("History" - (clojure.core ref-history-count ref-max-history ref-min-history))) - - ("Agents & Asynchronous Actions" - ("Create" - (clojure.core agent)) - ("Examine" - (clojure.core agent-error)) - ("Change State" - (clojure.core send send-off restart-agent send-via set-agent-send-executor! set-agent-send-off-executor!)) - ("Block Waiting" - (clojure.core await await-for)) - ("Ref Validators" - (clojure.core get-validator set-validator!)) - ("Watchers" - (clojure.core add-watch remove-watch)) - ("Thread Handling" - (clojure.core shutdown-agents)) - ("Error" - (clojure.core error-handler set-error-handler! error-mode set-error-mode!)) - ("Misc" - (clojure.core *agent* release-pending-sends)))) - - ("Sequences" - ("Creating a Lazy Seq" - ("From Collection" - (clojure.core seq sequence keys vals rseq subseq rsubseq)) - ("From Producer Fn" - (clojure.core lazy-seq repeatedly iterate)) - ("From Constant" - (clojure.core repeat range)) - ("From Other" - (clojure.core file-seq line-seq resultset-seq re-seq tree-seq xml-seq iterator-seq enumeration-seq)) - ("From Seq" - (clojure.core keep keep-indexed))) - - ("Seq in, Seq out" - ("Get shorter" - (clojure.core distinct dedupe filter remove for)) - ("Get longer" - (clojure.core cons conj concat lazy-cat mapcat cycle interleave interpose))) - ("Tail-items" - (clojure.core rest nthrest fnext nnext drop drop-while take-last for)) - ("Head-items" - (clojure.core take take-nth take-while butlast drop-last for)) - ("Change" - (clojure.core conj concat distinct flatten group-by partition partition-all partition-by split-at split-with filter remove replace shuffle random-sample)) - ("Rearrange" - (clojure.core reverse sort sort-by compare)) - ("Process items" - (clojure.core map pmap map-indexed mapcat for replace seque)) - - ("Using a Seq" - ("Extract item" - (clojure.core first second last rest next ffirst nfirst fnext nnext nth nthnext rand-nth when-first max-key min-key)) - ("Construct coll" - (clojure.core zipmap into reduce reductions set vec into-array to-array-2d)) - ("Pass to fn" - (clojure.core apply)) - ("Search" - (clojure.core some filter)) - ("Force evaluation" - (clojure.core doseq dorun doall)) - ("Check for forced" - (clojure.core realized?)))) - - ("Zippers" - ("Create" - (clojure.zip zipper seq-zip vector-zip xml-zip)) - ("Get loc" - (clojure.zip up down left right leftmost rightmost)) - ("Get seq" - (clojure.zip lefts rights path children)) - ("Change" - (clojure.zip make-node replace edit insert-child insert-left insert-right append-child remove)) - ("Move" - (clojure.zip next prev)) - ("XML" - (clojure.data.zip.xml attr attr= seq-test tag= text text= xml-> xml1->)) - ("Misc" - (clojure.zip root node branch? end?))) - - ("Documentation" - ("REPL" - (clojure.repl doc find-doc apropos source pst) - (clojure.java.javadoc javadoc))) - - ("Transients" - ("Create" - (clojure.core transient persistent!)) - ("Change" - (clojure.core conj! pop! assoc! dissoc! disj!))) - ("Misc" - ("Compare" - (clojure.core = == identical? not= not compare) - (clojure.data diff)) - ("Test" - (clojure.core true? false? nil? instance?))) - - ("IO" - ("To/from ..." - (clojure.core spit slurp)) - ("To *out*" - (clojure.core pr prn print printf println newline) - (clojure.pprint print-table)) - ("To writer" - (clojure.pprint pprint cl-format)) - ("To string" - (clojure.core format with-out-str pr-str prn-str print-str println-str)) - ("From *in*" - (clojure.core read-line read)) - ("From reader" - (clojure.core line-seq read)) - ("From string" - (clojure.core read-string with-in-str)) - ("Open" - (clojure.core with-open) - (clojure.java.io reader writer input-stream output-stream)) - ("Interop" - (clojure.java.io make-writer make-reader make-output-stream make-input-stream)) - ("Misc" - (clojure.core flush file-seq *in* *out* *err*) - (clojure.java.io file copy delete-file resource as-file as-url as-relative-path make-parents))) - - ("Metadata" - (clojure.core meta with-meta alter-meta! reset-meta! vary-meta)) - - ("Special Forms" - (:special def if do quote var recur throw try monitor-enter monitor-exit) - (clojure.core fn loop) - ("Binding / Destructuring" - (clojure.core let fn letfn defn defmacro loop for doseq if-let if-some when-let when-some))) - - ("Async" - ("Main" - (clojure.core.async go go-loop <! <!! >! >!! chan put! take take! close! timeout offer! poll! promise-chan)) - ("Choice" - (clojure.core.async alt! alt!! alts! alts!! do-alts)) - ("Buffering" - (clojure.core.async buffer dropping-buffer sliding-buffer unblocking-buffer?)) - ("Pipelines" - (clojure.core.async pipeline pipeline-async pipeline-blocking)) - ("Threading" - (clojure.core.async thread thread-call)) - ("Mixing" - (clojure.core.async admix solo-mode mix unmix unmix-all toggle merge pipe unique)) - ("Multiples" - (clojure.core.async mult tap untap untap-all)) - ("Publish/Subscribe" - (clojure.core.async pub sub unsub unsub-all)) - ("Higher Order" - (clojure.core.async filter< filter> map map< map> mapcat< mapcat> partition partition-by reduce remove< remove> split)) - ("Pre-Populate" - (clojure.core.async into onto-chan to-chan))) - ("Unit Tests" - ("Defining" - (clojure.test deftest deftest- testing is are)) - ("Running" - (clojure.test run-tests run-all-tests test-vars)) - ("Fixtures" - (clojure.test use-fixtures join-fixtures compose-fixtures)))) - "A data structure for Clojure cheatsheet information. - -It's a tree, where the head of each list determines the context of the rest -of the list. The head may be: - - - A string, in which case it's a (sub)heading for the rest of the items. - - - A symbol, in which case it's the Clojure namespace of the symbols that - follow it. - - - The keyword :special, in which case it's a Clojure special form - - - Any other keyword, in which case it's a typed item that will be passed - through. - -Note that some Clojure symbols appear in more than once. This is entirely -intentional. For instance, `map` belongs in the sections on collections -and transducers.") - -(defun cider-cheatsheet--expand-vars (list) - "Expand the symbols in LIST to fully-qualified var names. - -This list is supposed to have the following format: - - (my-ns var1 var2 var3)" - (let ((ns (car list)) - (vars (cdr list))) - (if (eq ns :special) - (mapcar #'symbol-name vars) - (mapcar (lambda (var) (format "%s/%s" ns var)) vars)))) - -(defun cider-cheatsheet--select-var (var-list) - "Expand the symbols in VAR-LIST to fully-qualified var names. - -The list can hold one or more lists inside - one per each namespace." - (let ((namespaced-vars (seq-mapcat #'cider-cheatsheet--expand-vars - (seq-remove (lambda (list) - (eq (car list) :url)) - var-list)))) - (cider-doc-lookup (completing-read "Select var: " namespaced-vars)))) - -;;;###autoload -(defun cider-cheatsheet () - "Navigate `cider-cheatsheet-hierarchy' with `completing-read'. - -When you make it to a Clojure var its doc buffer gets displayed." - (interactive) - (let ((cheatsheet-data cider-cheatsheet-hierarchy)) - (while (stringp (caar cheatsheet-data)) - (let* ((sections (mapcar #'car cheatsheet-data)) - (sel-section (completing-read "Select cheatsheet section: " sections)) - (section-data (seq-find (lambda (elem) (equal (car elem) sel-section)) cheatsheet-data))) - (setq cheatsheet-data (cdr section-data)))) - (cider-cheatsheet--select-var cheatsheet-data))) - -(provide 'cider-cheatsheet) - -;;; cider-cheatsheet.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-cheatsheet.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-cheatsheet.elc deleted file mode 100644 index 238c9f5cec58..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-cheatsheet.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-classpath.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-classpath.el deleted file mode 100644 index 101413705cb4..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-classpath.el +++ /dev/null @@ -1,112 +0,0 @@ -;;; cider-classpath.el --- Basic Java classpath browser - -;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Basic Java classpath browser for CIDER. - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'subr-x) -(require 'cider-compat) - -(defvar cider-classpath-buffer "*cider-classpath*") - -(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-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (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 'select nil 'ancillary) - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-classpath.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-classpath.elc deleted file mode 100644 index a8ce2b63f683..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-classpath.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-client.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-client.el deleted file mode 100644 index 1e09bae2e299..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-client.el +++ /dev/null @@ -1,577 +0,0 @@ -;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A layer of abstraction above the low-level nREPL client code. - -;;; Code: - -(require 'spinner) -(require 'nrepl-client) -(require 'cider-connection) -(require 'cider-common) -(require 'cider-util) -(require 'clojure-mode) - -(require 'subr-x) -(require 'cider-compat) -(require 'seq) - - -;;; Eval spinner -(defcustom cider-eval-spinner-type 'progress-bar - "Appearance of the evaluation spinner. - -Value is a symbol. The possible values are the symbols in the -`spinner-types' variable." - :type 'symbol - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-show-eval-spinner t - "When true, show the evaluation spinner in the mode line." - :type 'boolean - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-eval-spinner-delay 1 - "Amount of time, in seconds, after which the evaluation spinner will be shown." - :type 'integer - :group 'cider - :package-version '(cider . "0.10.0")) - -(defun cider-spinner-start (buffer) - "Start the evaluation spinner in BUFFER. -Do nothing if `cider-show-eval-spinner' is nil." - (when cider-show-eval-spinner - (with-current-buffer buffer - (spinner-start cider-eval-spinner-type nil - cider-eval-spinner-delay)))) - -(defun cider-eval-spinner-handler (eval-buffer original-callback) - "Return a response handler to stop the spinner and call ORIGINAL-CALLBACK. -EVAL-BUFFER is the buffer where the spinner was started." - (lambda (response) - ;; buffer still exists and - ;; we've got status "done" from nrepl - ;; stop the spinner - (when (and (buffer-live-p eval-buffer) - (let ((status (nrepl-dict-get response "status"))) - (or (member "done" status) - (member "eval-error" status) - (member "error" status)))) - (with-current-buffer eval-buffer - (when spinner-current (spinner-stop)))) - (funcall original-callback response))) - - -;;; Evaluation helpers -(defun cider-ns-form-p (form) - "Check if FORM is an ns form." - (string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form)) - -(defun cider-ns-from-form (ns-form) - "Get ns substring from NS-FORM." - (when (string-match "^[ \t\n]*\(ns[ \t\n]+\\([^][ \t\n(){}]+\\)" ns-form) - (match-string-no-properties 1 ns-form))) - -(defvar-local cider-buffer-ns nil - "Current Clojure namespace of some buffer. -Useful for special buffers (e.g. REPL, doc buffers) that have to keep track -of a namespace. This should never be set in Clojure buffers, as there the -namespace should be extracted from the buffer's ns form.") - -(defun cider-current-ns (&optional no-default) - "Return the current ns. -The ns is extracted from the ns form for Clojure buffers and from -`cider-buffer-ns' for all other buffers. If it's missing, use the current -REPL's ns, otherwise fall back to \"user\". When NO-DEFAULT is non-nil, it -will return nil instead of \"user\"." - (or cider-buffer-ns - (clojure-find-ns) - (when-let* ((repl (cider-current-repl))) - (buffer-local-value 'cider-buffer-ns repl)) - (if no-default nil "user"))) - -(defun cider-expected-ns (&optional path) - "Return the namespace string matching PATH, or nil if not found. -PATH is expected to be an absolute file path. If PATH is nil, use the path -to the file backing the current buffer. The command falls back to -`clojure-expected-ns' in the absence of an active nREPL connection." - (if (cider-connected-p) - (let* ((path (or path (file-truename (buffer-file-name)))) - (relpath (thread-last (cider-sync-request:classpath) - (seq-map - (lambda (cp) - (when (string-prefix-p cp path) - (substring path (length cp))))) - (seq-filter #'identity) - (seq-sort (lambda (a b) - (< (length a) (length b)))) - (car)))) - (if relpath - (thread-last (substring relpath 1) ; remove leading / - (file-name-sans-extension) - (replace-regexp-in-string "/" ".") - (replace-regexp-in-string "_" "-")) - (clojure-expected-ns path))) - (clojure-expected-ns path))) - -(defun cider-nrepl-op-supported-p (op &optional connection) - "Check whether the CONNECTION supports the nREPL middleware OP." - (nrepl-op-supported-p op (or connection (cider-current-repl)))) - -(defvar cider-version) -(defun cider-ensure-op-supported (op) - "Check for support of middleware op OP. -Signal an error if it is not supported." - (unless (cider-nrepl-op-supported-p op) - (user-error "`%s' requires the nREPL op \"%s\". 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-repl)))) - -(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input) - "Send REQUEST to the nREPL server synchronously using CONNECTION. -Hold till final \"done\" message has arrived and join all response messages -of the same \"op\" that came along and return the accumulated response. -If ABORT-ON-INPUT is non-nil, the function will return nil -at the first sign of user input, so as not to hang the -interface." - (nrepl-send-sync-request request - (or connection (cider-current-repl)) - abort-on-input)) - -(defun cider-nrepl-send-unhandled-request (request &optional connection) - "Send REQUEST to the nREPL CONNECTION and ignore any responses. -Immediately mark the REQUEST as done. Return the id of the sent message." - (let* ((conn (or connection (cider-current-repl))) - (id (nrepl-send-request request #'ignore conn))) - (with-current-buffer conn - (nrepl--mark-id-completed id)) - id)) - -(defun cider-nrepl-request:eval (input callback &optional ns line column additional-params connection) - "Send the request INPUT and register the CALLBACK as the response handler. -If NS is non-nil, include it in the request. LINE and COLUMN, if non-nil, -define the position of INPUT in its buffer. ADDITIONAL-PARAMS is a plist -to be appended to the request message. CONNECTION is the connection -buffer, defaults to (cider-current-repl)." - (let ((connection (or connection (cider-current-repl)))) - (nrepl-request:eval input - (if cider-show-eval-spinner - (cider-eval-spinner-handler connection callback) - callback) - connection - ns line column additional-params) - (cider-spinner-start connection))) - -(defun cider-nrepl-sync-request:eval (input &optional connection ns) - "Send the INPUT to the nREPL CONNECTION synchronously. -If NS is non-nil, include it in the eval request." - (nrepl-sync-request:eval input (or connection (cider-current-repl)) ns)) - -(defcustom cider-pprint-fn 'pprint - "Sets the function to use when pretty-printing evaluation results. - -The value must be one of the following symbols: - -`pprint' - to use \\=`clojure.pprint/pprint\\=` - -`fipp' - to use the Fast Idiomatic Pretty Printer, approximately 5-10x -faster than \\=`clojure.core/pprint\\=` (this is the default) - -`puget' - to use Puget, which provides canonical serialization of data on -top of fipp, but at a slight performance cost - -Alternatively, can be the namespace-qualified name of a Clojure function of -one argument. If the function cannot be resolved, an exception will be -thrown. - -The function is assumed to respect the contract of \\=`clojure.pprint/pprint\\=` -with respect to the bound values of \\=`*print-length*\\=`, \\=`*print-level*\\=`, -\\=`*print-meta*\\=`, and \\=`clojure.pprint/*print-right-margin*\\=`." - :type '(choice (const pprint) - (const fipp) - (const puget) - string) - :group 'cider - :package-version '(cider . "0.11.0")) - -(defun cider--pprint-fn () - "Return the value to send in the pprint-fn slot of messages." - (pcase cider-pprint-fn - (`pprint "clojure.pprint/pprint") - (`fipp "cider.nrepl.middleware.pprint/fipp-pprint") - (`puget "cider.nrepl.middleware.pprint/puget-pprint") - (_ cider-pprint-fn))) - -(defun cider--nrepl-pprint-request-plist (right-margin &optional pprint-fn) - "Plist to be appended to an eval request to make it use pprint. -PPRINT-FN is the name of the Clojure function to use. -RIGHT-MARGIN specifies the maximum column-width of the pretty-printed -result, and is included in the request if non-nil." - (nconc `("pprint" "true" - "pprint-fn" ,(or pprint-fn (cider--pprint-fn))) - (and right-margin `("print-right-margin" ,right-margin)))) - -(defun cider--nrepl-content-type-plist () - "Plist to be appended to an eval request to make it use content-types." - '("content-type" "true")) - -(defun cider-tooling-eval (input callback &optional ns connection) - "Send the request INPUT to CONNECTION and register the CALLBACK. -NS specifies the namespace in which to evaluate the request. Requests -evaluated in the tooling nREPL session don't affect the thread-local -bindings of the primary eval nREPL session (e.g. this is not going to -clobber *1/2/3)." - ;; namespace forms are always evaluated in the "user" namespace - (nrepl-request:eval input - callback - (or connection (cider-current-repl)) - ns nil nil nil 'tooling)) - -(defun cider-sync-tooling-eval (input &optional ns connection) - "Send the request INPUT to CONNECTION and evaluate in synchronously. -NS specifies the namespace in which to evaluate the request. Requests -evaluated in the tooling nREPL session don't affect the thread-local -bindings of the primary eval nREPL session (e.g. this is not going to -clobber *1/2/3)." - ;; namespace forms are always evaluated in the "user" namespace - (nrepl-sync-request:eval input - (or connection (cider-current-repl)) - ns - 'tooling)) - -;; TODO: Add some unit tests and pretty those two functions up. -;; FIXME: Currently that's broken for group-id with multiple segments (e.g. org.clojure/clojure) -(defun cider-classpath-libs () - "Return a list of all libs on the classpath." - (let ((libs (seq-filter (lambda (cp-entry) - (string-suffix-p ".jar" cp-entry)) - (cider-sync-request:classpath))) - (dir-sep (if (string-equal system-type "windows-nt") "\\\\" "/"))) - (thread-last libs - (seq-map (lambda (s) (split-string s dir-sep))) - (seq-map #'reverse) - (seq-map (lambda (l) (reverse (seq-take l 4))))))) - -(defun cider-library-present-p (lib) - "Check whether LIB is present on the classpath. -The library is a string of the format \"group-id/artifact-id\"." - (let* ((lib (split-string lib "/")) - (group-id (car lib)) - (artifact-id (cadr lib))) - (seq-find (lambda (lib) - (let ((g (car lib)) - (a (cadr lib))) - (and (equal group-id g) (equal artifact-id a)))) - (cider-classpath-libs)))) - - -;;; Interrupt evaluation - -(defun cider-interrupt-handler (buffer) - "Create an interrupt response handler for BUFFER." - (nrepl-make-response-handler buffer nil nil nil nil)) - -(defun cider-interrupt () - "Interrupt any pending evaluations." - (interactive) - ;; FIXME: does this work correctly in cljc files? - (with-current-buffer (cider-current-repl) - (let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests))) - (dolist (request-id pending-request-ids) - (nrepl-request:interrupt - request-id - (cider-interrupt-handler (current-buffer)) - (cider-current-repl)))))) - -(defun cider-nrepl-eval-session () - "Return the eval nREPL session id of the current connection." - (with-current-buffer (cider-current-repl) - nrepl-session)) - -(defun cider-nrepl-tooling-session () - "Return the tooling nREPL session id of the current connection." - (with-current-buffer (cider-current-repl) - nrepl-tooling-session)) - -(defun cider--var-choice (var-info) - "Prompt to choose from among multiple VAR-INFO candidates, if required. -This is needed only when the symbol queried is an unqualified host platform -method, and multiple classes have a so-named member. If VAR-INFO does not -contain a `candidates' key, it is returned as is." - (let ((candidates (nrepl-dict-get var-info "candidates"))) - (if candidates - (let* ((classes (nrepl-dict-keys candidates)) - (choice (completing-read "Member in class: " classes nil t)) - (info (nrepl-dict-get candidates choice))) - info) - var-info))) - -(defun cider-var-info (var &optional all) - "Return VAR's info as an alist with list cdrs. -When multiple matching vars are returned you'll be prompted to select one, -unless ALL is truthy." - (when (and var (not (string= var ""))) - (let ((var-info (cider-sync-request:info var))) - (if all var-info (cider--var-choice var-info))))) - -(defun cider-member-info (class member) - "Return the CLASS MEMBER's info as an alist with list cdrs." - (when (and class member) - (cider-sync-request:info nil class member))) - - -;;; Requests - -(declare-function cider-load-file-handler "cider-eval") -(defun cider-request:load-file (file-contents file-path file-name &optional connection callback) - "Perform the nREPL \"load-file\" op. -FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be -loaded. If CONNECTION is nil, use `cider-current-repl'. If CALLBACK -is nil, use `cider-load-file-handler'." - (cider-nrepl-send-request `("op" "load-file" - "file" ,file-contents - "file-path" ,file-path - "file-name" ,file-name) - (or callback - (cider-load-file-handler (current-buffer))) - connection)) - - -;;; Sync Requests - -(defcustom cider-filtered-namespaces-regexps - '("^cider.nrepl" "^refactor-nrepl" "^clojure.tools.nrepl" "^nrepl") - "List of regexps used to filter out some vars/symbols/namespaces. -When nil, nothing is filtered out. Otherwise, all namespaces matching any -regexp from this list are dropped out of the \"ns-list\" op. Also, -\"apropos\" won't include vars from such namespaces. This list is passed -on to the nREPL middleware without any pre-processing. So the regexps have -to be in Clojure format (with twice the number of backslashes) and not -Emacs Lisp." - :type '(repeat string) - :safe #'listp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p) - "Send \"apropos\" request for regexp QUERY. - -Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." - (let* ((query (replace-regexp-in-string "[ \t]+" ".+" query)) - (response (cider-nrepl-send-sync-request - `("op" "apropos" - "ns" ,(cider-current-ns) - "query" ,query - ,@(when search-ns `("search-ns" ,search-ns)) - ,@(when docs-p '("docs?" "t")) - ,@(when privates-p '("privates?" "t")) - ,@(when case-sensitive-p '("case-sensitive?" "t")) - "filter-regexps" ,cider-filtered-namespaces-regexps)))) - (if (member "apropos-regexp-error" (nrepl-dict-get response "status")) - (user-error "Invalid regexp: %s" (nrepl-dict-get response "error-msg")) - (nrepl-dict-get response "apropos-matches")))) - -(defun cider-sync-request:classpath () - "Return a list of classpath entries." - (cider-ensure-op-supported "classpath") - (thread-first '("op" "classpath") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "classpath"))) - -(defun cider-sync-request:complete (str context) - "Return a list of completions for STR using nREPL's \"complete\" op. -CONTEXT represents a completion context for compliment." - (when-let* ((dict (thread-first `("op" "complete" - "ns" ,(cider-current-ns) - "symbol" ,str - "context" ,context) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (nrepl-dict-get dict "completions"))) - -(defun cider-sync-request:complete-flush-caches () - "Send \"complete-flush-caches\" op to flush Compliment's caches." - (cider-nrepl-send-sync-request (list "op" "complete-flush-caches" - "session" (cider-nrepl-eval-session)) - 'abort-on-input)) - -(defun cider-sync-request:info (symbol &optional class member) - "Send \"info\" op with parameters SYMBOL or CLASS and MEMBER." - (let ((var-info (thread-first `("op" "info" - "ns" ,(cider-current-ns) - ,@(when symbol `("symbol" ,symbol)) - ,@(when class `("class" ,class)) - ,@(when member `("member" ,member))) - (cider-nrepl-send-sync-request)))) - (if (member "no-info" (nrepl-dict-get var-info "status")) - nil - var-info))) - -(defun cider-sync-request:eldoc (symbol &optional class member) - "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER." - (when-let* ((eldoc (thread-first `("op" "eldoc" - "ns" ,(cider-current-ns) - ,@(when symbol `("symbol" ,symbol)) - ,@(when class `("class" ,class)) - ,@(when member `("member" ,member))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) - nil - eldoc))) - -(defun cider-sync-request:eldoc-datomic-query (symbol) - "Send \"eldoc-datomic-query\" op with parameter SYMBOL." - (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query" - "ns" ,(cider-current-ns) - ,@(when symbol `("symbol" ,symbol))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) - nil - eldoc))) - -(defun cider-sync-request:spec-list (&optional filter-regex) - "Get a list of the available specs in the registry. -Optional argument FILTER-REGEX filters specs. By default, all specs are -returned." - (setq filter-regex (or filter-regex "")) - (thread-first `("op" "spec-list" - "filter-regex" ,filter-regex) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-list"))) - -(defun cider-sync-request:spec-form (spec) - "Get SPEC's form from registry." - (thread-first `("op" "spec-form" - "spec-name" ,spec) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-form"))) - -(defun cider-sync-request:spec-example (spec) - "Get an example for SPEC." - (thread-first `("op" "spec-example" - "spec-name" ,spec) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-example"))) - -(defun cider-sync-request:ns-list () - "Get a list of the available namespaces." - (thread-first `("op" "ns-list" - "filter-regexps" ,cider-filtered-namespaces-regexps) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-list"))) - -(defun cider-sync-request:ns-vars (ns) - "Get a list of the vars in NS." - (thread-first `("op" "ns-vars" - "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars"))) - -(defun cider-sync-request:ns-path (ns) - "Get the path to the file containing NS." - (thread-first `("op" "ns-path" - "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "path"))) - -(defun cider-sync-request:ns-vars-with-meta (ns) - "Get a map of the vars in NS to its metadata information." - (thread-first `("op" "ns-vars-with-meta" - "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars-with-meta"))) - -(defun cider-sync-request:ns-load-all () - "Load all project namespaces." - (thread-first '("op" "ns-load-all") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "loaded-ns"))) - -(defun cider-sync-request:resource (name) - "Perform nREPL \"resource\" op with resource name NAME." - (thread-first `("op" "resource" - "name" ,name) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resource-path"))) - -(defun cider-sync-request:resources-list () - "Return a list of all resources on the classpath. -The result entries are relative to the classpath." - (when-let* ((resources (thread-first '("op" "resources-list") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resources-list")))) - (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources))) - -(defun cider-sync-request:format-code (code) - "Perform nREPL \"format-code\" op with CODE." - (thread-first `("op" "format-code" - "code" ,code) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "formatted-code"))) - -(defun cider-sync-request:format-edn (edn right-margin) - "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." - (let* ((response (thread-first `("op" "format-edn" - "edn" ,edn) - (append (cider--nrepl-pprint-request-plist right-margin)) - (cider-nrepl-send-sync-request))) - (err (nrepl-dict-get response "err"))) - (when err - ;; err will be a stacktrace with a first line that looks like: - ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" - (error (car (split-string err "\n")))) - (nrepl-dict-get response "formatted-edn"))) - -;;; Dealing with input -;; TODO: Replace this with some nil handler. -(defun cider-stdin-handler (&optional _buffer) - "Make a stdin response handler for _BUFFER." - (nrepl-make-response-handler (current-buffer) - (lambda (_buffer _value)) - (lambda (_buffer _out)) - (lambda (_buffer _err)) - nil)) - -(defun cider-need-input (buffer) - "Handle an need-input request from BUFFER." - (with-current-buffer buffer - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "C-c C-c") 'abort-recursive-edit) - (let ((stdin (condition-case nil - (concat (read-from-minibuffer "Stdin: " nil map) "\n") - (quit nil)))) - (nrepl-request:stdin stdin - (cider-stdin-handler buffer) - (cider-current-repl)))))) - -(provide 'cider-client) - -;;; cider-client.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-client.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-client.elc deleted file mode 100644 index d8300d3299cc..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-client.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-common.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-common.el deleted file mode 100644 index 48a274468377..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-common.el +++ /dev/null @@ -1,375 +0,0 @@ -;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- - -;; Copyright © 2015-2018 Artur Malabarba - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Common functions that are useful in both Clojure buffers and REPL -;; buffers. - -;;; Code: - -(require 'subr-x) -(require 'cider-compat) -(require 'nrepl-dict) -(require 'cider-util) -(require 'etags) ; for find-tags-marker-ring -(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")) - -(defcustom cider-special-mode-truncate-lines t - "If non-nil, contents of CIDER's special buffers will be line-truncated. -Should be set before loading CIDER." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.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))) - -;;; Minibuffer -(defvar cider-minibuffer-history '() - "History list of expressions read from the minibuffer.") - -(defvar cider-minibuffer-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "TAB") #'complete-symbol) - (define-key map (kbd "M-TAB") #'complete-symbol) - map) - "Minibuffer keymap used for reading Clojure expressions.") - -(declare-function cider-complete-at-point "cider-completion") -(declare-function cider-eldoc "cider-eldoc") -(defun cider-read-from-minibuffer (prompt &optional value) - "Read a string from the minibuffer, prompting with PROMPT. -If VALUE is non-nil, it is inserted into the minibuffer as initial-input. -PROMPT need not end with \": \". If it doesn't, VALUE is displayed on the -prompt as a default value (used if the user doesn't type anything) and is -not used as initial input (input is left empty)." - (minibuffer-with-setup-hook - (lambda () - (set-syntax-table clojure-mode-syntax-table) - (add-hook 'completion-at-point-functions - #'cider-complete-at-point nil t) - (setq-local eldoc-documentation-function #'cider-eldoc) - (run-hooks 'eval-expression-minibuffer-setup-hook)) - (let* ((has-colon (string-match ": \\'" prompt)) - (input (read-from-minibuffer (cond - (has-colon prompt) - (value (format "%s (default %s): " prompt value)) - (t (format "%s: " prompt))) - (when has-colon value) ; initial-input - cider-minibuffer-map nil - 'cider-minibuffer-history - (unless has-colon value)))) ; default-value - (if (and (equal input "") value (not has-colon)) - value - input)))) - -(defun cider-read-symbol-name (prompt callback) - "Read a symbol name using PROMPT with a default of the one at point. -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-mode "cider-mode") - -(defun cider-jump-to (buffer &optional pos other-window) - "Push current point onto marker ring, and jump to BUFFER and POS. -POS can be either a number, a cons, or a symbol. -If a number, it is the character position (the point). -If a cons, it specifies the position as (LINE . COLUMN). COLUMN can be nil. -If a symbol, `cider-jump-to' searches for something that looks like the -symbol's definition in the file. -If OTHER-WINDOW is non-nil don't reuse current window." - (with-no-warnings - (ring-insert find-tag-marker-ring (point-marker))) - (if other-window - (pop-to-buffer buffer) - ;; like switch-to-buffer, but reuse existing window if BUFFER is visible - (pop-to-buffer buffer '((display-buffer-reuse-window display-buffer-same-window)))) - (with-current-buffer buffer - (widen) - (goto-char (point-min)) - (cider-mode +1) - (cond - ;; Line-column specification. - ((consp pos) - (forward-line (1- (or (car pos) 1))) - (if (cdr pos) - (move-to-column (cdr pos)) - (back-to-indentation))) - ;; Point specification. - ((numberp pos) - (goto-char pos)) - ;; Symbol or string. - (pos - ;; Try to find (def full-name ...). - (if (or (save-excursion - (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote pos)) - nil 'noerror)) - (let ((name (replace-regexp-in-string ".*/" "" pos))) - ;; Try to find (def name ...). - (or (save-excursion - (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote name)) - nil 'noerror)) - ;; Last resort, just find the first occurrence of `name'. - (save-excursion - (search-forward name nil 'noerror))))) - (goto-char (match-beginning 0)) - (message "Can't find %s in %s" pos (buffer-file-name)))) - (t nil)))) - -(defun cider--find-buffer-for-file (file) - "Return a buffer visiting FILE. -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-make-tramp-prefix (method user host) - "Constructs a Tramp file prefix from METHOD, USER, HOST. -It originated from Tramp's `tramp-make-tramp-file-name'. The original be -forced to make full file name with `with-parsed-tramp-file-name', not providing -prefix only option." - (concat tramp-prefix-format - (unless (zerop (length method)) - (concat method tramp-postfix-method-format)) - (unless (zerop (length user)) - (concat user tramp-postfix-user-format)) - (when host - (if (string-match tramp-ipv6-regexp host) - (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) - host)) - tramp-postfix-host-format)) - -(defun cider-tramp-prefix (&optional buffer) - "Use the filename for BUFFER to determine a tramp prefix. -Defaults to the current buffer. Return the tramp prefix, or nil -if BUFFER is local." - (let* ((buffer (or buffer (current-buffer))) - (name (or (buffer-file-name buffer) - (with-current-buffer buffer - default-directory)))) - (when (tramp-tramp-file-p name) - (with-parsed-tramp-file-name name v - (with-no-warnings - (cider-make-tramp-prefix v-method v-user v-host)))))) - -(defun cider--client-tramp-filename (name &optional buffer) - "Return the tramp filename for path NAME relative to BUFFER. -If BUFFER has a tramp prefix, it will be added as a prefix to NAME. -If the resulting path is an existing tramp file, it returns the path, -otherwise, nil." - (let* ((buffer (or buffer (current-buffer))) - (name (replace-regexp-in-string "^file:" "" name)) - (name (concat (cider-tramp-prefix buffer) name))) - (if (tramp-handle-file-exists-p name) - name))) - -(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 AVFS (archive virtual file -system; see online docs) is mounted the archive entry is opened inside the -AVFS directory, otherwise the entry is archived into a temporary read-only -buffer. If URL doesn't contain a scheme prefix and is an absolute path, it -is treated as such. Finally, if URL is relative, it is expanded within each -of the open Clojure buffers till an existing file ending with URL has been -found." - (require 'arc-mode) - (cond ((string-match "^file:\\(.+\\)" url) - (when-let* ((file (cider--url-to-file (match-string 1 url))) - (path (cider--file-path file))) - (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)) - (avfs (format "%s%s#uzip/%s" - (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/")) - path entry))) - (cond - ;; 1) use avfs - ((file-exists-p avfs) - (find-file-noselect avfs)) - ;; 2) already uncompressed - ((find-buffer-visiting name)) - ;; 3) on remotes use Emacs built-in archiving - ((tramp-tramp-file-p path) - (find-file path) - (goto-char (point-min)) - ;; anchor to eol to prevent eg. clj matching cljs. - (re-search-forward (concat entry "$")) - (let ((archive-buffer (current-buffer))) - (archive-extract) - (kill-buffer archive-buffer)) - (current-buffer)) - ;; 4) Use external zip program to extract a single file - (t - (with-current-buffer (generate-new-buffer - (file-name-nondirectory entry)) - (archive-zip-extract path entry) - (set-visited-file-name name) - (setq-local default-directory (file-name-directory path)) - (setq-local buffer-read-only t) - (set-buffer-modified-p nil) - (set-auto-mode) - (current-buffer)))))) - (t (if-let* ((path (cider--file-path url))) - (find-file-noselect path) - (unless (file-name-absolute-p url) - (let ((cider-buffers (cider-util--clojure-buffers)) - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-common.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-common.elc deleted file mode 100644 index c7a2b9e66ef7..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-common.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-compat.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-compat.el deleted file mode 100644 index e6b64b287c0b..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-compat.el +++ /dev/null @@ -1,54 +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-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Everything here was copied from subr-x for compatibility with -;; Emacs 25.1. - -;;; Code: - -(eval-and-compile - - (unless (fboundp 'if-let*) - (defmacro if-let* (bindings then &rest else) - "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in THEN, and its cadr is a sexp to be -evalled to set symbol's value." - (declare (indent 2) - (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) - `(let* ,(internal--build-bindings bindings) - (if ,(car (internal--listify (car (last bindings)))) - ,then - ,@else)))) - - (unless (fboundp 'when-let*) - (defmacro when-let* (bindings &rest body) - "Process BINDINGS and if all values are non-nil eval BODY. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in BODY, and its cadr is a sexp to be -evalled to set symbol's value." - (declare (indent 1) (debug if-let*)) - `(if-let* ,bindings ,(macroexp-progn body))))) - -(provide 'cider-compat) -;;; cider-compat.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-compat.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-compat.elc deleted file mode 100644 index be6816c977df..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-compat.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-completion.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-completion.el deleted file mode 100644 index c52769eec9cb..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-completion.el +++ /dev/null @@ -1,253 +0,0 @@ -;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Smart REPL-powered code completion and integration with company-mode. - -;;; Code: - -(require 'subr-x) -(require 'thingatpt) - -(require 'cider-client) -(require 'cider-common) -(require 'cider-eldoc) -(require 'nrepl-dict) - -(defcustom cider-completion-use-context t - "When true, uses context at point to improve completion suggestions." - :type 'boolean - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-annotate-completion-candidates t - "When true, annotate completion candidates with some extra information." - :type 'boolean - :group 'cider - :package-version '(cider . "0.8.0")) - -(defcustom cider-annotate-completion-function - #'cider-default-annotate-completion-function - "Controls how the annotations for completion candidates are formatted. -Must be a function that takes two arguments: the abbreviation of the -candidate type according to `cider-completion-annotations-alist' and the -candidate's namespace." - :type 'function - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-completion-annotations-alist - '(("class" "c") - ("field" "fi") - ("function" "f") - ("import" "i") - ("keyword" "k") - ("local" "l") - ("macro" "m") - ("method" "me") - ("namespace" "n") - ("protocol" "p") - ("protocol-function" "pf") - ("record" "r") - ("special-form" "s") - ("static-field" "sf") - ("static-method" "sm") - ("type" "t") - ("var" "v")) - "Controls the abbreviations used when annotating completion candidates. - -Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE -is a possible value of the candidate's type returned from the completion -backend, and ABBREVIATION is a short form of that type." - :type '(alist :key-type string :value-type string) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-completion-annotations-include-ns 'unqualified - "Controls passing of namespaces to `cider-annotate-completion-function'. - -When set to 'always, the candidate's namespace will always be passed if it -is available. When set to 'unqualified, the namespace will only be passed -if the candidate is not namespace-qualified." - :type '(choice (const always) - (const unqualified) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defvar cider-completion-last-context nil) - -(defun cider-completion-symbol-start-pos () - "Find the starting position of the symbol at point, unless inside a string." - (let ((sap (symbol-at-point))) - (when (and sap (not (nth 3 (syntax-ppss)))) - (car (bounds-of-thing-at-point 'symbol))))) - -(defun cider-completion-get-context-at-point () - "Extract the context at point. -If point is not inside the list, returns nil; otherwise return \"top-level\" -form, with symbol at point replaced by __prefix__." - (when (save-excursion - (condition-case _ - (progn - (up-list) - (check-parens) - t) - (scan-error nil) - (user-error nil))) - (save-excursion - (let* ((pref-end (point)) - (pref-start (cider-completion-symbol-start-pos)) - (context (cider-defun-at-point)) - (_ (beginning-of-defun)) - (expr-start (point))) - (concat (when pref-start (substring context 0 (- pref-start expr-start))) - "__prefix__" - (substring context (- pref-end expr-start))))))) - -(defun cider-completion-get-context () - "Extract context depending on `cider-completion-use-context' and major mode." - (let ((context (if (and cider-completion-use-context - ;; Important because `beginning-of-defun' and - ;; `ending-of-defun' work incorrectly in the REPL - ;; buffer, so context extraction fails there. - (derived-mode-p 'clojure-mode)) - (or (cider-completion-get-context-at-point) - "nil") - "nil"))) - (if (string= cider-completion-last-context context) - ":same" - (setq cider-completion-last-context context) - context))) - -(defun cider-completion--parse-candidate-map (candidate-map) - "Get \"candidate\" from CANDIDATE-MAP. -Put type and ns properties on the candidate" - (let ((candidate (nrepl-dict-get candidate-map "candidate")) - (type (nrepl-dict-get candidate-map "type")) - (ns (nrepl-dict-get candidate-map "ns"))) - (put-text-property 0 1 'type type candidate) - (put-text-property 0 1 'ns ns candidate) - candidate)) - -(defun cider-complete (str) - "Complete STR with context at point." - (let* ((context (cider-completion-get-context)) - (candidates (cider-sync-request:complete str context))) - (mapcar #'cider-completion--parse-candidate-map candidates))) - -(defun cider-completion--get-candidate-type (symbol) - "Get candidate type for SYMBOL." - (let ((type (get-text-property 0 'type symbol))) - (or (cadr (assoc type cider-completion-annotations-alist)) - type))) - -(defun cider-completion--get-candidate-ns (symbol) - "Get candidate ns for SYMBOL." - (when (or (eq 'always cider-completion-annotations-include-ns) - (and (eq 'unqualified cider-completion-annotations-include-ns) - (not (cider-namespace-qualified-p symbol)))) - (get-text-property 0 'ns symbol))) - -(defun cider-default-annotate-completion-function (type ns) - "Get completion function based on TYPE and NS." - (concat (when ns (format " (%s)" ns)) - (when type (format " <%s>" type)))) - -(defun cider-annotate-symbol (symbol) - "Return a string suitable for annotating SYMBOL. -If SYMBOL has a text property `type` whose value is recognised, its -abbreviation according to `cider-completion-annotations-alist' will be -used. If `type` is present but not recognised, its value will be used -unaltered. If SYMBOL has a text property `ns`, then its value will be used -according to `cider-completion-annotations-include-ns'. The formatting is -performed by `cider-annotate-completion-function'." - (when cider-annotate-completion-candidates - (let* ((type (cider-completion--get-candidate-type symbol)) - (ns (cider-completion--get-candidate-ns symbol))) - (funcall cider-annotate-completion-function type ns)))) - -(defun cider-complete-at-point () - "Complete the symbol at point." - (when-let* ((bounds (bounds-of-thing-at-point 'symbol))) - (when (and (cider-connected-p) - (not (or (cider-in-string-p) (cider-in-comment-p)))) - (list (car bounds) (cdr bounds) - (completion-table-dynamic #'cider-complete) - :annotation-function #'cider-annotate-symbol - :company-doc-buffer #'cider-create-doc-buffer - :company-location #'cider-company-location - :company-docsig #'cider-company-docsig)))) - -(defun cider-completion-flush-caches () - "Force Compliment to refill its caches. -This command should be used if Compliment fails to pick up new classnames -and methods from dependencies that were loaded dynamically after the REPL -has started." - (interactive) - (cider-sync-request:complete-flush-caches)) - -(defun cider-company-location (var) - "Open VAR's definition in a buffer. -Returns the cons of the buffer itself and the location of VAR's definition -in the buffer." - (when-let* ((info (cider-var-info var)) - (file (nrepl-dict-get info "file")) - (line (nrepl-dict-get info "line")) - (buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (cons buffer (point)))))) - -(defun cider-company-docsig (thing) - "Return signature for THING." - (let* ((eldoc-info (cider-eldoc-info thing)) - (ns (lax-plist-get eldoc-info "ns")) - (symbol (lax-plist-get eldoc-info "symbol")) - (arglists (lax-plist-get eldoc-info "arglists"))) - (when eldoc-info - (format "%s: %s" - (cider-eldoc-format-thing ns symbol thing - (cider-eldoc-thing-type eldoc-info)) - (cider-eldoc-format-arglist arglists 0))))) - -;; Fuzzy completion for company-mode - -(defun cider-company-unfiltered-candidates (string &rest _) - "Return CIDER completion candidates for STRING as is, unfiltered." - (cider-complete string)) - -(add-to-list 'completion-styles-alist - '(cider - cider-company-unfiltered-candidates - cider-company-unfiltered-candidates - "CIDER backend-driven completion style.")) - -(defun cider-company-enable-fuzzy-completion () - "Enable backend-driven fuzzy completion in the current buffer." - (setq-local completion-styles '(cider))) - -(provide 'cider-completion) -;;; cider-completion.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-completion.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-completion.elc deleted file mode 100644 index 688ce414a05d..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-completion.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-connection.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-connection.el deleted file mode 100644 index 959b78e50206..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-connection.el +++ /dev/null @@ -1,799 +0,0 @@ -;;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*- -;; -;; Copyright © 2018 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors -;; -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Vitalie Spinu <spinuvit@gmail.com> -;; -;; 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 <http://www.gnu.org/licenses/>. -;; -;; This file is not part of GNU Emacs. -;; -;; -;;; Commentary: -;; -;; -;;; Code: - -(require 'nrepl-client) -(require 'cl-lib) -(require 'format-spec) -(require 'sesman) -(require 'sesman-browser) - -(defcustom cider-session-name-template "%J:%h:%p" - "Format string to use for session names. -See `cider-format-connection-params' for available format characters." - :type 'string - :group 'cider - :package-version '(cider . "0.18.0")) - -(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration - "The function to use to generate the message displayed on connect. -When set to nil no additional message will be displayed. A good -alternative to the default is `cider-random-tip'." - :type 'function - :group 'cider - :package-version '(cider . "0.11.0")) - -(defcustom cider-redirect-server-output-to-repl t - "Controls whether nREPL server output would be redirected to the REPL. -When non-nil the output would end up in both the nrepl-server buffer (when -available) and the matching REPL buffer." - :type 'boolean - :group 'cider - :safe #'booleanp - :package-version '(cider . "0.17.0")) - -(defcustom cider-auto-mode t - "When non-nil, automatically enable cider mode for all Clojure buffers." - :type 'boolean - :group 'cider - :safe #'booleanp - :package-version '(cider . "0.9.0")) - -(defconst cider-required-nrepl-version "0.2.12" - "The minimum nREPL version that's known to work properly with CIDER.") - - -;;; Connect - -(defun cider-nrepl-connect (params) - "Start nrepl client and create the REPL. -PARAMS is a plist containing :host, :port, :server and other parameters for -`cider-repl-create'." - (process-buffer - (nrepl-start-client-process - (plist-get params :host) - (plist-get params :port) - (plist-get params :server) - (lambda (_) - (cider-repl-create params))))) - -(defun cider-connected-p () - "Return t if CIDER is currently connected, nil otherwise." - (process-live-p (get-buffer-process (cider-current-repl)))) - -(defun cider-ensure-connected () - "Ensure there is a linked CIDER session." - (sesman-ensure-session 'CIDER)) - -(defun cider--session-server (session) - "Return server buffer for SESSION or nil if there is no server." - (seq-some (lambda (r) - (buffer-local-value 'nrepl-server-buffer r)) - (cdr session))) - -(defun cider--gather-session-params (session) - "Gather all params for a SESSION." - (let (params) - (dolist (repl (cdr session)) - (setq params (cider--gather-connect-params params repl))) - (when-let* ((server (cider--session-server session))) - (setq params (cider--gather-connect-params params server))) - params)) - -(defun cider--gather-connect-params (&optional params proc-buffer) - "Gather all relevant connection parameters into PARAMS plist. -PROC-BUFFER is either server or client buffer, defaults to current buffer." - (let ((proc-buffer (or proc-buffer (current-buffer)))) - (with-current-buffer proc-buffer - (unless nrepl-endpoint - (error "This is not a REPL or SERVER buffer; is there an active REPL?")) - (let ((server-buf (if (nrepl-server-p proc-buffer) - proc-buffer - nrepl-server-buffer))) - (cl-loop for l on nrepl-endpoint by #'cddr - do (setq params (plist-put params (car l) (cadr l)))) - (setq params (thread-first params - (plist-put :project-dir nrepl-project-dir))) - (when (buffer-live-p server-buf) - (setq params (thread-first params - (plist-put :server (get-buffer-process server-buf)) - (plist-put :server-command nrepl-server-command)))) - ;; repl-specific parameters (do not pollute server params!) - (unless (nrepl-server-p proc-buffer) - (setq params (thread-first params - (plist-put :session-name cider-session-name) - (plist-put :repl-type cider-repl-type) - (plist-put :cljs-repl-type cider-cljs-repl-type) - (plist-put :repl-init-function cider-repl-init-function)))) - params)))) - -(defun cider--close-buffer (buffer) - "Close the BUFFER and kill its associated process (if any)." - (when (buffer-live-p buffer) - (when-let* ((proc (get-buffer-process buffer))) - (when (process-live-p proc) - (delete-process proc))) - (kill-buffer buffer))) - -(declare-function cider-repl-emit-interactive-stderr "cider-repl") -(defun cider--close-connection (repl &optional no-kill) - "Close connection associated with REPL. -When NO-KILL is non-nil stop the connection but don't kill the REPL -buffer." - (when (buffer-live-p repl) - (with-current-buffer repl - (when spinner-current (spinner-stop)) - (when nrepl-tunnel-buffer - (cider--close-buffer nrepl-tunnel-buffer)) - (when no-kill - ;; inform sentinel not to kill the server, if any - (thread-first (get-buffer-process repl) - (process-plist) - (plist-put :no-server-kill t)))) - (let ((proc (get-buffer-process repl))) - (when (and (process-live-p proc) - (or (not nrepl-server-buffer) - ;; Sync request will hang if the server is dead. - (process-live-p (get-buffer-process nrepl-server-buffer)))) - (nrepl-sync-request:close repl) - (delete-process proc))) - (when-let* ((messages-buffer (and nrepl-log-messages - (nrepl-messages-buffer repl)))) - (kill-buffer messages-buffer)) - (if no-kill - (with-current-buffer repl - (goto-char (point-max)) - (cider-repl-emit-interactive-stderr - (format "*** Closed on %s ***\n" (current-time-string)))) - (kill-buffer repl))) - (when repl - (sesman-remove-object 'CIDER nil repl (not no-kill) t))) - -(defun cider-emit-manual-warning (section-id format &rest args) - "Emit a warning to the REPL and link to the online manual. -SECTION-ID is the section to link to. The link is added on the last line. -FORMAT is a format string to compile with ARGS and display on the REPL." - (let ((message (apply #'format format args))) - (cider-repl-emit-interactive-stderr - (concat "WARNING: " message "\n " - (cider--manual-button "More information" section-id) - ".")))) - -(defvar cider-version) -(defun cider--check-required-nrepl-version () - "Check whether we're using a compatible nREPL version." - (if-let* ((nrepl-version (cider--nrepl-version))) - (when (version< nrepl-version cider-required-nrepl-version) - (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" - "CIDER requires nREPL %s (or newer) to work properly" - cider-required-nrepl-version)) - (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" - "Can't determine nREPL's version.\nPlease, update nREPL to %s." - cider-required-nrepl-version))) - -(defvar cider-minimum-clojure-version) -(defun cider--check-clojure-version-supported () - "Ensure that we are meeting the minimum supported version of Clojure." - (if-let* ((clojure-version (cider--clojure-version))) - (when (version< clojure-version cider-minimum-clojure-version) - (cider-emit-manual-warning "installation/#prerequisites" - "Clojure version (%s) is not supported (minimum %s). CIDER will not work." - clojure-version cider-minimum-clojure-version)) - (cider-emit-manual-warning "installation/#prerequisites" - "Can't determine Clojure's version. CIDER requires Clojure %s (or newer)." - cider-minimum-clojure-version))) - -(defvar cider-required-middleware-version) -(defun cider--check-middleware-compatibility () - "CIDER frontend/backend compatibility check. -Retrieve the underlying connection's CIDER-nREPL version and checks if the -middleware used is compatible with CIDER. If not, will display a warning -message in the REPL area." - (let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-repl))) - (middleware-version (nrepl-dict-get version-dict "version-string"))) - (cond - ((null middleware-version) - (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" - "CIDER requires cider-nrepl to be fully functional. Many things will not work without it!")) - ((version< middleware-version cider-required-middleware-version) - (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" - "CIDER %s requires cider-nrepl %s+, but you're currently using cider-nrepl %s. Things will break!" - cider-version cider-required-middleware-version middleware-version))))) - -(declare-function cider-interactive-eval-handler "cider-eval") -;; TODO: Use some null handler here -(defun cider--subscribe-repl-to-server-out () - "Subscribe to the nREPL server's *out*." - (cider-nrepl-send-request '("op" "out-subscribe") - (cider-interactive-eval-handler (current-buffer)))) - -(declare-function cider-mode "cider-mode") -(defun cider-enable-on-existing-clojure-buffers () - "Enable CIDER's minor mode on existing Clojure buffers. -See command `cider-mode'." - (interactive) - (add-hook 'clojure-mode-hook #'cider-mode) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (cider-mode +1)))) - -(defun cider-disable-on-existing-clojure-buffers () - "Disable command `cider-mode' on existing Clojure buffers." - (interactive) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (cider-mode -1)))) - -(defun cider-possibly-disable-on-existing-clojure-buffers () - "If not connected, disable command `cider-mode' on existing Clojure buffers." - (unless (cider-connected-p) - (cider-disable-on-existing-clojure-buffers))) - -(declare-function cider--debug-init-connection "cider-debug") -(declare-function cider-repl-init "cider-repl") -(defun cider--connected-handler () - "Handle CIDER initialization after nREPL connection has been established. -This function is appended to `nrepl-connected-hook' in the client process -buffer." - ;; `nrepl-connected-hook' is run in the connection buffer - ;; `cider-enlighten-mode' changes eval to include the debugger, so we inhibit - ;; it here as the debugger isn't necessarily initialized yet - (let ((cider-enlighten-mode nil)) - ;; after initialization, set mode-line and buffer name. - (cider-set-repl-type cider-repl-type) - (cider-repl-init (current-buffer)) - (cider--check-required-nrepl-version) - (cider--check-clojure-version-supported) - (cider--check-middleware-compatibility) - (when cider-redirect-server-output-to-repl - (cider--subscribe-repl-to-server-out)) - (when cider-auto-mode - (cider-enable-on-existing-clojure-buffers)) - ;; Middleware on cider-nrepl's side is deferred until first usage, but - ;; loading middleware concurrently can lead to occasional "require" issues - ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards - ;; the end, allowing for the faster "server-out" middleware to load - ;; first. - (cider--debug-init-connection) - (when cider-repl-init-function - (funcall cider-repl-init-function)) - (run-hooks 'cider-connected-hook))) - -(defun cider--disconnected-handler () - "Cleanup after nREPL connection has been lost or closed. -This function is appended to `nrepl-disconnected-hook' in the client -process buffer." - ;; `nrepl-connected-hook' is run in the connection buffer - (cider-possibly-disable-on-existing-clojure-buffers) - (run-hooks 'cider-disconnected-hook)) - - -;;; Connection Info - -(defun cider--java-version () - "Retrieve the underlying connection's Java version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "java") - (nrepl-dict-get "version-string"))))) - -(defun cider--clojure-version () - "Retrieve the underlying connection's Clojure version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "clojure") - (nrepl-dict-get "version-string"))))) - -(defun cider--nrepl-version () - "Retrieve the underlying connection's nREPL version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "nrepl") - (nrepl-dict-get "version-string"))))) - -(defun cider--connection-info (connection-buffer &optional genericp) - "Return info about CONNECTION-BUFFER. -Info contains project name, current REPL namespace, host:port endpoint and -Clojure version. When GENERICP is non-nil, don't provide specific info -about this buffer (like variable `cider-repl-type')." - (with-current-buffer connection-buffer - (format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)" - (if genericp "" (upcase (concat cider-repl-type " "))) - (or (cider--project-name nrepl-project-dir) "<no project>") - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port) - (cider--java-version) - (cider--clojure-version) - (cider--nrepl-version)))) - - -;;; Cider's Connection Management UI - -(defun cider-quit (&optional repl) - "Quit the CIDER connection associated with REPL. -REPL defaults to the current REPL." - (interactive) - (let ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure)))) - (cider--close-connection repl)) - ;; if there are no more connections we can kill all ancillary buffers - (unless (cider-connected-p) - (cider-close-ancillary-buffers)) - ;; need this to refresh sesman browser - (run-hooks 'sesman-post-command-hook)) - -(defun cider-restart (&optional repl) - "Restart CIDER connection associated with REPL. -REPL defaults to the current REPL. Don't restart the server or other -connections within the same session. Use `sesman-restart' to restart the -entire session." - (interactive) - (let* ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure))) - (params (thread-first () - (cider--gather-connect-params repl) - (plist-put :session-name (sesman-session-name-for-object 'CIDER repl)) - (plist-put :repl-buffer repl)))) - (cider--close-connection repl 'no-kill) - (cider-nrepl-connect params) - ;; need this to refresh sesman browser - (run-hooks 'sesman-post-command-hook))) - -(defun cider-close-ancillary-buffers () - "Close buffers that are shared across connections." - (interactive) - (dolist (buf-name cider-ancillary-buffers) - (when (get-buffer buf-name) - (kill-buffer buf-name)))) - -(defun cider-describe-connection (&optional repl) - "Display information about the connection associated with REPL. -REPL defaults to the current REPL." - (interactive) - (let ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure)))) - (message "%s" (cider--connection-info repl)))) -(define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-connection "0.18.0") - -(defconst cider-nrepl-session-buffer "*cider-nrepl-session*") - -(defun cider-describe-nrepl-session () - "Describe an nREPL session." - (interactive) - (cider-ensure-connected) - (let* ((repl (cider-current-repl nil 'ensure)) - (selected-session (completing-read "Describe nREPL session: " (nrepl-sessions repl)))) - (when (and selected-session (not (equal selected-session ""))) - (let* ((session-info (nrepl-sync-request:describe repl)) - (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) - (session-id (nrepl-dict-get session-info "session")) - (session-type (cond - ((equal session-id (cider-nrepl-eval-session)) "Active eval") - ((equal session-id (cider-nrepl-tooling-session)) "Active tooling") - (t "Unknown")))) - (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer 'select nil 'ancillary) - (read-only-mode -1) - (insert (format "Session: %s\n" session-id) - (format "Type: %s session\n" session-type) - (format "Supported ops:\n")) - (mapc (lambda (op) (insert (format " * %s\n" op))) ops))) - (display-buffer cider-nrepl-session-buffer)))) - - -;;; Sesman's Session-Wise Management UI - -(cl-defmethod sesman-project ((_system (eql CIDER))) - (clojure-project-dir (cider-current-dir))) - -(cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2) - (sesman-more-recent-p (cdr session1) (cdr session2))) - -(defvar cider-sesman-browser-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "j q") #'cider-quit) - (define-key map (kbd "j k") #'cider-quit) - (define-key map (kbd "j r") #'cider-restart) - (define-key map (kbd "j d") #'cider-describe-connection) - (define-key map (kbd "j i") #'cider-describe-connection) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c C-r") #'cider-restart) - (define-key map (kbd "C-c M-r") #'cider-restart) - (define-key map (kbd "C-c C-d") #'cider-describe-connection) - (define-key map (kbd "C-c M-d") #'cider-describe-connection) - (define-key map (kbd "C-c C-i") #'cider-describe-connection) - map) - "Map active on REPL objects in sesman browser.") - -(cl-defmethod sesman-session-info ((_system (eql CIDER)) session) - (interactive "P") - (list :objects (cdr session) - :map cider-sesman-browser-map)) - -(declare-function cider "cider") -(cl-defmethod sesman-start-session ((_system (eql CIDER))) - "Start a connection of any type interactively. -Fallback on `cider' command." - (call-interactively #'cider)) - -(cl-defmethod sesman-quit-session ((_system (eql CIDER)) session) - (mapc #'cider--close-connection (cdr session)) - ;; if there are no more connections we can kill all ancillary buffers - (unless (cider-connected-p) - (cider-close-ancillary-buffers))) - -(cl-defmethod sesman-restart-session ((_system (eql CIDER)) session) - (let* ((ses-name (car session)) - (repls (cdr session)) - (srv-buf (cider--session-server session))) - (if srv-buf - ;; session with a server - (let ((s-params (cider--gather-connect-params nil srv-buf))) - ;; 1) kill all connections, but keep the buffers - (mapc (lambda (conn) - (cider--close-connection conn 'no-kill)) - repls) - ;; 2) kill the server - (nrepl-kill-server-buffer srv-buf) - ;; 3) start server - (nrepl-start-server-process - (plist-get s-params :project-dir) - (plist-get s-params :server-command) - (lambda (server-buf) - ;; 4) restart the repls reusing the buffer - (dolist (r repls) - (cider-nrepl-connect - (thread-first () - (cider--gather-connect-params r) - ;; server params (:port, :project-dir etc) have precedence - (cider--gather-connect-params server-buf) - (plist-put :session-name ses-name) - (plist-put :repl-buffer r)))) - (sesman-browser-revert-all 'CIDER) - (message "Restarted CIDER %s session" ses-name)))) - ;; server-less session - (dolist (r repls) - (cider--close-connection r 'no-kill) - (cider-nrepl-connect - (thread-first () - (cider--gather-connect-params r) - (plist-put :session-name ses-name) - (plist-put :repl-buffer r))))))) - -(defun cider-format-connection-params (template params) - "Format PARAMS with TEMPLATE string. -The following formats can be used in TEMPLATE string: - - %h - host - %H - remote host, empty for local hosts - %p - port - %j - short project name, or directory name if no project - %J - long project name including parent dir name - %r - REPL type (clj or cljs) - %S - type of the ClojureScript runtime (Nashorn, Node, Figwheel etc.) - %s - session name as defined by `cider-session-name-template'. - -In case some values are empty, extra separators (: and -) are automatically -removed." - (let* ((dir (directory-file-name - (abbreviate-file-name - (or (plist-get params :project-dir) - (clojure-project-dir (cider-current-dir)) - default-directory)))) - (short-proj (file-name-nondirectory (directory-file-name dir))) - (parent-dir (ignore-errors - (thread-first dir file-name-directory - directory-file-name file-name-nondirectory - file-name-as-directory))) - (long-proj (format "%s%s" (or parent-dir "") short-proj)) - ;; use `dir` if it is shorter than `long-proj` or `short-proj` - (short-proj (if (>= (length short-proj) (length dir)) - dir - short-proj)) - (long-proj (if (>= (length long-proj) (length dir)) - dir - long-proj)) - (port (or (plist-get params :port) "")) - (host (or (plist-get params :host) "localhost")) - (remote-host (if (member host '("localhost" "127.0.0.1")) - "" - host)) - (repl-type (or (plist-get params :repl-type) "unknown")) - (cljs-repl-type (or (and (equal repl-type "cljs") - (plist-get params :cljs-repl-type)) - "")) - (specs `((?h . ,host) - (?H . ,remote-host) - (?p . ,port) - (?j . ,short-proj) - (?J . ,long-proj) - (?r . ,repl-type) - (?S . ,cljs-repl-type))) - (ses-name (or (plist-get params :session-name) - (format-spec cider-session-name-template specs))) - (specs (append `((?s . ,ses-name)) specs))) - (thread-last (format-spec template specs) - ;; remove extraneous separators - (replace-regexp-in-string "\\([:-]\\)[:-]+" "\\1") - (replace-regexp-in-string "\\(^[:-]\\)\\|\\([:-]$\\)" "") - (replace-regexp-in-string "[:-]\\([])*]\\)" "\\1")))) - -(defun cider-make-session-name (params) - "Create new session name given plist of connection PARAMS. -Session name can be customized with `cider-session-name-template'." - (let* ((root-name (cider-format-connection-params cider-session-name-template params)) - (other-names (mapcar #'car (sesman-sessions 'CIDER))) - (name root-name) - (i 2)) - (while (member name other-names) - (setq name (concat root-name "#" (number-to-string i)) - i (+ i 1))) - name)) - - -;;; REPL Buffer Init - -(defvar-local cider-cljs-repl-type nil - "The type of the CLJS runtime (Nashorn, Node etc.)") - -(defvar-local cider-repl-type nil - "The type of this REPL buffer, usually either \"clj\" or \"cljs\".") - -(defun cider-repl-type (repl-buffer) - "Get REPL-BUFFER's type." - (buffer-local-value 'cider-repl-type repl-buffer)) - -(defun cider-repl-type-for-buffer (&optional buffer) - "Return the matching connection type (clj or cljs) for BUFFER. -BUFFER defaults to the `current-buffer'. In cljc buffers return -\"multi\". This function infers connection type based on the major mode. -For the REPL type use the function `cider-repl-type'." - (with-current-buffer (or buffer (current-buffer)) - (cond - ((derived-mode-p 'clojurescript-mode) "cljs") - ((derived-mode-p 'clojurec-mode) "multi") - ((derived-mode-p 'clojure-mode) "clj") - (cider-repl-type)))) - -(defun cider-set-repl-type (&optional type) - "Set REPL TYPE to \"clj\" or \"cljs\". -Assume that the current buffer is a REPL." - (interactive) - (let ((type (or type (completing-read - (format "Set REPL type (currently `%s') to: " - cider-repl-type) - '("clj" "cljs"))))) - (when (or (not (equal cider-repl-type type)) - (null mode-name)) - (setq cider-repl-type type) - (setq mode-name (format "REPL[%s]" type)) - (let ((params (cider--gather-connect-params))) - ;; We need to set current name to something else temporarily to avoid - ;; false name duplication in `nrepl-repl-buffer-name`. - (rename-buffer (generate-new-buffer-name "*dummy-cider-repl-buffer*")) - (rename-buffer (nrepl-repl-buffer-name params)) - (when (and nrepl-log-messages nrepl-messages-buffer) - (with-current-buffer nrepl-messages-buffer - (rename-buffer (nrepl-messages-buffer-name params)))))))) - -(declare-function cider-default-err-handler "cider-eval") -(declare-function cider-repl-mode "cider-repl") -(declare-function cider-repl--state-handler "cider-repl") -(declare-function cider-repl-reset-markers "cider-repl") -(defvar-local cider-session-name nil) -(defvar-local cider-repl-init-function nil) -(defun cider-repl-create (params) - "Create new repl buffer. -PARAMS is a plist which contains :repl-type, :host, :port, :project-dir, -:repl-init-function and :session-name. When non-nil, :repl-init-function -must be a function with no arguments which is called after repl creation -function with the repl buffer set as current." - ;; Connection might not have been set as yet. Please don't send requests in - ;; this function, but use cider--connected-handler instead. - (let ((buffer (or (plist-get params :repl-buffer) - (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*")))) - (ses-name (or (plist-get params :session-name) - (cider-make-session-name params)))) - (with-current-buffer buffer - (setq-local sesman-system 'CIDER) - (setq-local default-directory (or (plist-get params :project-dir) default-directory)) - ;; creates a new session if session with ses-name doesn't already exist - (sesman-add-object 'CIDER ses-name buffer 'allow-new) - (unless (derived-mode-p 'cider-repl-mode) - (cider-repl-mode)) - (setq nrepl-err-handler #'cider-default-err-handler - ;; used as a new-repl marker in cider-set-repl-type - mode-name nil - cider-session-name ses-name - nrepl-project-dir (plist-get params :project-dir) - ;; REPLs start with clj and then "upgrade" to a different type - cider-repl-type (plist-get params :repl-type) - ;; ran at the end of cider--connected-handler - cider-repl-init-function (plist-get params :repl-init-function)) - (cider-repl-reset-markers) - (add-hook 'nrepl-response-handler-functions #'cider-repl--state-handler nil 'local) - (add-hook 'nrepl-connected-hook 'cider--connected-handler nil 'local) - (add-hook 'nrepl-disconnected-hook 'cider--disconnected-handler nil 'local) - (current-buffer)))) - - -;;; Current/other REPLs - -(defun cider--no-repls-user-error (type) - "Throw \"No REPL\" user error customized for TYPE." - (let ((type (cond - ((equal type "multi") - "clj or cljs") - ((listp type) - (mapconcat #'identity type " or ")) - (type)))) - (user-error "No %s REPLs in current session \"%s\"" - type (car (sesman-current-session 'CIDER))))) - -(defun cider-current-repl (&optional type ensure) - "Get the most recent REPL of TYPE from the current session. -TYPE is either \"clj\", \"cljs\" or \"multi\". When nil, infer the type -from the current buffer. If ENSURE is non-nil, throw an error if either -there is no linked session or there is no REPL of TYPE within the current -session." - (if (and (derived-mode-p 'cider-repl-mode) - (or (null type) - (string= cider-repl-type type))) - ;; shortcut when in REPL buffer - (current-buffer) - (let* ((type (or type (cider-repl-type-for-buffer))) - (repls (cider-repls type ensure)) - (repl (if (<= (length repls) 1) - (car repls) - ;; pick the most recent one - (seq-find (lambda (b) - (member b repls)) - (buffer-list))))) - (if (and ensure (null repl)) - (cider--no-repls-user-error type) - repl)))) - -(defun cider--match-repl-type (type buffer) - "Return non-nil if TYPE matches BUFFER's REPL type." - (let ((buffer-repl-type (cider-repl-type buffer))) - (cond ((null buffer-repl-type) nil) - ((or (null type) (equal type "multi")) t) - ((listp type) (member buffer-repl-type type)) - (t (string= type buffer-repl-type))))) - -(defun cider-repls (&optional type ensure) - "Return cider REPLs of TYPE from the current session. -If TYPE is nil or \"multi\", return all repls. If TYPE is a list of types, -return only REPLs of type contained in the list. If ENSURE is non-nil, -throw an error if no linked session exists." - (let ((repls (cdr (if ensure - (sesman-ensure-session 'CIDER) - (sesman-current-session 'CIDER))))) - (or (seq-filter (lambda (b) - (cider--match-repl-type type b)) - repls) - (when ensure - (cider--no-repls-user-error type))))) - -(defun cider-map-repls (which function) - "Call FUNCTION once for each appropriate REPL as indicated by WHICH. -The function is called with one argument, the REPL buffer. The appropriate -connections are found by inspecting the current buffer. WHICH is one of -the following keywords: - :auto - Act on the connections whose type matches the current buffer. In - `cljc' files, mapping happens over both types of REPLs. - :clj (:cljs) - Map over clj (cljs)) REPLs only. - :clj-strict (:cljs-strict) - Map over clj (cljs) REPLs but signal a - `user-error' in `clojurescript-mode' (`clojure-mode'). Use this for - commands only supported in Clojure (ClojureScript). -Error is signaled if no REPL buffers of specified type exist in current -session." - (declare (indent 1)) - (let ((cur-type (cider-repl-type-for-buffer))) - (cl-case which - (:clj-strict (when (equal cur-type "cljs") - (user-error "Clojure-only operation requested in a ClojureScript buffer"))) - (:cljs-strict (when (equal cur-type "clj") - (user-error "ClojureScript-only operation requested in a Clojure buffer")))) - (let* ((type (cl-case which - ((:clj :clj-strict) "clj") - ((:cljs :cljs-strict) "cljs") - (:auto (if (equal cur-type "multi") - '("clj" "cljs") - cur-type)))) - (repls (cider-repls type 'ensure))) - (mapcar function repls)))) - -;; REPLs double as connections in CIDER, so it's useful to be able to refer to -;; them as connections in certain contexts. -(defalias 'cider-current-connection #'cider-current-repl) -(defalias 'cider-connections #'cider-repls) -(defalias 'cider-map-connections #'cider-map-repls) -(defalias 'cider-connection-type-for-buffer #'cider-repl-type-for-buffer) - - -;; Deprecation after #2324 - -(define-obsolete-function-alias 'cider-current-repl-buffer 'cider-current-repl "0.18") -(define-obsolete-function-alias 'cider-repl-buffers 'cider-repls "0.18") -(define-obsolete-function-alias 'cider-current-session 'cider-nrepl-eval-session "0.18") -(define-obsolete-function-alias 'cider-current-tooling-session 'cider-nrepl-tooling-session "0.18") -(define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-connection "0.18") -(define-obsolete-function-alias 'nrepl-connection-buffer-name 'nrepl-repl-buffer-name "0.18") -(define-obsolete-function-alias 'cider-repl-set-type 'cider-set-repl-type "0.18") - -(make-obsolete 'cider-assoc-buffer-with-connection 'sesman-link-with-buffer "0.18") -(make-obsolete 'cider-assoc-project-with-connection 'sesman-link-with-project "0.18") -(make-obsolete 'cider-change-buffers-designation nil "0.18") -(make-obsolete 'cider-clear-buffer-local-connection nil "0.18") -(make-obsolete 'cider-close-nrepl-session 'cider-quit "0.18") -(make-obsolete 'cider-create-sibling-cljs-repl 'cider-connect-sibling-cljs "0.18") -(make-obsolete 'cider-current-messages-buffer nil "0.18") -(make-obsolete 'cider-default-connection "see sesman." "0.18") -(make-obsolete 'cider-extract-designation-from-current-repl-buffer nil "0.18") -(make-obsolete 'cider-find-connection-buffer-for-project-directory 'sesman-linked-sessions "0.18") -(make-obsolete 'cider-find-reusable-repl-buffer nil "0.18") -(make-obsolete 'cider-make-connection-default "see sesman." "0.18") -(make-obsolete 'cider-other-connection nil "0.18") -(make-obsolete 'cider-project-connections 'sesman-linked-sessions "0.18") -(make-obsolete 'cider-project-connections-types nil "0.18") -(make-obsolete 'cider-prompt-for-project-on-connect nil "0.18") -(make-obsolete 'cider-read-connection `sesman-ask-for-session "0.18") -(make-obsolete 'cider-replicate-connection nil "0.18") -(make-obsolete 'cider-request-dispatch "see sesman." "0.18") -(make-obsolete 'cider-rotate-default-connection "see sesman." "0.18") -(make-obsolete 'cider-toggle-buffer-connection nil "0.18") -(make-obsolete 'cider-toggle-request-dispatch nil "0.18") -(make-obsolete 'nrepl-connection-buffer-name-template 'nrepl-repl-buffer-name-template "0.18") -(make-obsolete 'nrepl-create-client-buffer-function nil "0.18") -(make-obsolete 'nrepl-post-client-callback nil "0.18") -(make-obsolete 'nrepl-prompt-to-kill-server-buffer-on-quit nil "0.18") -(make-obsolete 'nrepl-use-this-as-repl-buffer nil "0.18") - -;; connection manager -(make-obsolete 'cider-client-name-repl-type "see sesman." "0.18") -(make-obsolete 'cider-connection-browser "see sesman." "0.18") -(make-obsolete 'cider-connections-buffer-mode "see sesman." "0.18") -(make-obsolete 'cider-connections-buffer-mode-map "see sesman." "0.18") -(make-obsolete 'cider-connections-close-connection "see sesman." "0.18") -(make-obsolete 'cider-connections-goto-connection "see sesman." "0.18") -(make-obsolete 'cider-connections-make-default "see sesman." "0.18") -(make-obsolete 'cider-display-connected-message "see sesman." "0.18") -(make-obsolete 'cider-project-name "see sesman." "0.18") - -(provide 'cider-connection) - -;;; cider-connection.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-connection.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-connection.elc deleted file mode 100644 index c467959da491..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-connection.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-debug.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-debug.el deleted file mode 100644 index 7ea5b875008c..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-debug.el +++ /dev/null @@ -1,755 +0,0 @@ -;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*- - -;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; 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-eval) -(require 'cider-client) -(require 'cider-util) -(require 'cider-inspector) -(require 'cider-browse-ns) -(require 'cider-common) -(require 'subr-x) -(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 '("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 - (nconc '("op" "init-debugger") - (when cider-debug-print-level - `("print-level" ,cider-debug-print-level)) - (when cider-debug-print-length - `("print-length" ,cider-debug-print-length))) - #'cider--debug-response-handler)) - - -;;; 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) - (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-repl))))) - (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 non-nil 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 - `("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 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. -The boolean value of FORCE will be sent in the reply." - (interactive (list (cider--uppercase-command-p))) - (unless cider--debug-mode - (user-error "`cider-debug-move-here' only makes sense during a debug session")) - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-debug.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-debug.elc deleted file mode 100644 index ecfce4d3fcb9..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-debug.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-doc.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-doc.el deleted file mode 100644 index 5cca0505639d..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-doc.el +++ /dev/null @@ -1,533 +0,0 @@ -;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Bozhidar Batsov, Jeff Valk and CIDER contributors - -;; Author: Jeff Valk <jv@jeffvalk.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Mode for formatting and presenting documentation - -;;; Code: - -(require 'cider-common) -(require 'subr-x) -(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) -(require 'cider-browse-spec) - - -;;; Variables - -(defgroup cider-doc nil - "Documentation for CIDER." - :prefix "cider-doc-" - :group 'cider) - -(defcustom cider-doc-auto-select-buffer t - "Controls whether to auto-select the doc popup buffer." - :type 'boolean - :group 'cider-doc - :package-version '(cider . "0.15.0")) - -(declare-function cider-apropos "cider-apropos") -(declare-function cider-apropos-select "cider-apropos") -(declare-function cider-apropos-documentation "cider-apropos") -(declare-function cider-apropos-documentation-select "cider-apropos") - -(defvar cider-doc-map - (let (cider-doc-map) - (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))) - - -(defadvice disable-theme (after cider-docview-adapt-to-theme activate) - "When theme is disabled, update `cider-docview-code-background-color'." - (setq cider-docview-code-background-color (cider-scale-background-color))) - - -;; Mode & key bindings - -(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 "<backtab>") #'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 sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (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)) - -(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*") - -(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 nil 'ancillary) symbol info))) - -(defun cider-doc-lookup (symbol) - "Look up documentation for SYMBOL." - (if-let* ((buffer (cider-create-doc-buffer symbol))) - (cider-popup-buffer-display buffer cider-doc-auto-select-buffer) - (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' of FILE-WITH-PROTOCOL." - (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 (when-let* ((str (nrepl-dict-get info "forms-str"))) - (split-string str "\n"))) - (args (when-let* ((str (nrepl-dict-get info "arglists-str"))) - (split-string str "\n"))) - (doc (or (nrepl-dict-get info "doc") - "Not documented.")) - (url (nrepl-dict-get info "url")) - (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-let* ((forms (or forms args))) - (dolist (form forms) - (insert " ") - (emit (cider-font-lock-as-clojure form)))) - (when special - (emit "Special Form" 'font-lock-keyword-face)) - (when macro - (emit "Macro" 'font-lock-variable-name-face)) - (when added - (emit (concat "Added in " added) 'font-lock-comment-face)) - (when depr - (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) - (insert (cider-browse-spec--pprint-indented spec)) - (insert "\n\n") - (insert-text-button "Browse spec" - 'follow-link t - 'action (lambda (_) - (cider-browse-spec (format "%s/%s" ns name)))) - (insert "\n\n")) - (if cider-docview-file - (progn - (insert (propertize (if class java-name clj-name) - '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-text-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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-doc.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-doc.elc deleted file mode 100644 index 5c7fc0320ec4..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-doc.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el deleted file mode 100644 index b055824df3df..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el +++ /dev/null @@ -1,481 +0,0 @@ -;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; eldoc support for Clojure. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) ; for cider-symbol-at-point -(require 'subr-x) -(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.") - -(defcustom cider-eldoc-max-num-sexps-to-skip 30 - "The maximum number of sexps to skip while searching the beginning of current sexp." - :type 'integer - :group 'cider - :package-version '(cider . "0.10.1")) - -(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")) - -(defcustom cider-eldoc-display-context-dependent-info nil - "When non-nil, display context dependent info in the eldoc where possible. -CIDER will try to add expected function arguments based on the current context, -for example for the datomic.api/q function where it will show the expected -inputs of the query at point." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.0")) - -(defun cider--eldoc-format-class-names (class-names) - "Return a formatted CLASS-NAMES prefix string. -CLASS-NAMES is a list of classes to which a Java interop form belongs. -Only keep the first `cider-eldoc-max-class-names-to-display' names, and -add a \"& x more\" suffix. Return nil if the CLASS-NAMES list is empty or -mapping `cider-eldoc-ns-function' on it returns an empty list." - (when-let* ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names))) - (eldoc-class-names-length (length eldoc-class-names))) - (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) - (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 - (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, THING and TYPE. -THING represents the thing at point which triggered eldoc. Normally NS and -SYMBOL are used (they are derived from THING), but when empty we fallback to -THING (e.g. for Java methods). Format it as a function, if FUNCTION-P -is non-nil. Else format it as a variable." - (if-let* ((method-name (if (and symbol (not (string= symbol ""))) - symbol - thing)) - (propertized-method-name (cider-propertize method-name type)) - (ns-or-class (if (and ns (stringp ns)) - (funcall cider-eldoc-ns-function ns) - (cider--eldoc-format-class-names ns)))) - (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 eldoc-info) - "Return the formatted eldoc string for a variable. - -THING is the variable name. ELDOC-INFO is a p-list containing the eldoc -information." - (let* ((ns (lax-plist-get eldoc-info "ns")) - (symbol (lax-plist-get eldoc-info "symbol")) - (docstring (lax-plist-get eldoc-info "docstring")) - (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 ELDOC-INFO 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))))) - `("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))))) - `("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))) - ;; add context dependent args if requested by defcustom - ;; do not cache this eldoc info to avoid showing info - ;: of the previous context - (if cider-eldoc-display-context-dependent-info - (cond - ;; add inputs of datomic query - ((and (equal ns-or-class "datomic.api") - (equal name-or-member "q")) - (let ((arglists (lax-plist-get eldoc-plist "arglists"))) - (lax-plist-put eldoc-plist "arglists" - (cider--eldoc-add-datomic-query-inputs-to-arglists arglists)))) - ;; if none of the clauses is successful, do cache the eldoc - (t (setq cider-eldoc-last-symbol (list thing eldoc-plist)))) - ;; middleware eldoc lookups are expensive, so we - ;; cache the last lookup. This eliminates the need - ;; for extra middleware requests within the same sexp. - (setq cider-eldoc-last-symbol (list thing eldoc-plist))) - eldoc-plist)))))))) - -(defun cider--eldoc-remove-dot (sym) - "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-edn-file-p (file-name) - "Check whether FILE-NAME is representing an EDN file." - (and file-name (equal (file-name-extension file-name) "edn"))) - -(defun cider--eldoc-add-datomic-query-inputs-to-arglists (arglists) - "Add the expected inputs of the datomic query to the ARGLISTS." - (if (cider-second-sexp-in-list) - (let* ((query (cider-second-sexp-in-list)) - (query-inputs (nrepl-dict-get - (cider-sync-request:eldoc-datomic-query query) - "inputs"))) - (if query-inputs - (thread-first - (thread-last arglists - (car) - (remove "&") - (remove "inputs")) - (append (car query-inputs)) - (list)) - arglists)) - arglists)) - -(defun cider-eldoc () - "Backend function for eldoc to show argument list in the echo area." - (when (and (cider-connected-p) - ;; don't clobber an error message in the minibuffer - (not (member last-command '(next-error previous-error))) - ;; don't try to provide eldoc in EDN buffers - (not (cider--eldoc-edn-file-p buffer-file-name))) - (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 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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.elc deleted file mode 100644 index db499612c29c..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el deleted file mode 100644 index 67f2706ba34e..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el +++ /dev/null @@ -1,1115 +0,0 @@ -;;; cider-eval.el --- Interactive evaluation (compilation) functionality -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This file contains CIDER's interactive evaluation (compilation) functionality. -;; Although Clojure doesn't really have the concept of evaluation (only -;; compilation), we're using everywhere in the code the term evaluation for -;; brevity (and to be in line with the naming employed by other similar modes). -;; -;; This files also contains all the logic related to displaying errors and -;; evaluation warnings. -;; -;; Pretty much all of the commands here are meant to be used mostly from -;; `cider-mode', but some of them might make sense in other contexts as well. - -;;; Code: - -(require 'cider-client) -(require 'cider-repl) -(require 'cider-popup) -(require 'cider-common) -(require 'cider-util) -(require 'cider-stacktrace) -(require 'cider-overlays) -(require 'cider-compat) - -(require 'clojure-mode) -(require 'ansi-color) -(require 'cl-lib) -(require 'subr-x) -(require 'compile) - -(defconst cider-read-eval-buffer "*cider-read-eval*") -(defconst cider-result-buffer "*cider-result*") - -(defcustom cider-show-error-buffer t - "Control the popup behavior of cider stacktraces. -The following values are possible t or 'always, 'except-in-repl, -'only-in-repl. Any other value, including nil, will cause the stacktrace -not to be automatically shown. - -Irespective of the value of this variable, the `cider-error-buffer' is -always generated in the background. Use `cider-selector' to -navigate to this buffer." - :type '(choice (const :tag "always" t) - (const except-in-repl) - (const only-in-repl) - (const :tag "never" nil)) - :group 'cider) - -(defcustom cider-auto-jump-to-error t - "Control the cursor jump behaviour in compilation error buffer. -When non-nil automatically jump to error location during interactive -compilation. When set to 'errors-only, don't jump to warnings. -When set to nil, don't jump at all." - :type '(choice (const :tag "always" t) - (const errors-only) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-auto-select-error-buffer t - "Controls whether to auto-select the error popup buffer." - :type 'boolean - :group 'cider) - -(defcustom cider-auto-track-ns-form-changes t - "Controls whether to auto-evaluate a source buffer's ns form when changed. -When non-nil CIDER will check for ns form changes before each eval command. -When nil the users are expected to take care of the re-evaluating updated -ns forms manually themselves." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.0")) - -(defcustom cider-save-file-on-load 'prompt - "Controls whether to prompt to save the file when loading a buffer. -If nil, files are not saved. -If 'prompt, the user is prompted to save the file if it's been modified. -If t, save the file without confirmation." - :type '(choice (const prompt :tag "Prompt to save the file if it's been modified") - (const nil :tag "Don't save the file") - (const t :tag "Save the file without confirmation")) - :group 'cider - :package-version '(cider . "0.6.0")) - - -(defconst cider-output-buffer "*cider-out*") - -(defcustom cider-interactive-eval-output-destination 'repl-buffer - "The destination for stdout and stderr produced from interactive evaluation." - :type '(choice (const output-buffer) - (const repl-buffer)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defface cider-error-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "red") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline t))) - "Face used to highlight compilation errors in Clojure buffers." - :group 'cider) - -(defface cider-warning-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "yellow") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline (:color "yellow")))) - "Face used to highlight compilation warnings in Clojure buffers." - :group 'cider) - -(defcustom cider-comment-prefix ";; => " - "The prefix to insert before the first line of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-comment-continued-prefix ";; " - "The prefix to use on the second and subsequent lines of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-comment-postfix "" - "The postfix to be appended after the final line of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - - -;;; Utilities - -(defun cider--clear-compilation-highlights () - "Remove compilation highlights." - (remove-overlays (point-min) (point-max) 'cider-note-p t)) - -(defun cider-clear-compilation-highlights (&optional arg) - "Remove compilation highlights. -When invoked with a prefix ARG the command doesn't prompt for confirmation." - (interactive "P") - (when (or arg (y-or-n-p "Are you sure you want to clear the compilation highlights? ")) - (cider--clear-compilation-highlights))) - -(defun cider--quit-error-window () - "Buries the `cider-error-buffer' and quits its containing window." - (when-let* ((error-win (get-buffer-window cider-error-buffer))) - (quit-window nil error-win))) - - -;;; Dealing with compilation (evaluation) errors and warnings -(defun cider-find-property (property &optional backward) - "Find the next text region which has the specified PROPERTY. -If BACKWARD is t, then search backward. -Returns the position at which PROPERTY was found, or nil if not found." - (let ((p (if backward - (previous-single-char-property-change (point) property) - (next-single-char-property-change (point) property)))) - (when (and (not (= p (point-min))) (not (= p (point-max)))) - p))) - -(defun cider-jump-to-compilation-error (&optional _arg _reset) - "Jump to the line causing the current compilation error. -_ARG and _RESET are ignored, as there is only ever one compilation error. -They exist for compatibility with `next-error'." - (interactive) - (cl-labels ((goto-next-note-boundary - () - (let ((p (or (cider-find-property 'cider-note-p) - (cider-find-property 'cider-note-p t)))) - (when p - (goto-char p) - (message "%s" (get-char-property p 'cider-note)))))) - ;; if we're already on a compilation error, first jump to the end of - ;; it, so that we find the next error. - (when (get-char-property (point) 'cider-note-p) - (goto-next-note-boundary)) - (goto-next-note-boundary))) - -(defun cider--show-error-buffer-p () - "Return non-nil if the error buffer must be shown on error. -Takes into account both the value of `cider-show-error-buffer' and the -currently selected buffer." - (let* ((selected-buffer (window-buffer (selected-window))) - (replp (with-current-buffer selected-buffer (derived-mode-p 'cider-repl-mode)))) - (memq cider-show-error-buffer - (if replp - '(t always only-in-repl) - '(t always except-in-repl))))) - -(defun cider-new-error-buffer (&optional mode error-types) - "Return an empty error buffer using MODE. - -When deciding whether to display the buffer, takes into account not only -the value of `cider-show-error-buffer' and the currently selected buffer -but also the ERROR-TYPES of the error, which is checked against the -`cider-stacktrace-suppressed-errors' set. - -When deciding whether to select the buffer, takes into account the value of -`cider-auto-select-error-buffer'." - (if (and (cider--show-error-buffer-p) - (not (cider-stacktrace-some-suppressed-errors-p error-types))) - (cider-popup-buffer cider-error-buffer cider-auto-select-error-buffer mode 'ancillary) - (cider-make-popup-buffer cider-error-buffer mode 'ancillary))) - -(defun cider-emit-into-color-buffer (buffer value) - "Emit into color BUFFER the provided VALUE." - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (goto-char (point-max)) - (insert (format "%s" value)) - (ansi-color-apply-on-region (point-min) (point-max))) - (goto-char (point-min)))) - -(defun cider--handle-err-eval-response (response) - "Render eval RESPONSE into a new error buffer. - -Uses the value of the `out' slot in RESPONSE." - (nrepl-dbind-response response (out) - (when out - (let ((error-buffer (cider-new-error-buffer))) - (cider-emit-into-color-buffer error-buffer out) - (with-current-buffer error-buffer - (compilation-minor-mode +1)))))) - -(defun cider-default-err-eval-handler () - "Display the last exception without middleware support." - (cider--handle-err-eval-response - (cider-nrepl-sync-request:eval - "(clojure.stacktrace/print-cause-trace *e)"))) - -(defun cider--render-stacktrace-causes (causes &optional error-types) - "If CAUSES is non-nil, render its contents into a new error buffer. -Optional argument ERROR-TYPES contains a list which should determine the -op/situation that originated this error." - (when causes - (let ((error-buffer (cider-new-error-buffer #'cider-stacktrace-mode error-types))) - (cider-stacktrace-render error-buffer (reverse causes) error-types)))) - -(defun cider--handle-stacktrace-response (response causes) - "Handle stacktrace op RESPONSE, aggregating the result into CAUSES. -If RESPONSE contains a cause, cons it onto CAUSES and return that. If -RESPONSE is the final message (i.e. it contains a status), render CAUSES -into a new error buffer." - (nrepl-dbind-response response (class status) - (cond (class (cons response causes)) - (status (cider--render-stacktrace-causes causes))))) - -(defun cider-default-err-op-handler () - "Display the last exception, with middleware support." - ;; Causes are returned as a series of messages, which we aggregate in `causes' - (let (causes) - (cider-nrepl-send-request - (nconc '("op" "stacktrace") - (when (cider--pprint-fn) - `("pprint-fn" ,(cider--pprint-fn))) - (when cider-stacktrace-print-length - `("print-length" ,cider-stacktrace-print-length)) - (when cider-stacktrace-print-level - `("print-level" ,cider-stacktrace-print-level))) - (lambda (response) - ;; While the return value of `cider--handle-stacktrace-response' is not - ;; meaningful for the last message, we do not need the value of `causes' - ;; after it has been handled, so it's fine to set it unconditionally here - (setq causes (cider--handle-stacktrace-response response causes)))))) - -(defun cider-default-err-handler () - "This function determines how the error buffer is shown. -It delegates the actual error content to the eval or op handler." - (if (cider-nrepl-op-supported-p "stacktrace") - (cider-default-err-op-handler) - (cider-default-err-eval-handler))) - -(defvar cider-compilation-regexp - '("\\(?:.*\\(warning, \\)\\|.*?\\(, compiling\\):(\\)\\(.*?\\):\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\(\\(?: - \\(.*\\)\\)\\|)\\)" 3 4 5 (1)) - "Specifications for matching errors and warnings in Clojure stacktraces. -See `compilation-error-regexp-alist' for help on their format.") - -(add-to-list 'compilation-error-regexp-alist-alist - (cons 'cider cider-compilation-regexp)) -(add-to-list 'compilation-error-regexp-alist 'cider) - -(defun cider-extract-error-info (regexp message) - "Extract error information with REGEXP against MESSAGE." - (let ((file (nth 1 regexp)) - (line (nth 2 regexp)) - (col (nth 3 regexp)) - (type (nth 4 regexp)) - (pat (car regexp))) - (when (string-match pat message) - ;; special processing for type (1.2) style - (setq type (if (consp type) - (or (and (car type) (match-end (car type)) 1) - (and (cdr type) (match-end (cdr type)) 0) - 2))) - (list - (when file - (let ((val (match-string-no-properties file message))) - (unless (string= val "NO_SOURCE_PATH") val))) - (when line (string-to-number (match-string-no-properties line message))) - (when col - (let ((val (match-string-no-properties col message))) - (when val (string-to-number val)))) - (aref [cider-warning-highlight-face - cider-warning-highlight-face - cider-error-highlight-face] - (or type 2)) - message)))) - -(defun cider--goto-expression-start () - "Go to the beginning a list, vector, map or set outside of a string. -We do so by starting and the current position and proceeding backwards -until we find a delimiters that's not inside a string." - (if (and (looking-back "[])}]" (line-beginning-position)) - (null (nth 3 (syntax-ppss)))) - (backward-sexp) - (while (or (not (looking-at-p "[({[]")) - (nth 3 (syntax-ppss))) - (backward-char)))) - -(defun cider--find-last-error-location (message) - "Return the location (begin end buffer) from the Clojure error MESSAGE. -If location could not be found, return nil." - (save-excursion - (let ((info (cider-extract-error-info cider-compilation-regexp message))) - (when info - (let ((file (nth 0 info)) - (line (nth 1 info)) - (col (nth 2 info))) - (unless (or (not (stringp file)) - (cider--tooling-file-p file)) - (when-let* ((buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)) - (move-to-column (or col 0)) - (let ((begin (progn (if col (cider--goto-expression-start) (back-to-indentation)) - (point))) - (end (progn (if col (forward-list) (move-end-of-line nil)) - (point)))) - (list begin end buffer)))))))))))) - -(defun cider-handle-compilation-errors (message eval-buffer) - "Highlight and jump to compilation error extracted from MESSAGE. -EVAL-BUFFER is the buffer that was current during user's interactive -evaluation command. Honor `cider-auto-jump-to-error'." - (when-let* ((loc (cider--find-last-error-location message)) - (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc))) - (info (cider-extract-error-info cider-compilation-regexp message))) - (let* ((face (nth 3 info)) - (note (nth 4 info)) - (auto-jump (if (eq cider-auto-jump-to-error 'errors-only) - (not (eq face 'cider-warning-highlight-face)) - cider-auto-jump-to-error))) - (overlay-put overlay 'cider-note-p t) - (overlay-put overlay 'font-lock-face face) - (overlay-put overlay 'cider-note note) - (overlay-put overlay 'help-echo note) - (overlay-put overlay 'modification-hooks - (list (lambda (o &rest _args) (delete-overlay o)))) - (when auto-jump - (with-current-buffer eval-buffer - (push-mark) - ;; At this stage selected window commonly is *cider-error* and we need to - ;; re-select the original user window. If eval-buffer is not - ;; visible it was probably covered as a result of a small screen or user - ;; configuration (https://github.com/clojure-emacs/cider/issues/847). In - ;; that case we don't jump at all in order to avoid covering *cider-error* - ;; buffer. - (when-let* ((win (get-buffer-window eval-buffer))) - (with-selected-window win - (cider-jump-to (nth 2 loc) (car loc))))))))) - - -;;; Interactive evaluation handlers -(defun cider-insert-eval-handler (&optional buffer) - "Make an nREPL evaluation handler for the BUFFER. -The handler simply inserts the result value in BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (with-current-buffer buffer - (insert value))) - (lambda (_buffer out) - (cider-repl-emit-interactive-stdout out)) - (lambda (_buffer err) - (cider-handle-compilation-errors err eval-buffer)) - '()))) - -(defun cider--emit-interactive-eval-output (output repl-emit-function) - "Emit output resulting from interactive code evaluation. -The OUTPUT can be sent to either a dedicated output buffer or the current -REPL buffer. This is controlled by `cider-interactive-eval-output-destination'. -REPL-EMIT-FUNCTION emits the OUTPUT." - (pcase cider-interactive-eval-output-destination - (`output-buffer (let ((output-buffer (or (get-buffer cider-output-buffer) - (cider-popup-buffer cider-output-buffer t)))) - (cider-emit-into-popup-buffer output-buffer output) - (pop-to-buffer output-buffer))) - (`repl-buffer (funcall repl-emit-function output)) - (_ (error "Unsupported value %s for `cider-interactive-eval-output-destination'" - cider-interactive-eval-output-destination)))) - -(defun cider-emit-interactive-eval-output (output) - "Emit OUTPUT resulting from interactive code evaluation. -The output can be send to either a dedicated output buffer or the current -REPL buffer. This is controlled via -`cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stdout)) - -(defun cider-emit-interactive-eval-err-output (output) - "Emit err OUTPUT resulting from interactive code evaluation. -The output can be send to either a dedicated output buffer or the current -REPL buffer. This is controlled via -`cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stderr)) - -(defun cider--make-fringe-overlays-for-region (beg end) - "Place eval indicators on all sexps between BEG and END." - (with-current-buffer (if (markerp end) - (marker-buffer end) - (current-buffer)) - (save-excursion - (goto-char beg) - (remove-overlays beg end 'category 'cider-fringe-indicator) - (condition-case nil - (while (progn (clojure-forward-logical-sexp) - (and (<= (point) end) - (not (eobp)))) - (cider--make-fringe-overlay (point))) - (scan-error nil))))) - -(defun cider-interactive-eval-handler (&optional buffer place) - "Make an interactive eval handler for BUFFER. -PLACE is used to display the evaluation result. -If non-nil, it can be the position where the evaluated sexp ends, -or it can be a list with (START END) of the evaluated region." - (let* ((eval-buffer (current-buffer)) - (beg (car-safe place)) - (end (or (car-safe (cdr-safe place)) place)) - (beg (when beg (copy-marker beg))) - (end (when end (copy-marker end))) - (fringed nil)) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (if beg - (unless fringed - (cider--make-fringe-overlays-for-region beg end) - (setq fringed t)) - (cider--make-fringe-overlay end)) - (cider--display-interactive-eval-result value end)) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err) - (cider-handle-compilation-errors err eval-buffer)) - '()))) - -(defun cider-load-file-handler (&optional buffer) - "Make a load file handler for BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (buffer value) - (cider--display-interactive-eval-result value) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (cider--make-fringe-overlays-for-region (point-min) (point-max)) - (run-hooks 'cider-file-loaded-hook)))) - (lambda (_buffer value) - (cider-emit-interactive-eval-output value)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err) - (cider-handle-compilation-errors err eval-buffer)) - '() - (lambda () - (funcall nrepl-err-handler))))) - -(defun cider-eval-print-handler (&optional buffer) - "Make a handler for evaluating and printing result in BUFFER." - (nrepl-make-response-handler (or buffer (current-buffer)) - (lambda (buffer value) - (with-current-buffer buffer - (insert - (if (derived-mode-p 'cider-clojure-interaction-mode) - (format "\n%s\n" value) - value)))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - '())) - -(defun cider-eval-print-with-comment-handler (buffer location comment-prefix) - "Make a handler for evaluating and printing commented results in BUFFER. -LOCATION is the location at which to insert. COMMENT-PREFIX is the comment -prefix to use." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (with-current-buffer buffer - (save-excursion - (goto-char location) - (insert (concat comment-prefix - value "\n"))))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - '())) - -(defun cider-eval-pprint-with-multiline-comment-handler (buffer location comment-prefix continued-prefix comment-postfix) - "Make a handler for evaluating and inserting results in BUFFER. -The inserted text is pretty-printed and region will be commented. -LOCATION is the location at which to insert. -COMMENT-PREFIX is the comment prefix for the first line of output. -CONTINUED-PREFIX is the comment prefix to use for the remaining lines. -COMMENT-POSTFIX is the text to output after the last line." - (cl-flet ((multiline-comment-handler (buffer value) - (with-current-buffer buffer - (save-excursion - (goto-char location) - (let ((lines (split-string value "[\n]+" t))) - ;; only the first line gets the normal comment-prefix - (insert (concat comment-prefix (pop lines))) - (dolist (elem lines) - (insert (concat "\n" continued-prefix elem))) - (unless (string= comment-postfix "") - (insert comment-postfix))))))) - (nrepl-make-response-handler buffer - '() - #'multiline-comment-handler - #'multiline-comment-handler - '()))) - -(defun cider-popup-eval-out-handler (&optional buffer) - "Make a handler for evaluating and printing stdout/stderr in popup BUFFER. -This is used by pretty-printing commands and intentionally discards their results." - (cl-flet ((popup-output-handler (buffer str) - (cider-emit-into-popup-buffer buffer - (ansi-color-apply str) - nil - t))) - (nrepl-make-response-handler (or buffer (current-buffer)) - '() - ;; stdout handler - #'popup-output-handler - ;; stderr handler - #'popup-output-handler - '()))) - - -;;; Interactive valuation commands - -(defvar cider-to-nrepl-filename-function - (with-no-warnings - (if (eq system-type 'cygwin) - #'cygwin-convert-file-name-to-windows - #'identity)) - "Function to translate Emacs filenames to nREPL namestrings.") - -(defun cider--prep-interactive-eval (form connection) - "Prepare the environment for an interactive eval of FORM in CONNECTION. -Ensure the current ns declaration has been evaluated (so that the ns -containing FORM exists). Cache ns-form in the current buffer unless FORM is -ns declaration itself. Clear any compilation highlights and kill the error -window." - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((cur-ns-form (cider-ns-form))) - (when (and cur-ns-form - (not (cider-ns-form-p form)) - (cider-repl--ns-form-changed-p cur-ns-form connection)) - (when cider-auto-track-ns-form-changes - ;; The first interactive eval on a file can load a lot of libs. This can - ;; easily lead to more than 10 sec. - (let ((nrepl-sync-request-timeout 30)) - ;; TODO: check for evaluation errors - (cider-nrepl-sync-request:eval cur-ns-form connection))) - ;; cache at the end, in case of errors - (cider-repl--cache-ns-form cur-ns-form connection)))) - -(defvar-local cider-interactive-eval-override nil - "Function to call instead of `cider-interactive-eval'.") - -(defun cider-interactive-eval (form &optional callback bounds additional-params) - "Evaluate FORM and dispatch the response to CALLBACK. -If the code to be evaluated comes from a buffer, it is preferred to use a -nil FORM, and specify the code via the BOUNDS argument instead. - -This function is the main entry point in CIDER's interactive evaluation -API. Most other interactive eval functions should rely on this function. -If CALLBACK is nil use `cider-interactive-eval-handler'. -BOUNDS, if non-nil, is a list of two numbers marking the start and end -positions of FORM in its buffer. -ADDITIONAL-PARAMS is a plist to be appended to the request message. - -If `cider-interactive-eval-override' is a function, call it with the same -arguments and only proceed with evaluation if it returns nil." - (let ((form (or form (apply #'buffer-substring-no-properties bounds))) - (start (car-safe bounds)) - (end (car-safe (cdr-safe bounds)))) - (when (and start end) - (remove-overlays start end 'cider-temporary t)) - (unless (and cider-interactive-eval-override - (functionp cider-interactive-eval-override) - (funcall cider-interactive-eval-override form callback bounds)) - (cider-map-repls :auto - (lambda (connection) - (cider--prep-interactive-eval form connection) - (cider-nrepl-request:eval - form - (or callback (cider-interactive-eval-handler nil bounds)) - ;; always eval ns forms in the user namespace - ;; otherwise trying to eval ns form for the first time will produce an error - (if (cider-ns-form-p form) "user" (cider-current-ns)) - (when start (line-number-at-pos start)) - (when start (cider-column-number-at-pos start)) - additional-params - connection)))))) - -(defun cider-eval-region (start end) - "Evaluate the region between START and END." - (interactive "r") - (cider-interactive-eval nil nil (list start end))) - -(defun cider-eval-last-sexp (&optional output-to-current-buffer) - "Evaluate the expression preceding point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer." - (interactive "P") - (cider-interactive-eval nil - (when output-to-current-buffer (cider-eval-print-handler)) - (cider-last-sexp 'bounds))) - -(defun cider-eval-last-sexp-and-replace () - "Evaluate the expression preceding point and replace it with its result." - (interactive) - (let ((last-sexp (cider-last-sexp))) - ;; we have to be sure the evaluation won't result in an error - (cider-nrepl-sync-request:eval last-sexp) - ;; seems like the sexp is valid, so we can safely kill it - (backward-kill-sexp) - (cider-interactive-eval last-sexp (cider-eval-print-handler)))) - -(defun cider-eval-sexp-at-point (&optional output-to-current-buffer) - "Evaluate the expression around point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." - (interactive "P") - (save-excursion - (goto-char (cadr (cider-sexp-at-point 'bounds))) - (cider-eval-last-sexp output-to-current-buffer))) - -(defvar-local cider-previous-eval-context nil - "The previous evaluation context if any. -That's set by commands like `cider-eval-last-sexp-in-context'.") - -(defun cider--eval-in-context (code) - "Evaluate CODE in user-provided evaluation context." - (let* ((code (string-trim-right code)) - (eval-context (read-string - (format "Evaluation context (let-style) for `%s': " code) - cider-previous-eval-context)) - (code (concat "(let [" eval-context "]\n " code ")"))) - (cider-interactive-eval code) - (setq-local cider-previous-eval-context eval-context))) - -(defun cider-eval-last-sexp-in-context () - "Evaluate the preceding sexp in user-supplied context. -The context is just a let binding vector (without the brackets). -The context is remembered between command invocations." - (interactive) - (cider--eval-in-context (cider-last-sexp))) - -(defun cider-eval-sexp-at-point-in-context () - "Evaluate the preceding sexp in user-supplied context. - -The context is just a let binding vector (without the brackets). -The context is remembered between command invocations." - (interactive) - (cider--eval-in-context (cider-sexp-at-point))) - -(defun cider-eval-defun-to-comment (&optional insert-before) - "Evaluate the \"top-level\" form and insert result as comment. - -The formatting of the comment is defined in `cider-comment-prefix' -which, by default, is \";; => \" and can be customized. - -With the prefix arg INSERT-BEFORE, insert before the form, otherwise afterwards." - (interactive "P") - (let* ((bounds (cider-defun-at-point 'bounds)) - (insertion-point (nth (if insert-before 0 1) bounds))) - (cider-interactive-eval nil - (cider-eval-print-with-comment-handler - (current-buffer) - insertion-point - cider-comment-prefix) - bounds))) - -(defun cider-pprint-form-to-comment (form-fn insert-before) - "Evaluate the form selected by FORM-FN and insert result as comment. -FORM-FN can be either `cider-last-sexp' or `cider-defun-at-point'. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (let* ((bounds (funcall form-fn 'bounds)) - (insertion-point (nth (if insert-before 0 1) bounds)) - ;; when insert-before, we need a newline after the output to - ;; avoid commenting the first line of the form - (comment-postfix (concat cider-comment-postfix - (if insert-before "\n" "")))) - (cider-interactive-eval nil - (cider-eval-pprint-with-multiline-comment-handler - (current-buffer) - insertion-point - cider-comment-prefix - cider-comment-continued-prefix - comment-postfix) - bounds - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) - -(defun cider-pprint-eval-last-sexp-to-comment (&optional insert-before) - "Evaluate the last sexp and insert result as comment. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (interactive "P") - (cider-pprint-form-to-comment 'cider-last-sexp insert-before)) - -(defun cider-pprint-eval-defun-to-comment (&optional insert-before) - "Evaluate the \"top-level\" form and insert result as comment. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (interactive "P") - (cider-pprint-form-to-comment 'cider-defun-at-point insert-before)) - -(declare-function cider-switch-to-repl-buffer "cider-mode") - -(defun cider-eval-last-sexp-to-repl (&optional prefix) - "Evaluate the expression preceding point and insert its result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider-interactive-eval nil - (cider-insert-eval-handler (cider-current-repl)) - (cider-last-sexp 'bounds)) - (when prefix - (cider-switch-to-repl-buffer))) - -(defun cider-pprint-eval-last-sexp-to-repl (&optional prefix) - "Evaluate expr before point and insert its pretty-printed result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider-interactive-eval nil - (cider-insert-eval-handler (cider-current-repl)) - (cider-last-sexp 'bounds) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))) - (when prefix - (cider-switch-to-repl-buffer))) - -(defun cider-eval-print-last-sexp () - "Evaluate the expression preceding point. -Print its value into the current buffer." - (interactive) - (cider-interactive-eval nil - (cider-eval-print-handler) - (cider-last-sexp 'bounds))) - -(defun cider--pprint-eval-form (form) - "Pretty print FORM in popup buffer." - (let* ((result-buffer (cider-popup-buffer cider-result-buffer nil 'clojure-mode 'ancillary)) - (handler (cider-popup-eval-out-handler result-buffer))) - (cider-interactive-eval (when (stringp form) form) - handler - (when (consp form) form) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) - -(defun cider-pprint-eval-last-sexp (&optional output-to-current-buffer) - "Evaluate the sexp preceding point and pprint its value. -If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current -buffer, else display in a popup buffer." - (interactive "P") - (if output-to-current-buffer - (cider-pprint-eval-last-sexp-to-comment) - (cider--pprint-eval-form (cider-last-sexp 'bounds)))) - -(defun cider--prompt-and-insert-inline-dbg () - "Insert a #dbg button at the current sexp." - (save-excursion - (let ((beg)) - (skip-chars-forward "\r\n[:blank:]") - (unless (looking-at-p "(") - (ignore-errors (backward-up-list))) - (setq beg (point)) - (let* ((cond (cider-read-from-minibuffer "Condition for debugging (leave empty for \"always\"): ")) - (button (propertize (concat "#dbg" - (unless (equal cond "") - (format " ^{:break/when %s}" cond))) - 'font-lock-face 'cider-fragile-button-face))) - (when (> (current-column) 30) - (insert "\n") - (indent-according-to-mode)) - (insert button) - (when (> (current-column) 40) - (insert "\n") - (indent-according-to-mode))) - (make-button beg (point) - 'help-echo "Breakpoint. Reevaluate this form to remove it." - :type 'cider-fragile)))) - -(defun cider-eval-defun-at-point (&optional debug-it) - "Evaluate the current toplevel form, and print result in the minibuffer. -With DEBUG-IT prefix argument, also debug the entire form as with the -command `cider-debug-defun-at-point'." - (interactive "P") - (let ((inline-debug (eq 16 (car-safe debug-it)))) - (when debug-it - (when (derived-mode-p 'clojurescript-mode) - (when (y-or-n-p (concat "The debugger doesn't support ClojureScript yet, and we need help with that." - " \nWould you like to read the Feature Request?")) - (browse-url "https://github.com/clojure-emacs/cider/issues/1416")) - (user-error "The debugger does not support ClojureScript")) - (when inline-debug - (cider--prompt-and-insert-inline-dbg))) - (cider-interactive-eval (when (and debug-it (not inline-debug)) - (concat "#dbg\n" (cider-defun-at-point))) - nil (cider-defun-at-point 'bounds)))) - -(defun cider--calculate-opening-delimiters () - "Walks up the list of expressions to collect all sexp opening delimiters. -The result is a list of the delimiters. - -That function is used in `cider-eval-defun-up-to-point' so it can make an -incomplete expression complete." - (interactive) - (let ((result nil)) - (save-excursion - (condition-case nil - (while t - (backward-up-list) - (push (char-after) result)) - (error result))))) - -(defun cider--matching-delimiter (delimiter) - "Get the matching (opening/closing) delimiter for DELIMITER." - (pcase delimiter - (?\( ?\)) - (?\[ ?\]) - (?\{ ?\}) - (?\) ?\() - (?\] ?\[) - (?\} ?\{))) - -(defun cider--calculate-closing-delimiters () - "Compute the list of closing delimiters to make the defun before point valid." - (mapcar #'cider--matching-delimiter (cider--calculate-opening-delimiters))) - -(defun cider-eval-defun-up-to-point (&optional output-to-current-buffer) - "Evaluate the current toplevel form up to point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer. It constructs an expression to eval in the following manner: - -- It find the code between the point and the start of the toplevel expression; -- It balances this bit of code by closing all open expressions; -- It evaluates the resulting code using `cider-interactive-eval'." - (interactive "P") - (let* ((beg-of-defun (save-excursion (beginning-of-defun) (point))) - (code (buffer-substring-no-properties beg-of-defun (point))) - (code (concat code (cider--calculate-closing-delimiters)))) - (cider-interactive-eval - code - (when output-to-current-buffer (cider-eval-print-handler))))) - -(defun cider-eval-sexp-up-to-point (&optional output-to-current-buffer) - "Evaluate the current sexp form up to point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer. It constructs an expression to eval in the following manner: - -- It finds the code between the point and the start of the sexp expression; -- It balances this bit of code by closing the expression; -- It evaluates the resulting code using `cider-interactive-eval'." - (interactive "P") - (let* ((beg-of-sexp (save-excursion (up-list) (backward-list) (point))) - (beg-delimiter (save-excursion (up-list) (backward-list) (char-after))) - (beg-set? (save-excursion (up-list) (backward-list) (char-before))) - (code (buffer-substring-no-properties beg-of-sexp (point))) - (code (if (= beg-set? ?#) (concat (list beg-set?) code) code)) - (code (concat code (list (cider--matching-delimiter beg-delimiter))))) - (cider-interactive-eval code - (when output-to-current-buffer (cider-eval-print-handler))))) - -(defun cider-pprint-eval-defun-at-point (&optional output-to-current-buffer) - "Evaluate the \"top-level\" form at point and pprint its value. -If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current -buffer, else display in a popup buffer." - (interactive "P") - (if output-to-current-buffer - (cider-pprint-eval-defun-to-comment) - (cider--pprint-eval-form (cider-defun-at-point 'bounds)))) - -(defun cider-eval-ns-form () - "Evaluate the current buffer's namespace form." - (interactive) - (when (clojure-find-ns) - (save-excursion - (goto-char (match-beginning 0)) - (cider-eval-defun-at-point)))) - -(defun cider-read-and-eval (&optional value) - "Read a sexp from the minibuffer and output its result to the echo area. -If VALUE is non-nil, it is inserted into the minibuffer as initial input." - (interactive) - (let* ((form (cider-read-from-minibuffer "Clojure Eval: " value)) - (override cider-interactive-eval-override) - (ns-form (if (cider-ns-form-p form) "" (format "(ns %s)" (cider-current-ns))))) - (with-current-buffer (get-buffer-create cider-read-eval-buffer) - (erase-buffer) - (clojure-mode) - (unless (string= "" ns-form) - (insert ns-form "\n\n")) - (insert form) - (let ((cider-interactive-eval-override override)) - (cider-interactive-eval form))))) - -(defun cider-read-and-eval-defun-at-point () - "Insert the toplevel form at point in the minibuffer and output its result. -The point is placed next to the function name in the minibuffer to allow -passing arguments." - (interactive) - (let* ((fn-name (cadr (split-string (cider-defun-at-point)))) - (form (format "(%s)" fn-name))) - (cider-read-and-eval (cons form (length form))))) - -;; Eval keymaps -(defvar cider-eval-pprint-commands-map - (let ((map (define-prefix-command 'cider-eval-pprint-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "e") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "d") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "c e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "c d") #'cider-pprint-eval-defun-to-comment) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-e") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "C-d") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "C-c e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "C-c C-e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "C-c d") #'cider-pprint-eval-defun-to-comment) - (define-key map (kbd "C-c C-d") #'cider-pprint-eval-defun-to-comment))) - -(defvar cider-eval-commands-map - (let ((map (define-prefix-command 'cider-eval-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "w") #'cider-eval-last-sexp-and-replace) - (define-key map (kbd "r") #'cider-eval-region) - (define-key map (kbd "n") #'cider-eval-ns-form) - (define-key map (kbd "d") #'cider-eval-defun-at-point) - (define-key map (kbd "e") #'cider-eval-last-sexp) - (define-key map (kbd "v") #'cider-eval-sexp-at-point) - (define-key map (kbd "o") #'cider-eval-sexp-up-to-point) - (define-key map (kbd ".") #'cider-read-and-eval-defun-at-point) - (define-key map (kbd "z") #'cider-eval-defun-up-to-point) - (define-key map (kbd "c") #'cider-eval-last-sexp-in-context) - (define-key map (kbd "b") #'cider-eval-sexp-at-point-in-context) - (define-key map (kbd "f") 'cider-eval-pprint-commands-map) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-w") #'cider-eval-last-sexp-and-replace) - (define-key map (kbd "C-r") #'cider-eval-region) - (define-key map (kbd "C-n") #'cider-eval-ns-form) - (define-key map (kbd "C-d") #'cider-eval-defun-at-point) - (define-key map (kbd "C-f") #'cider-eval-last-sexp) - (define-key map (kbd "C-v") #'cider-eval-sexp-at-point) - (define-key map (kbd "C-o") #'cider-eval-sexp-up-to-point) - (define-key map (kbd "C-.") #'cider-read-and-eval-defun-at-point) - (define-key map (kbd "C-z") #'cider-eval-defun-up-to-point) - (define-key map (kbd "C-c") #'cider-eval-last-sexp-in-context) - (define-key map (kbd "C-b") #'cider-eval-sexp-at-point-in-context) - (define-key map (kbd "C-f") 'cider-eval-pprint-commands-map))) - -(defun cider--file-string (file) - "Read the contents of a FILE and return as a string." - (with-current-buffer (find-file-noselect file) - (substring-no-properties (buffer-string)))) - -(defun cider-load-buffer (&optional buffer) - "Load (eval) BUFFER's file in nREPL. -If no buffer is provided the command acts on the current buffer. If the -buffer is for a cljc file, and both a Clojure and ClojureScript REPL exists -for the project, it is evaluated in both REPLs." - (interactive) - (setq buffer (or buffer (current-buffer))) - ;; When cider-load-buffer or cider-load-file are called in programs the - ;; current context might not match the buffer's context. We use the caller - ;; context instead of the buffer's context because that's the common use - ;; case. For the other use case just let-bind the default-directory. - (let ((orig-default-directory default-directory)) - (with-current-buffer buffer - (check-parens) - (let ((default-directory orig-default-directory)) - (unless buffer-file-name - (user-error "Buffer `%s' is not associated with a file" (current-buffer))) - (when (and cider-save-file-on-load - (buffer-modified-p) - (or (eq cider-save-file-on-load t) - (y-or-n-p (format "Save file %s? " buffer-file-name)))) - (save-buffer)) - (remove-overlays nil nil 'cider-temporary t) - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((filename (buffer-file-name buffer)) - (ns-form (cider-ns-form))) - (cider-map-repls :auto - (lambda (repl) - (when ns-form - (cider-repl--cache-ns-form ns-form repl)) - (cider-request:load-file (cider--file-string filename) - (funcall cider-to-nrepl-filename-function - (cider--server-filename filename)) - (file-name-nondirectory filename) - repl))) - (message "Loading %s..." filename)))))) - -(defun cider-load-file (filename) - "Load (eval) the Clojure file FILENAME in nREPL. -If the file is a cljc file, and both a Clojure and ClojureScript REPL -exists for the project, it is evaluated in both REPLs. The heavy lifting -is done by `cider-load-buffer'." - (interactive (list - (read-file-name "Load file: " nil nil nil - (when (buffer-file-name) - (file-name-nondirectory - (buffer-file-name)))))) - (if-let* ((buffer (find-buffer-visiting filename))) - (cider-load-buffer buffer) - (cider-load-buffer (find-file-noselect filename)))) - -(defun cider-load-all-files (directory) - "Load all files in DIRECTORY (recursively). -Useful when the running nREPL on remote host." - (interactive "DLoad files beneath directory: ") - (mapcar #'cider-load-file - (directory-files-recursively directory ".clj$"))) - -(defalias 'cider-eval-file 'cider-load-file - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-all-files 'cider-load-all-files - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-buffer 'cider-load-buffer - "A convenience alias as some people are confused by the load-* names.") - -(defun cider-load-all-project-ns () - "Load all namespaces in the current project." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "ns-load-all") - (when (y-or-n-p "Are you sure you want to load all namespaces in the project? ") - (message "Loading all project namespaces...") - (let ((loaded-ns-count (length (cider-sync-request:ns-load-all)))) - (message "Loaded %d namespaces" loaded-ns-count)))) - -(provide 'cider-eval) - -;;; cider-eval.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.elc deleted file mode 100644 index a054e3a55e60..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-find.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-find.el deleted file mode 100644 index fb4969c18302..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-find.el +++ /dev/null @@ -1,236 +0,0 @@ -;;; cider-find.el --- Functionality for finding things -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A bunch of commands for finding resources and definitions. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) - -(require 'thingatpt) - -(defun cider--find-var-other-window (var &optional line) - "Find the definition of VAR, optionally at a specific LINE. - -Display the results in a different window." - (if-let* ((info (cider-var-info var))) - (progn - (if line (setq info (nrepl-dict-put info "line" line))) - (cider--jump-to-loc-from-info info t)) - (user-error "Symbol `%s' not resolved" var))) - -(defun cider--find-var (var &optional line) - "Find the definition of VAR, optionally at a specific LINE." - (if-let* ((info (cider-var-info var))) - (progn - (if line (setq info (nrepl-dict-put info "line" line))) - (cider--jump-to-loc-from-info info)) - (user-error "Symbol `%s' not resolved" var))) - -;;;###autoload -(defun cider-find-var (&optional arg var line) - "Find definition for VAR at LINE. -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point." - (interactive "P") - (cider-ensure-op-supported "info") - (let ((orig-buff (current-buffer)) - (session (sesman-current-session 'CIDER))) - (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))) - (when (and (not (eq orig-buff (current-buffer))) - session) - (sesman-link-session 'CIDER session)))) - -;;;###autoload -(defun cider-find-dwim-at-mouse (event) - "Find and display variable or resource at mouse EVENT." - (interactive "e") - (cider-ensure-op-supported "info") - (if-let* ((symbol-file (save-excursion - (mouse-set-point event) - (cider-symbol-at-point 'look-back)))) - (cider-find-dwim symbol-file) - (user-error "No variable or resource here"))) - -(defun cider--find-dwim (symbol-file callback &optional other-window) - "Find the SYMBOL-FILE at point. -CALLBACK upon failure to invoke prompt if not prompted previously. -Show results in a different window if OTHER-WINDOW is true." - (if-let* ((info (cider-var-info symbol-file))) - (cider--jump-to-loc-from-info info other-window) - (progn - (cider-ensure-op-supported "resource") - (if-let* ((resource (cider-sync-request:resource symbol-file)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer 0 other-window) - (if (cider--prompt-for-symbol-p current-prefix-arg) - (error "Resource or var %s not resolved" symbol-file) - (let ((current-prefix-arg (if current-prefix-arg nil '(4)))) - (call-interactively callback))))))) - -(defun cider--find-dwim-interactive (prompt) - "Get interactive arguments for jump-to functions using PROMPT as needed." - (if (cider--prompt-for-symbol-p current-prefix-arg) - (list - (cider-read-from-minibuffer prompt (thing-at-point 'filename))) - (list (or (thing-at-point 'filename) "")))) ; No prompt. - -(defun cider-find-dwim-other-window (symbol-file) - "Jump to SYMBOL-FILE at point, place results in other window." - (interactive (cider--find-dwim-interactive "Jump to: ")) - (cider--find-dwim symbol-file 'cider-find-dwim-other-window t)) - -;;;###autoload -(defun cider-find-dwim (symbol-file) - "Find and display the SYMBOL-FILE at point. -SYMBOL-FILE could be a var or a resource. If thing at point is empty then -show dired on project. If var is not found, try to jump to resource of the -same name. When called interactively, a prompt is given according to the -variable `cider-prompt-for-symbol'. A single or double prefix argument -inverts the meaning. A prefix of `-' or a double prefix argument causes -the results to be displayed in a different window. A default value of thing -at point is given when prompted." - (interactive (cider--find-dwim-interactive "Jump to: ")) - (cider--find-dwim symbol-file `cider-find-dwim - (cider--open-other-window-p current-prefix-arg))) - -;;;###autoload -(defun cider-find-resource (path) - "Find the resource at PATH. -Prompt for input as indicated by the variable `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix -argument causes the results to be displayed in other window. The default -value is thing at point." - (interactive - (list - (if (cider--prompt-for-symbol-p current-prefix-arg) - (completing-read "Resource: " - (cider-sync-request:resources-list) - nil nil - (thing-at-point 'filename)) - (or (thing-at-point 'filename) "")))) - (cider-ensure-op-supported "resource") - (when (= (length path) 0) - (error "Cannot find resource for empty path")) - (if-let* ((resource (cider-sync-request:resource path)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg)) - (if (cider--prompt-for-symbol-p current-prefix-arg) - (error "Cannot find resource %s" path) - (let ((current-prefix-arg (cider--invert-prefix-arg current-prefix-arg))) - (call-interactively 'cider-find-resource))))) - -(defun cider--invert-prefix-arg (arg) - "Invert the effect of prefix value ARG on `cider-prompt-for-symbol'. -This function preserves the `other-window' meaning of ARG." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (16 -1) ; empty empty -> - - (-1 16) ; - -> empty empty - (4 nil) ; empty -> no-prefix - (_ 4)))) ; no-prefix -> empty - -(defun cider--prefix-invert-prompt-p (arg) - "Test prefix value ARG for its effect on `cider-prompt-for-symbol`." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (16 t) ; empty empty - (4 t) ; empty - (_ nil)))) - -(defun cider--prompt-for-symbol-p (&optional prefix) - "Check if cider should prompt for symbol. -Tests againsts PREFIX and the value of `cider-prompt-for-symbol'. -Invert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be." - (if (cider--prefix-invert-prompt-p prefix) - (not cider-prompt-for-symbol) cider-prompt-for-symbol)) - -(defun cider--find-ns (ns &optional other-window) - "Find the file containing NS's definition. -Optionally open it in a different window if OTHER-WINDOW is truthy." - (if-let* ((path (cider-sync-request:ns-path ns))) - (cider-jump-to (cider-find-file path) nil other-window) - (user-error "Can't find namespace `%s'" ns))) - -;;;###autoload -(defun cider-find-ns (&optional arg ns) - "Find the file containing NS. -A prefix ARG of `-` or a double prefix argument causes -the results to be displayed in a different window." - (interactive "P") - (cider-ensure-connected) - (cider-ensure-op-supported "ns-path") - (if ns - (cider--find-ns ns) - (let* ((namespaces (cider-sync-request:ns-list)) - (ns (completing-read "Find namespace: " namespaces))) - (cider--find-ns ns (cider--open-other-window-p arg))))) - -;;;###autoload -(defun cider-find-keyword (&optional arg) - "Find the namespace of the keyword at point and its first occurrence there. - -For instance - if the keyword at point is \":cider.demo/keyword\", this command -would find the namespace \"cider.demo\" and afterwards find the first mention -of \"::keyword\" there. - -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point." - (interactive "P") - (cider-ensure-connected) - (let* ((kw (let ((kw-at-point (cider-symbol-at-point 'look-back))) - (if (or cider-prompt-for-symbol arg) - (read-string - (format "Keyword (default %s): " kw-at-point) - nil nil kw-at-point) - kw-at-point))) - (ns-qualifier (and - (string-match "^:+\\(.+\\)/.+$" kw) - (match-string 1 kw))) - (kw-ns (if ns-qualifier - (cider-resolve-alias (cider-current-ns) ns-qualifier) - (cider-current-ns))) - (kw-to-find (concat "::" (replace-regexp-in-string "^:+\\(.+/\\)?" "" kw)))) - - (when (and ns-qualifier (string= kw-ns (cider-current-ns))) - (error "Could not resolve alias `%s' in `%s'" ns-qualifier (cider-current-ns))) - (cider--find-ns kw-ns arg) - (search-forward-regexp kw-to-find nil 'noerror))) - -(provide 'cider-find) -;;; cider-find.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-find.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-find.elc deleted file mode 100644 index fbc6a6b98da5..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-find.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-format.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-format.el deleted file mode 100644 index 0aa9e8f0c488..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-format.el +++ /dev/null @@ -1,150 +0,0 @@ -;;; cider-format.el --- Code and EDN formatting functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Middleware-powered code and EDN formatting functionality. - -;;; Code: - -(require 'subr-x) - -(require 'cider-client) -(require 'cider-util) - - -;; Format - -(defun cider--format-reindent (formatted start) - "Reindent FORMATTED to align with buffer position START." - (let* ((start-column (save-excursion (goto-char start) (current-column))) - (indent-line (concat "\n" (make-string start-column ? )))) - (replace-regexp-in-string "\n" indent-line formatted))) - - -;;; Format region - -(defun cider--format-region (start end formatter) - "Format the contents of the given region. - -START and END represent the region's boundaries. - -FORMATTER is a function of one argument which is used to convert -the string contents of the region into a formatted string. - -Uses the following heuristic to try to maintain point position: - -- Take a snippet of text starting at current position, up to 64 chars. -- Search for the snippet, with lax whitespace, in the formatted text. - - If snippet is less than 64 chars (point was near end of buffer), search - from end instead of beginning. -- Place point at match beginning, or `point-min' if no match." - (let* ((original (buffer-substring-no-properties start end)) - (formatted (funcall formatter original)) - (indented (cider--format-reindent formatted start))) - (unless (equal original indented) - (let* ((pos (point)) - (pos-max (1+ (buffer-size))) - (l 64) - (endp (> (+ pos l) pos-max)) - (snippet (thread-last (buffer-substring-no-properties - pos (min (+ pos l) pos-max)) - (replace-regexp-in-string "[[:space:]\t\n\r]+" "[[:space:]\t\n\r]*")))) - (delete-region start end) - (insert indented) - (goto-char (if endp (point-max) (point-min))) - (funcall (if endp #'re-search-backward #'re-search-forward) snippet nil t) - (goto-char (or (match-beginning 0) start)) - (when (looking-at-p "\n") (forward-char)))))) - -;;;###autoload -(defun cider-format-region (start end) - "Format the Clojure code in the current region. -START and END represent the region's boundaries." - (interactive "r") - (cider-ensure-connected) - (cider--format-region start end #'cider-sync-request:format-code)) - - -;;; Format defun - -;;;###autoload -(defun cider-format-defun () - "Format the code in the current defun." - (interactive) - (cider-ensure-connected) - (save-excursion - (mark-defun) - (cider-format-region (region-beginning) (region-end)))) - - -;;; Format buffer - -(defun cider--format-buffer (formatter) - "Format the contents of the current buffer. - -Uses FORMATTER, a function of one argument, to convert the string contents -of the buffer into a formatted string." - (cider--format-region 1 (1+ (buffer-size)) formatter)) - -;;;###autoload -(defun cider-format-buffer () - "Format the Clojure code in the current buffer." - (interactive) - (check-parens) - (cider-ensure-connected) - (cider--format-buffer #'cider-sync-request:format-code)) - - -;;; Format EDN - -(declare-function cider--pretty-print-width "cider-repl") - -;;;###autoload -(defun cider-format-edn-buffer () - "Format the EDN data in the current buffer." - (interactive) - (check-parens) - (cider-ensure-connected) - (cider--format-buffer (lambda (edn) - (cider-sync-request:format-edn edn (cider--pretty-print-width))))) - -;;;###autoload -(defun cider-format-edn-region (start end) - "Format the EDN data in the current region. -START and END represent the region's boundaries." - (interactive "r") - (cider-ensure-connected) - (let* ((start-column (save-excursion (goto-char start) (current-column))) - (right-margin (- (cider--pretty-print-width) start-column))) - (cider--format-region start end - (lambda (edn) - (cider-sync-request:format-edn edn right-margin))))) - -;;;###autoload -(defun cider-format-edn-last-sexp () - "Format the EDN data of the last sexp." - (interactive) - (apply 'cider-format-edn-region (cider-sexp-at-point 'bounds))) - -(provide 'cider-format) -;;; cider-format.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-format.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-format.elc deleted file mode 100644 index 4a995a4eacdc..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-format.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-grimoire.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-grimoire.el deleted file mode 100644 index c07614ba59d5..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-grimoire.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; cider-grimoire.el --- Grimoire integration -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A few commands for Grimoire documentation lookup. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) -(require 'subr-x) -(require 'cider-compat) -(require 'cider-popup) - -(require 'nrepl-dict) - -(require 'url-vars) - -(declare-function markdown-mode "markdown-mode.el") -(declare-function markdown-toggle-fontify-code-blocks-natively "markdown-mode.el") - -(defconst cider-grimoire-url "http://conj.io/") - -(defconst cider-grimoire-buffer "*cider-grimoire*") - -(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) - (when (require 'markdown-mode nil 'noerror) - (markdown-mode) - (cider-popup-buffer-mode 1) - (when (fboundp 'markdown-toggle-fontify-code-blocks-natively) - (markdown-toggle-fontify-code-blocks-natively 1))) - (view-mode 1) - (goto-char (point-min)) - (current-buffer))) - -(defun cider-grimoire-lookup (symbol) - "Look up the grimoire documentation for SYMBOL. - -If SYMBOL is a special form, the clojure.core ns is used, as is -Grimoire's convention." - (if-let* ((var-info (cider-var-info symbol))) - (let ((name (nrepl-dict-get var-info "name")) - (ns (nrepl-dict-get var-info "ns" "clojure.core")) - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-grimoire.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-grimoire.elc deleted file mode 100644 index 43d26d33f0d8..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-grimoire.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-inspector.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-inspector.el deleted file mode 100644 index 61d5007db036..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-inspector.el +++ /dev/null @@ -1,397 +0,0 @@ -;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Vital Reactor, LLC -;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors - -;; Author: Ian Eslick <ian@vitalreactor.com> -;; Bozhidar Batsov <bozhidar@batsov.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Clojure object inspector inspired by SLIME. - -;;; Code: - -(require 'cl-lib) -(require 'seq) -(require 'cider-eval) - -;; =================================== -;; Inspector Key Map and Derived Mode -;; =================================== - -(defconst cider-inspector-buffer "*cider-inspect*") - -;;; 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")) - -(defcustom cider-inspector-fill-frame nil - "Controls whether the cider inspector window fills its frame." - :type 'boolean - :group 'cider-inspector - :package-version '(cider . "0.15.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-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (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 \\[execute-extended-command] 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 () - "Pop the last value off the inspector stack and render it. -See `cider-sync-request:inspect-pop' and `cider-inspector--render-value'." - (interactive) - (setq cider-inspector-last-command 'cider-inspector-pop) - (when-let* ((value (cider-sync-request:inspect-pop))) - (cider-inspector--render-value value))) - -(defun cider-inspector-push (idx) - "Inspect the value at IDX in the inspector stack and render it. -See `cider-sync-request:insepect-push' and `cider-inspector--render-value'" - (push (point) cider-inspector-location-stack) - (when-let* ((value (cider-sync-request:inspect-push idx))) - (cider-inspector--render-value value))) - -(defun cider-inspector-refresh () - "Re-render the currently inspected value. -See `cider-sync-request:insepect-refresh' and `cider-inspector--render-value'" - (interactive) - (when-let* ((value (cider-sync-request:inspect-refresh))) - (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 '("op" "inspect-pop") - (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 `("op" "inspect-push" - "idx" ,idx) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "value"))) - -(defun cider-sync-request:inspect-refresh () - "Re-render the currently inspected value." - (thread-first '("op" "inspect-refresh") - (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 '("op" "inspect-next-page") - (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 '("op" "inspect-prev-page") - (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 `("op" "inspect-set-page-size" - "page-size" ,page-size) - (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 ns) - `("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) - "Render VALUE." - (cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode 'ancillary) - (cider-inspector-render cider-inspector-buffer value) - (cider-popup-buffer-display cider-inspector-buffer t) - (when cider-inspector-fill-frame (delete-other-windows)) - (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) - "Render STR in BUFFER." - (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) - "Render ELEMENTS." - (dolist (el elements) - (cider-inspector-render-el* el))) - -(defun cider-inspector-render-el* (el) - "Render EL." - (cond ((symbolp el) (insert (symbol-name el))) - ((stringp el) (insert (propertize el 'font-lock-face 'font-lock-keyword-face))) - ((and (consp el) (eq (car el) :newline)) - (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) - "Render VALUE at 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 () - "Return 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"))))) - -(provide 'cider-inspector) - -;;; cider-inspector.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-inspector.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-inspector.elc deleted file mode 100644 index 5bebf64b1db3..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-inspector.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-macroexpansion.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-macroexpansion.el deleted file mode 100644 index 8123932a3495..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-macroexpansion.el +++ /dev/null @@ -1,206 +0,0 @@ -;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Macro expansion support. - -;;; Code: - -(require 'cider-mode) -(require 'subr-x) -(require 'cider-compat) - -(defconst cider-macroexpansion-buffer "*cider-macroexpansion*") - -(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 `("op" "macroexpand" - "expander" ,expander - "code" ,expr - "ns" ,(cider-current-ns) - "display-namespaces" ,(or display-namespaces - (symbol-name cider-macroexpansion-display-namespaces))) - (nconc (when cider-macroexpansion-print-metadata - '("print-meta" "true"))) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "expansion"))) - -(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 \\=`macroexpand-all\\=` on the expression preceding point." - (interactive) - (cider-macroexpand-expr "macroexpand-all" (cider-last-sexp))) - -(defun cider-macroexpand-all-inplace () - "Perform inplace \\=`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 'select 'clojure-mode 'ancillary) - (cider-mode -1) - (cider-macroexpansion-mode 1) - (current-buffer))) - -(declare-function cider-find-var "cider-find") - -(defvar cider-macroexpansion-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "g") #'cider-macroexpand-again) - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-macroexpansion.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-macroexpansion.elc deleted file mode 100644 index ab51790181d8..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-macroexpansion.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-mode.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-mode.el deleted file mode 100644 index 8258f05c6649..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-mode.el +++ /dev/null @@ -1,1043 +0,0 @@ -;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Minor mode for REPL interactions. - -;;; Code: - -(require 'clojure-mode) -(require 'cider-eval) -(require 'cider-test) ; required only for the menu -(require 'cider-eldoc) -(require 'cider-resolve) -(require 'cider-doc) ; required only for the menu -(require 'cider-profile) ; required only for the menu -(require 'cider-completion) -(require 'subr-x) -(require 'cider-compat) - -(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 the connection type, project name and host:port endpoint." - (if-let* ((current-connection (ignore-errors (cider-current-repl)))) - (with-current-buffer current-connection - (concat - cider-repl-type - (when cider-mode-line-show-connection - (format ":%s@%s:%s" - (or (cider--project-name nrepl-project-dir) "<no project>") - (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 - -(defun cider--switch-to-repl-buffer (repl-buffer &optional set-namespace) - "Select the REPL-BUFFER, when possible in an existing window. -When SET-NAMESPACE is t, sets the namespace in the REPL buffer to -that of the namespace in the Clojure source buffer." - (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)))) - (goto-char (point-max)))) - -(defun cider-switch-to-repl-buffer (&optional set-namespace) - "Switch to current REPL buffer, when possible in an existing window. -The type of the REPL is inferred from the mode of current buffer. With a -prefix arg SET-NAMESPACE sets the namespace in the REPL buffer to that of -the namespace in the Clojure source buffer" - (interactive "P") - (cider--switch-to-repl-buffer - (cider-current-repl nil 'ensure) - set-namespace)) - -(declare-function cider-load-buffer "cider-eval") - -(defun cider-load-buffer-and-switch-to-repl-buffer (&optional set-namespace) - "Load the current buffer into the matching REPL buffer and switch to it. -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 (derived-mode-p 'cider-repl-mode) - (let* ((a-buf) - (the-buf (let ((repl-type (cider-repl-type-for-buffer))) - (seq-find (lambda (b) - (unless (with-current-buffer b (derived-mode-p 'cider-repl-mode)) - (when-let* ((type (cider-repl-type-for-buffer b))) - (unless a-buf - (setq a-buf b)) - (or (equal type "multi") - (equal type repl-type))))) - (buffer-list))))) - (if-let* ((buf (or the-buf a-buf))) - (if cider-repl-display-in-current-window - (pop-to-buffer-same-window buf) - (pop-to-buffer buf)) - (user-error "No Clojure buffer found"))) - (user-error "Not in a CIDER REPL buffer"))) - -(defun cider-find-and-clear-repl-output (&optional clear-repl) - "Find the current REPL buffer and clear it. -With a prefix argument CLEAR-REPL the command clears the entire REPL -buffer. Returns to the buffer in which the command was invoked. See also -the related commands `cider-repl-clear-buffer' and -`cider-repl-clear-output'." - (interactive "P") - (let ((origin-buffer (current-buffer))) - (switch-to-buffer (cider-current-repl)) - (if clear-repl - (cider-repl-clear-buffer) - (cider-repl-clear-output)) - (switch-to-buffer origin-buffer))) - -(defun cider-undef () - "Undefine a symbol from the current ns." - (interactive) - (cider-ensure-op-supported "undef") - (cider-read-symbol-name - "Undefine symbol: " - (lambda (sym) - (cider-nrepl-send-request - `("op" "undef" - "ns" ,(cider-current-ns) - "symbol" ,sym) - (cider-interactive-eval-handler (current-buffer)))))) - -;;; cider-run -(defvar cider--namespace-history nil - "History of user input for namespace prompts.") - -(defun cider--var-namespace (var) - "Return the namespace of VAR. -VAR is a fully qualified Clojure variable name as a string." - (replace-regexp-in-string "\\(?:#'\\)?\\(.*\\)/.*" "\\1" var)) - -(defun cider-run (&optional function) - "Run -main or FUNCTION, prompting for its namespace if necessary. -With a prefix argument, prompt for function to run instead of -main." - (interactive (list (when current-prefix-arg (read-string "Function name: ")))) - (cider-ensure-connected) - (let ((name (or function "-main"))) - (when-let* ((response (cider-nrepl-send-sync-request - `("op" "ns-list-vars-by-name" - "name" ,name)))) - (if-let* ((vars (split-string (substring (nrepl-dict-get response "var-list") 1 -1)))) - (cider-interactive-eval - (if (= (length vars) 1) - (concat "(" (car vars) ")") - (let* ((completions (mapcar #'cider--var-namespace vars)) - (def (or (car cider--namespace-history) - (car completions)))) - (format "(#'%s/%s)" - (completing-read (format "Namespace (%s): " def) - completions nil t nil - 'cider--namespace-history def) - name)))) - (user-error "No %s var defined in any namespace" (cider-propertize name 'fn)))))) - -;;; Insert (and eval) in REPL functionality -(defvar cider-insert-commands-map - (let ((map (define-prefix-command 'cider-insert-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "e") #'cider-insert-last-sexp-in-repl) - (define-key map (kbd "d") #'cider-insert-defun-in-repl) - (define-key map (kbd "r") #'cider-insert-region-in-repl) - (define-key map (kbd "n") #'cider-insert-ns-form-in-repl) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-e") #'cider-insert-last-sexp-in-repl) - (define-key map (kbd "C-d") #'cider-insert-defun-in-repl) - (define-key map (kbd "C-r") #'cider-insert-region-in-repl) - (define-key map (kbd "C-n") #'cider-insert-ns-form-in-repl))) - -(defcustom cider-switch-to-repl-after-insert-p t - "Whether to switch to the repl after inserting a form into the repl." - :type 'boolean - :group 'cider - :package-version '(cider . "0.18.0")) - -(defcustom cider-invert-insert-eval-p nil - "Whether to invert the behavior of evaling. -Default behavior when inserting is to NOT eval the form and only eval with -a prefix. This allows to invert this so that default behavior is to insert -and eval and the prefix is required to prevent evaluation." - :type 'boolean - :group 'cider - :package-version '(cider . "0.18.0")) - -(defun cider-insert-in-repl (form eval) - "Insert FORM in the REPL buffer and switch to it. -If EVAL is non-nil the form will also be evaluated." - (while (string-match "\\`[ \t\n\r]+\\|[ \t\n\r]+\\'" form) - (setq form (replace-match "" t t form))) - (with-current-buffer (cider-current-repl) - (goto-char (point-max)) - (let ((beg (point))) - (insert form) - (indent-region beg (point))) - (when (if cider-invert-insert-eval-p - (not eval) - eval) - (cider-repl-return))) - (when cider-switch-to-repl-after-insert-p - (cider-switch-to-repl-buffer))) - -(defun cider-insert-last-sexp-in-repl (&optional arg) - "Insert the expression preceding point in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-last-sexp) arg)) - -(defun cider-insert-defun-in-repl (&optional arg) - "Insert the top level form at point in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-defun-at-point) arg)) - -(defun cider-insert-region-in-repl (start end &optional arg) - "Insert the curent region in the REPL buffer. -START and END represent the region's boundaries. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "rP") - (cider-insert-in-repl - (buffer-substring-no-properties start end) arg)) - -(defun cider-insert-ns-form-in-repl (&optional arg) - "Insert the current buffer's ns form in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-ns-form) arg)) - - - -;;; The menu-bar -(defconst cider-mode-menu - `("CIDER" - ["Start or connect to any REPL" cider - :help "A simple wrapper around all commands for starting/connecting to a REPL."] - ("Clojure" - ["Start a Clojure REPL" cider-jack-in - :help "Starts an nREPL server and connects a Clojure REPL to it."] - ["Connect to a Clojure REPL" cider-connect - :help "Connects to a REPL that's already running."]) - ("ClojureScript" - ["Start a ClojureScript REPL" cider-jack-in-cljs - :help "Starts an nREPL server and connects a ClojureScript REPL to it."] - ["Connect to a ClojureScript REPL" cider-connect-clojurescript - :help "Connects to a ClojureScript REPL that's already running."] - ["Create a ClojureScript REPL from a Clojure REPL" cider-jack-in-sibling-clojurescript]) - "--" - ["Quit" cider-quit :active (cider-connected-p)] - ["Restart" cider-restart :active (cider-connected-p)] - "--" - ["Connection info" cider-describe-connection - :active (cider-connected-p)] - ["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-connected-p) - ["Describe nrepl session" cider-describe-nrepl-session] - ["Toggle message logging" nrepl-toggle-message-logging]) - "Menu for CIDER mode.")) - -(defconst cider-mode-eval-menu - '("CIDER Eval" :visible (cider-connected-p) - ["Eval top-level sexp" cider-eval-defun-at-point] - ["Eval top-level sexp to point" cider-eval-defun-up-to-point] - ["Eval top-level sexp to comment" cider-eval-defun-to-comment] - ["Eval top-level sexp and pretty-print to comment" cider-pprint-eval-defun-to-comment] - "--" - ["Eval current sexp" cider-eval-sexp-at-point] - ["Eval current sexp to point" cider-eval-sexp-up-to-point] - ["Eval current sexp in context" cider-eval-sexp-at-point-in-context] - "--" - ["Eval last sexp" cider-eval-last-sexp] - ["Eval last sexp in context" cider-eval-last-sexp-in-context] - ["Eval last sexp and insert" cider-eval-print-last-sexp - :keys "\\[universal-argument] \\[cider-eval-last-sexp]"] - ["Eval last sexp in popup buffer" cider-pprint-eval-last-sexp] - ["Eval last sexp and replace" cider-eval-last-sexp-and-replace] - ["Eval last sexp to REPL" cider-eval-last-sexp-to-repl] - ["Eval last sexp and pretty-print to REPL" cider-pprint-eval-last-sexp-to-repl] - ["Eval last sexp and pretty-print to comment" cider-pprint-eval-last-sexp-to-comment] - "--" - ["Eval selected region" cider-eval-region] - ["Eval ns form" cider-eval-ns-form] - "--" - ["Interrupt evaluation" cider-interrupt] - "--" - ["Insert last sexp in REPL" cider-insert-last-sexp-in-repl] - ["Insert top-level sexp in REPL" cider-insert-defun-in-repl] - ["Insert region in REPL" cider-insert-region-in-repl] - ["Insert ns form in REPL" cider-insert-ns-form-in-repl] - "--" - ["Load this buffer" cider-load-buffer] - ["Load this buffer and switch to REPL" cider-load-buffer-and-switch-to-repl-buffer] - ["Load another file" cider-load-file] - ["Recursively load all files in directory" cider-load-all-files] - ["Load all project files" cider-load-all-project-ns] - ["Refresh loaded code" cider-ns-refresh] - ["Require and reload" cider-ns-reload] - ["Require and reload all" cider-ns-reload-all] - ["Run project (-main function)" cider-run]) - "Menu for CIDER mode eval commands.") - -(defconst cider-mode-interactions-menu - `("CIDER Interactions" :visible (cider-connected-p) - ["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 namespace" cider-find-ns] - ["Find resource" cider-find-resource] - ["Find keyword" cider-find-keyword] - ["Go back" cider-pop-back]) - ("Browse" - ["Browse namespace" cider-browse-ns] - ["Browse all namespaces" cider-browse-ns-all] - ["Browse spec" cider-browse-spec] - ["Browse all specs" cider-browse-spec-all] - ["Browse REPL input history" cider-repl-history] - ["Browse classpath" cider-classpath] - ["Browse classpath entry" cider-open-classpath-entry]) - ("Format" - ["Format EDN last sexp" cider-format-edn-last-sexp] - ["Format EDN region" cider-format-edn-region] - ["Format EDN buffer" cider-format-edn-buffer]) - ("Macroexpand" - ["Macroexpand-1" cider-macroexpand-1] - ["Macroexpand-all" cider-macroexpand-all]) - ,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)]) - ,cider-profile-menu - ("Misc" - ["Clojure Cheatsheet" cider-cheatsheet] - ["Flush completion cache" cider-completion-flush-caches])) - "Menu for CIDER interactions.") - - -(declare-function cider-ns-refresh "cider-ns") -(declare-function cider-ns-reload "cider-ns") -(declare-function cider-ns-reload-all "cider-ns") -(declare-function cider-browse-ns "cider-browse-ns") -(declare-function cider-eval-ns-form "cider-eval") -(declare-function cider-repl-set-ns "cider-repl") -(declare-function cider-find-ns "cider-find") - -(defvar cider-ns-map - (let ((map (define-prefix-command 'cider-ns-map))) - (define-key map (kbd "b") #'cider-browse-ns) - (define-key map (kbd "M-b") #'cider-browse-ns) - (define-key map (kbd "e") #'cider-eval-ns-form) - (define-key map (kbd "M-e") #'cider-eval-ns-form) - (define-key map (kbd "f") #'cider-find-ns) - (define-key map (kbd "M-f") #'cider-find-ns) - (define-key map (kbd "n") #'cider-repl-set-ns) - (define-key map (kbd "M-n") #'cider-repl-set-ns) - (define-key map (kbd "r") #'cider-ns-refresh) - (define-key map (kbd "M-r") #'cider-ns-refresh) - (define-key map (kbd "l") #'cider-ns-reload) - (define-key map (kbd "M-l") #'cider-ns-reload-all) - map) - "CIDER NS keymap.") - -;; Those declares are needed, because we autoload all those commands when first -;; used. That optimizes CIDER's initial load time. -(declare-function cider-macroexpand-1 "cider-macroexpansion") -(declare-function cider-macroexpand-all "cider-macroexpansion") -(declare-function cider-selector "cider-selector") -(declare-function cider-toggle-trace-ns "cider-tracing") -(declare-function cider-toggle-trace-var "cider-tracing") -(declare-function cider-find-resource "cider-find") -(declare-function cider-find-keyword "cider-find") -(declare-function cider-find-var "cider-find") -(declare-function cider-find-dwim-at-mouse "cider-find") - -(defconst cider--has-many-mouse-buttons (not (memq window-system '(mac ns))) - "Non-nil if system binds forward and back buttons to <mouse-8> and <mouse-9>. - -As it stands Emacs fires these events on <mouse-8> and <mouse-9> on 'x' and -'w32'systems while on macOS it presents them on <mouse-4> and <mouse-5>.") - -(defconst cider-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-d") 'cider-doc-map) - (define-key map (kbd "M-.") #'cider-find-var) - (define-key map (kbd (if cider--has-many-mouse-buttons "<mouse-8>" "<mouse-4>")) #'xref-pop-marker-stack) - (define-key map (kbd (if cider--has-many-mouse-buttons "<mouse-9>" "<mouse-5>")) #'cider-find-dwim-at-mouse) - (define-key map (kbd "C-c C-.") #'cider-find-ns) - (define-key map (kbd "C-c C-:") #'cider-find-keyword) - (define-key map (kbd "M-,") #'cider-pop-back) - (define-key map (kbd "C-c M-.") #'cider-find-resource) - (define-key map (kbd "M-TAB") #'complete-symbol) - (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-p") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "C-c C-f") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "C-c C-v") 'cider-eval-commands-map) - (define-key map (kbd "C-c C-j") 'cider-insert-commands-map) - (define-key map (kbd "C-c M-;") #'cider-eval-defun-to-comment) - (define-key map (kbd "C-c M-e") #'cider-eval-last-sexp-to-repl) - (define-key map (kbd "C-c M-p") #'cider-insert-last-sexp-in-repl) - (define-key map (kbd "C-c 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-ns-map) - (define-key map (kbd "C-c M-i") #'cider-inspect) - (define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var) - (define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns) - (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-M-l") #'cider-load-all-files) - (define-key map (kbd "C-c C-b") #'cider-interrupt) - (define-key map (kbd "C-c ,") 'cider-test-commands-map) - (define-key map (kbd "C-c C-t") 'cider-test-commands-map) - (define-key map (kbd "C-c M-s") #'cider-selector) - (define-key map (kbd "C-c M-d") #'cider-describe-connection) - (define-key map (kbd "C-c C-=") 'cider-profile-map) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c M-r") #'cider-restart) - (dolist (variable '(cider-mode-interactions-menu - cider-mode-eval-menu - cider-mode-menu)) - (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 Clojure REPL" cider-jack-in - :help "Starts an nREPL server (with Leiningen, Boot, or Gradle) and connects a REPL to it."] - ["Connect to a Clojure REPL" cider-connect - :help "Connects to a REPL that's already running."] - ["Connect to a ClojureScript REPL" cider-connect-clojurescript - :help "Connects to a ClojureScript REPL that's already running."] - ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-cljs - :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] - "--" - ["View manual online" cider-view-manual]))) - -;;; Dynamic indentation -(defcustom cider-dynamic-indentation t - "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 (let ((clojure-cache-ns t)) ; we force ns caching here for performance reasons - (cider-current-ns)))) - (if-let* ((meta (cider-resolve-var ns symbol-name)) - (indent (or (nrepl-dict-get meta "style/indent") - (nrepl-dict-get meta "indent")))) - (let ((format (format ":indent metadata on ‘%s’ is unreadable! \nERROR: %%s" - symbol-name))) - (with-demoted-errors format - (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")) - -(defcustom cider-font-lock-reader-conditionals t - "Apply font-locking to unused reader conditional expressions depending on the buffer CIDER connection type." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.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")) - -(defface cider-reader-conditional-face - '((t (:inherit font-lock-comment-face))) - "Face used to mark unused reader conditional expressions." - :group 'cider - :package-version '(cider . "0.15.0")) - -(defconst cider-reader-conditionals-regexp "\\(?:#\\?@?[[:space:]\n]*(\\)" - "Regexp for matching reader conditionals with a non-capturing group. -Starts from the reader macro characters to the opening parentheses.") - -(defvar cider--reader-conditionals-match-data (list nil nil) - "Reusable list for `match-data` in reader conditionals font lock matchers.") - -(defun cider--search-reader-conditionals (limit) - "Matcher for finding reader conditionals. -Search is done with the given LIMIT." - (when (and cider-font-lock-reader-conditionals - (cider-connected-p)) - (when (search-forward-regexp cider-reader-conditionals-regexp limit t) - (let ((start (match-beginning 0)) - (state (syntax-ppss))) - (if (or (nth 3 state) (nth 4 state)) ; inside string or comment? - (cider--search-reader-conditionals limit) - (when (<= (point) limit) - (ignore-errors - (let ((md (match-data nil cider--reader-conditionals-match-data))) - (setf (nth 0 md) start) - (setf (nth 1 md) (point)) - (set-match-data md) - t)))))))) - -(defun cider--anchored-search-suppressed-forms-internal (repl-types limit) - "Helper function for `cider--anchored-search-suppressed-forms`. -REPL-TYPES is a list of strings repl-type strings. LIMIT is the same as -the LIMIT in `cider--anchored-search-suppressed-forms`" - (when (= (length repl-types) 1) - (let ((type (car repl-types)) - (expr (read (current-buffer))) - (start (save-excursion (backward-sexp) (point)))) - (when (<= (point) limit) - (forward-sexp) - (if (not (string-equal (symbol-name expr) (concat ":" type))) - (ignore-errors - (cl-assert (<= (point) limit)) - (let ((md (match-data nil cider--reader-conditionals-match-data))) - (setf (nth 0 md) start) - (setf (nth 1 md) (point)) - (set-match-data md) - t)) - (cider--anchored-search-suppressed-forms-internal repl-types limit)))))) - -(defun cider--anchored-search-suppressed-forms (limit) - "Matcher for finding unused reader conditional expressions. -An unused reader conditional expression is an expression for a platform -that does not match the CIDER connection for the buffer. Search is done -with the given LIMIT." - (let ((repl-types (seq-uniq (seq-map #'cider-repl-type (cider-repls)))) - (result 'retry)) - (while (and (eq result 'retry) (<= (point) limit)) - (condition-case condition - (setq result - (cider--anchored-search-suppressed-forms-internal - repl-types limit)) - (invalid-read-syntax - (setq result 'retry)) - (wrong-type-argument - (setq result 'retry)) - (scan-error - (setq result 'retry)) - (end-of-file - (setq result nil)) - (error - (setq result nil) - (message - "Error during fontification while searching for forms: %S" - condition)))) - (if (eq result 'retry) (setq result nil)) - result)) - -(defconst cider--reader-conditionals-font-lock-keywords - '((cider--search-reader-conditionals - (cider--anchored-search-suppressed-forms - (save-excursion - (let* ((state (syntax-ppss)) - (list-pt (nth 1 state))) - (when list-pt - (goto-char list-pt) - (forward-list) - (backward-char) - (point)))) - nil - (0 'cider-reader-conditional-face t)))) - "Font Lock keywords for unused reader conditionals in CIDER mode.") - -(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/instrumented") - (`nil nil) - (`"\"breakpoint-if-interesting\"" - (push sym instrumented)) - (`"\"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 (or (nrepl-dict-get meta "fn") - (nrepl-dict-get meta "arglists"))) - (push sym functions)) - (do-var (push sym vars)))))))) - (when (memq 'core cider-font-lock-dynamically) - (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'. -SYM and INFO is passed to `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 - (setq-local sesman-system 'CIDER) - (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-add-keywords nil cider--reader-conditionals-font-lock-keywords) - ;; `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-add-keywords nil cider--reader-conditionals-font-lock-keywords) - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-mode.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-mode.elc deleted file mode 100644 index 1af6775f3c6f..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-mode.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-ns.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-ns.el deleted file mode 100644 index bcb843eef880..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-ns.el +++ /dev/null @@ -1,265 +0,0 @@ -;;; cider-ns.el --- Namespace manipulation functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Smart code refresh functionality based on ideas from: -;; http://thinkrelevance.com/blog/2013/06/04/clojure-workflow-reloaded -;; -;; Note that refresh with clojure.tools.namespace.repl is a smarter way to -;; reload code: the traditional way to reload Clojure code without restarting -;; the JVM is (require ... :reload) or an editor/IDE feature that does the same -;; thing. -;; -;; This has several problems: -;; -;; If you modify two namespaces which depend on each other, you must remember to -;; reload them in the correct order to avoid compilation errors. -;; -;; If you remove definitions from a source file and then reload it, those -;; definitions are still available in memory. If other code depends on those -;; definitions, it will continue to work but will break the next time you -;; restart the JVM. -;; -;; If the reloaded namespace contains defmulti, you must also reload all of the -;; associated defmethod expressions. -;; -;; If the reloaded namespace contains defprotocol, you must also reload any -;; records or types implementing that protocol and replace any existing -;; instances of those records/types with new instances. -;; -;; If the reloaded namespace contains macros, you must also reload any -;; namespaces which use those macros. -;; -;; If the running program contains functions which close over values in the -;; reloaded namespace, those closed-over values are not updated (This is common -;; in web applications which construct the "handler stack" as a composition of -;; functions.) - -;;; Code: - -(require 'subr-x) - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-stacktrace) - -(define-obsolete-variable-alias 'cider-save-files-on-cider-ns-refresh 'cider-ns-save-files-on-refresh "0.18") -(defcustom cider-ns-save-files-on-refresh 'prompt - "Controls whether to prompt to save Clojure files on `cider-ns-refresh'. -If nil, files are not saved. -If 'prompt, the user is prompted to save files if they have been modified. -If t, save the files without confirmation." - :type '(choice (const prompt :tag "Prompt to save files if they have been modified") - (const nil :tag "Don't save the files") - (const t :tag "Save the files without confirmation")) - :group 'cider - :package-version '(cider . "0.15.0")) - -(defconst cider-ns-refresh-log-buffer "*cider-ns-refresh-log*") - -(define-obsolete-variable-alias 'cider-refresh-show-log-buffer 'cider-ns-refresh-show-log-buffer "0.18") -(defcustom cider-ns-refresh-show-log-buffer nil - "Controls when to display the refresh log buffer. -If non-nil, the log buffer will be displayed every time `cider-ns-refresh' is -called. If nil, the log buffer will still be written to, but will never be -displayed automatically. Instead, the most relevant information will be -displayed in the echo area." - :type '(choice (const :tag "always" t) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(define-obsolete-variable-alias 'cider-refresh-before-fn 'cider-ns-refresh-before-fn "0.18") -(defcustom cider-ns-refresh-before-fn nil - "Clojure function for `cider-ns-refresh' to call before reloading. -If nil, nothing will be invoked before reloading. Must be a -namespace-qualified function of zero arity. Any thrown exception will -prevent reloading from occurring." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(define-obsolete-variable-alias 'cider-refresh-after-fn 'cider-ns-refresh-after-fn "0.18") -(defcustom cider-ns-refresh-after-fn nil - "Clojure function for `cider-ns-refresh' to call after reloading. -If nil, nothing will be invoked after reloading. Must be a -namespace-qualified function of zero arity." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(defun cider-ns-refresh--handle-response (response log-buffer) - "Refresh LOG-BUFFER with RESPONSE." - (nrepl-dbind-response response (out err reloading status error error-ns after before) - (cl-flet* ((log (message &optional face) - (cider-emit-into-popup-buffer log-buffer message face t)) - - (log-echo (message &optional face) - (log message face) - (unless cider-ns-refresh-show-log-buffer - (let ((message-truncate-lines t)) - (message "cider-ns-refresh: %s" message))))) - (cond - (out - (log out)) - - (err - (log err 'font-lock-warning-face)) - - ((member "invoking-before" status) - (log-echo (format "Calling %s\n" before) 'font-lock-string-face)) - - ((member "invoked-before" status) - (log-echo (format "Successfully called %s\n" before) 'font-lock-string-face)) - - ((member "invoked-not-resolved" status) - (log-echo "Could not resolve refresh function\n" 'font-lock-string-face)) - - (reloading - (log-echo (format "Reloading %s\n" reloading) 'font-lock-string-face)) - - ((member "reloading" (nrepl-dict-keys response)) - (log-echo "Nothing to reload\n" 'font-lock-string-face)) - - ((member "ok" status) - (log-echo "Reloading successful\n" 'font-lock-string-face)) - - (error-ns - (log-echo (format "Error reloading %s\n" error-ns) 'font-lock-warning-face)) - - ((member "invoking-after" status) - (log-echo (format "Calling %s\n" after) 'font-lock-string-face)) - - ((member "invoked-after" status) - (log-echo (format "Successfully called %s\n" after) 'font-lock-string-face)))) - - (with-selected-window (or (get-buffer-window cider-ns-refresh-log-buffer) - (selected-window)) - (with-current-buffer cider-ns-refresh-log-buffer - (goto-char (point-max)))) - - (when (member "error" status) - (cider--render-stacktrace-causes error)))) - -(defun cider-ns-refresh--save-project-buffers () - "Ensure modified project buffers are saved before certain operations. -Its behavior is controlled by `cider-save-files-on-cider-ns-refresh'." - (when-let* ((project-root (clojure-project-dir))) - (when cider-save-files-on-cider-ns-refresh - (save-some-buffers - (eq cider-save-files-on-cider-ns-refresh t) - (lambda () - (and - (derived-mode-p 'clojure-mode) - (string-prefix-p project-root - (file-truename default-directory) - (eq system-type 'windows-nt)))))))) - -;;;###autoload -(defun cider-ns-reload (&optional prompt) - "Send a (require 'ns :reload) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload forces loading of all the -identified libs even if they are already loaded\"." - (interactive "P") - (let ((ns (if prompt - (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns))) - (clojure-find-ns)))) - (cider-interactive-eval (format "(require '%s :reload)" ns)))) - -;;;###autoload -(defun cider-ns-reload-all (&optional prompt) - "Send a (require 'ns :reload-all) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload-all implies :reload and -also forces loading of all libs that the identified libs directly or -indirectly load via require\"." - (interactive "P") - (let ((ns (if prompt - (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns))) - (clojure-find-ns)))) - (cider-interactive-eval (format "(require '%s :reload-all)" ns)))) - -;;;###autoload -(defun cider-ns-refresh (&optional mode) - "Reload modified and unloaded namespaces on the classpath. - -With a single prefix argument, or if MODE is `refresh-all', reload all -namespaces on the classpath unconditionally. - -With a double prefix argument, or if MODE is `clear', clear the state of -the namespace tracker before reloading. This is useful for recovering from -some classes of error (for example, those caused by circular dependencies) -that a normal reload would not otherwise recover from. The trade-off of -clearing is that stale code from any deleted files may not be completely -unloaded. - -With a negative prefix argument, or if MODE is `inhibit-fns', prevent any -refresh functions (defined in `cider-ns-refresh-before-fn' and -`cider-ns-refresh-after-fn') from being invoked." - (interactive "p") - (cider-ensure-connected) - (cider-ensure-op-supported "refresh") - (cider-ns-refresh--save-project-buffers) - (let ((clear? (member mode '(clear 16))) - (refresh-all? (member mode '(refresh-all 4))) - (inhibit-refresh-fns (member mode '(inhibit-fns -1)))) - (cider-map-repls :clj - (lambda (conn) - ;; Inside the lambda, so the buffer is not created if we error out. - (let ((log-buffer (or (get-buffer cider-ns-refresh-log-buffer) - (cider-make-popup-buffer cider-ns-refresh-log-buffer)))) - (when cider-ns-refresh-show-log-buffer - (cider-popup-buffer-display log-buffer)) - (when inhibit-refresh-fns - (cider-emit-into-popup-buffer log-buffer - "inhibiting refresh functions\n" - nil - t)) - (when clear? - (cider-nrepl-send-sync-request '("op" "refresh-clear") conn)) - (cider-nrepl-send-request - (nconc `("op" ,(if refresh-all? "refresh-all" "refresh") - "print-length" ,cider-stacktrace-print-length - "print-level" ,cider-stacktrace-print-level) - (when (cider--pprint-fn) - `("pprint-fn" ,(cider--pprint-fn))) - (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn) - `("before" ,cider-ns-refresh-before-fn)) - (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn) - `("after" ,cider-ns-refresh-after-fn))) - (lambda (response) - (cider-ns-refresh--handle-response response log-buffer)) - conn)))))) - -;;;###autoload -(define-obsolete-function-alias 'cider-refresh 'cider-ns-refresh "0.18") - -(provide 'cider-ns) -;;; cider-ns.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-ns.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-ns.elc deleted file mode 100644 index 4177064c27cc..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-ns.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-overlays.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-overlays.el deleted file mode 100644 index 1a92b35f484b..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-overlays.el +++ /dev/null @@ -1,311 +0,0 @@ -;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*- - -;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; 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 'subr-x) -(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 - :package-version '(cider . "0.13.0")) - -(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) (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-overlays.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-overlays.elc deleted file mode 100644 index 1dbedb324c83..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-overlays.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-pkg.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-pkg.el deleted file mode 100644 index d9536af29023..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-pkg.el +++ /dev/null @@ -1,23 +0,0 @@ -(define-package "cider" "20180908.1925" "Clojure Interactive Development Environment that Rocks" - '((emacs "25") - (clojure-mode "5.9") - (pkg-info "0.4") - (queue "0.2") - (spinner "1.7") - (seq "2.16") - (sesman "0.3")) - :keywords - '("languages" "clojure" "cider") - :authors - '(("Tim King" . "kingtim@gmail.com") - ("Phil Hagelberg" . "technomancy@gmail.com") - ("Bozhidar Batsov" . "bozhidar@batsov.com") - ("Artur Malabarba" . "bruce.connor.am@gmail.com") - ("Hugo Duncan" . "hugo@hugoduncan.org") - ("Steve Purcell" . "steve@sanityinc.com")) - :maintainer - '("Bozhidar Batsov" . "bozhidar@batsov.com") - :url "http://www.github.com/clojure-emacs/cider") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-popup.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-popup.el deleted file mode 100644 index 274a0666b4dc..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-popup.el +++ /dev/null @@ -1,137 +0,0 @@ -;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- - -;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Common functionality for dealing with popup buffers. - -;;; Code: - -(require 'subr-x) -(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 - "A list ancillary buffers created by the various CIDER commands. -We track them mostly to be able to clean them up on quit.") - -(defun cider-make-popup-buffer (name &optional mode ancillary) - "Create a temporary buffer called NAME using major MODE (if specified). -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 inhibit-indent) - "Emit into BUFFER the provided VALUE optionally using FACE. -Indent emitted value (usually a sexp) unless INHIBIT-INDENT is specified -and non-nil." - ;; Long string output renders Emacs unresponsive and users might intentionally - ;; kill the frozen popup buffer. Therefore, we don't re-create the buffer and - ;; silently ignore the output. - (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)) - (unless inhibit-indent - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-popup.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-popup.elc deleted file mode 100644 index a65f7b3e7654..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-popup.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-profile.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-profile.el deleted file mode 100644 index 79577910580c..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-profile.el +++ /dev/null @@ -1,208 +0,0 @@ -;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*- - -;; Copyright © 2014-2018 Edwin Watkeys and CIDER contributors - -;; Author: Edwin Watkeys <edw@poseur.com> -;; Juan E. Maya <jmayaalv@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides coarse-grained interactive profiling support. -;; Based on earlier work by Edwin Watkeys (https://github.com/thunknyc/nrepl-profile). - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-eval) - -(defconst cider-profile-buffer "*cider-profile*") - -(defvar cider-profile-map - (let ((map (define-prefix-command 'cider-profile-map))) - (define-key map (kbd "t") #'cider-profile-toggle) - (define-key map (kbd "c") #'cider-profile-clear) - (define-key map (kbd "S") #'cider-profile-summary) - (define-key map (kbd "s") #'cider-profile-var-summary) - (define-key map (kbd "n") #'cider-profile-ns-toggle) - (define-key map (kbd "v") #'cider-profile-var-profiled-p) - (define-key map (kbd "+") #'cider-profile-samples) - map) - "CIDER profiler keymap.") - -(defconst cider-profile-menu - '("Profile" - ["Toggle var profiling" cider-profile-toggle] - ["Toggle namespace profiling" cider-profile-ns-toggle] - "--" - ["Display var profiling status" cider-profile-var-profiled-p] - ["Display max sample count" cider-profile-samples] - ["Display summary" cider-profile-summary] - ["Clear data" cider-profile-clear]) - "CIDER profiling submenu.") - -(defun cider-profile--make-response-handler (handler &optional buffer) - "Make a response handler using value handler HANDLER for connection BUFFER. - -Optional argument BUFFER defaults to current buffer." - (nrepl-make-response-handler - (or buffer (current-buffer)) handler nil nil nil)) - -;;;###autoload -(defun cider-profile-samples (&optional query) - "Displays current max-sample-count. -If optional QUERY is specified, set max-sample-count and display new value." - (interactive "P") - (cider-ensure-op-supported "set-max-samples") - (cider-ensure-op-supported "get-max-samples") - (if (not (null query)) - (cider-nrepl-send-request - (let ((max-samples (if (numberp query) query '()))) - (message "query: %s" max-samples) - `("op" "set-max-samples" "max-samples" ,max-samples)) - (cider-profile--make-response-handler - (lambda (_buffer value) - (let ((value (if (zerop (length value)) "unlimited" value))) - (message "max-sample-count is now %s" value))))) - (cider-nrepl-send-request - '("op" "get-max-samples") - (cider-profile--make-response-handler - (lambda (_buffer value) - (let ((value (if (zerop (length value)) "unlimited" value))) - (message "max-sample-count is now %s" value)))))) - query) - -;;;###autoload -(defun cider-profile-var-profiled-p (query) - "Displays the profiling status of var under point. -Prompts for var if none under point or QUERY is present." - (interactive "P") - (cider-ensure-op-supported "is-var-profiled") - (cider-read-symbol-name - "Report profiling status for var: " - (lambda (sym) - (let ((ns (cider-current-ns))) - (cider-nrepl-send-request - `("op" "is-var-profiled" - "ns" ,ns - "sym" ,sym) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling is currently enabled for %s/%s" ns sym)) - ("unprofiled" (message "Profiling is currently disabled for %s/%s" ns sym)) - ("unbound" (message "%s/%s is unbound" ns sym))))))))) - query) - -;;;###autoload -(defun cider-profile-ns-toggle (&optional query) - "Toggle profiling for the ns associated with optional QUERY. - -If optional argument QUERY is non-nil, prompt for ns. Otherwise use -current ns." - (interactive "P") - (cider-ensure-op-supported "toggle-profile-ns") - (let ((ns (if query - (completing-read "Toggle profiling for ns: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (cider-nrepl-send-request - `("op" "toggle-profile-ns" - "ns" ,ns) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling enabled for %s" ns)) - ("unprofiled" (message "Profiling disabled for %s" ns))))))) - query) - -;;;###autoload -(defun cider-profile-toggle (query) - "Toggle profiling for the given QUERY. -Defaults to the symbol at point. -With prefix arg or no symbol at point, prompts for a var." - (interactive "P") - (cider-ensure-op-supported "toggle-profile") - (cider-read-symbol-name - "Toggle profiling for var: " - (lambda (sym) - (let ((ns (cider-current-ns))) - (cider-nrepl-send-request - `("op" "toggle-profile" - "ns" ,ns - "sym" ,sym) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling enabled for %s/%s" ns sym)) - ("unprofiled" (message "Profiling disabled for %s/%s" ns sym)) - ("unbound" (message "%s/%s is unbound" ns sym))))))))) - query) - -(defun cider-profile-display-stats (stats-response) - "Displays the STATS-RESPONSE on `cider-profile-buffer`." - (let ((table (nrepl-dict-get stats-response "err"))) - (if cider-profile-buffer - (let ((buffer (cider-make-popup-buffer cider-profile-buffer))) - (with-current-buffer buffer - (let ((inhibit-read-only t)) (insert table))) - (display-buffer buffer) - (let ((window (get-buffer-window buffer))) - (set-window-point window 0) - (select-window window) - (fit-window-to-buffer window))) - (cider-emit-interactive-eval-err-output table)))) - -;;;###autoload -(defun cider-profile-summary () - "Display a summary of currently collected profile data." - (interactive) - (cider-ensure-op-supported "profile-summary") - (cider-profile-display-stats - (cider-nrepl-send-sync-request '("op" "profile-summary")))) - -;;;###autoload -(defun cider-profile-var-summary (query) - "Display profile data for var under point QUERY. -Defaults to the symbol at point. With prefix arg or no symbol at point, -prompts for a var." - (interactive "P") - (cider-ensure-op-supported "profile-var-summary") - (cider-read-symbol-name - "Profile-summary for var: " - (lambda (sym) - (cider-profile-display-stats - (cider-nrepl-send-sync-request - `("op" "profile-var-summary" - "ns" ,(cider-current-ns) - "sym" ,sym))))) - query) - -;;;###autoload -(defun cider-profile-clear () - "Clear any collected profile data." - (interactive) - (cider-ensure-op-supported "clear-profile") - (cider-nrepl-send-request - '("op" "clear-profile") - (cider-profile--make-response-handler - (lambda (_buffer value) - (when (equal value "cleared") - (message "Cleared profile data")))))) - -(provide 'cider-profile) - -;;; cider-profile.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-profile.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-profile.elc deleted file mode 100644 index ffa751b9d5b1..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-profile.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl-history.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl-history.el deleted file mode 100644 index f6cd4c86cd05..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl-history.el +++ /dev/null @@ -1,726 +0,0 @@ -;;; cider-repl-history.el --- REPL input history browser - -;; Copyright (c) 2017 John Valente and browse-kill-ring authors - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;; Based heavily on browse-kill-ring -;; https://github.com/browse-kill-ring/browse-kill-ring - -;;; Commentary: - -;; REPL input history browser for CIDER. - -;; Allows you to browse the full input history for your REPL buffer, and -;; insert previous commands at the prompt. - -;;; Code: - -(require 'cl-lib) -(require 'cider-compat) -(require 'cider-popup) -(require 'clojure-mode) -(require 'derived) -(require 'pulse) - -(defconst cider-repl-history-buffer "*cider-repl-history*") - -(defgroup cider-repl-history nil - "A package for browsing and inserting the items in the CIDER command history." - :prefix "cider-repl-history-" - :group 'cider) - -(defvar cider-repl-history-display-styles - '((separated . cider-repl-history-insert-as-separated) - (one-line . cider-repl-history-insert-as-one-line))) - -(defcustom cider-repl-history-display-style 'separated - "How to display the CIDER command history items. - -If `one-line', then replace newlines with \"\\n\" for display. - -If `separated', then display `cider-repl-history-separator' between -entries." - :type '(choice (const :tag "One line" one-line) - (const :tag "Separated" separated)) - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-quit-action 'quit-window - "What action to take when `cider-repl-history-quit' is called. - -If `bury-buffer', then simply bury the *cider-repl-history* buffer, but keep -the window. - -If `bury-and-delete-window', then bury the buffer, and (if there is -more than one window) delete the window. - -If `delete-and-restore', then restore the window configuration to what it was -before `cider-repl-history' was called, and kill the *cider-repl-history* -buffer. - -If `quit-window', then restore the window configuration to what -it was before `cider-repl-history' was called, and bury *cider-repl-history*. -This is the default. - -If `kill-and-delete-window', then kill the *cider-repl-history* buffer, and -delete the window on close. - -Otherwise, it should be a function to call." - ;; Note, if you use one of the non-"delete" options, after you "quit", - ;; the *cider-repl-history* buffer is still available. If you are using - ;; `cider-repl-history-show-preview', and you switch to *cider-repl-history* (i.e., - ;; with C-x b), it will not give the preview unless and until you "update" - ;; the *cider-repl-history* buffer. - ;; - ;; This really should not be an issue, because there's no reason to "switch" - ;; back to the buffer. If you want to get it back, you can just do C-c M-p - ;; from the REPL buffer. - - ;; If you get in this situation and find it annoying, you can either disable - ;; the preview, or set `cider-repl-history-quit-action' to 'delete-and-restore. - ;; Then you will simply not have the *cider-repl-history* buffer after you quit, - ;; and it won't be an issue. - - :type '(choice (const :tag "Bury buffer" - :value bury-buffer) - (const :tag "Bury buffer and delete window" - :value bury-and-delete-window) - (const :tag "Delete window" - :value delete-and-restore) - (const :tag "Save and restore" - :value quit-window) - (const :tag "Kill buffer and delete window" - :value kill-and-delete-window) - function) - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-resize-window nil - "Whether to resize the `cider-repl-history' window to fit its contents. -Value is either t, meaning yes, or a cons pair of integers, - (MAXIMUM . MINIMUM) for the size of the window. MAXIMUM defaults to -the window size chosen by `pop-to-buffer'; MINIMUM defaults to -`window-min-height'." - :type '(choice (const :tag "No" nil) - (const :tag "Yes" t) - (cons (integer :tag "Maximum") (integer :tag "Minimum"))) - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-separator ";;;;;;;;;;" - "The string separating entries in the `separated' style. -See `cider-repl-history-display-style'." - ;; The (default) separator is a Clojure comment, to preserve fontification - ;; in the buffer. - :type 'string - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-recenter nil - "If non-nil, then always keep the current entry at the top of the window." - :type 'boolean - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-highlight-current-entry nil - "If non-nil, highlight the currently selected command history entry." - :type 'boolean - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-highlight-inserted-item nil - "If non-nil, then temporarily highlight the inserted command history entry. -The value selected controls how the inserted item is highlighted, -possible values are `solid' (highlight the inserted text for a -fixed period of time), or `pulse' (fade out the highlighting gradually). -Setting this variable to the value t will select the default -highlighting style, which currently `pulse'. - -The variable `cider-repl-history-inserted-item-face' contains the -face used for highlighting." - :type '(choice (const nil) (const t) (const solid) (const pulse)) - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-separator-face 'bold - "The face in which to highlight the `cider-repl-history-separator'." - :type 'face - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-current-entry-face 'highlight - "The face in which to highlight the command history current entry." - :type 'face - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-inserted-item-face 'highlight - "The face in which to highlight the inserted item." - :type 'face - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-maximum-display-length nil - "Whether or not to limit the length of displayed items. - -If this variable is an integer, the display of the command history will be -limited to that many characters. -Setting this variable to nil means no limit." - :type '(choice (const :tag "None" nil) - integer) - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-display-duplicates t - "If non-nil, then display duplicate items in the command history." - :type 'boolean - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-display-duplicate-highest t - "When `cider-repl-history-display-duplicates' is nil, then display highest (most recent) duplicate items in the command history." - :type 'boolean - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-text-properties nil - "If non-nil, maintain text properties of the command history items." - :type 'boolean - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-hook nil - "A list of functions to call after `cider-repl-history'." - :type 'hook - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-show-preview nil - "If non-nil, show a preview of the inserted text in the REPL buffer. - -The REPL buffer would show a preview of what the buffer would look like -if the item under point were inserted." - - :type 'boolean - :group 'cider-repl-history - :package-version '(cider . "0.15.0")) - -(defvar cider-repl-history-repl-window nil - "The window in which chosen command history data will be inserted. -It is probably not a good idea to set this variable directly; simply -call `cider-repl-history' again.") - -(defvar cider-repl-history-repl-buffer nil - "The buffer in which chosen command history data will be inserted. -It is probably not a good idea to set this variable directly; simply -call `cider-repl-history' again.") - -(defvar cider-repl-history-preview-overlay nil - "The overlay used to preview what would happen if the user inserted the given text.") - -(defvar cider-repl-history-previous-overlay nil - "Previous overlay within *cider-repl-history* buffer.") - - -(defun cider-repl-history-get-history () - "Function to retrieve history from the REPL buffer." - (if cider-repl-history-repl-buffer - (buffer-local-value - 'cider-repl-input-history - cider-repl-history-repl-buffer) - (error "Variable `cider-repl-history-repl-buffer' not bound to a buffer"))) - -(defun cider-repl-history-resize-window () - "If variable `cider-repl-history-resize-window' is non-nil, resize the *cider-repl-history* window." - (when cider-repl-history-resize-window - (apply #'fit-window-to-buffer (selected-window) - (if (consp cider-repl-history-resize-window) - (list (car cider-repl-history-resize-window) - (or (cdr cider-repl-history-resize-window) - window-min-height)) - (list nil window-min-height))))) - -(defun cider-repl-history-read-regexp (msg use-default-p) - "Get a regular expression from the user, prompting with MSG; previous entry is default if USE-DEFAULT-P." - (let* ((default (car regexp-history)) - (prompt (if (and default use-default-p) - (format "%s for regexp (default `%s'): " - msg - default) - (format "%s (regexp): " msg))) - (input - (read-from-minibuffer prompt nil nil nil 'regexp-history - (if use-default-p nil default)))) - (if (equal input "") - (if use-default-p default nil) - input))) - -(defun cider-repl-history-clear-preview () - "Clear the preview, if one is present." - (interactive) - (when cider-repl-history-preview-overlay - (cl-assert (overlayp cider-repl-history-preview-overlay)) - (delete-overlay cider-repl-history-preview-overlay))) - -(defun cider-repl-history-cleanup-on-exit () - "Function called when the user is finished with `cider-repl-history'. -This function performs any cleanup that is required when the user -has finished interacting with the *cider-repl-history* buffer. For now -the only cleanup performed is to remove the preview overlay, if -it's turned on." - (cider-repl-history-clear-preview)) - -(defun cider-repl-history-quit () - "Take the action specified by `cider-repl-history-quit-action'." - (interactive) - (cider-repl-history-cleanup-on-exit) - (pcase cider-repl-history-quit-action - (`delete-and-restore - (quit-restore-window (selected-window) 'kill)) - (`quit-window - (quit-window)) - (`kill-and-delete-window - (kill-buffer (current-buffer)) - (unless (= (count-windows) 1) - (delete-window))) - (`bury-and-delete-window - (bury-buffer) - (unless (= (count-windows) 1) - (delete-window))) - (_ - (funcall cider-repl-history-quit-action)))) - -(defun cider-repl-history-preview-overlay-setup (orig-buf) - "Setup the preview overlay in ORIG-BUF." - (when cider-repl-history-show-preview - (with-current-buffer orig-buf - (let* ((will-replace (region-active-p)) - (start (if will-replace - (min (point) (mark)) - (point))) - (end (if will-replace - (max (point) (mark)) - (point)))) - (cider-repl-history-clear-preview) - (setq cider-repl-history-preview-overlay - (make-overlay start end orig-buf)) - (overlay-put cider-repl-history-preview-overlay - 'invisible t))))) - -(defun cider-repl-history-highlight-inserted (start end) - "Insert the text between START and END." - (pcase cider-repl-history-highlight-inserted-item - ((or `pulse `t) - (let ((pulse-delay .05) (pulse-iterations 10)) - (with-no-warnings - (pulse-momentary-highlight-region - start end cider-repl-history-inserted-item-face)))) - (`solid - (let ((o (make-overlay start end))) - (overlay-put o 'face cider-repl-history-inserted-item-face) - (sit-for 0.5) - (delete-overlay o))))) - -(defun cider-repl-history-insert-and-highlight (str) - "Helper function to insert STR at point, highlighting it if appropriate." - (let ((before-insert (point))) - (let (deactivate-mark) - (insert-for-yank str)) - (cider-repl-history-highlight-inserted - before-insert - (point)))) - -(defun cider-repl-history-target-overlay-at (position &optional no-error) - "Return overlay at POSITION that has property `cider-repl-history-target'. -If no such overlay, raise an error unless NO-ERROR is true, in which -case retun nil." - (let ((ovs (overlays-at (point)))) - (catch 'cider-repl-history-target-overlay-at - (dolist (ov ovs) - (when (overlay-get ov 'cider-repl-history-target) - (throw 'cider-repl-history-target-overlay-at ov))) - (unless no-error - (error "No CIDER history item here"))))) - -(defun cider-repl-history-current-string (pt &optional no-error) - "Find the string to insert into the REPL by looking for the overlay at PT; might error unless NO-ERROR set." - (let ((o (cider-repl-history-target-overlay-at pt t))) - (if o - (overlay-get o 'cider-repl-history-target) - (unless no-error - (error "No CIDER history item in this buffer"))))) - -(defun cider-repl-history-do-insert (buf pt) - "Helper function to insert text from BUF at PT into the REPL buffer and kill *cider-repl-history*." - ;; Note: as mentioned at the top, this file is based on browse-kill-ring, - ;; which has numerous insertion options. The functionality of - ;; browse-kill-ring allows users to insert at point, and move point to the end - ;; of the inserted text; or insert at the beginning or end of the buffer, - ;; while leaving point alone. And each of these had the option of leaving the - ;; history buffer in place, or getting rid of it. That was appropriate for a - ;; generic paste tool, but for inserting a previous command into an - ;; interpreter, I felt the only useful option would be inserting it at the end - ;; and quitting the history buffer, so that is all that's provided. - (let ((str (cider-repl-history-current-string pt))) - (cider-repl-history-quit) - (with-selected-window cider-repl-history-repl-window - (with-current-buffer cider-repl-history-repl-buffer - (let ((max (point-max))) - (if (= max (point)) - (cider-repl-history-insert-and-highlight str) - (save-excursion - (goto-char max) - (cider-repl-history-insert-and-highlight str)))))))) - -(defun cider-repl-history-insert-and-quit () - "Insert the item into the REPL buffer, and close *cider-repl-history*. - -The text is always inserted at the very bottom of the REPL buffer. If your -cursor is already at the bottom, it is advanced to the end of the inserted -text. If your cursor is somewhere else, the cursor is not moved, but the -text is still inserted at the end." - (interactive) - (cider-repl-history-do-insert (current-buffer) (point))) - -(defun cider-repl-history-mouse-insert (e) - "Insert the item at E into the REPL buffer, and close *cider-repl-history*. - -The text is always inserted at the very bottom of the REPL buffer. If your -cursor is already at the bottom, it is advanced to the end of the inserted -text. If your cursor is somewhere else, the cursor is not moved, but the -text is still inserted at the end." - (interactive "e") - (let* ((data (save-excursion - (mouse-set-point e) - (cons (current-buffer) (point)))) - (buf (car data)) - (pt (cdr data))) - (cider-repl-history-do-insert buf pt))) - -(defun cider-repl-history-clear-highlighed-entry () - "Clear the highlighted entry, when one exists." - (when cider-repl-history-previous-overlay - (cl-assert (overlayp cider-repl-history-previous-overlay) - nil "not an overlay") - (overlay-put cider-repl-history-previous-overlay 'face nil))) - -(defun cider-repl-history-update-highlighed-entry () - "Update highlighted entry, when feature is turned on." - (when cider-repl-history-highlight-current-entry - (if-let* ((current-overlay (cider-repl-history-target-overlay-at (point) t))) - (unless (equal cider-repl-history-previous-overlay current-overlay) - ;; We've changed overlay. Clear current highlighting, - ;; and highlight the new overlay. - (cl-assert (overlay-get current-overlay 'cider-repl-history-target) t) - (cider-repl-history-clear-highlighed-entry) - (setq cider-repl-history-previous-overlay current-overlay) - (overlay-put current-overlay 'face - cider-repl-history-current-entry-face)) - ;; No overlay at point. Just clear all current highlighting. - (cider-repl-history-clear-highlighed-entry)))) - -(defun cider-repl-history-forward (&optional arg) - "Move forward by ARG command history entries." - (interactive "p") - (beginning-of-line) - (while (not (zerop arg)) - (let ((o (cider-repl-history-target-overlay-at (point) t))) - (cond - ((>= arg 0) - (setq arg (1- arg)) - ;; We're on a cider-repl-history overlay, skip to the end of it. - (when o - (goto-char (overlay-end o)) - (setq o nil)) - (while (not (or o (eobp))) - (goto-char (next-overlay-change (point))) - (setq o (cider-repl-history-target-overlay-at (point) t)))) - (t - (setq arg (1+ arg)) - (when o - (goto-char (overlay-start o)) - (setq o nil)) - (while (not (or o (bobp))) - (goto-char (previous-overlay-change (point))) - (setq o (cider-repl-history-target-overlay-at (point) t))))))) - (when cider-repl-history-recenter - (recenter 1))) - -(defun cider-repl-history-previous (&optional arg) - "Move backward by ARG command history entries." - (interactive "p") - (cider-repl-history-forward (- arg))) - -(defun cider-repl-history-search-forward (regexp &optional backwards) - "Move to the next command history entry matching REGEXP from point. -If optional arg BACKWARDS is non-nil, move to the previous matching -entry." - (interactive - (list (cider-repl-history-read-regexp "Search forward" t) - current-prefix-arg)) - (let ((orig (point))) - (cider-repl-history-forward (if backwards -1 1)) - (let ((over (cider-repl-history-target-overlay-at (point) t))) - (while (and over - (not (if backwards (bobp) (eobp))) - (not (string-match regexp - (overlay-get over - 'cider-repl-history-target)))) - (cider-repl-history-forward (if backwards -1 1)) - (setq over (cider-repl-history-target-overlay-at (point) t))) - (unless (and over - (string-match regexp - (overlay-get over - 'cider-repl-history-target))) - (goto-char orig) - (message "No more command history entries matching %s" regexp))))) - -(defun cider-repl-history-search-backward (regexp) - "Move to the previous command history entry matching REGEXP from point." - (interactive - (list (cider-repl-history-read-regexp "Search backward" t))) - (cider-repl-history-search-forward regexp t)) - -(defun cider-repl-history-elide (str) - "If STR is too long, abbreviate it with an ellipsis; otherwise, return it unchanged." - (if (and cider-repl-history-maximum-display-length - (> (length str) - cider-repl-history-maximum-display-length)) - (concat (substring str 0 (- cider-repl-history-maximum-display-length 3)) - (propertize "..." 'cider-repl-history-extra t)) - str)) - -(defmacro cider-repl-history-add-overlays-for (item &rest body) - "Add overlays for ITEM, and execute BODY." - (let ((beg (cl-gensym "cider-repl-history-add-overlays-")) - (end (cl-gensym "cider-repl-history-add-overlays-"))) - `(let ((,beg (point)) - (,end - (progn - ,@body - (point)))) - (let ((o (make-overlay ,beg ,end))) - (overlay-put o 'cider-repl-history-target ,item) - (overlay-put o 'mouse-face 'highlight))))) - -(defun cider-repl-history-insert-as-separated (items) - "Insert ITEMS into the current buffer, with separators between items." - (while items - (let* ((origitem (car items)) - (item (cider-repl-history-elide origitem)) - (len (length item))) - (cider-repl-history-add-overlays-for origitem (insert item)) - ;; When the command history has items with read-only text property at - ;; **the end of** string, cider-repl-history-setup fails with error - ;; `Text is read-only'. So inhibit-read-only here. - ;; See http://bugs.debian.org/225082 - (let ((inhibit-read-only t)) - (insert "\n") - (when (cdr items) - (insert (propertize cider-repl-history-separator - 'cider-repl-history-extra t - 'cider-repl-history-separator t)) - (insert "\n")))) - (setq items (cdr items)))) - -(defun cider-repl-history-insert-as-one-line (items) - "Insert ITEMS into the current buffer, formatting each item as a single line. - -An explicit newline character will replace newlines so that the text retains its -spacing when it's actually inserted into the REPL buffer." - (dolist (item items) - (cider-repl-history-add-overlays-for - item - (let* ((item (cider-repl-history-elide item)) - (len (length item)) - (start 0) - (newl (propertize "\\n" 'cider-repl-history-extra t))) - (while (and (< start len) - (string-match "\n" item start)) - (insert (substring item start (match-beginning 0)) - newl) - (setq start (match-end 0))) - (insert (substring item start len)))) - (insert "\n"))) - -(defun cider-repl-history-preview-update-text (preview-text) - "Update `cider-repl-history-preview-overlay' to show `PREVIEW-TEXT`." - ;; If preview-text is nil, replacement should be nil too. - (cl-assert (overlayp cider-repl-history-preview-overlay)) - (let ((replacement (when preview-text - (propertize preview-text 'face 'highlight)))) - (overlay-put cider-repl-history-preview-overlay - 'before-string replacement))) - -(defun cider-repl-history-preview-update-by-position (&optional pt) - "Update `cider-repl-history-preview-overlay' to match item at PT. - -This function is called whenever the selection in the *cider-repl-history* -buffer is adjusted, the `cider-repl-history-preview-overlay' -is udpated to preview the text of the selection at PT (or the -current point if not specified)." - (let ((new-text (cider-repl-history-current-string - (or pt (point)) t))) - (cider-repl-history-preview-update-text new-text))) - -(defun cider-repl-history-undo-other-window () - "Undo the most recent change in the other window's buffer. -You most likely want to use this command for undoing an insertion of -text from the *cider-repl-history* buffer." - (interactive) - (with-current-buffer cider-repl-history-repl-buffer - (undo))) - -(defun cider-repl-history-setup (repl-win repl-buf history-buf &optional regexp) - "Setup: REPL-WIN and REPL-BUF are where to insert commands, HISTORY-BUF is the history, and optional arg REGEXP is a filter." - (cider-repl-history-preview-overlay-setup repl-buf) - (with-current-buffer history-buf - (unwind-protect - (progn - (cider-repl-history-mode) - (setq buffer-read-only nil) - (when (eq 'one-line cider-repl-history-display-style) - (setq truncate-lines t)) - (let ((inhibit-read-only t)) - (erase-buffer)) - (setq cider-repl-history-repl-buffer repl-buf) - (setq cider-repl-history-repl-window repl-win) - (let* ((cider-repl-history-maximum-display-length - (if (and cider-repl-history-maximum-display-length - (<= cider-repl-history-maximum-display-length 3)) - 4 - cider-repl-history-maximum-display-length)) - (cider-command-history (cider-repl-history-get-history)) - (items (mapcar - (if cider-repl-history-text-properties - #'copy-sequence - #'substring-no-properties) - cider-command-history))) - (unless cider-repl-history-display-duplicates - ;; display highest or lowest duplicate. - ;; if `cider-repl-history-display-duplicate-highest' is t, - ;; display highest (most recent) duplicate. - (cl-delete-duplicates - items - :test #'equal - :from-end cider-repl-history-display-duplicate-highest)) - (when (stringp regexp) - (setq items (delq nil - (mapcar - #'(lambda (item) - (when (string-match regexp item) - item)) - items)))) - (funcall (or (cdr (assq cider-repl-history-display-style - cider-repl-history-display-styles)) - (error "Invalid `cider-repl-history-display-style': %s" - cider-repl-history-display-style)) - items) - (when cider-repl-history-show-preview - (cider-repl-history-preview-update-by-position (point-min)) - ;; Local post-command-hook, only happens in *cider-repl-history* - (add-hook 'post-command-hook - 'cider-repl-history-preview-update-by-position - nil t) - (add-hook 'kill-buffer-hook - 'cider-repl-history-cleanup-on-exit - nil t)) - (when cider-repl-history-highlight-current-entry - (add-hook 'post-command-hook - 'cider-repl-history-update-highlighed-entry - nil t)) - (message - (let ((entry (if (= 1 (length cider-command-history)) - "entry" - "entries"))) - (concat - (if (and (not regexp) - cider-repl-history-display-duplicates) - (format "%s %s in the command history." - (length cider-command-history) entry) - (format "%s (of %s) %s in the command history shown." - (length items) (length cider-command-history) entry)) - (substitute-command-keys - (concat " Type \\[cider-repl-history-quit] to quit. " - "\\[describe-mode] for help."))))) - (set-buffer-modified-p nil) - (goto-char (point-min)) - (cider-repl-history-forward 0) - (setq mode-name (if regexp - (concat "History [" regexp "]") - "History")) - (run-hooks 'cider-repl-history-hook))) - (setq buffer-read-only t)))) - -(defun cider-repl-history-update () - "Update the history buffer to reflect the latest state of the command history." - (interactive) - (cl-assert (eq major-mode 'cider-repl-history-mode)) - (cider-repl-history-setup cider-repl-history-repl-window - cider-repl-history-repl-buffer - (current-buffer)) - (cider-repl-history-resize-window)) - -(defun cider-repl-history-occur (regexp) - "Display all command history entries matching REGEXP." - (interactive - (list (cider-repl-history-read-regexp - "Display command history entries matching" nil))) - (cl-assert (eq major-mode 'cider-repl-history-mode)) - (cider-repl-history-setup cider-repl-history-repl-window - cider-repl-history-repl-buffer - (current-buffer) - regexp) - (cider-repl-history-resize-window)) - -(put 'cider-repl-history-mode 'mode-class 'special) -(define-derived-mode cider-repl-history-mode clojure-mode "History" - "Major mode for browsing the entries in the command input history. - -\\{cider-repl-history-mode-map}" - (setq-local sesman-system 'CIDER) - (define-key cider-repl-history-mode-map (kbd "n") 'cider-repl-history-forward) - (define-key cider-repl-history-mode-map (kbd "p") 'cider-repl-history-previous) - (define-key cider-repl-history-mode-map (kbd "SPC") 'cider-repl-history-insert-and-quit) - (define-key cider-repl-history-mode-map (kbd "RET") 'cider-repl-history-insert-and-quit) - (define-key cider-repl-history-mode-map [(mouse-2)] 'cider-repl-history-mouse-insert) - (define-key cider-repl-history-mode-map (kbd "l") 'cider-repl-history-occur) - (define-key cider-repl-history-mode-map (kbd "s") 'cider-repl-history-search-forward) - (define-key cider-repl-history-mode-map (kbd "r") 'cider-repl-history-search-backward) - (define-key cider-repl-history-mode-map (kbd "g") 'cider-repl-history-update) - (define-key cider-repl-history-mode-map (kbd "q") 'cider-repl-history-quit) - (define-key cider-repl-history-mode-map (kbd "U") 'cider-repl-history-undo-other-window) - (define-key cider-repl-history-mode-map (kbd "?") 'describe-mode) - (define-key cider-repl-history-mode-map (kbd "h") 'describe-mode)) - -;;;###autoload -(defun cider-repl-history () - "Display items in the CIDER command history in another buffer." - (interactive) - (when (eq major-mode 'cider-repl-history-mode) - (user-error "Already viewing the CIDER command history")) - - (let* ((repl-win (selected-window)) - (repl-buf (window-buffer repl-win)) - (buf (get-buffer-create cider-repl-history-buffer))) - (cider-repl-history-setup repl-win repl-buf buf) - (pop-to-buffer buf) - (cider-repl-history-resize-window))) - -(provide 'cider-repl-history) - -;;; cider-repl-history.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl-history.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl-history.elc deleted file mode 100644 index 6a8716c9243e..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl-history.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl.el deleted file mode 100644 index 2d95cb30c570..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl.el +++ /dev/null @@ -1,1747 +0,0 @@ -;;; cider-repl.el --- CIDER REPL mode interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; Reid McKenzie <me@arrdem.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This functionality concerns `cider-repl-mode' and REPL interaction. For -;; REPL/connection life-cycle management see cider-connection.el. - -;;; Code: - -(require 'cider-client) -(require 'cider-doc) -(require 'cider-test) -(require 'cider-eldoc) ; for cider-eldoc-setup -(require 'cider-common) -(require 'subr-x) -(require 'cider-compat) -(require 'cider-util) -(require 'cider-resolve) - -(require 'clojure-mode) -(require 'easymenu) -(require 'cl-lib) -(require 'sesman) - -(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, and not displayed. When -set to `display-only' the buffer will be displayed, but it will not become -focused. Otherwise the buffer is displayed and focused." - :type '(choice (const :tag "Create the buffer, but don't display it" nil) - (const :tag "Create and display the buffer, but don't focus it" - display-only) - (const :tag "Create, display, and focus the buffer" t)) - :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 results in the REPL are pretty-printed or not. -The `cider-toggle-pretty-printing' command can be used to interactively -change the setting's value." - :type 'boolean - :group 'cider-repl) - -(defcustom cider-repl-pretty-print-width nil - "Control the width of pretty printing on the REPL. -This sets the wrap point for pretty printing on the repl. If nil, it -defaults to the variable `fill-column'." - :type '(restricted-sexp :match-alternatives - (integerp 'nil)) - :group 'cider-repl - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-use-content-types t - "Control whether REPL results are presented using content-type information. -The `cider-repl-toggle-content-types' command can be used to interactively -change the setting's value." - :type 'boolean - :group 'cider-repl - :package-version '(cider . "0.17.0")) - -(defcustom cider-repl-auto-detect-type t - "Control whether to auto-detect the REPL type using track-state information. -If you disable this you'll have to manually change the REPL type between -Clojure and ClojureScript when invoking REPL type changing forms. -Use `cider-set-repl-type' to manually change the REPL type." - :type 'boolean - :group 'cider-repl - :safe #'booleanp - :package-version '(cider . "0.18.0")) - -(defcustom cider-repl-use-clojure-font-lock t - "Non-nil means to use Clojure mode font-locking for input and result. -Nil means that `cider-repl-input-face' and `cider-repl-result-face' -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. -By default there's no prefix, but you can specify something -like \"=>\" if want results to stand out more." - :type 'string - :group 'cider - :package-version '(cider . "0.5.0")) - -(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-print-length 100 - "Initial value for *print-length* set during REPL start." - :type 'integer - :group 'cider - :package-version '(cider . "0.17.0")) - -(defcustom cider-repl-print-level nil - "Initial value for *print-level* set during REPL start." - :type 'integer - :group 'cider - :package-version '(cider . "0.17.0")) - -(defcustom cider-repl-display-help-banner t - "When non-nil a bit of help text will be displayed on REPL start." - :type 'boolean - :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.") - -(defvar cider-mode) -(declare-function cider-refresh-dynamic-font-lock "cider-mode") - -(defun cider-repl--state-handler (response) - "Handle server state contained in RESPONSE." - (with-demoted-errors "Error in `cider-repl--state-handler': %s" - (when (member "state" (nrepl-dict-get response "status")) - (nrepl-dbind-response response (repl-type changed-namespaces) - (when (and repl-type cider-repl-auto-detect-type) - (cider-set-repl-type repl-type)) - (unless (nrepl-dict-empty-p changed-namespaces) - (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces)) - (dolist (b (buffer-list)) - (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-set-buffer-ns "cider-mode") -(defun cider-repl-set-initial-ns (buffer) - "Require standard REPL util functions and set the ns of the REPL's BUFFER. -Namespace is \"user\" by default, but can be overridden in apps like -lein (:init-ns). Both of these operations need to be done as a sync -request at the beginning of the session. Bundling them together for -efficiency." - ;; we don't want to get a timeout during init - (let ((nrepl-sync-request-timeout nil)) - (with-current-buffer buffer - (let* ((response (nrepl-send-sync-request - (lax-plist-put (nrepl--eval-request "(str *ns*)") - "inhibit-cider-middleware" "true") - (cider-current-repl))) - (initial-ns (or (read (nrepl-dict-get response "value")) - "user"))) - (cider-set-buffer-ns initial-ns))))) - -(defun cider-repl-require-repl-utils () - "Require standard REPL util functions into the current REPL." - (interactive) - (nrepl-send-sync-request - (lax-plist-put - (nrepl--eval-request - "(when (clojure.core/resolve 'clojure.main/repl-requires) - (clojure.core/map clojure.core/require clojure.main/repl-requires))") - "inhibit-cider-middleware" "true") - (cider-current-repl))) - -(defun cider-repl--build-config-expression () - "Build the initial config expression." - (when (or cider-repl-print-length cider-repl-print-level) - (concat - "(do" - (when cider-repl-print-length (format " (set! *print-length* %d)" cider-repl-print-length)) - (when cider-repl-print-level (format " (set! *print-level* %d)" cider-repl-print-level)) - ")"))) - -(defun cider-repl-set-config () - "Set an inititial REPL configuration." - (interactive) - (when-let* ((config-expression (cider-repl--build-config-expression))) - (nrepl-send-sync-request - (lax-plist-put - (nrepl--eval-request config-expression) - "inhibit-cider-middleware" "true") - (cider-current-repl)))) - -(defun cider-repl-init (buffer &optional no-banner) - "Initialize the REPL in BUFFER. -BUFFER must be a REPL buffer with `cider-repl-mode' and a running -client process connection. Unless NO-BANNER is non-nil, insert a banner." - (when cider-repl-display-in-current-window - (add-to-list 'same-window-buffer-names (buffer-name buffer))) - (pcase cider-repl-pop-to-buffer-on-connect - (`display-only (display-buffer buffer)) - ((pred identity) (pop-to-buffer buffer))) - (cider-repl-set-initial-ns buffer) - (cider-repl-require-repl-utils) - (cider-repl-set-config) - (unless no-banner - (cider-repl--insert-banner-and-prompt buffer)) - buffer) - -(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))) - -(defun cider-repl--banner () - "Generate the welcome REPL buffer banner." - (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: <C-c C-q> -;; Results: Stored in vars *1, *2, *3, an exception in *e;" - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port) - (cider--version) - (cider--nrepl-version) - (cider--clojure-version) - (cider--java-version))) - -(defun cider-repl--help-banner () - "Generate the help banner." - (substitute-command-keys - "\n;; ====================================================================== -;; If you're new to CIDER it is highly recommended to go through its -;; manual first. Type <M-x cider-view-manual> 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 <M-x customize-group cider> to -;; get a feel for this. If you're thirsty for knowledge you should try -;; <M-x cider-drink-a-sip>. -;; -;; If you think you've encountered a bug (or have some suggestions for -;; improvements) use <M-x cider-report-bug> 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 <M-x cider-repl-clear-help-banner> command. -;; You can disable it from appearing on start by setting -;; `cider-repl-display-help-banner' to nil. -;; ====================================================================== -")) - - -;;; 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))) - -(defvar-local cider-repl--ns-forms-plist nil - "Plist holding ns->ns-form mappings within each connection.") - -(defun cider-repl--ns-form-changed-p (ns-form connection) - "Return non-nil if NS-FORM for CONNECTION changed since last eval." - (when-let* ((ns (cider-ns-from-form ns-form))) - (not (string= ns-form - (lax-plist-get - (buffer-local-value 'cider-repl--ns-forms-plist connection) - ns))))) - -(defvar cider-repl--root-ns-highlight-template "\\_<\\(%s\\)[^$/: \t\n()]+" - "Regexp used to highlight root ns in REPL buffers.") - -(defvar-local cider-repl--root-ns-regexp nil - "Cache of root ns regexp in REPLs.") - -(defvar-local cider-repl--ns-roots nil - "List holding all past root namespaces seen during interactive eval.") - -(defun cider-repl--cache-ns-form (ns-form connection) - "Given NS-FORM cache root ns in CONNECTION." - (with-current-buffer connection - (when-let* ((ns (cider-ns-from-form ns-form))) - ;; cache ns-form - (setq cider-repl--ns-forms-plist - (lax-plist-put cider-repl--ns-forms-plist ns ns-form)) - ;; cache ns roots regexp - (when (string-match "\\([^.]+\\)" ns) - (let ((root (match-string-no-properties 1 ns))) - (unless (member root cider-repl--ns-roots) - (push root cider-repl--ns-roots) - (let ((roots (mapconcat - ;; Replace _ or - with regexp pattern to accommodate "raw" namespaces - (lambda (r) (replace-regexp-in-string "[_-]+" "[_-]+" r)) - cider-repl--ns-roots "\\|"))) - (setq cider-repl--root-ns-regexp - (format cider-repl--root-ns-highlight-template roots))))))))) - -(defvar cider-repl-spec-keywords-regexp - (concat - (regexp-opt '("In:" " val:" - " at:" "fails at:" - " spec:" "fails spec:" - " predicate:" "fails predicate:")) - "\\|^" - (regexp-opt '(":clojure.spec.alpha/spec" - ":clojure.spec.alpha/value") - "\\(")) - "Regexp matching clojure.spec `explain` keywords.") - -(defun cider-repl-highlight-spec-keywords (string) - "Highlight clojure.spec `explain` keywords in STRING. -Foreground of `clojure-keyword-face' is used for highlight." - (cider-add-face cider-repl-spec-keywords-regexp - 'clojure-keyword-face t nil string) - string) - -(defun cider-repl-highlight-current-project (string) - "Fontify project's root namespace to make stacktraces more readable. -Foreground of `cider-stacktrace-ns-face' is used to propertize matched -namespaces. STRING is REPL's output." - (cider-add-face cider-repl--root-ns-regexp 'cider-stacktrace-ns-face - t nil string) - string) - -(defun cider-repl-add-locref-help-echo (string) - "Set help-echo property of STRING to `cider-locref-help-echo'." - (put-text-property 0 (length string) 'help-echo 'cider-locref-help-echo string) - string) - -(defvar cider-repl-preoutput-hook '(ansi-color-apply - cider-repl-highlight-current-project - cider-repl-highlight-spec-keywords - cider-repl-add-locref-help-echo) - "Hook run on output string before it is inserted into the REPL buffer. -Each functions takes a string and must return a modified string. Also see -`cider-run-chained-hook'.") - -(defun cider-repl--emit-output-at-pos (buffer string output-face position &optional bol) - "Using BUFFER, insert STRING (applying to it OUTPUT-FACE) at POSITION. -If BOL is non-nil insert at the beginning of line. Run -`cider-repl-preoutput-hook' on STRING." - (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")) - (setq string (propertize string - 'font-lock-face output-face - 'rear-nonsticky '(font-lock-face))) - (setq string (cider-run-chained-hook 'cider-repl-preoutput-hook string)) - (insert-before-markers string) - (cider-repl--flush-ansi-color-context) - (when (and (= (point) cider-repl-prompt-start-mark) - (not (bolp))) - (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) - (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--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 show-prefix &optional bol) - "Emit into BUFFER the result STRING and mark it as an evaluation result. -If SHOW-PREFIX is non-nil insert `cider-repl-result-prefix' at the beginning -of the line. If BOL is non-nil insert at the beginning of the line." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (goto-char cider-repl-input-start-mark) - (when (and bol (not (bolp))) - (insert-before-markers "\n")) - (when show-prefix - (insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) - (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--display-image (buffer image &optional show-prefix bol string) - "Insert IMAGE into BUFFER at the current point. - -For compatibility with the rest of CIDER's REPL machinery, supports -SHOW-PREFIX and BOL." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (goto-char cider-repl-input-start-mark) - (when (and bol (not (bolp))) - (insert-before-markers "\n")) - (when show-prefix - (insert-before-markers - (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) - (insert-image image string) - (set-marker cider-repl-input-start-mark (point) buffer) - (set-marker cider-repl-prompt-start-mark (point) buffer)))) - (cider-repl--show-maximum-output)) - t) - -(defcustom cider-repl-image-margin 10 - "Specifies the margin to be applied to images displayed in the REPL. -Either a single number of pixels - interpreted as a symmetric margin, or -pair of numbers `(x . y)' encoding an arbitrary margin." - :type '(choice integer (vector integer integer)) - :group 'cider-repl - :package-version '(cider . "0.17.0")) - -(defun cider-repl--image (data type datap) - "A helper for creating images with CIDER's image options. -DATA is either the path to an image or its base64 coded data. TYPE is a -symbol indicating the image type. DATAP indicates whether the image is the -raw image data or a filename. Returns an image instance with a margin per -`cider-repl-image-margin'." - (create-image data type datap - :margin cider-repl-image-margin)) - -(defun cider-repl-handle-jpeg (_type buffer image &optional show-prefix bol) - "A handler for inserting a jpeg IMAGE into a repl BUFFER. -Part of the default `cider-repl-content-type-handler-alist'." - (cider-repl--display-image buffer - (cider-repl--image image 'jpeg t) - show-prefix bol " ")) - -(defun cider-repl-handle-png (_type buffer image &optional show-prefix bol) - "A handler for inserting a png IMAGE into a repl BUFFER. -Part of the default `cider-repl-content-type-handler-alist'." - (cider-repl--display-image buffer - (cider-repl--image image 'png t) - show-prefix bol " ")) - -(defun cider-repl-handle-external-body (type buffer _ &optional _show-prefix _bol) - "Handler for slurping external content into BUFFER. -Handles an external-body TYPE by issuing a slurp request to fetch the content." - (if-let* ((args (cadr type)) - (access-type (nrepl-dict-get args "access-type"))) - (nrepl-send-request - (list "op" "slurp" "url" (nrepl-dict-get args access-type)) - (cider-repl-handler buffer) - (cider-current-repl))) - nil) - -(defvar cider-repl-content-type-handler-alist - `(("message/external-body" . ,#'cider-repl-handle-external-body) - ("image/jpeg" . ,#'cider-repl-handle-jpeg) - ("image/png" . ,#'cider-repl-handle-png)) - "Association list from content-types to handlers. -Handlers must be functions of two required and two optional arguments - the -REPL buffer to insert into, the value of the given content type as a raw -string, the REPL's show prefix as any and an `end-of-line' flag. - -The return value of the handler should be a flag, indicating whether or not -the REPL is ready for a prompt to be displayed. Most handlers should return -t, as the content-type response is (currently) an alternative to the -value response. However for handlers which themselves issue subsequent -nREPL ops, it may be convenient to prevent inserting a prompt.") - -(defun cider-repl-handler (buffer) - "Make an nREPL evaluation handler for the REPL BUFFER." - (let (after-first-result-chunk - (show-prompt t)) - (nrepl-make-response-handler - buffer - (lambda (buffer value) - (cider-repl-emit-result buffer value (not after-first-result-chunk) t) - (setq after-first-result-chunk t)) - (lambda (buffer out) - (cider-repl-emit-stdout buffer out)) - (lambda (buffer err) - (cider-repl-emit-stderr buffer err)) - (lambda (buffer) - (when show-prompt - (cider-repl-emit-prompt buffer) - (let ((win (get-buffer-window (current-buffer) t))) - (when win - (with-selected-window win - (set-window-point win cider-repl-input-start-mark)) - (cider-repl--show-maximum-output))))) - nrepl-err-handler - (lambda (buffer pprint-out) - (cider-repl-emit-result buffer pprint-out (not after-first-result-chunk)) - (setq after-first-result-chunk t)) - (lambda (buffer value content-type) - (if-let* ((content-attrs (cadr content-type)) - (content-type* (car content-type)) - (handler (cdr (assoc content-type* - cider-repl-content-type-handler-alist)))) - (setq after-first-result-chunk t - show-prompt (funcall handler content-type buffer value - (not after-first-result-chunk) t)) - (progn (cider-repl-emit-result buffer value (not after-first-result-chunk) t) - (setq after-first-result-chunk t))))))) - -(defun cider--repl-request-plist (right-margin &optional pprint-fn) - "Plist to be appended to generic eval requests, as for the REPL. -PPRINT-FN and RIGHT-MARGIN are as in `cider--nrepl-pprint-request-plist'." - (nconc (when cider-repl-use-pretty-printing - (cider--nrepl-pprint-request-plist right-margin pprint-fn)) - (when cider-repl-use-content-types - (cider--nrepl-content-type-plist)))) - -(defun cider-repl--send-input (&optional newline) - "Go to the end of the input and send the current input. -If NEWLINE is true then add a newline at the end of the input." - (unless (cider-repl--in-input-area-p) - (error "No input at point")) - (let ((input (cider-repl--current-input))) - (if (string-blank-p input) - ;; don't evaluate a blank string, but erase it and emit - ;; a fresh prompt to acknowledge to the user. - (progn - (cider-repl--replace-input "") - (cider-repl-emit-prompt (current-buffer))) - ;; otherwise evaluate the input - (goto-char (point-max)) - (let ((end (point))) ; end of input, without the newline - (cider-repl--add-to-input-history input) - (when newline - (insert "\n") - (cider-repl--show-maximum-output)) - (let ((inhibit-modification-hooks t)) - (add-text-properties cider-repl-input-start-mark - (point) - `(cider-old-input - ,(cl-incf cider-repl-old-input-counter)))) - (unless cider-repl-use-clojure-font-lock - (let ((overlay (make-overlay cider-repl-input-start-mark end))) - ;; These properties are on an overlay so that they won't be taken - ;; by kill/yank. - (overlay-put overlay 'read-only t) - (overlay-put overlay 'font-lock-face 'cider-repl-input-face)))) - (let ((input-start (save-excursion (cider-repl-beginning-of-defun) (point)))) - (goto-char (point-max)) - (cider-repl--mark-input-start) - (cider-repl--mark-output-start) - (cider-nrepl-request:eval - input - (cider-repl-handler (current-buffer)) - (cider-current-ns) - (line-number-at-pos input-start) - (cider-column-number-at-pos input-start) - (cider--repl-request-plist (cider--pretty-print-width))))))) - -(defun cider-repl-return (&optional end-of-input) - "Evaluate the current input string, or insert a newline. -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--pretty-print-width () - "Return the width to use for pretty-printing." - (or cider-repl-pretty-print-width - fill-column - 80)) - -(defun cider-repl-toggle-content-types () - "Toggle content-type rendering in the REPL." - (interactive) - (setq cider-repl-use-content-types (not cider-repl-use-content-types)) - (message "Content-type support in REPL %s." - (if cider-repl-use-content-types "enabled" "disabled"))) - -(defun cider-repl-switch-to-other () - "Switch between the Clojure and ClojureScript REPLs for the current project." - (interactive) - ;; FIXME: implement cycling as session can hold more than two REPLs - (let* ((this-repl (cider-current-repl nil 'ensure)) - (other-repl (car (seq-remove (lambda (r) (eq r this-repl)) (cider-repls nil t))))) - (if other-repl - (switch-to-buffer other-repl) - (user-error "No other REPL in current session (%s)" - (car (sesman-current-session 'CIDER)))))) - -(defvar cider-repl-clear-buffer-hook) - -(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 () - "Clear the currently visited REPL buffer completely. -See also the related commands `cider-repl-clear-output' and -`cider-find-and-clear-repl-output'." - (interactive) - (let ((inhibit-read-only t)) - (cider-repl--clear-region (point-min) cider-repl-prompt-start-mark) - (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 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-repls :auto - (lambda (connection) - (cider-nrepl-request:eval (format "(in-ns '%s)" ns) - (cider-repl-switch-ns-handler connection))))) - - -;;; Location References - -(defcustom cider-locref-regexp-alist - '((stdout-stacktrace "[ \t]\\(at \\([^$(]+\\).*(\\([^:()]+\\):\\([0-9]+\\))\\)" 1 2 3 4) - (aviso-stacktrace "^[ \t]*\\(\\([^$/ \t]+\\).*? +\\([^:]+\\): +\\([0-9]+\\)\\)" 1 2 3 4) - (print-stacktrace "\\[\\([^][$ \t]+\\).* +\\([^ \t]+\\) +\\([0-9]+\\)\\]" 0 1 2 3) - (timbre-log "\\(TRACE\\|INFO\\|DEBUG\\|WARN\\|ERROR\\) +\\(\\[\\([^:]+\\):\\([0-9]+\\)\\]\\)" 2 3 nil 4) - (cljs-message "at line \\([0-9]+\\) +\\(.*\\)$" 0 nil 2 1) - (reflection "Reflection warning, +\\(\\([^\n:]+\\):\\([0-9]+\\):[0-9]+\\)" 1 nil 2 3)) - "Alist holding regular expressions for inline location references. -Each element in the alist has the form (NAME REGEXP HIGHLIGHT VAR FILE -LINE), where NAME is the identifier of the regexp, REGEXP - regexp matching -a location, HIGHLIGHT - sub-expression matching region to highlight on -mouse-over, VAR - sub-expression giving Clojure VAR to look up. FILE is -currently only used when VAR is nil and must be full resource path in that -case." - :type '(alist :key-type sexp) - :group 'cider-repl - :package-version '(cider. "0.16.0")) - -(defun cider--locref-at-point-1 (reg-list &optional pos) - "Workhorse for getting locref at POS. -REG-LIST is an entry in `cider-locref-regexp-alist'." - (save-excursion - (let ((pos (or pos (point)))) - (goto-char pos) - (beginning-of-line) - (when (re-search-forward (nth 1 reg-list) (point-at-eol) t) - (let ((ix-highlight (or (nth 2 reg-list) 0)) - (ix-var (nth 3 reg-list)) - (ix-file (nth 4 reg-list)) - (ix-line (nth 5 reg-list))) - (list - :type (car reg-list) - :highlight (cons (match-beginning ix-highlight) (match-end ix-highlight)) - :var (and ix-var - (replace-regexp-in-string "_" "-" - (match-string-no-properties ix-var) - nil t)) - :file (and ix-file (match-string-no-properties ix-file)) - :line (and ix-line (string-to-number (match-string-no-properties ix-line))))))))) - -(defun cider-locref-at-point (&optional pos) - "Return a plist of components of the location reference at POS. -Limit search to current line only and return nil if no location has been -found. Returned keys are :type, :highlight, :var, :file, :line, where -:highlight is a cons of positions, :var and :file are strings or nil, :line -is a number. See `cider-locref-regexp-alist' for how to specify regexes -for locref look up." - (seq-some (lambda (rl) (cider--locref-at-point-1 rl pos)) - cider-locref-regexp-alist)) - -(defun cider-jump-to-locref-at-point (&optional pos) - "Identify location reference at POS and navigate to it. -This function is used from help-echo property inside REPL buffers and uses -regexes from `cider-locref-regexp-alist' to infer locations at point." - (interactive) - (if-let* ((loc (cider-locref-at-point pos))) - (let* ((var (plist-get loc :var)) - (line (plist-get loc :line)) - (file (or - ;; retrieve from info middleware - (when var - (or (cider-sync-request:ns-path var) - (nrepl-dict-get (cider-sync-request:info var) "file"))) - ;; when not found, return the file detected by regexp - (when-let* ((file (plist-get loc :file))) - (if (file-name-absolute-p file) - file - ;; when not absolute, expand within the current project - (when-let* ((proj (clojure-project-dir))) - (expand-file-name file proj))))))) - (if file - (cider--jump-to-loc-from-info (nrepl-dict "file" file "line" line) t) - (error "No source location for %s" var))) - (user-error "No location reference at point"))) - -(defvar cider-locref-hoover-overlay - (let ((o (make-overlay 1 1))) - (overlay-put o 'category 'cider-error-hoover) - ;; (overlay-put o 'face 'highlight) - (overlay-put o 'pointer 'hand) - (overlay-put o 'mouse-face 'highlight) - (overlay-put o 'follow-link 'mouse) - (overlay-put o 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] 'cider-jump-to-locref-at-point) - (define-key map [mouse-2] 'cider-jump-to-locref-at-point) - map)) - o) - "Overlay used during hoovering on location references in REPL buffers. -One for all REPLs.") - -(defun cider-locref-help-echo (_win buffer pos) - "Function for help-echo property in REPL buffers. -WIN, BUFFER and POS are the window, buffer and point under mouse position." - (with-current-buffer buffer - (if-let* ((hl (plist-get (cider-locref-at-point pos) :highlight))) - (move-overlay cider-locref-hoover-overlay (car hl) (cdr hl)) - (delete-overlay cider-locref-hoover-overlay)) - nil)) - - -;;; History - -(defcustom cider-repl-wrap-history nil - "T to wrap history around when the end is reached." - :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-toggle-trace-ns "cider-tracing") -(declare-function cider-undef "cider-mode") -(declare-function cider-browse-ns "cider-browse-ns") -(declare-function cider-classpath "cider-classpath") -(declare-function cider-repl-history "cider-repl-history") -(declare-function cider-run "cider-mode") -(declare-function cider-ns-refresh "cider-ns") -(declare-function cider-version "cider") -(declare-function cider-test-run-loaded-tests "cider-test") -(declare-function cider-test-run-project-tests "cider-test") -(cider-repl-add-shortcut "clear-output" #'cider-repl-clear-output) -(cider-repl-add-shortcut "clear" #'cider-repl-clear-buffer) -(cider-repl-add-shortcut "clear-banners" #'cider-repl-clear-banners) -(cider-repl-add-shortcut "clear-help-banner" #'cider-repl-clear-help-banner) -(cider-repl-add-shortcut "ns" #'cider-repl-set-ns) -(cider-repl-add-shortcut "toggle-pretty" #'cider-repl-toggle-pretty-printing) -(cider-repl-add-shortcut "browse-ns" (lambda () (interactive) (cider-browse-ns (cider-current-ns)))) -(cider-repl-add-shortcut "classpath" #'cider-classpath) -(cider-repl-add-shortcut "history" #'cider-repl-history) -(cider-repl-add-shortcut "trace-ns" #'cider-toggle-trace-ns) -(cider-repl-add-shortcut "undef" #'cider-undef) -(cider-repl-add-shortcut "refresh" #'cider-ns-refresh) -(cider-repl-add-shortcut "help" #'cider-repl-shortcuts-help) -(cider-repl-add-shortcut "test-ns" #'cider-test-run-ns-tests) -(cider-repl-add-shortcut "test-all" #'cider-test-run-loaded-tests) -(cider-repl-add-shortcut "test-project" #'cider-test-run-project-tests) -(cider-repl-add-shortcut "test-ns-with-filters" #'cider-test-run-ns-tests-with-filters) -(cider-repl-add-shortcut "test-all-with-filters" (lambda () (interactive) (cider-test-run-loaded-tests 'prompt-for-filters))) -(cider-repl-add-shortcut "test-project-with-filters" (lambda () (interactive) (cider-test-run-project-tests 'prompt-for-filters))) -(cider-repl-add-shortcut "test-report" #'cider-test-show-report) -(cider-repl-add-shortcut "run" #'cider-run) -(cider-repl-add-shortcut "conn-info" #'cider-describe-connection) -(cider-repl-add-shortcut "hasta la vista" #'cider-quit) -(cider-repl-add-shortcut "adios" #'cider-quit) -(cider-repl-add-shortcut "sayonara" #'cider-quit) -(cider-repl-add-shortcut "quit" #'cider-quit) -(cider-repl-add-shortcut "restart" #'cider-restart) -(cider-repl-add-shortcut "version" #'cider-version) -(cider-repl-add-shortcut "require-repl-utils" #'cider-repl-require-repl-utils) - -(defconst cider-repl-shortcuts-help-buffer "*CIDER REPL Shortcuts Help*") - -(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 command-func) - (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-last-sexp "cider-eval") -(declare-function cider-toggle-trace-ns "cider-tracing") -(declare-function cider-toggle-trace-var "cider-tracing") -(declare-function cider-find-resource "cider-find") -(declare-function cider-find-ns "cider-find") -(declare-function cider-find-keyword "cider-find") -(declare-function cider-find-var "cider-find") -(declare-function cider-switch-to-last-clojure-buffer "cider-mode") -(declare-function cider-macroexpand-1 "cider-macroexpansion") -(declare-function cider-macroexpand-all "cider-macroexpansion") -(declare-function cider-selector "cider-selector") -(declare-function cider-jack-in-clj "cider") -(declare-function cider-jack-in-cljs "cider") -(declare-function cider-connect-clj "cider") -(declare-function cider-connect-cljs "cider") - -(defvar cider-repl-mode-map - (let ((map (make-sparse-keymap))) - (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 "C-c C-:") #'cider-find-keyword) - (define-key map (kbd "M-,") #'cider-pop-back) - (define-key map (kbd "C-c M-.") #'cider-find-resource) - (define-key map (kbd "RET") #'cider-repl-return) - (define-key map (kbd "TAB") #'cider-repl-tab) - (define-key map (kbd "C-<return>") #'cider-repl-closing-return) - (define-key map (kbd "C-j") #'cider-repl-newline-and-indent) - (define-key map (kbd "C-c C-o") #'cider-repl-clear-output) - (define-key map (kbd "C-c M-n") #'cider-repl-set-ns) - (define-key map (kbd "C-c C-u") #'cider-repl-kill-input) - (define-key map (kbd "C-S-a") #'cider-repl-bol-mark) - (define-key map [S-home] #'cider-repl-bol-mark) - (define-key map (kbd "C-<up>") #'cider-repl-backward-input) - (define-key map (kbd "C-<down>") #'cider-repl-forward-input) - (define-key map (kbd "M-p") #'cider-repl-previous-input) - (define-key map (kbd "M-n") #'cider-repl-next-input) - (define-key map (kbd "M-r") #'cider-repl-previous-matching-input) - (define-key map (kbd "M-s") #'cider-repl-next-matching-input) - (define-key map (kbd "C-c C-n") #'cider-repl-next-prompt) - (define-key map (kbd "C-c C-p") #'cider-repl-previous-prompt) - (define-key map (kbd "C-c C-b") #'cider-interrupt) - (define-key map (kbd "C-c C-c") #'cider-interrupt) - (define-key map (kbd "C-c C-m") #'cider-macroexpand-1) - (define-key map (kbd "C-c M-m") #'cider-macroexpand-all) - (define-key map (kbd "C-c C-s") #'sesman-map) - (define-key map (kbd "C-c C-z") #'cider-switch-to-last-clojure-buffer) - (define-key map (kbd "C-c M-o") #'cider-repl-switch-to-other) - (define-key map (kbd "C-c M-s") #'cider-selector) - (define-key map (kbd "C-c M-d") #'cider-describe-connection) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c M-r") #'cider-restart) - (define-key map (kbd "C-c M-i") #'cider-inspect) - (define-key map (kbd "C-c M-p") #'cider-repl-history) - (define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var) - (define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns) - (define-key map (kbd "C-c C-x") 'cider-start-map) - (define-key map (kbd "C-x C-e") #'cider-eval-last-sexp) - (define-key map (kbd "C-c C-r") 'clojure-refactor-map) - (define-key map (kbd "C-c C-v") 'cider-eval-commands-map) - (define-key map (kbd "C-c M-j") #'cider-jack-in-clj) - (define-key map (kbd "C-c M-J") #'cider-jack-in-cljs) - (define-key map (kbd "C-c M-c") #'cider-connect-clj) - (define-key map (kbd "C-c M-C") #'cider-connect-cljs) - - (define-key map (string cider-repl-shortcut-dispatch-char) #'cider-repl-handle-shortcut) - (easy-menu-define cider-repl-mode-menu map - "Menu for CIDER's REPL mode" - `("REPL" - ["Complete symbol" complete-symbol] - "--" - ,cider-doc-menu - "--" - ("Find" - ["Find definition" cider-find-var] - ["Find namespace" cider-find-ns] - ["Find resource" cider-find-resource] - ["Find keyword" cider-find-keyword] - ["Go back" cider-pop-back]) - "--" - ["Switch to Clojure buffer" cider-switch-to-last-clojure-buffer] - ["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-ns-refresh] - "--" - ["Set REPL ns" cider-repl-set-ns] - ["Toggle pretty printing" cider-repl-toggle-pretty-printing] - ["Require REPL utils" cider-repl-require-repl-utils] - "--" - ["Browse classpath" cider-classpath] - ["Browse classpath entry" cider-open-classpath-entry] - ["Browse namespace" cider-browse-ns] - ["Browse all namespaces" cider-browse-ns-all] - ["Browse spec" cider-browse-spec] - ["Browse all specs" cider-browse-spec-all] - "--" - ["Next prompt" cider-repl-next-prompt] - ["Previous prompt" cider-repl-previous-prompt] - ["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-describe-connection] - "--" - ["Close ancillary buffers" cider-close-ancillary-buffers] - ["Quit" cider-quit] - ["Restart" cider-restart] - "--" - ["Clojure Cheatsheet" cider-cheatsheet] - "--" - ["A sip of CIDER" cider-drink-a-sip] - ["View manual online" cider-view-manual] - ["View refcard online" cider-view-refcard] - ["Report a bug" cider-report-bug] - ["Version info" cider-version])) - map)) - -(sesman-install-menu cider-repl-mode-map) - -(defun cider-repl-wrap-fontify-function (func) - "Return a function that will call FUNC narrowed to input region." - (lambda (beg end &rest rest) - (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-completion") -(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) - (clojure-font-lock-setup) - (font-lock-add-keywords nil cider--static-font-lock-keywords) - (setq-local sesman-system 'CIDER) - (setq-local font-lock-fontify-region-function - (cider-repl-wrap-fontify-function font-lock-fontify-region-function)) - (setq-local font-lock-unfontify-region-function - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl.elc deleted file mode 100644 index e4b8f04616a3..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-resolve.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-resolve.el deleted file mode 100644 index 3c2dc6fdf79a..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-resolve.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection - -;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; 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!" "#'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-let* ((conn (cider-current-repl))) - (with-current-buffer conn - (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 the return value of the -function `cider-repl-type'." - (when-let* ((repl (cider-current-repl))) - (with-current-buffer repl - (cider-resolve--get-in (if (equal cider-repl-type "cljs") - "cljs.core" - "clojure.core"))))) - -(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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-resolve.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-resolve.elc deleted file mode 100644 index c1bd31c59b8b..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-resolve.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-scratch.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-scratch.el deleted file mode 100644 index f1c3e93d1cd0..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-scratch.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Imitate Emacs's *scratch* buffer. - -;;; Code: - -(require 'cider-eval) -(require 'clojure-mode) -(require 'easymenu) - -(defcustom cider-scratch-initial-message - ";; This buffer is for Clojure experiments and evaluation.\n -;; Press C-j to evaluate the last expression.\n\n" - "The initial message displayed in new scratch buffers." - :type 'string - :group 'cider - :package-version '(cider . "0.18.0")) - -(defvar cider-clojure-interaction-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map clojure-mode-map) - (define-key map (kbd "C-j") #'cider-eval-print-last-sexp) - (define-key map [remap paredit-newline] #'cider-eval-print-last-sexp) - (easy-menu-define cider-clojure-interaction-mode-menu map - "Menu for Clojure Interaction mode" - '("Clojure Interaction" - (["Eval and print last sexp" #'cider-eval-print-last-sexp] - "--" - ["Reset" #'cider-scratch-reset]))) - map)) - -(defconst cider-scratch-buffer-name "*cider-scratch*") - -;;;###autoload -(defun cider-scratch () - "Go to the scratch buffer named `cider-scratch-buffer-name'." - (interactive) - (pop-to-buffer (cider-scratch-find-or-create-buffer))) - -(defun cider-scratch-find-or-create-buffer () - "Find or create the scratch buffer." - (or (get-buffer cider-scratch-buffer-name) - (cider-scratch--create-buffer))) - -(define-derived-mode cider-clojure-interaction-mode clojure-mode "Clojure Interaction" - "Major mode for typing and evaluating Clojure forms. -Like clojure-mode except that \\[cider-eval-print-last-sexp] evals the Lisp expression -before point, and prints its value into the buffer, advancing point. - -\\{cider-clojure-interaction-mode-map}" - (setq-local sesman-system 'CIDER)) - -(defun cider-scratch--insert-welcome-message () - "Insert the welcome message for the scratch buffer." - (insert cider-scratch-initial-message)) - -(defun cider-scratch--create-buffer () - "Create a new scratch buffer." - (with-current-buffer (get-buffer-create cider-scratch-buffer-name) - (cider-clojure-interaction-mode) - (cider-scratch--insert-welcome-message) - (current-buffer))) - -(defun cider-scratch-reset () - "Reset the current scratch buffer." - (interactive) - (erase-buffer) - (cider-scratch--insert-welcome-message)) - -(provide 'cider-scratch) - -;;; cider-scratch.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-scratch.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-scratch.elc deleted file mode 100644 index f6f0788fa7cc..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-scratch.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-selector.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-selector.el deleted file mode 100644 index a21032db0737..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-selector.el +++ /dev/null @@ -1,166 +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-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Buffer selection command inspired by SLIME's selector. - -;;; Code: - -(require 'cider-client) -(require 'cider-eval) -(require 'cider-scratch) -(require 'cider-profile) - -(defconst cider-selector-help-buffer "*CIDER Selector Help*" - "The name of the selector's help buffer.") - -(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'. -Not meant to be set by users. It's used internally -by `cider-selector'.") - -(defun cider-selector--recently-visited-buffer (mode) - "Return the most recently visited buffer, deriving its `major-mode' from MODE. -Only considers buffers that are not already visible." - (cl-loop for buffer in (buffer-list) - 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-selector--recently-visited-buffer 'clojure-mode)) - -(def-cider-selector-method ?e - "Most recently visited emacs-lisp-mode buffer." - (cider-selector--recently-visited-buffer 'emacs-lisp-mode)) - -(def-cider-selector-method ?q "Abort." - (top-level)) - -(def-cider-selector-method ?r - "Current REPL buffer." - (cider-current-repl)) - -(def-cider-selector-method ?m - "Current connection's *nrepl-messages* buffer." - (nrepl-messages-buffer (cider-current-repl))) - -(def-cider-selector-method ?x - "*cider-error* buffer." - cider-error-buffer) - -(def-cider-selector-method ?p - "CIDER profiler buffer." - cider-profile-buffer) - -(def-cider-selector-method ?d - "*cider-doc* buffer." - cider-doc-buffer) - -(def-cider-selector-method ?s - "*cider-scratch* buffer." - (cider-scratch-find-or-create-buffer)) - -(provide 'cider-selector) - -;;; cider-selector.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-selector.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-selector.elc deleted file mode 100644 index 7921110b39c8..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-selector.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-stacktrace.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-stacktrace.el deleted file mode 100644 index 321d4bbdeb0b..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-stacktrace.el +++ /dev/null @@ -1,910 +0,0 @@ -;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors - -;; Author: Jeff Valk <jv@jeffvalk.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Stacktrace filtering and stack frame source navigation - -;;; Code: - -(require 'cl-lib) -(require 'cider-popup) -(require 'button) -(require 'easymenu) -(require 'cider-common) -(require 'subr-x) -(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-cause-visibility nil) -(defvar-local cider-stacktrace-positive-filters nil) - -(defconst cider-error-buffer "*cider-error*") - -(make-obsolete 'cider-visit-error-buffer 'cider-selector "0.18") - -(defcustom cider-stacktrace-suppressed-errors '() - "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-active-face - '((t (:inherit button :underline t :weight normal))) - "Face for filter buttons representing frames currently visible" - :group 'cider-stacktrace - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-filter-inactive-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) - (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))) - - -(defadvice disable-theme (after cider-stacktrace-adapt-to-theme activate) - "When theme is disabled, update `cider-stacktrace-frames-background-color'." - (setq cider-stacktrace-frames-background-color (cider-scale-background-color))) - - -;; Mode & key bindings - -(defvar cider-stacktrace-mode-map - (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 "p" #'cider-stacktrace-show-only-project) - (define-key map "a" #'cider-stacktrace-toggle-all) - (define-key map "1" #'cider-stacktrace-cycle-cause-1) - (define-key map "2" #'cider-stacktrace-cycle-cause-2) - (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 (kbd "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] - ["Toggle only project frames" cider-stacktrace-show-only-project] - ["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}" - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local sesman-system 'CIDER) - (setq-local electric-indent-chars nil) - (setq-local cider-stacktrace-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 - -(defvar cider-stacktrace--all-negative-filters - '(clj tooling dup java repl) - "Filters that remove stackframes.") - -(defvar cider-stacktrace--all-positive-filters - '(project all) - "Filters that ensure stackframes are shown.") - -(defun cider-stacktrace--face-for-filter (filter neg-filters pos-filters) - "Return whether we should mark the FILTER is active or not. - -NEG-FILTERS and POS-FILTERS are lists of filters to check FILTER's type. - -NEG-FILTERS dictate which frames should be hidden while POS-FILTERS can -override this and ensure that those frames are shown." - (cond ((member filter cider-stacktrace--all-negative-filters) - (if (member filter neg-filters) - 'cider-stacktrace-filter-active-face - 'cider-stacktrace-filter-inactive-face)) - ((member filter cider-stacktrace--all-positive-filters) - (if (member filter pos-filters) - 'cider-stacktrace-filter-active-face - 'cider-stacktrace-filter-inactive-face)))) - -(defun cider-stacktrace-indicate-filters (filters pos-filters) - "Update enabled state of filter buttons. - -Find buttons with a 'filter property; if filter is a member of FILTERS, or -if filter is nil ('show all') and the argument list is non-nil, fontify the -button as disabled. Upon finding text with a 'hidden-count property, stop -searching and update the hidden count text. POS-FILTERS is the list of -positive filters to always include." - (with-current-buffer cider-error-buffer - (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t)) - ;; 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 (cider-stacktrace--face-for-filter filter - filters - pos-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-frame-p () - "Indicate if the text at point is a stack frame." - (get-text-property (point) 'cider-stacktrace-frame)) - -(defun cider-stacktrace-collapsed-p () - "Indicate if the stackframe was collapsed." - (get-text-property (point) 'collapsed)) - -(defun cider-stacktrace--should-hide-p (neg-filters pos-filters flags) - "Decide whether a stackframe should be hidden or not. -NEG-FILTERS dictate which frames should be hidden while POS-FILTERS can -override this and ensure that those frames are shown. -Argument FLAGS are the flags set on the stackframe, ie: clj dup, etc." - (let ((neg (seq-intersection neg-filters flags)) - (pos (seq-intersection pos-filters flags)) - (all (memq 'all pos-filters))) - (cond (all nil) ;; if all filter is on then we should not hide - ((and pos neg) nil) ;; if hidden and "resurrected" we should not hide - (pos nil) - (neg t) - (t nil)))) - -(defun cider-stacktrace--apply-filters (neg-filters pos-filters) - "Set visibility on stack frames. -Should be called by `cider-stacktrace-apply-filters' which has the logic of -how to interpret the combinations of the positive and negative filters. -For instance, the presence of the positive filter `project' requires all of -the other negative filters to be applied so that only project frames are -shown. NEG-FILTERS are the tags that should be hidden. POS-FILTERS are -the tags that must be shown." - (with-current-buffer cider-error-buffer - (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t) - (hidden 0)) - (while (not (eobp)) - (when (and (cider-stacktrace-frame-p) - (not (cider-stacktrace-collapsed-p))) - (let* ((flags (get-text-property (point) 'flags)) - (hide (cider-stacktrace--should-hide-p neg-filters - pos-filters - flags))) - (when hide (cl-incf hidden)) - (put-text-property (point) (line-beginning-position 2) - 'invisible hide))) - (forward-line 1)) - (setq cider-stacktrace-hidden-frame-count hidden))) - (cider-stacktrace-indicate-filters neg-filters pos-filters))) - -(defun cider-stacktrace-apply-filters (filters) - "Takes a single list of filters and applies them. -Update `cider-stacktrace-hidden-frame-count' and indicate -filters applied. Currently collapsed stacktraces are ignored, and do not -contribute to the hidden count. FILTERS is the list of filters to be -applied, positive and negative all together. This function defines how -those choices interact and separates them into positive and negative -filters for the resulting machinery." - (let ((neg-filters (seq-intersection filters cider-stacktrace--all-negative-filters)) - (pos-filters (seq-intersection filters cider-stacktrace--all-positive-filters))) - ;; project and all are mutually exclusive. when both are present we check to - ;; see the most recent one (as cons onto the list would put it) and use that - ;; interaction. - (cond - ((memq 'all (memq 'project pos-filters)) ;; project is most recent - (cider-stacktrace--apply-filters cider-stacktrace--all-negative-filters '(project))) - ((memq 'project (memq 'all pos-filters)) ;; all is most recent - (cider-stacktrace--apply-filters nil '(all))) - ((memq 'all pos-filters) (cider-stacktrace--apply-filters nil '(all))) - ((memq 'project pos-filters) (cider-stacktrace--apply-filters cider-stacktrace--all-negative-filters - pos-filters)) - (t (cider-stacktrace--apply-filters neg-filters pos-filters))))) - -(defun cider-stacktrace-apply-cause-visibility () - "Apply `cider-stacktrace-cause-visibility' to causes and reapply filters." - (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'. -If LEVEL is specified, it is useed, otherwise its current value is incremented. -When it reaches 3, it wraps to 0." - (let ((level (or level (1+ (elt cider-stacktrace-cause-visibility num))))) - (aset cider-stacktrace-cause-visibility num (mod level 3)) - (cider-stacktrace-apply-cause-visibility))) - -(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 (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-all () - "Toggle `all' in filter list." - (interactive) - (cider-stacktrace-toggle 'all)) - -(defun cider-stacktrace-show-only-project () - "Display only the stackframes from the project." - (interactive) - (cider-stacktrace-toggle 'project)) - -(defun cider-stacktrace-toggle-java () - "Toggle display of Java stack frames." - (interactive) - (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))) - (cond ((member flag cider-stacktrace--all-negative-filters) - (cider-stacktrace-toggle flag)) - ((member flag cider-stacktrace--all-positive-filters) - (cider-stacktrace-show-only-project)) - (t (cider-stacktrace-toggle-all)))) - (sit-for 5))) - -(defun cider-stacktrace-toggle-suppression (button) - "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))) - (file (or - (and (null var) (cider-resolve-java-class class)) - (nrepl-dict-get info "file") - (button-get button 'file))) - ;; give priority to `info` files as `info` returns full paths. - (info (nrepl-dict-put info "file" file))) - (cider--jump-to-loc-from-info info t) - (forward-line line-shift) - (back-to-indentation))) - -(declare-function cider-find-var "cider-find") - -(defun cider-stacktrace-jump (&optional arg) - "Find definition for stack frame at point, if available. -The prefix ARG and `cider-prompt-for-symbol' decide whether to -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 -(defvar cider-use-tooltips) -(defun cider-stacktrace-tooltip (tooltip) - "Return TOOLTIP if `cider-use-tooltips' is set to true, nil otherwise." - (when cider-use-tooltips tooltip)) - -(defun cider-stacktrace-emit-indented (text &optional indent fill fontify) - "Insert TEXT, and optionally FILL and FONTIFY as clojure the entire block. -INDENT is a string to insert before each line. When INDENT is nil, first -line is not indented and INDENT defaults to a white-spaced string with -length given by `current-column'." - (let ((text (if fontify - (cider-font-lock-as-clojure text) - text)) - (do-first indent) - (indent (or indent (make-string (current-column) ? ))) - (beg (point))) - (insert text) - (goto-char beg) - (when do-first - (insert indent)) - (forward-line) - (while (not (eobp)) - (insert indent) - (forward-line)) - (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 special-filters filters) - "Emit into BUFFER toggle buttons for each of the FILTERS. -SPECIAL-FILTERS are filters that show stack certain stack frames, hiding -others." - (with-current-buffer buffer - (insert " Show: ") - (dolist (filter special-filters) - (insert-text-button (car filter) - 'filter (cadr filter) - 'follow-link t - 'action 'cider-stacktrace-filter - 'help-echo (cider-stacktrace-tooltip - (format "Toggle %s stack frames" - (car filter)))) - (insert " ")) - (insert "\n") - (insert " Hide: ") - (dolist (filter filters) - (insert-text-button (car filter) - 'filter (cadr filter) - 'follow-link t - 'action 'cider-stacktrace-filter - 'help-echo (cider-stacktrace-tooltip - (format "Toggle %s stack frames" - (car filter)))) - (insert " ")) - - (let ((hidden "(0 frames hidden)")) - (put-text-property 0 (length hidden) 'hidden-count t hidden) - (insert " " hidden "\n")))) - -(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 (cider-stacktrace-tooltip - "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 (cider-stacktrace-tooltip - (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 (cider-stacktrace-tooltip - "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) - (put-text-property (line-beginning-position) (line-end-position) - 'cider-stacktrace-frame t))) - (insert "\n"))))) - -(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))) - 'help-echo (cider-stacktrace-tooltip - "Jump to the line that caused the error")) - (insert (propertize (format " at (%d:%d)" line column) - 'font-lock-face message-face)))))) - -(defun cider-stacktrace--toggle-visibility (id) - "Toggle visibility of the region with ID invisibility prop. -ID can also be a button, in which case button's property :id is used -instead. This function can be used directly in button actions." - (let ((id (if (or (numberp id) (symbolp id)) - ;; There is no proper way to identify buttons. Assuming that - ;; id's can be either numbers or symbols. - id - (button-get id :id)))) - (if (and (consp buffer-invisibility-spec) - (assoc id buffer-invisibility-spec)) - (remove-from-invisibility-spec (cons id t)) - (add-to-invisibility-spec (cons id t))))) - -(defun cider-stacktrace--insert-named-group (indent name &rest vals) - "Insert named group with the ability to toggle visibility. -NAME is a string naming the group. VALS are strings to be inserted after -the NAME. The whole group is prefixed by string INDENT." - (let* ((str (and vals (replace-regexp-in-string "\n+\\'" "" (apply #'concat vals)))) - (id (and str - (string-match "\n" str) - (cl-gensym name)))) - (insert indent) - (if id - (let* ((beg-link (string-match "[^ :]" name)) - (end-link (string-match "[ :]" name (1+ beg-link)))) - (insert (substring name 0 beg-link)) - (insert-text-button (substring name beg-link end-link) - :id id - 'face '((:weight bold) (:underline t)) - 'follow-link t - 'help-echo "Toggle visibility" - 'action #'cider-stacktrace--toggle-visibility) - (insert (substring name end-link))) - (insert (propertize name 'face '((:weight bold))))) - (let ((pos (point))) - (when str - (cider-stacktrace-emit-indented (concat str "\n") nil nil t) - (when id - (remove-from-invisibility-spec (cons id t)) - (let ((hide-beg (save-excursion (goto-char pos) (point-at-eol))) - (hide-end (1- (point-at-bol)))) - (overlay-put (make-overlay hide-beg hide-end) 'invisible id))))))) - -(defun cider-stacktrace--emit-spec-problems (spec-data indent) - "Emit SPEC-DATA indented with INDENT." - (nrepl-dbind-response spec-data (spec value problems) - (insert "\n") - (cider-stacktrace--insert-named-group indent " Spec: " spec) - (cider-stacktrace--insert-named-group indent " Value: " value) - (insert "\n") - (cider-stacktrace--insert-named-group indent "Problems: \n") - (let ((indent2 (concat indent " "))) - (dolist (prob problems) - (nrepl-dbind-response prob (in val predicate reason spec at extra) - (insert "\n") - (when (not (string= val value)) - (cider-stacktrace--insert-named-group indent2 " val: " val)) - (when in - (cider-stacktrace--insert-named-group indent2 " in: " in)) - (cider-stacktrace--insert-named-group indent2 "failed: " predicate) - (when spec - (cider-stacktrace--insert-named-group indent2 " spec: " spec)) - (when at - (cider-stacktrace--insert-named-group indent2 " at: " at)) - (when reason - (cider-stacktrace--insert-named-group indent2 "reason: " reason)) - (when extra - (cider-stacktrace--insert-named-group indent2 "extras: \n") - (cider-stacktrace-emit-indented extra (concat indent2 " ") nil t))))))) - -(defun cider-stacktrace-render-cause (buffer cause num note) - "Emit into BUFFER the CAUSE NUM, exception class, message, data, and NOTE." - (with-current-buffer buffer - (nrepl-dbind-response cause (class message data spec 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 spec - (cider-stacktrace--emit-spec-problems spec (concat indent " "))) - (when data - (cider-stacktrace-emit-indented data indent nil t))) - ;; 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 - `(("Project-Only" project) ("All" all)) - `(("Clojure" clj) ("Java" java) ("REPL" repl) - ("Tooling" tooling) ("Duplicates" dup))) - (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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-stacktrace.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-stacktrace.elc deleted file mode 100644 index 21e88b2cf1f2..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-stacktrace.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-test.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-test.el deleted file mode 100644 index bce6b4c066b2..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-test.el +++ /dev/null @@ -1,825 +0,0 @@ -;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors - -;; Author: Jeff Valk <jv@jeffvalk.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This 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 'subr-x) -(require 'cider-compat) -(require 'cider-overlays) - -(require 'button) -(require 'cl-lib) -(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")) - -(defcustom cider-test-defining-forms '("deftest" "defspec") - "Forms that define individual tests. -CIDER considers the \"top-level\" form around point to define a test if -the form starts with one of these forms. -Add to this list to have CIDER recognize additional test defining macros." - :type '(repeat string) - :group 'cider-test - :package-version '(cider . "0.15.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.") - -;;; 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))) - - -(defadvice disable-theme (after cider-test-adapt-to-theme activate) - "When theme is disabled, update `cider-test-items-background-color'." - (setq cider-test-items-background-color (cider-scale-background-color))) - - -;;; Report mode & key bindings -;; -;; The primary mode of interacting with test results is the report buffer, which -;; allows navigation among tests, jumping to test definitions, expected/actual -;; diff-ing, and cause/stacktrace inspection for test errors. - -(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-failed-tests) - (define-key map (kbd "C-t") #'cider-test-run-test) - (define-key map (kbd "C-g") #'cider-test-rerun-test) - (define-key map (kbd "C-n") #'cider-test-run-ns-tests) - (define-key map (kbd "C-s") #'cider-test-run-ns-tests-with-filters) - (define-key map (kbd "C-l") #'cider-test-run-loaded-tests) - (define-key map (kbd "C-p") #'cider-test-run-project-tests) - (define-key map (kbd "C-b") #'cider-test-show-report) - ;; Single-key bindings defined last for display in menu - (define-key map (kbd "r") #'cider-test-rerun-failed-tests) - (define-key map (kbd "t") #'cider-test-run-test) - (define-key map (kbd "g") #'cider-test-rerun-test) - (define-key map (kbd "n") #'cider-test-run-ns-tests) - (define-key map (kbd "s") #'cider-test-run-ns-tests-with-filters) - (define-key map (kbd "l") #'cider-test-run-loaded-tests) - (define-key map (kbd "p") #'cider-test-run-project-tests) - (define-key map (kbd "b") #'cider-test-show-report) - map)) - -(defconst cider-test-menu - '("Test" - ["Run test" cider-test-run-test] - ["Run namespace tests" cider-test-run-ns-tests] - ["Run namespace tests with filters" cider-test-run-ns-tests-with-filters] - ["Run all loaded tests" cider-test-run-loaded-tests] - ["Run all loaded tests with filters" (apply-partially cider-test-run-loaded-tests 'prompt-for-filters)] - ["Run all project tests" cider-test-run-project-tests] - ["Run all project tests with filters" (apply-partially cider-test-run-project-tests 'prompt-for-filters)] - ["Run tests after load-file" cider-auto-test-mode - :style toggle :selected cider-auto-test-mode] - "--" - ["Interrupt running tests" cider-interrupt] - ["Rerun failed/erring tests" cider-test-rerun-failed-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 "<backtab>") #'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-failed-tests) - (define-key map "n" #'cider-test-run-ns-tests) - (define-key map "s" #'cider-test-run-ns-tests-with-filters) - (define-key map "l" #'cider-test-run-loaded-tests) - (define-key map "p" #'cider-test-run-project-tests) - ;; `g' generally reloads the buffer. The closest thing we have to that is - ;; "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-failed-tests] - ["Run all ns tests" cider-test-run-ns-tests] - ["Run all ns tests with filters" cider-test-run-ns-tests-with-filters] - ["Run all loaded tests" cider-test-run-loaded-tests] - ["Run all loaded tests with filters" (apply-partially cider-test-run-loaded-tests 'prompt-for-filters)] - ["Run all project tests" cider-test-run-project-tests] - ["Run all project tests with filters" (apply-partially cider-test-run-project-tests 'prompt-for-filters)] - "--" - ["Jump to test definition" cider-test-jump] - ["Display test error" cider-test-stacktrace] - ["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) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local sesman-system 'CIDER) - (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)))))) - -(declare-function cider-find-var "cider-find") - -(defun cider-test-jump (&optional arg) - "Find definition for test at point, if available. -The prefix ARG and `cider-prompt-for-symbol' decide whether to -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 - (nconc `("op" "test-stacktrace" - "ns" ,ns - "var" ,var - "index" ,index) - (when (cider--pprint-fn) - `("pprint-fn" ,(cider--pprint-fn))) - (when cider-stacktrace-print-length - `("print-length" ,cider-stacktrace-print-length)) - (when cider-stacktrace-print-level - `("print-level" ,cider-stacktrace-print-level))) - (lambda (response) - (nrepl-dbind-response response (class status) - (cond (class (setq causes (cons response causes))) - (status (when causes - (cider-stacktrace-render - (cider-popup-buffer cider-error-buffer - cider-auto-select-error-buffer - #'cider-stacktrace-mode - 'ancillary) - (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--extract-from-actual (actual n) - "Extract form N from ACTUAL, ignoring outermost not. - -ACTUAL is a string like \"(not (= 3 4))\", of the sort returned by -clojure.test. - -N = 1 => 3, N = 2 => 4, etc." - (with-temp-buffer - (insert actual) - (clojure-mode) - (goto-char (point-min)) - (re-search-forward "(" nil t 2) - (clojure-forward-logical-sexp n) - (forward-whitespace 1) - (let ((beg (point))) - (clojure-forward-logical-sexp) - (buffer-substring beg (point))))) - -(defun cider-test-ediff () - "Show diff of the expected vs actual value for the test at point. -With the actual value, the outermost '(not ...)' s-expression is removed." - (interactive) - (let* ((expected-buffer (generate-new-buffer " *expected*")) - (actual-buffer (generate-new-buffer " *actual*")) - (diffs (get-text-property (point) 'diffs)) - (actual* (get-text-property (point) 'actual)) - (expected (cond (diffs (get-text-property (point) 'expected)) - (actual* (cider-test--extract-from-actual actual* 1)))) - (actual (cond (diffs (caar diffs)) - (actual* (cider-test--extract-from-actual actual* 2))))) - (if (not (and expected actual)) - (message "No test failure at point") - (with-current-buffer expected-buffer - (insert expected) - (clojure-mode)) - (with-current-buffer actual-buffer - (insert actual) - (clojure-mode)) - (apply #'ediff-buffers - (setq cider-test-ediff-buffers - (list (buffer-name expected-buffer) - (buffer-name actual-buffer))))))) - -(defun cider-test-ediff-cleanup () - "Cleanup expected/actual buffers used for diff." - (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 diffs error gen-input) - (cl-flet ((insert-label (s) - (cider-insert (format "%8s: " s) 'font-lock-comment-face)) - (insert-align-label (s) - (insert (format "%12s" s))) - (insert-rect (s) - (insert-rectangle (thread-first s - cider-font-lock-as-clojure - (split-string "\n"))) - (beginning-of-line))) - (cider-propertize-region (cider-intern-keys (cdr test)) - (let ((beg (point)) - (type-face (cider-test-type-simple-face type)) - (bg `(:background ,cider-test-items-background-color))) - (cider-insert (capitalize type) type-face nil " in ") - (cider-insert var 'font-lock-function-name-face t) - (when context (cider-insert context 'font-lock-doc-face t)) - (when message (cider-insert message 'font-lock-doc-string-face t)) - (when expected - (insert-label "expected") - (insert-rect expected) - (insert "\n")) - (if diffs - (dolist (d diffs) - (cl-destructuring-bind (actual (removed added)) d - (insert-label "actual") - (insert-rect actual) - (insert-label "diff") - (insert "- ") - (insert-rect removed) - (insert-align-label "+ ") - (insert-rect added) - (insert "\n"))) - (when actual - (insert-label "actual") - (insert-rect actual))) - (when error - (insert-label "error") - (insert-text-button error - 'follow-link t - 'action '(lambda (_button) (cider-test-stacktrace)) - 'help-echo "View causes and stacktrace") - (insert "\n")) - (when gen-input - (insert-label "input") - (insert (cider-font-lock-as-clojure gen-input))) - (overlay-put (make-overlay beg (point)) 'font-lock-face bg)) - (insert "\n")))))) - -(defun cider-test-non-passing (tests) - "For a list of TESTS, each an `nrepl-dict`, return only those that did not pass." - (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 - ;; we don't need the file name here, as we always operate on the current - ;; buffer and the line data is correct even for vars that were - ;; defined interactively - (nrepl-dbind-response test (type line message expected actual) - (when line - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (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")) - (if (string-suffix-p suffix ns) - ns - (concat ns suffix))))) - - -;;; Test execution - -(declare-function cider-emit-interactive-eval-output "cider-eval") -(declare-function cider-emit-interactive-eval-err-output "cider-eval") - -(defun cider-test--prompt-for-selectors (message) - "Prompt for test selectors with MESSAGE. -The selectors can be either keywords or strings." - (mapcar - (lambda (string) (replace-regexp-in-string "^:+" "" string)) - (split-string - (cider-read-from-minibuffer message)))) - -(defun cider-test-execute (ns &optional tests silent prompt-for-filters) - "Run tests for NS, which may be a keyword, optionally specifying TESTS. -This tests a single NS, or multiple namespaces when using keywords `:project', -`:loaded' or `:non-passing'. Optional TESTS are only honored when a single -namespace is specified. Upon test completion, results are echoed and a test -report is optionally displayed. When test failures/errors occur, their sources -are highlighted. -If SILENT is non-nil, suppress all messages other then test results. -If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selector filters. -The include/exclude selectors will be used to filter the tests before - running them." - (cider-test-clear-highlights) - (let ((include-selectors - (when prompt-for-filters - (cider-test--prompt-for-selectors "Test selectors to include (space separated): "))) - (exclude-selectors - (when prompt-for-filters - (cider-test--prompt-for-selectors "Test selectors to exclude (space separated): ")))) - (cider-map-repls :clj-strict - (lambda (conn) - (unless silent - (if (and tests (= (length tests) 1)) - ;; we generate a different message when running individual tests - (cider-test-echo-running ns (car tests)) - (cider-test-echo-running ns))) - (let ((request `("op" ,(cond ((stringp ns) "test") - ((eq :project ns) "test-all") - ((eq :loaded ns) "test-all") - ((eq :non-passing ns) "retest"))))) - ;; we add optional parts of the request only when relevant - (when (and (listp include-selectors) include-selectors) - (setq request (append request `("include" ,include-selectors)))) - (when (and (listp exclude-selectors) exclude-selectors) - (setq request (append request `("exclude" ,exclude-selectors)))) - (when (stringp ns) - (setq request (append request `("ns" ,ns)))) - (when (stringp ns) - (setq request (append request `("tests" ,tests)))) - (when (or (stringp ns) (eq :project ns)) - (setq request (append request `("load?" ,"true")))) - (cider-nrepl-send-request - request - (lambda (response) - (nrepl-dbind-response response (summary results status out err) - (cond ((member "namespace-not-found" status) - (unless silent - (message "No test namespace: %s" (cider-propertize ns 'ns)))) - (out (cider-emit-interactive-eval-output out)) - (err (cider-emit-interactive-eval-err-output err)) - (results - (nrepl-dbind-response summary (error fail) - (setq cider-test-last-summary summary) - (setq cider-test-last-results results) - (cider-test-highlight-problems results) - (cider-test-echo-summary summary results) - (if (or (not (zerop (+ error fail))) - cider-test-show-report-on-success) - (cider-test-render-report - (cider-popup-buffer - cider-test-report-buffer - cider-auto-select-test-report-buffer) - summary - results) - (when (get-buffer cider-test-report-buffer) - (with-current-buffer cider-test-report-buffer - (let ((inhibit-read-only t)) - (erase-buffer))) - (cider-test-render-report - cider-test-report-buffer - summary results)))))))) - conn)))))) - -(defun cider-test-rerun-failed-tests () - "Rerun failed and erring tests from the last test run." - (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 (prompt-for-filters) - "Run all tests defined in currently loaded namespaces. - -If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selectors to filter the tests with." - (interactive "P") - (cider-test-execute :loaded nil nil prompt-for-filters)) - -(defun cider-test-run-project-tests (prompt-for-filters) - "Run all tests defined in all project namespaces, loading these as needed. - -If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selectors to filter the tests with." - (interactive "P") - (cider-test-execute :project nil nil prompt-for-filters)) - -(defun cider-test-run-ns-tests-with-filters (suppress-inference) - "Run tests filtered by selectors for the current Clojure namespace context. - -With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the -current ns." - (interactive "P") - (cider-test-run-ns-tests suppress-inference nil 't)) - -(defun cider-test-run-ns-tests (suppress-inference &optional silent prompt-for-filters) - "Run all tests for the current Clojure namespace context. - -If SILENT is non-nil, suppress all messages other then test results. -With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the -current ns. If PROMPT-FOR-FILTERS is non-nil, prompt the user for -test selectors to filter the tests with." - (interactive "P") - (if-let* ((ns (if suppress-inference - (cider-current-ns t) - (funcall cider-test-infer-test-ns (cider-current-ns t))))) - (cider-test-execute ns nil silent prompt-for-filters) - (if (eq major-mode 'cider-test-report-mode) - (when (y-or-n-p (concat "Test report does not define a namespace. " - "Rerun failed/erring tests?")) - (cider-test-rerun-failed-tests)) - (unless silent - (message "No namespace to test in current context"))))) - -(defvar cider-test-last-test-ns nil - "The ns of the last test ran with `cider-test-run-test'.") -(defvar cider-test-last-test-var nil - "The var of the last test ran with `cider-test-run-test'.") - -(defun cider-test-update-last-test (ns var) - "Update the last test by setting NS and VAR. - -See `cider-test-rerun-test'." - (setq cider-test-last-test-ns ns - cider-test-last-test-var var)) - -(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) - ;; we're in a `cider-test-report-mode' buffer - ;; or on a highlighted failed/erred test definition - (progn - (cider-test-update-last-test ns var) - (cider-test-execute ns (list var))) - ;; we're in a `clojure-mode' buffer - (let* ((ns (clojure-find-ns)) - (def (clojure-find-def)) ; it's a list of the form (deftest something) - (deftype (car def)) - (var (cadr def))) - (if (and ns (member deftype cider-test-defining-forms)) - (progn - (cider-test-update-last-test ns (list var)) - (cider-test-execute ns (list var))) - (message "No test at point")))))) - -(defun cider-test-rerun-test () - "Re-run the test that was previously ran." - (interactive) - (if (and cider-test-last-test-ns cider-test-last-test-var) - (cider-test-execute cider-test-last-test-ns cider-test-last-test-var) - (user-error "No test to re-run"))) - -;;; 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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-test.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-test.elc deleted file mode 100644 index 3d1d7b0c2a1c..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-test.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-tracing.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-tracing.el deleted file mode 100644 index c00e7b7f9877..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-tracing.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A couple of commands for tracing the execution of functions. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) ; for `cider-prompt-for-symbol-function' -(require 'cider-util) ; for `cider-propertize' -(require 'cider-connection) ; for `cider-map-repls' -(require 'nrepl-dict) - -(defun cider-sync-request:toggle-trace-var (symbol) - "Toggle var tracing for SYMBOL." - (thread-first `("op" "toggle-trace-var" - "ns" ,(cider-current-ns) - "sym" ,symbol) - (cider-nrepl-send-sync-request))) - -(defun cider--toggle-trace-var (sym) - "Toggle var tracing for SYM." - (let* ((trace-response (cider-sync-request:toggle-trace-var sym)) - (var-name (nrepl-dict-get trace-response "var-name")) - (var-status (nrepl-dict-get trace-response "var-status"))) - (pcase var-status - ("not-found" (error "Var %s not found" (cider-propertize sym 'fn))) - ("not-traceable" (error "Var %s can't be traced because it's not bound to a function" (cider-propertize var-name 'fn))) - (_ (message "Var %s %s" (cider-propertize var-name 'fn) var-status))))) - -;;;###autoload -(defun cider-toggle-trace-var (arg) - "Toggle var tracing. -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates." - (interactive "P") - (cider-ensure-op-supported "toggle-trace-var") - (funcall (cider-prompt-for-symbol-function arg) - "Toggle trace for var" - #'cider--toggle-trace-var)) - -(defun cider-sync-request:toggle-trace-ns (ns) - "Toggle namespace tracing for NS." - (thread-first `("op" "toggle-trace-ns" - "ns" ,ns) - (cider-nrepl-send-sync-request))) - -;;;###autoload -(defun cider-toggle-trace-ns (query) - "Toggle ns tracing. -Defaults to the current ns. With prefix arg QUERY, prompts for a ns." - (interactive "P") - (cider-map-repls :clj-strict - (lambda (conn) - (with-current-buffer conn - (cider-ensure-op-supported "toggle-trace-ns") - (let ((ns (if query - (completing-read "Toggle trace for ns: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (let* ((trace-response (cider-sync-request:toggle-trace-ns ns)) - (ns-status (nrepl-dict-get trace-response "ns-status"))) - (pcase ns-status - ("not-found" (error "Namespace %s not found" (cider-propertize ns 'ns))) - (_ (message "Namespace %s %s" (cider-propertize ns 'ns) ns-status))))))))) - -(provide 'cider-tracing) -;;; cider-tracing.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-tracing.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-tracing.elc deleted file mode 100644 index 0a351a37326f..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-tracing.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-util.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-util.el deleted file mode 100644 index 6737b97eec4f..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-util.el +++ /dev/null @@ -1,791 +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-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Common utility functions that don't belong anywhere else. - -;;; Code: - -;; Built-ins -(require 'ansi-color) -(require 'color) -(require 'seq) -(require 'subr-x) -(require 'thingatpt) - -;; clojure-mode and CIDER -(require 'cider-compat) -(require 'clojure-mode) -(require 'nrepl-dict) - -(defalias 'cider-pop-back 'pop-tag-mark) - -(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 non-nil if point is in a string." - (let ((beg (save-excursion (beginning-of-defun) (point)))) - (nth 3 (parse-partial-sexp beg (point))))) - -(defun cider-in-comment-p () - "Return non-nil 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-buffer-p (&optional buffer) - "Return non-nil if the current buffer is visiting a cljc file. - -If BUFFER is provided act on that buffer instead." - (with-current-buffer (or buffer (current-buffer)) - (or (derived-mode-p 'clojurec-mode)))) - - -;;; Thing at point - -(defun cider--text-or-limits (bounds start end) - "Returns the substring or the bounds of text. -If BOUNDS is non-nil, returns the list (START END) of character -positions. Else returns the substring from START to END." - (funcall (if bounds #'list #'buffer-substring-no-properties) - start end)) - -(defun cider-defun-at-point (&optional bounds) - "Return the text of the top level sexp at point. -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) - (cider--text-or-limits bounds (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)))) - -(defun cider-second-sexp-in-list () - "Return the second sexp in the list at point." - (condition-case nil - (save-excursion - (backward-up-list) - (forward-char) - (forward-sexp 2) - (cider-sexp-at-point)) - (error nil))) - -;;; Text properties - -(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) - (debug (sexp body))) - (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"))) - - -;;; Hooks - -(defun cider-run-chained-hook (hook arg) - "Like `run-hook-with-args' but pass intermediate return values through. -HOOK is a name of a hook (a symbol). You can use `add-hook' or -`remove-hook' to add functions to this variable. ARG is passed to first -function. Its return value is passed to the second function and so forth -till all functions are called or one of them returns nil. Return the value -return by the last called function." - (let ((functions (copy-sequence (symbol-value hook)))) - (while (and functions arg) - (if (eq (car functions) t) - ;; global value of the hook - (let ((functions (default-value hook))) - (while (and functions arg) - (setq arg (funcall (car functions) arg)) - (setq functions (cdr functions)))) - (setq arg (funcall (car functions) arg))) - (setq functions (cdr functions))) - arg)) - - -;;; Font lock - -(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-ansi-color-string-p (string) - "Return non-nil if STRING is an ANSI string." - (string-match "^\\[" string)) - -(defun cider-font-lock-as (mode string) - "Use MODE to font-lock the STRING." - (let ((string (if (cider-ansi-color-string-p string) - (substring-no-properties (ansi-color-apply string)) - string))) - (if (or (null cider-font-lock-max-length) - (< (length string) cider-font-lock-max-length)) - (with-current-buffer (cider--make-buffer-for-mode mode) - (erase-buffer) - (insert string) - (font-lock-fontify-region (point-min) (point-max)) - (buffer-string)) - string))) - -(defun cider-font-lock-region-as (mode beg end &optional buffer) - "Use MODE to font-lock text between BEG and END. - -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) - -(defun cider-add-face (regexp face &optional foreground-only sub-expr object) - "Propertize all occurrences of REGEXP with FACE. -If FOREGROUND-ONLY is non-nil, change only the foreground of matched -regions. SUB-EXPR is a sub-expression of REGEXP to be -propertized (defaults to 0). OBJECT is an object to be -propertized (defaults to current buffer)." - (setq sub-expr (or sub-expr 0)) - (when (and regexp face) - (let ((beg 0) - (end 0)) - (with-current-buffer (or (and (bufferp object) object) - (current-buffer)) - (while (if (stringp object) - (string-match regexp object end) - (re-search-forward regexp nil t)) - (setq beg (match-beginning sub-expr) - end (match-end sub-expr)) - (if foreground-only - (let ((face-spec (list (cons 'foreground-color - (face-attribute face :foreground nil t))))) - (font-lock-prepend-text-property beg end 'face face-spec object)) - (put-text-property beg end 'face face object))))))) - - -;;; Colors - -(defun cider-scale-background-color () - "Scale the current background color to get a slighted muted version." - (let ((color (frame-parameter nil 'background-color)) - (darkp (eq (frame-parameter nil 'background-mode) 'dark))) - (unless (equal "unspecified-bg" color) - (color-lighten-name color (if darkp 5 -5))))) - -(autoload 'pkg-info-version-info "pkg-info.el") - -(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-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 (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://docs.cider.mx/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") - -;; Taken from: https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L551-L565 -(defun cider--make-back-forward-xrefs (&optional buffer) - "Insert special references `back' and `forward', as in `help-make-xrefs'. - -Optional argument BUFFER is the buffer in which to insert references. -Default is current buffer." - (with-current-buffer (or buffer (current-buffer)) - (insert "\n") - (when (or help-xref-stack help-xref-forward-stack) - (insert "\n")) - ;; Make a back-reference in this buffer if appropriate. - (when help-xref-stack - (help-insert-xref-button help-back-label 'help-back - (current-buffer))) - ;; Make a forward-reference in this buffer if appropriate. - (when help-xref-forward-stack - (when help-xref-stack - (insert "\t")) - (help-insert-xref-button help-forward-label 'help-forward - (current-buffer))) - (when (or help-xref-stack help-xref-forward-stack) - (insert "\n")))) - -;; Similar to https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L404 -(defun cider--doc-make-xrefs () - "Parse and hyperlink documentation cross-references in current buffer. -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)))))) - (cider--make-back-forward-xrefs)) - - -;;; 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" - "A designer knows he has achieved perfection not when there is nothing left to add, but when there is nothing left to take away. -Antoine de Saint-Exupery" - "Clojure isn't a language, it's a building material." - "Think big!" - "Think bold!" - "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." - "The worst day programming is better than the best day working." - "The only thing worse than a rebel without a cause is a REPL without a clause." - "In the absence of parentheses, chaos prevails." - "One REPL to rule them all, One REPL to find them, One REPL to bring them all, and in parentheses bind them!" - ,(format "%s, I've a feeling we're not in Kansas anymore." - (cider-user-first-name)) - ,(format "%s, this could be the start of a beautiful program." - (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-doc]> to view the documentation for something (e.g. a var, a Java method)." - "Press <\\[cider-find-resource]> to find a resource on the classpath." - "Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a Java method)." - "Press <\\[cider-selector]> to quickly select a CIDER buffer." - "Press <\\[cider-test-run-ns-tests]> to run the tests for the current namespace." - "Press <\\[cider-test-run-loaded-tests]> to run all loaded tests." - "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-defun-up-to-point]> to eval the top-level form up to the point." - "Press <\\[cider-eval-sexp-up-to-point]> to eval the current form up to the point." - "Press <\\[cider-eval-sexp-at-point]> to eval the current form around the point." - "Press <\\[cider-eval-sexp-at-point-in-context]> to eval the current form around the point in a user-provided context." - "Press <\\[cider-eval-buffer]> to eval the entire source buffer." - "Press <\\[cider-scratch]> to create a Clojure scratchpad. Pretty handy for prototyping." - "Press <\\[cider-read-and-eval]> to evaluate some Clojure expression directly in the minibuffer." - "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-repl-history]> to start CIDER's REPL input history browser." - "Press <\\[cider-macroexpand-1]> to expand the preceding macro." - "Press <\\[cider-inspect]> to inspect the preceding expression's result." - "Press <C-u \\[cider-inspect]> to inspect the defun at point's result." - "Press <C-u C-u \\[cider-inspect]> to read Clojure code from the minibuffer and inspect its result." - "Press <\\[cider-ns-refresh]> to reload modified and unloaded namespaces." - "You can define Clojure functions to be called before and after `cider-ns-refresh' (see `cider-ns-refresh-before-fn' and `cider-ns-refresh-after-fn'." - "Press <\\[cider-describe-connection]> to view information about the connection." - "Press <\\[cider-undef]> to undefine a symbol in the current namespace." - "Press <\\[cider-interrupt]> to interrupt an ongoing evaluation." - "Use <M-x customize-group RET cider RET> to see every possible setting you can customize." - "Use <M-x customize-group RET cider-repl RET> 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." - "For no middleware, low-tech and reliable namespace reloading use <\\[cider-ns-reload]>." - "Press <\\[cider-load-buffer-and-switch-to-repl-buffer]> to load the current buffer and switch to the REPL buffer afterwards.") - "Some handy CIDER tips." - ) - -(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) - ;; we have to adjust the column number by 1 to account for the fact - ;; that Emacs starts counting columns from 0 and Clojure from 1 - (1+ (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)) - -(defcustom cider-jdk-src-paths '("/usr/lib/jvm/openjdk-8/src.zip") - "Used by `cider-stacktrace-navigate'. -Zip/jar files work, but it's better to extract them and put the directory -paths here. Clojure sources here: -https://repo1.maven.org/maven2/org/clojure/clojure/1.8.0/." - :group 'cider - :package-version '(cider . "0.17.0") - :type '(list string)) - -(defun cider-resolve-java-class (class) - "Return a path to a Java source file that corresponds to CLASS. - -This will be a zip/jar path for archived sources and a normal -file path otherwise." - (when class - (let ((file-name (concat (replace-regexp-in-string "\\." "/" class) ".java"))) - (cl-find-if - 'file-exists-p - (mapcar - (lambda (d) - (cond ((file-directory-p d) - (expand-file-name file-name d)) - ((and (file-exists-p d) - (member (file-name-extension d) '("jar" "zip"))) - (format "zip:file:%s!/%s" d file-name)) - (t (error "Unexpected archive: %s" d)))) - cider-jdk-src-paths))))) - -(provide 'cider-util) - -;;; cider-util.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-util.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-util.elc deleted file mode 100644 index 7b078e906ea6..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-util.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider.el deleted file mode 100644 index ed11fff95abf..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider.el +++ /dev/null @@ -1,1447 +0,0 @@ -;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; Maintainer: Bozhidar Batsov <bozhidar@batsov.com> -;; URL: http://www.github.com/clojure-emacs/cider -;; Version: 0.18.1-snapshot -;; Package-Requires: ((emacs "25") (clojure-mode "5.9") (pkg-info "0.4") (queue "0.2") (spinner "1.7") (seq "2.16") (sesman "0.3")) -;; 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 <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides a Clojure interactive development environment for Emacs, built on -;; top of nREPL. - -;;; Installation: - -;; Available as a package in melpa.org and stable.melpa.org - -;; (add-to-list 'package-archives -;; '("melpa" . "https://melpa.org/packages/")) -;; -;; or -;; -;; (add-to-list 'package-archives -;; '("melpa-stable" . "https://stable.melpa.org/packages/") t) -;; -;; M-x package-install cider - -;;; Usage: - -;; M-x cider-jack-in-clj -;; M-x cider-jack-in-cljs -;; -;; M-x cider-connect-sibling-clj -;; M-x cider-connect-sibling-cljs -;; -;; M-x cider-connect-clj -;; M-x cider-connect-cljs - -;;; Code: - -(defgroup cider nil - "Clojure Interactive Development Environment that Rocks." - :prefix "cider-" - :group 'applications - :link '(url-link :tag "GitHub" "https://github.com/clojure-emacs/cider") - :link '(url-link :tag "Online Manual" "http://docs.cider.mx") - :link '(emacs-commentary-link :tag "Commentary" "cider")) - -(require 'cider-client) -(require 'cider-eldoc) -(require 'cider-repl) -(require 'cider-repl-history) -(require 'cider-connection) -(require 'cider-mode) -(require 'cider-common) -(require 'cider-compat) -(require 'cider-debug) -(require 'cider-util) - -(require 'tramp-sh) -(require 'subr-x) -(require 'seq) -(require 'sesman) - -(defconst cider-version "0.18.1-snapshot" - "Fallback version used when it cannot be extracted automatically. -Normally it won't be used, unless `pkg-info' fails to extract the -version from the CIDER package or library.") - -(defconst cider-codename "Saigon" - "Codename used to denote stable releases.") - -(defcustom cider-lein-command - "lein" - "The command used to execute Leiningen." - :type 'string - :group 'cider) - -(defcustom cider-lein-global-options - nil - "Command global options used to execute Leiningen (e.g.: -o for offline)." - :type 'string - :group 'cider - :safe #'stringp) - -(defcustom cider-lein-parameters - "repl :headless :host ::" - "Params passed to Leiningen to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :safe #'stringp) - -(defcustom cider-boot-command - "boot" - "The command used to execute Boot." - :type 'string - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-boot-global-options - nil - "Command global options used to execute Boot (e.g.: -c for checkouts)." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.14.0")) - -(defcustom cider-boot-parameters - "cider.tasks/nrepl-server -b :: wait" - "Params passed to boot to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.9.0")) - -(defcustom cider-clojure-cli-command - "clojure" - "The command used to execute clojure with tools.deps (requires Clojure 1.9+). -Don't use clj here, as it doesn't work when spawned from Emacs due to -it using rlwrap." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-clojure-cli-global-options - nil - "Command line options used to execute clojure with tools.deps." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-clojure-cli-parameters - "-e '(require (quote cider-nrepl.main)) (cider-nrepl.main/init %s)'" - "Params passed to clojure to start an nREPL server via `cider-jack-in'. -This is evaluated using `format', with the first argument being the Clojure -vector of middleware variables as a string." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-shadow-cljs-command - "npx shadow-cljs" - "The command used to execute shadow-cljs. - -By default we favor the project-specific shadow-cljs over the system-wide." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-shadow-cljs-global-options - "" - "Command line options used to execute shadow-cljs (e.g.: -v for verbose mode)." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-shadow-cljs-parameters - "server" - "Params passed to shadow-cljs to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-gradle-command - "gradle" - "The command used to execute Gradle." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.10.0")) - -(defcustom cider-gradle-global-options - "--no-daemon" - "Command line options used to execute Gradle (e.g.: -m for dry run)." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.14.0")) - -(defcustom cider-gradle-parameters - "clojureRepl" - "Params passed to gradle to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.10.0")) - -(define-obsolete-variable-alias 'cider-default-repl-command 'cider-jack-in-default) -(defcustom cider-jack-in-default (if (executable-find "clojure") 'clojure-cli 'lein) - "The default tool to use when doing `cider-jack-in' outside a project. -This value will only be consulted when no identifying file types, i.e. -project.clj for leiningen or build.boot for boot, could be found. - -As the Clojure CLI is bundled with Clojure itself, it's the default. -In the absence of the Clojure CLI (e.g. on Windows), we fallback -to Leiningen." - :type '(choice (const 'lein) - (const 'boot) - (const 'clojure-cli) - (const 'shadow-cljs) - (const 'gradle)) - :group 'cider - :safe #'symbolp - :package-version '(cider . "0.9.0")) - -(defcustom cider-preferred-build-tool - nil - "Allow choosing a build system when there are many. -When there are project markers from multiple build systems (e.g. lein and -boot) the user is prompted to select one of them. When non-nil, this -variable will suppress this behavior and will select whatever build system -is indicated by the variable if present. Note, this is only when CIDER -cannot decide which of many build systems to use and will never override a -command when there is no ambiguity." - :type '(choice (const 'lein) - (const 'boot) - (const 'clojure-cli) - (const 'shadow-cljs) - (const 'gradle) - (const :tag "Always ask" nil)) - :group 'cider - :safe #'symbolp - :package-version '(cider . "0.13.0")) - -(defcustom cider-allow-jack-in-without-project 'warn - "Controls what happens when doing `cider-jack-in' outside a project. -When set to 'warn you'd prompted to confirm the command. -When set to t `cider-jack-in' will quietly continue. -When set to nil `cider-jack-in' will fail." - :type '(choice (const :tag "always" t) - (const 'warn) - (const :tag "never" nil)) - :group 'cider - :safe #'stringp - :package-version '(cider . "0.15.0")) - -(defcustom cider-known-endpoints nil - "A list of connection endpoints where each endpoint is a list. -For example: \\='((\"label\" \"host\" \"port\")). -The label is optional so that \\='(\"host\" \"port\") will suffice. -This variable is used by `cider-connect'." - :type '(repeat (list (string :tag "label") - (string :tag "host") - (string :tag "port"))) - :group 'cider) - -(defcustom cider-connected-hook nil - "List of functions to call when connected to Clojure nREPL server." - :type 'hook - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-disconnected-hook nil - "List of functions to call when disconnected from the Clojure nREPL server." - :type 'hook - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-inject-dependencies-at-jack-in t - "When nil, do not inject repl dependencies (most likely nREPL middlewares) at `cider-jack-in' time." - :type 'boolean - :safe #'booleanp - :version '(cider . "0.11.0")) - -(defcustom cider-offer-to-open-cljs-app-in-browser t - "When nil, do not offer to open ClojureScript apps in a browser on connect." - :type 'boolean - :safe #'booleanp - :version '(cider . "0.15.0")) - -(defvar cider-ps-running-nrepls-command "ps u | grep leiningen" - "Process snapshot command used in `cider-locate-running-nrepl-ports'.") - -(defvar cider-ps-running-nrepl-path-regexp-list - '("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D" - "\\(?:-classpath +:?\\(.+?\\)/self-installs\\)") - "Regexp list to get project paths. -Extract project paths from output of `cider-ps-running-nrepls-command'. -Sub-match 1 must be the project path.") - -(defvar cider-host-history nil - "Completion history for connection hosts.") - -;;;###autoload -(defun cider-version () - "Display CIDER's version." - (interactive) - (message "CIDER %s" (cider--version))) - -(defun cider-jack-in-command (project-type) - "Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE." - (pcase project-type - ('lein cider-lein-command) - ('boot cider-boot-command) - ('clojure-cli cider-clojure-cli-command) - ('shadow-cljs cider-shadow-cljs-command) - ('gradle cider-gradle-command) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defun cider-jack-in-resolve-command (project-type) - "Determine the resolved file path to `cider-jack-in-command'. -Throws an error if PROJECT-TYPE is unknown." - (pcase project-type - ('lein (cider--resolve-command cider-lein-command)) - ('boot (cider--resolve-command cider-boot-command)) - ('clojure-cli (cider--resolve-command cider-clojure-cli-command)) - ;; here we have to account for the possibility that the command is either - ;; "npx shadow-cljs" or just "shadow-cljs" - ('shadow-cljs (let ((parts (split-string cider-shadow-cljs-command))) - (when-let* ((command (cider--resolve-command (car parts)))) - (mapconcat #'identity (cons command (cdr parts)) " ")))) - ('gradle (cider--resolve-command cider-gradle-command)) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defun cider-jack-in-global-options (project-type) - "Determine the command line options for `cider-jack-in' for the PROJECT-TYPE." - (pcase project-type - ('lein cider-lein-global-options) - ('boot cider-boot-global-options) - ('clojure-cli cider-clojure-cli-global-options) - ('shadow-cljs cider-shadow-cljs-global-options) - ('gradle cider-gradle-global-options) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defun cider-jack-in-params (project-type) - "Determine the commands params for `cider-jack-in' for the PROJECT-TYPE." - (pcase project-type - ('lein cider-lein-parameters) - ('boot cider-boot-parameters) - ('clojure-cli (format cider-clojure-cli-parameters - (concat - "[" - (mapconcat - (apply-partially #'format "\"%s\"") - (cider-jack-in-normalized-nrepl-middlewares) - ", ") - "]"))) - ('shadow-cljs cider-shadow-cljs-parameters) - ('gradle cider-gradle-parameters) - (_ (user-error "Unsupported project type `%S'" project-type)))) - - -;;; Jack-in dependencies injection -(defvar cider-jack-in-dependencies nil - "List of dependencies where elements are lists of artifact name and version.") -(put 'cider-jack-in-dependencies 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-dependencies - "org.clojure/tools.nrepl" "0.2.13") - -(defvar cider-jack-in-cljs-dependencies nil - "List of dependencies where elements are lists of artifact name and version. -Added to `cider-jack-in-dependencies' when doing `cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-dependencies 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-cljs-dependencies "cider/piggieback" "0.3.9") - -(defvar cider-jack-in-dependencies-exclusions nil - "List of exclusions for jack in dependencies. -Elements of the list are artifact name and list of exclusions to apply for the artifact.") -(put 'cider-jack-in-dependencies-exclusions 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-dependencies-exclusions - "org.clojure/tools.nrepl" '("org.clojure/clojure")) - -(defconst cider-clojure-artifact-id "org.clojure/clojure" - "Artifact identifier for Clojure.") - -(defconst cider-minimum-clojure-version "1.8.0" - "Minimum supported version of Clojure.") - -(defconst cider-latest-clojure-version "1.10.0" - "Latest supported version of Clojure.") - -(defconst cider-required-middleware-version "0.18.0" - "The minimum CIDER nREPL version that's known to work properly with CIDER.") - -(defconst cider-latest-middleware-version "0.18.0" - "The latest CIDER nREPL version that's known to work properly with CIDER.") - -(defcustom cider-jack-in-auto-inject-clojure nil - "Version of clojure to auto-inject into REPL. -If nil, do not inject Clojure into the REPL. If `latest', inject -`cider-latest-clojure-version', which should approximate to the most recent -version of Clojure. If `minimal', inject `cider-minimum-clojure-version', -which will be the lowest version CIDER supports. If a string, use this as -the version number. If it is a list, the first element should be a string, -specifying the artifact ID, and the second element the version number." - :type '(choice (const :tag "None" nil) - (const :tag "Latest" 'latest) - (const :tag "Minimal" 'minimal) - (string :tag "Specific Version") - (list :tag "Artifact ID and Version" - (string :tag "Artifact ID") - (string :tag "Version")))) - -(defvar cider-jack-in-lein-plugins nil - "List of Leiningen plugins to be injected at jack-in. -Each element is a list of artifact name and version, followed optionally by -keyword arguments. The only keyword argument currently accepted is -`:predicate', which should be given a function that takes the list (name, -version, and keyword arguments) and returns non-nil to indicate that the -plugin should actually be injected. (This is useful primarily for packages -that extend CIDER, not for users. For example, a refactoring package might -want to inject some middleware only when within a project context.)") -(put 'cider-jack-in-lein-plugins 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-lein-plugins - "cider/cider-nrepl" cider-latest-middleware-version) - -(defvar cider-jack-in-cljs-lein-plugins nil - "List of Leiningen plugins to be injected at jack-in. -Added to `cider-jack-in-lein-plugins' (which see) when doing -`cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-lein-plugins 'risky-local-variable t) - -(defun cider-jack-in-normalized-lein-plugins () - "Return a normalized list of Leiningen plugins to be injected. -See `cider-jack-in-lein-plugins' for the format, except that the list -returned by this function does not include keyword arguments." - (thread-last cider-jack-in-lein-plugins - (seq-filter - (lambda (spec) - (if-let* ((pred (plist-get (seq-drop spec 2) :predicate))) - (funcall pred spec) - t))) - (mapcar - (lambda (spec) - (seq-take spec 2))))) - -(defvar cider-jack-in-nrepl-middlewares nil - "List of Clojure variable names. -Each of these Clojure variables should hold a vector of nREPL middlewares. -Instead of a string, an element can be a list containing a string followed -by optional keyword arguments. The only keyword argument currently -accepted is `:predicate', which should be given a function that takes the -list (string and keyword arguments) and returns non-nil to indicate that -the middlewares should actually be injected.") -(put 'cider-jack-in-nrepl-middlewares 'risky-local-variable t) -(add-to-list 'cider-jack-in-nrepl-middlewares "cider.nrepl/cider-middleware") - -(defvar cider-jack-in-cljs-nrepl-middlewares nil - "List of Clojure variable names. -Added to `cider-jack-in-nrepl-middlewares' (which see) when doing -`cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-nrepl-middlewares 'risky-local-variable t) -(add-to-list 'cider-jack-in-cljs-nrepl-middlewares "cider.piggieback/wrap-cljs-repl") - -(defun cider-jack-in-normalized-nrepl-middlewares () - "Return a normalized list of middleware variable names. -See `cider-jack-in-nrepl-middlewares' for the format, except that the list -returned by this function only contains strings." - (thread-last cider-jack-in-nrepl-middlewares - (seq-filter - (lambda (spec) - (or (not (listp spec)) - (if-let* ((pred (plist-get (cdr spec) :predicate))) - (funcall pred spec) - t)))) - (mapcar - (lambda (spec) - (if (listp spec) - (car spec) - spec))))) - -(defun cider--list-as-boot-artifact (list) - "Return a boot artifact string described by the elements of LIST. -LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). The returned -string is quoted for passing as argument to an inferior shell." - (concat "-d " (shell-quote-argument (format "%s:%s" (car list) (cadr list))))) - -(defun cider-boot-dependencies (dependencies) - "Return a list of boot artifact strings created from DEPENDENCIES." - (concat (mapconcat #'cider--list-as-boot-artifact dependencies " ") - (unless (seq-empty-p dependencies) " "))) - -(defun cider-boot-middleware-task (params middlewares) - "Create a command to add MIDDLEWARES with corresponding PARAMS." - (concat "cider.tasks/add-middleware " - (mapconcat (lambda (middleware) - (format "-m %s" (shell-quote-argument middleware))) - middlewares - " ") - " " params)) - -(defun cider-boot-jack-in-dependencies (global-opts params dependencies plugins middlewares) - "Create boot jack-in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, -PLUGINS and MIDDLEWARES. PARAMS and MIDDLEWARES are passed on to -`cider-boot-middleware-task` before concatenating and DEPENDENCIES and PLUGINS - are passed on to `cider-boot-dependencies`." - (concat global-opts - (unless (seq-empty-p global-opts) " ") - "-i \"(require 'cider.tasks)\" " ;; Note the space at the end here - (cider-boot-dependencies (append dependencies plugins)) - (cider-boot-middleware-task params middlewares))) - -(defun cider--lein-artifact-exclusions (exclusions) - "Return an exclusions vector described by the elements of EXCLUSIONS." - (if exclusions - (format " :exclusions [%s]" (mapconcat #'identity exclusions " ")) - "")) - -(defun cider--list-as-lein-artifact (list &optional exclusions) - "Return an artifact string described by the elements of LIST. -LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). Optionally a list -of EXCLUSIONS can be provided as well. The returned -string is quoted for passing as argument to an inferior shell." - (shell-quote-argument (format "[%s %S%s]" (car list) (cadr list) (cider--lein-artifact-exclusions exclusions)))) - -(defun cider-lein-jack-in-dependencies (global-opts params dependencies dependencies-exclusions lein-plugins) - "Create lein jack-in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, with DEPENDENCIES-EXCLUSIONS -removed, LEIN-PLUGINS, and finally PARAMS." - (concat - global-opts - (unless (seq-empty-p global-opts) " ") - (mapconcat #'identity - (append (seq-map (lambda (dep) - (let ((exclusions (cadr (assoc (car dep) dependencies-exclusions)))) - (concat "update-in :dependencies conj " - (cider--list-as-lein-artifact dep exclusions)))) - dependencies) - (seq-map (lambda (plugin) - (concat "update-in :plugins conj " - (cider--list-as-lein-artifact plugin))) - lein-plugins)) - " -- ") - " -- " - params)) - -(defun cider-clojure-cli-jack-in-dependencies (global-opts params dependencies) - "Create Clojure tools.deps jack-in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES finally PARAMS." - (let ((dependencies (append dependencies cider-jack-in-lein-plugins))) - (concat - global-opts - (unless (seq-empty-p global-opts) " ") - "-Sdeps '{:deps {" - (mapconcat #'identity - (seq-map (lambda (dep) (format "%s {:mvn/version \"%s\"}" (car dep) (cadr dep))) dependencies) - " ") - "}}' " - params))) - -(defun cider-shadow-cljs-jack-in-dependencies (global-opts params dependencies) - "Create shadow-cljs jack-in deps. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES finally PARAMS." - (let ((dependencies (append dependencies cider-jack-in-lein-plugins))) - (concat - global-opts - (unless (seq-empty-p global-opts) " ") - (mapconcat #'identity - (seq-map (lambda (dep) (format "-d %s:%s" (car dep) (cadr dep))) dependencies) - " ") - " " - params))) - -(defun cider-add-clojure-dependencies-maybe (dependencies) - "Return DEPENDENCIES with an added Clojure dependency if requested. -See also `cider-jack-in-auto-inject-clojure'." - (if cider-jack-in-auto-inject-clojure - (if (consp cider-jack-in-auto-inject-clojure) - (cons cider-jack-in-auto-inject-clojure dependencies) - (cons (list cider-clojure-artifact-id - (cond - ((stringp cider-jack-in-auto-inject-clojure) - cider-jack-in-auto-inject-clojure) - ((eq cider-jack-in-auto-inject-clojure 'minimal) - cider-minimum-clojure-version) - ((eq cider-jack-in-auto-inject-clojure 'latest) - cider-latest-clojure-version))) - dependencies)) - dependencies)) - -(defun cider-inject-jack-in-dependencies (global-opts params project-type) - "Return GLOBAL-OPTS and PARAMS with injected REPL dependencies. -These are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' and -`cider-jack-in-nrepl-middlewares' are injected from the CLI according to -the used PROJECT-TYPE. Eliminates the need for hacking profiles.clj or the -boot script for supporting cider with its nREPL middleware and -dependencies." - (pcase project-type - ('lein (cider-lein-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - cider-jack-in-dependencies-exclusions - (cider-jack-in-normalized-lein-plugins))) - ('boot (cider-boot-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - (cider-jack-in-normalized-lein-plugins) - (cider-jack-in-normalized-nrepl-middlewares))) - ('clojure-cli (cider-clojure-cli-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies))) - ('shadow-cljs (cider-shadow-cljs-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies))) - ('gradle (concat - global-opts - (unless (seq-empty-p global-opts) " ") - params)) - (_ (error "Unsupported project type `%S'" project-type)))) - - -;;; ClojureScript REPL creation - -(defcustom cider-check-cljs-repl-requirements t - "When non-nil will run the requirement checks for the different cljs repls. -Generally you should not disable this unless you run into some faulty check." - :type 'boolean - :safe #'booleanp - :package-version '(cider . "0.17.0")) - -(defun cider-verify-clojurescript-is-present () - "Check whether ClojureScript is present." - (unless (cider-library-present-p "clojure/clojurescript") - (user-error "ClojureScript is not available. See http://docs.cider.mx/en/latest/clojurescript for details"))) - -(defun cider-verify-piggieback-is-present () - "Check whether the piggieback middleware is present." - (unless (cider-library-present-p "cider/piggieback") - (user-error "Piggieback is not available. See http://docs.cider.mx/en/latest/clojurescript for details"))) - -(defun cider-check-nashorn-requirements () - "Check whether we can start a Nashorn ClojureScript REPL." - (cider-verify-piggieback-is-present)) - -(defun cider-check-node-requirements () - "Check whether we can start a Node ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (executable-find "node") - (user-error "Node.js is not present on the exec-path. Make sure you've installed it and your exec-path is properly set"))) - -(defun cider-check-figwheel-requirements () - "Check whether we can start a Figwheel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "figwheel-sidecar/figwheel-sidecar") - (user-error "Figwheel-sidecar is not available. Please check http://docs.cider.mx/en/latest/clojurescript"))) - -(defun cider-check-figwheel-main-requirements () - "Check whether we can start a Figwheel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "bhauman/figwheel-main") - (user-error "Figwheel-main is not available. Please check http://docs.cider.mx/en/latest/clojurescript"))) - -(defun cider-check-weasel-requirements () - "Check whether we can start a Weasel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "weasel/weasel") - (user-error "Weasel in not available. Please check http://docs.cider.mx/en/latest/clojurescript/#browser-connected-clojurescript-repl"))) - -(defun cider-check-boot-requirements () - "Check whether we can start a Boot ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "adzerk/boot-cljs-repl") - (user-error "The Boot ClojureScript REPL is not available. Please check https://github.com/adzerk-oss/boot-cljs-repl/blob/master/README.md"))) - -(defun cider-check-shadow-cljs-requirements () - "Check whether we can start a shadow-cljs REPL." - (unless (cider-library-present-p "thheller/shadow-cljs") - (user-error "The shadow-cljs ClojureScript REPL is not available"))) - -(defun cider-normalize-cljs-init-options (options) - "Normalize the OPTIONS string used for initializing a CLJS REPL." - (if (or (string-prefix-p "{" options) - (string-prefix-p "(" options) - (string-prefix-p "[" options) - (string-prefix-p ":" options)) - options - (concat ":" options))) - -(defcustom cider-shadow-default-options nil - "Defines default `shadow-cljs' options." - :type 'string - :safe (lambda (s) (or (null s) (stringp s))) - :package-version '(cider . "0.18.0")) - -(defun cider-shadow-select-cljs-init-form () - "Generate the init form for a shadow-cljs select-only REPL. -We have to prompt the user to select a build, that's why this is a command, -not just a string." - (let ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/nrepl-select %s))") - (options (or cider-shadow-default-options - (read-from-minibuffer "Select shadow-cljs build (e.g. dev): ")))) - (format form (cider-normalize-cljs-init-options options)))) - -(defun cider-shadow-cljs-init-form () - "Generate the init form for a shadow-cljs REPL. -We have to prompt the user to select a build, that's why -this is a command, not just a string." - (let* ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/watch %s) (shadow/nrepl-select %s))") - (options (or cider-shadow-default-options - (read-from-minibuffer "Select shadow-cljs build (e.g. dev): "))) - (build (cider-normalize-cljs-init-options options))) - (format form build build))) - -(defcustom cider-figwheel-main-default-options nil - "Defines the `figwheel.main/start' options. - -Note that figwheel-main/start can also accept a map of options, refer to -Figwheel for details." - :type 'string - :safe (lambda (s) (or (null s) (stringp s))) - :package-version '(cider . "0.18.0")) - -(defun cider-figwheel-main-init-form () - "Produce the figwheel-main ClojureScript init form." - (let ((form "(do (require 'figwheel.main) (figwheel.main/start %s))") - (options (string-trim - (or cider-figwheel-main-default-options - (read-from-minibuffer "Select figwheel-main build (e.g. :dev): "))))) - (format form (cider-normalize-cljs-init-options options)))) - -(defun cider-custom-cljs-repl-init-form () - "Prompt for a form that would start a ClojureScript REPL. -The supplied string will be wrapped in a do form if needed." - (let ((form (read-from-minibuffer "Please, provide a form to start a ClojureScript REPL: "))) - ;; TODO: We should probably make this more robust (e.g. by using a regexp or - ;; parsing the form). - (if (string-prefix-p "(do" form) - form - (format "(do %s)" form)))) - -(defvar cider-cljs-repl-types - '((nashorn "(do (require 'cljs.repl.nashorn) (cider.piggieback/cljs-repl (cljs.repl.nashorn/repl-env)))" - cider-check-nashorn-requirements) - (figwheel "(do (require 'figwheel-sidecar.repl-api) (figwheel-sidecar.repl-api/start-figwheel!) (figwheel-sidecar.repl-api/cljs-repl))" - cider-check-figwheel-requirements) - (figwheel-main cider-figwheel-main-init-form cider-check-figwheel-main-requirements) - (node "(do (require 'cljs.repl.node) (cider.piggieback/cljs-repl (cljs.repl.node/repl-env)))" - cider-check-node-requirements) - (weasel "(do (require 'weasel.repl.websocket) (cider.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \"127.0.0.1\" :port 9001)))" - cider-check-weasel-requirements) - (boot "(do (require 'adzerk.boot-cljs-repl) (adzerk.boot-cljs-repl/start-repl))" - cider-check-boot-requirements) - (shadow cider-shadow-cljs-init-form cider-check-shadow-cljs-requirements) - (shadow-select cider-shadow-select-cljs-init-form cider-check-shadow-cljs-requirements) - (custom cider-custom-cljs-repl-init-form nil)) - "A list of supported ClojureScript REPLs. - -For each one we have its name, the form we need to evaluate in a Clojure -REPL to start the ClojureScript REPL and functions to very their requirements. - -The form should be either a string or a function producing a string.") - -(defun cider-register-cljs-repl-type (type init-form &optional requirements-fn) - "Register a new ClojureScript REPL type. - -Types are defined by the following: - -- TYPE - symbol identifier that will be used to refer to the REPL type -- INIT-FORM - string or function (symbol) producing string -- REQUIREMENTS-FN - function to check whether the REPL can be started. -This param is optional. - -All this function does is modifying `cider-cljs-repl-types'. -It's intended to be used in your Emacs config." - (unless (symbolp type) - (user-error "The REPL type must be a symbol")) - (unless (or (stringp init-form) (symbolp init-form)) - (user-error "The init form must be a string or a symbol referring to a function")) - (unless (or (null requirements-fn) (symbolp requirements-fn)) - (user-error "The requirements-fn must be a symbol referring to a function")) - (add-to-list 'cider-cljs-repl-types (list type init-form requirements-fn))) - -(defcustom cider-default-cljs-repl nil - "The default ClojureScript REPL to start. -This affects commands like `cider-jack-in-cljs'. Generally it's -intended to be set via .dir-locals.el for individual projects, as its -relatively unlikely you'd like to use the same type of REPL in each project -you're working on." - :type '(choice (const :tag "Nashorn" nashorn) - (const :tag "Figwheel" figwheel) - (const :tag "Node" node) - (const :tag "Weasel" weasel) - (const :tag "Boot" boot) - (const :tag "Shadow" shadow) - (const :tag "Custom" custom)) - :group 'cider - :safe #'symbolp - :package-version '(cider . "0.17.0")) - -(make-obsolete-variable 'cider-cljs-lein-repl 'cider-default-cljs-repl "0.17") -(make-obsolete-variable 'cider-cljs-boot-repl 'cider-default-cljs-repl "0.17") -(make-obsolete-variable 'cider-cljs-gradle-repl 'cider-default-cljs-repl "0.17") - -(defvar cider--select-cljs-repl-history nil) -(defun cider-select-cljs-repl (&optional default) - "Select the ClojureScript REPL to use with `cider-jack-in-cljs'. -DEFAULT is the default CLJS REPL to offer in completion." - (let ((repl-types (mapcar #'car cider-cljs-repl-types))) - (intern (completing-read "Select ClojureScript REPL type: " repl-types - nil nil nil 'cider--select-cljs-repl-history - (or default (car cider--select-cljs-repl-history)))))) - -(defun cider-cljs-repl-form (repl-type) - "Get the cljs REPL form for REPL-TYPE." - (if-let* ((repl-form (cadr (seq-find - (lambda (entry) - (eq (car entry) repl-type)) - cider-cljs-repl-types)))) - ;; repl-form can be either a string or a function producing a string - (if (symbolp repl-form) - (funcall repl-form) - repl-form) - (user-error "No ClojureScript REPL type %s found. Please make sure that `cider-cljs-repl-types' has an entry for it" repl-type))) - -(defun cider-verify-cljs-repl-requirements (&optional repl-type) - "Verify that the requirements for REPL-TYPE are met. -Return REPL-TYPE if requirements are met." - (let ((repl-type (or repl-type - cider-default-cljs-repl - (cider-select-cljs-repl)))) - (when-let* ((fun (nth 2 (seq-find - (lambda (entry) - (eq (car entry) repl-type)) - cider-cljs-repl-types)))) - (funcall fun)) - repl-type)) - -(defun cider--check-cljs (&optional cljs-type no-error) - "Verify that all cljs requirements are met for CLJS-TYPE connection. -Return REPL-TYPE of requirement are met, and throw an ‘user-error’ otherwise. -When NO-ERROR is non-nil, don't throw an error, issue a message and return -nil." - (if no-error - (condition-case ex - (progn - (cider-verify-clojurescript-is-present) - (cider-verify-cljs-repl-requirements cljs-type)) - (error - (message "Invalid CLJS dependency: %S" ex) - nil)) - (cider-verify-clojurescript-is-present) - (cider-verify-cljs-repl-requirements cljs-type))) - -(defun cider--offer-to-open-app-in-browser (server-buffer) - "Look for a server address in SERVER-BUFFER and offer to open it." - (when (buffer-live-p server-buffer) - (with-current-buffer server-buffer - (save-excursion - (goto-char (point-min)) - (when-let* ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror) - (match-string 0)))) - (when (y-or-n-p (format "Visit ‘%s’ in a browser? " url)) - (browse-url url))))))) - - -;;; User Level Connectors - -(defvar cider-start-map - (let ((map (define-prefix-command 'cider-start-map))) - (define-key map (kbd "x") #'cider) - (define-key map (kbd "C-x") #'cider) - (define-key map (kbd "j j") #'cider-jack-in-clj) - (define-key map (kbd "j s") #'cider-jack-in-cljs) - (define-key map (kbd "j m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "C-j j") #'cider-jack-in-clj) - (define-key map (kbd "C-j s") #'cider-jack-in-cljs) - (define-key map (kbd "C-j m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "C-j C-j") #'cider-jack-in-clj) - (define-key map (kbd "C-j C-s") #'cider-jack-in-cljs) - (define-key map (kbd "C-j C-m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "c j") #'cider-connect-clj) - (define-key map (kbd "c s") #'cider-connect-cljs) - (define-key map (kbd "c m") #'cider-connect-clj&cljs) - (define-key map (kbd "C-c j") #'cider-connect-clj) - (define-key map (kbd "C-c s") #'cider-connect-cljs) - (define-key map (kbd "C-c m") #'cider-connect-clj&cljs) - (define-key map (kbd "C-c C-j") #'cider-connect-clj) - (define-key map (kbd "C-c C-s") #'cider-connect-cljs) - (define-key map (kbd "C-c C-m") #'cider-connect-clj&cljs) - (define-key map (kbd "s j") #'cider-connect-sibling-clj) - (define-key map (kbd "s s") #'cider-connect-sibling-cljs) - (define-key map (kbd "C-s j") #'cider-connect-sibling-clj) - (define-key map (kbd "C-s s") #'cider-connect-sibling-cljs) - (define-key map (kbd "C-s C-j") #'cider-connect-sibling-clj) - (define-key map (kbd "C-s C-s") #'cider-connect-sibling-cljs) - map) - "CIDER jack-in and connect keymap.") - -;;;###autoload -(defun cider-jack-in-clj (params) - "Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. -With the prefix argument, prompt for all these parameters." - (interactive "P") - (let ((params (thread-first params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd)))) - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - (lambda (server-buffer) - (cider-connect-sibling-clj params server-buffer))))) - -;;;###autoload -(defun cider-jack-in-cljs (params) - "Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, -prompt for all these parameters." - (interactive "P") - (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) - (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) - (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) - (orig-buffer (current-buffer))) - ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars - (let ((params (thread-first params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd)))) - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - (lambda (server-buffer) - (with-current-buffer orig-buffer - (cider-connect-sibling-cljs params server-buffer))))))) - -;;;###autoload -(defun cider-jack-in-clj&cljs (&optional params soft-cljs-start) - "Start an nREPL server and connect with clj and cljs REPLs. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, -prompt for all these parameters. When SOFT-CLJS-START is non-nil, start -cljs REPL only when the ClojureScript dependencies are met." - (interactive "P") - (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) - (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) - (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) - (orig-buffer (current-buffer))) - ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars - (let ((params (thread-first params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd) - (cider--update-cljs-type) - ;; already asked, don't ask on sibling connect - (plist-put :do-prompt nil)))) - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - (lambda (server-buffer) - (with-current-buffer orig-buffer - (let ((clj-repl (cider-connect-sibling-clj params server-buffer))) - (if soft-cljs-start - (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) - (cider-connect-sibling-cljs params clj-repl)) - (cider-connect-sibling-cljs params clj-repl))))))))) - -;;;###autoload -(defun cider-connect-sibling-clj (params &optional other-repl) - "Create a Clojure REPL with the same server as OTHER-REPL. -PARAMS is for consistency with other connection commands and is currently -ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can -also be a server buffer, in which case a new session with a REPL for that -server is created." - (interactive "P") - (cider-nrepl-connect - (let* ((other-repl (or other-repl (cider-current-repl nil 'ensure))) - (other-params (cider--gather-connect-params nil other-repl)) - (ses-name (unless (nrepl-server-p other-repl) - (sesman-session-name-for-object 'CIDER other-repl)))) - (thread-first params - (cider--update-do-prompt) - (append other-params) - (plist-put :repl-init-function nil) - (plist-put :repl-type "clj") - (plist-put :session-name ses-name))))) - -;;;###autoload -(defun cider-connect-sibling-cljs (params &optional other-repl) - "Create a ClojureScript REPL with the same server as OTHER-REPL. -PARAMS is a plist optionally containing :cljs-repl-type (e.g. Node, -Figwheel, etc). All other parameters are inferred from the OTHER-REPL. -OTHER-REPL defaults to `cider-current-repl' but in programs can also be a -server buffer, in which case a new session for that server is created." - (interactive "P") - (let* ((other-repl (or other-repl (cider-current-repl nil 'ensure))) - (other-params (cider--gather-connect-params nil other-repl)) - (ses-name (unless (nrepl-server-p other-repl) - (sesman-session-name-for-object 'CIDER other-repl)))) - (cider-nrepl-connect - (thread-first params - (cider--update-do-prompt) - (append other-params) - (cider--update-cljs-type) - (cider--update-cljs-init-function) - (plist-put :session-name ses-name) - (plist-put :repl-type "pending-cljs"))))) - -;;;###autoload -(defun cider-connect-clj (&optional params) - "Initialize a CLJ connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port and :project-dir. On -prefix argument, prompt for all the parameters." - (interactive "P") - (cider-nrepl-connect - (thread-first params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (plist-put :repl-init-function nil) - (plist-put :session-name nil) - (plist-put :repl-type "clj")))) - -;;;###autoload -(defun cider-connect-cljs (&optional params) - "Initialize a CLJS connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. Node, Figwheel, etc). On prefix, prompt for all the -parameters regardless of their supplied or default values." - (interactive "P") - (cider-nrepl-connect - (thread-first params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (cider--update-cljs-type) - (cider--update-cljs-init-function) - (plist-put :session-name nil) - (plist-put :repl-type "pending-cljs")))) - -;;;###autoload -(defun cider-connect-clj&cljs (params &optional soft-cljs-start) - "Initialize a CLJ and CLJS connection to an nREPL server.. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is -non-nil, don't start if ClojureScript requirements are not met." - (interactive "P") - (let* ((params (thread-first params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (cider--update-cljs-type))) - (clj-repl (cider-connect-clj params))) - (if soft-cljs-start - (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) - (cider-connect-sibling-cljs params clj-repl)) - (cider-connect-sibling-cljs params clj-repl)))) - -(defvar cider-connection-init-commands - '(cider-jack-in-clj - cider-jack-in-cljs - cider-jack-in-clj&cljs - cider-connect-clj - cider-connect-cljs - cider-connect-clj&cljs - cider-connect-sibling-clj - cider-connect-sibling-cljs) - "A list of all user-level connection init commands in CIDER.") - -;;;###autoload -(defun cider () - "Start a connection of any type interactively." - (interactive) - (when-let* ((command (intern (completing-read "Select command: " cider-connection-init-commands)))) - (call-interactively command))) - - -;;; PARAMS updating - -(defun cider--update-do-prompt (params) - "Update :do-prompt in PARAMS." - (if (equal params '(4)) - (list :do-prompt t) - params)) - -(defun cider--update-project-dir (params) - "Update :project-dir in PARAMS." - (let* ((params (cider--update-do-prompt params)) - (proj-dir (if (plist-get params :do-prompt) - (read-directory-name "Project: " - (clojure-project-dir (cider-current-dir))) - (plist-get params :project-dir))) - (orig-buffer (current-buffer))) - (if (or (null proj-dir) - (file-in-directory-p default-directory proj-dir)) - (plist-put params :project-dir - (or proj-dir - (clojure-project-dir (cider-current-dir)))) - ;; If proj-dir is not a parent of default-directory, transfer all local - ;; variables and hack dir-local variables into a temporary buffer and keep - ;; that buffer within `params` for the later use by other --update- - ;; functions. The context buffer should not be used outside of the param - ;; initialization pipeline. Therefore, we don't bother with making it - ;; unique or killing it anywhere. - (let ((context-buf-name " *cider-context-buffer*")) - (when (get-buffer context-buf-name) - (kill-buffer context-buf-name)) - (with-current-buffer (get-buffer-create context-buf-name) - (dolist (pair (buffer-local-variables orig-buffer)) - (pcase pair - (`(,name . ,value) ;ignore unbound variables - (ignore-errors (set (make-local-variable name) value)))) - (setq-local buffer-file-name nil)) - (let ((default-directory proj-dir)) - (hack-dir-local-variables-non-file-buffer) - (thread-first params - (plist-put :project-dir proj-dir) - (plist-put :--context-buffer (current-buffer))))))))) - -(defun cider--update-cljs-type (params) - "Update :cljs-repl-type in PARAMS." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let ((params (cider--update-do-prompt params)) - (inferred-type (or (plist-get params :cljs-repl-type) - cider-default-cljs-repl))) - (plist-put params :cljs-repl-type - (if (plist-get params :do-prompt) - (cider-select-cljs-repl inferred-type) - (or inferred-type - (cider-select-cljs-repl))))))) - -(defun cider--update-jack-in-cmd (params) - "Update :jack-in-cmd key in PARAMS." - (let* ((params (cider--update-do-prompt params)) - (project-dir (plist-get params :project-dir)) - (project-type (cider-project-type project-dir)) - (command (cider-jack-in-command project-type)) - (command-resolved (cider-jack-in-resolve-command project-type)) - (command-global-opts (cider-jack-in-global-options project-type)) - (command-params (cider-jack-in-params project-type))) - (if command-resolved - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let* ((command-params (if (plist-get params :do-prompt) - (read-string (format "nREPL server command: %s " command-params) - command-params) - command-params)) - (cmd-params (if cider-inject-dependencies-at-jack-in - (cider-inject-jack-in-dependencies command-global-opts command-params project-type) - command-params))) - (if (or project-dir cider-allow-jack-in-without-project) - (when (or project-dir - (eq cider-allow-jack-in-without-project t) - (and (null project-dir) - (eq cider-allow-jack-in-without-project 'warn) - (y-or-n-p "Are you sure you want to run `cider-jack-in' without a Clojure project? "))) - (let* ((cmd (format "%s %s" command-resolved cmd-params))) - (plist-put params :jack-in-cmd cmd))) - (user-error "`cider-jack-in' is not allowed without a Clojure project")))) - (user-error "The %s executable isn't on your `exec-path'" command)))) - -(defun cider--update-host-port (params) - "Update :host and :port in PARAMS." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let* ((params (cider--update-do-prompt params)) - (host (plist-get params :host)) - (port (plist-get params :port)) - (endpoint (if (plist-get params :do-prompt) - (cider-select-endpoint) - (if (and host port) - (cons host port) - (cider-select-endpoint))))) - (thread-first params - (plist-put :host (car endpoint)) - (plist-put :port (cdr endpoint)))))) - -(defun cider--update-cljs-init-function (params) - "Update PARAMS :repl-init-function for cljs connections." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let ((cljs-type (plist-get params :cljs-repl-type))) - (plist-put params :repl-init-function - (lambda () - (cider--check-cljs cljs-type) - ;; FIXME: ideally this should be done in the state handler - (setq-local cider-cljs-repl-type cljs-type) - (cider-nrepl-send-request - (list "op" "eval" - "ns" (cider-current-ns) - "code" (cider-cljs-repl-form cljs-type)) - (cider-repl-handler (current-buffer))) - (when (and (buffer-live-p nrepl-server-buffer) - cider-offer-to-open-cljs-app-in-browser) - (cider--offer-to-open-app-in-browser nrepl-server-buffer))))))) - -(defun cider--check-existing-session (params) - "Ask for confirmation if a session with similar PARAMS already exists. -If no session exists or user chose to proceed, return PARAMS. If the user -canceled the action, signal quit." - (let* ((proj-dir (plist-get params :project-dir)) - (host (plist-get params :host)) - (port (plist-get params :port)) - (session (seq-find (lambda (ses) - (let ((ses-params (cider--gather-session-params ses))) - (and (equal proj-dir (plist-get ses-params :project-dir)) - (or (null port) - (equal port (plist-get ses-params :port))) - (or (null host) - (equal host (plist-get ses-params :host)))))) - (sesman-linked-sessions 'CIDER '(project))))) - (when session - (unless (y-or-n-p - (concat - "A session with the same parameters exists (" (car session) "). " - "You can connect a sibling instead. Proceed? ")) - (let ((debug-on-quit nil)) - (signal 'quit nil))))) - params) - - -;;; Aliases - - ;;;###autoload -(defalias 'cider-jack-in #'cider-jack-in-clj) - ;;;###autoload -(defalias 'cider-jack-in-clojure #'cider-jack-in-clj) -;;;###autoload -(defalias 'cider-jack-in-clojurescript #'cider-jack-in-cljs) - -;;;###autoload -(defalias 'cider-connect #'cider-connect-clj) -;;;###autoload -(defalias 'cider-connect-clojure #'cider-connect-clj) -;;;###autoload -(defalias 'cider-connect-clojurescript #'cider-connect-cljs) - -;;;###autoload -(defalias 'cider-connect-sibling-clojure #'cider-connect-sibling-clj) -;;;###autoload -(defalias 'cider-connect-sibling-clojurescript #'cider-connect-sibling-cljs) - - -;;; Helpers - -(defun cider-current-host () - "Retrieve the current host." - (or (when (stringp buffer-file-name) - (file-remote-p buffer-file-name 'host)) - "localhost")) - -(defun cider-select-endpoint () - "Interactively select the host and port to connect to." - (dolist (endpoint cider-known-endpoints) - (unless (stringp (or (nth 2 endpoint) - (nth 1 endpoint))) - (user-error "The port for %s in `cider-known-endpoints' should be a string" - (nth 0 endpoint)))) - (let* ((ssh-hosts (cider--ssh-hosts)) - (hosts (seq-uniq (append (when cider-host-history - ;; history elements are strings of the form "host:port" - (list (split-string (car cider-host-history) ":"))) - (list (list (cider-current-host))) - cider-known-endpoints - ssh-hosts - ;; always add localhost - '(("localhost"))))) - (sel-host (cider--completing-read-host hosts)) - (host (car sel-host)) - (port (or (cadr sel-host) - (cider--completing-read-port host (cider--infer-ports host ssh-hosts))))) - (cons host port))) - -(defun cider--ssh-hosts () - "Retrieve all ssh host from local configuration files." - (seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s))) - ;; `tramp-completion-mode' is obsoleted in 26 - (cl-progv (if (version< emacs-version "26") - '(tramp-completion-mode) - '(non-essential)) '(t) - (tramp-completion-handle-file-name-all-completions "" "/ssh:")))) - -(defun cider--completing-read-host (hosts) - "Interactively select host from HOSTS. -Each element in HOSTS is one of: (host), (host port) or (label host port). -Return a list of the form (HOST PORT), where PORT can be nil." - (let* ((hosts (cider-join-into-alist hosts)) - (sel-host (completing-read "Host: " hosts nil nil nil - 'cider-host-history (caar hosts))) - (host (or (cdr (assoc sel-host hosts)) (list sel-host)))) - ;; remove the label - (if (= 3 (length host)) (cdr host) host))) - -(defun cider--tramp-file-name (vec) - "A simple compatibility wrapper around `make-tramp-file-name'. -Tramp version starting 26.1 is using a `cl-defstruct' rather than vanilla VEC." - (if (version< emacs-version "26.1") - vec - (with-no-warnings - (make-tramp-file-name :method (elt vec 0) - :host (elt vec 2))))) - -(defun cider--infer-ports (host ssh-hosts) - "Infer nREPL ports on HOST. -Return a list of elements of the form (directory port). SSH-HOSTS is a list -of remote SSH hosts." - (let ((localp (or (nrepl-local-host-p host) - (not (assoc-string host ssh-hosts))))) - (if localp - ;; change dir: current file might be remote - (let* ((change-dir-p (file-remote-p default-directory)) - (default-directory (if change-dir-p "~/" default-directory))) - (cider-locate-running-nrepl-ports (unless change-dir-p default-directory))) - (let ((vec (vector "sshx" nil host "" nil)) - ;; change dir: user might want to connect to a different remote - (dir (when (file-remote-p default-directory) - (with-parsed-tramp-file-name default-directory cur - (when (string= cur-host host) default-directory))))) - (tramp-maybe-open-connection (cider--tramp-file-name vec)) - (with-current-buffer (tramp-get-connection-buffer (cider--tramp-file-name vec)) - (cider-locate-running-nrepl-ports dir)))))) - -(defun cider--completing-read-port (host ports) - "Interactively select port for HOST from PORTS." - (let* ((ports (cider-join-into-alist ports)) - (sel-port (completing-read (format "Port for %s: " host) ports - nil nil nil nil (caar ports))) - (port (or (cdr (assoc sel-port ports)) sel-port)) - (port (if (listp port) (cadr port) port))) - (if (stringp port) (string-to-number port) port))) - -(defun cider-locate-running-nrepl-ports (&optional dir) - "Locate ports of running nREPL servers. -When DIR is non-nil also look for nREPL port files in DIR. Return a list -of list of the form (project-dir port)." - (let* ((paths (cider--running-nrepl-paths)) - (proj-ports (mapcar (lambda (d) - (when-let* ((port (and d (nrepl-extract-port (cider--file-path d))))) - (list (file-name-nondirectory (directory-file-name d)) port))) - (cons (clojure-project-dir dir) paths)))) - (seq-uniq (delq nil proj-ports)))) - -(defun cider--running-nrepl-paths () - "Retrieve project paths of running nREPL servers. -Use `cider-ps-running-nrepls-command' and `cider-ps-running-nrepl-path-regexp-list'." - (let (paths) - (with-temp-buffer - (insert (shell-command-to-string cider-ps-running-nrepls-command)) - (dolist (regexp cider-ps-running-nrepl-path-regexp-list) - (goto-char 1) - (while (re-search-forward regexp nil t) - (setq paths (cons (match-string 1) paths))))) - (seq-uniq paths))) - -(defun cider--identify-buildtools-present (&optional project-dir) - "Identify build systems present by their build files in PROJECT-DIR. -PROJECT-DIR defaults to current project." - (let* ((default-directory (or project-dir (clojure-project-dir (cider-current-dir)))) - (build-files '((lein . "project.clj") - (boot . "build.boot") - (clojure-cli . "deps.edn") - (shadow-cljs . "shadow-cljs.edn") - (gradle . "build.gradle")))) - (delq nil - (mapcar (lambda (candidate) - (when (file-exists-p (cdr candidate)) - (car candidate))) - build-files)))) - -(defun cider-project-type (&optional project-dir) - "Determine the type of the project in PROJECT-DIR. -When multiple project file markers are present, check for a preferred build -tool in `cider-preferred-build-tool', otherwise prompt the user to choose. -PROJECT-DIR defaults to the current project." - (let* ((choices (cider--identify-buildtools-present project-dir)) - (multiple-project-choices (> (length choices) 1)) - ;; this needs to be a string to be used in `completing-read' - (default (symbol-name (car choices))) - ;; `cider-preferred-build-tool' used to be a string prior to CIDER - ;; 0.18, therefore the need for `cider-maybe-intern' - (preferred-build-tool (cider-maybe-intern cider-preferred-build-tool))) - (cond ((and multiple-project-choices - (member preferred-build-tool choices)) - preferred-build-tool) - (multiple-project-choices - (intern - (completing-read - (format "Which command should be used (default %s): " default) - choices nil t nil nil default))) - (choices - (car choices)) - ;; TODO: Move this fallback outside the project-type check - ;; if we're outside a project we fallback to whatever tool - ;; is specified in `cider-jack-in-default' (normally clojure-cli) - ;; `cider-jack-in-default' used to be a string prior to CIDER - ;; 0.18, therefore the need for `cider-maybe-intern' - (t (cider-maybe-intern cider-jack-in-default))))) - - -;; TODO: Implement a check for command presence over tramp -(defun cider--resolve-command (command) - "Find COMMAND in exec path (see variable `exec-path'). -Return nil if not found. In case `default-directory' is non-local we -assume the command is available." - (when-let* ((command (or (and (file-remote-p default-directory) command) - (executable-find command) - (executable-find (concat command ".bat"))))) - (shell-quote-argument command))) - -;;;###autoload -(eval-after-load 'clojure-mode - '(progn - (define-key clojure-mode-map (kbd "C-c M-x") #'cider) - (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) - (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) - (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) - (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) - (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) - (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) - (require 'sesman) - (sesman-install-menu clojure-mode-map) - (add-hook 'clojure-mode-hook (lambda () (setq-local sesman-system 'CIDER))))) - -(provide 'cider) - -;;; cider.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider.elc deleted file mode 100644 index 8cd342afe0d1..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-client.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-client.el deleted file mode 100644 index 056a8540a034..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-client.el +++ /dev/null @@ -1,1343 +0,0 @@ -;;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; Reid McKenzie <me@arrdem.com> -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;; -;; This file is not part of GNU Emacs. -;; -;;; Commentary: -;; -;; 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 'subr-x) -(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) -(make-obsolete-variable 'nrepl-buffer-name-separator 'cider-session-name-template "0.18") - -;; (defcustom nrepl-buffer-name-show-port nil -;; "Show the connection port in the nrepl REPL buffer name, if set to t." -;; :type 'boolean -;; :group 'nrepl) -(make-obsolete-variable 'nrepl-buffer-name-show-port 'cider-session-name-template "0.18") - -(defcustom nrepl-connected-hook nil - "List of functions to call when connecting to the nREPL server." - :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-use-ssh-fallback-for-remote-hosts nil - "If non-nil, attempt to connect via ssh to remote hosts when unable to connect directly." - :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) - - -;;; Buffer Local Declarations - -;; These variables are used to track the state of nREPL connections -(defvar-local nrepl-connection-buffer nil) -(defvar-local nrepl-server-buffer nil) -(defvar-local nrepl-messages-buffer nil) -(defvar-local nrepl-endpoint nil) -(defvar-local nrepl-project-dir nil) -(defvar-local nrepl-is-server nil) -(defvar-local nrepl-server-command nil) -(defvar-local nrepl-tunnel-buffer nil) - -(defvar-local nrepl-session nil - "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(%r:%S)*") -(defconst nrepl-error-buffer-name "*nrepl-error*") -(defconst nrepl-repl-buffer-name-template "*cider-repl %s(%r:%S)*") -(defconst nrepl-server-buffer-name-template "*nrepl-server %s*") -(defconst nrepl-tunnel-buffer-name-template "*nrepl-tunnel %s*") - -(defun nrepl-make-buffer-name (template params &optional dup-ok) - "Generate a buffer name using TEMPLATE and PARAMS. -TEMPLATE and PARAMS are as in `cider-format-connection-params'. If -optional DUP-OK is non-nil, the returned buffer is not \"uniquified\" by a -call to `generate-new-buffer-name'." - (let ((name (cider-format-connection-params template params))) - (if dup-ok - name - (generate-new-buffer-name name)))) - -(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-repl-buffer-name (params &optional dup-ok) - "Return the name of the repl buffer. -PARAMS and DUP-OK are as in `nrepl-make-buffer-name'." - (nrepl-make-buffer-name nrepl-repl-buffer-name-template params dup-ok)) - -(defun nrepl-server-buffer-name (params) - "Return the name of the server buffer. -PARAMS is as in `nrepl-make-buffer-name'." - (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-server-buffer-name-template params))) - -(defun nrepl-tunnel-buffer-name (params) - "Return the name of the tunnel buffer. -PARAMS is as in `nrepl-make-buffer-name'." - (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-tunnel-buffer-name-template params))) - -(defun nrepl-messages-buffer-name (params) - "Return the name for the message buffer given connection PARAMS." - (nrepl-make-buffer-name nrepl-message-buffer-name-template params)) - - -;;; Utilities -(defun nrepl-op-supported-p (op connection) - "Return t iff the given operation OP is supported by the nREPL CONNECTION." - (when (buffer-live-p connection) - (with-current-buffer connection - (and nrepl-ops (nrepl-dict-get nrepl-ops op))))) - -(defun nrepl-aux-info (key connection) - "Return KEY's aux info, as returned via the :describe op for CONNECTION." - (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)) - (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir)))) - -(defun nrepl--port-from-file (file) - "Attempts to read port from a file named by FILE." - (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) - (let ((server-buffer nrepl-server-buffer)) - (when (and (buffer-live-p server-buffer) - (not (plist-get (process-plist process) :no-server-kill))) - (setq nrepl-server-buffer nil) - (nrepl--maybe-kill-server-buffer 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 (and `nrepl-use-ssh-fallback-for-remote-hosts' is -non-nil), 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) - ;; we're dealing with a remote host - (if (and host (not nrepl-force-ssh-for-remote-hosts)) - (or (nrepl--direct-connect host port 'no-error) - ;; direct connection failed - ;; fallback to ssh tunneling if enabled - (and nrepl-use-ssh-fallback-for-remote-hosts - (message "[nREPL] Falling back to SSH tunneled connection ...") - (nrepl--ssh-tunnel-connect host port)) - ;; fallback is either not enabled or it failed as well - (if (and (null nrepl-use-ssh-fallback-for-remote-hosts) - (not localp)) - (error "[nREPL] Direct connection to %s:%s failed; try setting `nrepl-use-ssh-fallback-for-remote-hosts' to t" - host port) - (error "[nREPL] Cannot connect to %s:%s" host port))) - ;; `nrepl-force-ssh-for-remote-hosts' is non-nil - (nrepl--ssh-tunnel-connect host port))))) - -(defun nrepl--direct-connect (host port &optional no-error) - "If HOST and PORT are given, try to `open-network-stream'. -If NO-ERROR is non-nil, show messages instead of throwing an error." - (if (not (and host port)) - (unless no-error - (unless host - (error "[nREPL] Host not provided")) - (unless port - (error "[nREPL] Port not provided"))) - (message "[nREPL] Establishing direct connection to %s:%s ..." host port) - (condition-case nil - (prog1 (list :proc (open-network-stream "nrepl-connection" nil host port) - :host host :port port) - (message "[nREPL] Direct connection to %s:%s established" host port)) - (error (let ((msg (format "[nREPL] Direct connection to %s:%s failed" host port))) - (if no-error - (message msg) - (error msg)) - nil))))) - -(defun nrepl--ssh-tunnel-connect (host port) - "Connect to a remote machine identified by HOST and PORT through SSH tunnel." - (message "[nREPL] Establishing SSH tunneled connection to %s:%s ..." host port) - (let* ((remote-dir (if host (format "/ssh:%s:" host) default-directory)) - (ssh (or (executable-find "ssh") - (error "[nREPL] Cannot locate 'ssh' executable"))) - (cmd (nrepl--ssh-tunnel-command ssh remote-dir port)) - (tunnel-buf (nrepl-tunnel-buffer-name - `((:host ,host) (:port ,port)))) - (tunnel (start-process-shell-command "nrepl-tunnel" tunnel-buf cmd))) - (process-put tunnel :waiting-for-port t) - (set-process-filter tunnel (nrepl--ssh-tunnel-filter port)) - (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 v - ;; this abuses the -v option for ssh to get output when the port - ;; forwarding is set up, which is used to synchronise on, so that - ;; the port forwarding is up when we try to connect. - (format-spec - "%s -v -N -L %p:localhost:%p %u'%h'" - `((?s . ,ssh) - (?p . ,port) - (?h . ,v-host) - (?u . ,(if v-user (format "-l '%s' " v-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--kill-process (proc) - "Kill PROC using the appropriate, os specific way. -Implement a workaround to clean up an orphaned JVM process left around -after exiting the REPL on some windows machines." - (if (memq system-type '(cygwin windows-nt)) - (interrupt-process proc) - (kill-process proc))) - -(defun nrepl-kill-server-buffer (server-buf) - "Kill SERVER-BUF and its process." - (when (buffer-live-p server-buf) - (let ((proc (get-buffer-process server-buf))) - (when (process-live-p proc) - (set-process-query-on-exit-flag proc nil) - (nrepl--kill-process proc)) - (kill-buffer server-buf)))) - -(defun nrepl--maybe-kill-server-buffer (server-buf) - "Kill SERVER-BUF and its process. -Do not kill the server if there is a REPL connected to that server." - (when (buffer-live-p server-buf) - (with-current-buffer server-buf - ;; Don't kill if there is at least one REPL connected to it. - (when (not (seq-find (lambda (b) - (eq (buffer-local-value 'nrepl-server-buffer b) - server-buf)) - (buffer-list))) - (nrepl-kill-server-buffer server-buf))))) - -(defun nrepl-start-client-process (&optional host port server-proc buffer-builder) - "Create new client process identified by HOST and PORT. -In remote buffers, HOST and PORT are taken from the current tramp -connection. SERVER-PROC must be a running nREPL server process within -Emacs. BUFFER-BUILDER is a function of one argument (endpoint returned by -`nrepl-connect') which returns a client buffer. Return the newly created -client process." - (let* ((endpoint (nrepl-connect host port)) - (client-proc (plist-get endpoint :proc)) - (builder (or buffer-builder (error "`buffer-builder' must be provided"))) - (client-buf (funcall builder 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 endpoint - nrepl-tunnel-buffer (when-let* ((tunnel (plist-get endpoint :tunnel))) - (process-buffer tunnel)) - nrepl-pending-requests (make-hash-table :test 'equal) - nrepl-completed-requests (make-hash-table :test 'equal))) - - (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 t))) ; t for tooling - (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))) - -(declare-function cider-repl--emit-interactive-output "cider-repl") -(defun nrepl-notify (msg type) - "Handle \"notification\" server request. -MSG is a string to be displayed. TYPE is the type of the message. All -notifications are currently displayed with `message' function and emitted -to the REPL." - (let* ((face (pcase type - ((or "message" `nil) 'font-lock-builtin-face) - ("warning" 'warning) - ("error" 'error))) - (msg (if face - (propertize msg 'face face) - (format "%s: %s" (upcase type) msg)))) - (cider-repl--emit-interactive-output msg (or face 'font-lock-builtin-face)) - (message msg) - ;; Interactive eval handler covers this message, but it won't be eval - ;; middleware using this functionality. - (sit-for 2))) - -(defvar cider-buffer-ns) -(defvar cider-special-mode-truncate-lines) -(declare-function cider-need-input "cider-client") -(declare-function cider-set-buffer-ns "cider-mode") - -(defun nrepl-make-response-handler (buffer value-handler stdout-handler - stderr-handler done-handler - &optional eval-error-handler - pprint-out-handler - content-type-handler) - "Make a response handler for connection BUFFER. -A handler is a function that takes one argument - response received from -the server process. The response is an alist that contains at least 'id' -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, PPRINT-OUT-HANDLER and -CONTENT-TYPE-HANDLER. - -Handlers are functions of the buffer and the value they handle, except for -the optional CONTENT-TYPE-HANDLER which should be a function of the buffer, -content, the content-type to be handled as a list `(type attrs)'. - -If the optional EVAL-ERROR-HANDLER is nil, the default `nrepl-err-handler' -is used. If any of the other supplied handlers are nil nothing happens for -the corresponding type of response." - (lambda (response) - (nrepl-dbind-response response (content-type content-transfer-encoding body - value ns out err status id - pprint-out) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when (and ns (not (derived-mode-p 'clojure-mode))) - (cider-set-buffer-ns ns)))) - (cond ((and content-type content-type-handler) - (funcall content-type-handler buffer - (if (string= content-transfer-encoding "base64") - (base64-decode-string body) - body) - content-type)) - (value - (when value-handler - (funcall value-handler buffer value))) - (out - (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 "notification" status) - (nrepl-dbind-response response (msg type) - (nrepl-notify msg type))) - (when (member "interrupted" status) - (message "Evaluation interrupted.")) - (when (member "eval-error" status) - (funcall (or eval-error-handler nrepl-err-handler))) - (when (member "namespace-not-found" status) - ;; nREPL 0.4.3 started echoing back the name of the missing ns - (if ns - (message "Namespace `%s' not found." ns) - (message "Namespace not found."))) - (when (member "need-input" status) - (cider-need-input buffer)) - (when (member "done" status) - (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/nrepl/nrepl/blob/master/doc/ops.md. CIDER adds -;; many more operations through nREPL middleware. See -;; https://github.com/clojure-emacs/cider-nrepl#supplied-nrepl-middleware for -;; the up-to-date list. - -(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 &optional tooling) - "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. This expects that the REQUEST does not have a -session already in it. This code will add it as appropriate to prevent -connection/session drift. -Return the ID of the sent message. -Optional argument TOOLING Set to t if desiring the tooling session rather than the standard session." - (with-current-buffer connection - (when-let* ((session (if tooling nrepl-tooling-session nrepl-session))) - (setq request (append request `("session" ,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-eval") - -(defun nrepl-send-sync-request (request connection &optional abort-on-input tooling) - "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. -If TOOLING, use the tooling session rather than the standard session." - (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 - tooling) - (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) - "Send a :stdin request with INPUT using CONNECTION. -Register CALLBACK as the response handler." - (nrepl-send-request `("op" "stdin" - "stdin" ,input) - callback - connection)) - -(defun nrepl-request:interrupt (pending-request-id callback connection) - "Send an :interrupt request for PENDING-REQUEST-ID. -The request is dispatched using CONNECTION. -Register CALLBACK as the response handler." - (nrepl-send-request `("op" "interrupt" - "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 &optional ns line column) - "Prepare :eval request message for INPUT. -NS provides context for the request. -If LINE and COLUMN are non-nil and current buffer is a file buffer, \"line\", -\"column\" and \"file\" are added to the message." - (nconc (and ns `("ns" ,ns)) - `("op" "eval" - "code" ,(substring-no-properties input)) - (when cider-enlighten-mode - '("enlighten" "true")) - (let ((file (or (buffer-file-name) (buffer-name)))) - (when (and line column file) - `("file" ,file - "line" ,line - "column" ,column))))) - -(defun nrepl-request:eval (input callback connection &optional ns line column additional-params tooling) - "Send the request INPUT and register the CALLBACK as the response handler. -The request is dispatched via CONNECTION. If NS is non-nil, -include it in the request. LINE and COLUMN, if non-nil, define the position -of INPUT in its buffer. A CONNECTION uniquely determines two connections -available: the standard interaction one and the tooling session. If the -tooling is desired, set TOOLING to true. -ADDITIONAL-PARAMS is a plist to be appended to the request message." - (nrepl-send-request (append (nrepl--eval-request input ns line column) additional-params) - callback - connection - tooling)) - -(defun nrepl-sync-request:clone (connection &optional tooling) - "Sent a :clone request to create a new client session. -The request is dispatched via CONNECTION. -Optional argument TOOLING Tooling is set to t if wanting the tooling session from CONNECTION." - (nrepl-send-sync-request '("op" "clone") - connection - nil tooling)) - -(defun nrepl-sync-request:close (connection) - "Sent a :close request to close CONNECTION's SESSION." - (nrepl-send-sync-request '("op" "close") connection) - (nrepl-send-sync-request '("op" "close") connection nil t)) ;; close tooling session - -(defun nrepl-sync-request:describe (connection) - "Perform :describe request for CONNECTION and SESSION." - (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 &optional ns tooling) - "Send the INPUT to the nREPL server synchronously. -The request is dispatched via CONNECTION. -If NS is non-nil, include it in the request -If TOOLING is non-nil the evaluation is done using the tooling nREPL -session." - (nrepl-send-sync-request - (nrepl--eval-request input ns) - connection - nil - tooling)) - -(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. - -;; internal variables used for state transfer between nrepl-start-server-process -;; and nrepl-server-filter. -(defvar-local nrepl-on-port-callback nil) - -(defun nrepl-server-p (buffer-or-process) - "Return t if BUFFER-OR-PROCESS is an nREPL server." - (let ((buffer (if (processp buffer-or-process) - (process-buffer buffer-or-process) - buffer-or-process))) - (buffer-local-value 'nrepl-is-server buffer))) - -(defun nrepl-start-server-process (directory cmd on-port-callback) - "Start nREPL server process in DIRECTORY using shell command CMD. -Return a newly created process. Set `nrepl-server-filter' as the process -filter, which starts REPL process with its own buffer once the server has -started. ON-PORT-CALLBACK is a function of one argument (server buffer) -which is called by the process filter once the port of the connection has -been determined." - (let* ((default-directory (or directory default-directory)) - (serv-buf (get-buffer-create - (nrepl-server-buffer-name - `(:project-dir ,default-directory))))) - (with-current-buffer serv-buf - (setq nrepl-is-server t - nrepl-project-dir default-directory - nrepl-server-command cmd - nrepl-on-port-callback on-port-callback)) - (let ((serv-proc (start-file-process-shell-command - "nrepl-server" serv-buf cmd))) - (set-process-filter serv-proc 'nrepl-server-filter) - (set-process-sentinel serv-proc 'nrepl-server-sentinel) - (set-process-coding-system serv-proc 'utf-8-unix 'utf-8-unix) - (message "[nREPL] Starting server via %s..." - (propertize cmd 'face 'font-lock-keyword-face)) - serv-proc))) - -(defun nrepl-server-filter (process output) - "Process nREPL server output from PROCESS contained in OUTPUT." - ;; 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 (and (null nrepl-endpoint) - (string-match "nREPL server started on port \\([0-9]+\\)" output)) - (let ((port (string-to-number (match-string 1 output)))) - (setq nrepl-endpoint (list :host (or (file-remote-p default-directory 'host) - "localhost") - :port port)) - (message "[nREPL] server started on %s" port) - (when nrepl-on-port-callback - (funcall nrepl-on-port-callback (process-buffer process))))))))) - -(declare-function cider--close-connection "cider-connection") -(defun nrepl-server-sentinel (process event) - "Handle nREPL server PROCESS EVENT." - (let* ((server-buffer (process-buffer process)) - (clients (seq-filter (lambda (b) - (eq (buffer-local-value 'nrepl-server-buffer b) - server-buffer)) - (buffer-list))) - (problem (if (and server-buffer (buffer-live-p server-buffer)) - (with-current-buffer server-buffer - (buffer-substring (point-min) (point-max))) - ""))) - (when server-buffer - (kill-buffer server-buffer)) - (cond - ((string-match-p "^killed\\|^interrupt" event) - nil) - ((string-match-p "^hangup" event) - (mapc #'cider--close-connection clients)) - ;; On Windows, a failed start sends the "finished" event. On Linux it sends - ;; "exited abnormally with code 1". - (t (error "Could not start nREPL server: %s" problem))))) - - -;;; Messages - -(defcustom nrepl-log-messages nil - "If non-nil, log protocol messages to an nREPL messages buffer. -This is extremely useful for debug purposes, as it allows you to inspect -the communication between Emacs and an nREPL server. Enabling the logging -might have a negative impact on performance, so it's not recommended to -keep it enabled unless you need to debug something." - :type 'boolean - :group 'nrepl - :safe #'booleanp) - -(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 "RET") #'nrepl-log-expand-button) - (define-key map (kbd "e") #'nrepl-log-expand-button) - (define-key map (kbd "E") #'nrepl-log-expand-all-buttons) - (define-key map (kbd "<backtab>") #'backward-button) - map)) - -(define-derived-mode nrepl-messages-mode special-mode "nREPL Messages" - "Major mode for displaying nREPL messages. - -\\{nrepl-messages-mode-map}" - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local sesman-system 'CIDER) - (setq-local electric-indent-chars nil) - (setq-local comment-start ";") - (setq-local comment-end "") - (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 - ;; append a time-stamp to the message before logging it - ;; the time-stamps are quite useful for debugging - (setq msg (cons (car msg) - (lax-plist-put (cdr msg) "time-stamp" - (format-time-string "%Y-%m-%0d %H:%M:%S.%N")))) - (with-current-buffer (nrepl-messages-buffer (current-buffer)) - (setq buffer-read-only nil) - (when (> (buffer-size) nrepl-message-buffer-max-size) - (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-log-pp-object (nrepl-decorate-msg msg type) - (nrepl-log--message-color (lax-plist-get (cdr msg) "id")) - t) - (when-let* ((win (get-buffer-window))) - (set-window-point win (point-max))) - (setq buffer-read-only t)))) - -(defun nrepl-toggle-message-logging () - "Toggle the value of `nrepl-log-messages' between nil and t. - -This in effect enables or disables the logging of nREPL messages." - (interactive) - (setq nrepl-log-messages (not nrepl-log-messages)) - (if nrepl-log-messages - (message "nREPL message logging enabled") - (message "nREPL message logging disabled"))) - -(defcustom nrepl-message-colors - '("red" "brown" "coral" "orange" "green" "deep sky blue" "blue" "dark violet") - "Colors used in the messages buffer." - :type '(repeat color) - :group 'nrepl) - -(defun nrepl-log-expand-button (&optional button) - "Expand the objects hidden in BUTTON's :nrepl-object property. -BUTTON defaults the button at point." - (interactive) - (if-let* ((button (or button (button-at (point))))) - (let* ((start (overlay-start button)) - (end (overlay-end button)) - (obj (overlay-get button :nrepl-object)) - (inhibit-read-only t)) - (save-excursion - (goto-char start) - (delete-overlay button) - (delete-region start end) - (nrepl-log-pp-object obj) - (delete-char -1))) - (error "No button at point"))) - -(defun nrepl-log-expand-all-buttons () - "Expand all buttons in nREPL log buffer." - (interactive) - (if (not (eq major-mode 'nrepl-messages-mode)) - (user-error "Not in a `nrepl-messages-mode'") - (save-excursion - (let* ((pos (point-min)) - (button (next-button pos))) - (while button - (setq pos (overlay-start button)) - (nrepl-log-expand-button button) - (setq button (next-button pos))))))) - -(defun nrepl-log--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-log-expand-button (button-at point)))))) - -(defun nrepl-log-insert-button (label object) - "Insert button with LABEL and :nrepl-object property as OBJECT." - (insert-button label - :nrepl-object object - 'action #'nrepl-log-expand-button - 'face 'link - 'help-echo "RET: Expand object." - ;; Workaround for bug#1568 (don't use local-map here; it - ;; overwrites major mode map.) - 'keymap `(keymap (mouse-1 . nrepl-log--expand-button-mouse))) - (insert "\n")) - -(defun nrepl-log--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)))) - -(defun nrepl-log--pp-listlike (object &optional foreground button) - "Pretty print nREPL list like OBJECT. -FOREGROUND and BUTTON are as in `nrepl-log-pp-object'." - (cl-flet ((color (str) - (propertize str 'face - (append '(:weight ultra-bold) - (when foreground `(:foreground ,foreground)))))) - (let ((head (format "(%s" (car object)))) - (insert (color head)) - (if (null (cdr object)) - (insert ")\n") - (let* ((indent (+ 2 (- (current-column) (length head)))) - (sorted-pairs (sort (seq-partition (cl-copy-list (cdr object)) 2) - (lambda (a b) - (string< (car a) (car b))))) - (name-lengths (seq-map (lambda (pair) (length (car pair))) sorted-pairs)) - (longest-name (seq-max name-lengths)) - ;; Special entries are displayed first - (specialq (lambda (pair) (seq-contains '("id" "op" "session" "time-stamp") (car pair)))) - (special-pairs (seq-filter specialq sorted-pairs)) - (not-special-pairs (seq-remove specialq sorted-pairs)) - (all-pairs (seq-concatenate 'list special-pairs not-special-pairs)) - (sorted-object (apply 'seq-concatenate 'list all-pairs))) - (insert "\n") - (cl-loop for l on sorted-object by #'cddr - do (let ((indent-str (make-string indent ?\s)) - (name-str (propertize (car l) 'face - ;; Only highlight top-level keys. - (unless (eq (car object) 'dict) - 'font-lock-keyword-face))) - (spaces-str (make-string (- longest-name (length (car l))) ?\s))) - (insert (format "%s%s%s " indent-str name-str spaces-str)) - (nrepl-log-pp-object (cadr l) nil button))) - (when (eq (car object) 'dict) - (delete-char -1)) - (insert (color ")\n"))))))) - -(defun nrepl-log-pp-object (object &optional foreground button) - "Pretty print nREPL OBJECT, delimited using FOREGROUND. -If BUTTON is non-nil, try making a button from OBJECT instead of inserting -it into the buffer." - (let ((min-dict-fold-size 1) - (min-list-fold-size 10) - (min-string-fold-size 60)) - (if-let* ((head (car-safe object))) - ;; list-like objects - (cond - ;; top level dicts (always expanded) - ((memq head '(<-- -->)) - (nrepl-log--pp-listlike object foreground button)) - ;; inner dicts - ((eq head 'dict) - (if (and button (> (length object) min-dict-fold-size)) - (nrepl-log-insert-button "(dict ...)" object) - (nrepl-log--pp-listlike object foreground button))) - ;; lists - (t - (if (and button (> (length object) min-list-fold-size)) - (nrepl-log-insert-button (format "(%s ...)" (prin1-to-string head)) object) - (pp object (current-buffer))))) - ;; non-list objects - (if (stringp object) - (if (and button (> (length object) min-string-fold-size)) - (nrepl-log-insert-button (format "\"%s...\"" (substring object 0 min-string-fold-size)) object) - (insert (prin1-to-string object) "\n")) - (pp object (current-buffer)) - (insert "\n"))))) - -(defun nrepl-messages-buffer (conn) - "Return or create the buffer for CONN. -The default buffer name is *nrepl-messages connection*." - (with-current-buffer conn - (or (and (buffer-live-p nrepl-messages-buffer) - nrepl-messages-buffer) - (setq nrepl-messages-buffer - (let ((buffer (get-buffer-create - (nrepl-messages-buffer-name - (cider--gather-connect-params))))) - (with-current-buffer buffer - (buffer-disable-undo) - (nrepl-messages-mode) - buffer)))))) - -(defun nrepl-error-buffer () - "Return or create the buffer. -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))) - -(make-obsolete 'nrepl-default-client-buffer-builder nil "0.18") - -(provide 'nrepl-client) - -;;; nrepl-client.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-client.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-client.elc deleted file mode 100644 index 5c883288349f..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-client.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-dict.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-dict.el deleted file mode 100644 index be143860c397..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/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-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.com> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;; -;; This file is not part of GNU Emacs. -;; -;;; Commentary: -;; -;; 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) - `(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 `(,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/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-dict.elc b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-dict.elc deleted file mode 100644 index af75eb64f0b2..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-dict.elc +++ /dev/null Binary files differ |