diff options
| author | William Carroll <wpcarro@gmail.com> | 2018-10-02T13·54-0400 |
|---|---|---|
| committer | William Carroll <wpcarro@gmail.com> | 2018-10-02T13·54-0400 |
| commit | 9da3ffee41fa481a404a5fb19b7128d557df6114 (patch) | |
| tree | abac717a4d44360910233bd6a7dc7ad956f2440a /configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925 | |
| parent | de97c7bcd0ed4b4877c1ae70e86cb37386755a37 (diff) | |
Update Emacs packages
This is a massive diff that I had to do in a hurry - when leaving Urbint. I'm pretty sure that most of these are updating Emacs packages, but I'm not positive.
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925')
74 files changed, 18631 insertions, 0 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 new file mode 100644 index 000000000000..97be9aa62a36 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-apropos.el @@ -0,0 +1,208 @@ +;;; 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 new file mode 100644 index 000000000000..1b2d8c643e3c --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-apropos.elc 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 new file mode 100644 index 000000000000..244e2ecbc759 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-autoloads.el @@ -0,0 +1,637 @@ +;;; 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 new file mode 100644 index 000000000000..6f7353532b9a --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-ns.el @@ -0,0 +1,232 @@ +;;; 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 new file mode 100644 index 000000000000..e452c7e4a28c --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-ns.elc 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 new file mode 100644 index 000000000000..d58352b16896 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-spec.el @@ -0,0 +1,357 @@ +;;; cider-browse-spec.el --- CIDER spec browser + +;; Copyright © 2017 Juan Monetta, Bozhidar Batsov and CIDER contributors + +;; Author: Juan Monetta <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 new file mode 100644 index 000000000000..a7b18881b3ba --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-browse-spec.elc 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 new file mode 100644 index 000000000000..d870c5a5a822 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-cheatsheet.el @@ -0,0 +1,577 @@ +;;; cider-cheatsheet.el --- Quick reference for Clojure -*- lexical-binding: t -*- + +;; Copyright © 2018 Kris Jenkins, Bozhidar Batsov and CIDER contributors +;; +;; Author: Kris Jenkins <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 new file mode 100644 index 000000000000..238c9f5cec58 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-cheatsheet.elc 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 new file mode 100644 index 000000000000..101413705cb4 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-classpath.el @@ -0,0 +1,112 @@ +;;; 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 new file mode 100644 index 000000000000..a8ce2b63f683 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-classpath.elc 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 new file mode 100644 index 000000000000..1e09bae2e299 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-client.el @@ -0,0 +1,577 @@ +;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov +;; +;; Author: Bozhidar Batsov <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 new file mode 100644 index 000000000000..d8300d3299cc --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-client.elc 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 new file mode 100644 index 000000000000..48a274468377 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-common.el @@ -0,0 +1,375 @@ +;;; 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 new file mode 100644 index 000000000000..c7a2b9e66ef7 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-common.elc 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 new file mode 100644 index 000000000000..e6b64b287c0b --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-compat.el @@ -0,0 +1,54 @@ +;;; cider-compat.el --- Functions from newer Emacs versions for compatibility -*- lexical-binding: t -*- + +;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <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 new file mode 100644 index 000000000000..be6816c977df --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-compat.elc 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 new file mode 100644 index 000000000000..c52769eec9cb --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-completion.el @@ -0,0 +1,253 @@ +;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov <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 new file mode 100644 index 000000000000..688ce414a05d --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-completion.elc 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 new file mode 100644 index 000000000000..959b78e50206 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-connection.el @@ -0,0 +1,799 @@ +;;; 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 new file mode 100644 index 000000000000..c467959da491 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-connection.elc 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 new file mode 100644 index 000000000000..7ea5b875008c --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-debug.el @@ -0,0 +1,755 @@ +;;; 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 new file mode 100644 index 000000000000..ecfce4d3fcb9 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-debug.elc 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 new file mode 100644 index 000000000000..5cca0505639d --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-doc.el @@ -0,0 +1,533 @@ +;;; 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 new file mode 100644 index 000000000000..5c7fc0320ec4 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-doc.elc 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 new file mode 100644 index 000000000000..b055824df3df --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el @@ -0,0 +1,481 @@ +;;; 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 new file mode 100644 index 000000000000..db499612c29c --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.elc 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 new file mode 100644 index 000000000000..67f2706ba34e --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.el @@ -0,0 +1,1115 @@ +;;; 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 new file mode 100644 index 000000000000..a054e3a55e60 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eval.elc 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 new file mode 100644 index 000000000000..fb4969c18302 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-find.el @@ -0,0 +1,236 @@ +;;; 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 new file mode 100644 index 000000000000..fbc6a6b98da5 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-find.elc 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 new file mode 100644 index 000000000000..0aa9e8f0c488 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-format.el @@ -0,0 +1,150 @@ +;;; cider-format.el --- Code and EDN formatting functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov <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 new file mode 100644 index 000000000000..4a995a4eacdc --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-format.elc 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 new file mode 100644 index 000000000000..c07614ba59d5 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-grimoire.el @@ -0,0 +1,130 @@ +;;; 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 new file mode 100644 index 000000000000..43d26d33f0d8 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-grimoire.elc 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 new file mode 100644 index 000000000000..61d5007db036 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-inspector.el @@ -0,0 +1,397 @@ +;;; 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 new file mode 100644 index 000000000000..5bebf64b1db3 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-inspector.elc 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 new file mode 100644 index 000000000000..8123932a3495 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-macroexpansion.el @@ -0,0 +1,206 @@ +;;; 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 new file mode 100644 index 000000000000..ab51790181d8 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-macroexpansion.elc 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 new file mode 100644 index 000000000000..8258f05c6649 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-mode.el @@ -0,0 +1,1043 @@ +;;; 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 new file mode 100644 index 000000000000..1af6775f3c6f --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-mode.elc 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 new file mode 100644 index 000000000000..bcb843eef880 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-ns.el @@ -0,0 +1,265 @@ +;;; cider-ns.el --- Namespace manipulation functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov <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 new file mode 100644 index 000000000000..4177064c27cc --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-ns.elc 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 new file mode 100644 index 000000000000..1a92b35f484b --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-overlays.el @@ -0,0 +1,311 @@ +;;; 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 new file mode 100644 index 000000000000..1dbedb324c83 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-overlays.elc 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 new file mode 100644 index 000000000000..d9536af29023 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-pkg.el @@ -0,0 +1,23 @@ +(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 new file mode 100644 index 000000000000..274a0666b4dc --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-popup.el @@ -0,0 +1,137 @@ +;;; 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 new file mode 100644 index 000000000000..a65f7b3e7654 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-popup.elc 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 new file mode 100644 index 000000000000..79577910580c --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-profile.el @@ -0,0 +1,208 @@ +;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*- + +;; Copyright © 2014-2018 Edwin Watkeys and CIDER contributors + +;; Author: Edwin Watkeys <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 new file mode 100644 index 000000000000..ffa751b9d5b1 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-profile.elc 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 new file mode 100644 index 000000000000..f6cd4c86cd05 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl-history.el @@ -0,0 +1,726 @@ +;;; 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 new file mode 100644 index 000000000000..6a8716c9243e --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl-history.elc 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 new file mode 100644 index 000000000000..2d95cb30c570 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl.el @@ -0,0 +1,1747 @@ +;;; 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 new file mode 100644 index 000000000000..e4b8f04616a3 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-repl.elc 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 new file mode 100644 index 000000000000..3c2dc6fdf79a --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-resolve.el @@ -0,0 +1,130 @@ +;;; 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 new file mode 100644 index 000000000000..c1bd31c59b8b --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-resolve.elc 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 new file mode 100644 index 000000000000..f1c3e93d1cd0 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-scratch.el @@ -0,0 +1,98 @@ +;;; 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 new file mode 100644 index 000000000000..f6f0788fa7cc --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-scratch.elc 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 new file mode 100644 index 000000000000..a21032db0737 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-selector.el @@ -0,0 +1,166 @@ +;;; 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 new file mode 100644 index 000000000000..7921110b39c8 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-selector.elc 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 new file mode 100644 index 000000000000..321d4bbdeb0b --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-stacktrace.el @@ -0,0 +1,910 @@ +;;; 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 new file mode 100644 index 000000000000..21e88b2cf1f2 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-stacktrace.elc 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 new file mode 100644 index 000000000000..bce6b4c066b2 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-test.el @@ -0,0 +1,825 @@ +;;; 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 new file mode 100644 index 000000000000..3d1d7b0c2a1c --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-test.elc 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 new file mode 100644 index 000000000000..c00e7b7f9877 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-tracing.el @@ -0,0 +1,90 @@ +;;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov <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 new file mode 100644 index 000000000000..0a351a37326f --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-tracing.elc 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 new file mode 100644 index 000000000000..6737b97eec4f --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-util.el @@ -0,0 +1,791 @@ +;; 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 new file mode 100644 index 000000000000..7b078e906ea6 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-util.elc 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 new file mode 100644 index 000000000000..ed11fff95abf --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider.el @@ -0,0 +1,1447 @@ +;;; 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 new file mode 100644 index 000000000000..8cd342afe0d1 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider.elc 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 new file mode 100644 index 000000000000..056a8540a034 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-client.el @@ -0,0 +1,1343 @@ +;;; 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 new file mode 100644 index 000000000000..5c883288349f --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-client.elc 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 new file mode 100644 index 000000000000..be143860c397 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-dict.el @@ -0,0 +1,187 @@ +;;; 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 new file mode 100644 index 000000000000..af75eb64f0b2 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/nrepl-dict.elc Binary files differ |