From: Andreas Gerler Date: Tue, 22 Jan 2019 15:17:02 +0000 (+0100) Subject: Update cider. X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=4fb45c100ac01258efb492d3c252f95e43e6cd9e;p=emacsconfig.git Update cider. Signed-off-by: Andreas Gerler --- diff --git a/elpa/cider-20181110.1413/cider-apropos.el b/elpa/cider-20181110.1413/cider-apropos.el deleted file mode 100644 index 97be9aa6..00000000 --- a/elpa/cider-20181110.1413/cider-apropos.el +++ /dev/null @@ -1,208 +0,0 @@ -;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors -;; -;; Author: Jeff Valk - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Apropos functionality for Clojure. - -;;; Code: - -(require 'cider-doc) -(require 'cider-util) -(require '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 nil t)." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (cider-apropos (read-string "Search for Clojure documentation (a regular expression): ") nil t)) - -(defun cider-apropos-act-on-symbol (symbol) - "Apply selected action on SYMBOL." - (let* ((first-action-key (car (car cider-apropos-actions))) - (action-key (if (= 1 (length cider-apropos-actions)) - first-action-key - (completing-read (format "Choose action to apply to `%s` (default %s): " - symbol first-action-key) - cider-apropos-actions nil nil nil nil first-action-key))) - (action-fn (cdr (assoc action-key cider-apropos-actions)))) - (if action-fn - (funcall action-fn symbol) - (user-error "Unknown action `%s`" action-key)))) - -;;;###autoload -(defun cider-apropos-select (query &optional ns docs-p privates-p case-sensitive-p) - "Similar to `cider-apropos', but presents the results in a completing read. -Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P)." - (interactive - (cons (read-string "Search for Clojure symbol (a regular expression): ") - (when current-prefix-arg - (list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list)))) - (if (string= ns "") nil ns)) - (y-or-n-p "Search doc strings? ") - (y-or-n-p "Include private symbols? ") - (y-or-n-p "Case-sensitive? "))))) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (if-let* ((summary (cider-apropos-summary - query ns docs-p privates-p case-sensitive-p)) - (results (mapcar (lambda (r) (nrepl-dict-get r "name")) - (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))) - (cider-apropos-act-on-symbol (completing-read (concat summary ": ") results)) - (message "No apropos matches for %S" query))) - -;;;###autoload -(defun cider-apropos-documentation-select () - "Shortcut for (cider-apropos-select nil t)." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (cider-apropos-select (read-string "Search for Clojure documentation (a regular expression): ") nil t)) - -(provide 'cider-apropos) - -;;; cider-apropos.el ends here diff --git a/elpa/cider-20181110.1413/cider-autoloads.el b/elpa/cider-20181110.1413/cider-autoloads.el deleted file mode 100644 index 56c25811..00000000 --- a/elpa/cider-20181110.1413/cider-autoloads.el +++ /dev/null @@ -1,772 +0,0 @@ -;;; cider-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "cider" "cider.el" (0 0 0 0)) -;;; Generated autoloads from cider.el - -(autoload 'cider-version "cider" "\ -Display CIDER's version. - -\(fn)" t nil) - (autoload 'cider-start-map "cider" "CIDER jack-in and connect keymap." t 'keymap) - -(autoload 'cider-jack-in-clj "cider" "\ -Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. -With the prefix argument, prompt for all these parameters. - -\(fn PARAMS)" t nil) - -(autoload 'cider-jack-in-cljs "cider" "\ -Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, -prompt for all these parameters. - -\(fn PARAMS)" t nil) - -(autoload 'cider-jack-in-clj&cljs "cider" "\ -Start an nREPL server and connect with clj and cljs REPLs. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, -prompt for all these parameters. When SOFT-CLJS-START is non-nil, start -cljs REPL only when the ClojureScript dependencies are met. - -\(fn &optional PARAMS SOFT-CLJS-START)" t nil) - -(autoload 'cider-connect-sibling-clj "cider" "\ -Create a Clojure REPL with the same server as OTHER-REPL. -PARAMS is for consistency with other connection commands and is currently -ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can -also be a server buffer, in which case a new session with a REPL for that -server is created. - -\(fn PARAMS &optional OTHER-REPL)" t nil) - -(autoload 'cider-connect-sibling-cljs "cider" "\ -Create a ClojureScript REPL with the same server as OTHER-REPL. -PARAMS is a plist optionally containing :cljs-repl-type (e.g. Node, -Figwheel, etc). All other parameters are inferred from the OTHER-REPL. -OTHER-REPL defaults to `cider-current-repl' but in programs can also be a -server buffer, in which case a new session for that server is created. - -\(fn PARAMS &optional OTHER-REPL)" t nil) - -(autoload 'cider-connect-clj "cider" "\ -Initialize a Clojure connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port and :project-dir. On -prefix argument, prompt for all the parameters. - -\(fn &optional PARAMS)" t nil) - -(autoload 'cider-connect-cljs "cider" "\ -Initialize a ClojureScript connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. Node, Figwheel, etc). On prefix, prompt for all the -parameters regardless of their supplied or default values. - -\(fn &optional PARAMS)" t nil) - -(autoload 'cider-connect-clj&cljs "cider" "\ -Initialize a Clojure and ClojureScript connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is -non-nil, don't start if ClojureScript requirements are not met. - -\(fn PARAMS &optional SOFT-CLJS-START)" t nil) - -(autoload 'cider "cider" "\ -Start a connection of any type interactively. - -\(fn)" t nil) - -(defalias 'cider-jack-in #'cider-jack-in-clj) - -(defalias 'cider-jack-in-clojure #'cider-jack-in-clj) - -(defalias 'cider-jack-in-clojurescript #'cider-jack-in-cljs) - -(defalias 'cider-connect #'cider-connect-clj) - -(defalias 'cider-connect-clojure #'cider-connect-clj) - -(defalias 'cider-connect-clojurescript #'cider-connect-cljs) - -(defalias 'cider-connect-sibling-clojure #'cider-connect-sibling-clj) - -(defalias 'cider-connect-sibling-clojurescript #'cider-connect-sibling-cljs) - -(with-eval-after-load 'clojure-mode (define-key clojure-mode-map (kbd "C-c M-x") #'cider) (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) (require 'sesman) (sesman-install-menu clojure-mode-map) (add-hook 'clojure-mode-hook (lambda nil (setq-local sesman-system 'CIDER)))) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-apropos" "cider-apropos.el" (0 0 0 0)) -;;; Generated autoloads from cider-apropos.el - -(autoload 'cider-apropos "cider-apropos" "\ -Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). - -\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) - -(autoload 'cider-apropos-documentation "cider-apropos" "\ -Shortcut for (cider-apropos nil t). - -\(fn)" t nil) - -(autoload 'cider-apropos-select "cider-apropos" "\ -Similar to `cider-apropos', but presents the results in a completing read. -Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). - -\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) - -(autoload 'cider-apropos-documentation-select "cider-apropos" "\ -Shortcut for (cider-apropos-select nil t). - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-apropos" '("cider-" "apropos-special-form"))) - -;;;*** - -;;;### (autoloads nil "cider-browse-ns" "cider-browse-ns.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from cider-browse-ns.el - -(autoload 'cider-browse-ns "cider-browse-ns" "\ -List all NAMESPACE's vars in BUFFER. - -\(fn NAMESPACE)" t nil) - -(autoload 'cider-browse-ns-all "cider-browse-ns" "\ -List all loaded namespaces in BUFFER. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-browse-ns" '("cider-browse-ns-"))) - -;;;*** - -;;;### (autoloads nil "cider-browse-spec" "cider-browse-spec.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cider-browse-spec.el - -(autoload 'cider-browse-spec "cider-browse-spec" "\ -Browse SPEC definition. - -\(fn SPEC)" t nil) - -(autoload 'cider-browse-spec-all "cider-browse-spec" "\ -Open list of specs in a popup buffer. - -With a prefix argument ARG, prompts for a regexp to filter specs. -No filter applied if the regexp is the empty string. - -\(fn &optional ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-browse-spec" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-cheatsheet" "cider-cheatsheet.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from cider-cheatsheet.el - -(autoload 'cider-cheatsheet "cider-cheatsheet" "\ -Navigate `cider-cheatsheet-hierarchy' with `completing-read'. - -When you make it to a Clojure var its doc buffer gets displayed. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-cheatsheet" '("cider-cheatsheet-"))) - -;;;*** - -;;;### (autoloads nil "cider-classpath" "cider-classpath.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from cider-classpath.el - -(autoload 'cider-classpath "cider-classpath" "\ -List all classpath entries. - -\(fn)" t nil) - -(autoload 'cider-open-classpath-entry "cider-classpath" "\ -Open a classpath entry. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-classpath" '("cider-classpath-"))) - -;;;*** - -;;;### (autoloads nil "cider-client" "cider-client.el" (0 0 0 0)) -;;; Generated autoloads from cider-client.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-client" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-common" "cider-common.el" (0 0 0 0)) -;;; Generated autoloads from cider-common.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-common" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-completion" "cider-completion.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from cider-completion.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-completion" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-connection" "cider-connection.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from cider-connection.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-connection" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-debug" "cider-debug.el" (0 0 0 0)) -;;; Generated autoloads from cider-debug.el - -(autoload 'cider-debug-defun-at-point "cider-debug" "\ -Instrument the \"top-level\" expression at point. -If it is a defn, dispatch the instrumented definition. Otherwise, -immediately evaluate the instrumented expression. - -While debugged code is being evaluated, the user is taken through the -source code and displayed the value of various expressions. At each step, -a number of keys will be prompted to the user. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-debug" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-doc" "cider-doc.el" (0 0 0 0)) -;;; Generated autoloads from cider-doc.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-doc" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-eldoc" "cider-eldoc.el" (0 0 0 0)) -;;; Generated autoloads from cider-eldoc.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-eldoc" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-eval" "cider-eval.el" (0 0 0 0)) -;;; Generated autoloads from cider-eval.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-eval" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-find" "cider-find.el" (0 0 0 0)) -;;; Generated autoloads from cider-find.el - -(autoload 'cider-find-var "cider-find" "\ -Find definition for VAR at LINE. -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point. - -\(fn &optional ARG VAR LINE)" t nil) - -(autoload 'cider-find-dwim-at-mouse "cider-find" "\ -Find and display variable or resource at mouse EVENT. - -\(fn EVENT)" t nil) - -(autoload 'cider-find-dwim "cider-find" "\ -Find and display the SYMBOL-FILE at point. -SYMBOL-FILE could be a var or a resource. If thing at point is empty then -show dired on project. If var is not found, try to jump to resource of the -same name. When called interactively, a prompt is given according to the -variable `cider-prompt-for-symbol'. A single or double prefix argument -inverts the meaning. A prefix of `-' or a double prefix argument causes -the results to be displayed in a different window. A default value of thing -at point is given when prompted. - -\(fn SYMBOL-FILE)" t nil) - -(autoload 'cider-find-resource "cider-find" "\ -Find the resource at PATH. -Prompt for input as indicated by the variable `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix -argument causes the results to be displayed in other window. The default -value is thing at point. - -\(fn PATH)" t nil) - -(autoload 'cider-find-ns "cider-find" "\ -Find the file containing NS. -A prefix ARG of `-` or a double prefix argument causes -the results to be displayed in a different window. - -\(fn &optional ARG NS)" t nil) - -(autoload 'cider-find-keyword "cider-find" "\ -Find the namespace of the keyword at point and its first occurrence there. - -For instance - if the keyword at point is \":cider.demo/keyword\", this command -would find the namespace \"cider.demo\" and afterwards find the first mention -of \"::keyword\" there. - -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point. - -\(fn &optional ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-find" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-format" "cider-format.el" (0 0 0 0)) -;;; Generated autoloads from cider-format.el - -(autoload 'cider-format-region "cider-format" "\ -Format the Clojure code in the current region. -START and END represent the region's boundaries. - -\(fn START END)" t nil) - -(autoload 'cider-format-defun "cider-format" "\ -Format the code in the current defun. - -\(fn)" t nil) - -(autoload 'cider-format-buffer "cider-format" "\ -Format the Clojure code in the current buffer. - -\(fn)" t nil) - -(autoload 'cider-format-edn-buffer "cider-format" "\ -Format the EDN data in the current buffer. - -\(fn)" t nil) - -(autoload 'cider-format-edn-region "cider-format" "\ -Format the EDN data in the current region. -START and END represent the region's boundaries. - -\(fn START END)" t nil) - -(autoload 'cider-format-edn-last-sexp "cider-format" "\ -Format the EDN data of the last sexp. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-format" '("cider--format-"))) - -;;;*** - -;;;### (autoloads nil "cider-grimoire" "cider-grimoire.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from cider-grimoire.el - -(autoload 'cider-grimoire-web "cider-grimoire" "\ -Open grimoire documentation in the default web browser. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -\(fn &optional ARG)" t nil) - -(autoload 'cider-grimoire "cider-grimoire" "\ -Open grimoire documentation in a popup buffer. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -\(fn &optional ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-grimoire" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-inspector" "cider-inspector.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from cider-inspector.el - -(autoload 'cider-inspect-last-sexp "cider-inspector" "\ -Inspect the result of the the expression preceding point. - -\(fn)" t nil) - -(autoload 'cider-inspect-defun-at-point "cider-inspector" "\ -Inspect the result of the \"top-level\" expression at point. - -\(fn)" t nil) - -(autoload 'cider-inspect-last-result "cider-inspector" "\ -Inspect the most recent eval result. - -\(fn)" t nil) - -(autoload 'cider-inspect "cider-inspector" "\ -Inspect the result of the preceding sexp. - -With a prefix argument ARG it inspects the result of the \"top-level\" form. -With a second prefix argument it prompts for an expression to eval and inspect. - -\(fn &optional ARG)" t nil) - -(autoload 'cider-inspect-expr "cider-inspector" "\ -Evaluate EXPR in NS and inspect its value. -Interactively, EXPR is read from the minibuffer, and NS the -current buffer's namespace. - -\(fn EXPR NS)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-inspector" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-macroexpansion" "cider-macroexpansion.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cider-macroexpansion.el - -(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\ -Invoke \\=`macroexpand-1\\=` on the expression preceding point. -If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of -\\=`macroexpand-1\\=`. - -\(fn &optional PREFIX)" t nil) - -(autoload 'cider-macroexpand-all "cider-macroexpansion" "\ -Invoke \\=`macroexpand-all\\=` on the expression preceding point. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-macroexpansion" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-mode" "cider-mode.el" (0 0 0 0)) -;;; Generated autoloads from cider-mode.el - -(defvar cider-mode-line '(:eval (format " cider[%s]" (cider--modeline-info))) "\ -Mode line lighter for cider mode. - -The value of this variable is a mode line template as in -`mode-line-format'. See Info Node `(elisp)Mode Line Format' for details -about mode line templates. - -Customize this variable to change how cider mode displays its status in the -mode line. The default value displays the current connection. Set this -variable to nil to disable the mode line entirely.") - -(custom-autoload 'cider-mode-line "cider-mode" t) - -(with-eval-after-load 'clojure-mode (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map "Menu for Clojure mode.\n This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." `("CIDER" :visible (not cider-mode) ["Start a Clojure REPL" cider-jack-in-clj :help "Starts an nREPL server and connects a Clojure REPL to it."] ["Connect to a Clojure REPL" cider-connect-clj :help "Connects to a REPL that's already running."] ["Start a ClojureScript REPL" cider-jack-in-cljs :help "Starts an nREPL server and connects a ClojureScript REPL to it."] ["Connect to a ClojureScript REPL" cider-connect-cljs :help "Connects to a ClojureScript REPL that's already running."] ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clj&cljs :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] "--" ["View manual online" cider-view-manual]))) - -(autoload 'cider-mode "cider-mode" "\ -Minor mode for REPL interaction from a Clojure buffer. - -\\{cider-mode-map} - -\(fn &optional ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-mode" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-ns" "cider-ns.el" (0 0 0 0)) -;;; Generated autoloads from cider-ns.el - -(autoload 'cider-ns-reload "cider-ns" "\ -Send a (require 'ns :reload) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload forces loading of all the -identified libs even if they are already loaded\". - -\(fn &optional PROMPT)" t nil) - -(autoload 'cider-ns-reload-all "cider-ns" "\ -Send a (require 'ns :reload-all) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload-all implies :reload and -also forces loading of all libs that the identified libs directly or -indirectly load via require\". - -\(fn &optional PROMPT)" t nil) - -(autoload 'cider-ns-refresh "cider-ns" "\ -Reload modified and unloaded namespaces on the classpath. - -With a single prefix argument, or if MODE is `refresh-all', reload all -namespaces on the classpath unconditionally. - -With a double prefix argument, or if MODE is `clear', clear the state of -the namespace tracker before reloading. This is useful for recovering from -some classes of error (for example, those caused by circular dependencies) -that a normal reload would not otherwise recover from. The trade-off of -clearing is that stale code from any deleted files may not be completely -unloaded. - -With a negative prefix argument, or if MODE is `inhibit-fns', prevent any -refresh functions (defined in `cider-ns-refresh-before-fn' and -`cider-ns-refresh-after-fn') from being invoked. - -\(fn &optional MODE)" t nil) - -(define-obsolete-function-alias 'cider-refresh 'cider-ns-refresh "0.18") - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-ns" '("cider-ns-"))) - -;;;*** - -;;;### (autoloads nil "cider-overlays" "cider-overlays.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from cider-overlays.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-overlays" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-popup" "cider-popup.el" (0 0 0 0)) -;;; Generated autoloads from cider-popup.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-popup" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-profile" "cider-profile.el" (0 0 0 0)) -;;; Generated autoloads from cider-profile.el - -(autoload 'cider-profile-samples "cider-profile" "\ -Displays current max-sample-count. -If optional QUERY is specified, set max-sample-count and display new value. - -\(fn &optional QUERY)" t nil) - -(autoload 'cider-profile-var-profiled-p "cider-profile" "\ -Displays the profiling status of var under point. -Prompts for var if none under point or QUERY is present. - -\(fn QUERY)" t nil) - -(autoload 'cider-profile-ns-toggle "cider-profile" "\ -Toggle profiling for the ns associated with optional QUERY. - -If optional argument QUERY is non-nil, prompt for ns. Otherwise use -current ns. - -\(fn &optional QUERY)" t nil) - -(autoload 'cider-profile-toggle "cider-profile" "\ -Toggle profiling for the given QUERY. -Defaults to the symbol at point. -With prefix arg or no symbol at point, prompts for a var. - -\(fn QUERY)" t nil) - -(autoload 'cider-profile-summary "cider-profile" "\ -Display a summary of currently collected profile data. - -\(fn)" t nil) - -(autoload 'cider-profile-var-summary "cider-profile" "\ -Display profile data for var under point QUERY. -Defaults to the symbol at point. With prefix arg or no symbol at point, -prompts for a var. - -\(fn QUERY)" t nil) - -(autoload 'cider-profile-clear "cider-profile" "\ -Clear any collected profile data. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-profile" '("cider-profile-"))) - -;;;*** - -;;;### (autoloads nil "cider-repl" "cider-repl.el" (0 0 0 0)) -;;; Generated autoloads from cider-repl.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-repl" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-repl-history" "cider-repl-history.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from cider-repl-history.el - -(autoload 'cider-repl-history "cider-repl-history" "\ -Display items in the CIDER command history in another buffer. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-repl-history" '("cider-repl-history-"))) - -;;;*** - -;;;### (autoloads nil "cider-resolve" "cider-resolve.el" (0 0 0 0)) -;;; Generated autoloads from cider-resolve.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-resolve" '("cider-resolve-"))) - -;;;*** - -;;;### (autoloads nil "cider-scratch" "cider-scratch.el" (0 0 0 0)) -;;; Generated autoloads from cider-scratch.el - -(autoload 'cider-scratch "cider-scratch" "\ -Go to the scratch buffer named `cider-scratch-buffer-name'. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-scratch" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-selector" "cider-selector.el" (0 0 0 -;;;;;; 0)) -;;; Generated autoloads from cider-selector.el - -(autoload 'cider-selector "cider-selector" "\ -Select a new buffer by type, indicated by a single character. -The user is prompted for a single character indicating the method by -which to choose a new buffer. The `?' character describes then -available methods. OTHER-WINDOW provides an optional target. -See `def-cider-selector-method' for defining new methods. - -\(fn &optional OTHER-WINDOW)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-selector" '("??" "?c" "?e" "?q" "?r" "?m" "?x" "?p" "?d" "?s" "def-cider-selector-method" "cider-selector-"))) - -;;;*** - -;;;### (autoloads nil "cider-stacktrace" "cider-stacktrace.el" (0 -;;;;;; 0 0 0)) -;;; Generated autoloads from cider-stacktrace.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-stacktrace" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-test" "cider-test.el" (0 0 0 0)) -;;; Generated autoloads from cider-test.el - -(defvar cider-auto-test-mode nil "\ -Non-nil if Cider-Auto-Test mode is enabled. -See the `cider-auto-test-mode' command -for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `cider-auto-test-mode'.") - -(custom-autoload 'cider-auto-test-mode "cider-test" nil) - -(autoload 'cider-auto-test-mode "cider-test" "\ -Toggle automatic testing of Clojure files. - -When enabled this reruns tests every time a Clojure file is loaded. -Only runs tests corresponding to the loaded file's namespace and does -nothing if no tests are defined or if the file failed to load. - -\(fn &optional ARG)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-test" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-tracing" "cider-tracing.el" (0 0 0 0)) -;;; Generated autoloads from cider-tracing.el - -(autoload 'cider-toggle-trace-var "cider-tracing" "\ -Toggle var tracing. -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -\(fn ARG)" t nil) - -(autoload 'cider-toggle-trace-ns "cider-tracing" "\ -Toggle ns tracing. -Defaults to the current ns. With prefix arg QUERY, prompts for a ns. - -\(fn QUERY)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-tracing" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "cider-util" "cider-util.el" (0 0 0 0)) -;;; Generated autoloads from cider-util.el - -(autoload 'cider-view-manual "cider-util" "\ -View the manual in your default browser. - -\(fn)" t nil) - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-util" '("cider-"))) - -;;;*** - -;;;### (autoloads nil "nrepl-client" "nrepl-client.el" (0 0 0 0)) -;;; Generated autoloads from nrepl-client.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nrepl-client" '("nrepl-" "cider-enlighten-mode"))) - -;;;*** - -;;;### (autoloads nil "nrepl-dict" "nrepl-dict.el" (0 0 0 0)) -;;; Generated autoloads from nrepl-dict.el - -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nrepl-dict" '("nrepl-"))) - -;;;*** - -;;;### (autoloads nil nil ("cider-compat.el" "cider-pkg.el") (0 0 -;;;;;; 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; cider-autoloads.el ends here diff --git a/elpa/cider-20181110.1413/cider-browse-ns.el b/elpa/cider-20181110.1413/cider-browse-ns.el deleted file mode 100644 index 6f735353..00000000 --- a/elpa/cider-20181110.1413/cider-browse-ns.el +++ /dev/null @@ -1,232 +0,0 @@ -;;; cider-browse-ns.el --- CIDER namespace browser - -;; Copyright © 2014-2018 John Andrews, Bozhidar Batsov and CIDER contributors - -;; Author: John Andrews - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; M-x cider-browse-ns -;; -;; Display a list of all vars in a namespace. -;; Pressing will take you to the cider-doc buffer for that var. -;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode'). - -;; M-x cider-browse-ns-all -;; -;; Explore Clojure namespaces by browsing a list of all namespaces. -;; Pressing expands into a list of that namespace's vars as if by -;; executing the command (cider-browse-ns "my.ns"). - -;;; Code: - -(require 'cider-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/elpa/cider-20181110.1413/cider-browse-spec.el b/elpa/cider-20181110.1413/cider-browse-spec.el deleted file mode 100644 index d58352b1..00000000 --- a/elpa/cider-20181110.1413/cider-browse-spec.el +++ /dev/null @@ -1,357 +0,0 @@ -;;; cider-browse-spec.el --- CIDER spec browser - -;; Copyright © 2017 Juan Monetta, Bozhidar Batsov and CIDER contributors - -;; Author: Juan Monetta - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; M-x cider-browse-spec -;; -;; Display a spec description you can browse. -;; Pressing over a sub spec will take you to the description of that sub spec. -;; Pressing ^ takes you to the list of all specs. - -;; M-x cider-browse-spec-all -;; -;; Explore clojure.spec registry by browsing a list of all specs. -;; Pressing over a spec display the spec description you can browse. - -;;; Code: - -(require 'cider-client) -(require 'cider-compat) -(require 'cider-util) -(require 'cl-lib) -(require 'nrepl-dict) -(require 'seq) -(require 'subr-x) -(require 'help-mode) - -;; The buffer names used by the spec browser -(defconst cider-browse-spec-buffer "*cider-spec-browser*") -(defconst cider-browse-spec-example-buffer "*cider-spec-example*") - -;; Mode Definition - -(defvar cider-browse-spec-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (make-composed-keymap button-buffer-map - cider-popup-buffer-mode-map)) - (define-key map (kbd "RET") #'cider-browse-spec--browse-at) - (define-key map "n" #'forward-button) - (define-key map "p" #'backward-button) - map) - "Keymap for `cider-browse-spec-mode'.") - -(define-derived-mode cider-browse-spec-mode special-mode "Specs" - "Major mode for browsing Clojure specs. - -\\{cider-browse-spec-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -(defvar cider-browse-spec--current-spec nil) - -(defvar cider-browse-spec-view-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map help-mode-map) - (define-key map (kbd "RET") #'cider-browse-spec--browse-at) - (define-key map "^" #'cider-browse-spec-all) - (define-key map "e" #'cider-browse-spec--print-curr-spec-example) - (define-key map "n" #'forward-button) - (define-key map "p" #'backward-button) - map) - "Keymap for `cider-browse-spec-view-mode'.") - -(define-derived-mode cider-browse-spec-view-mode help-mode "Spec" - "Major mode for displaying CIDER spec. - -\\{cider-browse-spec-view-mode-map}" - (setq-local cider-browse-spec--current-spec nil) - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -(defvar cider-browse-spec-example-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map "^" #'cider-browse-spec-all) - (define-key map "e" #'cider-browse-spec--print-curr-spec-example) - (define-key map "g" #'revert-buffer) - map) - "Keymap for `cider-browse-spec-example-mode'.") - -(define-derived-mode cider-browse-spec-example-mode special-mode "Example" - "Major mode for Clojure spec examples. - -\\{cider-browse-spec-example-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -;; Non interactive functions - -(define-button-type 'cider-browse-spec--spec - 'action #'cider-browse-spec--browse-at - 'face nil - 'follow-link t - 'help-echo "View spec") - -(defun cider-browse-spec--draw-list-buffer (buffer title specs) - "Reset contents of BUFFER. -Display TITLE at the top and SPECS are indented underneath." - (with-current-buffer buffer - (cider-browse-spec-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (goto-char (point-max)) - (insert (cider-propertize title 'emph) "\n") - (dolist (spec-name specs) - (insert (propertize " " 'spec-name spec-name)) - (thread-first (cider-font-lock-as-clojure spec-name) - (insert-text-button 'type 'cider-browse-spec--spec) - (button-put 'spec-name spec-name)) - (insert (propertize "\n" 'spec-name spec-name))) - (goto-char (point-min))))) - -(defun cider--qualified-keyword-p (str) - "Return non nil if STR is a namespaced keyword." - (string-match-p "^:.+/.+$" str)) - -(defun cider--spec-fn-p (value fn-name) - "Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME." - (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\)/" fn-name "$") value)) - -(defun cider-browse-spec--pprint (form) - "Given a spec FORM builds a multi line string with a pretty render of that FORM." - (cond ((stringp form) - (if (cider--qualified-keyword-p form) - (with-temp-buffer - (thread-first form - (insert-text-button 'type 'cider-browse-spec--spec) - (button-put 'spec-name form)) - (buffer-string)) - ;; to make it easier to read replace all clojure.spec ns with s/ - ;; and remove all clojure.core ns - (thread-last form - (replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\)/" "s/") - (replace-regexp-in-string "^\\(clojure.core\\)/" "")))) - - ((and (listp form) (stringp (cl-first form))) - (let ((form-tag (cl-first form))) - (cond - ;; prettier fns #() - ((string-equal form-tag "clojure.core/fn") - (if (equal (cl-second form) '("%")) - (format "#%s" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))) - (format "(fn [%%] %s)" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))))) - ;; prettier (s/and ) - ((cider--spec-fn-p form-tag "and") - (format "(s/and\n%s)" (string-join (thread-last (cl-rest form) - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n"))) - ;; prettier (s/or ) - ((cider--spec-fn-p form-tag "or") - (let ((name-spec-pair (seq-partition (cl-rest form) 2))) - (format "(s/or\n%s)" (string-join - (thread-last name-spec-pair - (mapcar (lambda (s) (format "%s %s" (cl-first s) (cider-browse-spec--pprint (cl-second s)))))) - "\n")))) - ;; prettier (s/merge ) - ((cider--spec-fn-p form-tag "merge") - (format "(s/merge\n%s)" (string-join (thread-last (cl-rest form) - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n"))) - ;; prettier (s/keys ) - ((cider--spec-fn-p form-tag "keys") - (let ((keys-args (seq-partition (cl-rest form) 2))) - (format "(s/keys%s)" (thread-last - keys-args - (mapcar (lambda (s) - (let ((key-type (cl-first s)) - (specs-vec (cl-second s))) - (concat "\n" key-type - " [" - (string-join (thread-last specs-vec - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n") - "]")))) - (cl-reduce #'concat))))) - ;; prettier (s/multi-spec) - ((cider--spec-fn-p form-tag "multi-spec") - (let ((multi-method (cl-second form)) - (retag (cl-third form)) - (sub-specs (cl-rest (cl-rest (cl-rest form))))) - (format "(s/multi-spec %s %s\n%s)" - multi-method - retag - (string-join - (thread-last sub-specs - (mapcar (lambda (s) - (concat "\n\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) - "\n")))) - ;; prettier (s/cat ) - ((cider--spec-fn-p form-tag "cat") - (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) - (format "(s/cat %s)" - (thread-last name-spec-pairs - (mapcar (lambda (s) - (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat))))) - ;; prettier (s/alt ) - ((cider--spec-fn-p form-tag "alt") - (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) - (format "(s/alt %s)" - (thread-last name-spec-pairs - (mapcar (lambda (s) - (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat))))) - ;; prettier (s/fspec ) - ((cider--spec-fn-p form-tag "fspec") - (thread-last (seq-partition (cl-rest form) 2) - (cl-remove-if (lambda (s) (and (stringp (cl-second s)) - (string-empty-p (cl-second s))))) - (mapcar (lambda (s) - (format "\n%-11s: %s" (pcase (cl-first s) - (":args" "arguments") - (":ret" "returns") - (":fn" "invariants")) - (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat) - (format "%s"))) - ;; every other with no special management - (t (format "(%s %s)" - (cider-browse-spec--pprint form-tag) - (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " ")))))) - (t (format "%s" form)))) - -(defun cider-browse-spec--pprint-indented (spec-form) - "Indent (pretty-print) and font-lock SPEC-FORM. -Return the result as a string." - (with-temp-buffer - (clojure-mode) - (insert (cider-browse-spec--pprint spec-form)) - (indent-region (point-min) (point-max)) - (cider--font-lock-ensure) - (buffer-string))) - -(defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form) - "Reset contents of BUFFER and draws everything needed to browse the SPEC-FORM. -Display SPEC as a title and uses `cider-browse-spec--pprint' to display -a more user friendly representation of SPEC-FORM." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer) - (goto-char (point-max)) - (insert (cider-font-lock-as-clojure spec) "\n\n") - (insert (cider-browse-spec--pprint-indented spec-form)) - (cider--make-back-forward-xrefs) - (current-buffer)))) - -(defun cider-browse-spec--browse (spec) - "Browse SPEC." - (cider-ensure-connected) - (cider-ensure-op-supported "spec-form") - (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select #'cider-browse-spec-view-mode 'ancillary) - (setq-local cider-browse-spec--current-spec spec) - (cider-browse-spec--draw-spec-buffer (current-buffer) - spec - (cider-sync-request:spec-form spec)) - (goto-char (point-min)) - (current-buffer))) - -(defun cider-browse-spec--browse-at (&optional pos) - "View the definition of a spec. - -Optional argument POS is the position of a spec, defaulting to point. POS -may also be a button, so this function can be used a the button's `action' -property." - (interactive) - (let ((pos (or pos (point)))) - (when-let* ((spec (button-get pos 'spec-name))) - (cider-browse-spec--browse spec)))) - -;; Interactive Functions - -(defun cider-browse-spec--print-curr-spec-example () - "Generate and print an example of the current spec." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "spec-example") - (if-let* ((spec cider-browse-spec--current-spec)) - (if-let* ((example (cider-sync-request:spec-example spec))) - (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer 'select #'cider-browse-spec-example-mode 'ancillary) - (setq-local cider-browse-spec--current-spec spec) - (let ((inhibit-read-only t)) - (insert "Example of " (cider-font-lock-as-clojure spec)) - (insert "\n\n") - (insert (cider-font-lock-as-clojure example)) - (goto-char (point-min)))) - (error (format "No example for spec %s" spec))) - (error "No current spec"))) - -(defun cider-browse-spec--example-revert-buffer-function (&rest _) - "`revert-buffer' function for `cider-browse-spec-example-mode'. - -Generates a new example for the current spec." - (cider-browse-spec--print-curr-spec-example)) - -;;;###autoload -(defun cider-browse-spec (spec) - "Browse SPEC definition." - (interactive (list (completing-read "Browse spec: " - (cider-sync-request:spec-list) - nil nil - (cider-symbol-at-point)))) - (cider-browse-spec--browse spec)) - -(defun cider-browse-spec-regex (regex) - "Open the list of specs that matches REGEX in a popup buffer. -Displays all specs when REGEX is nil." - (cider-ensure-connected) - (cider-ensure-op-supported "spec-list") - (let ((filter-regex (or regex ""))) - (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select nil 'ancillary) - (let ((specs (cider-sync-request:spec-list filter-regex))) - (cider-browse-spec--draw-list-buffer (current-buffer) - (if (string-empty-p filter-regex) - "All specs in registry" - (format "All specs matching regex `%s' in registry" filter-regex)) - specs))))) - -;;;###autoload -(defun cider-browse-spec-all (&optional arg) - "Open list of specs in a popup buffer. - -With a prefix argument ARG, prompts for a regexp to filter specs. -No filter applied if the regexp is the empty string." - (interactive "P") - (cider-browse-spec-regex (if arg (read-string "Filter regex: ") ""))) - -(provide 'cider-browse-spec) - -;;; cider-browse-spec.el ends here diff --git a/elpa/cider-20181110.1413/cider-cheatsheet.el b/elpa/cider-20181110.1413/cider-cheatsheet.el deleted file mode 100644 index d870c5a5..00000000 --- a/elpa/cider-20181110.1413/cider-cheatsheet.el +++ /dev/null @@ -1,577 +0,0 @@ -;;; cider-cheatsheet.el --- Quick reference for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2018 Kris Jenkins, Bozhidar Batsov and CIDER contributors -;; -;; Author: Kris Jenkins - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A quick reference system for Clojure. Fast, searchable & available offline. - -;; Mostly taken from Kris Jenkins' `clojure-cheatsheet' -;; See: https://github.com/clojure-emacs/clojure-cheatsheet - -;;; Code: - -(require 'cider-doc) -(require 'seq) - -(defconst cider-cheatsheet-hierarchy - '(("Primitives" - ("Numbers" - ("Arithmetic" - (clojure.core + - * / quot rem mod dec inc max min)) - ("Compare" - (clojure.core = == not= < > <= >= compare)) - ("Bitwise" - (clojure.core bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set bit-shift-left bit-shift-right bit-test bit-xor unsigned-bit-shift-right)) - ("Cast" - (clojure.core byte short long int float double bigdec bigint biginteger num rationalize)) - ("Test" - (clojure.core nil? some? identical? zero? pos? neg? even? odd?)) - ("Random" - (clojure.core rand rand-int)) - ("BigDecimal" - (clojure.core with-precision)) - ("Ratios" - (clojure.core numerator denominator ratio?)) - ("Arbitrary Precision Arithmetic" - (clojure.core +\' -\' *\' inc\' dec\')) - ("Unchecked" - (clojure.core *unchecked-math* - unchecked-add - unchecked-add-int - unchecked-byte - unchecked-char - unchecked-dec - unchecked-dec-int - unchecked-divide-int - unchecked-double - unchecked-float - unchecked-inc - unchecked-inc-int - unchecked-int - unchecked-long - unchecked-multiply - unchecked-multiply-int - unchecked-negate - unchecked-negate-int - unchecked-remainder-int - unchecked-short - unchecked-subtract - unchecked-subtract-int))) - - ("Strings" - ("Create" - (clojure.core str format)) - ("Use" - (clojure.core count get subs compare) - (clojure.string join escape split split-lines replace replace-first reverse re-quote-replacement index-of last-index-of starts-with? ends-with? includes?)) - ("Regex" - (clojure.core re-find re-seq re-matches re-pattern re-matcher re-groups) - (clojure.string replace replace-first re-quote-replacement)) - ("Letters" - (clojure.string capitalize lower-case upper-case)) - ("Trim" - (clojure.string trim trim-newline triml trimr)) - ("Test" - (clojure.core char char? string?) - (clojure.string blank?))) - - ("Other" - ("Characters" - (clojure.core char char-name-string char-escape-string)) - ("Keywords" - (clojure.core keyword keyword? find-keyword)) - ("Symbols" - (clojure.core symbol symbol? gensym)) - ("Data Readers" - (clojure.core *data-readers* default-data-readers *default-data-reader-fn*)))) - - ("Collections" - ("Generic Ops" - (clojure.core count bounded-count empty not-empty into conj)) - ("Tree Walking" - (clojure.walk walk prewalk prewalk-demo prewalk-replace postwalk postwalk-demo postwalk-replace keywordize-keys stringify-keys)) - ("Content tests" - (clojure.core distinct? empty? every? not-every? some not-any?)) - ("Capabilities" - (clojure.core sequential? associative? sorted? counted? reversible?)) - ("Type tests" - (clojure.core type class coll? list? vector? set? map? seq? - number? integer? float? decimal? class? rational? ratio? - chunked-seq? reduced? special-symbol? record?)) - ("Lists" - ("Create" - (clojure.core list list*)) - ("Examine" - (clojure.core first nth peek)) - ("Change" - (clojure.core cons conj rest pop))) - - ("Vectors" - ("Create" - (clojure.core vec vector vector-of)) - ("Examine" - (clojure.core get peek)) - - ("Change" - (clojure.core assoc pop subvec replace conj rseq)) - ("Ops" - (clojure.core mapv filterv reduce-kv))) - - ("Sets" - ("Create" - (clojure.core set hash-set sorted-set sorted-set-by)) - ("Examine" - (clojure.core get contains?)) - ("Change" - (clojure.core conj disj)) - ("Relational Algebra" - (clojure.set join select project union difference intersection)) - ("Get map" - (clojure.set index rename-keys rename map-invert)) - ("Test" - (clojure.set subset? superset?)) - ("Sorted Sets" - (clojure.core rseq subseq rsubseq))) - - ("Maps" - ("Create" - (clojure.core hash-map array-map zipmap sorted-map sorted-map-by bean frequencies group-by)) - ("Examine" - (clojure.core get get-in contains? find keys vals map-entry?)) - ("Change" - (clojure.core assoc assoc-in dissoc merge merge-with select-keys update update-in)) - ("Entry" - (clojure.core key val)) - ("Sorted Maps" - (clojure.core rseq subseq rsubseq))) - - ("Hashes" - (clojure.core hash hash-ordered-coll hash-unordered-coll mix-collection-hash)) - - ("Volatiles" - (clojure.core volatile! volatile? vreset! vswap!))) - - ("Functions" - ("Create" - (clojure.core fn defn defn- definline identity constantly comp complement partial juxt memfn memoize fnil every-pred some-fn trampoline)) - ("Call" - (clojure.core -> ->> some-> some->> as-> cond-> cond->>)) - ("Test" - (clojure.core fn? ifn?))) - - ("Transducers" - ("Create" - (clojure.core cat dedupe distinct drop drop-while filter halt-when interpose keep keep-indexed map map-indexed mapcat partition-all partition-by random-sample remove replace take take-nth take-while)) - ("Call" - (clojure.core ->Eduction eduction into sequence transduce completing run!)) - ("Early Termination" - (clojure.core deref reduced reduced? ensure-reduced unreduced))) - - ("Spec" - ("Operations" - (clojure.spec.alpha valid? conform unform explain explain-data explain-str explain-out form describe assert check-asserts check-asserts?)) - ("Generator Ops" - (clojure.spec.alpha gen exercise exercise-fn)) - ("Defn & Registry" - (clojure.spec.alpha def fdef registry get-spec spec? spec with-gen)) - ("Logical" - (clojure.spec.alpha and or)) - ("Collection" - (clojure.spec.alpha coll-of map-of every every-kv keys merge)) - ("Regex " - (clojure.spec.alpha cat alt * + \? & keys*)) - ("Range" - (clojure.spec.alpha int-in inst-in double-in int-in-range? inst-in-range?)) - ("Custom Explain" - (clojure.spec.alpha explain-printer *explain-out*)) - ("Other" - (clojure.spec.alpha nilable multi-spec fspec conformer)) - - ("Predicates with test.check generators" - ("Numbers" - (clojure.core number? rational? integer? ratio? decimal? float? zero? double? int? nat-int? neg-int? pos-int?)) - ("Symbols & Keywords" - (clojure.core keyword? symbol? ident? qualified-ident? qualified-keyword? qualified-symbol? simple-ident? simple-keyword? simple-symbol?)) - ("Scalars" - (clojure.core string? true? false? nil? some? boolean? bytes? inst? uri? uuid?)) - ("Collections" - (clojure.core list? map? set? vector? associative? coll? sequential? seq? empty? indexed? seqable?)) - ("Other" - (clojure.core any?)))) - - ("Other" - ("XML" - (clojure.core xml-seq) - (clojure.xml parse)) - ("REPL" - (clojure.core *1 *2 *3 *e *print-dup* *print-length* *print-level* *print-meta* *print-readably*)) - ("EDN" - (clojure.edn read read-string)) - ("Compiling Code & Class Generation" - (clojure.core *compile-files* *compile-path* *file* *warn-on-reflection* compile gen-class gen-interface loaded-libs test)) - ("Misc" - (clojure.core eval force name *clojure-version* clojure-version *command-line-args*)) - ("Pretty Printing" - (clojure.pprint pprint print-table pp *print-right-margin*)) - ("Browser / Shell" - (clojure.java.browse browse-url) - (clojure.java.shell sh with-sh-dir with-sh-env))) - - ("Vars & Global Environment" - ("Def Variants" - (:special def) - (clojure.core defn defn- definline defmacro defmethod defmulti defonce defrecord)) - ("Interned Vars" - (:special var) - (clojure.core declare intern binding find-var)) - ("Var Objects" - (clojure.core with-local-vars var-get var-set alter-var-root var?)) - ("Var Validators" - (clojure.core set-validator! get-validator))) - - ("Reader Conditionals" - (clojure.core reader-conditional reader-conditional? tagged-literal tagged-literal?)) - - ("Abstractions" - ("Protocols" - (clojure.core defprotocol extend extend-type extend-protocol reify extends? satisfies? extenders)) - ("Records & Types" - (clojure.core defrecord deftype)) - ("Multimethods" - ("Define" - (clojure.core defmulti defmethod)) - ("Dispatch" - (clojure.core get-method methods)) - ("Remove" - (clojure.core remove-method remove-all-methods)) - ("Prefer" - (clojure.core prefer-method prefers)) - ("Relation" - (clojure.core derive isa? parents ancestors descendants make-hierarchy)))) - - ("Macros" - ("Create" - (clojure.core defmacro definline)) - ("Debug" - (clojure.core macroexpand-1 macroexpand) - (clojure.walk macroexpand-all)) - ("Branch" - (clojure.core and or when when-not when-let when-first if-not if-let cond condp case)) - ("Loop" - (clojure.core for doseq dotimes while)) - ("Arrange" - (clojure.core .. doto ->)) - ("Scope" - (clojure.core binding locking time) - (clojure.core with-in-str with-local-vars with-open with-out-str with-precision with-redefs with-redefs-fn)) - ("Lazy" - (clojure.core lazy-cat lazy-seq delay delay?)) - ("Doc" - (clojure.core assert comment) - (clojure.repl doc dir dir-fn source-fn))) - - ("Java Interop" - ("General" - (:special new set!) - (clojure.core .. doto bean comparator enumeration-seq import iterator-seq memfn definterface supers bases)) - ("Cast" - (clojure.core boolean byte short char int long float double bigdec bigint num cast biginteger)) - ("Exceptions" - (:special throw try catch finally) - (clojure.core ex-info ex-data Throwable->map StackTraceElement->vec) - (clojure.repl pst)) - ("Arrays" - ("Create" - (clojure.core boolean-array byte-array double-array char-array float-array int-array long-array make-array object-array short-array to-array)) - ("Manipulate" - (clojure.core aclone aget aset alength amap areduce aset-int aset-long aset-short aset-boolean aset-byte aset-char aset-double aset-float)) - ("Cast" - (clojure.core booleans bytes chars doubles floats ints longs shorts))) - ("Proxy" - ("Create" - (clojure.core proxy get-proxy-class construct-proxy init-proxy)) - ("Misc" - (clojure.core proxy-mappings proxy-super update-proxy)))) - - ("Namespaces" - ("Current" - (clojure.core *ns*)) - ("Create Switch" - (clojure.core ns in-ns create-ns)) - ("Add" - (clojure.core alias import intern refer refer-clojure)) - ("Find" - (clojure.core all-ns find-ns)) - ("Examine" - (clojure.core ns-aliases ns-imports ns-interns ns-map ns-name ns-publics ns-refers)) - ("From symbol" - (clojure.core resolve namespace ns-resolve the-ns)) - ("Remove" - (clojure.core ns-unalias ns-unmap remove-ns))) - ("Loading" - ("Load libs" - (clojure.core require use import refer)) - ("List Loaded" - (clojure.core loaded-libs)) - ("Load Misc" - (clojure.core load load-file load-reader load-string))) - - ("Concurrency" - ("Atoms" - (clojure.core atom swap! swap-vals! reset! reset-vals! compare-and-set!)) - ("Futures" - (clojure.core future future-call future-cancel future-cancelled? future-done? future?)) - ("Threads" - (clojure.core bound-fn bound-fn* get-thread-bindings pop-thread-bindings push-thread-bindings)) - - ("Misc" - (clojure.core locking pcalls pvalues pmap seque promise deliver)) - - ("Refs & Transactions" - ("Create" - (clojure.core ref)) - ("Examine" - (clojure.core deref)) - ("Transaction" - (clojure.core sync dosync io!)) - ("In Transaction" - (clojure.core ensure ref-set alter commute)) - ("Validators" - (clojure.core get-validator set-validator!)) - ("History" - (clojure.core ref-history-count ref-max-history ref-min-history))) - - ("Agents & Asynchronous Actions" - ("Create" - (clojure.core agent)) - ("Examine" - (clojure.core agent-error)) - ("Change State" - (clojure.core send send-off restart-agent send-via set-agent-send-executor! set-agent-send-off-executor!)) - ("Block Waiting" - (clojure.core await await-for)) - ("Ref Validators" - (clojure.core get-validator set-validator!)) - ("Watchers" - (clojure.core add-watch remove-watch)) - ("Thread Handling" - (clojure.core shutdown-agents)) - ("Error" - (clojure.core error-handler set-error-handler! error-mode set-error-mode!)) - ("Misc" - (clojure.core *agent* release-pending-sends)))) - - ("Sequences" - ("Creating a Lazy Seq" - ("From Collection" - (clojure.core seq sequence keys vals rseq subseq rsubseq)) - ("From Producer Fn" - (clojure.core lazy-seq repeatedly iterate)) - ("From Constant" - (clojure.core repeat range)) - ("From Other" - (clojure.core file-seq line-seq resultset-seq re-seq tree-seq xml-seq iterator-seq enumeration-seq)) - ("From Seq" - (clojure.core keep keep-indexed))) - - ("Seq in, Seq out" - ("Get shorter" - (clojure.core distinct dedupe filter remove for)) - ("Get longer" - (clojure.core cons conj concat lazy-cat mapcat cycle interleave interpose))) - ("Tail-items" - (clojure.core rest nthrest fnext nnext drop drop-while take-last for)) - ("Head-items" - (clojure.core take take-nth take-while butlast drop-last for)) - ("Change" - (clojure.core conj concat distinct flatten group-by partition partition-all partition-by split-at split-with filter remove replace shuffle random-sample)) - ("Rearrange" - (clojure.core reverse sort sort-by compare)) - ("Process items" - (clojure.core map pmap map-indexed mapcat for replace seque)) - - ("Using a Seq" - ("Extract item" - (clojure.core first second last rest next ffirst nfirst fnext nnext nth nthnext rand-nth when-first max-key min-key)) - ("Construct coll" - (clojure.core zipmap into reduce reductions set vec into-array to-array-2d)) - ("Pass to fn" - (clojure.core apply)) - ("Search" - (clojure.core some filter)) - ("Force evaluation" - (clojure.core doseq dorun doall)) - ("Check for forced" - (clojure.core realized?)))) - - ("Zippers" - ("Create" - (clojure.zip zipper seq-zip vector-zip xml-zip)) - ("Get loc" - (clojure.zip up down left right leftmost rightmost)) - ("Get seq" - (clojure.zip lefts rights path children)) - ("Change" - (clojure.zip make-node replace edit insert-child insert-left insert-right append-child remove)) - ("Move" - (clojure.zip next prev)) - ("XML" - (clojure.data.zip.xml attr attr= seq-test tag= text text= xml-> xml1->)) - ("Misc" - (clojure.zip root node branch? end?))) - - ("Documentation" - ("REPL" - (clojure.repl doc find-doc apropos source pst) - (clojure.java.javadoc javadoc))) - - ("Transients" - ("Create" - (clojure.core transient persistent!)) - ("Change" - (clojure.core conj! pop! assoc! dissoc! disj!))) - ("Misc" - ("Compare" - (clojure.core = == identical? not= not compare) - (clojure.data diff)) - ("Test" - (clojure.core true? false? nil? instance?))) - - ("IO" - ("To/from ..." - (clojure.core spit slurp)) - ("To *out*" - (clojure.core pr prn print printf println newline) - (clojure.pprint print-table)) - ("To writer" - (clojure.pprint pprint cl-format)) - ("To string" - (clojure.core format with-out-str pr-str prn-str print-str println-str)) - ("From *in*" - (clojure.core read-line read)) - ("From reader" - (clojure.core line-seq read)) - ("From string" - (clojure.core read-string with-in-str)) - ("Open" - (clojure.core with-open) - (clojure.java.io reader writer input-stream output-stream)) - ("Interop" - (clojure.java.io make-writer make-reader make-output-stream make-input-stream)) - ("Misc" - (clojure.core flush file-seq *in* *out* *err*) - (clojure.java.io file copy delete-file resource as-file as-url as-relative-path make-parents))) - - ("Metadata" - (clojure.core meta with-meta alter-meta! reset-meta! vary-meta)) - - ("Special Forms" - (:special def if do quote var recur throw try monitor-enter monitor-exit) - (clojure.core fn loop) - ("Binding / Destructuring" - (clojure.core let fn letfn defn defmacro loop for doseq if-let if-some when-let when-some))) - - ("Async" - ("Main" - (clojure.core.async go go-loop ! >!! chan put! take take! close! timeout offer! poll! promise-chan)) - ("Choice" - (clojure.core.async alt! alt!! alts! alts!! do-alts)) - ("Buffering" - (clojure.core.async buffer dropping-buffer sliding-buffer unblocking-buffer?)) - ("Pipelines" - (clojure.core.async pipeline pipeline-async pipeline-blocking)) - ("Threading" - (clojure.core.async thread thread-call)) - ("Mixing" - (clojure.core.async admix solo-mode mix unmix unmix-all toggle merge pipe unique)) - ("Multiples" - (clojure.core.async mult tap untap untap-all)) - ("Publish/Subscribe" - (clojure.core.async pub sub unsub unsub-all)) - ("Higher Order" - (clojure.core.async filter< filter> map map< map> mapcat< mapcat> partition partition-by reduce remove< remove> split)) - ("Pre-Populate" - (clojure.core.async into onto-chan to-chan))) - ("Unit Tests" - ("Defining" - (clojure.test deftest deftest- testing is are)) - ("Running" - (clojure.test run-tests run-all-tests test-vars)) - ("Fixtures" - (clojure.test use-fixtures join-fixtures compose-fixtures)))) - "A data structure for Clojure cheatsheet information. - -It's a tree, where the head of each list determines the context of the rest -of the list. The head may be: - - - A string, in which case it's a (sub)heading for the rest of the items. - - - A symbol, in which case it's the Clojure namespace of the symbols that - follow it. - - - The keyword :special, in which case it's a Clojure special form - - - Any other keyword, in which case it's a typed item that will be passed - through. - -Note that some Clojure symbols appear in more than once. This is entirely -intentional. For instance, `map` belongs in the sections on collections -and transducers.") - -(defun cider-cheatsheet--expand-vars (list) - "Expand the symbols in LIST to fully-qualified var names. - -This list is supposed to have the following format: - - (my-ns var1 var2 var3)" - (let ((ns (car list)) - (vars (cdr list))) - (if (eq ns :special) - (mapcar #'symbol-name vars) - (mapcar (lambda (var) (format "%s/%s" ns var)) vars)))) - -(defun cider-cheatsheet--select-var (var-list) - "Expand the symbols in VAR-LIST to fully-qualified var names. - -The list can hold one or more lists inside - one per each namespace." - (let ((namespaced-vars (seq-mapcat #'cider-cheatsheet--expand-vars - (seq-remove (lambda (list) - (eq (car list) :url)) - var-list)))) - (cider-doc-lookup (completing-read "Select var: " namespaced-vars)))) - -;;;###autoload -(defun cider-cheatsheet () - "Navigate `cider-cheatsheet-hierarchy' with `completing-read'. - -When you make it to a Clojure var its doc buffer gets displayed." - (interactive) - (let ((cheatsheet-data cider-cheatsheet-hierarchy)) - (while (stringp (caar cheatsheet-data)) - (let* ((sections (mapcar #'car cheatsheet-data)) - (sel-section (completing-read "Select cheatsheet section: " sections)) - (section-data (seq-find (lambda (elem) (equal (car elem) sel-section)) cheatsheet-data))) - (setq cheatsheet-data (cdr section-data)))) - (cider-cheatsheet--select-var cheatsheet-data))) - -(provide 'cider-cheatsheet) - -;;; cider-cheatsheet.el ends here diff --git a/elpa/cider-20181110.1413/cider-classpath.el b/elpa/cider-20181110.1413/cider-classpath.el deleted file mode 100644 index 10141370..00000000 --- a/elpa/cider-20181110.1413/cider-classpath.el +++ /dev/null @@ -1,112 +0,0 @@ -;;; cider-classpath.el --- Basic Java classpath browser - -;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; 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/elpa/cider-20181110.1413/cider-client.el b/elpa/cider-20181110.1413/cider-client.el deleted file mode 100644 index 2c092fbe..00000000 --- a/elpa/cider-20181110.1413/cider-client.el +++ /dev/null @@ -1,577 +0,0 @@ -;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov -;; -;; Author: Bozhidar Batsov - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A layer of abstraction above the low-level nREPL client code. - -;;; Code: - -(require 'spinner) -(require 'nrepl-client) -(require 'cider-connection) -(require 'cider-common) -(require 'cider-util) -(require 'clojure-mode) - -(require 'subr-x) -(require 'cider-compat) -(require 'seq) - - -;;; Eval spinner -(defcustom cider-eval-spinner-type 'progress-bar - "Appearance of the evaluation spinner. - -Value is a symbol. The possible values are the symbols in the -`spinner-types' variable." - :type 'symbol - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-show-eval-spinner t - "When true, show the evaluation spinner in the mode line." - :type 'boolean - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-eval-spinner-delay 1 - "Amount of time, in seconds, after which the evaluation spinner will be shown." - :type 'integer - :group 'cider - :package-version '(cider . "0.10.0")) - -(defun cider-spinner-start (buffer) - "Start the evaluation spinner in BUFFER. -Do nothing if `cider-show-eval-spinner' is nil." - (when cider-show-eval-spinner - (with-current-buffer buffer - (spinner-start cider-eval-spinner-type nil - cider-eval-spinner-delay)))) - -(defun cider-eval-spinner-handler (eval-buffer original-callback) - "Return a response handler to stop the spinner and call ORIGINAL-CALLBACK. -EVAL-BUFFER is the buffer where the spinner was started." - (lambda (response) - ;; buffer still exists and - ;; we've got status "done" from nrepl - ;; stop the spinner - (when (and (buffer-live-p eval-buffer) - (let ((status (nrepl-dict-get response "status"))) - (or (member "done" status) - (member "eval-error" status) - (member "error" status)))) - (with-current-buffer eval-buffer - (when spinner-current (spinner-stop)))) - (funcall original-callback response))) - - -;;; Evaluation helpers -(defun cider-ns-form-p (form) - "Check if FORM is an ns form." - (string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form)) - -(defun cider-ns-from-form (ns-form) - "Get ns substring from NS-FORM." - (when (string-match "^[ \t\n]*\(ns[ \t\n]+\\([^][ \t\n(){}]+\\)" ns-form) - (match-string-no-properties 1 ns-form))) - -(defvar-local cider-buffer-ns nil - "Current Clojure namespace of some buffer. -Useful for special buffers (e.g. REPL, doc buffers) that have to keep track -of a namespace. This should never be set in Clojure buffers, as there the -namespace should be extracted from the buffer's ns form.") - -(defun cider-current-ns (&optional no-default) - "Return the current ns. -The ns is extracted from the ns form for Clojure buffers and from -`cider-buffer-ns' for all other buffers. If it's missing, use the current -REPL's ns, otherwise fall back to \"user\". When NO-DEFAULT is non-nil, it -will return nil instead of \"user\"." - (or cider-buffer-ns - (clojure-find-ns) - (when-let* ((repl (cider-current-repl))) - (buffer-local-value 'cider-buffer-ns repl)) - (if no-default nil "user"))) - -(defun cider-expected-ns (&optional path) - "Return the namespace string matching PATH, or nil if not found. -PATH is expected to be an absolute file path. If PATH is nil, use the path -to the file backing the current buffer. The command falls back to -`clojure-expected-ns' in the absence of an active nREPL connection." - (if (cider-connected-p) - (let* ((path (or path (file-truename (buffer-file-name)))) - (relpath (thread-last (cider-sync-request:classpath) - (seq-map - (lambda (cp) - (when (string-prefix-p cp path) - (substring path (length cp))))) - (seq-filter #'identity) - (seq-sort (lambda (a b) - (< (length a) (length b)))) - (car)))) - (if relpath - (thread-last (substring relpath 1) ; remove leading / - (file-name-sans-extension) - (replace-regexp-in-string "/" ".") - (replace-regexp-in-string "_" "-")) - (clojure-expected-ns path))) - (clojure-expected-ns path))) - -(defun cider-nrepl-op-supported-p (op &optional connection) - "Check whether the CONNECTION supports the nREPL middleware OP." - (nrepl-op-supported-p op (or connection (cider-current-repl)))) - -(defvar cider-version) -(defun cider-ensure-op-supported (op) - "Check for support of middleware op OP. -Signal an error if it is not supported." - (unless (cider-nrepl-op-supported-p op) - (user-error "`%s' requires the nREPL op \"%s\" (provided by cider-nrepl)" this-command op))) - -(defun cider-nrepl-send-request (request callback &optional connection) - "Send REQUEST and register response handler CALLBACK. -REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" - \"par1\" ... ). -If CONNECTION is provided dispatch to that connection instead of -the current connection. Return the id of the sent message." - (nrepl-send-request request callback (or connection (cider-current-repl "any")))) - -(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input) - "Send REQUEST to the nREPL server synchronously using CONNECTION. -Hold till final \"done\" message has arrived and join all response messages -of the same \"op\" that came along and return the accumulated response. -If ABORT-ON-INPUT is non-nil, the function will return nil -at the first sign of user input, so as not to hang the -interface." - (nrepl-send-sync-request request - (or connection (cider-current-repl "any")) - abort-on-input)) - -(defun cider-nrepl-send-unhandled-request (request &optional connection) - "Send REQUEST to the nREPL CONNECTION and ignore any responses. -Immediately mark the REQUEST as done. Return the id of the sent message." - (let* ((conn (or connection (cider-current-repl "any"))) - (id (nrepl-send-request request #'ignore conn))) - (with-current-buffer conn - (nrepl--mark-id-completed id)) - id)) - -(defun cider-nrepl-request:eval (input callback &optional ns line column additional-params connection) - "Send the request INPUT and register the CALLBACK as the response handler. -If NS is non-nil, include it in the request. LINE and COLUMN, if non-nil, -define the position of INPUT in its buffer. ADDITIONAL-PARAMS is a plist -to be appended to the request message. CONNECTION is the connection -buffer, defaults to (cider-current-repl)." - (let ((connection (or connection (cider-current-repl)))) - (nrepl-request:eval input - (if cider-show-eval-spinner - (cider-eval-spinner-handler connection callback) - callback) - connection - ns line column additional-params) - (cider-spinner-start connection))) - -(defun cider-nrepl-sync-request:eval (input &optional connection ns) - "Send the INPUT to the nREPL CONNECTION synchronously. -If NS is non-nil, include it in the eval request." - (nrepl-sync-request:eval input (or connection (cider-current-repl)) ns)) - -(defcustom cider-pprint-fn 'pprint - "Sets the function to use when pretty-printing evaluation results. - -The value must be one of the following symbols: - -`pprint' - to use \\=`clojure.pprint/pprint\\=` - -`fipp' - to use the Fast Idiomatic Pretty Printer, approximately 5-10x -faster than \\=`clojure.core/pprint\\=` (this is the default) - -`puget' - to use Puget, which provides canonical serialization of data on -top of fipp, but at a slight performance cost - -Alternatively, can be the namespace-qualified name of a Clojure function of -one argument. If the function cannot be resolved, an exception will be -thrown. - -The function is assumed to respect the contract of \\=`clojure.pprint/pprint\\=` -with respect to the bound values of \\=`*print-length*\\=`, \\=`*print-level*\\=`, -\\=`*print-meta*\\=`, and \\=`clojure.pprint/*print-right-margin*\\=`." - :type '(choice (const pprint) - (const fipp) - (const puget) - string) - :group 'cider - :package-version '(cider . "0.11.0")) - -(defun cider--pprint-fn () - "Return the value to send in the pprint-fn slot of messages." - (pcase cider-pprint-fn - (`pprint "clojure.pprint/pprint") - (`fipp "cider.nrepl.middleware.pprint/fipp-pprint") - (`puget "cider.nrepl.middleware.pprint/puget-pprint") - (_ cider-pprint-fn))) - -(defun cider--nrepl-pprint-request-plist (right-margin &optional pprint-fn) - "Plist to be appended to an eval request to make it use pprint. -PPRINT-FN is the name of the Clojure function to use. -RIGHT-MARGIN specifies the maximum column-width of the pretty-printed -result, and is included in the request if non-nil." - (nconc `("pprint" "true" - "pprint-fn" ,(or pprint-fn (cider--pprint-fn))) - (and right-margin `("print-right-margin" ,right-margin)))) - -(defun cider--nrepl-content-type-plist () - "Plist to be appended to an eval request to make it use content-types." - '("content-type" "true")) - -(defun cider-tooling-eval (input callback &optional ns connection) - "Send the request INPUT to CONNECTION and register the CALLBACK. -NS specifies the namespace in which to evaluate the request. Requests -evaluated in the tooling nREPL session don't affect the thread-local -bindings of the primary eval nREPL session (e.g. this is not going to -clobber *1/2/3)." - ;; namespace forms are always evaluated in the "user" namespace - (nrepl-request:eval input - callback - (or connection (cider-current-repl)) - ns nil nil nil 'tooling)) - -(defun cider-sync-tooling-eval (input &optional ns connection) - "Send the request INPUT to CONNECTION and evaluate in synchronously. -NS specifies the namespace in which to evaluate the request. Requests -evaluated in the tooling nREPL session don't affect the thread-local -bindings of the primary eval nREPL session (e.g. this is not going to -clobber *1/2/3)." - ;; namespace forms are always evaluated in the "user" namespace - (nrepl-sync-request:eval input - (or connection (cider-current-repl)) - ns - 'tooling)) - -;; TODO: Add some unit tests and pretty those two functions up. -;; FIXME: Currently that's broken for group-id with multiple segments (e.g. org.clojure/clojure) -(defun cider-classpath-libs () - "Return a list of all libs on the classpath." - (let ((libs (seq-filter (lambda (cp-entry) - (string-suffix-p ".jar" cp-entry)) - (cider-sync-request:classpath))) - (dir-sep (if (string-equal system-type "windows-nt") "\\\\" "/"))) - (thread-last libs - (seq-map (lambda (s) (split-string s dir-sep))) - (seq-map #'reverse) - (seq-map (lambda (l) (reverse (seq-take l 4))))))) - -(defun cider-library-present-p (lib) - "Check whether LIB is present on the classpath. -The library is a string of the format \"group-id/artifact-id\"." - (let* ((lib (split-string lib "/")) - (group-id (car lib)) - (artifact-id (cadr lib))) - (seq-find (lambda (lib) - (let ((g (car lib)) - (a (cadr lib))) - (and (equal group-id g) (equal artifact-id a)))) - (cider-classpath-libs)))) - - -;;; Interrupt evaluation - -(defun cider-interrupt-handler (buffer) - "Create an interrupt response handler for BUFFER." - (nrepl-make-response-handler buffer nil nil nil nil)) - -(defun cider-interrupt () - "Interrupt any pending evaluations." - (interactive) - ;; FIXME: does this work correctly in cljc files? - (with-current-buffer (cider-current-repl) - (let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests))) - (dolist (request-id pending-request-ids) - (nrepl-request:interrupt - request-id - (cider-interrupt-handler (current-buffer)) - (cider-current-repl)))))) - -(defun cider-nrepl-eval-session () - "Return the eval nREPL session id of the current connection." - (with-current-buffer (cider-current-repl) - nrepl-session)) - -(defun cider-nrepl-tooling-session () - "Return the tooling nREPL session id of the current connection." - (with-current-buffer (cider-current-repl) - nrepl-tooling-session)) - -(defun cider--var-choice (var-info) - "Prompt to choose from among multiple VAR-INFO candidates, if required. -This is needed only when the symbol queried is an unqualified host platform -method, and multiple classes have a so-named member. If VAR-INFO does not -contain a `candidates' key, it is returned as is." - (let ((candidates (nrepl-dict-get var-info "candidates"))) - (if candidates - (let* ((classes (nrepl-dict-keys candidates)) - (choice (completing-read "Member in class: " classes nil t)) - (info (nrepl-dict-get candidates choice))) - info) - var-info))) - -(defun cider-var-info (var &optional all) - "Return VAR's info as an alist with list cdrs. -When multiple matching vars are returned you'll be prompted to select one, -unless ALL is truthy." - (when (and var (not (string= var ""))) - (let ((var-info (cider-sync-request:info var))) - (if all var-info (cider--var-choice var-info))))) - -(defun cider-member-info (class member) - "Return the CLASS MEMBER's info as an alist with list cdrs." - (when (and class member) - (cider-sync-request:info nil class member))) - - -;;; Requests - -(declare-function cider-load-file-handler "cider-eval") -(defun cider-request:load-file (file-contents file-path file-name &optional connection callback) - "Perform the nREPL \"load-file\" op. -FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be -loaded. If CONNECTION is nil, use `cider-current-repl'. If CALLBACK -is nil, use `cider-load-file-handler'." - (cider-nrepl-send-request `("op" "load-file" - "file" ,file-contents - "file-path" ,file-path - "file-name" ,file-name) - (or callback - (cider-load-file-handler (current-buffer))) - connection)) - - -;;; Sync Requests - -(defcustom cider-filtered-namespaces-regexps - '("^cider.nrepl" "^refactor-nrepl" "^clojure.tools.nrepl" "^nrepl") - "List of regexps used to filter out some vars/symbols/namespaces. -When nil, nothing is filtered out. Otherwise, all namespaces matching any -regexp from this list are dropped out of the \"ns-list\" op. Also, -\"apropos\" won't include vars from such namespaces. This list is passed -on to the nREPL middleware without any pre-processing. So the regexps have -to be in Clojure format (with twice the number of backslashes) and not -Emacs Lisp." - :type '(repeat string) - :safe #'listp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p) - "Send \"apropos\" request for regexp QUERY. - -Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." - (let* ((query (replace-regexp-in-string "[ \t]+" ".+" query)) - (response (cider-nrepl-send-sync-request - `("op" "apropos" - "ns" ,(cider-current-ns) - "query" ,query - ,@(when search-ns `("search-ns" ,search-ns)) - ,@(when docs-p '("docs?" "t")) - ,@(when privates-p '("privates?" "t")) - ,@(when case-sensitive-p '("case-sensitive?" "t")) - "filter-regexps" ,cider-filtered-namespaces-regexps)))) - (if (member "apropos-regexp-error" (nrepl-dict-get response "status")) - (user-error "Invalid regexp: %s" (nrepl-dict-get response "error-msg")) - (nrepl-dict-get response "apropos-matches")))) - -(defun cider-sync-request:classpath () - "Return a list of classpath entries." - (cider-ensure-op-supported "classpath") - (thread-first '("op" "classpath") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "classpath"))) - -(defun cider-sync-request:complete (str context) - "Return a list of completions for STR using nREPL's \"complete\" op. -CONTEXT represents a completion context for compliment." - (when-let* ((dict (thread-first `("op" "complete" - "ns" ,(cider-current-ns) - "symbol" ,str - "context" ,context) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (nrepl-dict-get dict "completions"))) - -(defun cider-sync-request:complete-flush-caches () - "Send \"complete-flush-caches\" op to flush Compliment's caches." - (cider-nrepl-send-sync-request (list "op" "complete-flush-caches" - "session" (cider-nrepl-eval-session)) - 'abort-on-input)) - -(defun cider-sync-request:info (symbol &optional class member) - "Send \"info\" op with parameters SYMBOL or CLASS and MEMBER." - (let ((var-info (thread-first `("op" "info" - "ns" ,(cider-current-ns) - ,@(when symbol `("symbol" ,symbol)) - ,@(when class `("class" ,class)) - ,@(when member `("member" ,member))) - (cider-nrepl-send-sync-request)))) - (if (member "no-info" (nrepl-dict-get var-info "status")) - nil - var-info))) - -(defun cider-sync-request:eldoc (symbol &optional class member) - "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER." - (when-let* ((eldoc (thread-first `("op" "eldoc" - "ns" ,(cider-current-ns) - ,@(when symbol `("symbol" ,symbol)) - ,@(when class `("class" ,class)) - ,@(when member `("member" ,member))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) - nil - eldoc))) - -(defun cider-sync-request:eldoc-datomic-query (symbol) - "Send \"eldoc-datomic-query\" op with parameter SYMBOL." - (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query" - "ns" ,(cider-current-ns) - ,@(when symbol `("symbol" ,symbol))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) - nil - eldoc))) - -(defun cider-sync-request:spec-list (&optional filter-regex) - "Get a list of the available specs in the registry. -Optional argument FILTER-REGEX filters specs. By default, all specs are -returned." - (setq filter-regex (or filter-regex "")) - (thread-first `("op" "spec-list" - "filter-regex" ,filter-regex) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-list"))) - -(defun cider-sync-request:spec-form (spec) - "Get SPEC's form from registry." - (thread-first `("op" "spec-form" - "spec-name" ,spec) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-form"))) - -(defun cider-sync-request:spec-example (spec) - "Get an example for SPEC." - (thread-first `("op" "spec-example" - "spec-name" ,spec) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-example"))) - -(defun cider-sync-request:ns-list () - "Get a list of the available namespaces." - (thread-first `("op" "ns-list" - "filter-regexps" ,cider-filtered-namespaces-regexps) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-list"))) - -(defun cider-sync-request:ns-vars (ns) - "Get a list of the vars in NS." - (thread-first `("op" "ns-vars" - "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars"))) - -(defun cider-sync-request:ns-path (ns) - "Get the path to the file containing NS." - (thread-first `("op" "ns-path" - "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "path"))) - -(defun cider-sync-request:ns-vars-with-meta (ns) - "Get a map of the vars in NS to its metadata information." - (thread-first `("op" "ns-vars-with-meta" - "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars-with-meta"))) - -(defun cider-sync-request:ns-load-all () - "Load all project namespaces." - (thread-first '("op" "ns-load-all") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "loaded-ns"))) - -(defun cider-sync-request:resource (name) - "Perform nREPL \"resource\" op with resource name NAME." - (thread-first `("op" "resource" - "name" ,name) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resource-path"))) - -(defun cider-sync-request:resources-list () - "Return a list of all resources on the classpath. -The result entries are relative to the classpath." - (when-let* ((resources (thread-first '("op" "resources-list") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resources-list")))) - (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources))) - -(defun cider-sync-request:format-code (code) - "Perform nREPL \"format-code\" op with CODE." - (thread-first `("op" "format-code" - "code" ,code) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "formatted-code"))) - -(defun cider-sync-request:format-edn (edn right-margin) - "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." - (let* ((response (thread-first `("op" "format-edn" - "edn" ,edn) - (append (cider--nrepl-pprint-request-plist right-margin)) - (cider-nrepl-send-sync-request))) - (err (nrepl-dict-get response "err"))) - (when err - ;; err will be a stacktrace with a first line that looks like: - ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" - (error (car (split-string err "\n")))) - (nrepl-dict-get response "formatted-edn"))) - -;;; Dealing with input -;; TODO: Replace this with some nil handler. -(defun cider-stdin-handler (&optional _buffer) - "Make a stdin response handler for _BUFFER." - (nrepl-make-response-handler (current-buffer) - (lambda (_buffer _value)) - (lambda (_buffer _out)) - (lambda (_buffer _err)) - nil)) - -(defun cider-need-input (buffer) - "Handle an need-input request from BUFFER." - (with-current-buffer buffer - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "C-c C-c") 'abort-recursive-edit) - (let ((stdin (condition-case nil - (concat (read-from-minibuffer "Stdin: " nil map) "\n") - (quit nil)))) - (nrepl-request:stdin stdin - (cider-stdin-handler buffer) - (cider-current-repl)))))) - -(provide 'cider-client) - -;;; cider-client.el ends here diff --git a/elpa/cider-20181110.1413/cider-common.el b/elpa/cider-20181110.1413/cider-common.el deleted file mode 100644 index 48a27446..00000000 --- a/elpa/cider-20181110.1413/cider-common.el +++ /dev/null @@ -1,375 +0,0 @@ -;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- - -;; Copyright © 2015-2018 Artur Malabarba - -;; Author: Artur Malabarba - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Common functions that are useful in both Clojure buffers and REPL -;; buffers. - -;;; Code: - -(require '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/elpa/cider-20181110.1413/cider-compat.el b/elpa/cider-20181110.1413/cider-compat.el deleted file mode 100644 index e6b64b28..00000000 --- a/elpa/cider-20181110.1413/cider-compat.el +++ /dev/null @@ -1,54 +0,0 @@ -;;; cider-compat.el --- Functions from newer Emacs versions for compatibility -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Everything here was copied from subr-x for compatibility with -;; Emacs 25.1. - -;;; Code: - -(eval-and-compile - - (unless (fboundp 'if-let*) - (defmacro if-let* (bindings then &rest else) - "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in THEN, and its cadr is a sexp to be -evalled to set symbol's value." - (declare (indent 2) - (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) - `(let* ,(internal--build-bindings bindings) - (if ,(car (internal--listify (car (last bindings)))) - ,then - ,@else)))) - - (unless (fboundp 'when-let*) - (defmacro when-let* (bindings &rest body) - "Process BINDINGS and if all values are non-nil eval BODY. -Argument BINDINGS is a list of tuples whose car is a symbol to be -bound and (optionally) used in BODY, and its cadr is a sexp to be -evalled to set symbol's value." - (declare (indent 1) (debug if-let*)) - `(if-let* ,bindings ,(macroexp-progn body))))) - -(provide 'cider-compat) -;;; cider-compat.el ends here diff --git a/elpa/cider-20181110.1413/cider-completion.el b/elpa/cider-20181110.1413/cider-completion.el deleted file mode 100644 index c52769ee..00000000 --- a/elpa/cider-20181110.1413/cider-completion.el +++ /dev/null @@ -1,253 +0,0 @@ -;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov -;; Artur Malabarba - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Smart REPL-powered code completion and integration with company-mode. - -;;; Code: - -(require 'subr-x) -(require 'thingatpt) - -(require 'cider-client) -(require 'cider-common) -(require 'cider-eldoc) -(require 'nrepl-dict) - -(defcustom cider-completion-use-context t - "When true, uses context at point to improve completion suggestions." - :type 'boolean - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-annotate-completion-candidates t - "When true, annotate completion candidates with some extra information." - :type 'boolean - :group 'cider - :package-version '(cider . "0.8.0")) - -(defcustom cider-annotate-completion-function - #'cider-default-annotate-completion-function - "Controls how the annotations for completion candidates are formatted. -Must be a function that takes two arguments: the abbreviation of the -candidate type according to `cider-completion-annotations-alist' and the -candidate's namespace." - :type 'function - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-completion-annotations-alist - '(("class" "c") - ("field" "fi") - ("function" "f") - ("import" "i") - ("keyword" "k") - ("local" "l") - ("macro" "m") - ("method" "me") - ("namespace" "n") - ("protocol" "p") - ("protocol-function" "pf") - ("record" "r") - ("special-form" "s") - ("static-field" "sf") - ("static-method" "sm") - ("type" "t") - ("var" "v")) - "Controls the abbreviations used when annotating completion candidates. - -Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE -is a possible value of the candidate's type returned from the completion -backend, and ABBREVIATION is a short form of that type." - :type '(alist :key-type string :value-type string) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-completion-annotations-include-ns 'unqualified - "Controls passing of namespaces to `cider-annotate-completion-function'. - -When set to 'always, the candidate's namespace will always be passed if it -is available. When set to 'unqualified, the namespace will only be passed -if the candidate is not namespace-qualified." - :type '(choice (const always) - (const unqualified) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defvar cider-completion-last-context nil) - -(defun cider-completion-symbol-start-pos () - "Find the starting position of the symbol at point, unless inside a string." - (let ((sap (symbol-at-point))) - (when (and sap (not (nth 3 (syntax-ppss)))) - (car (bounds-of-thing-at-point 'symbol))))) - -(defun cider-completion-get-context-at-point () - "Extract the context at point. -If point is not inside the list, returns nil; otherwise return \"top-level\" -form, with symbol at point replaced by __prefix__." - (when (save-excursion - (condition-case _ - (progn - (up-list) - (check-parens) - t) - (scan-error nil) - (user-error nil))) - (save-excursion - (let* ((pref-end (point)) - (pref-start (cider-completion-symbol-start-pos)) - (context (cider-defun-at-point)) - (_ (beginning-of-defun)) - (expr-start (point))) - (concat (when pref-start (substring context 0 (- pref-start expr-start))) - "__prefix__" - (substring context (- pref-end expr-start))))))) - -(defun cider-completion-get-context () - "Extract context depending on `cider-completion-use-context' and major mode." - (let ((context (if (and cider-completion-use-context - ;; Important because `beginning-of-defun' and - ;; `ending-of-defun' work incorrectly in the REPL - ;; buffer, so context extraction fails there. - (derived-mode-p 'clojure-mode)) - (or (cider-completion-get-context-at-point) - "nil") - "nil"))) - (if (string= cider-completion-last-context context) - ":same" - (setq cider-completion-last-context context) - context))) - -(defun cider-completion--parse-candidate-map (candidate-map) - "Get \"candidate\" from CANDIDATE-MAP. -Put type and ns properties on the candidate" - (let ((candidate (nrepl-dict-get candidate-map "candidate")) - (type (nrepl-dict-get candidate-map "type")) - (ns (nrepl-dict-get candidate-map "ns"))) - (put-text-property 0 1 'type type candidate) - (put-text-property 0 1 'ns ns candidate) - candidate)) - -(defun cider-complete (str) - "Complete STR with context at point." - (let* ((context (cider-completion-get-context)) - (candidates (cider-sync-request:complete str context))) - (mapcar #'cider-completion--parse-candidate-map candidates))) - -(defun cider-completion--get-candidate-type (symbol) - "Get candidate type for SYMBOL." - (let ((type (get-text-property 0 'type symbol))) - (or (cadr (assoc type cider-completion-annotations-alist)) - type))) - -(defun cider-completion--get-candidate-ns (symbol) - "Get candidate ns for SYMBOL." - (when (or (eq 'always cider-completion-annotations-include-ns) - (and (eq 'unqualified cider-completion-annotations-include-ns) - (not (cider-namespace-qualified-p symbol)))) - (get-text-property 0 'ns symbol))) - -(defun cider-default-annotate-completion-function (type ns) - "Get completion function based on TYPE and NS." - (concat (when ns (format " (%s)" ns)) - (when type (format " <%s>" type)))) - -(defun cider-annotate-symbol (symbol) - "Return a string suitable for annotating SYMBOL. -If SYMBOL has a text property `type` whose value is recognised, its -abbreviation according to `cider-completion-annotations-alist' will be -used. If `type` is present but not recognised, its value will be used -unaltered. If SYMBOL has a text property `ns`, then its value will be used -according to `cider-completion-annotations-include-ns'. The formatting is -performed by `cider-annotate-completion-function'." - (when cider-annotate-completion-candidates - (let* ((type (cider-completion--get-candidate-type symbol)) - (ns (cider-completion--get-candidate-ns symbol))) - (funcall cider-annotate-completion-function type ns)))) - -(defun cider-complete-at-point () - "Complete the symbol at point." - (when-let* ((bounds (bounds-of-thing-at-point 'symbol))) - (when (and (cider-connected-p) - (not (or (cider-in-string-p) (cider-in-comment-p)))) - (list (car bounds) (cdr bounds) - (completion-table-dynamic #'cider-complete) - :annotation-function #'cider-annotate-symbol - :company-doc-buffer #'cider-create-doc-buffer - :company-location #'cider-company-location - :company-docsig #'cider-company-docsig)))) - -(defun cider-completion-flush-caches () - "Force Compliment to refill its caches. -This command should be used if Compliment fails to pick up new classnames -and methods from dependencies that were loaded dynamically after the REPL -has started." - (interactive) - (cider-sync-request:complete-flush-caches)) - -(defun cider-company-location (var) - "Open VAR's definition in a buffer. -Returns the cons of the buffer itself and the location of VAR's definition -in the buffer." - (when-let* ((info (cider-var-info var)) - (file (nrepl-dict-get info "file")) - (line (nrepl-dict-get info "line")) - (buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (cons buffer (point)))))) - -(defun cider-company-docsig (thing) - "Return signature for THING." - (let* ((eldoc-info (cider-eldoc-info thing)) - (ns (lax-plist-get eldoc-info "ns")) - (symbol (lax-plist-get eldoc-info "symbol")) - (arglists (lax-plist-get eldoc-info "arglists"))) - (when eldoc-info - (format "%s: %s" - (cider-eldoc-format-thing ns symbol thing - (cider-eldoc-thing-type eldoc-info)) - (cider-eldoc-format-arglist arglists 0))))) - -;; Fuzzy completion for company-mode - -(defun cider-company-unfiltered-candidates (string &rest _) - "Return CIDER completion candidates for STRING as is, unfiltered." - (cider-complete string)) - -(add-to-list 'completion-styles-alist - '(cider - cider-company-unfiltered-candidates - cider-company-unfiltered-candidates - "CIDER backend-driven completion style.")) - -(defun cider-company-enable-fuzzy-completion () - "Enable backend-driven fuzzy completion in the current buffer." - (setq-local completion-styles '(cider))) - -(provide 'cider-completion) -;;; cider-completion.el ends here diff --git a/elpa/cider-20181110.1413/cider-connection.el b/elpa/cider-20181110.1413/cider-connection.el deleted file mode 100644 index bfaa8f76..00000000 --- a/elpa/cider-20181110.1413/cider-connection.el +++ /dev/null @@ -1,857 +0,0 @@ -;;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*- -;; -;; Copyright © 2018 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors -;; -;; Author: Artur Malabarba -;; Bozhidar Batsov -;; Vitalie Spinu -;; -;; Keywords: languages, clojure, cider -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . -;; -;; This file is not part of GNU Emacs. -;; -;; -;;; Commentary: -;; -;; -;;; Code: - -(require 'nrepl-client) -(require 'cl-lib) -(require 'format-spec) -(require 'sesman) -(require 'sesman-browser) - -(defcustom cider-session-name-template "%J:%h:%p" - "Format string to use for session names. -See `cider-format-connection-params' for available format characters." - :type 'string - :group 'cider - :package-version '(cider . "0.18.0")) - -(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration - "The function to use to generate the message displayed on connect. -When set to nil no additional message will be displayed. A good -alternative to the default is `cider-random-tip'." - :type 'function - :group 'cider - :package-version '(cider . "0.11.0")) - -(defcustom cider-redirect-server-output-to-repl t - "Controls whether nREPL server output would be redirected to the REPL. -When non-nil the output would end up in both the nrepl-server buffer (when -available) and the matching REPL buffer." - :type 'boolean - :group 'cider - :safe #'booleanp - :package-version '(cider . "0.17.0")) - -(defcustom cider-auto-mode t - "When non-nil, automatically enable cider mode for all Clojure buffers." - :type 'boolean - :group 'cider - :safe #'booleanp - :package-version '(cider . "0.9.0")) - -(defconst cider-required-nrepl-version "0.2.12" - "The minimum nREPL version that's known to work properly with CIDER.") - - -;;; Connect - -(defun cider-nrepl-connect (params) - "Start nrepl client and create the REPL. -PARAMS is a plist containing :host, :port, :server and other parameters for -`cider-repl-create'." - (process-buffer - (nrepl-start-client-process - (plist-get params :host) - (plist-get params :port) - (plist-get params :server) - (lambda (_) - (cider-repl-create params))))) - -(defun cider-connected-p () - "Return t if CIDER is currently connected, nil otherwise." - (process-live-p (get-buffer-process (cider-current-repl)))) - -(defun cider-ensure-connected () - "Ensure there is a linked CIDER session." - (sesman-ensure-session 'CIDER)) - -(defun cider--session-server (session) - "Return server buffer for SESSION or nil if there is no server." - (seq-some (lambda (r) - (buffer-local-value 'nrepl-server-buffer r)) - (cdr session))) - -(defun cider--gather-session-params (session) - "Gather all params for a SESSION." - (let (params) - (dolist (repl (cdr session)) - (setq params (cider--gather-connect-params params repl))) - (when-let* ((server (cider--session-server session))) - (setq params (cider--gather-connect-params params server))) - params)) - -(defun cider--gather-connect-params (&optional params proc-buffer) - "Gather all relevant connection parameters into PARAMS plist. -PROC-BUFFER is either server or client buffer, defaults to current buffer." - (let ((proc-buffer (or proc-buffer (current-buffer)))) - (with-current-buffer proc-buffer - (unless nrepl-endpoint - (error "This is not a REPL or SERVER buffer; is there an active REPL?")) - (let ((server-buf (if (nrepl-server-p proc-buffer) - proc-buffer - nrepl-server-buffer))) - (cl-loop for l on nrepl-endpoint by #'cddr - do (setq params (plist-put params (car l) (cadr l)))) - (setq params (thread-first params - (plist-put :project-dir nrepl-project-dir))) - (when (buffer-live-p server-buf) - (setq params (thread-first params - (plist-put :server (get-buffer-process server-buf)) - (plist-put :server-command nrepl-server-command)))) - ;; repl-specific parameters (do not pollute server params!) - (unless (nrepl-server-p proc-buffer) - (setq params (thread-first params - (plist-put :session-name cider-session-name) - (plist-put :repl-type cider-repl-type) - (plist-put :cljs-repl-type cider-cljs-repl-type) - (plist-put :repl-init-function cider-repl-init-function)))) - params)))) - -(defun cider--close-buffer (buffer) - "Close the BUFFER and kill its associated process (if any)." - (when (buffer-live-p buffer) - (when-let* ((proc (get-buffer-process buffer))) - (when (process-live-p proc) - (delete-process proc))) - (kill-buffer buffer))) - -(declare-function cider-repl-emit-interactive-stderr "cider-repl") -(defun cider--close-connection (repl &optional no-kill) - "Close connection associated with REPL. -When NO-KILL is non-nil stop the connection but don't kill the REPL -buffer." - (when (buffer-live-p repl) - (with-current-buffer repl - (when spinner-current (spinner-stop)) - (when nrepl-tunnel-buffer - (cider--close-buffer nrepl-tunnel-buffer)) - (when no-kill - ;; inform sentinel not to kill the server, if any - (thread-first (get-buffer-process repl) - (process-plist) - (plist-put :keep-server t)))) - (let ((proc (get-buffer-process repl))) - (when (and (process-live-p proc) - (or (not nrepl-server-buffer) - ;; Sync request will hang if the server is dead. - (process-live-p (get-buffer-process nrepl-server-buffer)))) - (nrepl-sync-request:close repl) - (delete-process proc))) - (when-let* ((messages-buffer (and nrepl-log-messages - (nrepl-messages-buffer repl)))) - (kill-buffer messages-buffer)) - (unless no-kill - (kill-buffer repl))) - (when repl - (sesman-remove-object 'CIDER nil repl (not no-kill) t))) - -(defun cider-emit-manual-warning (section-id format &rest args) - "Emit a warning to the REPL and link to the online manual. -SECTION-ID is the section to link to. The link is added on the last line. -FORMAT is a format string to compile with ARGS and display on the REPL." - (let ((message (apply #'format format args))) - (cider-repl-emit-interactive-stderr - (concat "WARNING: " message "\n " - (cider--manual-button "More information" section-id) - ".")))) - -(defvar cider-version) -(defun cider--check-required-nrepl-version () - "Check whether we're using a compatible nREPL version." - (if-let* ((nrepl-version (cider--nrepl-version))) - (when (version< nrepl-version cider-required-nrepl-version) - (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" - "CIDER requires nREPL %s (or newer) to work properly" - cider-required-nrepl-version)) - (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" - "Can't determine nREPL's version.\nPlease, update nREPL to %s." - cider-required-nrepl-version))) - -(defvar cider-minimum-clojure-version) -(defun cider--check-clojure-version-supported () - "Ensure that we are meeting the minimum supported version of Clojure." - (if-let* ((clojure-version (cider--clojure-version))) - (when (version< clojure-version cider-minimum-clojure-version) - (cider-emit-manual-warning "installation/#prerequisites" - "Clojure version (%s) is not supported (minimum %s). CIDER will not work." - clojure-version cider-minimum-clojure-version)) - (cider-emit-manual-warning "installation/#prerequisites" - "Can't determine Clojure's version. CIDER requires Clojure %s (or newer)." - cider-minimum-clojure-version))) - -(defvar cider-required-middleware-version) -(defun cider--check-middleware-compatibility () - "CIDER frontend/backend compatibility check. -Retrieve the underlying connection's CIDER-nREPL version and checks if the -middleware used is compatible with CIDER. If not, will display a warning -message in the REPL area." - (let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-repl))) - (middleware-version (nrepl-dict-get version-dict "version-string"))) - (cond - ((null middleware-version) - (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" - "CIDER requires cider-nrepl to be fully functional. Many things will not work without it!")) - ((version< middleware-version cider-required-middleware-version) - (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" - "CIDER %s requires cider-nrepl %s+, but you're currently using cider-nrepl %s. Things will break!" - cider-version cider-required-middleware-version middleware-version))))) - -(declare-function cider-interactive-eval-handler "cider-eval") -;; TODO: Use some null handler here -(defun cider--subscribe-repl-to-server-out () - "Subscribe to the nREPL server's *out*." - (cider-nrepl-send-request '("op" "out-subscribe") - (cider-interactive-eval-handler (current-buffer)))) - -(declare-function cider-mode "cider-mode") -(defun cider-enable-on-existing-clojure-buffers () - "Enable CIDER's minor mode on existing Clojure buffers. -See command `cider-mode'." - (interactive) - (add-hook 'clojure-mode-hook #'cider-mode) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (cider-mode +1)))) - -(defun cider-disable-on-existing-clojure-buffers () - "Disable command `cider-mode' on existing Clojure buffers." - (interactive) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (cider-mode -1)))) - -(defun cider-possibly-disable-on-existing-clojure-buffers () - "If not connected, disable command `cider-mode' on existing Clojure buffers." - (unless (cider-connected-p) - (cider-disable-on-existing-clojure-buffers))) - -(declare-function cider--debug-init-connection "cider-debug") -(declare-function cider-repl-init "cider-repl") -(defun cider--connected-handler () - "Handle CIDER initialization after nREPL connection has been established. -This function is appended to `nrepl-connected-hook' in the client process -buffer." - ;; `nrepl-connected-hook' is run in the connection buffer - ;; `cider-enlighten-mode' changes eval to include the debugger, so we inhibit - ;; it here as the debugger isn't necessarily initialized yet - (let ((cider-enlighten-mode nil)) - ;; after initialization, set mode-line and buffer name. - (cider-set-repl-type cider-repl-type) - (cider-repl-init (current-buffer)) - (cider--check-required-nrepl-version) - (cider--check-clojure-version-supported) - (cider--check-middleware-compatibility) - (when cider-redirect-server-output-to-repl - (cider--subscribe-repl-to-server-out)) - (when cider-auto-mode - (cider-enable-on-existing-clojure-buffers)) - ;; Middleware on cider-nrepl's side is deferred until first usage, but - ;; loading middleware concurrently can lead to occasional "require" issues - ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards - ;; the end, allowing for the faster "server-out" middleware to load - ;; first. - (cider--debug-init-connection) - (when cider-repl-init-function - (funcall cider-repl-init-function)) - (run-hooks 'cider-connected-hook))) - -(defun cider--disconnected-handler () - "Cleanup after nREPL connection has been lost or closed. -This function is appended to `nrepl-disconnected-hook' in the client -process buffer." - ;; `nrepl-connected-hook' is run in the connection buffer - (cider-possibly-disable-on-existing-clojure-buffers) - (run-hooks 'cider-disconnected-hook)) - - -;;; Connection Info - -(defun cider--java-version () - "Retrieve the underlying connection's Java version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "java") - (nrepl-dict-get "version-string"))))) - -(defun cider--clojure-version () - "Retrieve the underlying connection's Clojure version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "clojure") - (nrepl-dict-get "version-string"))))) - -(defun cider--nrepl-version () - "Retrieve the underlying connection's nREPL version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "nrepl") - (nrepl-dict-get "version-string"))))) - -(defun cider--connection-info (connection-buffer &optional genericp) - "Return info about CONNECTION-BUFFER. -Info contains project name, current REPL namespace, host:port endpoint and -Clojure version. When GENERICP is non-nil, don't provide specific info -about this buffer (like variable `cider-repl-type')." - (with-current-buffer connection-buffer - (format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)" - (if genericp "" (upcase (concat cider-repl-type " "))) - (or (cider--project-name nrepl-project-dir) "") - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port) - (cider--java-version) - (cider--clojure-version) - (cider--nrepl-version)))) - - -;;; Cider's Connection Management UI - -(defun cider-quit (&optional repl) - "Quit the CIDER connection associated with REPL. -REPL defaults to the current REPL." - (interactive) - (let ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure)))) - (cider--close-connection repl)) - ;; if there are no more connections we can kill all ancillary buffers - (unless (cider-connected-p) - (cider-close-ancillary-buffers)) - ;; need this to refresh sesman browser - (run-hooks 'sesman-post-command-hook)) - -(defun cider-restart (&optional repl) - "Restart CIDER connection associated with REPL. -REPL defaults to the current REPL. Don't restart the server or other -connections within the same session. Use `sesman-restart' to restart the -entire session." - (interactive) - (let* ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure))) - (params (thread-first () - (cider--gather-connect-params repl) - (plist-put :session-name (sesman-session-name-for-object 'CIDER repl)) - (plist-put :repl-buffer repl)))) - (cider--close-connection repl 'no-kill) - (cider-nrepl-connect params) - ;; need this to refresh sesman browser - (run-hooks 'sesman-post-command-hook))) - -(defun cider-close-ancillary-buffers () - "Close buffers that are shared across connections." - (interactive) - (dolist (buf-name cider-ancillary-buffers) - (when (get-buffer buf-name) - (kill-buffer buf-name)))) - -(defun cider-describe-connection (&optional repl) - "Display information about the connection associated with REPL. -REPL defaults to the current REPL." - (interactive) - (let ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure)))) - (message "%s" (cider--connection-info repl)))) -(define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-connection "0.18.0") - -(defconst cider-nrepl-session-buffer "*cider-nrepl-session*") - -(defun cider-describe-nrepl-session () - "Describe an nREPL session." - (interactive) - (cider-ensure-connected) - (let* ((repl (cider-current-repl nil 'ensure)) - (selected-session (completing-read "Describe nREPL session: " (nrepl-sessions repl)))) - (when (and selected-session (not (equal selected-session ""))) - (let* ((session-info (nrepl-sync-request:describe repl)) - (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) - (session-id (nrepl-dict-get session-info "session")) - (session-type (cond - ((equal session-id (cider-nrepl-eval-session)) "Active eval") - ((equal session-id (cider-nrepl-tooling-session)) "Active tooling") - (t "Unknown")))) - (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer 'select nil 'ancillary) - (read-only-mode -1) - (insert (format "Session: %s\n" session-id) - (format "Type: %s session\n" session-type) - (format "Supported ops:\n")) - (mapc (lambda (op) (insert (format " * %s\n" op))) ops))) - (display-buffer cider-nrepl-session-buffer)))) - - -;;; Sesman's Session-Wise Management UI - -(cl-defmethod sesman-project ((_system (eql CIDER))) - (clojure-project-dir (cider-current-dir))) - -(cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2) - (sesman-more-recent-p (cdr session1) (cdr session2))) - -(cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session) - (setcdr session (seq-filter #'buffer-live-p (cdr session))) - (when-let* ((repl (cadr session)) - (proc (get-buffer-process repl)) - (file (file-truename (or (buffer-file-name) default-directory)))) - ;; With avfs paths look like /path/to/.avfs/path/to/some.jar#uzip/path/to/file.clj - (when (string-match-p "#uzip" file) - (let ((avfs-path (directory-file-name (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/"))))) - (setq file (replace-regexp-in-string avfs-path "" file t t)))) - (when (process-live-p proc) - (let* ((classpath (or (process-get proc :cached-classpath) - (let ((cp (with-current-buffer repl - (cider-sync-request:classpath)))) - (process-put proc :cached-classpath cp) - cp))) - (classpath-roots (or (process-get proc :cached-classpath-roots) - (let ((cp (thread-last classpath - (seq-filter (lambda (path) (not (string-match-p "\\.jar$" path)))) - (mapcar #'file-name-directory)))) - (process-put proc :cached-classpath-roots cp) - cp)))) - (or (seq-find (lambda (path) (string-prefix-p path file)) - classpath) - (seq-find (lambda (path) (string-prefix-p path file)) - classpath-roots)))))) - -(defvar cider-sesman-browser-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "j q") #'cider-quit) - (define-key map (kbd "j k") #'cider-quit) - (define-key map (kbd "j r") #'cider-restart) - (define-key map (kbd "j d") #'cider-describe-connection) - (define-key map (kbd "j i") #'cider-describe-connection) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c C-r") #'cider-restart) - (define-key map (kbd "C-c M-r") #'cider-restart) - (define-key map (kbd "C-c C-d") #'cider-describe-connection) - (define-key map (kbd "C-c M-d") #'cider-describe-connection) - (define-key map (kbd "C-c C-i") #'cider-describe-connection) - map) - "Map active on REPL objects in sesman browser.") - -(cl-defmethod sesman-session-info ((_system (eql CIDER)) session) - (interactive "P") - (list :objects (cdr session) - :map cider-sesman-browser-map)) - -(declare-function cider "cider") -(cl-defmethod sesman-start-session ((_system (eql CIDER))) - "Start a connection of any type interactively. -Fallback on `cider' command." - (call-interactively #'cider)) - -(cl-defmethod sesman-quit-session ((_system (eql CIDER)) session) - (mapc #'cider--close-connection (cdr session)) - ;; if there are no more connections we can kill all ancillary buffers - (unless (cider-connected-p) - (cider-close-ancillary-buffers))) - -(cl-defmethod sesman-restart-session ((_system (eql CIDER)) session) - (let* ((ses-name (car session)) - (repls (cdr session)) - (srv-buf (cider--session-server session))) - (if srv-buf - ;; session with a server - (let ((s-params (cider--gather-connect-params nil srv-buf))) - ;; 1) kill all connections, but keep the buffers - (mapc (lambda (conn) - (cider--close-connection conn 'no-kill)) - repls) - ;; 2) kill the server - (nrepl-kill-server-buffer srv-buf) - ;; 3) start server - (nrepl-start-server-process - (plist-get s-params :project-dir) - (plist-get s-params :server-command) - (lambda (server-buf) - ;; 4) restart the repls reusing the buffer - (dolist (r repls) - (cider-nrepl-connect - (thread-first () - (cider--gather-connect-params r) - ;; server params (:port, :project-dir etc) have precedence - (cider--gather-connect-params server-buf) - (plist-put :session-name ses-name) - (plist-put :repl-buffer r)))) - (sesman-browser-revert-all 'CIDER) - (message "Restarted CIDER %s session" ses-name)))) - ;; server-less session - (dolist (r repls) - (cider--close-connection r 'no-kill) - (cider-nrepl-connect - (thread-first () - (cider--gather-connect-params r) - (plist-put :session-name ses-name) - (plist-put :repl-buffer r))))))) - -(defun cider-format-connection-params (template params) - "Format PARAMS with TEMPLATE string. -The following formats can be used in TEMPLATE string: - - %h - host - %H - remote host, empty for local hosts - %p - port - %j - short project name, or directory name if no project - %J - long project name including parent dir name - %r - REPL type (clj or cljs) - %S - type of the ClojureScript runtime (Nashorn, Node, Figwheel etc.) - %s - session name as defined by `cider-session-name-template'. - -In case some values are empty, extra separators (: and -) are automatically -removed." - (let* ((dir (directory-file-name - (abbreviate-file-name - (or (plist-get params :project-dir) - (clojure-project-dir (cider-current-dir)) - default-directory)))) - (short-proj (file-name-nondirectory (directory-file-name dir))) - (parent-dir (ignore-errors - (thread-first dir file-name-directory - directory-file-name file-name-nondirectory - file-name-as-directory))) - (long-proj (format "%s%s" (or parent-dir "") short-proj)) - ;; use `dir` if it is shorter than `long-proj` or `short-proj` - (short-proj (if (>= (length short-proj) (length dir)) - dir - short-proj)) - (long-proj (if (>= (length long-proj) (length dir)) - dir - long-proj)) - (port (or (plist-get params :port) "")) - (host (or (plist-get params :host) "localhost")) - (remote-host (if (member host '("localhost" "127.0.0.1")) - "" - host)) - (repl-type (or (plist-get params :repl-type) "unknown")) - (cljs-repl-type (or (and (equal repl-type "cljs") - (plist-get params :cljs-repl-type)) - "")) - (specs `((?h . ,host) - (?H . ,remote-host) - (?p . ,port) - (?j . ,short-proj) - (?J . ,long-proj) - (?r . ,repl-type) - (?S . ,cljs-repl-type))) - (ses-name (or (plist-get params :session-name) - (format-spec cider-session-name-template specs))) - (specs (append `((?s . ,ses-name)) specs))) - (thread-last (format-spec template specs) - ;; remove extraneous separators - (replace-regexp-in-string "\\([:-]\\)[:-]+" "\\1") - (replace-regexp-in-string "\\(^[:-]\\)\\|\\([:-]$\\)" "") - (replace-regexp-in-string "[:-]\\([])*]\\)" "\\1")))) - -(defun cider-make-session-name (params) - "Create new session name given plist of connection PARAMS. -Session name can be customized with `cider-session-name-template'." - (let* ((root-name (cider-format-connection-params cider-session-name-template params)) - (other-names (mapcar #'car (sesman-sessions 'CIDER))) - (name root-name) - (i 2)) - (while (member name other-names) - (setq name (concat root-name "#" (number-to-string i)) - i (+ i 1))) - name)) - - -;;; REPL Buffer Init - -(defvar-local cider-cljs-repl-type nil - "The type of the ClojureScript runtime (Nashorn, Node etc.)") - -(defvar-local cider-repl-type nil - "The type of this REPL buffer, usually either \"clj\" or \"cljs\".") - -(defun cider-repl-type (repl-buffer) - "Get REPL-BUFFER's type." - (buffer-local-value 'cider-repl-type repl-buffer)) - -(defun cider-repl-type-for-buffer (&optional buffer) - "Return the matching connection type (clj or cljs) for BUFFER. -BUFFER defaults to the `current-buffer'. In cljc buffers return -\"multi\". This function infers connection type based on the major mode. -For the REPL type use the function `cider-repl-type'." - (with-current-buffer (or buffer (current-buffer)) - (cond - ((derived-mode-p 'clojurescript-mode) "cljs") - ((derived-mode-p 'clojurec-mode) "multi") - ((derived-mode-p 'clojure-mode) "clj") - (cider-repl-type)))) - -(defun cider-set-repl-type (&optional type) - "Set REPL TYPE to \"clj\" or \"cljs\". -Assume that the current buffer is a REPL." - (interactive) - (let ((type (or type (completing-read - (format "Set REPL type (currently `%s') to: " - cider-repl-type) - '("clj" "cljs"))))) - (when (or (not (equal cider-repl-type type)) - (null mode-name)) - (setq cider-repl-type type) - (setq mode-name (format "REPL[%s]" type)) - (let ((params (cider--gather-connect-params))) - ;; We need to set current name to something else temporarily to avoid - ;; false name duplication in `nrepl-repl-buffer-name`. - (rename-buffer (generate-new-buffer-name "*dummy-cider-repl-buffer*")) - (rename-buffer (nrepl-repl-buffer-name params)) - (when (and nrepl-log-messages nrepl-messages-buffer) - (with-current-buffer nrepl-messages-buffer - (rename-buffer (nrepl-messages-buffer-name params)))))))) - -(defun cider--choose-reusable-repl-buffer (params) - "Find connection-less REPL buffer and ask the user for confirmation. -Return nil if no such buffers exists or the user has chosen not to reuse -the buffer. If multiple dead REPLs exist, ask the user to choose one. -PARAMS is a plist as received by `cider-repl-create'." - (when-let* ((repls (seq-filter (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'cider-repl-mode) - (not (process-live-p (get-buffer-process b)))))) - (buffer-list)))) - (let* ((proj-dir (plist-get params :project-dir)) - (host (plist-get params :host)) - (port (plist-get params :port)) - (cljsp (string-match-p "cljs" (plist-get params :repl-type))) - (scored-repls - (delq nil - (mapcar (lambda (b) - (let ((bparams (cider--gather-connect-params nil b))) - (when (eq cljsp (string-match-p "cljs" (plist-get bparams :repl-type))) - (cons (buffer-name b) - (+ - (if (equal proj-dir (plist-get bparams :project-dir)) 8 0) - (if (equal host (plist-get bparams :host)) 4 0) - (if (equal port (plist-get bparams :port)) 2 0)))))) - repls)))) - (when scored-repls - (if (> (length scored-repls) 1) - (when (y-or-n-p "Dead REPLs exist. Reuse? ") - (let ((sorted-repls (seq-sort (lambda (a b) (> (cdr a) (cdr b))) scored-repls))) - (get-buffer (completing-read "REPL to reuse: " - (mapcar #'car sorted-repls) nil t nil nil (caar sorted-repls))))) - (when (y-or-n-p (format "A dead REPL %s exists. Reuse? " (caar scored-repls))) - (get-buffer (caar scored-repls)))))))) - -(declare-function cider-default-err-handler "cider-eval") -(declare-function cider-repl-mode "cider-repl") -(declare-function cider-repl--state-handler "cider-repl") -(declare-function cider-repl-reset-markers "cider-repl") -(defvar-local cider-session-name nil) -(defvar-local cider-repl-init-function nil) -(defun cider-repl-create (params) - "Create new repl buffer. -PARAMS is a plist which contains :repl-type, :host, :port, :project-dir, -:repl-init-function and :session-name. When non-nil, :repl-init-function -must be a function with no arguments which is called after repl creation -function with the repl buffer set as current." - ;; Connection might not have been set as yet. Please don't send requests in - ;; this function, but use cider--connected-handler instead. - (let ((buffer (or (plist-get params :repl-buffer) - (cider--choose-reusable-repl-buffer params) - (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*")))) - (ses-name (or (plist-get params :session-name) - (cider-make-session-name params)))) - (with-current-buffer buffer - (setq-local sesman-system 'CIDER) - (setq-local default-directory (or (plist-get params :project-dir) default-directory)) - ;; creates a new session if session with ses-name doesn't already exist - (sesman-add-object 'CIDER ses-name buffer 'allow-new) - (unless (derived-mode-p 'cider-repl-mode) - (cider-repl-mode)) - (setq nrepl-err-handler #'cider-default-err-handler - ;; used as a new-repl marker in cider-set-repl-type - mode-name nil - cider-session-name ses-name - nrepl-project-dir (plist-get params :project-dir) - ;; REPLs start with clj and then "upgrade" to a different type - cider-repl-type (plist-get params :repl-type) - ;; ran at the end of cider--connected-handler - cider-repl-init-function (plist-get params :repl-init-function)) - (cider-repl-reset-markers) - (add-hook 'nrepl-response-handler-functions #'cider-repl--state-handler nil 'local) - (add-hook 'nrepl-connected-hook #'cider--connected-handler nil 'local) - (add-hook 'nrepl-disconnected-hook #'cider--disconnected-handler nil 'local) - (current-buffer)))) - - -;;; Current/other REPLs - -(defun cider--no-repls-user-error (type) - "Throw \"No REPL\" user error customized for TYPE." - (let ((type (cond - ((equal type "multi") - "clj or cljs") - ((listp type) - (mapconcat #'identity type " or ")) - (type)))) - (user-error "No %s REPLs in current session \"%s\"" - type (car (sesman-current-session 'CIDER))))) - -(defun cider-current-repl (&optional type ensure) - "Get the most recent REPL of TYPE from the current session. -TYPE is either \"clj\", \"cljs\", \"multi\" or \"any\". -When nil, infer the type from the current buffer. \"multi\" or \"any\" -are synonyms. If ENSURE is non-nil, throw an error if either there is -no linked session or there is no REPL of TYPE within the current session." - (if (and (derived-mode-p 'cider-repl-mode) - (or (null type) - (string= cider-repl-type type))) - ;; shortcut when in REPL buffer - (current-buffer) - (let* ((type (if (equal type "any") "multi" type)) - (type (or type (cider-repl-type-for-buffer))) - (repls (cider-repls type ensure)) - (repl (if (<= (length repls) 1) - (car repls) - ;; pick the most recent one - (seq-find (lambda (b) - (member b repls)) - (buffer-list))))) - (if (and ensure (null repl)) - (cider--no-repls-user-error type) - repl)))) - -(defun cider--match-repl-type (type buffer) - "Return non-nil if TYPE matches BUFFER's REPL type." - (let ((buffer-repl-type (cider-repl-type buffer))) - (cond ((null buffer-repl-type) nil) - ((or (null type) (equal type "multi")) t) - ((listp type) (member buffer-repl-type type)) - (t (string= type buffer-repl-type))))) - -(defun cider-repls (&optional type ensure) - "Return cider REPLs of TYPE from the current session. -If TYPE is nil or \"multi\", return all repls. If TYPE is a list of types, -return only REPLs of type contained in the list. If ENSURE is non-nil, -throw an error if no linked session exists." - (let ((repls (cdr (if ensure - (sesman-ensure-session 'CIDER) - (sesman-current-session 'CIDER))))) - (or (seq-filter (lambda (b) - (cider--match-repl-type type b)) - repls) - (when ensure - (cider--no-repls-user-error type))))) - -(defun cider-map-repls (which function) - "Call FUNCTION once for each appropriate REPL as indicated by WHICH. -The function is called with one argument, the REPL buffer. The appropriate -connections are found by inspecting the current buffer. WHICH is one of -the following keywords: - :auto - Act on the connections whose type matches the current buffer. In - `cljc' files, mapping happens over both types of REPLs. - :clj (:cljs) - Map over clj (cljs)) REPLs only. - :clj-strict (:cljs-strict) - Map over clj (cljs) REPLs but signal a - `user-error' in `clojurescript-mode' (`clojure-mode'). Use this for - commands only supported in Clojure (ClojureScript). -Error is signaled if no REPL buffers of specified type exist in current -session." - (declare (indent 1)) - (let ((cur-type (cider-repl-type-for-buffer))) - (cl-case which - (:clj-strict (when (equal cur-type "cljs") - (user-error "Clojure-only operation requested in a ClojureScript buffer"))) - (:cljs-strict (when (equal cur-type "clj") - (user-error "ClojureScript-only operation requested in a Clojure buffer")))) - (let* ((type (cl-case which - ((:clj :clj-strict) "clj") - ((:cljs :cljs-strict) "cljs") - (:auto (if (equal cur-type "multi") - '("clj" "cljs") - cur-type)))) - (repls (cider-repls type 'ensure))) - (mapcar function repls)))) - -;; REPLs double as connections in CIDER, so it's useful to be able to refer to -;; them as connections in certain contexts. -(defalias 'cider-current-connection #'cider-current-repl) -(defalias 'cider-connections #'cider-repls) -(defalias 'cider-map-connections #'cider-map-repls) -(defalias 'cider-connection-type-for-buffer #'cider-repl-type-for-buffer) - - -;; Deprecation after #2324 - -(define-obsolete-function-alias 'cider-current-repl-buffer 'cider-current-repl "0.18") -(define-obsolete-function-alias 'cider-repl-buffers 'cider-repls "0.18") -(define-obsolete-function-alias 'cider-current-session 'cider-nrepl-eval-session "0.18") -(define-obsolete-function-alias 'cider-current-tooling-session 'cider-nrepl-tooling-session "0.18") -(define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-connection "0.18") -(define-obsolete-function-alias 'nrepl-connection-buffer-name 'nrepl-repl-buffer-name "0.18") -(define-obsolete-function-alias 'cider-repl-set-type 'cider-set-repl-type "0.18") - -(make-obsolete 'cider-assoc-buffer-with-connection 'sesman-link-with-buffer "0.18") -(make-obsolete 'cider-assoc-project-with-connection 'sesman-link-with-project "0.18") -(make-obsolete 'cider-change-buffers-designation nil "0.18") -(make-obsolete 'cider-clear-buffer-local-connection nil "0.18") -(make-obsolete 'cider-close-nrepl-session 'cider-quit "0.18") -(make-obsolete 'cider-create-sibling-cljs-repl 'cider-connect-sibling-cljs "0.18") -(make-obsolete 'cider-current-messages-buffer nil "0.18") -(make-obsolete 'cider-default-connection "see sesman." "0.18") -(make-obsolete 'cider-extract-designation-from-current-repl-buffer nil "0.18") -(make-obsolete 'cider-find-connection-buffer-for-project-directory 'sesman-current-sessions "0.18") -(make-obsolete 'cider-find-reusable-repl-buffer nil "0.18") -(make-obsolete 'cider-make-connection-default "see sesman." "0.18") -(make-obsolete 'cider-other-connection nil "0.18") -(make-obsolete 'cider-project-connections 'sesman-current-sessions "0.18") -(make-obsolete 'cider-project-connections-types nil "0.18") -(make-obsolete 'cider-prompt-for-project-on-connect nil "0.18") -(make-obsolete 'cider-read-connection `sesman-ask-for-session "0.18") -(make-obsolete 'cider-replicate-connection nil "0.18") -(make-obsolete 'cider-request-dispatch "see sesman." "0.18") -(make-obsolete 'cider-rotate-default-connection "see sesman." "0.18") -(make-obsolete 'cider-toggle-buffer-connection nil "0.18") -(make-obsolete 'cider-toggle-request-dispatch nil "0.18") -(make-obsolete 'nrepl-connection-buffer-name-template 'nrepl-repl-buffer-name-template "0.18") -(make-obsolete 'nrepl-create-client-buffer-function nil "0.18") -(make-obsolete 'nrepl-post-client-callback nil "0.18") -(make-obsolete 'nrepl-prompt-to-kill-server-buffer-on-quit nil "0.18") -(make-obsolete 'nrepl-use-this-as-repl-buffer nil "0.18") - -;; connection manager -(make-obsolete 'cider-client-name-repl-type "see sesman." "0.18") -(make-obsolete 'cider-connection-browser "see sesman." "0.18") -(make-obsolete 'cider-connections-buffer-mode "see sesman." "0.18") -(make-obsolete 'cider-connections-buffer-mode-map "see sesman." "0.18") -(make-obsolete 'cider-connections-close-connection "see sesman." "0.18") -(make-obsolete 'cider-connections-goto-connection "see sesman." "0.18") -(make-obsolete 'cider-connections-make-default "see sesman." "0.18") -(make-obsolete 'cider-display-connected-message "see sesman." "0.18") -(make-obsolete 'cider-project-name "see sesman." "0.18") - -(provide 'cider-connection) - -;;; cider-connection.el ends here diff --git a/elpa/cider-20181110.1413/cider-debug.el b/elpa/cider-20181110.1413/cider-debug.el deleted file mode 100644 index b8cc2f48..00000000 --- a/elpa/cider-20181110.1413/cider-debug.el +++ /dev/null @@ -1,756 +0,0 @@ -;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*- - -;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Instrument code with `cider-debug-defun-at-point', and when the code is -;; executed cider-debug will kick in. See this function's doc for more -;; information. - -;;; Code: - -(require 'nrepl-dict) -(require 'nrepl-client) ; `nrepl--mark-id-completed' -(require 'cider-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") - (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" (cider-debug-mode-send-reply ":continue") :keys "c"] - ["Continue non-stop" (cider-debug-mode-send-reply ":Continue") :keys "C"] - ["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"] - ["Quit" (cider-debug-mode-send-reply ":quit") :keys "q"] - "--" - ["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 - (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/elpa/cider-20181110.1413/cider-doc.el b/elpa/cider-20181110.1413/cider-doc.el deleted file mode 100644 index 5cca0505..00000000 --- a/elpa/cider-20181110.1413/cider-doc.el +++ /dev/null @@ -1,533 +0,0 @@ -;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Bozhidar Batsov, Jeff Valk and CIDER contributors - -;; Author: Jeff Valk - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Mode for formatting and presenting documentation - -;;; Code: - -(require 'cider-common) -(require '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 "") #'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/elpa/cider-20181110.1413/cider-eldoc.el b/elpa/cider-20181110.1413/cider-eldoc.el deleted file mode 100644 index b055824d..00000000 --- a/elpa/cider-20181110.1413/cider-eldoc.el +++ /dev/null @@ -1,481 +0,0 @@ -;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; eldoc support for Clojure. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) ; for cider-symbol-at-point -(require '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/elpa/cider-20181110.1413/cider-eval.el b/elpa/cider-20181110.1413/cider-eval.el deleted file mode 100644 index 643fc93a..00000000 --- a/elpa/cider-20181110.1413/cider-eval.el +++ /dev/null @@ -1,1116 +0,0 @@ -;;; cider-eval.el --- Interactive evaluation (compilation) functionality -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This file contains CIDER's interactive evaluation (compilation) functionality. -;; Although Clojure doesn't really have the concept of evaluation (only -;; compilation), we're using everywhere in the code the term evaluation for -;; brevity (and to be in line with the naming employed by other similar modes). -;; -;; This files also contains all the logic related to displaying errors and -;; evaluation warnings. -;; -;; Pretty much all of the commands here are meant to be used mostly from -;; `cider-mode', but some of them might make sense in other contexts as well. - -;;; Code: - -(require 'cider-client) -(require 'cider-repl) -(require 'cider-popup) -(require 'cider-common) -(require 'cider-util) -(require 'cider-stacktrace) -(require 'cider-overlays) -(require 'cider-compat) - -(require 'clojure-mode) -(require 'ansi-color) -(require 'cl-lib) -(require 'subr-x) -(require 'compile) - -(defconst cider-read-eval-buffer "*cider-read-eval*") -(defconst cider-result-buffer "*cider-result*") - -(defcustom cider-show-error-buffer t - "Control the popup behavior of cider stacktraces. -The following values are possible t or 'always, 'except-in-repl, -'only-in-repl. Any other value, including nil, will cause the stacktrace -not to be automatically shown. - -Irespective of the value of this variable, the `cider-error-buffer' is -always generated in the background. Use `cider-selector' to -navigate to this buffer." - :type '(choice (const :tag "always" t) - (const except-in-repl) - (const only-in-repl) - (const :tag "never" nil)) - :group 'cider) - -(defcustom cider-auto-jump-to-error t - "Control the cursor jump behaviour in compilation error buffer. -When non-nil automatically jump to error location during interactive -compilation. When set to 'errors-only, don't jump to warnings. -When set to nil, don't jump at all." - :type '(choice (const :tag "always" t) - (const errors-only) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-auto-select-error-buffer t - "Controls whether to auto-select the error popup buffer." - :type 'boolean - :group 'cider) - -(defcustom cider-auto-track-ns-form-changes t - "Controls whether to auto-evaluate a source buffer's ns form when changed. -When non-nil CIDER will check for ns form changes before each eval command. -When nil the users are expected to take care of the re-evaluating updated -ns forms manually themselves." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.0")) - -(defcustom cider-save-file-on-load 'prompt - "Controls whether to prompt to save the file when loading a buffer. -If nil, files are not saved. -If 'prompt, the user is prompted to save the file if it's been modified. -If t, save the file without confirmation." - :type '(choice (const prompt :tag "Prompt to save the file if it's been modified") - (const nil :tag "Don't save the file") - (const t :tag "Save the file without confirmation")) - :group 'cider - :package-version '(cider . "0.6.0")) - - -(defconst cider-output-buffer "*cider-out*") - -(defcustom cider-interactive-eval-output-destination 'repl-buffer - "The destination for stdout and stderr produced from interactive evaluation." - :type '(choice (const output-buffer) - (const repl-buffer)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defface cider-error-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "red") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline t))) - "Face used to highlight compilation errors in Clojure buffers." - :group 'cider) - -(defface cider-warning-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "yellow") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline (:color "yellow")))) - "Face used to highlight compilation warnings in Clojure buffers." - :group 'cider) - -(defcustom cider-comment-prefix ";; => " - "The prefix to insert before the first line of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-comment-continued-prefix ";; " - "The prefix to use on the second and subsequent lines of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-comment-postfix "" - "The postfix to be appended after the final line of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - - -;;; Utilities - -(defun cider--clear-compilation-highlights () - "Remove compilation highlights." - (remove-overlays (point-min) (point-max) 'cider-note-p t)) - -(defun cider-clear-compilation-highlights (&optional arg) - "Remove compilation highlights. -When invoked with a prefix ARG the command doesn't prompt for confirmation." - (interactive "P") - (when (or arg (y-or-n-p "Are you sure you want to clear the compilation highlights? ")) - (cider--clear-compilation-highlights))) - -(defun cider--quit-error-window () - "Buries the `cider-error-buffer' and quits its containing window." - (when-let* ((error-win (get-buffer-window cider-error-buffer))) - (quit-window nil error-win))) - - -;;; Dealing with compilation (evaluation) errors and warnings -(defun cider-find-property (property &optional backward) - "Find the next text region which has the specified PROPERTY. -If BACKWARD is t, then search backward. -Returns the position at which PROPERTY was found, or nil if not found." - (let ((p (if backward - (previous-single-char-property-change (point) property) - (next-single-char-property-change (point) property)))) - (when (and (not (= p (point-min))) (not (= p (point-max)))) - p))) - -(defun cider-jump-to-compilation-error (&optional _arg _reset) - "Jump to the line causing the current compilation error. -_ARG and _RESET are ignored, as there is only ever one compilation error. -They exist for compatibility with `next-error'." - (interactive) - (cl-labels ((goto-next-note-boundary - () - (let ((p (or (cider-find-property 'cider-note-p) - (cider-find-property 'cider-note-p t)))) - (when p - (goto-char p) - (message "%s" (get-char-property p 'cider-note)))))) - ;; if we're already on a compilation error, first jump to the end of - ;; it, so that we find the next error. - (when (get-char-property (point) 'cider-note-p) - (goto-next-note-boundary)) - (goto-next-note-boundary))) - -(defun cider--show-error-buffer-p () - "Return non-nil if the error buffer must be shown on error. -Takes into account both the value of `cider-show-error-buffer' and the -currently selected buffer." - (let* ((selected-buffer (window-buffer (selected-window))) - (replp (with-current-buffer selected-buffer (derived-mode-p 'cider-repl-mode)))) - (memq cider-show-error-buffer - (if replp - '(t always only-in-repl) - '(t always except-in-repl))))) - -(defun cider-new-error-buffer (&optional mode error-types) - "Return an empty error buffer using MODE. - -When deciding whether to display the buffer, takes into account not only -the value of `cider-show-error-buffer' and the currently selected buffer -but also the ERROR-TYPES of the error, which is checked against the -`cider-stacktrace-suppressed-errors' set. - -When deciding whether to select the buffer, takes into account the value of -`cider-auto-select-error-buffer'." - (if (and (cider--show-error-buffer-p) - (not (cider-stacktrace-some-suppressed-errors-p error-types))) - (cider-popup-buffer cider-error-buffer cider-auto-select-error-buffer mode 'ancillary) - (cider-make-popup-buffer cider-error-buffer mode 'ancillary))) - -(defun cider-emit-into-color-buffer (buffer value) - "Emit into color BUFFER the provided VALUE." - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (goto-char (point-max)) - (insert (format "%s" value)) - (ansi-color-apply-on-region (point-min) (point-max))) - (goto-char (point-min)))) - -(defun cider--handle-err-eval-response (response) - "Render eval RESPONSE into a new error buffer. - -Uses the value of the `out' slot in RESPONSE." - (nrepl-dbind-response response (out) - (when out - (let ((error-buffer (cider-new-error-buffer))) - (cider-emit-into-color-buffer error-buffer out) - (with-current-buffer error-buffer - (compilation-minor-mode +1)))))) - -(defun cider-default-err-eval-handler () - "Display the last exception without middleware support." - (cider--handle-err-eval-response - (cider-nrepl-sync-request:eval - "(clojure.stacktrace/print-cause-trace *e)"))) - -(defun cider--render-stacktrace-causes (causes &optional error-types) - "If CAUSES is non-nil, render its contents into a new error buffer. -Optional argument ERROR-TYPES contains a list which should determine the -op/situation that originated this error." - (when causes - (let ((error-buffer (cider-new-error-buffer #'cider-stacktrace-mode error-types))) - (cider-stacktrace-render error-buffer (reverse causes) error-types)))) - -(defun cider--handle-stacktrace-response (response causes) - "Handle stacktrace op RESPONSE, aggregating the result into CAUSES. -If RESPONSE contains a cause, cons it onto CAUSES and return that. If -RESPONSE is the final message (i.e. it contains a status), render CAUSES -into a new error buffer." - (nrepl-dbind-response response (class status) - (cond (class (cons response causes)) - (status (cider--render-stacktrace-causes causes))))) - -(defun cider-default-err-op-handler () - "Display the last exception, with middleware support." - ;; Causes are returned as a series of messages, which we aggregate in `causes' - (let (causes) - (cider-nrepl-send-request - (nconc '("op" "stacktrace") - (when (cider--pprint-fn) - `("pprint-fn" ,(cider--pprint-fn))) - (when cider-stacktrace-print-length - `("print-length" ,cider-stacktrace-print-length)) - (when cider-stacktrace-print-level - `("print-level" ,cider-stacktrace-print-level))) - (lambda (response) - ;; While the return value of `cider--handle-stacktrace-response' is not - ;; meaningful for the last message, we do not need the value of `causes' - ;; after it has been handled, so it's fine to set it unconditionally here - (setq causes (cider--handle-stacktrace-response response causes)))))) - -(defun cider-default-err-handler () - "This function determines how the error buffer is shown. -It delegates the actual error content to the eval or op handler." - (if (cider-nrepl-op-supported-p "stacktrace") - (cider-default-err-op-handler) - (cider-default-err-eval-handler))) - -(defvar cider-compilation-regexp - '("\\(?:.*\\(warning, \\)\\|.*?\\(, compiling\\):(\\)\\(.*?\\):\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\(\\(?: - \\(.*\\)\\)\\|)\\)" 3 4 5 (1)) - "Specifications for matching errors and warnings in Clojure stacktraces. -See `compilation-error-regexp-alist' for help on their format.") - -(add-to-list 'compilation-error-regexp-alist-alist - (cons 'cider cider-compilation-regexp)) -(add-to-list 'compilation-error-regexp-alist 'cider) - -(defun cider-extract-error-info (regexp message) - "Extract error information with REGEXP against MESSAGE." - (let ((file (nth 1 regexp)) - (line (nth 2 regexp)) - (col (nth 3 regexp)) - (type (nth 4 regexp)) - (pat (car regexp))) - (when (string-match pat message) - ;; special processing for type (1.2) style - (setq type (if (consp type) - (or (and (car type) (match-end (car type)) 1) - (and (cdr type) (match-end (cdr type)) 0) - 2))) - (list - (when file - (let ((val (match-string-no-properties file message))) - (unless (string= val "NO_SOURCE_PATH") val))) - (when line (string-to-number (match-string-no-properties line message))) - (when col - (let ((val (match-string-no-properties col message))) - (when val (string-to-number val)))) - (aref [cider-warning-highlight-face - cider-warning-highlight-face - cider-error-highlight-face] - (or type 2)) - message)))) - -(defun cider--goto-expression-start () - "Go to the beginning a list, vector, map or set outside of a string. -We do so by starting and the current position and proceeding backwards -until we find a delimiters that's not inside a string." - (if (and (looking-back "[])}]" (line-beginning-position)) - (null (nth 3 (syntax-ppss)))) - (backward-sexp) - (while (or (not (looking-at-p "[({[]")) - (nth 3 (syntax-ppss))) - (backward-char)))) - -(defun cider--find-last-error-location (message) - "Return the location (begin end buffer) from the Clojure error MESSAGE. -If location could not be found, return nil." - (save-excursion - (let ((info (cider-extract-error-info cider-compilation-regexp message))) - (when info - (let ((file (nth 0 info)) - (line (nth 1 info)) - (col (nth 2 info))) - (unless (or (not (stringp file)) - (cider--tooling-file-p file)) - (when-let* ((buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)) - (move-to-column (or col 0)) - (let ((begin (progn (if col (cider--goto-expression-start) (back-to-indentation)) - (point))) - (end (progn (if col (forward-list) (move-end-of-line nil)) - (point)))) - (list begin end buffer)))))))))))) - -(defun cider-handle-compilation-errors (message eval-buffer) - "Highlight and jump to compilation error extracted from MESSAGE. -EVAL-BUFFER is the buffer that was current during user's interactive -evaluation command. Honor `cider-auto-jump-to-error'." - (when-let* ((loc (cider--find-last-error-location message)) - (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc))) - (info (cider-extract-error-info cider-compilation-regexp message))) - (let* ((face (nth 3 info)) - (note (nth 4 info)) - (auto-jump (if (eq cider-auto-jump-to-error 'errors-only) - (not (or (eq face 'cider-warning-highlight-face) - (string-match-p "warning" note))) - cider-auto-jump-to-error))) - (overlay-put overlay 'cider-note-p t) - (overlay-put overlay 'font-lock-face face) - (overlay-put overlay 'cider-note note) - (overlay-put overlay 'help-echo note) - (overlay-put overlay 'modification-hooks - (list (lambda (o &rest _args) (delete-overlay o)))) - (when auto-jump - (with-current-buffer eval-buffer - (push-mark) - ;; At this stage selected window commonly is *cider-error* and we need to - ;; re-select the original user window. If eval-buffer is not - ;; visible it was probably covered as a result of a small screen or user - ;; configuration (https://github.com/clojure-emacs/cider/issues/847). In - ;; that case we don't jump at all in order to avoid covering *cider-error* - ;; buffer. - (when-let* ((win (get-buffer-window eval-buffer))) - (with-selected-window win - (cider-jump-to (nth 2 loc) (car loc))))))))) - - -;;; Interactive evaluation handlers -(defun cider-insert-eval-handler (&optional buffer) - "Make an nREPL evaluation handler for the BUFFER. -The handler simply inserts the result value in BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (with-current-buffer buffer - (insert value))) - (lambda (_buffer out) - (cider-repl-emit-interactive-stdout out)) - (lambda (_buffer err) - (cider-handle-compilation-errors err eval-buffer)) - '()))) - -(defun cider--emit-interactive-eval-output (output repl-emit-function) - "Emit output resulting from interactive code evaluation. -The OUTPUT can be sent to either a dedicated output buffer or the current -REPL buffer. This is controlled by `cider-interactive-eval-output-destination'. -REPL-EMIT-FUNCTION emits the OUTPUT." - (pcase cider-interactive-eval-output-destination - (`output-buffer (let ((output-buffer (or (get-buffer cider-output-buffer) - (cider-popup-buffer cider-output-buffer t)))) - (cider-emit-into-popup-buffer output-buffer output) - (pop-to-buffer output-buffer))) - (`repl-buffer (funcall repl-emit-function output)) - (_ (error "Unsupported value %s for `cider-interactive-eval-output-destination'" - cider-interactive-eval-output-destination)))) - -(defun cider-emit-interactive-eval-output (output) - "Emit OUTPUT resulting from interactive code evaluation. -The output can be send to either a dedicated output buffer or the current -REPL buffer. This is controlled via -`cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stdout)) - -(defun cider-emit-interactive-eval-err-output (output) - "Emit err OUTPUT resulting from interactive code evaluation. -The output can be send to either a dedicated output buffer or the current -REPL buffer. This is controlled via -`cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stderr)) - -(defun cider--make-fringe-overlays-for-region (beg end) - "Place eval indicators on all sexps between BEG and END." - (with-current-buffer (if (markerp end) - (marker-buffer end) - (current-buffer)) - (save-excursion - (goto-char beg) - (remove-overlays beg end 'category 'cider-fringe-indicator) - (condition-case nil - (while (progn (clojure-forward-logical-sexp) - (and (<= (point) end) - (not (eobp)))) - (cider--make-fringe-overlay (point))) - (scan-error nil))))) - -(defun cider-interactive-eval-handler (&optional buffer place) - "Make an interactive eval handler for BUFFER. -PLACE is used to display the evaluation result. -If non-nil, it can be the position where the evaluated sexp ends, -or it can be a list with (START END) of the evaluated region." - (let* ((eval-buffer (current-buffer)) - (beg (car-safe place)) - (end (or (car-safe (cdr-safe place)) place)) - (beg (when beg (copy-marker beg))) - (end (when end (copy-marker end))) - (fringed nil)) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (if beg - (unless fringed - (cider--make-fringe-overlays-for-region beg end) - (setq fringed t)) - (cider--make-fringe-overlay end)) - (cider--display-interactive-eval-result value end)) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err) - (cider-handle-compilation-errors err eval-buffer)) - '()))) - -(defun cider-load-file-handler (&optional buffer) - "Make a load file handler for BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (buffer value) - (cider--display-interactive-eval-result value) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (cider--make-fringe-overlays-for-region (point-min) (point-max)) - (run-hooks 'cider-file-loaded-hook)))) - (lambda (_buffer value) - (cider-emit-interactive-eval-output value)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err) - (cider-handle-compilation-errors err eval-buffer)) - '() - (lambda () - (funcall nrepl-err-handler))))) - -(defun cider-eval-print-handler (&optional buffer) - "Make a handler for evaluating and printing result in BUFFER." - (nrepl-make-response-handler (or buffer (current-buffer)) - (lambda (buffer value) - (with-current-buffer buffer - (insert - (if (derived-mode-p 'cider-clojure-interaction-mode) - (format "\n%s\n" value) - value)))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - '())) - -(defun cider-eval-print-with-comment-handler (buffer location comment-prefix) - "Make a handler for evaluating and printing commented results in BUFFER. -LOCATION is the location at which to insert. COMMENT-PREFIX is the comment -prefix to use." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (with-current-buffer buffer - (save-excursion - (goto-char location) - (insert (concat comment-prefix - value "\n"))))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - '())) - -(defun cider-eval-pprint-with-multiline-comment-handler (buffer location comment-prefix continued-prefix comment-postfix) - "Make a handler for evaluating and inserting results in BUFFER. -The inserted text is pretty-printed and region will be commented. -LOCATION is the location at which to insert. -COMMENT-PREFIX is the comment prefix for the first line of output. -CONTINUED-PREFIX is the comment prefix to use for the remaining lines. -COMMENT-POSTFIX is the text to output after the last line." - (cl-flet ((multiline-comment-handler (buffer value) - (with-current-buffer buffer - (save-excursion - (goto-char location) - (let ((lines (split-string value "[\n]+" t))) - ;; only the first line gets the normal comment-prefix - (insert (concat comment-prefix (pop lines))) - (dolist (elem lines) - (insert (concat "\n" continued-prefix elem))) - (unless (string= comment-postfix "") - (insert comment-postfix))))))) - (nrepl-make-response-handler buffer - '() - #'multiline-comment-handler - #'multiline-comment-handler - '()))) - -(defun cider-popup-eval-out-handler (&optional buffer) - "Make a handler for evaluating and printing stdout/stderr in popup BUFFER. -This is used by pretty-printing commands and intentionally discards their results." - (cl-flet ((popup-output-handler (buffer str) - (cider-emit-into-popup-buffer buffer - (ansi-color-apply str) - nil - t))) - (nrepl-make-response-handler (or buffer (current-buffer)) - '() - ;; stdout handler - #'popup-output-handler - ;; stderr handler - #'popup-output-handler - '()))) - - -;;; Interactive valuation commands - -(defvar cider-to-nrepl-filename-function - (with-no-warnings - (if (eq system-type 'cygwin) - #'cygwin-convert-file-name-to-windows - #'identity)) - "Function to translate Emacs filenames to nREPL namestrings.") - -(defun cider--prep-interactive-eval (form connection) - "Prepare the environment for an interactive eval of FORM in CONNECTION. -Ensure the current ns declaration has been evaluated (so that the ns -containing FORM exists). Cache ns-form in the current buffer unless FORM is -ns declaration itself. Clear any compilation highlights and kill the error -window." - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((cur-ns-form (cider-ns-form))) - (when (and cur-ns-form - (not (cider-ns-form-p form)) - (cider-repl--ns-form-changed-p cur-ns-form connection)) - (when cider-auto-track-ns-form-changes - ;; The first interactive eval on a file can load a lot of libs. This can - ;; easily lead to more than 10 sec. - (let ((nrepl-sync-request-timeout 30)) - ;; TODO: check for evaluation errors - (cider-nrepl-sync-request:eval cur-ns-form connection))) - ;; cache at the end, in case of errors - (cider-repl--cache-ns-form cur-ns-form connection)))) - -(defvar-local cider-interactive-eval-override nil - "Function to call instead of `cider-interactive-eval'.") - -(defun cider-interactive-eval (form &optional callback bounds additional-params) - "Evaluate FORM and dispatch the response to CALLBACK. -If the code to be evaluated comes from a buffer, it is preferred to use a -nil FORM, and specify the code via the BOUNDS argument instead. - -This function is the main entry point in CIDER's interactive evaluation -API. Most other interactive eval functions should rely on this function. -If CALLBACK is nil use `cider-interactive-eval-handler'. -BOUNDS, if non-nil, is a list of two numbers marking the start and end -positions of FORM in its buffer. -ADDITIONAL-PARAMS is a plist to be appended to the request message. - -If `cider-interactive-eval-override' is a function, call it with the same -arguments and only proceed with evaluation if it returns nil." - (let ((form (or form (apply #'buffer-substring-no-properties bounds))) - (start (car-safe bounds)) - (end (car-safe (cdr-safe bounds)))) - (when (and start end) - (remove-overlays start end 'cider-temporary t)) - (unless (and cider-interactive-eval-override - (functionp cider-interactive-eval-override) - (funcall cider-interactive-eval-override form callback bounds)) - (cider-map-repls :auto - (lambda (connection) - (cider--prep-interactive-eval form connection) - (cider-nrepl-request:eval - form - (or callback (cider-interactive-eval-handler nil bounds)) - ;; always eval ns forms in the user namespace - ;; otherwise trying to eval ns form for the first time will produce an error - (if (cider-ns-form-p form) "user" (cider-current-ns)) - (when start (line-number-at-pos start)) - (when start (cider-column-number-at-pos start)) - additional-params - connection)))))) - -(defun cider-eval-region (start end) - "Evaluate the region between START and END." - (interactive "r") - (cider-interactive-eval nil nil (list start end))) - -(defun cider-eval-last-sexp (&optional output-to-current-buffer) - "Evaluate the expression preceding point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer." - (interactive "P") - (cider-interactive-eval nil - (when output-to-current-buffer (cider-eval-print-handler)) - (cider-last-sexp 'bounds))) - -(defun cider-eval-last-sexp-and-replace () - "Evaluate the expression preceding point and replace it with its result." - (interactive) - (let ((last-sexp (cider-last-sexp))) - ;; we have to be sure the evaluation won't result in an error - (cider-nrepl-sync-request:eval last-sexp) - ;; seems like the sexp is valid, so we can safely kill it - (backward-kill-sexp) - (cider-interactive-eval last-sexp (cider-eval-print-handler)))) - -(defun cider-eval-sexp-at-point (&optional output-to-current-buffer) - "Evaluate the expression around point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." - (interactive "P") - (save-excursion - (goto-char (cadr (cider-sexp-at-point 'bounds))) - (cider-eval-last-sexp output-to-current-buffer))) - -(defvar-local cider-previous-eval-context nil - "The previous evaluation context if any. -That's set by commands like `cider-eval-last-sexp-in-context'.") - -(defun cider--eval-in-context (code) - "Evaluate CODE in user-provided evaluation context." - (let* ((code (string-trim-right code)) - (eval-context (read-string - (format "Evaluation context (let-style) for `%s': " code) - cider-previous-eval-context)) - (code (concat "(let [" eval-context "]\n " code ")"))) - (cider-interactive-eval code) - (setq-local cider-previous-eval-context eval-context))) - -(defun cider-eval-last-sexp-in-context () - "Evaluate the preceding sexp in user-supplied context. -The context is just a let binding vector (without the brackets). -The context is remembered between command invocations." - (interactive) - (cider--eval-in-context (cider-last-sexp))) - -(defun cider-eval-sexp-at-point-in-context () - "Evaluate the preceding sexp in user-supplied context. - -The context is just a let binding vector (without the brackets). -The context is remembered between command invocations." - (interactive) - (cider--eval-in-context (cider-sexp-at-point))) - -(defun cider-eval-defun-to-comment (&optional insert-before) - "Evaluate the \"top-level\" form and insert result as comment. - -The formatting of the comment is defined in `cider-comment-prefix' -which, by default, is \";; => \" and can be customized. - -With the prefix arg INSERT-BEFORE, insert before the form, otherwise afterwards." - (interactive "P") - (let* ((bounds (cider-defun-at-point 'bounds)) - (insertion-point (nth (if insert-before 0 1) bounds))) - (cider-interactive-eval nil - (cider-eval-print-with-comment-handler - (current-buffer) - insertion-point - cider-comment-prefix) - bounds))) - -(defun cider-pprint-form-to-comment (form-fn insert-before) - "Evaluate the form selected by FORM-FN and insert result as comment. -FORM-FN can be either `cider-last-sexp' or `cider-defun-at-point'. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (let* ((bounds (funcall form-fn 'bounds)) - (insertion-point (nth (if insert-before 0 1) bounds)) - ;; when insert-before, we need a newline after the output to - ;; avoid commenting the first line of the form - (comment-postfix (concat cider-comment-postfix - (if insert-before "\n" "")))) - (cider-interactive-eval nil - (cider-eval-pprint-with-multiline-comment-handler - (current-buffer) - insertion-point - cider-comment-prefix - cider-comment-continued-prefix - comment-postfix) - bounds - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) - -(defun cider-pprint-eval-last-sexp-to-comment (&optional insert-before) - "Evaluate the last sexp and insert result as comment. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (interactive "P") - (cider-pprint-form-to-comment 'cider-last-sexp insert-before)) - -(defun cider-pprint-eval-defun-to-comment (&optional insert-before) - "Evaluate the \"top-level\" form and insert result as comment. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (interactive "P") - (cider-pprint-form-to-comment 'cider-defun-at-point insert-before)) - -(declare-function cider-switch-to-repl-buffer "cider-mode") - -(defun cider-eval-last-sexp-to-repl (&optional prefix) - "Evaluate the expression preceding point and insert its result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider-interactive-eval nil - (cider-insert-eval-handler (cider-current-repl)) - (cider-last-sexp 'bounds)) - (when prefix - (cider-switch-to-repl-buffer))) - -(defun cider-pprint-eval-last-sexp-to-repl (&optional prefix) - "Evaluate expr before point and insert its pretty-printed result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider-interactive-eval nil - (cider-insert-eval-handler (cider-current-repl)) - (cider-last-sexp 'bounds) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))) - (when prefix - (cider-switch-to-repl-buffer))) - -(defun cider-eval-print-last-sexp () - "Evaluate the expression preceding point. -Print its value into the current buffer." - (interactive) - (cider-interactive-eval nil - (cider-eval-print-handler) - (cider-last-sexp 'bounds))) - -(defun cider--pprint-eval-form (form) - "Pretty print FORM in popup buffer." - (let* ((result-buffer (cider-popup-buffer cider-result-buffer nil 'clojure-mode 'ancillary)) - (handler (cider-popup-eval-out-handler result-buffer))) - (cider-interactive-eval (when (stringp form) form) - handler - (when (consp form) form) - (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) - -(defun cider-pprint-eval-last-sexp (&optional output-to-current-buffer) - "Evaluate the sexp preceding point and pprint its value. -If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current -buffer, else display in a popup buffer." - (interactive "P") - (if output-to-current-buffer - (cider-pprint-eval-last-sexp-to-comment) - (cider--pprint-eval-form (cider-last-sexp 'bounds)))) - -(defun cider--prompt-and-insert-inline-dbg () - "Insert a #dbg button at the current sexp." - (save-excursion - (let ((beg)) - (skip-chars-forward "\r\n[:blank:]") - (unless (looking-at-p "(") - (ignore-errors (backward-up-list))) - (setq beg (point)) - (let* ((cond (cider-read-from-minibuffer "Condition for debugging (leave empty for \"always\"): ")) - (button (propertize (concat "#dbg" - (unless (equal cond "") - (format " ^{:break/when %s}" cond))) - 'font-lock-face 'cider-fragile-button-face))) - (when (> (current-column) 30) - (insert "\n") - (indent-according-to-mode)) - (insert button) - (when (> (current-column) 40) - (insert "\n") - (indent-according-to-mode))) - (make-button beg (point) - 'help-echo "Breakpoint. Reevaluate this form to remove it." - :type 'cider-fragile)))) - -(defun cider-eval-defun-at-point (&optional debug-it) - "Evaluate the current toplevel form, and print result in the minibuffer. -With DEBUG-IT prefix argument, also debug the entire form as with the -command `cider-debug-defun-at-point'." - (interactive "P") - (let ((inline-debug (eq 16 (car-safe debug-it)))) - (when debug-it - (when (derived-mode-p 'clojurescript-mode) - (when (y-or-n-p (concat "The debugger doesn't support ClojureScript yet, and we need help with that." - " \nWould you like to read the Feature Request?")) - (browse-url "https://github.com/clojure-emacs/cider/issues/1416")) - (user-error "The debugger does not support ClojureScript")) - (when inline-debug - (cider--prompt-and-insert-inline-dbg))) - (cider-interactive-eval (when (and debug-it (not inline-debug)) - (concat "#dbg\n" (cider-defun-at-point))) - nil (cider-defun-at-point 'bounds)))) - -(defun cider--calculate-opening-delimiters () - "Walks up the list of expressions to collect all sexp opening delimiters. -The result is a list of the delimiters. - -That function is used in `cider-eval-defun-up-to-point' so it can make an -incomplete expression complete." - (interactive) - (let ((result nil)) - (save-excursion - (condition-case nil - (while t - (backward-up-list) - (push (char-after) result)) - (error result))))) - -(defun cider--matching-delimiter (delimiter) - "Get the matching (opening/closing) delimiter for DELIMITER." - (pcase delimiter - (?\( ?\)) - (?\[ ?\]) - (?\{ ?\}) - (?\) ?\() - (?\] ?\[) - (?\} ?\{))) - -(defun cider--calculate-closing-delimiters () - "Compute the list of closing delimiters to make the defun before point valid." - (mapcar #'cider--matching-delimiter (cider--calculate-opening-delimiters))) - -(defun cider-eval-defun-up-to-point (&optional output-to-current-buffer) - "Evaluate the current toplevel form up to point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer. It constructs an expression to eval in the following manner: - -- It find the code between the point and the start of the toplevel expression; -- It balances this bit of code by closing all open expressions; -- It evaluates the resulting code using `cider-interactive-eval'." - (interactive "P") - (let* ((beg-of-defun (save-excursion (beginning-of-defun) (point))) - (code (buffer-substring-no-properties beg-of-defun (point))) - (code (concat code (cider--calculate-closing-delimiters)))) - (cider-interactive-eval - code - (when output-to-current-buffer (cider-eval-print-handler))))) - -(defun cider-eval-sexp-up-to-point (&optional output-to-current-buffer) - "Evaluate the current sexp form up to point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer. It constructs an expression to eval in the following manner: - -- It finds the code between the point and the start of the sexp expression; -- It balances this bit of code by closing the expression; -- It evaluates the resulting code using `cider-interactive-eval'." - (interactive "P") - (let* ((beg-of-sexp (save-excursion (up-list) (backward-list) (point))) - (beg-delimiter (save-excursion (up-list) (backward-list) (char-after))) - (beg-set? (save-excursion (up-list) (backward-list) (char-before))) - (code (buffer-substring-no-properties beg-of-sexp (point))) - (code (if (= beg-set? ?#) (concat (list beg-set?) code) code)) - (code (concat code (list (cider--matching-delimiter beg-delimiter))))) - (cider-interactive-eval code - (when output-to-current-buffer (cider-eval-print-handler))))) - -(defun cider-pprint-eval-defun-at-point (&optional output-to-current-buffer) - "Evaluate the \"top-level\" form at point and pprint its value. -If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current -buffer, else display in a popup buffer." - (interactive "P") - (if output-to-current-buffer - (cider-pprint-eval-defun-to-comment) - (cider--pprint-eval-form (cider-defun-at-point 'bounds)))) - -(defun cider-eval-ns-form () - "Evaluate the current buffer's namespace form." - (interactive) - (when (clojure-find-ns) - (save-excursion - (goto-char (match-beginning 0)) - (cider-eval-defun-at-point)))) - -(defun cider-read-and-eval (&optional value) - "Read a sexp from the minibuffer and output its result to the echo area. -If VALUE is non-nil, it is inserted into the minibuffer as initial input." - (interactive) - (let* ((form (cider-read-from-minibuffer "Clojure Eval: " value)) - (override cider-interactive-eval-override) - (ns-form (if (cider-ns-form-p form) "" (format "(ns %s)" (cider-current-ns))))) - (with-current-buffer (get-buffer-create cider-read-eval-buffer) - (erase-buffer) - (clojure-mode) - (unless (string= "" ns-form) - (insert ns-form "\n\n")) - (insert form) - (let ((cider-interactive-eval-override override)) - (cider-interactive-eval form))))) - -(defun cider-read-and-eval-defun-at-point () - "Insert the toplevel form at point in the minibuffer and output its result. -The point is placed next to the function name in the minibuffer to allow -passing arguments." - (interactive) - (let* ((fn-name (cadr (split-string (cider-defun-at-point)))) - (form (format "(%s)" fn-name))) - (cider-read-and-eval (cons form (length form))))) - -;; Eval keymaps -(defvar cider-eval-pprint-commands-map - (let ((map (define-prefix-command 'cider-eval-pprint-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "e") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "d") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "c e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "c d") #'cider-pprint-eval-defun-to-comment) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-e") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "C-d") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "C-c e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "C-c C-e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "C-c d") #'cider-pprint-eval-defun-to-comment) - (define-key map (kbd "C-c C-d") #'cider-pprint-eval-defun-to-comment))) - -(defvar cider-eval-commands-map - (let ((map (define-prefix-command 'cider-eval-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "w") #'cider-eval-last-sexp-and-replace) - (define-key map (kbd "r") #'cider-eval-region) - (define-key map (kbd "n") #'cider-eval-ns-form) - (define-key map (kbd "d") #'cider-eval-defun-at-point) - (define-key map (kbd "e") #'cider-eval-last-sexp) - (define-key map (kbd "v") #'cider-eval-sexp-at-point) - (define-key map (kbd "o") #'cider-eval-sexp-up-to-point) - (define-key map (kbd ".") #'cider-read-and-eval-defun-at-point) - (define-key map (kbd "z") #'cider-eval-defun-up-to-point) - (define-key map (kbd "c") #'cider-eval-last-sexp-in-context) - (define-key map (kbd "b") #'cider-eval-sexp-at-point-in-context) - (define-key map (kbd "f") 'cider-eval-pprint-commands-map) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-w") #'cider-eval-last-sexp-and-replace) - (define-key map (kbd "C-r") #'cider-eval-region) - (define-key map (kbd "C-n") #'cider-eval-ns-form) - (define-key map (kbd "C-d") #'cider-eval-defun-at-point) - (define-key map (kbd "C-f") #'cider-eval-last-sexp) - (define-key map (kbd "C-v") #'cider-eval-sexp-at-point) - (define-key map (kbd "C-o") #'cider-eval-sexp-up-to-point) - (define-key map (kbd "C-.") #'cider-read-and-eval-defun-at-point) - (define-key map (kbd "C-z") #'cider-eval-defun-up-to-point) - (define-key map (kbd "C-c") #'cider-eval-last-sexp-in-context) - (define-key map (kbd "C-b") #'cider-eval-sexp-at-point-in-context) - (define-key map (kbd "C-f") 'cider-eval-pprint-commands-map))) - -(defun cider--file-string (file) - "Read the contents of a FILE and return as a string." - (with-current-buffer (find-file-noselect file) - (substring-no-properties (buffer-string)))) - -(defun cider-load-buffer (&optional buffer) - "Load (eval) BUFFER's file in nREPL. -If no buffer is provided the command acts on the current buffer. If the -buffer is for a cljc file, and both a Clojure and ClojureScript REPL exists -for the project, it is evaluated in both REPLs." - (interactive) - (setq buffer (or buffer (current-buffer))) - ;; When cider-load-buffer or cider-load-file are called in programs the - ;; current context might not match the buffer's context. We use the caller - ;; context instead of the buffer's context because that's the common use - ;; case. For the other use case just let-bind the default-directory. - (let ((orig-default-directory default-directory)) - (with-current-buffer buffer - (check-parens) - (let ((default-directory orig-default-directory)) - (unless buffer-file-name - (user-error "Buffer `%s' is not associated with a file" (current-buffer))) - (when (and cider-save-file-on-load - (buffer-modified-p) - (or (eq cider-save-file-on-load t) - (y-or-n-p (format "Save file %s? " buffer-file-name)))) - (save-buffer)) - (remove-overlays nil nil 'cider-temporary t) - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((filename (buffer-file-name buffer)) - (ns-form (cider-ns-form))) - (cider-map-repls :auto - (lambda (repl) - (when ns-form - (cider-repl--cache-ns-form ns-form repl)) - (cider-request:load-file (cider--file-string filename) - (funcall cider-to-nrepl-filename-function - (cider--server-filename filename)) - (file-name-nondirectory filename) - repl))) - (message "Loading %s..." filename)))))) - -(defun cider-load-file (filename) - "Load (eval) the Clojure file FILENAME in nREPL. -If the file is a cljc file, and both a Clojure and ClojureScript REPL -exists for the project, it is evaluated in both REPLs. The heavy lifting -is done by `cider-load-buffer'." - (interactive (list - (read-file-name "Load file: " nil nil nil - (when (buffer-file-name) - (file-name-nondirectory - (buffer-file-name)))))) - (if-let* ((buffer (find-buffer-visiting filename))) - (cider-load-buffer buffer) - (cider-load-buffer (find-file-noselect filename)))) - -(defun cider-load-all-files (directory) - "Load all files in DIRECTORY (recursively). -Useful when the running nREPL on remote host." - (interactive "DLoad files beneath directory: ") - (mapcar #'cider-load-file - (directory-files-recursively directory ".clj$"))) - -(defalias 'cider-eval-file 'cider-load-file - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-all-files 'cider-load-all-files - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-buffer 'cider-load-buffer - "A convenience alias as some people are confused by the load-* names.") - -(defun cider-load-all-project-ns () - "Load all namespaces in the current project." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "ns-load-all") - (when (y-or-n-p "Are you sure you want to load all namespaces in the project? ") - (message "Loading all project namespaces...") - (let ((loaded-ns-count (length (cider-sync-request:ns-load-all)))) - (message "Loaded %d namespaces" loaded-ns-count)))) - -(provide 'cider-eval) - -;;; cider-eval.el ends here diff --git a/elpa/cider-20181110.1413/cider-find.el b/elpa/cider-20181110.1413/cider-find.el deleted file mode 100644 index dc49ddac..00000000 --- a/elpa/cider-20181110.1413/cider-find.el +++ /dev/null @@ -1,231 +0,0 @@ -;;; cider-find.el --- Functionality for finding things -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov -;; Artur Malabarba - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A bunch of commands for finding resources and definitions. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) - -(require 'thingatpt) - -(defun cider--find-var-other-window (var &optional line) - "Find the definition of VAR, optionally at a specific LINE. - -Display the results in a different window." - (if-let* ((info (cider-var-info var))) - (progn - (if line (setq info (nrepl-dict-put info "line" line))) - (cider--jump-to-loc-from-info info t)) - (user-error "Symbol `%s' not resolved" var))) - -(defun cider--find-var (var &optional line) - "Find the definition of VAR, optionally at a specific LINE." - (if-let* ((info (cider-var-info var))) - (progn - (if line (setq info (nrepl-dict-put info "line" line))) - (cider--jump-to-loc-from-info info)) - (user-error "Symbol `%s' not resolved" var))) - -;;;###autoload -(defun cider-find-var (&optional arg var line) - "Find definition for VAR at LINE. -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point." - (interactive "P") - (cider-ensure-op-supported "info") - (if var - (cider--find-var var line) - (funcall (cider-prompt-for-symbol-function arg) - "Symbol" - (if (cider--open-other-window-p arg) - #'cider--find-var-other-window - #'cider--find-var)))) - -;;;###autoload -(defun cider-find-dwim-at-mouse (event) - "Find and display variable or resource at mouse EVENT." - (interactive "e") - (cider-ensure-op-supported "info") - (if-let* ((symbol-file (save-excursion - (mouse-set-point event) - (cider-symbol-at-point 'look-back)))) - (cider-find-dwim symbol-file) - (user-error "No variable or resource here"))) - -(defun cider--find-dwim (symbol-file callback &optional other-window) - "Find the SYMBOL-FILE at point. -CALLBACK upon failure to invoke prompt if not prompted previously. -Show results in a different window if OTHER-WINDOW is true." - (if-let* ((info (cider-var-info symbol-file))) - (cider--jump-to-loc-from-info info other-window) - (progn - (cider-ensure-op-supported "resource") - (if-let* ((resource (cider-sync-request:resource symbol-file)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer 0 other-window) - (if (cider--prompt-for-symbol-p current-prefix-arg) - (error "Resource or var %s not resolved" symbol-file) - (let ((current-prefix-arg (if current-prefix-arg nil '(4)))) - (call-interactively callback))))))) - -(defun cider--find-dwim-interactive (prompt) - "Get interactive arguments for jump-to functions using PROMPT as needed." - (if (cider--prompt-for-symbol-p current-prefix-arg) - (list - (cider-read-from-minibuffer prompt (thing-at-point 'filename))) - (list (or (thing-at-point 'filename) "")))) ; No prompt. - -(defun cider-find-dwim-other-window (symbol-file) - "Jump to SYMBOL-FILE at point, place results in other window." - (interactive (cider--find-dwim-interactive "Jump to: ")) - (cider--find-dwim symbol-file 'cider-find-dwim-other-window t)) - -;;;###autoload -(defun cider-find-dwim (symbol-file) - "Find and display the SYMBOL-FILE at point. -SYMBOL-FILE could be a var or a resource. If thing at point is empty then -show dired on project. If var is not found, try to jump to resource of the -same name. When called interactively, a prompt is given according to the -variable `cider-prompt-for-symbol'. A single or double prefix argument -inverts the meaning. A prefix of `-' or a double prefix argument causes -the results to be displayed in a different window. A default value of thing -at point is given when prompted." - (interactive (cider--find-dwim-interactive "Jump to: ")) - (cider--find-dwim symbol-file `cider-find-dwim - (cider--open-other-window-p current-prefix-arg))) - -;;;###autoload -(defun cider-find-resource (path) - "Find the resource at PATH. -Prompt for input as indicated by the variable `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix -argument causes the results to be displayed in other window. The default -value is thing at point." - (interactive - (list - (if (cider--prompt-for-symbol-p current-prefix-arg) - (completing-read "Resource: " - (cider-sync-request:resources-list) - nil nil - (thing-at-point 'filename)) - (or (thing-at-point 'filename) "")))) - (cider-ensure-op-supported "resource") - (when (= (length path) 0) - (error "Cannot find resource for empty path")) - (if-let* ((resource (cider-sync-request:resource path)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg)) - (if (cider--prompt-for-symbol-p current-prefix-arg) - (error "Cannot find resource %s" path) - (let ((current-prefix-arg (cider--invert-prefix-arg current-prefix-arg))) - (call-interactively 'cider-find-resource))))) - -(defun cider--invert-prefix-arg (arg) - "Invert the effect of prefix value ARG on `cider-prompt-for-symbol'. -This function preserves the `other-window' meaning of ARG." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (16 -1) ; empty empty -> - - (-1 16) ; - -> empty empty - (4 nil) ; empty -> no-prefix - (_ 4)))) ; no-prefix -> empty - -(defun cider--prefix-invert-prompt-p (arg) - "Test prefix value ARG for its effect on `cider-prompt-for-symbol`." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (16 t) ; empty empty - (4 t) ; empty - (_ nil)))) - -(defun cider--prompt-for-symbol-p (&optional prefix) - "Check if cider should prompt for symbol. -Tests againsts PREFIX and the value of `cider-prompt-for-symbol'. -Invert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be." - (if (cider--prefix-invert-prompt-p prefix) - (not cider-prompt-for-symbol) cider-prompt-for-symbol)) - -(defun cider--find-ns (ns &optional other-window) - "Find the file containing NS's definition. -Optionally open it in a different window if OTHER-WINDOW is truthy." - (if-let* ((path (cider-sync-request:ns-path ns))) - (cider-jump-to (cider-find-file path) nil other-window) - (user-error "Can't find namespace `%s'" ns))) - -;;;###autoload -(defun cider-find-ns (&optional arg ns) - "Find the file containing NS. -A prefix ARG of `-` or a double prefix argument causes -the results to be displayed in a different window." - (interactive "P") - (cider-ensure-connected) - (cider-ensure-op-supported "ns-path") - (if ns - (cider--find-ns ns) - (let* ((namespaces (cider-sync-request:ns-list)) - (ns (completing-read "Find namespace: " namespaces))) - (cider--find-ns ns (cider--open-other-window-p arg))))) - -;;;###autoload -(defun cider-find-keyword (&optional arg) - "Find the namespace of the keyword at point and its first occurrence there. - -For instance - if the keyword at point is \":cider.demo/keyword\", this command -would find the namespace \"cider.demo\" and afterwards find the first mention -of \"::keyword\" there. - -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point." - (interactive "P") - (cider-ensure-connected) - (let* ((kw (let ((kw-at-point (cider-symbol-at-point 'look-back))) - (if (or cider-prompt-for-symbol arg) - (read-string - (format "Keyword (default %s): " kw-at-point) - nil nil kw-at-point) - kw-at-point))) - (ns-qualifier (and - (string-match "^:+\\(.+\\)/.+$" kw) - (match-string 1 kw))) - (kw-ns (if ns-qualifier - (cider-resolve-alias (cider-current-ns) ns-qualifier) - (cider-current-ns))) - (kw-to-find (concat "::" (replace-regexp-in-string "^:+\\(.+/\\)?" "" kw)))) - - (when (and ns-qualifier (string= kw-ns (cider-current-ns))) - (error "Could not resolve alias `%s' in `%s'" ns-qualifier (cider-current-ns))) - (cider--find-ns kw-ns arg) - (search-forward-regexp kw-to-find nil 'noerror))) - -(provide 'cider-find) -;;; cider-find.el ends here diff --git a/elpa/cider-20181110.1413/cider-format.el b/elpa/cider-20181110.1413/cider-format.el deleted file mode 100644 index 8256ea8a..00000000 --- a/elpa/cider-20181110.1413/cider-format.el +++ /dev/null @@ -1,150 +0,0 @@ -;;; cider-format.el --- Code and EDN formatting functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov -;; Artur Malabarba - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Middleware-powered code and EDN formatting functionality. - -;;; Code: - -(require 'subr-x) - -(require 'cider-client) -(require 'cider-util) - - -;; Format - -(defun cider--format-reindent (formatted start) - "Reindent FORMATTED to align with buffer position START." - (let* ((start-column (save-excursion (goto-char start) (current-column))) - (indent-line (concat "\n" (make-string start-column ? )))) - (replace-regexp-in-string "\n" indent-line formatted))) - - -;;; Format region - -(defun cider--format-region (start end formatter) - "Format the contents of the given region. - -START and END represent the region's boundaries. - -FORMATTER is a function of one argument which is used to convert -the string contents of the region into a formatted string. - -Uses the following heuristic to try to maintain point position: - -- Take a snippet of text starting at current position, up to 64 chars. -- Search for the snippet, with lax whitespace, in the formatted text. - - If snippet is less than 64 chars (point was near end of buffer), search - from end instead of beginning. -- Place point at match beginning, or `point-min' if no match." - (let* ((original (buffer-substring-no-properties start end)) - (formatted (funcall formatter original)) - (indented (cider--format-reindent formatted start))) - (unless (equal original indented) - (let* ((pos (point)) - (pos-max (1+ (buffer-size))) - (l 64) - (endp (> (+ pos l) pos-max)) - (snippet (thread-last (buffer-substring-no-properties - pos (min (+ pos l) pos-max)) - (regexp-quote) - (replace-regexp-in-string "[[:space:]\t\n\r]+" "[[:space:]\t\n\r]*")))) - (delete-region start end) - (insert indented) - (goto-char (if endp (point-max) (point-min))) - (funcall (if endp #'re-search-backward #'re-search-forward) snippet nil t) - (goto-char (or (match-beginning 0) start)) - (when (looking-at-p "\n") (forward-char)))))) - -;;;###autoload -(defun cider-format-region (start end) - "Format the Clojure code in the current region. -START and END represent the region's boundaries." - (interactive "r") - (cider-ensure-connected) - (cider--format-region start end #'cider-sync-request:format-code)) - - -;;; Format defun - -;;;###autoload -(defun cider-format-defun () - "Format the code in the current defun." - (interactive) - (cider-ensure-connected) - (let ((defun-bounds (cider-defun-at-point 't))) - (cider-format-region (car defun-bounds) (cadr defun-bounds)))) - - -;;; Format buffer - -(defun cider--format-buffer (formatter) - "Format the contents of the current buffer. - -Uses FORMATTER, a function of one argument, to convert the string contents -of the buffer into a formatted string." - (cider--format-region 1 (1+ (buffer-size)) formatter)) - -;;;###autoload -(defun cider-format-buffer () - "Format the Clojure code in the current buffer." - (interactive) - (check-parens) - (cider-ensure-connected) - (cider--format-buffer #'cider-sync-request:format-code)) - - -;;; Format EDN - -(declare-function cider--pretty-print-width "cider-repl") - -;;;###autoload -(defun cider-format-edn-buffer () - "Format the EDN data in the current buffer." - (interactive) - (check-parens) - (cider-ensure-connected) - (cider--format-buffer (lambda (edn) - (cider-sync-request:format-edn edn (cider--pretty-print-width))))) - -;;;###autoload -(defun cider-format-edn-region (start end) - "Format the EDN data in the current region. -START and END represent the region's boundaries." - (interactive "r") - (cider-ensure-connected) - (let* ((start-column (save-excursion (goto-char start) (current-column))) - (right-margin (- (cider--pretty-print-width) start-column))) - (cider--format-region start end - (lambda (edn) - (cider-sync-request:format-edn edn right-margin))))) - -;;;###autoload -(defun cider-format-edn-last-sexp () - "Format the EDN data of the last sexp." - (interactive) - (apply 'cider-format-edn-region (cider-sexp-at-point 'bounds))) - -(provide 'cider-format) -;;; cider-format.el ends here diff --git a/elpa/cider-20181110.1413/cider-grimoire.el b/elpa/cider-20181110.1413/cider-grimoire.el deleted file mode 100644 index c07614ba..00000000 --- a/elpa/cider-20181110.1413/cider-grimoire.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; cider-grimoire.el --- Grimoire integration -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors -;; -;; Author: Bozhidar Batsov - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A few commands for Grimoire documentation lookup. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) -(require '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/elpa/cider-20181110.1413/cider-inspector.el b/elpa/cider-20181110.1413/cider-inspector.el deleted file mode 100644 index 9823530d..00000000 --- a/elpa/cider-20181110.1413/cider-inspector.el +++ /dev/null @@ -1,402 +0,0 @@ -;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Vital Reactor, LLC -;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors - -;; Author: Ian Eslick -;; Bozhidar Batsov - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Clojure object inspector inspired by SLIME. - -;;; Code: - -(require 'cl-lib) -(require 'seq) -(require 'cider-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) - (visual-line-mode 1)) - -;;;###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.") - -(defvar cider-inspector--current-repl nil - "Contains the reference to the REPL where inspector was last invoked from. -This is needed for internal inspector buffer operations (push, -pop) to execute against the correct REPL session.") - -;; Operations -;;;###autoload -(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))) - (setq cider-inspector--current-repl (cider-current-repl)) - (when-let* ((value (cider-sync-request:inspect-expr expr ns (or cider-inspector-page-size 32)))) - (cider-inspector--render-value value))) - -(defun cider-inspector-pop () - "Pop the last value off the inspector stack and render it. -See `cider-sync-request:inspect-pop' and `cider-inspector--render-value'." - (interactive) - (setq cider-inspector-last-command 'cider-inspector-pop) - (when-let* ((value (cider-sync-request:inspect-pop))) - (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 cider-inspector--current-repl) - (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 cider-inspector--current-repl) - (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 cider-inspector--current-repl) - (nrepl-dict-get "value"))) - -(defun cider-sync-request:inspect-next-page () - "Jump to the next page in paginated collection view." - (thread-first '("op" "inspect-next-page") - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) - -(defun cider-sync-request:inspect-prev-page () - "Jump to the previous page in paginated collection view." - (thread-first '("op" "inspect-prev-page") - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) - -(defun cider-sync-request:inspect-set-page-size (page-size) - "Set the page size in paginated view to PAGE-SIZE." - (thread-first `("op" "inspect-set-page-size" - "page-size" ,page-size) - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) - -(defun cider-sync-request:inspect-expr (expr ns page-size) - "Evaluate EXPR in context of NS and inspect its result. -Set the page size in paginated view to PAGE-SIZE." - (thread-first (append (nrepl--eval-request expr ns) - `("inspect" "true" - "page-size" ,page-size)) - (cider-nrepl-send-sync-request cider-inspector--current-repl) - (nrepl-dict-get "value"))) - -;; Render Inspector from Structured Values -(defun cider-inspector--render-value (value) - "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/elpa/cider-20181110.1413/cider-macroexpansion.el b/elpa/cider-20181110.1413/cider-macroexpansion.el deleted file mode 100644 index 8123932a..00000000 --- a/elpa/cider-20181110.1413/cider-macroexpansion.el +++ /dev/null @@ -1,206 +0,0 @@ -;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Macro expansion support. - -;;; Code: - -(require 'cider-mode) -(require '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/elpa/cider-20181110.1413/cider-mode.el b/elpa/cider-20181110.1413/cider-mode.el deleted file mode 100644 index f9b2189e..00000000 --- a/elpa/cider-20181110.1413/cider-mode.el +++ /dev/null @@ -1,1045 +0,0 @@ -;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Minor mode for REPL interactions. - -;;; Code: - -(require 'clojure-mode) -(require 'cider-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) "") - (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 and . - -As it stands Emacs fires these events on and on 'x' and -'w32'systems while on macOS it presents them on and .") - -(defconst cider-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-d") 'cider-doc-map) - (define-key map (kbd "M-.") #'cider-find-var) - (define-key map (kbd (if cider--has-many-mouse-buttons "" "")) #'xref-pop-marker-stack) - (define-key map (kbd (if cider--has-many-mouse-buttons "" "")) #'cider-find-dwim-at-mouse) - (define-key map (kbd "C-c C-.") #'cider-find-ns) - (define-key map (kbd "C-c C-:") #'cider-find-keyword) - (define-key map (kbd "M-,") #'cider-pop-back) - (define-key map (kbd "C-c M-.") #'cider-find-resource) - (define-key map (kbd "M-TAB") #'complete-symbol) - (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 -(with-eval-after-load 'clojure-mode - (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map - "Menu for Clojure mode. - This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." - `("CIDER" :visible (not cider-mode) - ["Start a Clojure REPL" cider-jack-in-clj - :help "Starts an nREPL server and connects a Clojure REPL to it."] - ["Connect to a Clojure REPL" cider-connect-clj - :help "Connects to a REPL that's already running."] - ["Start a ClojureScript REPL" cider-jack-in-cljs - :help "Starts an nREPL server and connects a ClojureScript REPL to it."] - ["Connect to a ClojureScript REPL" cider-connect-cljs - :help "Connects to a ClojureScript REPL that's already running."] - ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clj&cljs - :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] - "--" - ["View manual online" cider-view-manual]))) - -;;; Dynamic indentation -(defcustom cider-dynamic-indentation t - "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-keyword-face'. - `function': Any defined function gets the `font-lock-function-face'. - `var': Any non-local var gets the `font-lock-variable-name-face'. - `deprecated' (default): Any deprecated var gets the `cider-deprecated-face' - face. - `core' (default): Any symbol from clojure.core (face depends on type). - -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/elpa/cider-20181110.1413/cider-ns.el b/elpa/cider-20181110.1413/cider-ns.el deleted file mode 100644 index bcb843ee..00000000 --- a/elpa/cider-20181110.1413/cider-ns.el +++ /dev/null @@ -1,265 +0,0 @@ -;;; cider-ns.el --- Namespace manipulation functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov -;; Artur Malabarba - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Smart code refresh functionality based on ideas from: -;; http://thinkrelevance.com/blog/2013/06/04/clojure-workflow-reloaded -;; -;; Note that refresh with clojure.tools.namespace.repl is a smarter way to -;; reload code: the traditional way to reload Clojure code without restarting -;; the JVM is (require ... :reload) or an editor/IDE feature that does the same -;; thing. -;; -;; This has several problems: -;; -;; If you modify two namespaces which depend on each other, you must remember to -;; reload them in the correct order to avoid compilation errors. -;; -;; If you remove definitions from a source file and then reload it, those -;; definitions are still available in memory. If other code depends on those -;; definitions, it will continue to work but will break the next time you -;; restart the JVM. -;; -;; If the reloaded namespace contains defmulti, you must also reload all of the -;; associated defmethod expressions. -;; -;; If the reloaded namespace contains defprotocol, you must also reload any -;; records or types implementing that protocol and replace any existing -;; instances of those records/types with new instances. -;; -;; If the reloaded namespace contains macros, you must also reload any -;; namespaces which use those macros. -;; -;; If the running program contains functions which close over values in the -;; reloaded namespace, those closed-over values are not updated (This is common -;; in web applications which construct the "handler stack" as a composition of -;; functions.) - -;;; Code: - -(require 'subr-x) - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-stacktrace) - -(define-obsolete-variable-alias 'cider-save-files-on-cider-ns-refresh 'cider-ns-save-files-on-refresh "0.18") -(defcustom cider-ns-save-files-on-refresh 'prompt - "Controls whether to prompt to save Clojure files on `cider-ns-refresh'. -If nil, files are not saved. -If 'prompt, the user is prompted to save files if they have been modified. -If t, save the files without confirmation." - :type '(choice (const prompt :tag "Prompt to save files if they have been modified") - (const nil :tag "Don't save the files") - (const t :tag "Save the files without confirmation")) - :group 'cider - :package-version '(cider . "0.15.0")) - -(defconst cider-ns-refresh-log-buffer "*cider-ns-refresh-log*") - -(define-obsolete-variable-alias 'cider-refresh-show-log-buffer 'cider-ns-refresh-show-log-buffer "0.18") -(defcustom cider-ns-refresh-show-log-buffer nil - "Controls when to display the refresh log buffer. -If non-nil, the log buffer will be displayed every time `cider-ns-refresh' is -called. If nil, the log buffer will still be written to, but will never be -displayed automatically. Instead, the most relevant information will be -displayed in the echo area." - :type '(choice (const :tag "always" t) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(define-obsolete-variable-alias 'cider-refresh-before-fn 'cider-ns-refresh-before-fn "0.18") -(defcustom cider-ns-refresh-before-fn nil - "Clojure function for `cider-ns-refresh' to call before reloading. -If nil, nothing will be invoked before reloading. Must be a -namespace-qualified function of zero arity. Any thrown exception will -prevent reloading from occurring." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(define-obsolete-variable-alias 'cider-refresh-after-fn 'cider-ns-refresh-after-fn "0.18") -(defcustom cider-ns-refresh-after-fn nil - "Clojure function for `cider-ns-refresh' to call after reloading. -If nil, nothing will be invoked after reloading. Must be a -namespace-qualified function of zero arity." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(defun cider-ns-refresh--handle-response (response log-buffer) - "Refresh LOG-BUFFER with RESPONSE." - (nrepl-dbind-response response (out err reloading status error error-ns after before) - (cl-flet* ((log (message &optional face) - (cider-emit-into-popup-buffer log-buffer message face t)) - - (log-echo (message &optional face) - (log message face) - (unless cider-ns-refresh-show-log-buffer - (let ((message-truncate-lines t)) - (message "cider-ns-refresh: %s" message))))) - (cond - (out - (log out)) - - (err - (log err 'font-lock-warning-face)) - - ((member "invoking-before" status) - (log-echo (format "Calling %s\n" before) 'font-lock-string-face)) - - ((member "invoked-before" status) - (log-echo (format "Successfully called %s\n" before) 'font-lock-string-face)) - - ((member "invoked-not-resolved" status) - (log-echo "Could not resolve refresh function\n" 'font-lock-string-face)) - - (reloading - (log-echo (format "Reloading %s\n" reloading) 'font-lock-string-face)) - - ((member "reloading" (nrepl-dict-keys response)) - (log-echo "Nothing to reload\n" 'font-lock-string-face)) - - ((member "ok" status) - (log-echo "Reloading successful\n" 'font-lock-string-face)) - - (error-ns - (log-echo (format "Error reloading %s\n" error-ns) 'font-lock-warning-face)) - - ((member "invoking-after" status) - (log-echo (format "Calling %s\n" after) 'font-lock-string-face)) - - ((member "invoked-after" status) - (log-echo (format "Successfully called %s\n" after) 'font-lock-string-face)))) - - (with-selected-window (or (get-buffer-window cider-ns-refresh-log-buffer) - (selected-window)) - (with-current-buffer cider-ns-refresh-log-buffer - (goto-char (point-max)))) - - (when (member "error" status) - (cider--render-stacktrace-causes error)))) - -(defun cider-ns-refresh--save-project-buffers () - "Ensure modified project buffers are saved before certain operations. -Its behavior is controlled by `cider-save-files-on-cider-ns-refresh'." - (when-let* ((project-root (clojure-project-dir))) - (when cider-save-files-on-cider-ns-refresh - (save-some-buffers - (eq cider-save-files-on-cider-ns-refresh t) - (lambda () - (and - (derived-mode-p 'clojure-mode) - (string-prefix-p project-root - (file-truename default-directory) - (eq system-type 'windows-nt)))))))) - -;;;###autoload -(defun cider-ns-reload (&optional prompt) - "Send a (require 'ns :reload) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload forces loading of all the -identified libs even if they are already loaded\"." - (interactive "P") - (let ((ns (if prompt - (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns))) - (clojure-find-ns)))) - (cider-interactive-eval (format "(require '%s :reload)" ns)))) - -;;;###autoload -(defun cider-ns-reload-all (&optional prompt) - "Send a (require 'ns :reload-all) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload-all implies :reload and -also forces loading of all libs that the identified libs directly or -indirectly load via require\"." - (interactive "P") - (let ((ns (if prompt - (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns))) - (clojure-find-ns)))) - (cider-interactive-eval (format "(require '%s :reload-all)" ns)))) - -;;;###autoload -(defun cider-ns-refresh (&optional mode) - "Reload modified and unloaded namespaces on the classpath. - -With a single prefix argument, or if MODE is `refresh-all', reload all -namespaces on the classpath unconditionally. - -With a double prefix argument, or if MODE is `clear', clear the state of -the namespace tracker before reloading. This is useful for recovering from -some classes of error (for example, those caused by circular dependencies) -that a normal reload would not otherwise recover from. The trade-off of -clearing is that stale code from any deleted files may not be completely -unloaded. - -With a negative prefix argument, or if MODE is `inhibit-fns', prevent any -refresh functions (defined in `cider-ns-refresh-before-fn' and -`cider-ns-refresh-after-fn') from being invoked." - (interactive "p") - (cider-ensure-connected) - (cider-ensure-op-supported "refresh") - (cider-ns-refresh--save-project-buffers) - (let ((clear? (member mode '(clear 16))) - (refresh-all? (member mode '(refresh-all 4))) - (inhibit-refresh-fns (member mode '(inhibit-fns -1)))) - (cider-map-repls :clj - (lambda (conn) - ;; Inside the lambda, so the buffer is not created if we error out. - (let ((log-buffer (or (get-buffer cider-ns-refresh-log-buffer) - (cider-make-popup-buffer cider-ns-refresh-log-buffer)))) - (when cider-ns-refresh-show-log-buffer - (cider-popup-buffer-display log-buffer)) - (when inhibit-refresh-fns - (cider-emit-into-popup-buffer log-buffer - "inhibiting refresh functions\n" - nil - t)) - (when clear? - (cider-nrepl-send-sync-request '("op" "refresh-clear") conn)) - (cider-nrepl-send-request - (nconc `("op" ,(if refresh-all? "refresh-all" "refresh") - "print-length" ,cider-stacktrace-print-length - "print-level" ,cider-stacktrace-print-level) - (when (cider--pprint-fn) - `("pprint-fn" ,(cider--pprint-fn))) - (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn) - `("before" ,cider-ns-refresh-before-fn)) - (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn) - `("after" ,cider-ns-refresh-after-fn))) - (lambda (response) - (cider-ns-refresh--handle-response response log-buffer)) - conn)))))) - -;;;###autoload -(define-obsolete-function-alias 'cider-refresh 'cider-ns-refresh "0.18") - -(provide 'cider-ns) -;;; cider-ns.el ends here diff --git a/elpa/cider-20181110.1413/cider-overlays.el b/elpa/cider-20181110.1413/cider-overlays.el deleted file mode 100644 index 1a92b35f..00000000 --- a/elpa/cider-20181110.1413/cider-overlays.el +++ /dev/null @@ -1,311 +0,0 @@ -;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*- - -;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Use `cider--make-overlay' to place a generic overlay at point. Or use -;; `cider--make-result-overlay' to place an interactive eval result overlay at -;; the end of a specified line. - -;;; Code: - -(require 'cider-common) -(require '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/elpa/cider-20181110.1413/cider-pkg.el b/elpa/cider-20181110.1413/cider-pkg.el deleted file mode 100644 index 0e91f236..00000000 --- a/elpa/cider-20181110.1413/cider-pkg.el +++ /dev/null @@ -1,23 +0,0 @@ -(define-package "cider" "20181110.1413" "Clojure Interactive Development Environment that Rocks" - '((emacs "25") - (clojure-mode "5.9") - (pkg-info "0.4") - (queue "0.2") - (spinner "1.7") - (seq "2.16") - (sesman "0.3.2")) - :keywords - '("languages" "clojure" "cider") - :authors - '(("Tim King" . "kingtim@gmail.com") - ("Phil Hagelberg" . "technomancy@gmail.com") - ("Bozhidar Batsov" . "bozhidar@batsov.com") - ("Artur Malabarba" . "bruce.connor.am@gmail.com") - ("Hugo Duncan" . "hugo@hugoduncan.org") - ("Steve Purcell" . "steve@sanityinc.com")) - :maintainer - '("Bozhidar Batsov" . "bozhidar@batsov.com") - :url "http://www.github.com/clojure-emacs/cider") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/cider-20181110.1413/cider-popup.el b/elpa/cider-20181110.1413/cider-popup.el deleted file mode 100644 index 274a0666..00000000 --- a/elpa/cider-20181110.1413/cider-popup.el +++ /dev/null @@ -1,137 +0,0 @@ -;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- - -;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Common functionality for dealing with popup buffers. - -;;; Code: - -(require '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/elpa/cider-20181110.1413/cider-profile.el b/elpa/cider-20181110.1413/cider-profile.el deleted file mode 100644 index 79577910..00000000 --- a/elpa/cider-20181110.1413/cider-profile.el +++ /dev/null @@ -1,208 +0,0 @@ -;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*- - -;; Copyright © 2014-2018 Edwin Watkeys and CIDER contributors - -;; Author: Edwin Watkeys -;; Juan E. Maya - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Provides coarse-grained interactive profiling support. -;; Based on earlier work by Edwin Watkeys (https://github.com/thunknyc/nrepl-profile). - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-eval) - -(defconst cider-profile-buffer "*cider-profile*") - -(defvar cider-profile-map - (let ((map (define-prefix-command 'cider-profile-map))) - (define-key map (kbd "t") #'cider-profile-toggle) - (define-key map (kbd "c") #'cider-profile-clear) - (define-key map (kbd "S") #'cider-profile-summary) - (define-key map (kbd "s") #'cider-profile-var-summary) - (define-key map (kbd "n") #'cider-profile-ns-toggle) - (define-key map (kbd "v") #'cider-profile-var-profiled-p) - (define-key map (kbd "+") #'cider-profile-samples) - map) - "CIDER profiler keymap.") - -(defconst cider-profile-menu - '("Profile" - ["Toggle var profiling" cider-profile-toggle] - ["Toggle namespace profiling" cider-profile-ns-toggle] - "--" - ["Display var profiling status" cider-profile-var-profiled-p] - ["Display max sample count" cider-profile-samples] - ["Display summary" cider-profile-summary] - ["Clear data" cider-profile-clear]) - "CIDER profiling submenu.") - -(defun cider-profile--make-response-handler (handler &optional buffer) - "Make a response handler using value handler HANDLER for connection BUFFER. - -Optional argument BUFFER defaults to current buffer." - (nrepl-make-response-handler - (or buffer (current-buffer)) handler nil nil nil)) - -;;;###autoload -(defun cider-profile-samples (&optional query) - "Displays current max-sample-count. -If optional QUERY is specified, set max-sample-count and display new value." - (interactive "P") - (cider-ensure-op-supported "set-max-samples") - (cider-ensure-op-supported "get-max-samples") - (if (not (null query)) - (cider-nrepl-send-request - (let ((max-samples (if (numberp query) query '()))) - (message "query: %s" max-samples) - `("op" "set-max-samples" "max-samples" ,max-samples)) - (cider-profile--make-response-handler - (lambda (_buffer value) - (let ((value (if (zerop (length value)) "unlimited" value))) - (message "max-sample-count is now %s" value))))) - (cider-nrepl-send-request - '("op" "get-max-samples") - (cider-profile--make-response-handler - (lambda (_buffer value) - (let ((value (if (zerop (length value)) "unlimited" value))) - (message "max-sample-count is now %s" value)))))) - query) - -;;;###autoload -(defun cider-profile-var-profiled-p (query) - "Displays the profiling status of var under point. -Prompts for var if none under point or QUERY is present." - (interactive "P") - (cider-ensure-op-supported "is-var-profiled") - (cider-read-symbol-name - "Report profiling status for var: " - (lambda (sym) - (let ((ns (cider-current-ns))) - (cider-nrepl-send-request - `("op" "is-var-profiled" - "ns" ,ns - "sym" ,sym) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling is currently enabled for %s/%s" ns sym)) - ("unprofiled" (message "Profiling is currently disabled for %s/%s" ns sym)) - ("unbound" (message "%s/%s is unbound" ns sym))))))))) - query) - -;;;###autoload -(defun cider-profile-ns-toggle (&optional query) - "Toggle profiling for the ns associated with optional QUERY. - -If optional argument QUERY is non-nil, prompt for ns. Otherwise use -current ns." - (interactive "P") - (cider-ensure-op-supported "toggle-profile-ns") - (let ((ns (if query - (completing-read "Toggle profiling for ns: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (cider-nrepl-send-request - `("op" "toggle-profile-ns" - "ns" ,ns) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling enabled for %s" ns)) - ("unprofiled" (message "Profiling disabled for %s" ns))))))) - query) - -;;;###autoload -(defun cider-profile-toggle (query) - "Toggle profiling for the given QUERY. -Defaults to the symbol at point. -With prefix arg or no symbol at point, prompts for a var." - (interactive "P") - (cider-ensure-op-supported "toggle-profile") - (cider-read-symbol-name - "Toggle profiling for var: " - (lambda (sym) - (let ((ns (cider-current-ns))) - (cider-nrepl-send-request - `("op" "toggle-profile" - "ns" ,ns - "sym" ,sym) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling enabled for %s/%s" ns sym)) - ("unprofiled" (message "Profiling disabled for %s/%s" ns sym)) - ("unbound" (message "%s/%s is unbound" ns sym))))))))) - query) - -(defun cider-profile-display-stats (stats-response) - "Displays the STATS-RESPONSE on `cider-profile-buffer`." - (let ((table (nrepl-dict-get stats-response "err"))) - (if cider-profile-buffer - (let ((buffer (cider-make-popup-buffer cider-profile-buffer))) - (with-current-buffer buffer - (let ((inhibit-read-only t)) (insert table))) - (display-buffer buffer) - (let ((window (get-buffer-window buffer))) - (set-window-point window 0) - (select-window window) - (fit-window-to-buffer window))) - (cider-emit-interactive-eval-err-output table)))) - -;;;###autoload -(defun cider-profile-summary () - "Display a summary of currently collected profile data." - (interactive) - (cider-ensure-op-supported "profile-summary") - (cider-profile-display-stats - (cider-nrepl-send-sync-request '("op" "profile-summary")))) - -;;;###autoload -(defun cider-profile-var-summary (query) - "Display profile data for var under point QUERY. -Defaults to the symbol at point. With prefix arg or no symbol at point, -prompts for a var." - (interactive "P") - (cider-ensure-op-supported "profile-var-summary") - (cider-read-symbol-name - "Profile-summary for var: " - (lambda (sym) - (cider-profile-display-stats - (cider-nrepl-send-sync-request - `("op" "profile-var-summary" - "ns" ,(cider-current-ns) - "sym" ,sym))))) - query) - -;;;###autoload -(defun cider-profile-clear () - "Clear any collected profile data." - (interactive) - (cider-ensure-op-supported "clear-profile") - (cider-nrepl-send-request - '("op" "clear-profile") - (cider-profile--make-response-handler - (lambda (_buffer value) - (when (equal value "cleared") - (message "Cleared profile data")))))) - -(provide 'cider-profile) - -;;; cider-profile.el ends here diff --git a/elpa/cider-20181110.1413/cider-repl-history.el b/elpa/cider-20181110.1413/cider-repl-history.el deleted file mode 100644 index f6cd4c86..00000000 --- a/elpa/cider-20181110.1413/cider-repl-history.el +++ /dev/null @@ -1,726 +0,0 @@ -;;; cider-repl-history.el --- REPL input history browser - -;; Copyright (c) 2017 John Valente and browse-kill-ring authors - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; 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/elpa/cider-20181110.1413/cider-repl.el b/elpa/cider-20181110.1413/cider-repl.el deleted file mode 100644 index 261b5bbb..00000000 --- a/elpa/cider-20181110.1413/cider-repl.el +++ /dev/null @@ -1,1748 +0,0 @@ -;;; cider-repl.el --- CIDER REPL mode interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell -;; Reid McKenzie - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This 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)) - (with-current-buffer buffer - (set-window-point (get-buffer-window) (point-max))) - buffer) - -(defun cider-repl--insert-banner-and-prompt (buffer) - "Insert REPL banner and REPL prompt in BUFFER." - (with-current-buffer buffer - (insert (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face)) - (when cider-repl-display-help-banner - (insert (propertize (cider-repl--help-banner) 'font-lock-face 'font-lock-comment-face))) - (goto-char (point-max)) - (cider-repl--mark-output-start) - (cider-repl--mark-input-start) - (cider-repl--insert-prompt cider-buffer-ns))) - -(defun cider-repl--banner () - "Generate the welcome REPL buffer banner." - (format ";; Connected to nREPL server - nrepl://%s:%s -;; CIDER %s, nREPL %s -;; Clojure %s, Java %s -;; Docs: (doc function-name) -;; (find-doc part-of-name) -;; Source: (source function-name) -;; Javadoc: (javadoc java-object-or-class) -;; Exit: -;; Results: Stored in vars *1, *2, *3, an exception in *e;" - (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 to view it. -;; In case you're seeing any warnings you should consult the manual's -;; \"Troubleshooting\" section. -;; -;; Here are few tips to get you started: -;; -;; * Press <\\[describe-mode]> to see a list of the keybindings available (this -;; will work in every Emacs buffer) -;; * Press <\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command -;; * Press <\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure file -;; * Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a -;; Java method) -;; * Press <\\[cider-doc]> to view the documentation for something (e.g. -;; a var, a Java method) -;; * Enable `eldoc-mode' to display function & method signatures in the minibuffer. -;; * Print CIDER's refcard and keep it close to your keyboard. -;; -;; CIDER is super customizable - try to -;; get a feel for this. If you're thirsty for knowledge you should try -;; . -;; -;; If you think you've encountered a bug (or have some suggestions for -;; improvements) use to report it. -;; -;; Above all else - don't panic! In case of an emergency - procure -;; some (hard) cider and enjoy it responsibly! -;; -;; You can remove this message with the 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-") #'cider-repl-closing-return) - (define-key map (kbd "C-j") #'cider-repl-newline-and-indent) - (define-key map (kbd "C-c C-o") #'cider-repl-clear-output) - (define-key map (kbd "C-c M-n") #'cider-repl-set-ns) - (define-key map (kbd "C-c C-u") #'cider-repl-kill-input) - (define-key map (kbd "C-S-a") #'cider-repl-bol-mark) - (define-key map [S-home] #'cider-repl-bol-mark) - (define-key map (kbd "C-") #'cider-repl-backward-input) - (define-key map (kbd "C-") #'cider-repl-forward-input) - (define-key map (kbd "M-p") #'cider-repl-previous-input) - (define-key map (kbd "M-n") #'cider-repl-next-input) - (define-key map (kbd "M-r") #'cider-repl-previous-matching-input) - (define-key map (kbd "M-s") #'cider-repl-next-matching-input) - (define-key map (kbd "C-c C-n") #'cider-repl-next-prompt) - (define-key map (kbd "C-c C-p") #'cider-repl-previous-prompt) - (define-key map (kbd "C-c C-b") #'cider-interrupt) - (define-key map (kbd "C-c C-c") #'cider-interrupt) - (define-key map (kbd "C-c C-m") #'cider-macroexpand-1) - (define-key map (kbd "C-c M-m") #'cider-macroexpand-all) - (define-key map (kbd "C-c C-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/elpa/cider-20181110.1413/cider-resolve.el b/elpa/cider-20181110.1413/cider-resolve.el deleted file mode 100644 index 3c2dc6fd..00000000 --- a/elpa/cider-20181110.1413/cider-resolve.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection - -;; Copyright © 2015-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; The ns cache is a dict of namespaces stored in the connection buffer. This -;; file offers functions to easily get information about variables from this -;; cache, given the variable's name and the file's namespace. This -;; functionality is similar to that offered by the `cider-var-info' function -;; (and others). The difference is that all functions in this file operate -;; without contacting the server (they still rely on an active connection -;; buffer, but no messages are actually exchanged). - -;; For this reason, the functions here are well suited for very -;; performance-sentitive operations, such as font-locking or -;; indentation. Meanwhile, operations like code-jumping are better off -;; communicating with the middleware, just in the off chance that the cache is -;; outdated. - -;; Below is a typical entry on this cache dict. Note that clojure.core symbols -;; are excluded from the refers to save space. - -;; "cider.nrepl.middleware.track-state" -;; (dict "aliases" -;; (dict "cljs" "cider.nrepl.middleware.util.cljs" -;; "misc" "cider.nrepl.middleware.util.misc" -;; "set" "clojure.set") -;; "interns" (dict a -;; "assoc-state" (dict "arglists" -;; (("response" -;; (dict "as" "msg" "keys" -;; ("session"))))) -;; "filter-core" (dict "arglists" -;; (("refers"))) -;; "make-transport" (dict "arglists" -;; (((dict "as" "msg" "keys" -;; ("transport"))))) -;; "ns-as-map" (dict "arglists" -;; (("ns"))) -;; "ns-cache" (dict) -;; "relevant-meta" (dict "arglists" -;; (("var"))) -;; "update-vals" (dict "arglists" -;; (("m" "f"))) -;; "wrap-tracker" (dict "arglists" -;; (("handler")))) -;; "refers" (dict "set-descriptor!" "#'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/elpa/cider-20181110.1413/cider-scratch.el b/elpa/cider-20181110.1413/cider-scratch.el deleted file mode 100644 index f1c3e93d..00000000 --- a/elpa/cider-20181110.1413/cider-scratch.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Bozhidar Batsov and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Imitate Emacs's *scratch* buffer. - -;;; Code: - -(require 'cider-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/elpa/cider-20181110.1413/cider-selector.el b/elpa/cider-20181110.1413/cider-selector.el deleted file mode 100644 index a21032db..00000000 --- a/elpa/cider-20181110.1413/cider-selector.el +++ /dev/null @@ -1,166 +0,0 @@ -;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Buffer selection command inspired by SLIME's selector. - -;;; Code: - -(require 'cider-client) -(require 'cider-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/elpa/cider-20181110.1413/cider-stacktrace.el b/elpa/cider-20181110.1413/cider-stacktrace.el deleted file mode 100644 index 321d4bbd..00000000 --- a/elpa/cider-20181110.1413/cider-stacktrace.el +++ /dev/null @@ -1,910 +0,0 @@ -;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors - -;; Author: Jeff Valk - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Stacktrace filtering and stack frame source navigation - -;;; Code: - -(require 'cl-lib) -(require 'cider-popup) -(require 'button) -(require 'easymenu) -(require 'cider-common) -(require '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/elpa/cider-20181110.1413/cider-test.el b/elpa/cider-20181110.1413/cider-test.el deleted file mode 100644 index a7b3e984..00000000 --- a/elpa/cider-20181110.1413/cider-test.el +++ /dev/null @@ -1,825 +0,0 @@ -;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*- - -;; Copyright © 2014-2018 Jeff Valk, Bozhidar Batsov and CIDER contributors - -;; Author: Jeff Valk - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This provides execution, reporting, and navigation support for Clojure tests, -;; specifically using the `clojure.test' machinery. This functionality replaces -;; the venerable `clojure-test-mode' (deprecated in June 2014), and relies on -;; nREPL middleware for report running and session support. - -;;; Code: - -(require 'cider-common) -(require 'cider-client) -(require 'cider-popup) -(require 'cider-stacktrace) -(require '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 "") #'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-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/elpa/cider-20181110.1413/cider-tracing.el b/elpa/cider-20181110.1413/cider-tracing.el deleted file mode 100644 index c00e7b7f..00000000 --- a/elpa/cider-20181110.1413/cider-tracing.el +++ /dev/null @@ -1,90 +0,0 @@ -;;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov -;; Artur Malabarba - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A couple of commands for tracing the execution of functions. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) ; for `cider-prompt-for-symbol-function' -(require 'cider-util) ; for `cider-propertize' -(require 'cider-connection) ; for `cider-map-repls' -(require 'nrepl-dict) - -(defun cider-sync-request:toggle-trace-var (symbol) - "Toggle var tracing for SYMBOL." - (thread-first `("op" "toggle-trace-var" - "ns" ,(cider-current-ns) - "sym" ,symbol) - (cider-nrepl-send-sync-request))) - -(defun cider--toggle-trace-var (sym) - "Toggle var tracing for SYM." - (let* ((trace-response (cider-sync-request:toggle-trace-var sym)) - (var-name (nrepl-dict-get trace-response "var-name")) - (var-status (nrepl-dict-get trace-response "var-status"))) - (pcase var-status - ("not-found" (error "Var %s not found" (cider-propertize sym 'fn))) - ("not-traceable" (error "Var %s can't be traced because it's not bound to a function" (cider-propertize var-name 'fn))) - (_ (message "Var %s %s" (cider-propertize var-name 'fn) var-status))))) - -;;;###autoload -(defun cider-toggle-trace-var (arg) - "Toggle var tracing. -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates." - (interactive "P") - (cider-ensure-op-supported "toggle-trace-var") - (funcall (cider-prompt-for-symbol-function arg) - "Toggle trace for var" - #'cider--toggle-trace-var)) - -(defun cider-sync-request:toggle-trace-ns (ns) - "Toggle namespace tracing for NS." - (thread-first `("op" "toggle-trace-ns" - "ns" ,ns) - (cider-nrepl-send-sync-request))) - -;;;###autoload -(defun cider-toggle-trace-ns (query) - "Toggle ns tracing. -Defaults to the current ns. With prefix arg QUERY, prompts for a ns." - (interactive "P") - (cider-map-repls :clj-strict - (lambda (conn) - (with-current-buffer conn - (cider-ensure-op-supported "toggle-trace-ns") - (let ((ns (if query - (completing-read "Toggle trace for ns: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (let* ((trace-response (cider-sync-request:toggle-trace-ns ns)) - (ns-status (nrepl-dict-get trace-response "ns-status"))) - (pcase ns-status - ("not-found" (error "Namespace %s not found" (cider-propertize ns 'ns))) - (_ (message "Namespace %s %s" (cider-propertize ns 'ns) ns-status))))))))) - -(provide 'cider-tracing) -;;; cider-tracing.el ends here diff --git a/elpa/cider-20181110.1413/cider-util.el b/elpa/cider-20181110.1413/cider-util.el deleted file mode 100644 index f09d580f..00000000 --- a/elpa/cider-20181110.1413/cider-util.el +++ /dev/null @@ -1,791 +0,0 @@ -;; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Common utility functions that don't belong anywhere else. - -;;; Code: - -;; 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 "https://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 to inspect the defun at point's result." - "Press 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 to see every possible setting you can customize." - "Use to see every possible REPL setting you can customize." - "Enable `eldoc-mode' to display function & method signatures in the minibuffer." - "Enable `cider-enlighten-mode' to display the locals of a function when it's executed." - "Use <\\[cider-close-ancillary-buffers]> to close all ancillary buffers created by CIDER (e.g. *cider-doc*)." - "Exploring CIDER's menu-bar entries is a great way to discover features." - "Keep in mind that some commands don't have a keybinding by default. Explore CIDER!" - "Tweak `cider-repl-prompt-function' to customize your REPL prompt." - "Tweak `cider-eldoc-ns-function' to customize the way namespaces are displayed by eldoc." - "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/elpa/cider-20181110.1413/cider.el b/elpa/cider-20181110.1413/cider.el deleted file mode 100644 index 0f920e7a..00000000 --- a/elpa/cider-20181110.1413/cider.el +++ /dev/null @@ -1,1452 +0,0 @@ -;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell -;; Maintainer: Bozhidar Batsov -;; URL: http://www.github.com/clojure-emacs/cider -;; Version: 0.19.0-snapshot -;; Package-Requires: ((emacs "25") (clojure-mode "5.9") (pkg-info "0.4") (queue "0.2") (spinner "1.7") (seq "2.16") (sesman "0.3.2")) -;; Keywords: languages, clojure, cider - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides a Clojure interactive development environment for Emacs, built on -;; top of nREPL. - -;;; Installation: - -;; Available as a package in melpa.org and stable.melpa.org - -;; (add-to-list 'package-archives -;; '("melpa" . "https://melpa.org/packages/")) -;; -;; or -;; -;; (add-to-list 'package-archives -;; '("melpa-stable" . "https://stable.melpa.org/packages/") t) -;; -;; M-x package-install cider - -;;; Usage: - -;; M-x cider-jack-in-clj -;; M-x cider-jack-in-cljs -;; -;; M-x cider-connect-sibling-clj -;; M-x cider-connect-sibling-cljs -;; -;; M-x cider-connect-clj -;; M-x cider-connect-cljs - -;;; Code: - -(defgroup cider nil - "Clojure Interactive Development Environment that Rocks." - :prefix "cider-" - :group 'applications - :link '(url-link :tag "GitHub" "https://github.com/clojure-emacs/cider") - :link '(url-link :tag "Online Manual" "https://docs.cider.mx") - :link '(emacs-commentary-link :tag "Commentary" "cider")) - -(require 'cider-client) -(require 'cider-eldoc) -(require 'cider-repl) -(require 'cider-repl-history) -(require 'cider-connection) -(require 'cider-mode) -(require 'cider-common) -(require 'cider-compat) -(require 'cider-debug) -(require 'cider-util) - -(require 'tramp-sh) -(require 'subr-x) -(require 'seq) -(require 'sesman) - -(defconst cider-version "0.19.0-snapshot" - "Fallback version used when it cannot be extracted automatically. -Normally it won't be used, unless `pkg-info' fails to extract the -version from the CIDER package or library.") - -(defconst cider-codename "Saigon" - "Codename used to denote stable releases.") - -(defcustom cider-lein-command - "lein" - "The command used to execute Leiningen." - :type 'string - :group 'cider) - -(defcustom cider-lein-global-options - nil - "Command global options used to execute Leiningen (e.g.: -o for offline)." - :type 'string - :group 'cider - :safe #'stringp) - -(defcustom cider-lein-parameters - "repl :headless :host localhost" - "Params passed to Leiningen to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :safe #'stringp) - -(defcustom cider-boot-command - "boot" - "The command used to execute Boot." - :type 'string - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-boot-global-options - nil - "Command global options used to execute Boot (e.g.: -c for checkouts)." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.14.0")) - -(defcustom cider-boot-parameters - "cider.tasks/nrepl-server -b localhost wait" - "Params passed to boot to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.9.0")) - -(defcustom cider-clojure-cli-command - "clojure" - "The command used to execute clojure with tools.deps (requires Clojure 1.9+). -Don't use clj here, as it doesn't work when spawned from Emacs due to -it using rlwrap." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-clojure-cli-global-options - nil - "Command line options used to execute clojure with tools.deps." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-clojure-cli-parameters - "-m nrepl.cmdline --middleware '%s'" - "Params passed to clojure to start an nREPL server via `cider-jack-in'. -This is evaluated using `format', with the first argument being the Clojure -vector of middleware variables as a string." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-shadow-cljs-command - "npx shadow-cljs" - "The command used to execute shadow-cljs. - -By default we favor the project-specific shadow-cljs over the system-wide." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-shadow-cljs-global-options - "" - "Command line options used to execute shadow-cljs (e.g.: -v for verbose mode)." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-shadow-cljs-parameters - "server" - "Params passed to shadow-cljs to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-gradle-command - "gradle" - "The command used to execute Gradle." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.10.0")) - -(defcustom cider-gradle-global-options - "--no-daemon" - "Command line options used to execute Gradle (e.g.: -m for dry run)." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.14.0")) - -(defcustom cider-gradle-parameters - "clojureRepl" - "Params passed to gradle to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider - :safe #'stringp - :package-version '(cider . "0.10.0")) - -(define-obsolete-variable-alias 'cider-default-repl-command 'cider-jack-in-default) -(defcustom cider-jack-in-default (if (executable-find "clojure") 'clojure-cli 'lein) - "The default tool to use when doing `cider-jack-in' outside a project. -This value will only be consulted when no identifying file types, i.e. -project.clj for leiningen or build.boot for boot, could be found. - -As the Clojure CLI is bundled with Clojure itself, it's the default. -In the absence of the Clojure CLI (e.g. on Windows), we fallback -to Leiningen." - :type '(choice (const 'lein) - (const 'boot) - (const 'clojure-cli) - (const 'shadow-cljs) - (const 'gradle)) - :group 'cider - :safe #'symbolp - :package-version '(cider . "0.9.0")) - -(defcustom cider-preferred-build-tool - nil - "Allow choosing a build system when there are many. -When there are project markers from multiple build systems (e.g. lein and -boot) the user is prompted to select one of them. When non-nil, this -variable will suppress this behavior and will select whatever build system -is indicated by the variable if present. Note, this is only when CIDER -cannot decide which of many build systems to use and will never override a -command when there is no ambiguity." - :type '(choice (const 'lein) - (const 'boot) - (const 'clojure-cli) - (const 'shadow-cljs) - (const 'gradle) - (const :tag "Always ask" nil)) - :group 'cider - :safe #'symbolp - :package-version '(cider . "0.13.0")) - -(defcustom cider-allow-jack-in-without-project 'warn - "Controls what happens when doing `cider-jack-in' outside a project. -When set to 'warn you'd prompted to confirm the command. -When set to t `cider-jack-in' will quietly continue. -When set to nil `cider-jack-in' will fail." - :type '(choice (const :tag "always" t) - (const 'warn) - (const :tag "never" nil)) - :group 'cider - :safe #'stringp - :package-version '(cider . "0.15.0")) - -(defcustom cider-known-endpoints nil - "A list of connection endpoints where each endpoint is a list. -For example: \\='((\"label\" \"host\" \"port\")). -The label is optional so that \\='(\"host\" \"port\") will suffice. -This variable is used by `cider-connect'." - :type '(repeat (list (string :tag "label") - (string :tag "host") - (string :tag "port"))) - :group 'cider) - -(defcustom cider-connected-hook nil - "List of functions to call when connected to Clojure nREPL server." - :type 'hook - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-disconnected-hook nil - "List of functions to call when disconnected from the Clojure nREPL server." - :type 'hook - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-inject-dependencies-at-jack-in t - "When nil, do not inject repl dependencies (most likely nREPL middlewares) at `cider-jack-in' time." - :type 'boolean - :safe #'booleanp - :version '(cider . "0.11.0")) - -(defcustom cider-offer-to-open-cljs-app-in-browser t - "When nil, do not offer to open ClojureScript apps in a browser on connect." - :type 'boolean - :safe #'booleanp - :version '(cider . "0.15.0")) - -(defvar cider-ps-running-nrepls-command "ps u | grep leiningen" - "Process snapshot command used in `cider-locate-running-nrepl-ports'.") - -(defvar cider-ps-running-nrepl-path-regexp-list - '("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D" - "\\(?:-classpath +:?\\(.+?\\)/self-installs\\)") - "Regexp list to get project paths. -Extract project paths from output of `cider-ps-running-nrepls-command'. -Sub-match 1 must be the project path.") - -(defvar cider-host-history nil - "Completion history for connection hosts.") - -;;;###autoload -(defun cider-version () - "Display CIDER's version." - (interactive) - (message "CIDER %s" (cider--version))) - -(defun cider-jack-in-command (project-type) - "Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE." - (pcase project-type - ('lein cider-lein-command) - ('boot cider-boot-command) - ('clojure-cli cider-clojure-cli-command) - ('shadow-cljs cider-shadow-cljs-command) - ('gradle cider-gradle-command) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defun cider-jack-in-resolve-command (project-type) - "Determine the resolved file path to `cider-jack-in-command'. -Throws an error if PROJECT-TYPE is unknown." - (pcase project-type - ('lein (cider--resolve-command cider-lein-command)) - ('boot (cider--resolve-command cider-boot-command)) - ('clojure-cli (cider--resolve-command cider-clojure-cli-command)) - ;; here we have to account for the possibility that the command is either - ;; "npx shadow-cljs" or just "shadow-cljs" - ('shadow-cljs (let ((parts (split-string cider-shadow-cljs-command))) - (when-let* ((command (cider--resolve-command (car parts)))) - (mapconcat #'identity (cons command (cdr parts)) " ")))) - ('gradle (cider--resolve-command cider-gradle-command)) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defun cider-jack-in-global-options (project-type) - "Determine the command line options for `cider-jack-in' for the PROJECT-TYPE." - (pcase project-type - ('lein cider-lein-global-options) - ('boot cider-boot-global-options) - ('clojure-cli cider-clojure-cli-global-options) - ('shadow-cljs cider-shadow-cljs-global-options) - ('gradle cider-gradle-global-options) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defun cider-jack-in-params (project-type) - "Determine the commands params for `cider-jack-in' for the PROJECT-TYPE." - (pcase project-type - ('lein cider-lein-parameters) - ('boot cider-boot-parameters) - ('clojure-cli (format cider-clojure-cli-parameters - (concat - "[" - (mapconcat - (apply-partially #'format "\"%s\"") - (cider-jack-in-normalized-nrepl-middlewares) - ", ") - "]"))) - ('shadow-cljs cider-shadow-cljs-parameters) - ('gradle cider-gradle-parameters) - (_ (user-error "Unsupported project type `%S'" project-type)))) - - -;;; Jack-in dependencies injection -(defvar cider-jack-in-dependencies nil - "List of dependencies where elements are lists of artifact name and version.") -(put 'cider-jack-in-dependencies 'risky-local-variable t) -;; We inject the newest known version of nREPL just in case -;; your version of Boot or Leiningen is bundling an older one. -(cider-add-to-alist 'cider-jack-in-dependencies - "nrepl" "0.4.5") - -(defvar cider-jack-in-cljs-dependencies nil - "List of dependencies where elements are lists of artifact name and version. -Added to `cider-jack-in-dependencies' when doing `cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-dependencies 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-cljs-dependencies "cider/piggieback" "0.3.10") - -(defvar cider-jack-in-dependencies-exclusions nil - "List of exclusions for jack in dependencies. -Elements of the list are artifact name and list of exclusions to apply for the artifact.") -(put 'cider-jack-in-dependencies-exclusions 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-dependencies-exclusions - "org.clojure/tools.nrepl" '("org.clojure/clojure")) - -(defconst cider-clojure-artifact-id "org.clojure/clojure" - "Artifact identifier for Clojure.") - -(defconst cider-minimum-clojure-version "1.8.0" - "Minimum supported version of Clojure.") - -(defconst cider-latest-clojure-version "1.10.0" - "Latest supported version of Clojure.") - -(defconst cider-required-middleware-version "0.18.0" - "The minimum CIDER nREPL version that's known to work properly with CIDER.") - -(defconst cider-latest-middleware-version "0.19.0-SNAPSHOT" - "The latest CIDER nREPL version that's known to work properly with CIDER.") - -(defcustom cider-jack-in-auto-inject-clojure nil - "Version of clojure to auto-inject into REPL. -If nil, do not inject Clojure into the REPL. If `latest', inject -`cider-latest-clojure-version', which should approximate to the most recent -version of Clojure. If `minimal', inject `cider-minimum-clojure-version', -which will be the lowest version CIDER supports. If a string, use this as -the version number. If it is a list, the first element should be a string, -specifying the artifact ID, and the second element the version number." - :type '(choice (const :tag "None" nil) - (const :tag "Latest" 'latest) - (const :tag "Minimal" 'minimal) - (string :tag "Specific Version") - (list :tag "Artifact ID and Version" - (string :tag "Artifact ID") - (string :tag "Version")))) - -(defvar cider-jack-in-lein-plugins nil - "List of Leiningen plugins to be injected at jack-in. -Each element is a list of artifact name and version, followed optionally by -keyword arguments. The only keyword argument currently accepted is -`:predicate', which should be given a function that takes the list (name, -version, and keyword arguments) and returns non-nil to indicate that the -plugin should actually be injected. (This is useful primarily for packages -that extend CIDER, not for users. For example, a refactoring package might -want to inject some middleware only when within a project context.)") -(put 'cider-jack-in-lein-plugins 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-lein-plugins - "cider/cider-nrepl" cider-latest-middleware-version) - -(defvar cider-jack-in-cljs-lein-plugins nil - "List of Leiningen plugins to be injected at jack-in. -Added to `cider-jack-in-lein-plugins' (which see) when doing -`cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-lein-plugins 'risky-local-variable t) - -(defun cider-jack-in-normalized-lein-plugins () - "Return a normalized list of Leiningen plugins to be injected. -See `cider-jack-in-lein-plugins' for the format, except that the list -returned by this function does not include keyword arguments." - (thread-last cider-jack-in-lein-plugins - (seq-filter - (lambda (spec) - (if-let* ((pred (plist-get (seq-drop spec 2) :predicate))) - (funcall pred spec) - t))) - (mapcar - (lambda (spec) - (seq-take spec 2))))) - -(defvar cider-jack-in-nrepl-middlewares nil - "List of Clojure variable names. -Each of these Clojure variables should hold a vector of nREPL middlewares. -Instead of a string, an element can be a list containing a string followed -by optional keyword arguments. The only keyword argument currently -accepted is `:predicate', which should be given a function that takes the -list (string and keyword arguments) and returns non-nil to indicate that -the middlewares should actually be injected.") -(put 'cider-jack-in-nrepl-middlewares 'risky-local-variable t) -(add-to-list 'cider-jack-in-nrepl-middlewares "cider.nrepl/cider-middleware") - -(defvar cider-jack-in-cljs-nrepl-middlewares nil - "List of Clojure variable names. -Added to `cider-jack-in-nrepl-middlewares' (which see) when doing -`cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-nrepl-middlewares 'risky-local-variable t) -(add-to-list 'cider-jack-in-cljs-nrepl-middlewares "cider.piggieback/wrap-cljs-repl") - -(defun cider-jack-in-normalized-nrepl-middlewares () - "Return a normalized list of middleware variable names. -See `cider-jack-in-nrepl-middlewares' for the format, except that the list -returned by this function only contains strings." - (thread-last cider-jack-in-nrepl-middlewares - (seq-filter - (lambda (spec) - (or (not (listp spec)) - (if-let* ((pred (plist-get (cdr spec) :predicate))) - (funcall pred spec) - t)))) - (mapcar - (lambda (spec) - (if (listp spec) - (car spec) - spec))))) - -(defun cider--list-as-boot-artifact (list) - "Return a boot artifact string described by the elements of LIST. -LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). The returned -string is quoted for passing as argument to an inferior shell." - (concat "-d " (shell-quote-argument (format "%s:%s" (car list) (cadr list))))) - -(defun cider-boot-dependencies (dependencies) - "Return a list of boot artifact strings created from DEPENDENCIES." - (concat (mapconcat #'cider--list-as-boot-artifact dependencies " ") - (unless (seq-empty-p dependencies) " "))) - -(defun cider-boot-middleware-task (params middlewares) - "Create a command to add MIDDLEWARES with corresponding PARAMS." - (concat "cider.tasks/add-middleware " - (mapconcat (lambda (middleware) - (format "-m %s" (shell-quote-argument middleware))) - middlewares - " ") - " " params)) - -(defun cider-boot-jack-in-dependencies (global-opts params dependencies plugins middlewares) - "Create boot jack-in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, -PLUGINS and MIDDLEWARES. PARAMS and MIDDLEWARES are passed on to -`cider-boot-middleware-task` before concatenating and DEPENDENCIES and PLUGINS - are passed on to `cider-boot-dependencies`." - (concat global-opts - (unless (seq-empty-p global-opts) " ") - "-i \"(require 'cider.tasks)\" " ;; Note the space at the end here - (cider-boot-dependencies (append dependencies plugins)) - (cider-boot-middleware-task params middlewares))) - -(defun cider--lein-artifact-exclusions (exclusions) - "Return an exclusions vector described by the elements of EXCLUSIONS." - (if exclusions - (format " :exclusions [%s]" (mapconcat #'identity exclusions " ")) - "")) - -(defun cider--list-as-lein-artifact (list &optional exclusions) - "Return an artifact string described by the elements of LIST. -LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). Optionally a list -of EXCLUSIONS can be provided as well. The returned -string is quoted for passing as argument to an inferior shell." - (shell-quote-argument (format "[%s %S%s]" (car list) (cadr list) (cider--lein-artifact-exclusions exclusions)))) - -(defun cider-lein-jack-in-dependencies (global-opts params dependencies dependencies-exclusions lein-plugins) - "Create lein jack-in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, with DEPENDENCIES-EXCLUSIONS -removed, LEIN-PLUGINS, and finally PARAMS." - (concat - global-opts - (unless (seq-empty-p global-opts) " ") - (mapconcat #'identity - (append (seq-map (lambda (dep) - (let ((exclusions (cadr (assoc (car dep) dependencies-exclusions)))) - (concat "update-in :dependencies conj " - (cider--list-as-lein-artifact dep exclusions)))) - dependencies) - (seq-map (lambda (plugin) - (concat "update-in :plugins conj " - (cider--list-as-lein-artifact plugin))) - lein-plugins)) - " -- ") - " -- " - params)) - -(defun cider-clojure-cli-jack-in-dependencies (global-opts params dependencies) - "Create Clojure tools.deps jack-in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES finally PARAMS." - (let ((dependencies (append dependencies cider-jack-in-lein-plugins))) - (concat - global-opts - (unless (seq-empty-p global-opts) " ") - "-Sdeps '{:deps {" - (mapconcat #'identity - (seq-map (lambda (dep) (format "%s {:mvn/version \"%s\"}" (car dep) (cadr dep))) dependencies) - " ") - "}}' " - params))) - -(defun cider-shadow-cljs-jack-in-dependencies (global-opts params dependencies) - "Create shadow-cljs jack-in deps. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES finally PARAMS." - (let ((dependencies (append dependencies cider-jack-in-lein-plugins))) - (concat - global-opts - (unless (seq-empty-p global-opts) " ") - (mapconcat #'identity - (seq-map (lambda (dep) (format "-d %s:%s" (car dep) (cadr dep))) dependencies) - " ") - " " - params))) - -(defun cider-add-clojure-dependencies-maybe (dependencies) - "Return DEPENDENCIES with an added Clojure dependency if requested. -See also `cider-jack-in-auto-inject-clojure'." - (if cider-jack-in-auto-inject-clojure - (if (consp cider-jack-in-auto-inject-clojure) - (cons cider-jack-in-auto-inject-clojure dependencies) - (cons (list cider-clojure-artifact-id - (cond - ((stringp cider-jack-in-auto-inject-clojure) - cider-jack-in-auto-inject-clojure) - ((eq cider-jack-in-auto-inject-clojure 'minimal) - cider-minimum-clojure-version) - ((eq cider-jack-in-auto-inject-clojure 'latest) - cider-latest-clojure-version))) - dependencies)) - dependencies)) - -(defun cider-inject-jack-in-dependencies (global-opts params project-type) - "Return GLOBAL-OPTS and PARAMS with injected REPL dependencies. -These are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' and -`cider-jack-in-nrepl-middlewares' are injected from the CLI according to -the used PROJECT-TYPE. Eliminates the need for hacking profiles.clj or the -boot script for supporting cider with its nREPL middleware and -dependencies." - (pcase project-type - ('lein (cider-lein-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - cider-jack-in-dependencies-exclusions - (cider-jack-in-normalized-lein-plugins))) - ('boot (cider-boot-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - (cider-jack-in-normalized-lein-plugins) - (cider-jack-in-normalized-nrepl-middlewares))) - ('clojure-cli (cider-clojure-cli-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies))) - ('shadow-cljs (cider-shadow-cljs-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies))) - ('gradle (concat - global-opts - (unless (seq-empty-p global-opts) " ") - params)) - (_ (error "Unsupported project type `%S'" project-type)))) - - -;;; ClojureScript REPL creation - -(defcustom cider-check-cljs-repl-requirements t - "When non-nil will run the requirement checks for the different cljs repls. -Generally you should not disable this unless you run into some faulty check." - :type 'boolean - :safe #'booleanp - :package-version '(cider . "0.17.0")) - -(defun cider-verify-clojurescript-is-present () - "Check whether ClojureScript is present." - (unless (cider-library-present-p "clojure/clojurescript") - (user-error "ClojureScript is not available. See https://docs.cider.mx/en/latest/clojurescript for details"))) - -(defun cider-verify-piggieback-is-present () - "Check whether the piggieback middleware is present." - (unless (cider-library-present-p "cider/piggieback") - (user-error "Piggieback 0.3.x (aka cider/piggieback) is not available. See https://docs.cider.mx/en/latest/clojurescript for details"))) - -(defun cider-check-nashorn-requirements () - "Check whether we can start a Nashorn ClojureScript REPL." - (cider-verify-piggieback-is-present)) - -(defun cider-check-node-requirements () - "Check whether we can start a Node ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (executable-find "node") - (user-error "Node.js is not present on the exec-path. Make sure you've installed it and your exec-path is properly set"))) - -(defun cider-check-figwheel-requirements () - "Check whether we can start a Figwheel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "figwheel-sidecar/figwheel-sidecar") - (user-error "Figwheel-sidecar is not available. Please check https://docs.cider.mx/en/latest/clojurescript"))) - -(defun cider-check-figwheel-main-requirements () - "Check whether we can start a Figwheel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "bhauman/figwheel-main") - (user-error "Figwheel-main is not available. Please check https://docs.cider.mx/en/latest/clojurescript"))) - -(defun cider-check-weasel-requirements () - "Check whether we can start a Weasel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "weasel/weasel") - (user-error "Weasel in not available. Please check https://docs.cider.mx/en/latest/clojurescript/#browser-connected-clojurescript-repl"))) - -(defun cider-check-boot-requirements () - "Check whether we can start a Boot ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "adzerk/boot-cljs-repl") - (user-error "The Boot ClojureScript REPL is not available. Please check https://github.com/adzerk-oss/boot-cljs-repl/blob/master/README.md"))) - -(defun cider-check-shadow-cljs-requirements () - "Check whether we can start a shadow-cljs REPL." - (unless (cider-library-present-p "thheller/shadow-cljs") - (user-error "The shadow-cljs ClojureScript REPL is not available"))) - -(defun cider-normalize-cljs-init-options (options) - "Normalize the OPTIONS string used for initializing a ClojureScript REPL." - (if (or (string-prefix-p "{" options) - (string-prefix-p "(" options) - (string-prefix-p "[" options) - (string-prefix-p ":" options)) - options - (concat ":" options))) - -(defcustom cider-shadow-default-options nil - "Defines default `shadow-cljs' options." - :type 'string - :safe (lambda (s) (or (null s) (stringp s))) - :package-version '(cider . "0.18.0")) - -(defun cider-shadow-select-cljs-init-form () - "Generate the init form for a shadow-cljs select-only REPL. -We have to prompt the user to select a build, that's why this is a command, -not just a string." - (let ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/nrepl-select %s))") - (options (or cider-shadow-default-options - (read-from-minibuffer "Select shadow-cljs build (e.g. dev): ")))) - (format form (cider-normalize-cljs-init-options options)))) - -(defun cider-shadow-cljs-init-form () - "Generate the init form for a shadow-cljs REPL. -We have to prompt the user to select a build, that's why -this is a command, not just a string." - (let* ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/watch %s) (shadow/nrepl-select %s))") - (options (or cider-shadow-default-options - (read-from-minibuffer "Select shadow-cljs build (e.g. dev): "))) - (build (cider-normalize-cljs-init-options options))) - (format form build build))) - -(defcustom cider-figwheel-main-default-options nil - "Defines the `figwheel.main/start' options. - -Note that figwheel-main/start can also accept a map of options, refer to -Figwheel for details." - :type 'string - :safe (lambda (s) (or (null s) (stringp s))) - :package-version '(cider . "0.18.0")) - -(defun cider-figwheel-main-init-form () - "Produce the figwheel-main ClojureScript init form." - (let ((form "(do (require 'figwheel.main) (figwheel.main/start %s))") - (options (string-trim - (or cider-figwheel-main-default-options - (read-from-minibuffer "Select figwheel-main build (e.g. :dev): "))))) - (format form (cider-normalize-cljs-init-options options)))) - -(defun cider-custom-cljs-repl-init-form () - "Prompt for a form that would start a ClojureScript REPL. -The supplied string will be wrapped in a do form if needed." - (let ((form (read-from-minibuffer "Please, provide a form to start a ClojureScript REPL: "))) - ;; TODO: We should probably make this more robust (e.g. by using a regexp or - ;; parsing the form). - (if (string-prefix-p "(do" form) - form - (format "(do %s)" form)))) - -(defvar cider-cljs-repl-types - '((nashorn "(do (require 'cljs.repl.nashorn) (cider.piggieback/cljs-repl (cljs.repl.nashorn/repl-env)))" - cider-check-nashorn-requirements) - (figwheel "(do (require 'figwheel-sidecar.repl-api) (figwheel-sidecar.repl-api/start-figwheel!) (figwheel-sidecar.repl-api/cljs-repl))" - cider-check-figwheel-requirements) - (figwheel-main cider-figwheel-main-init-form cider-check-figwheel-main-requirements) - (node "(do (require 'cljs.repl.node) (cider.piggieback/cljs-repl (cljs.repl.node/repl-env)))" - cider-check-node-requirements) - (weasel "(do (require 'weasel.repl.websocket) (cider.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \"127.0.0.1\" :port 9001)))" - cider-check-weasel-requirements) - (boot "(do (require 'adzerk.boot-cljs-repl) (adzerk.boot-cljs-repl/start-repl))" - cider-check-boot-requirements) - (shadow cider-shadow-cljs-init-form cider-check-shadow-cljs-requirements) - (shadow-select cider-shadow-select-cljs-init-form cider-check-shadow-cljs-requirements) - (custom cider-custom-cljs-repl-init-form nil)) - "A list of supported ClojureScript REPLs. - -For each one we have its name, the form we need to evaluate in a Clojure -REPL to start the ClojureScript REPL and functions to very their requirements. - -The form should be either a string or a function producing a string.") - -(defun cider-register-cljs-repl-type (type init-form &optional requirements-fn) - "Register a new ClojureScript REPL type. - -Types are defined by the following: - -- TYPE - symbol identifier that will be used to refer to the REPL type -- INIT-FORM - string or function (symbol) producing string -- REQUIREMENTS-FN - function to check whether the REPL can be started. -This param is optional. - -All this function does is modifying `cider-cljs-repl-types'. -It's intended to be used in your Emacs config." - (unless (symbolp type) - (user-error "The REPL type must be a symbol")) - (unless (or (stringp init-form) (symbolp init-form)) - (user-error "The init form must be a string or a symbol referring to a function")) - (unless (or (null requirements-fn) (symbolp requirements-fn)) - (user-error "The requirements-fn must be a symbol referring to a function")) - (add-to-list 'cider-cljs-repl-types (list type init-form requirements-fn))) - -(defcustom cider-default-cljs-repl nil - "The default ClojureScript REPL to start. -This affects commands like `cider-jack-in-cljs'. Generally it's -intended to be set via .dir-locals.el for individual projects, as its -relatively unlikely you'd like to use the same type of REPL in each project -you're working on." - :type '(choice (const :tag "Nashorn" nashorn) - (const :tag "Figwheel" figwheel) - (const :tag "Figwheel Main" figwheel-main) - (const :tag "Node" node) - (const :tag "Weasel" weasel) - (const :tag "Boot" boot) - (const :tag "Shadow" shadow) - (const :tag "Shadow w/o Server" shadow-select) - (const :tag "Custom" custom)) - :group 'cider - :safe #'symbolp - :package-version '(cider . "0.17.0")) - -(make-obsolete-variable 'cider-cljs-lein-repl 'cider-default-cljs-repl "0.17") -(make-obsolete-variable 'cider-cljs-boot-repl 'cider-default-cljs-repl "0.17") -(make-obsolete-variable 'cider-cljs-gradle-repl 'cider-default-cljs-repl "0.17") - -(defvar cider--select-cljs-repl-history nil) -(defun cider-select-cljs-repl (&optional default) - "Select the ClojureScript REPL to use with `cider-jack-in-cljs'. -DEFAULT is the default ClojureScript REPL to offer in completion." - (let ((repl-types (mapcar #'car cider-cljs-repl-types))) - (intern (completing-read "Select ClojureScript REPL type: " repl-types - nil nil nil 'cider--select-cljs-repl-history - (or default (car cider--select-cljs-repl-history)))))) - -(defun cider-cljs-repl-form (repl-type) - "Get the cljs REPL form for REPL-TYPE." - (if-let* ((repl-form (cadr (seq-find - (lambda (entry) - (eq (car entry) repl-type)) - cider-cljs-repl-types)))) - ;; repl-form can be either a string or a function producing a string - (if (symbolp repl-form) - (funcall repl-form) - repl-form) - (user-error "No ClojureScript REPL type %s found. Please make sure that `cider-cljs-repl-types' has an entry for it" repl-type))) - -(defun cider-verify-cljs-repl-requirements (&optional repl-type) - "Verify that the requirements for REPL-TYPE are met. -Return REPL-TYPE if requirements are met." - (let ((repl-type (or repl-type - cider-default-cljs-repl - (cider-select-cljs-repl)))) - (when cider-check-cljs-repl-requirements - (when-let* ((fun (nth 2 (seq-find - (lambda (entry) - (eq (car entry) repl-type)) - cider-cljs-repl-types)))) - (funcall fun))) - repl-type)) - -(defun cider--check-cljs (&optional cljs-type no-error) - "Verify that all cljs requirements are met for CLJS-TYPE connection. -Return REPL-TYPE of requirement are met, and throw an ‘user-error’ otherwise. -When NO-ERROR is non-nil, don't throw an error, issue a message and return -nil." - (if no-error - (condition-case ex - (progn - (cider-verify-clojurescript-is-present) - (cider-verify-cljs-repl-requirements cljs-type)) - (error - (message "Invalid ClojureScript dependency: %S" ex) - nil)) - (cider-verify-clojurescript-is-present) - (cider-verify-cljs-repl-requirements cljs-type))) - -(defun cider--offer-to-open-app-in-browser (server-buffer) - "Look for a server address in SERVER-BUFFER and offer to open it." - (when (buffer-live-p server-buffer) - (with-current-buffer server-buffer - (save-excursion - (goto-char (point-min)) - (when-let* ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror) - (match-string 0)))) - (when (y-or-n-p (format "Visit ‘%s’ in a browser? " url)) - (browse-url url))))))) - - -;;; User Level Connectors - -;;;###autoload (autoload 'cider-start-map "cider" "CIDER jack-in and connect keymap." t 'keymap) -(defvar cider-start-map - (let ((map (define-prefix-command 'cider-start-map))) - (define-key map (kbd "x") #'cider) - (define-key map (kbd "C-x") #'cider) - (define-key map (kbd "j j") #'cider-jack-in-clj) - (define-key map (kbd "j s") #'cider-jack-in-cljs) - (define-key map (kbd "j m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "C-j j") #'cider-jack-in-clj) - (define-key map (kbd "C-j s") #'cider-jack-in-cljs) - (define-key map (kbd "C-j m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "C-j C-j") #'cider-jack-in-clj) - (define-key map (kbd "C-j C-s") #'cider-jack-in-cljs) - (define-key map (kbd "C-j C-m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "c j") #'cider-connect-clj) - (define-key map (kbd "c s") #'cider-connect-cljs) - (define-key map (kbd "c m") #'cider-connect-clj&cljs) - (define-key map (kbd "C-c j") #'cider-connect-clj) - (define-key map (kbd "C-c s") #'cider-connect-cljs) - (define-key map (kbd "C-c m") #'cider-connect-clj&cljs) - (define-key map (kbd "C-c C-j") #'cider-connect-clj) - (define-key map (kbd "C-c C-s") #'cider-connect-cljs) - (define-key map (kbd "C-c C-m") #'cider-connect-clj&cljs) - (define-key map (kbd "s j") #'cider-connect-sibling-clj) - (define-key map (kbd "s s") #'cider-connect-sibling-cljs) - (define-key map (kbd "C-s j") #'cider-connect-sibling-clj) - (define-key map (kbd "C-s s") #'cider-connect-sibling-cljs) - (define-key map (kbd "C-s C-j") #'cider-connect-sibling-clj) - (define-key map (kbd "C-s C-s") #'cider-connect-sibling-cljs) - map) - "CIDER jack-in and connect keymap.") - -;;;###autoload -(defun cider-jack-in-clj (params) - "Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. -With the prefix argument, prompt for all these parameters." - (interactive "P") - (let ((params (thread-first params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd)))) - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - (lambda (server-buffer) - (cider-connect-sibling-clj params server-buffer))))) - -;;;###autoload -(defun cider-jack-in-cljs (params) - "Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, -prompt for all these parameters." - (interactive "P") - (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) - (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) - (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) - (orig-buffer (current-buffer))) - ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars - (let ((params (thread-first params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd)))) - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - (lambda (server-buffer) - (with-current-buffer orig-buffer - (cider-connect-sibling-cljs params server-buffer))))))) - -;;;###autoload -(defun cider-jack-in-clj&cljs (&optional params soft-cljs-start) - "Start an nREPL server and connect with clj and cljs REPLs. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, -prompt for all these parameters. When SOFT-CLJS-START is non-nil, start -cljs REPL only when the ClojureScript dependencies are met." - (interactive "P") - (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) - (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) - (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) - (orig-buffer (current-buffer))) - ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars - (let ((params (thread-first params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd) - (cider--update-cljs-type) - ;; already asked, don't ask on sibling connect - (plist-put :do-prompt nil)))) - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - (lambda (server-buffer) - (with-current-buffer orig-buffer - (let ((clj-repl (cider-connect-sibling-clj params server-buffer))) - (if soft-cljs-start - (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) - (cider-connect-sibling-cljs params clj-repl)) - (cider-connect-sibling-cljs params clj-repl))))))))) - -;;;###autoload -(defun cider-connect-sibling-clj (params &optional other-repl) - "Create a Clojure REPL with the same server as OTHER-REPL. -PARAMS is for consistency with other connection commands and is currently -ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can -also be a server buffer, in which case a new session with a REPL for that -server is created." - (interactive "P") - (cider-nrepl-connect - (let* ((other-repl (or other-repl (cider-current-repl nil 'ensure))) - (other-params (cider--gather-connect-params nil other-repl)) - (ses-name (unless (nrepl-server-p other-repl) - (sesman-session-name-for-object 'CIDER other-repl)))) - (thread-first params - (cider--update-do-prompt) - (append other-params) - (plist-put :repl-init-function nil) - (plist-put :repl-type "clj") - (plist-put :session-name ses-name))))) - -;;;###autoload -(defun cider-connect-sibling-cljs (params &optional other-repl) - "Create a ClojureScript REPL with the same server as OTHER-REPL. -PARAMS is a plist optionally containing :cljs-repl-type (e.g. Node, -Figwheel, etc). All other parameters are inferred from the OTHER-REPL. -OTHER-REPL defaults to `cider-current-repl' but in programs can also be a -server buffer, in which case a new session for that server is created." - (interactive "P") - (let* ((other-repl (or other-repl (cider-current-repl nil 'ensure))) - (other-params (cider--gather-connect-params nil other-repl)) - (ses-name (unless (nrepl-server-p other-repl) - (sesman-session-name-for-object 'CIDER other-repl)))) - (cider-nrepl-connect - (thread-first params - (cider--update-do-prompt) - (append other-params) - (cider--update-cljs-type) - (cider--update-cljs-init-function) - (plist-put :session-name ses-name) - (plist-put :repl-type "pending-cljs"))))) - -;;;###autoload -(defun cider-connect-clj (&optional params) - "Initialize a Clojure connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port and :project-dir. On -prefix argument, prompt for all the parameters." - (interactive "P") - (cider-nrepl-connect - (thread-first params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (plist-put :repl-init-function nil) - (plist-put :session-name nil) - (plist-put :repl-type "clj")))) - -;;;###autoload -(defun cider-connect-cljs (&optional params) - "Initialize a ClojureScript connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. Node, Figwheel, etc). On prefix, prompt for all the -parameters regardless of their supplied or default values." - (interactive "P") - (cider-nrepl-connect - (thread-first params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (cider--update-cljs-type) - (cider--update-cljs-init-function) - (plist-put :session-name nil) - (plist-put :repl-type "pending-cljs")))) - -;;;###autoload -(defun cider-connect-clj&cljs (params &optional soft-cljs-start) - "Initialize a Clojure and ClojureScript connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is -non-nil, don't start if ClojureScript requirements are not met." - (interactive "P") - (let* ((params (thread-first params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (cider--update-cljs-type))) - (clj-repl (cider-connect-clj params))) - (if soft-cljs-start - (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) - (cider-connect-sibling-cljs params clj-repl)) - (cider-connect-sibling-cljs params clj-repl)))) - -(defvar cider-connection-init-commands - '(cider-jack-in-clj - cider-jack-in-cljs - cider-jack-in-clj&cljs - cider-connect-clj - cider-connect-cljs - cider-connect-clj&cljs - cider-connect-sibling-clj - cider-connect-sibling-cljs) - "A list of all user-level connection init commands in CIDER.") - -;;;###autoload -(defun cider () - "Start a connection of any type interactively." - (interactive) - (when-let* ((command (intern (completing-read "Select command: " cider-connection-init-commands)))) - (call-interactively command))) - - -;;; PARAMS updating - -(defun cider--update-do-prompt (params) - "Update :do-prompt in PARAMS." - (if (equal params '(4)) - (list :do-prompt t) - params)) - -(defun cider--update-project-dir (params) - "Update :project-dir in PARAMS." - (let* ((params (cider--update-do-prompt params)) - (proj-dir (if (plist-get params :do-prompt) - (read-directory-name "Project: " - (clojure-project-dir (cider-current-dir))) - (plist-get params :project-dir))) - (orig-buffer (current-buffer))) - (if (or (null proj-dir) - (file-in-directory-p default-directory proj-dir)) - (plist-put params :project-dir - (or proj-dir - (clojure-project-dir (cider-current-dir)))) - ;; If proj-dir is not a parent of default-directory, transfer all local - ;; variables and hack dir-local variables into a temporary buffer and keep - ;; that buffer within `params` for the later use by other --update- - ;; functions. The context buffer should not be used outside of the param - ;; initialization pipeline. Therefore, we don't bother with making it - ;; unique or killing it anywhere. - (let ((context-buf-name " *cider-context-buffer*")) - (when (get-buffer context-buf-name) - (kill-buffer context-buf-name)) - (with-current-buffer (get-buffer-create context-buf-name) - (dolist (pair (buffer-local-variables orig-buffer)) - (pcase pair - (`(,name . ,value) ;ignore unbound variables - (ignore-errors (set (make-local-variable name) value)))) - (setq-local buffer-file-name nil)) - (let ((default-directory proj-dir)) - (hack-dir-local-variables-non-file-buffer) - (thread-first params - (plist-put :project-dir proj-dir) - (plist-put :--context-buffer (current-buffer))))))))) - -(defun cider--update-cljs-type (params) - "Update :cljs-repl-type in PARAMS." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let ((params (cider--update-do-prompt params)) - (inferred-type (or (plist-get params :cljs-repl-type) - cider-default-cljs-repl))) - (plist-put params :cljs-repl-type - (if (plist-get params :do-prompt) - (cider-select-cljs-repl inferred-type) - (or inferred-type - (cider-select-cljs-repl))))))) - -(defun cider--update-jack-in-cmd (params) - "Update :jack-in-cmd key in PARAMS." - (let* ((params (cider--update-do-prompt params)) - (project-dir (plist-get params :project-dir)) - (project-type (cider-project-type project-dir)) - (command (cider-jack-in-command project-type)) - (command-resolved (cider-jack-in-resolve-command project-type)) - (command-global-opts (cider-jack-in-global-options project-type)) - (command-params (cider-jack-in-params project-type))) - (if command-resolved - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let* ((command-params (if (plist-get params :do-prompt) - (read-string (format "nREPL server command: %s " command-params) - command-params) - command-params)) - (cmd-params (if cider-inject-dependencies-at-jack-in - (cider-inject-jack-in-dependencies command-global-opts command-params project-type) - command-params))) - (if (or project-dir cider-allow-jack-in-without-project) - (when (or project-dir - (eq cider-allow-jack-in-without-project t) - (and (null project-dir) - (eq cider-allow-jack-in-without-project 'warn) - (y-or-n-p "Are you sure you want to run `cider-jack-in' without a Clojure project? "))) - (let* ((cmd (format "%s %s" command-resolved cmd-params))) - (plist-put params :jack-in-cmd cmd))) - (user-error "`cider-jack-in' is not allowed without a Clojure project")))) - (user-error "The %s executable isn't on your `exec-path'" command)))) - -(defun cider--update-host-port (params) - "Update :host and :port in PARAMS." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let* ((params (cider--update-do-prompt params)) - (host (plist-get params :host)) - (port (plist-get params :port)) - (endpoint (if (plist-get params :do-prompt) - (cider-select-endpoint) - (if (and host port) - (cons host port) - (cider-select-endpoint))))) - (thread-first params - (plist-put :host (car endpoint)) - (plist-put :port (cdr endpoint)))))) - -(defun cider--update-cljs-init-function (params) - "Update PARAMS :repl-init-function for cljs connections." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let ((cljs-type (plist-get params :cljs-repl-type))) - (plist-put params :repl-init-function - (lambda () - (cider--check-cljs cljs-type) - ;; FIXME: ideally this should be done in the state handler - (setq-local cider-cljs-repl-type cljs-type) - (cider-nrepl-send-request - (list "op" "eval" - "ns" (cider-current-ns) - "code" (cider-cljs-repl-form cljs-type)) - (cider-repl-handler (current-buffer))) - (when (and (buffer-live-p nrepl-server-buffer) - cider-offer-to-open-cljs-app-in-browser) - (cider--offer-to-open-app-in-browser nrepl-server-buffer))))))) - -(defun cider--check-existing-session (params) - "Ask for confirmation if a session with similar PARAMS already exists. -If no session exists or user chose to proceed, return PARAMS. If the user -canceled the action, signal quit." - (let* ((proj-dir (plist-get params :project-dir)) - (host (plist-get params :host)) - (port (plist-get params :port)) - (session (seq-find (lambda (ses) - (let ((ses-params (cider--gather-session-params ses))) - (and (equal proj-dir (plist-get ses-params :project-dir)) - (or (null port) - (equal port (plist-get ses-params :port))) - (or (null host) - (equal host (plist-get ses-params :host)))))) - (sesman-current-sessions 'CIDER '(project))))) - (when session - (unless (y-or-n-p - (concat - "A session with the same parameters exists (" (car session) "). " - "You can connect a sibling instead. Proceed? ")) - (let ((debug-on-quit nil)) - (signal 'quit nil))))) - params) - - -;;; Aliases - - ;;;###autoload -(defalias 'cider-jack-in #'cider-jack-in-clj) - ;;;###autoload -(defalias 'cider-jack-in-clojure #'cider-jack-in-clj) -;;;###autoload -(defalias 'cider-jack-in-clojurescript #'cider-jack-in-cljs) - -;;;###autoload -(defalias 'cider-connect #'cider-connect-clj) -;;;###autoload -(defalias 'cider-connect-clojure #'cider-connect-clj) -;;;###autoload -(defalias 'cider-connect-clojurescript #'cider-connect-cljs) - -;;;###autoload -(defalias 'cider-connect-sibling-clojure #'cider-connect-sibling-clj) -;;;###autoload -(defalias 'cider-connect-sibling-clojurescript #'cider-connect-sibling-cljs) - - -;;; Helpers - -(defun cider-current-host () - "Retrieve the current host." - (or (when (stringp buffer-file-name) - (file-remote-p buffer-file-name 'host)) - "localhost")) - -(defun cider-select-endpoint () - "Interactively select the host and port to connect to." - (dolist (endpoint cider-known-endpoints) - (unless (stringp (or (nth 2 endpoint) - (nth 1 endpoint))) - (user-error "The port for %s in `cider-known-endpoints' should be a string" - (nth 0 endpoint)))) - (let* ((ssh-hosts (cider--ssh-hosts)) - (hosts (seq-uniq (append (when cider-host-history - ;; history elements are strings of the form "host:port" - (list (split-string (car cider-host-history) ":"))) - (list (list (cider-current-host))) - cider-known-endpoints - ssh-hosts - ;; always add localhost - '(("localhost"))))) - (sel-host (cider--completing-read-host hosts)) - (host (car sel-host)) - (port (or (cadr sel-host) - (cider--completing-read-port host (cider--infer-ports host ssh-hosts))))) - (cons host port))) - -(defun cider--ssh-hosts () - "Retrieve all ssh host from local configuration files." - (seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s))) - ;; `tramp-completion-mode' is obsoleted in 26 - (cl-progv (if (version< emacs-version "26") - '(tramp-completion-mode) - '(non-essential)) '(t) - (tramp-completion-handle-file-name-all-completions "" "/ssh:")))) - -(defun cider--completing-read-host (hosts) - "Interactively select host from HOSTS. -Each element in HOSTS is one of: (host), (host port) or (label host port). -Return a list of the form (HOST PORT), where PORT can be nil." - (let* ((hosts (cider-join-into-alist hosts)) - (sel-host (completing-read "Host: " hosts nil nil nil - 'cider-host-history (caar hosts))) - (host (or (cdr (assoc sel-host hosts)) (list sel-host)))) - ;; remove the label - (if (= 3 (length host)) (cdr host) host))) - -(defun cider--tramp-file-name (vec) - "A simple compatibility wrapper around `make-tramp-file-name'. -Tramp version starting 26.1 is using a `cl-defstruct' rather than vanilla VEC." - (if (version< emacs-version "26.1") - vec - (with-no-warnings - (make-tramp-file-name :method (elt vec 0) - :host (elt vec 2))))) - -(defun cider--infer-ports (host ssh-hosts) - "Infer nREPL ports on HOST. -Return a list of elements of the form (directory port). SSH-HOSTS is a list -of remote SSH hosts." - (let ((localp (or (nrepl-local-host-p host) - (not (assoc-string host ssh-hosts))))) - (if localp - ;; change dir: current file might be remote - (let* ((change-dir-p (file-remote-p default-directory)) - (default-directory (if change-dir-p "~/" default-directory))) - (cider-locate-running-nrepl-ports (unless change-dir-p default-directory))) - (let ((vec (vector "sshx" nil host "" nil)) - ;; change dir: user might want to connect to a different remote - (dir (when (file-remote-p default-directory) - (with-parsed-tramp-file-name default-directory cur - (when (string= cur-host host) default-directory))))) - (tramp-maybe-open-connection (cider--tramp-file-name vec)) - (with-current-buffer (tramp-get-connection-buffer (cider--tramp-file-name vec)) - (cider-locate-running-nrepl-ports dir)))))) - -(defun cider--completing-read-port (host ports) - "Interactively select port for HOST from PORTS." - (let* ((ports (cider-join-into-alist ports)) - (sel-port (completing-read (format "Port for %s: " host) ports - nil nil nil nil (caar ports))) - (port (or (cdr (assoc sel-port ports)) sel-port)) - (port (if (listp port) (cadr port) port))) - (if (stringp port) (string-to-number port) port))) - -(defun cider-locate-running-nrepl-ports (&optional dir) - "Locate ports of running nREPL servers. -When DIR is non-nil also look for nREPL port files in DIR. Return a list -of list of the form (project-dir port)." - (let* ((paths (cider--running-nrepl-paths)) - (proj-ports (mapcar (lambda (d) - (when-let* ((port (and d (nrepl-extract-port (cider--file-path d))))) - (list (file-name-nondirectory (directory-file-name d)) port))) - (cons (clojure-project-dir dir) paths)))) - (seq-uniq (delq nil proj-ports)))) - -(defun cider--running-nrepl-paths () - "Retrieve project paths of running nREPL servers. -Use `cider-ps-running-nrepls-command' and `cider-ps-running-nrepl-path-regexp-list'." - (let (paths) - (with-temp-buffer - (insert (shell-command-to-string cider-ps-running-nrepls-command)) - (dolist (regexp cider-ps-running-nrepl-path-regexp-list) - (goto-char 1) - (while (re-search-forward regexp nil t) - (setq paths (cons (match-string 1) paths))))) - (seq-uniq paths))) - -(defun cider--identify-buildtools-present (&optional project-dir) - "Identify build systems present by their build files in PROJECT-DIR. -PROJECT-DIR defaults to current project." - (let* ((default-directory (or project-dir (clojure-project-dir (cider-current-dir)))) - (build-files '((lein . "project.clj") - (boot . "build.boot") - (clojure-cli . "deps.edn") - (shadow-cljs . "shadow-cljs.edn") - (gradle . "build.gradle")))) - (delq nil - (mapcar (lambda (candidate) - (when (file-exists-p (cdr candidate)) - (car candidate))) - build-files)))) - -(defun cider-project-type (&optional project-dir) - "Determine the type of the project in PROJECT-DIR. -When multiple project file markers are present, check for a preferred build -tool in `cider-preferred-build-tool', otherwise prompt the user to choose. -PROJECT-DIR defaults to the current project." - (let* ((choices (cider--identify-buildtools-present project-dir)) - (multiple-project-choices (> (length choices) 1)) - ;; this needs to be a string to be used in `completing-read' - (default (symbol-name (car choices))) - ;; `cider-preferred-build-tool' used to be a string prior to CIDER - ;; 0.18, therefore the need for `cider-maybe-intern' - (preferred-build-tool (cider-maybe-intern cider-preferred-build-tool))) - (cond ((and multiple-project-choices - (member preferred-build-tool choices)) - preferred-build-tool) - (multiple-project-choices - (intern - (completing-read - (format "Which command should be used (default %s): " default) - choices nil t nil nil default))) - (choices - (car choices)) - ;; TODO: Move this fallback outside the project-type check - ;; if we're outside a project we fallback to whatever tool - ;; is specified in `cider-jack-in-default' (normally clojure-cli) - ;; `cider-jack-in-default' used to be a string prior to CIDER - ;; 0.18, therefore the need for `cider-maybe-intern' - (t (cider-maybe-intern cider-jack-in-default))))) - - -;; TODO: Implement a check for command presence over tramp -(defun cider--resolve-command (command) - "Find COMMAND in exec path (see variable `exec-path'). -Return nil if not found. In case `default-directory' is non-local we -assume the command is available." - (when-let* ((command (or (and (file-remote-p default-directory) command) - (executable-find command) - (executable-find (concat command ".bat"))))) - (shell-quote-argument command))) - -;;;###autoload -(with-eval-after-load 'clojure-mode - (define-key clojure-mode-map (kbd "C-c M-x") #'cider) - (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) - (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) - (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) - (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) - (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) - (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) - (require 'sesman) - (sesman-install-menu clojure-mode-map) - (add-hook 'clojure-mode-hook (lambda () (setq-local sesman-system 'CIDER)))) - -(provide 'cider) - -;;; cider.el ends here diff --git a/elpa/cider-20181110.1413/nrepl-client.el b/elpa/cider-20181110.1413/nrepl-client.el deleted file mode 100644 index b250f74a..00000000 --- a/elpa/cider-20181110.1413/nrepl-client.el +++ /dev/null @@ -1,1348 +0,0 @@ -;;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell -;; Reid McKenzie -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . -;; -;; This file is not part of GNU Emacs. -;; -;;; Commentary: -;; -;; Provides an Emacs Lisp client to connect to Clojure nREPL servers. -;; -;; A connection is an abstract idea of the communication between Emacs (client) -;; and nREPL server. On the Emacs side connections are represented by two -;; running processes. The two processes are the server process and client -;; process (the connection to the server). Each of these is represented by its -;; own process buffer, filter and sentinel. -;; -;; The nREPL communication process can be broadly represented as follows: -;; -;; 1) The server process is started as an Emacs subprocess (usually by -;; `cider-jack-in', which in turn fires up leiningen or boot). Note that -;; if a connection was established using `cider-connect' there won't be -;; a server process. -;; -;; 2) The server's process filter (`nrepl-server-filter') detects the -;; connection port from the first plain text response from the server and -;; starts a communication process (socket connection) as another Emacs -;; subprocess. This is the nREPL client process (`nrepl-client-filter'). -;; All requests and responses handling happens through this client -;; connection. -;; -;; 3) Requests are sent by `nrepl-send-request' and -;; `nrepl-send-sync-request'. A request is simply a list containing a -;; requested operation name and the parameters required by the -;; operation. Each request has an associated callback that is called once -;; the response for the request has arrived. Besides the above functions -;; there are specialized request senders for each type of common -;; operations. Examples are `nrepl-request:eval', `nrepl-request:clone', -;; `nrepl-sync-request:describe'. -;; -;; 4) Responses from the server are decoded in `nrepl-client-filter' and are -;; physically represented by alists whose structure depends on the type of -;; the response. After having been decoded, the data from the response is -;; passed over to the callback that was registered by the original -;; request. -;; -;; Please see the comments in dedicated sections of this file for more detailed -;; description. - -;;; Code: -(require 'seq) -(require '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))) - (sesman-remove-object 'CIDER nil client-buffer - (not (process-get process :keep-server)) - 'no-error) - (nrepl--clear-client-sessions client-buffer) - (with-current-buffer client-buffer - (goto-char (point-max)) - (insert-before-markers - (propertize - (format "\n*** Closed on %s ***\n" (current-time-string)) - 'face 'cider-repl-stderr-face)) - (run-hooks 'nrepl-disconnected-hook) - (let ((server-buffer nrepl-server-buffer)) - (when (and (buffer-live-p server-buffer) - (not (process-get process :keep-server))) - (setq nrepl-server-buffer nil) - (nrepl--maybe-kill-server-buffer server-buffer))))))) - - -;;; Network - -(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))) - -(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 "") #'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/elpa/cider-20181110.1413/nrepl-dict.el b/elpa/cider-20181110.1413/nrepl-dict.el deleted file mode 100644 index be143860..00000000 --- a/elpa/cider-20181110.1413/nrepl-dict.el +++ /dev/null @@ -1,187 +0,0 @@ -;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Artur Malabarba -;; Hugo Duncan -;; Steve Purcell -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . -;; -;; This file is not part of GNU Emacs. -;; -;;; Commentary: -;; -;; Provides functions to interact with and create `nrepl-dict's. These are -;; simply plists with an extra element at the head. - -;;; Code: -(require 'cl-lib) - - -(defun nrepl-dict (&rest key-vals) - "Create nREPL dict from KEY-VALS." - (cons 'dict key-vals)) - -(defun nrepl-dict-p (object) - "Return t if OBJECT is an nREPL dict." - (and (listp object) - (eq (car object) 'dict))) - -(defun nrepl-dict-empty-p (dict) - "Return t if nREPL dict DICT is empty." - (null (cdr dict))) - -(defun nrepl-dict-contains (dict key) - "Return nil if nREPL dict DICT doesn't contain KEY. -If DICT does contain KEY, then a non-nil value is returned. Due to the -current implementation, this return value is the tail of DICT's key-list -whose car is KEY. Comparison is done with `equal'." - (member key (nrepl-dict-keys dict))) - -(defun nrepl-dict-get (dict key &optional default) - "Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT. -If dict is nil, return nil. If DEFAULT not provided, and KEY not in DICT, -return nil. If DICT is not an nREPL dict object, an error is thrown." - (when dict - (if (nrepl-dict-p dict) - (if (nrepl-dict-contains dict key) - (lax-plist-get (cdr dict) key) - default) - (error "Not an nREPL dict object: %s" dict)))) - -(defun nrepl-dict-put (dict key value) - "Associate in DICT, KEY to VALUE. -Return new dict. Dict is modified by side effects." - (if (null dict) - `(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/elpa/cider-20190121.1852/cider-apropos.el b/elpa/cider-20190121.1852/cider-apropos.el new file mode 100644 index 00000000..6c0ca5d6 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-apropos.el @@ -0,0 +1,208 @@ +;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- + +;; Copyright © 2014-2019 Jeff Valk, Bozhidar Batsov and CIDER contributors +;; +;; Author: Jeff Valk + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Apropos functionality for Clojure. + +;;; Code: + +(require 'cider-doc) +(require 'cider-util) +(require '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 nil t)." + (interactive) + (cider-ensure-connected) + (cider-ensure-op-supported "apropos") + (cider-apropos (read-string "Search for Clojure documentation (a regular expression): ") nil t)) + +(defun cider-apropos-act-on-symbol (symbol) + "Apply selected action on SYMBOL." + (let* ((first-action-key (car (car cider-apropos-actions))) + (action-key (if (= 1 (length cider-apropos-actions)) + first-action-key + (completing-read (format "Choose action to apply to `%s` (default %s): " + symbol first-action-key) + cider-apropos-actions nil nil nil nil first-action-key))) + (action-fn (cdr (assoc action-key cider-apropos-actions)))) + (if action-fn + (funcall action-fn symbol) + (user-error "Unknown action `%s`" action-key)))) + +;;;###autoload +(defun cider-apropos-select (query &optional ns docs-p privates-p case-sensitive-p) + "Similar to `cider-apropos', but presents the results in a completing read. +Show all symbols whose names match QUERY, a regular expression. +QUERY can also be a list of space-separated words (e.g. take while) which +will be converted to a regular expression (like take.+while) automatically +behind the scenes. The search may be limited to the namespace NS, and may +optionally search doc strings (based on DOCS-P), include private vars +\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P)." + (interactive + (cons (read-string "Search for Clojure symbol (a regular expression): ") + (when current-prefix-arg + (list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list)))) + (if (string= ns "") nil ns)) + (y-or-n-p "Search doc strings? ") + (y-or-n-p "Include private symbols? ") + (y-or-n-p "Case-sensitive? "))))) + (cider-ensure-connected) + (cider-ensure-op-supported "apropos") + (if-let* ((summary (cider-apropos-summary + query ns docs-p privates-p case-sensitive-p)) + (results (mapcar (lambda (r) (nrepl-dict-get r "name")) + (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))) + (cider-apropos-act-on-symbol (completing-read (concat summary ": ") results)) + (message "No apropos matches for %S" query))) + +;;;###autoload +(defun cider-apropos-documentation-select () + "Shortcut for (cider-apropos-select nil t)." + (interactive) + (cider-ensure-connected) + (cider-ensure-op-supported "apropos") + (cider-apropos-select (read-string "Search for Clojure documentation (a regular expression): ") nil t)) + +(provide 'cider-apropos) + +;;; cider-apropos.el ends here diff --git a/elpa/cider-20190121.1852/cider-autoloads.el b/elpa/cider-20190121.1852/cider-autoloads.el new file mode 100644 index 00000000..56c25811 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-autoloads.el @@ -0,0 +1,772 @@ +;;; cider-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "cider" "cider.el" (0 0 0 0)) +;;; Generated autoloads from cider.el + +(autoload 'cider-version "cider" "\ +Display CIDER's version. + +\(fn)" t nil) + (autoload 'cider-start-map "cider" "CIDER jack-in and connect keymap." t 'keymap) + +(autoload 'cider-jack-in-clj "cider" "\ +Start an nREPL server for the current project and connect to it. +PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. +With the prefix argument, prompt for all these parameters. + +\(fn PARAMS)" t nil) + +(autoload 'cider-jack-in-cljs "cider" "\ +Start an nREPL server for the current project and connect to it. +PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and +:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, +prompt for all these parameters. + +\(fn PARAMS)" t nil) + +(autoload 'cider-jack-in-clj&cljs "cider" "\ +Start an nREPL server and connect with clj and cljs REPLs. +PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and +:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, +prompt for all these parameters. When SOFT-CLJS-START is non-nil, start +cljs REPL only when the ClojureScript dependencies are met. + +\(fn &optional PARAMS SOFT-CLJS-START)" t nil) + +(autoload 'cider-connect-sibling-clj "cider" "\ +Create a Clojure REPL with the same server as OTHER-REPL. +PARAMS is for consistency with other connection commands and is currently +ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can +also be a server buffer, in which case a new session with a REPL for that +server is created. + +\(fn PARAMS &optional OTHER-REPL)" t nil) + +(autoload 'cider-connect-sibling-cljs "cider" "\ +Create a ClojureScript REPL with the same server as OTHER-REPL. +PARAMS is a plist optionally containing :cljs-repl-type (e.g. Node, +Figwheel, etc). All other parameters are inferred from the OTHER-REPL. +OTHER-REPL defaults to `cider-current-repl' but in programs can also be a +server buffer, in which case a new session for that server is created. + +\(fn PARAMS &optional OTHER-REPL)" t nil) + +(autoload 'cider-connect-clj "cider" "\ +Initialize a Clojure connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port and :project-dir. On +prefix argument, prompt for all the parameters. + +\(fn &optional PARAMS)" t nil) + +(autoload 'cider-connect-cljs "cider" "\ +Initialize a ClojureScript connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port, :project-dir and +:cljs-repl-type (e.g. Node, Figwheel, etc). On prefix, prompt for all the +parameters regardless of their supplied or default values. + +\(fn &optional PARAMS)" t nil) + +(autoload 'cider-connect-clj&cljs "cider" "\ +Initialize a Clojure and ClojureScript connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port, :project-dir and +:cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is +non-nil, don't start if ClojureScript requirements are not met. + +\(fn PARAMS &optional SOFT-CLJS-START)" t nil) + +(autoload 'cider "cider" "\ +Start a connection of any type interactively. + +\(fn)" t nil) + +(defalias 'cider-jack-in #'cider-jack-in-clj) + +(defalias 'cider-jack-in-clojure #'cider-jack-in-clj) + +(defalias 'cider-jack-in-clojurescript #'cider-jack-in-cljs) + +(defalias 'cider-connect #'cider-connect-clj) + +(defalias 'cider-connect-clojure #'cider-connect-clj) + +(defalias 'cider-connect-clojurescript #'cider-connect-cljs) + +(defalias 'cider-connect-sibling-clojure #'cider-connect-sibling-clj) + +(defalias 'cider-connect-sibling-clojurescript #'cider-connect-sibling-cljs) + +(with-eval-after-load 'clojure-mode (define-key clojure-mode-map (kbd "C-c M-x") #'cider) (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) (require 'sesman) (sesman-install-menu clojure-mode-map) (add-hook 'clojure-mode-hook (lambda nil (setq-local sesman-system 'CIDER)))) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-apropos" "cider-apropos.el" (0 0 0 0)) +;;; Generated autoloads from cider-apropos.el + +(autoload 'cider-apropos "cider-apropos" "\ +Show all symbols whose names match QUERY, a regular expression. +QUERY can also be a list of space-separated words (e.g. take while) which +will be converted to a regular expression (like take.+while) automatically +behind the scenes. The search may be limited to the namespace NS, and may +optionally search doc strings (based on DOCS-P), include private vars +\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). + +\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) + +(autoload 'cider-apropos-documentation "cider-apropos" "\ +Shortcut for (cider-apropos nil t). + +\(fn)" t nil) + +(autoload 'cider-apropos-select "cider-apropos" "\ +Similar to `cider-apropos', but presents the results in a completing read. +Show all symbols whose names match QUERY, a regular expression. +QUERY can also be a list of space-separated words (e.g. take while) which +will be converted to a regular expression (like take.+while) automatically +behind the scenes. The search may be limited to the namespace NS, and may +optionally search doc strings (based on DOCS-P), include private vars +\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). + +\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) + +(autoload 'cider-apropos-documentation-select "cider-apropos" "\ +Shortcut for (cider-apropos-select nil t). + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-apropos" '("cider-" "apropos-special-form"))) + +;;;*** + +;;;### (autoloads nil "cider-browse-ns" "cider-browse-ns.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cider-browse-ns.el + +(autoload 'cider-browse-ns "cider-browse-ns" "\ +List all NAMESPACE's vars in BUFFER. + +\(fn NAMESPACE)" t nil) + +(autoload 'cider-browse-ns-all "cider-browse-ns" "\ +List all loaded namespaces in BUFFER. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-browse-ns" '("cider-browse-ns-"))) + +;;;*** + +;;;### (autoloads nil "cider-browse-spec" "cider-browse-spec.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cider-browse-spec.el + +(autoload 'cider-browse-spec "cider-browse-spec" "\ +Browse SPEC definition. + +\(fn SPEC)" t nil) + +(autoload 'cider-browse-spec-all "cider-browse-spec" "\ +Open list of specs in a popup buffer. + +With a prefix argument ARG, prompts for a regexp to filter specs. +No filter applied if the regexp is the empty string. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-browse-spec" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-cheatsheet" "cider-cheatsheet.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cider-cheatsheet.el + +(autoload 'cider-cheatsheet "cider-cheatsheet" "\ +Navigate `cider-cheatsheet-hierarchy' with `completing-read'. + +When you make it to a Clojure var its doc buffer gets displayed. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-cheatsheet" '("cider-cheatsheet-"))) + +;;;*** + +;;;### (autoloads nil "cider-classpath" "cider-classpath.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cider-classpath.el + +(autoload 'cider-classpath "cider-classpath" "\ +List all classpath entries. + +\(fn)" t nil) + +(autoload 'cider-open-classpath-entry "cider-classpath" "\ +Open a classpath entry. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-classpath" '("cider-classpath-"))) + +;;;*** + +;;;### (autoloads nil "cider-client" "cider-client.el" (0 0 0 0)) +;;; Generated autoloads from cider-client.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-client" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-common" "cider-common.el" (0 0 0 0)) +;;; Generated autoloads from cider-common.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-common" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-completion" "cider-completion.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cider-completion.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-completion" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-connection" "cider-connection.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cider-connection.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-connection" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-debug" "cider-debug.el" (0 0 0 0)) +;;; Generated autoloads from cider-debug.el + +(autoload 'cider-debug-defun-at-point "cider-debug" "\ +Instrument the \"top-level\" expression at point. +If it is a defn, dispatch the instrumented definition. Otherwise, +immediately evaluate the instrumented expression. + +While debugged code is being evaluated, the user is taken through the +source code and displayed the value of various expressions. At each step, +a number of keys will be prompted to the user. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-debug" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-doc" "cider-doc.el" (0 0 0 0)) +;;; Generated autoloads from cider-doc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-doc" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-eldoc" "cider-eldoc.el" (0 0 0 0)) +;;; Generated autoloads from cider-eldoc.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-eldoc" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-eval" "cider-eval.el" (0 0 0 0)) +;;; Generated autoloads from cider-eval.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-eval" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-find" "cider-find.el" (0 0 0 0)) +;;; Generated autoloads from cider-find.el + +(autoload 'cider-find-var "cider-find" "\ +Find definition for VAR at LINE. +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point. + +\(fn &optional ARG VAR LINE)" t nil) + +(autoload 'cider-find-dwim-at-mouse "cider-find" "\ +Find and display variable or resource at mouse EVENT. + +\(fn EVENT)" t nil) + +(autoload 'cider-find-dwim "cider-find" "\ +Find and display the SYMBOL-FILE at point. +SYMBOL-FILE could be a var or a resource. If thing at point is empty then +show dired on project. If var is not found, try to jump to resource of the +same name. When called interactively, a prompt is given according to the +variable `cider-prompt-for-symbol'. A single or double prefix argument +inverts the meaning. A prefix of `-' or a double prefix argument causes +the results to be displayed in a different window. A default value of thing +at point is given when prompted. + +\(fn SYMBOL-FILE)" t nil) + +(autoload 'cider-find-resource "cider-find" "\ +Find the resource at PATH. +Prompt for input as indicated by the variable `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix +argument causes the results to be displayed in other window. The default +value is thing at point. + +\(fn PATH)" t nil) + +(autoload 'cider-find-ns "cider-find" "\ +Find the file containing NS. +A prefix ARG of `-` or a double prefix argument causes +the results to be displayed in a different window. + +\(fn &optional ARG NS)" t nil) + +(autoload 'cider-find-keyword "cider-find" "\ +Find the namespace of the keyword at point and its first occurrence there. + +For instance - if the keyword at point is \":cider.demo/keyword\", this command +would find the namespace \"cider.demo\" and afterwards find the first mention +of \"::keyword\" there. + +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-find" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-format" "cider-format.el" (0 0 0 0)) +;;; Generated autoloads from cider-format.el + +(autoload 'cider-format-region "cider-format" "\ +Format the Clojure code in the current region. +START and END represent the region's boundaries. + +\(fn START END)" t nil) + +(autoload 'cider-format-defun "cider-format" "\ +Format the code in the current defun. + +\(fn)" t nil) + +(autoload 'cider-format-buffer "cider-format" "\ +Format the Clojure code in the current buffer. + +\(fn)" t nil) + +(autoload 'cider-format-edn-buffer "cider-format" "\ +Format the EDN data in the current buffer. + +\(fn)" t nil) + +(autoload 'cider-format-edn-region "cider-format" "\ +Format the EDN data in the current region. +START and END represent the region's boundaries. + +\(fn START END)" t nil) + +(autoload 'cider-format-edn-last-sexp "cider-format" "\ +Format the EDN data of the last sexp. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-format" '("cider--format-"))) + +;;;*** + +;;;### (autoloads nil "cider-grimoire" "cider-grimoire.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cider-grimoire.el + +(autoload 'cider-grimoire-web "cider-grimoire" "\ +Open grimoire documentation in the default web browser. + +Prompts for the symbol to use, or uses the symbol at point, depending on +the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the +opposite of what that option dictates. + +\(fn &optional ARG)" t nil) + +(autoload 'cider-grimoire "cider-grimoire" "\ +Open grimoire documentation in a popup buffer. + +Prompts for the symbol to use, or uses the symbol at point, depending on +the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the +opposite of what that option dictates. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-grimoire" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-inspector" "cider-inspector.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from cider-inspector.el + +(autoload 'cider-inspect-last-sexp "cider-inspector" "\ +Inspect the result of the the expression preceding point. + +\(fn)" t nil) + +(autoload 'cider-inspect-defun-at-point "cider-inspector" "\ +Inspect the result of the \"top-level\" expression at point. + +\(fn)" t nil) + +(autoload 'cider-inspect-last-result "cider-inspector" "\ +Inspect the most recent eval result. + +\(fn)" t nil) + +(autoload 'cider-inspect "cider-inspector" "\ +Inspect the result of the preceding sexp. + +With a prefix argument ARG it inspects the result of the \"top-level\" form. +With a second prefix argument it prompts for an expression to eval and inspect. + +\(fn &optional ARG)" t nil) + +(autoload 'cider-inspect-expr "cider-inspector" "\ +Evaluate EXPR in NS and inspect its value. +Interactively, EXPR is read from the minibuffer, and NS the +current buffer's namespace. + +\(fn EXPR NS)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-inspector" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-macroexpansion" "cider-macroexpansion.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cider-macroexpansion.el + +(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\ +Invoke \\=`macroexpand-1\\=` on the expression preceding point. +If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of +\\=`macroexpand-1\\=`. + +\(fn &optional PREFIX)" t nil) + +(autoload 'cider-macroexpand-all "cider-macroexpansion" "\ +Invoke \\=`macroexpand-all\\=` on the expression preceding point. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-macroexpansion" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-mode" "cider-mode.el" (0 0 0 0)) +;;; Generated autoloads from cider-mode.el + +(defvar cider-mode-line '(:eval (format " cider[%s]" (cider--modeline-info))) "\ +Mode line lighter for cider mode. + +The value of this variable is a mode line template as in +`mode-line-format'. See Info Node `(elisp)Mode Line Format' for details +about mode line templates. + +Customize this variable to change how cider mode displays its status in the +mode line. The default value displays the current connection. Set this +variable to nil to disable the mode line entirely.") + +(custom-autoload 'cider-mode-line "cider-mode" t) + +(with-eval-after-load 'clojure-mode (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map "Menu for Clojure mode.\n This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." `("CIDER" :visible (not cider-mode) ["Start a Clojure REPL" cider-jack-in-clj :help "Starts an nREPL server and connects a Clojure REPL to it."] ["Connect to a Clojure REPL" cider-connect-clj :help "Connects to a REPL that's already running."] ["Start a ClojureScript REPL" cider-jack-in-cljs :help "Starts an nREPL server and connects a ClojureScript REPL to it."] ["Connect to a ClojureScript REPL" cider-connect-cljs :help "Connects to a ClojureScript REPL that's already running."] ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clj&cljs :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] "--" ["View manual online" cider-view-manual]))) + +(autoload 'cider-mode "cider-mode" "\ +Minor mode for REPL interaction from a Clojure buffer. + +\\{cider-mode-map} + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-mode" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-ns" "cider-ns.el" (0 0 0 0)) +;;; Generated autoloads from cider-ns.el + +(autoload 'cider-ns-reload "cider-ns" "\ +Send a (require 'ns :reload) to the REPL. + +With an argument PROMPT, it prompts for a namespace name. This is the +Clojure out of the box reloading experience and does not rely on +org.clojure/tools.namespace. See Commentary of this file for a longer list +of differences. From the Clojure doc: \":reload forces loading of all the +identified libs even if they are already loaded\". + +\(fn &optional PROMPT)" t nil) + +(autoload 'cider-ns-reload-all "cider-ns" "\ +Send a (require 'ns :reload-all) to the REPL. + +With an argument PROMPT, it prompts for a namespace name. This is the +Clojure out of the box reloading experience and does not rely on +org.clojure/tools.namespace. See Commentary of this file for a longer list +of differences. From the Clojure doc: \":reload-all implies :reload and +also forces loading of all libs that the identified libs directly or +indirectly load via require\". + +\(fn &optional PROMPT)" t nil) + +(autoload 'cider-ns-refresh "cider-ns" "\ +Reload modified and unloaded namespaces on the classpath. + +With a single prefix argument, or if MODE is `refresh-all', reload all +namespaces on the classpath unconditionally. + +With a double prefix argument, or if MODE is `clear', clear the state of +the namespace tracker before reloading. This is useful for recovering from +some classes of error (for example, those caused by circular dependencies) +that a normal reload would not otherwise recover from. The trade-off of +clearing is that stale code from any deleted files may not be completely +unloaded. + +With a negative prefix argument, or if MODE is `inhibit-fns', prevent any +refresh functions (defined in `cider-ns-refresh-before-fn' and +`cider-ns-refresh-after-fn') from being invoked. + +\(fn &optional MODE)" t nil) + +(define-obsolete-function-alias 'cider-refresh 'cider-ns-refresh "0.18") + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-ns" '("cider-ns-"))) + +;;;*** + +;;;### (autoloads nil "cider-overlays" "cider-overlays.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cider-overlays.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-overlays" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-popup" "cider-popup.el" (0 0 0 0)) +;;; Generated autoloads from cider-popup.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-popup" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-profile" "cider-profile.el" (0 0 0 0)) +;;; Generated autoloads from cider-profile.el + +(autoload 'cider-profile-samples "cider-profile" "\ +Displays current max-sample-count. +If optional QUERY is specified, set max-sample-count and display new value. + +\(fn &optional QUERY)" t nil) + +(autoload 'cider-profile-var-profiled-p "cider-profile" "\ +Displays the profiling status of var under point. +Prompts for var if none under point or QUERY is present. + +\(fn QUERY)" t nil) + +(autoload 'cider-profile-ns-toggle "cider-profile" "\ +Toggle profiling for the ns associated with optional QUERY. + +If optional argument QUERY is non-nil, prompt for ns. Otherwise use +current ns. + +\(fn &optional QUERY)" t nil) + +(autoload 'cider-profile-toggle "cider-profile" "\ +Toggle profiling for the given QUERY. +Defaults to the symbol at point. +With prefix arg or no symbol at point, prompts for a var. + +\(fn QUERY)" t nil) + +(autoload 'cider-profile-summary "cider-profile" "\ +Display a summary of currently collected profile data. + +\(fn)" t nil) + +(autoload 'cider-profile-var-summary "cider-profile" "\ +Display profile data for var under point QUERY. +Defaults to the symbol at point. With prefix arg or no symbol at point, +prompts for a var. + +\(fn QUERY)" t nil) + +(autoload 'cider-profile-clear "cider-profile" "\ +Clear any collected profile data. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-profile" '("cider-profile-"))) + +;;;*** + +;;;### (autoloads nil "cider-repl" "cider-repl.el" (0 0 0 0)) +;;; Generated autoloads from cider-repl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-repl" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-repl-history" "cider-repl-history.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from cider-repl-history.el + +(autoload 'cider-repl-history "cider-repl-history" "\ +Display items in the CIDER command history in another buffer. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-repl-history" '("cider-repl-history-"))) + +;;;*** + +;;;### (autoloads nil "cider-resolve" "cider-resolve.el" (0 0 0 0)) +;;; Generated autoloads from cider-resolve.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-resolve" '("cider-resolve-"))) + +;;;*** + +;;;### (autoloads nil "cider-scratch" "cider-scratch.el" (0 0 0 0)) +;;; Generated autoloads from cider-scratch.el + +(autoload 'cider-scratch "cider-scratch" "\ +Go to the scratch buffer named `cider-scratch-buffer-name'. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-scratch" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-selector" "cider-selector.el" (0 0 0 +;;;;;; 0)) +;;; Generated autoloads from cider-selector.el + +(autoload 'cider-selector "cider-selector" "\ +Select a new buffer by type, indicated by a single character. +The user is prompted for a single character indicating the method by +which to choose a new buffer. The `?' character describes then +available methods. OTHER-WINDOW provides an optional target. +See `def-cider-selector-method' for defining new methods. + +\(fn &optional OTHER-WINDOW)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-selector" '("??" "?c" "?e" "?q" "?r" "?m" "?x" "?p" "?d" "?s" "def-cider-selector-method" "cider-selector-"))) + +;;;*** + +;;;### (autoloads nil "cider-stacktrace" "cider-stacktrace.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from cider-stacktrace.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-stacktrace" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-test" "cider-test.el" (0 0 0 0)) +;;; Generated autoloads from cider-test.el + +(defvar cider-auto-test-mode nil "\ +Non-nil if Cider-Auto-Test mode is enabled. +See the `cider-auto-test-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `cider-auto-test-mode'.") + +(custom-autoload 'cider-auto-test-mode "cider-test" nil) + +(autoload 'cider-auto-test-mode "cider-test" "\ +Toggle automatic testing of Clojure files. + +When enabled this reruns tests every time a Clojure file is loaded. +Only runs tests corresponding to the loaded file's namespace and does +nothing if no tests are defined or if the file failed to load. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-test" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-tracing" "cider-tracing.el" (0 0 0 0)) +;;; Generated autoloads from cider-tracing.el + +(autoload 'cider-toggle-trace-var "cider-tracing" "\ +Toggle var tracing. +Prompts for the symbol to use, or uses the symbol at point, depending on +the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the +opposite of what that option dictates. + +\(fn ARG)" t nil) + +(autoload 'cider-toggle-trace-ns "cider-tracing" "\ +Toggle ns tracing. +Defaults to the current ns. With prefix arg QUERY, prompts for a ns. + +\(fn QUERY)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-tracing" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "cider-util" "cider-util.el" (0 0 0 0)) +;;; Generated autoloads from cider-util.el + +(autoload 'cider-view-manual "cider-util" "\ +View the manual in your default browser. + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cider-util" '("cider-"))) + +;;;*** + +;;;### (autoloads nil "nrepl-client" "nrepl-client.el" (0 0 0 0)) +;;; Generated autoloads from nrepl-client.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nrepl-client" '("nrepl-" "cider-enlighten-mode"))) + +;;;*** + +;;;### (autoloads nil "nrepl-dict" "nrepl-dict.el" (0 0 0 0)) +;;; Generated autoloads from nrepl-dict.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "nrepl-dict" '("nrepl-"))) + +;;;*** + +;;;### (autoloads nil nil ("cider-compat.el" "cider-pkg.el") (0 0 +;;;;;; 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; cider-autoloads.el ends here diff --git a/elpa/cider-20190121.1852/cider-browse-ns.el b/elpa/cider-20190121.1852/cider-browse-ns.el new file mode 100644 index 00000000..8b983abd --- /dev/null +++ b/elpa/cider-20190121.1852/cider-browse-ns.el @@ -0,0 +1,232 @@ +;;; cider-browse-ns.el --- CIDER namespace browser + +;; Copyright © 2014-2019 John Andrews, Bozhidar Batsov and CIDER contributors + +;; Author: John Andrews + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; M-x cider-browse-ns +;; +;; Display a list of all vars in a namespace. +;; Pressing will take you to the cider-doc buffer for that var. +;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode'). + +;; M-x cider-browse-ns-all +;; +;; Explore Clojure namespaces by browsing a list of all namespaces. +;; Pressing expands into a list of that namespace's vars as if by +;; executing the command (cider-browse-ns "my.ns"). + +;;; Code: + +(require 'cider-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/elpa/cider-20190121.1852/cider-browse-spec.el b/elpa/cider-20190121.1852/cider-browse-spec.el new file mode 100644 index 00000000..d58352b1 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-browse-spec.el @@ -0,0 +1,357 @@ +;;; cider-browse-spec.el --- CIDER spec browser + +;; Copyright © 2017 Juan Monetta, Bozhidar Batsov and CIDER contributors + +;; Author: Juan Monetta + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; M-x cider-browse-spec +;; +;; Display a spec description you can browse. +;; Pressing over a sub spec will take you to the description of that sub spec. +;; Pressing ^ takes you to the list of all specs. + +;; M-x cider-browse-spec-all +;; +;; Explore clojure.spec registry by browsing a list of all specs. +;; Pressing over a spec display the spec description you can browse. + +;;; Code: + +(require 'cider-client) +(require 'cider-compat) +(require 'cider-util) +(require 'cl-lib) +(require 'nrepl-dict) +(require 'seq) +(require 'subr-x) +(require 'help-mode) + +;; The buffer names used by the spec browser +(defconst cider-browse-spec-buffer "*cider-spec-browser*") +(defconst cider-browse-spec-example-buffer "*cider-spec-example*") + +;; Mode Definition + +(defvar cider-browse-spec-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (make-composed-keymap button-buffer-map + cider-popup-buffer-mode-map)) + (define-key map (kbd "RET") #'cider-browse-spec--browse-at) + (define-key map "n" #'forward-button) + (define-key map "p" #'backward-button) + map) + "Keymap for `cider-browse-spec-mode'.") + +(define-derived-mode cider-browse-spec-mode special-mode "Specs" + "Major mode for browsing Clojure specs. + +\\{cider-browse-spec-mode-map}" + (setq-local electric-indent-chars nil) + (setq-local sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (setq-local truncate-lines t))) + +(defvar cider-browse-spec--current-spec nil) + +(defvar cider-browse-spec-view-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map help-mode-map) + (define-key map (kbd "RET") #'cider-browse-spec--browse-at) + (define-key map "^" #'cider-browse-spec-all) + (define-key map "e" #'cider-browse-spec--print-curr-spec-example) + (define-key map "n" #'forward-button) + (define-key map "p" #'backward-button) + map) + "Keymap for `cider-browse-spec-view-mode'.") + +(define-derived-mode cider-browse-spec-view-mode help-mode "Spec" + "Major mode for displaying CIDER spec. + +\\{cider-browse-spec-view-mode-map}" + (setq-local cider-browse-spec--current-spec nil) + (setq-local electric-indent-chars nil) + (setq-local sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (setq-local truncate-lines t))) + +(defvar cider-browse-spec-example-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map cider-popup-buffer-mode-map) + (define-key map "^" #'cider-browse-spec-all) + (define-key map "e" #'cider-browse-spec--print-curr-spec-example) + (define-key map "g" #'revert-buffer) + map) + "Keymap for `cider-browse-spec-example-mode'.") + +(define-derived-mode cider-browse-spec-example-mode special-mode "Example" + "Major mode for Clojure spec examples. + +\\{cider-browse-spec-example-mode-map}" + (setq-local electric-indent-chars nil) + (setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function) + (setq-local sesman-system 'CIDER) + (when cider-special-mode-truncate-lines + (setq-local truncate-lines t))) + +;; Non interactive functions + +(define-button-type 'cider-browse-spec--spec + 'action #'cider-browse-spec--browse-at + 'face nil + 'follow-link t + 'help-echo "View spec") + +(defun cider-browse-spec--draw-list-buffer (buffer title specs) + "Reset contents of BUFFER. +Display TITLE at the top and SPECS are indented underneath." + (with-current-buffer buffer + (cider-browse-spec-mode) + (let ((inhibit-read-only t)) + (erase-buffer) + (goto-char (point-max)) + (insert (cider-propertize title 'emph) "\n") + (dolist (spec-name specs) + (insert (propertize " " 'spec-name spec-name)) + (thread-first (cider-font-lock-as-clojure spec-name) + (insert-text-button 'type 'cider-browse-spec--spec) + (button-put 'spec-name spec-name)) + (insert (propertize "\n" 'spec-name spec-name))) + (goto-char (point-min))))) + +(defun cider--qualified-keyword-p (str) + "Return non nil if STR is a namespaced keyword." + (string-match-p "^:.+/.+$" str)) + +(defun cider--spec-fn-p (value fn-name) + "Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME." + (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\)/" fn-name "$") value)) + +(defun cider-browse-spec--pprint (form) + "Given a spec FORM builds a multi line string with a pretty render of that FORM." + (cond ((stringp form) + (if (cider--qualified-keyword-p form) + (with-temp-buffer + (thread-first form + (insert-text-button 'type 'cider-browse-spec--spec) + (button-put 'spec-name form)) + (buffer-string)) + ;; to make it easier to read replace all clojure.spec ns with s/ + ;; and remove all clojure.core ns + (thread-last form + (replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\)/" "s/") + (replace-regexp-in-string "^\\(clojure.core\\)/" "")))) + + ((and (listp form) (stringp (cl-first form))) + (let ((form-tag (cl-first form))) + (cond + ;; prettier fns #() + ((string-equal form-tag "clojure.core/fn") + (if (equal (cl-second form) '("%")) + (format "#%s" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))) + (format "(fn [%%] %s)" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))))) + ;; prettier (s/and ) + ((cider--spec-fn-p form-tag "and") + (format "(s/and\n%s)" (string-join (thread-last (cl-rest form) + (mapcar #'cider-browse-spec--pprint) + (mapcar (lambda (x) (format "%s" x)))) + "\n"))) + ;; prettier (s/or ) + ((cider--spec-fn-p form-tag "or") + (let ((name-spec-pair (seq-partition (cl-rest form) 2))) + (format "(s/or\n%s)" (string-join + (thread-last name-spec-pair + (mapcar (lambda (s) (format "%s %s" (cl-first s) (cider-browse-spec--pprint (cl-second s)))))) + "\n")))) + ;; prettier (s/merge ) + ((cider--spec-fn-p form-tag "merge") + (format "(s/merge\n%s)" (string-join (thread-last (cl-rest form) + (mapcar #'cider-browse-spec--pprint) + (mapcar (lambda (x) (format "%s" x)))) + "\n"))) + ;; prettier (s/keys ) + ((cider--spec-fn-p form-tag "keys") + (let ((keys-args (seq-partition (cl-rest form) 2))) + (format "(s/keys%s)" (thread-last + keys-args + (mapcar (lambda (s) + (let ((key-type (cl-first s)) + (specs-vec (cl-second s))) + (concat "\n" key-type + " [" + (string-join (thread-last specs-vec + (mapcar #'cider-browse-spec--pprint) + (mapcar (lambda (x) (format "%s" x)))) + "\n") + "]")))) + (cl-reduce #'concat))))) + ;; prettier (s/multi-spec) + ((cider--spec-fn-p form-tag "multi-spec") + (let ((multi-method (cl-second form)) + (retag (cl-third form)) + (sub-specs (cl-rest (cl-rest (cl-rest form))))) + (format "(s/multi-spec %s %s\n%s)" + multi-method + retag + (string-join + (thread-last sub-specs + (mapcar (lambda (s) + (concat "\n\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) + "\n")))) + ;; prettier (s/cat ) + ((cider--spec-fn-p form-tag "cat") + (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) + (format "(s/cat %s)" + (thread-last name-spec-pairs + (mapcar (lambda (s) + (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) + (cl-reduce #'concat))))) + ;; prettier (s/alt ) + ((cider--spec-fn-p form-tag "alt") + (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) + (format "(s/alt %s)" + (thread-last name-spec-pairs + (mapcar (lambda (s) + (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) + (cl-reduce #'concat))))) + ;; prettier (s/fspec ) + ((cider--spec-fn-p form-tag "fspec") + (thread-last (seq-partition (cl-rest form) 2) + (cl-remove-if (lambda (s) (and (stringp (cl-second s)) + (string-empty-p (cl-second s))))) + (mapcar (lambda (s) + (format "\n%-11s: %s" (pcase (cl-first s) + (":args" "arguments") + (":ret" "returns") + (":fn" "invariants")) + (cider-browse-spec--pprint (cl-second s))))) + (cl-reduce #'concat) + (format "%s"))) + ;; every other with no special management + (t (format "(%s %s)" + (cider-browse-spec--pprint form-tag) + (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " ")))))) + (t (format "%s" form)))) + +(defun cider-browse-spec--pprint-indented (spec-form) + "Indent (pretty-print) and font-lock SPEC-FORM. +Return the result as a string." + (with-temp-buffer + (clojure-mode) + (insert (cider-browse-spec--pprint spec-form)) + (indent-region (point-min) (point-max)) + (cider--font-lock-ensure) + (buffer-string))) + +(defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form) + "Reset contents of BUFFER and draws everything needed to browse the SPEC-FORM. +Display SPEC as a title and uses `cider-browse-spec--pprint' to display +a more user friendly representation of SPEC-FORM." + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer) + (goto-char (point-max)) + (insert (cider-font-lock-as-clojure spec) "\n\n") + (insert (cider-browse-spec--pprint-indented spec-form)) + (cider--make-back-forward-xrefs) + (current-buffer)))) + +(defun cider-browse-spec--browse (spec) + "Browse SPEC." + (cider-ensure-connected) + (cider-ensure-op-supported "spec-form") + (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select #'cider-browse-spec-view-mode 'ancillary) + (setq-local cider-browse-spec--current-spec spec) + (cider-browse-spec--draw-spec-buffer (current-buffer) + spec + (cider-sync-request:spec-form spec)) + (goto-char (point-min)) + (current-buffer))) + +(defun cider-browse-spec--browse-at (&optional pos) + "View the definition of a spec. + +Optional argument POS is the position of a spec, defaulting to point. POS +may also be a button, so this function can be used a the button's `action' +property." + (interactive) + (let ((pos (or pos (point)))) + (when-let* ((spec (button-get pos 'spec-name))) + (cider-browse-spec--browse spec)))) + +;; Interactive Functions + +(defun cider-browse-spec--print-curr-spec-example () + "Generate and print an example of the current spec." + (interactive) + (cider-ensure-connected) + (cider-ensure-op-supported "spec-example") + (if-let* ((spec cider-browse-spec--current-spec)) + (if-let* ((example (cider-sync-request:spec-example spec))) + (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer 'select #'cider-browse-spec-example-mode 'ancillary) + (setq-local cider-browse-spec--current-spec spec) + (let ((inhibit-read-only t)) + (insert "Example of " (cider-font-lock-as-clojure spec)) + (insert "\n\n") + (insert (cider-font-lock-as-clojure example)) + (goto-char (point-min)))) + (error (format "No example for spec %s" spec))) + (error "No current spec"))) + +(defun cider-browse-spec--example-revert-buffer-function (&rest _) + "`revert-buffer' function for `cider-browse-spec-example-mode'. + +Generates a new example for the current spec." + (cider-browse-spec--print-curr-spec-example)) + +;;;###autoload +(defun cider-browse-spec (spec) + "Browse SPEC definition." + (interactive (list (completing-read "Browse spec: " + (cider-sync-request:spec-list) + nil nil + (cider-symbol-at-point)))) + (cider-browse-spec--browse spec)) + +(defun cider-browse-spec-regex (regex) + "Open the list of specs that matches REGEX in a popup buffer. +Displays all specs when REGEX is nil." + (cider-ensure-connected) + (cider-ensure-op-supported "spec-list") + (let ((filter-regex (or regex ""))) + (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select nil 'ancillary) + (let ((specs (cider-sync-request:spec-list filter-regex))) + (cider-browse-spec--draw-list-buffer (current-buffer) + (if (string-empty-p filter-regex) + "All specs in registry" + (format "All specs matching regex `%s' in registry" filter-regex)) + specs))))) + +;;;###autoload +(defun cider-browse-spec-all (&optional arg) + "Open list of specs in a popup buffer. + +With a prefix argument ARG, prompts for a regexp to filter specs. +No filter applied if the regexp is the empty string." + (interactive "P") + (cider-browse-spec-regex (if arg (read-string "Filter regex: ") ""))) + +(provide 'cider-browse-spec) + +;;; cider-browse-spec.el ends here diff --git a/elpa/cider-20190121.1852/cider-cheatsheet.el b/elpa/cider-20190121.1852/cider-cheatsheet.el new file mode 100644 index 00000000..20c61e71 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-cheatsheet.el @@ -0,0 +1,577 @@ +;;; cider-cheatsheet.el --- Quick reference for Clojure -*- lexical-binding: t -*- + +;; Copyright © 2019 Kris Jenkins, Bozhidar Batsov and CIDER contributors +;; +;; Author: Kris Jenkins + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A quick reference system for Clojure. Fast, searchable & available offline. + +;; Mostly taken from Kris Jenkins' `clojure-cheatsheet' +;; See: https://github.com/clojure-emacs/clojure-cheatsheet + +;;; Code: + +(require 'cider-doc) +(require 'seq) + +(defconst cider-cheatsheet-hierarchy + '(("Primitives" + ("Numbers" + ("Arithmetic" + (clojure.core + - * / quot rem mod dec inc max min)) + ("Compare" + (clojure.core = == not= < > <= >= compare)) + ("Bitwise" + (clojure.core bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set bit-shift-left bit-shift-right bit-test bit-xor unsigned-bit-shift-right)) + ("Cast" + (clojure.core byte short long int float double bigdec bigint biginteger num rationalize)) + ("Test" + (clojure.core nil? some? identical? zero? pos? neg? even? odd?)) + ("Random" + (clojure.core rand rand-int)) + ("BigDecimal" + (clojure.core with-precision)) + ("Ratios" + (clojure.core numerator denominator ratio?)) + ("Arbitrary Precision Arithmetic" + (clojure.core +\' -\' *\' inc\' dec\')) + ("Unchecked" + (clojure.core *unchecked-math* + unchecked-add + unchecked-add-int + unchecked-byte + unchecked-char + unchecked-dec + unchecked-dec-int + unchecked-divide-int + unchecked-double + unchecked-float + unchecked-inc + unchecked-inc-int + unchecked-int + unchecked-long + unchecked-multiply + unchecked-multiply-int + unchecked-negate + unchecked-negate-int + unchecked-remainder-int + unchecked-short + unchecked-subtract + unchecked-subtract-int))) + + ("Strings" + ("Create" + (clojure.core str format)) + ("Use" + (clojure.core count get subs compare) + (clojure.string join escape split split-lines replace replace-first reverse re-quote-replacement index-of last-index-of starts-with? ends-with? includes?)) + ("Regex" + (clojure.core re-find re-seq re-matches re-pattern re-matcher re-groups) + (clojure.string replace replace-first re-quote-replacement)) + ("Letters" + (clojure.string capitalize lower-case upper-case)) + ("Trim" + (clojure.string trim trim-newline triml trimr)) + ("Test" + (clojure.core char char? string?) + (clojure.string blank?))) + + ("Other" + ("Characters" + (clojure.core char char-name-string char-escape-string)) + ("Keywords" + (clojure.core keyword keyword? find-keyword)) + ("Symbols" + (clojure.core symbol symbol? gensym)) + ("Data Readers" + (clojure.core *data-readers* default-data-readers *default-data-reader-fn*)))) + + ("Collections" + ("Generic Ops" + (clojure.core count bounded-count empty not-empty into conj)) + ("Tree Walking" + (clojure.walk walk prewalk prewalk-demo prewalk-replace postwalk postwalk-demo postwalk-replace keywordize-keys stringify-keys)) + ("Content tests" + (clojure.core distinct? empty? every? not-every? some not-any?)) + ("Capabilities" + (clojure.core sequential? associative? sorted? counted? reversible?)) + ("Type tests" + (clojure.core type class coll? list? vector? set? map? seq? + number? integer? float? decimal? class? rational? ratio? + chunked-seq? reduced? special-symbol? record?)) + ("Lists" + ("Create" + (clojure.core list list*)) + ("Examine" + (clojure.core first nth peek)) + ("Change" + (clojure.core cons conj rest pop))) + + ("Vectors" + ("Create" + (clojure.core vec vector vector-of)) + ("Examine" + (clojure.core get peek)) + + ("Change" + (clojure.core assoc pop subvec replace conj rseq)) + ("Ops" + (clojure.core mapv filterv reduce-kv))) + + ("Sets" + ("Create" + (clojure.core set hash-set sorted-set sorted-set-by)) + ("Examine" + (clojure.core get contains?)) + ("Change" + (clojure.core conj disj)) + ("Relational Algebra" + (clojure.set join select project union difference intersection)) + ("Get map" + (clojure.set index rename-keys rename map-invert)) + ("Test" + (clojure.set subset? superset?)) + ("Sorted Sets" + (clojure.core rseq subseq rsubseq))) + + ("Maps" + ("Create" + (clojure.core hash-map array-map zipmap sorted-map sorted-map-by bean frequencies group-by)) + ("Examine" + (clojure.core get get-in contains? find keys vals map-entry?)) + ("Change" + (clojure.core assoc assoc-in dissoc merge merge-with select-keys update update-in)) + ("Entry" + (clojure.core key val)) + ("Sorted Maps" + (clojure.core rseq subseq rsubseq))) + + ("Hashes" + (clojure.core hash hash-ordered-coll hash-unordered-coll mix-collection-hash)) + + ("Volatiles" + (clojure.core volatile! volatile? vreset! vswap!))) + + ("Functions" + ("Create" + (clojure.core fn defn defn- definline identity constantly comp complement partial juxt memfn memoize fnil every-pred some-fn trampoline)) + ("Call" + (clojure.core -> ->> some-> some->> as-> cond-> cond->>)) + ("Test" + (clojure.core fn? ifn?))) + + ("Transducers" + ("Create" + (clojure.core cat dedupe distinct drop drop-while filter halt-when interpose keep keep-indexed map map-indexed mapcat partition-all partition-by random-sample remove replace take take-nth take-while)) + ("Call" + (clojure.core ->Eduction eduction into sequence transduce completing run!)) + ("Early Termination" + (clojure.core deref reduced reduced? ensure-reduced unreduced))) + + ("Spec" + ("Operations" + (clojure.spec.alpha valid? conform unform explain explain-data explain-str explain-out form describe assert check-asserts check-asserts?)) + ("Generator Ops" + (clojure.spec.alpha gen exercise exercise-fn)) + ("Defn & Registry" + (clojure.spec.alpha def fdef registry get-spec spec? spec with-gen)) + ("Logical" + (clojure.spec.alpha and or)) + ("Collection" + (clojure.spec.alpha coll-of map-of every every-kv keys merge)) + ("Regex " + (clojure.spec.alpha cat alt * + \? & keys*)) + ("Range" + (clojure.spec.alpha int-in inst-in double-in int-in-range? inst-in-range?)) + ("Custom Explain" + (clojure.spec.alpha explain-printer *explain-out*)) + ("Other" + (clojure.spec.alpha nilable multi-spec fspec conformer)) + + ("Predicates with test.check generators" + ("Numbers" + (clojure.core number? rational? integer? ratio? decimal? float? zero? double? int? nat-int? neg-int? pos-int?)) + ("Symbols & Keywords" + (clojure.core keyword? symbol? ident? qualified-ident? qualified-keyword? qualified-symbol? simple-ident? simple-keyword? simple-symbol?)) + ("Scalars" + (clojure.core string? true? false? nil? some? boolean? bytes? inst? uri? uuid?)) + ("Collections" + (clojure.core list? map? set? vector? associative? coll? sequential? seq? empty? indexed? seqable?)) + ("Other" + (clojure.core any?)))) + + ("Other" + ("XML" + (clojure.core xml-seq) + (clojure.xml parse)) + ("REPL" + (clojure.core *1 *2 *3 *e *print-dup* *print-length* *print-level* *print-meta* *print-readably*)) + ("EDN" + (clojure.edn read read-string)) + ("Compiling Code & Class Generation" + (clojure.core *compile-files* *compile-path* *file* *warn-on-reflection* compile gen-class gen-interface loaded-libs test)) + ("Misc" + (clojure.core eval force name *clojure-version* clojure-version *command-line-args*)) + ("Pretty Printing" + (clojure.pprint pprint print-table pp *print-right-margin*)) + ("Browser / Shell" + (clojure.java.browse browse-url) + (clojure.java.shell sh with-sh-dir with-sh-env))) + + ("Vars & Global Environment" + ("Def Variants" + (:special def) + (clojure.core defn defn- definline defmacro defmethod defmulti defonce defrecord)) + ("Interned Vars" + (:special var) + (clojure.core declare intern binding find-var)) + ("Var Objects" + (clojure.core with-local-vars var-get var-set alter-var-root var?)) + ("Var Validators" + (clojure.core set-validator! get-validator))) + + ("Reader Conditionals" + (clojure.core reader-conditional reader-conditional? tagged-literal tagged-literal?)) + + ("Abstractions" + ("Protocols" + (clojure.core defprotocol extend extend-type extend-protocol reify extends? satisfies? extenders)) + ("Records & Types" + (clojure.core defrecord deftype)) + ("Multimethods" + ("Define" + (clojure.core defmulti defmethod)) + ("Dispatch" + (clojure.core get-method methods)) + ("Remove" + (clojure.core remove-method remove-all-methods)) + ("Prefer" + (clojure.core prefer-method prefers)) + ("Relation" + (clojure.core derive isa? parents ancestors descendants make-hierarchy)))) + + ("Macros" + ("Create" + (clojure.core defmacro definline)) + ("Debug" + (clojure.core macroexpand-1 macroexpand) + (clojure.walk macroexpand-all)) + ("Branch" + (clojure.core and or when when-not when-let when-first if-not if-let cond condp case)) + ("Loop" + (clojure.core for doseq dotimes while)) + ("Arrange" + (clojure.core .. doto ->)) + ("Scope" + (clojure.core binding locking time) + (clojure.core with-in-str with-local-vars with-open with-out-str with-precision with-redefs with-redefs-fn)) + ("Lazy" + (clojure.core lazy-cat lazy-seq delay delay?)) + ("Doc" + (clojure.core assert comment) + (clojure.repl doc dir dir-fn source-fn))) + + ("Java Interop" + ("General" + (:special new set!) + (clojure.core .. doto bean comparator enumeration-seq import iterator-seq memfn definterface supers bases)) + ("Cast" + (clojure.core boolean byte short char int long float double bigdec bigint num cast biginteger)) + ("Exceptions" + (:special throw try catch finally) + (clojure.core ex-info ex-data Throwable->map StackTraceElement->vec) + (clojure.repl pst)) + ("Arrays" + ("Create" + (clojure.core boolean-array byte-array double-array char-array float-array int-array long-array make-array object-array short-array to-array)) + ("Manipulate" + (clojure.core aclone aget aset alength amap areduce aset-int aset-long aset-short aset-boolean aset-byte aset-char aset-double aset-float)) + ("Cast" + (clojure.core booleans bytes chars doubles floats ints longs shorts))) + ("Proxy" + ("Create" + (clojure.core proxy get-proxy-class construct-proxy init-proxy)) + ("Misc" + (clojure.core proxy-mappings proxy-super update-proxy)))) + + ("Namespaces" + ("Current" + (clojure.core *ns*)) + ("Create Switch" + (clojure.core ns in-ns create-ns)) + ("Add" + (clojure.core alias import intern refer refer-clojure)) + ("Find" + (clojure.core all-ns find-ns)) + ("Examine" + (clojure.core ns-aliases ns-imports ns-interns ns-map ns-name ns-publics ns-refers)) + ("From symbol" + (clojure.core resolve namespace ns-resolve the-ns)) + ("Remove" + (clojure.core ns-unalias ns-unmap remove-ns))) + ("Loading" + ("Load libs" + (clojure.core require use import refer)) + ("List Loaded" + (clojure.core loaded-libs)) + ("Load Misc" + (clojure.core load load-file load-reader load-string))) + + ("Concurrency" + ("Atoms" + (clojure.core atom swap! swap-vals! reset! reset-vals! compare-and-set!)) + ("Futures" + (clojure.core future future-call future-cancel future-cancelled? future-done? future?)) + ("Threads" + (clojure.core bound-fn bound-fn* get-thread-bindings pop-thread-bindings push-thread-bindings)) + + ("Misc" + (clojure.core locking pcalls pvalues pmap seque promise deliver)) + + ("Refs & Transactions" + ("Create" + (clojure.core ref)) + ("Examine" + (clojure.core deref)) + ("Transaction" + (clojure.core sync dosync io!)) + ("In Transaction" + (clojure.core ensure ref-set alter commute)) + ("Validators" + (clojure.core get-validator set-validator!)) + ("History" + (clojure.core ref-history-count ref-max-history ref-min-history))) + + ("Agents & Asynchronous Actions" + ("Create" + (clojure.core agent)) + ("Examine" + (clojure.core agent-error)) + ("Change State" + (clojure.core send send-off restart-agent send-via set-agent-send-executor! set-agent-send-off-executor!)) + ("Block Waiting" + (clojure.core await await-for)) + ("Ref Validators" + (clojure.core get-validator set-validator!)) + ("Watchers" + (clojure.core add-watch remove-watch)) + ("Thread Handling" + (clojure.core shutdown-agents)) + ("Error" + (clojure.core error-handler set-error-handler! error-mode set-error-mode!)) + ("Misc" + (clojure.core *agent* release-pending-sends)))) + + ("Sequences" + ("Creating a Lazy Seq" + ("From Collection" + (clojure.core seq sequence keys vals rseq subseq rsubseq)) + ("From Producer Fn" + (clojure.core lazy-seq repeatedly iterate)) + ("From Constant" + (clojure.core repeat range)) + ("From Other" + (clojure.core file-seq line-seq resultset-seq re-seq tree-seq xml-seq iterator-seq enumeration-seq)) + ("From Seq" + (clojure.core keep keep-indexed))) + + ("Seq in, Seq out" + ("Get shorter" + (clojure.core distinct dedupe filter remove for)) + ("Get longer" + (clojure.core cons conj concat lazy-cat mapcat cycle interleave interpose))) + ("Tail-items" + (clojure.core rest nthrest fnext nnext drop drop-while take-last for)) + ("Head-items" + (clojure.core take take-nth take-while butlast drop-last for)) + ("Change" + (clojure.core conj concat distinct flatten group-by partition partition-all partition-by split-at split-with filter remove replace shuffle random-sample)) + ("Rearrange" + (clojure.core reverse sort sort-by compare)) + ("Process items" + (clojure.core map pmap map-indexed mapcat for replace seque)) + + ("Using a Seq" + ("Extract item" + (clojure.core first second last rest next ffirst nfirst fnext nnext nth nthnext rand-nth when-first max-key min-key)) + ("Construct coll" + (clojure.core zipmap into reduce reductions set vec into-array to-array-2d)) + ("Pass to fn" + (clojure.core apply)) + ("Search" + (clojure.core some filter)) + ("Force evaluation" + (clojure.core doseq dorun doall)) + ("Check for forced" + (clojure.core realized?)))) + + ("Zippers" + ("Create" + (clojure.zip zipper seq-zip vector-zip xml-zip)) + ("Get loc" + (clojure.zip up down left right leftmost rightmost)) + ("Get seq" + (clojure.zip lefts rights path children)) + ("Change" + (clojure.zip make-node replace edit insert-child insert-left insert-right append-child remove)) + ("Move" + (clojure.zip next prev)) + ("XML" + (clojure.data.zip.xml attr attr= seq-test tag= text text= xml-> xml1->)) + ("Misc" + (clojure.zip root node branch? end?))) + + ("Documentation" + ("REPL" + (clojure.repl doc find-doc apropos source pst) + (clojure.java.javadoc javadoc))) + + ("Transients" + ("Create" + (clojure.core transient persistent!)) + ("Change" + (clojure.core conj! pop! assoc! dissoc! disj!))) + ("Misc" + ("Compare" + (clojure.core = == identical? not= not compare) + (clojure.data diff)) + ("Test" + (clojure.core true? false? nil? instance?))) + + ("IO" + ("To/from ..." + (clojure.core spit slurp)) + ("To *out*" + (clojure.core pr prn print printf println newline) + (clojure.pprint print-table)) + ("To writer" + (clojure.pprint pprint cl-format)) + ("To string" + (clojure.core format with-out-str pr-str prn-str print-str println-str)) + ("From *in*" + (clojure.core read-line read)) + ("From reader" + (clojure.core line-seq read)) + ("From string" + (clojure.core read-string with-in-str)) + ("Open" + (clojure.core with-open) + (clojure.java.io reader writer input-stream output-stream)) + ("Interop" + (clojure.java.io make-writer make-reader make-output-stream make-input-stream)) + ("Misc" + (clojure.core flush file-seq *in* *out* *err*) + (clojure.java.io file copy delete-file resource as-file as-url as-relative-path make-parents))) + + ("Metadata" + (clojure.core meta with-meta alter-meta! reset-meta! vary-meta)) + + ("Special Forms" + (:special def if do quote var recur throw try monitor-enter monitor-exit) + (clojure.core fn loop) + ("Binding / Destructuring" + (clojure.core let fn letfn defn defmacro loop for doseq if-let if-some when-let when-some))) + + ("Async" + ("Main" + (clojure.core.async go go-loop ! >!! chan put! take take! close! timeout offer! poll! promise-chan)) + ("Choice" + (clojure.core.async alt! alt!! alts! alts!! do-alts)) + ("Buffering" + (clojure.core.async buffer dropping-buffer sliding-buffer unblocking-buffer?)) + ("Pipelines" + (clojure.core.async pipeline pipeline-async pipeline-blocking)) + ("Threading" + (clojure.core.async thread thread-call)) + ("Mixing" + (clojure.core.async admix solo-mode mix unmix unmix-all toggle merge pipe unique)) + ("Multiples" + (clojure.core.async mult tap untap untap-all)) + ("Publish/Subscribe" + (clojure.core.async pub sub unsub unsub-all)) + ("Higher Order" + (clojure.core.async filter< filter> map map< map> mapcat< mapcat> partition partition-by reduce remove< remove> split)) + ("Pre-Populate" + (clojure.core.async into onto-chan to-chan))) + ("Unit Tests" + ("Defining" + (clojure.test deftest deftest- testing is are)) + ("Running" + (clojure.test run-tests run-all-tests test-vars)) + ("Fixtures" + (clojure.test use-fixtures join-fixtures compose-fixtures)))) + "A data structure for Clojure cheatsheet information. + +It's a tree, where the head of each list determines the context of the rest +of the list. The head may be: + + - A string, in which case it's a (sub)heading for the rest of the items. + + - A symbol, in which case it's the Clojure namespace of the symbols that + follow it. + + - The keyword :special, in which case it's a Clojure special form + + - Any other keyword, in which case it's a typed item that will be passed + through. + +Note that some Clojure symbols appear in more than once. This is entirely +intentional. For instance, `map` belongs in the sections on collections +and transducers.") + +(defun cider-cheatsheet--expand-vars (list) + "Expand the symbols in LIST to fully-qualified var names. + +This list is supposed to have the following format: + + (my-ns var1 var2 var3)" + (let ((ns (car list)) + (vars (cdr list))) + (if (eq ns :special) + (mapcar #'symbol-name vars) + (mapcar (lambda (var) (format "%s/%s" ns var)) vars)))) + +(defun cider-cheatsheet--select-var (var-list) + "Expand the symbols in VAR-LIST to fully-qualified var names. + +The list can hold one or more lists inside - one per each namespace." + (let ((namespaced-vars (seq-mapcat #'cider-cheatsheet--expand-vars + (seq-remove (lambda (list) + (eq (car list) :url)) + var-list)))) + (cider-doc-lookup (completing-read "Select var: " namespaced-vars)))) + +;;;###autoload +(defun cider-cheatsheet () + "Navigate `cider-cheatsheet-hierarchy' with `completing-read'. + +When you make it to a Clojure var its doc buffer gets displayed." + (interactive) + (let ((cheatsheet-data cider-cheatsheet-hierarchy)) + (while (stringp (caar cheatsheet-data)) + (let* ((sections (mapcar #'car cheatsheet-data)) + (sel-section (completing-read "Select cheatsheet section: " sections)) + (section-data (seq-find (lambda (elem) (equal (car elem) sel-section)) cheatsheet-data))) + (setq cheatsheet-data (cdr section-data)))) + (cider-cheatsheet--select-var cheatsheet-data))) + +(provide 'cider-cheatsheet) + +;;; cider-cheatsheet.el ends here diff --git a/elpa/cider-20190121.1852/cider-classpath.el b/elpa/cider-20190121.1852/cider-classpath.el new file mode 100644 index 00000000..b40a3cee --- /dev/null +++ b/elpa/cider-20190121.1852/cider-classpath.el @@ -0,0 +1,112 @@ +;;; cider-classpath.el --- Basic Java classpath browser + +;; Copyright © 2014-2019 Bozhidar Batsov and CIDER contributors + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Basic Java classpath browser for CIDER. + +;;; Code: + +(require 'cider-client) +(require 'cider-popup) +(require '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/elpa/cider-20190121.1852/cider-client.el b/elpa/cider-20190121.1852/cider-client.el new file mode 100644 index 00000000..8a155568 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-client.el @@ -0,0 +1,624 @@ +;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*- + +;; Copyright © 2013-2019 Bozhidar Batsov +;; +;; Author: Bozhidar Batsov + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A layer of abstraction above the low-level nREPL client code. + +;;; Code: + +(require 'spinner) +(require 'nrepl-client) +(require 'cider-connection) +(require 'cider-common) +(require 'cider-util) +(require 'clojure-mode) + +(require 'subr-x) +(require 'cider-compat) +(require 'seq) + + +;;; Eval spinner +(defcustom cider-eval-spinner-type 'progress-bar + "Appearance of the evaluation spinner. + +Value is a symbol. The possible values are the symbols in the +`spinner-types' variable." + :type 'symbol + :group 'cider + :package-version '(cider . "0.10.0")) + +(defcustom cider-show-eval-spinner t + "When true, show the evaluation spinner in the mode line." + :type 'boolean + :group 'cider + :package-version '(cider . "0.10.0")) + +(defcustom cider-eval-spinner-delay 1 + "Amount of time, in seconds, after which the evaluation spinner will be shown." + :type 'integer + :group 'cider + :package-version '(cider . "0.10.0")) + +(defun cider-spinner-start (buffer) + "Start the evaluation spinner in BUFFER. +Do nothing if `cider-show-eval-spinner' is nil." + (when cider-show-eval-spinner + (with-current-buffer buffer + (spinner-start cider-eval-spinner-type nil + cider-eval-spinner-delay)))) + +(defun cider-eval-spinner-handler (eval-buffer original-callback) + "Return a response handler to stop the spinner and call ORIGINAL-CALLBACK. +EVAL-BUFFER is the buffer where the spinner was started." + (lambda (response) + ;; buffer still exists and + ;; we've got status "done" from nrepl + ;; stop the spinner + (when (and (buffer-live-p eval-buffer) + (let ((status (nrepl-dict-get response "status"))) + (or (member "done" status) + (member "eval-error" status) + (member "error" status)))) + (with-current-buffer eval-buffer + (when spinner-current (spinner-stop)))) + (funcall original-callback response))) + + +;;; Evaluation helpers +(defun cider-ns-form-p (form) + "Check if FORM is an ns form." + (string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form)) + +(defun cider-ns-from-form (ns-form) + "Get ns substring from NS-FORM." + (when (string-match "^[ \t\n]*\(ns[ \t\n]+\\([^][ \t\n(){}]+\\)" ns-form) + (match-string-no-properties 1 ns-form))) + +(defvar-local cider-buffer-ns nil + "Current Clojure namespace of some buffer. +Useful for special buffers (e.g. REPL, doc buffers) that have to keep track +of a namespace. This should never be set in Clojure buffers, as there the +namespace should be extracted from the buffer's ns form.") + +(defun cider-current-ns (&optional no-default) + "Return the current ns. +The ns is extracted from the ns form for Clojure buffers and from +`cider-buffer-ns' for all other buffers. If it's missing, use the current +REPL's ns, otherwise fall back to \"user\". When NO-DEFAULT is non-nil, it +will return nil instead of \"user\"." + (or cider-buffer-ns + (clojure-find-ns) + (when-let* ((repl (cider-current-repl))) + (buffer-local-value 'cider-buffer-ns repl)) + (if no-default nil "user"))) + +(defun cider-expected-ns (&optional path) + "Return the namespace string matching PATH, or nil if not found. +PATH is expected to be an absolute file path. If PATH is nil, use the path +to the file backing the current buffer. The command falls back to +`clojure-expected-ns' in the absence of an active nREPL connection." + (if (cider-connected-p) + (let* ((path (or path (file-truename (buffer-file-name)))) + (relpath (thread-last (cider-sync-request:classpath) + (seq-map + (lambda (cp) + (when (string-prefix-p cp path) + (substring path (length cp))))) + (seq-filter #'identity) + (seq-sort (lambda (a b) + (< (length a) (length b)))) + (car)))) + (if relpath + (thread-last (substring relpath 1) ; remove leading / + (file-name-sans-extension) + (replace-regexp-in-string "/" ".") + (replace-regexp-in-string "_" "-")) + (clojure-expected-ns path))) + (clojure-expected-ns path))) + +(defun cider-nrepl-op-supported-p (op &optional connection) + "Check whether the CONNECTION supports the nREPL middleware OP." + (nrepl-op-supported-p op (or connection (cider-current-repl)))) + +(defvar cider-version) +(defun cider-ensure-op-supported (op) + "Check for support of middleware op OP. +Signal an error if it is not supported." + (unless (cider-nrepl-op-supported-p op) + (user-error "`%s' requires the nREPL op \"%s\" (provided by cider-nrepl)" this-command op))) + +(defun cider-nrepl-send-request (request callback &optional connection) + "Send REQUEST and register response handler CALLBACK. +REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" + \"par1\" ... ). +If CONNECTION is provided dispatch to that connection instead of +the current connection. Return the id of the sent message." + (nrepl-send-request request callback (or connection (cider-current-repl 'any)))) + +(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input) + "Send REQUEST to the nREPL server synchronously using CONNECTION. +Hold till final \"done\" message has arrived and join all response messages +of the same \"op\" that came along and return the accumulated response. +If ABORT-ON-INPUT is non-nil, the function will return nil +at the first sign of user input, so as not to hang the +interface." + (nrepl-send-sync-request request + (or connection (cider-current-repl 'any)) + abort-on-input)) + +(defun cider-nrepl-send-unhandled-request (request &optional connection) + "Send REQUEST to the nREPL CONNECTION and ignore any responses. +Immediately mark the REQUEST as done. Return the id of the sent message." + (let* ((conn (or connection (cider-current-repl 'any))) + (id (nrepl-send-request request #'ignore conn))) + (with-current-buffer conn + (nrepl--mark-id-completed id)) + id)) + +(defun cider-nrepl-request:eval (input callback &optional ns line column additional-params connection) + "Send the request INPUT and register the CALLBACK as the response handler. +If NS is non-nil, include it in the request. LINE and COLUMN, if non-nil, +define the position of INPUT in its buffer. ADDITIONAL-PARAMS is a plist +to be appended to the request message. CONNECTION is the connection +buffer, defaults to (cider-current-repl)." + (let ((connection (or connection (cider-current-repl)))) + (nrepl-request:eval input + (if cider-show-eval-spinner + (cider-eval-spinner-handler connection callback) + callback) + connection + ns line column additional-params) + (cider-spinner-start connection))) + +(defun cider-nrepl-sync-request:eval (input &optional connection ns) + "Send the INPUT to the nREPL CONNECTION synchronously. +If NS is non-nil, include it in the eval request." + (nrepl-sync-request:eval input (or connection (cider-current-repl)) ns)) + +(defcustom cider-pprint-fn 'pprint + "Sets the function to use when pretty-printing evaluation results. + +The value must be one of the following symbols: + +`pprint' - to use \\=`clojure.pprint/pprint\\=` + +`fipp' - to use the Fast Idiomatic Pretty Printer, approximately 5-10x +faster than \\=`clojure.core/pprint\\=` (this is the default) + +`puget' - to use Puget, which provides canonical serialization of data on +top of fipp, but at a slight performance cost + +`zprint' - to use zprint, a fast and flexible alternative to the libraries +mentioned above. + +Alternatively, can be the namespace-qualified name of a Clojure function of +two arguments - an object to print and an options map. The options map will +have string keys. If the function +cannot be resolved, an exception will be thrown. + +The function should ideally have a two-arity variant that accepts the +object to print and a map of configuration options for the printer. See +`cider-pprint-options' for details. + +The function is also 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*\\=`. Those would normally serve as +fallback values when a map of print options is not supplied explicitly." + :type '(choice (const pprint) + (const fipp) + (const puget) + (const zprint) + string) + :group 'cider + :package-version '(cider . "0.11.0")) + +(defcustom cider-pprint-options nil + "A list of options for the pretty-printer that will be converted to a map. +Note that map can only have string keys, so the printer functions should be +able to handle those. Here's an example for `pprint': + + '(dict \"length\" 50 \"right-margin\" 70)" + :type 'list + :group 'cider + :package-version '(cider . "0.20.0")) + +(defun cider--pprint-fn () + "Return the value to send in the pprint-fn slot of messages." + (pcase cider-pprint-fn + (`pprint "cider.nrepl.pprint/pprint") + (`fipp "cider.nrepl.pprint/fipp-pprint") + (`puget "cider.nrepl.pprint/puget-pprint") + (`zprint "zprint.core/zprint-str") + (_ cider-pprint-fn))) + +(defvar cider--pprint-options-mapping + '((right-margin + ((fipp . width) (puget . width) (zprint . width))) + (length + ((fipp . print-length) (puget . print-length) (zprint . max-length))) + (level + ((fipp . print-level) (puget . print-level) (zprint . max-depth)))) + "A mapping of print option for the various supported print engines.") + +(defun cider--pprint-option (name printer) + "Covert the generic NAME to its PRINTER specific variant. +E.g. pprint's right-margin would become width for fipp. +The function is useful when you want to generate dynamically +print options. + +NAME can be a string or a symbol. PRINTER has to be a symbol. +The result will be a string." + (let* ((name (cider-maybe-intern name)) + (result (cdr (assoc printer (cadr (assoc name cider--pprint-options-mapping)))))) + (symbol-name (or result name)))) + +(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." + (let* ((print-options (or cider-pprint-options (nrepl-dict)))) + (when right-margin + (setq print-options (nrepl-dict-put print-options (cider--pprint-option "right-margin" cider-pprint-fn) right-margin))) + (nconc `("printer" ,(or pprint-fn (cider--pprint-fn))) + (and (not (nrepl-dict-empty-p print-options)) `("print-options" ,print-options))))) + +(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" "^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 (cider-current-repl) + '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 (cider-current-repl))))) + (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 (cider-current-repl) + 'abort-on-input)))) + (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) + nil + eldoc))) + +(defun cider-sync-request:eldoc-datomic-query (symbol) + "Send \"eldoc-datomic-query\" op with parameter SYMBOL." + (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query" + "ns" ,(cider-current-ns) + ,@(when symbol `("symbol" ,symbol))) + (cider-nrepl-send-sync-request nil 'abort-on-input)))) + (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) + nil + eldoc))) + +(defun cider-sync-request:spec-list (&optional filter-regex) + "Get a list of the available specs in the registry. +Optional argument FILTER-REGEX filters specs. By default, all specs are +returned." + (setq filter-regex (or filter-regex "")) + (thread-first `("op" "spec-list" + "filter-regex" ,filter-regex) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-list"))) + +(defun cider-sync-request:spec-form (spec) + "Get SPEC's form from registry." + (thread-first `("op" "spec-form" + "spec-name" ,spec) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-form"))) + +(defun cider-sync-request:spec-example (spec) + "Get an example for SPEC." + (thread-first `("op" "spec-example" + "spec-name" ,spec) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "spec-example"))) + +(defun cider-sync-request:ns-list () + "Get a list of the available namespaces." + (thread-first `("op" "ns-list" + "filter-regexps" ,cider-filtered-namespaces-regexps) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-list"))) + +(defun cider-sync-request:ns-vars (ns) + "Get a list of the vars in NS." + (thread-first `("op" "ns-vars" + "ns" ,ns) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-vars"))) + +(defun cider-sync-request:ns-path (ns) + "Get the path to the file containing NS." + (thread-first `("op" "ns-path" + "ns" ,ns) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "path"))) + +(defun cider-sync-request:ns-vars-with-meta (ns) + "Get a map of the vars in NS to its metadata information." + (thread-first `("op" "ns-vars-with-meta" + "ns" ,ns) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "ns-vars-with-meta"))) + +(defun cider-sync-request:ns-load-all () + "Load all project namespaces." + (thread-first '("op" "ns-load-all") + (cider-nrepl-send-sync-request) + (nrepl-dict-get "loaded-ns"))) + +(defun cider-sync-request:resource (name) + "Perform nREPL \"resource\" op with resource name NAME." + (thread-first `("op" "resource" + "name" ,name) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "resource-path"))) + +(defun cider-sync-request:resources-list () + "Return a list of all resources on the classpath. +The result entries are relative to the classpath." + (when-let* ((resources (thread-first '("op" "resources-list") + (cider-nrepl-send-sync-request) + (nrepl-dict-get "resources-list")))) + (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources))) + +(defun cider-sync-request:format-code (code) + "Perform nREPL \"format-code\" op with CODE." + (thread-first `("op" "format-code" + "code" ,code) + (cider-nrepl-send-sync-request) + (nrepl-dict-get "formatted-code"))) + +(defun cider-sync-request:format-edn (edn right-margin) + "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." + (let* ((response (thread-first `("op" "format-edn" + "edn" ,edn) + (append (cider--nrepl-pprint-request-plist right-margin)) + (cider-nrepl-send-sync-request))) + (err (nrepl-dict-get response "err"))) + (when err + ;; err will be a stacktrace with a first line that looks like: + ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" + (error (car (split-string err "\n")))) + (nrepl-dict-get response "formatted-edn"))) + +;;; Dealing with input +;; TODO: Replace this with some nil handler. +(defun cider-stdin-handler (&optional _buffer) + "Make a stdin response handler for _BUFFER." + (nrepl-make-response-handler (current-buffer) + (lambda (_buffer _value)) + (lambda (_buffer _out)) + (lambda (_buffer _err)) + nil)) + +(defun cider-need-input (buffer) + "Handle an need-input request from BUFFER." + (with-current-buffer buffer + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map (kbd "C-c C-c") 'abort-recursive-edit) + (let ((stdin (condition-case nil + (concat (read-from-minibuffer "Stdin: " nil map) "\n") + (quit nil)))) + (nrepl-request:stdin stdin + (cider-stdin-handler buffer) + (cider-current-repl)))))) + +(provide 'cider-client) + +;;; cider-client.el ends here diff --git a/elpa/cider-20190121.1852/cider-common.el b/elpa/cider-20190121.1852/cider-common.el new file mode 100644 index 00000000..e17ac7a8 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-common.el @@ -0,0 +1,375 @@ +;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- + +;; Copyright © 2015-2019 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Common functions that are useful in both Clojure buffers and REPL +;; buffers. + +;;; Code: + +(require '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/elpa/cider-20190121.1852/cider-compat.el b/elpa/cider-20190121.1852/cider-compat.el new file mode 100644 index 00000000..dfd25615 --- /dev/null +++ b/elpa/cider-20190121.1852/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-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Everything here was copied from subr-x for compatibility with +;; Emacs 25.1. + +;;; Code: + +(eval-and-compile + + (unless (fboundp 'if-let*) + (defmacro if-let* (bindings then &rest else) + "Process BINDINGS and if all values are non-nil eval THEN, else ELSE. +Argument BINDINGS is a list of tuples whose car is a symbol to be +bound and (optionally) used in THEN, and its cadr is a sexp to be +evalled to set symbol's value." + (declare (indent 2) + (debug ([&or (&rest (symbolp form)) (symbolp form)] form body))) + `(let* ,(internal--build-bindings bindings) + (if ,(car (internal--listify (car (last bindings)))) + ,then + ,@else)))) + + (unless (fboundp 'when-let*) + (defmacro when-let* (bindings &rest body) + "Process BINDINGS and if all values are non-nil eval BODY. +Argument BINDINGS is a list of tuples whose car is a symbol to be +bound and (optionally) used in BODY, and its cadr is a sexp to be +evalled to set symbol's value." + (declare (indent 1) (debug if-let*)) + `(if-let* ,bindings ,(macroexp-progn body))))) + +(provide 'cider-compat) +;;; cider-compat.el ends here diff --git a/elpa/cider-20190121.1852/cider-completion.el b/elpa/cider-20190121.1852/cider-completion.el new file mode 100644 index 00000000..d4be0a73 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-completion.el @@ -0,0 +1,253 @@ +;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*- + +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Smart REPL-powered code completion and integration with company-mode. + +;;; Code: + +(require 'subr-x) +(require 'thingatpt) + +(require 'cider-client) +(require 'cider-common) +(require 'cider-eldoc) +(require 'nrepl-dict) + +(defcustom cider-completion-use-context t + "When true, uses context at point to improve completion suggestions." + :type 'boolean + :group 'cider + :package-version '(cider . "0.7.0")) + +(defcustom cider-annotate-completion-candidates t + "When true, annotate completion candidates with some extra information." + :type 'boolean + :group 'cider + :package-version '(cider . "0.8.0")) + +(defcustom cider-annotate-completion-function + #'cider-default-annotate-completion-function + "Controls how the annotations for completion candidates are formatted. +Must be a function that takes two arguments: the abbreviation of the +candidate type according to `cider-completion-annotations-alist' and the +candidate's namespace." + :type 'function + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-completion-annotations-alist + '(("class" "c") + ("field" "fi") + ("function" "f") + ("import" "i") + ("keyword" "k") + ("local" "l") + ("macro" "m") + ("method" "me") + ("namespace" "n") + ("protocol" "p") + ("protocol-function" "pf") + ("record" "r") + ("special-form" "s") + ("static-field" "sf") + ("static-method" "sm") + ("type" "t") + ("var" "v")) + "Controls the abbreviations used when annotating completion candidates. + +Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE +is a possible value of the candidate's type returned from the completion +backend, and ABBREVIATION is a short form of that type." + :type '(alist :key-type string :value-type string) + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-completion-annotations-include-ns 'unqualified + "Controls passing of namespaces to `cider-annotate-completion-function'. + +When set to 'always, the candidate's namespace will always be passed if it +is available. When set to 'unqualified, the namespace will only be passed +if the candidate is not namespace-qualified." + :type '(choice (const always) + (const unqualified) + (const :tag "never" nil)) + :group 'cider + :package-version '(cider . "0.9.0")) + +(defvar cider-completion-last-context nil) + +(defun cider-completion-symbol-start-pos () + "Find the starting position of the symbol at point, unless inside a string." + (let ((sap (symbol-at-point))) + (when (and sap (not (nth 3 (syntax-ppss)))) + (car (bounds-of-thing-at-point 'symbol))))) + +(defun cider-completion-get-context-at-point () + "Extract the context at point. +If point is not inside the list, returns nil; otherwise return \"top-level\" +form, with symbol at point replaced by __prefix__." + (when (save-excursion + (condition-case _ + (progn + (up-list) + (check-parens) + t) + (scan-error nil) + (user-error nil))) + (save-excursion + (let* ((pref-end (point)) + (pref-start (cider-completion-symbol-start-pos)) + (context (cider-defun-at-point)) + (_ (beginning-of-defun)) + (expr-start (point))) + (concat (when pref-start (substring context 0 (- pref-start expr-start))) + "__prefix__" + (substring context (- pref-end expr-start))))))) + +(defun cider-completion-get-context () + "Extract context depending on `cider-completion-use-context' and major mode." + (let ((context (if (and cider-completion-use-context + ;; Important because `beginning-of-defun' and + ;; `ending-of-defun' work incorrectly in the REPL + ;; buffer, so context extraction fails there. + (derived-mode-p 'clojure-mode)) + (or (cider-completion-get-context-at-point) + "nil") + "nil"))) + (if (string= cider-completion-last-context context) + ":same" + (setq cider-completion-last-context context) + context))) + +(defun cider-completion--parse-candidate-map (candidate-map) + "Get \"candidate\" from CANDIDATE-MAP. +Put type and ns properties on the candidate" + (let ((candidate (nrepl-dict-get candidate-map "candidate")) + (type (nrepl-dict-get candidate-map "type")) + (ns (nrepl-dict-get candidate-map "ns"))) + (put-text-property 0 1 'type type candidate) + (put-text-property 0 1 'ns ns candidate) + candidate)) + +(defun cider-complete (str) + "Complete STR with context at point." + (let* ((context (cider-completion-get-context)) + (candidates (cider-sync-request:complete str context))) + (mapcar #'cider-completion--parse-candidate-map candidates))) + +(defun cider-completion--get-candidate-type (symbol) + "Get candidate type for SYMBOL." + (let ((type (get-text-property 0 'type symbol))) + (or (cadr (assoc type cider-completion-annotations-alist)) + type))) + +(defun cider-completion--get-candidate-ns (symbol) + "Get candidate ns for SYMBOL." + (when (or (eq 'always cider-completion-annotations-include-ns) + (and (eq 'unqualified cider-completion-annotations-include-ns) + (not (cider-namespace-qualified-p symbol)))) + (get-text-property 0 'ns symbol))) + +(defun cider-default-annotate-completion-function (type ns) + "Get completion function based on TYPE and NS." + (concat (when ns (format " (%s)" ns)) + (when type (format " <%s>" type)))) + +(defun cider-annotate-symbol (symbol) + "Return a string suitable for annotating SYMBOL. +If SYMBOL has a text property `type` whose value is recognised, its +abbreviation according to `cider-completion-annotations-alist' will be +used. If `type` is present but not recognised, its value will be used +unaltered. If SYMBOL has a text property `ns`, then its value will be used +according to `cider-completion-annotations-include-ns'. The formatting is +performed by `cider-annotate-completion-function'." + (when cider-annotate-completion-candidates + (let* ((type (cider-completion--get-candidate-type symbol)) + (ns (cider-completion--get-candidate-ns symbol))) + (funcall cider-annotate-completion-function type ns)))) + +(defun cider-complete-at-point () + "Complete the symbol at point." + (when-let* ((bounds (bounds-of-thing-at-point 'symbol))) + (when (and (cider-connected-p) + (not (or (cider-in-string-p) (cider-in-comment-p)))) + (list (car bounds) (cdr bounds) + (completion-table-dynamic #'cider-complete) + :annotation-function #'cider-annotate-symbol + :company-doc-buffer #'cider-create-doc-buffer + :company-location #'cider-company-location + :company-docsig #'cider-company-docsig)))) + +(defun cider-completion-flush-caches () + "Force Compliment to refill its caches. +This command should be used if Compliment fails to pick up new classnames +and methods from dependencies that were loaded dynamically after the REPL +has started." + (interactive) + (cider-sync-request:complete-flush-caches)) + +(defun cider-company-location (var) + "Open VAR's definition in a buffer. +Returns the cons of the buffer itself and the location of VAR's definition +in the buffer." + (when-let* ((info (cider-var-info var)) + (file (nrepl-dict-get info "file")) + (line (nrepl-dict-get info "line")) + (buffer (cider-find-file file))) + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (forward-line (1- line)) + (cons buffer (point)))))) + +(defun cider-company-docsig (thing) + "Return signature for THING." + (let* ((eldoc-info (cider-eldoc-info thing)) + (ns (lax-plist-get eldoc-info "ns")) + (symbol (lax-plist-get eldoc-info "symbol")) + (arglists (lax-plist-get eldoc-info "arglists"))) + (when eldoc-info + (format "%s: %s" + (cider-eldoc-format-thing ns symbol thing + (cider-eldoc-thing-type eldoc-info)) + (cider-eldoc-format-arglist arglists 0))))) + +;; Fuzzy completion for company-mode + +(defun cider-company-unfiltered-candidates (string &rest _) + "Return CIDER completion candidates for STRING as is, unfiltered." + (cider-complete string)) + +(add-to-list 'completion-styles-alist + '(cider + cider-company-unfiltered-candidates + cider-company-unfiltered-candidates + "CIDER backend-driven completion style.")) + +(defun cider-company-enable-fuzzy-completion () + "Enable backend-driven fuzzy completion in the current buffer." + (setq-local completion-styles '(cider))) + +(provide 'cider-completion) +;;; cider-completion.el ends here diff --git a/elpa/cider-20190121.1852/cider-connection.el b/elpa/cider-20190121.1852/cider-connection.el new file mode 100644 index 00000000..a73ccc93 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-connection.el @@ -0,0 +1,866 @@ +;;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*- +;; +;; Copyright © 2019 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors +;; +;; Author: Artur Malabarba +;; Bozhidar Batsov +;; Vitalie Spinu +;; +;; Keywords: languages, clojure, cider +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;; This file is not part of GNU Emacs. +;; +;; +;;; Commentary: +;; +;; +;;; Code: + +(require 'nrepl-client) +(require 'cl-lib) +(require 'format-spec) +(require 'sesman) +(require 'sesman-browser) + +(defcustom cider-session-name-template "%J:%h:%p" + "Format string to use for session names. +See `cider-format-connection-params' for available format characters." + :type 'string + :group 'cider + :package-version '(cider . "0.18.0")) + +(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration + "The function to use to generate the message displayed on connect. +When set to nil no additional message will be displayed. A good +alternative to the default is `cider-random-tip'." + :type 'function + :group 'cider + :package-version '(cider . "0.11.0")) + +(defcustom cider-redirect-server-output-to-repl t + "Controls whether nREPL server output would be redirected to the REPL. +When non-nil the output would end up in both the nrepl-server buffer (when +available) and the matching REPL buffer." + :type 'boolean + :group 'cider + :safe #'booleanp + :package-version '(cider . "0.17.0")) + +(defcustom cider-auto-mode t + "When non-nil, automatically enable cider mode for all Clojure buffers." + :type 'boolean + :group 'cider + :safe #'booleanp + :package-version '(cider . "0.9.0")) + +(defconst cider-required-nrepl-version "0.4.4" + "The minimum nREPL version that's known to work properly with CIDER.") + + +;;; Connect + +(defun cider-nrepl-connect (params) + "Start nrepl client and create the REPL. +PARAMS is a plist containing :host, :port, :server and other parameters for +`cider-repl-create'." + (process-buffer + (nrepl-start-client-process + (plist-get params :host) + (plist-get params :port) + (plist-get params :server) + (lambda (_) + (cider-repl-create params))))) + +(defun cider-connected-p () + "Return t if CIDER is currently connected, nil otherwise." + (process-live-p (get-buffer-process (cider-current-repl)))) + +(defun cider-ensure-connected () + "Ensure there is a linked CIDER session." + (sesman-ensure-session 'CIDER)) + +(defun cider--session-server (session) + "Return server buffer for SESSION or nil if there is no server." + (seq-some (lambda (r) + (buffer-local-value 'nrepl-server-buffer r)) + (cdr session))) + +(defun cider--gather-session-params (session) + "Gather all params for a SESSION." + (let (params) + (dolist (repl (cdr session)) + (setq params (cider--gather-connect-params params repl))) + (when-let* ((server (cider--session-server session))) + (setq params (cider--gather-connect-params params server))) + params)) + +(defun cider--gather-connect-params (&optional params proc-buffer) + "Gather all relevant connection parameters into PARAMS plist. +PROC-BUFFER is either server or client buffer, defaults to current buffer." + (let ((proc-buffer (or proc-buffer (current-buffer)))) + (with-current-buffer proc-buffer + (unless nrepl-endpoint + (error "This is not a REPL or SERVER buffer; is there an active REPL?")) + (let ((server-buf (if (nrepl-server-p proc-buffer) + proc-buffer + nrepl-server-buffer))) + (cl-loop for l on nrepl-endpoint by #'cddr + do (setq params (plist-put params (car l) (cadr l)))) + (setq params (thread-first params + (plist-put :project-dir nrepl-project-dir))) + (when (buffer-live-p server-buf) + (setq params (thread-first params + (plist-put :server (get-buffer-process server-buf)) + (plist-put :server-command nrepl-server-command)))) + ;; repl-specific parameters (do not pollute server params!) + (unless (nrepl-server-p proc-buffer) + (setq params (thread-first params + (plist-put :session-name cider-session-name) + (plist-put :repl-type cider-repl-type) + (plist-put :cljs-repl-type cider-cljs-repl-type) + (plist-put :repl-init-function cider-repl-init-function)))) + params)))) + +(defun cider--close-buffer (buffer) + "Close the BUFFER and kill its associated process (if any)." + (when (buffer-live-p buffer) + (when-let* ((proc (get-buffer-process buffer))) + (when (process-live-p proc) + (delete-process proc))) + (kill-buffer buffer))) + +(declare-function cider-repl-emit-interactive-stderr "cider-repl") +(defun cider--close-connection (repl &optional no-kill) + "Close connection associated with REPL. +When NO-KILL is non-nil stop the connection but don't kill the REPL +buffer." + (when (buffer-live-p repl) + (with-current-buffer repl + (when spinner-current (spinner-stop)) + (when nrepl-tunnel-buffer + (cider--close-buffer nrepl-tunnel-buffer)) + (when no-kill + ;; inform sentinel not to kill the server, if any + (thread-first (get-buffer-process repl) + (process-plist) + (plist-put :keep-server t)))) + (let ((proc (get-buffer-process repl))) + (when (and (process-live-p proc) + (or (not nrepl-server-buffer) + ;; Sync request will hang if the server is dead. + (process-live-p (get-buffer-process nrepl-server-buffer)))) + (nrepl-sync-request:close repl) + (delete-process proc))) + (when-let* ((messages-buffer (and nrepl-log-messages + (nrepl-messages-buffer repl)))) + (kill-buffer messages-buffer)) + (unless no-kill + (kill-buffer repl))) + (when repl + (sesman-remove-object 'CIDER nil repl (not no-kill) t))) + +(defun cider-emit-manual-warning (section-id format &rest args) + "Emit a warning to the REPL and link to the online manual. +SECTION-ID is the section to link to. The link is added on the last line. +FORMAT is a format string to compile with ARGS and display on the REPL." + (let ((message (apply #'format format args))) + (cider-repl-emit-interactive-stderr + (concat "WARNING: " message "\n " + (cider--manual-button "More information" section-id) + ".")))) + +(defvar cider-version) +(defun cider--check-required-nrepl-version () + "Check whether we're using a compatible nREPL version." + (if-let* ((nrepl-version (cider--nrepl-version))) + (when (version< nrepl-version cider-required-nrepl-version) + (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" + "CIDER requires nREPL %s (or newer) to work properly" + cider-required-nrepl-version)) + (cider-emit-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212" + "Can't determine nREPL's version.\nPlease, update nREPL to %s." + cider-required-nrepl-version))) + +(defvar cider-minimum-clojure-version) +(defun cider--check-clojure-version-supported () + "Ensure that we are meeting the minimum supported version of Clojure." + (if-let* ((clojure-version (cider--clojure-version))) + (when (version< clojure-version cider-minimum-clojure-version) + (cider-emit-manual-warning "installation/#prerequisites" + "Clojure version (%s) is not supported (minimum %s). CIDER will not work." + clojure-version cider-minimum-clojure-version)) + (cider-emit-manual-warning "installation/#prerequisites" + "Can't determine Clojure's version. CIDER requires Clojure %s (or newer)." + cider-minimum-clojure-version))) + +(defvar cider-required-middleware-version) +(defun cider--check-middleware-compatibility () + "CIDER frontend/backend compatibility check. +Retrieve the underlying connection's CIDER-nREPL version and checks if the +middleware used is compatible with CIDER. If not, will display a warning +message in the REPL area." + (let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-repl))) + (middleware-version (nrepl-dict-get version-dict "version-string"))) + (cond + ((null middleware-version) + (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" + "CIDER requires cider-nrepl to be fully functional. Many things will not work without it!")) + ((version< middleware-version cider-required-middleware-version) + (cider-emit-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version" + "CIDER %s requires cider-nrepl %s+, but you're currently using cider-nrepl %s. Things will break!" + cider-version cider-required-middleware-version middleware-version))))) + +(declare-function cider-interactive-eval-handler "cider-eval") +;; TODO: Use some null handler here +(defun cider--subscribe-repl-to-server-out () + "Subscribe to the nREPL server's *out*." + (cider-nrepl-send-request '("op" "out-subscribe") + (cider-interactive-eval-handler (current-buffer)))) + +(declare-function cider-mode "cider-mode") +(defun cider-enable-on-existing-clojure-buffers () + "Enable CIDER's minor mode on existing Clojure buffers. +See command `cider-mode'." + (interactive) + (add-hook 'clojure-mode-hook #'cider-mode) + (dolist (buffer (cider-util--clojure-buffers)) + (with-current-buffer buffer + (cider-mode +1)))) + +(defun cider-disable-on-existing-clojure-buffers () + "Disable command `cider-mode' on existing Clojure buffers." + (interactive) + (dolist (buffer (cider-util--clojure-buffers)) + (with-current-buffer buffer + (cider-mode -1)))) + +(defun cider-possibly-disable-on-existing-clojure-buffers () + "If not connected, disable command `cider-mode' on existing Clojure buffers." + (unless (cider-connected-p) + (cider-disable-on-existing-clojure-buffers))) + +(declare-function cider--debug-init-connection "cider-debug") +(declare-function cider-repl-init "cider-repl") +(defun cider--connected-handler () + "Handle CIDER initialization after nREPL connection has been established. +This function is appended to `nrepl-connected-hook' in the client process +buffer." + ;; `nrepl-connected-hook' is run in the connection buffer + ;; `cider-enlighten-mode' changes eval to include the debugger, so we inhibit + ;; it here as the debugger isn't necessarily initialized yet + (let ((cider-enlighten-mode nil)) + ;; after initialization, set mode-line and buffer name. + (cider-set-repl-type cider-repl-type) + (cider-repl-init (current-buffer)) + (cider--check-required-nrepl-version) + (cider--check-clojure-version-supported) + (cider--check-middleware-compatibility) + (when cider-redirect-server-output-to-repl + (cider--subscribe-repl-to-server-out)) + (when cider-auto-mode + (cider-enable-on-existing-clojure-buffers)) + ;; Middleware on cider-nrepl's side is deferred until first usage, but + ;; loading middleware concurrently can lead to occasional "require" issues + ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards + ;; the end, allowing for the faster "server-out" middleware to load + ;; first. + (cider--debug-init-connection) + (when cider-repl-init-function + (funcall cider-repl-init-function)) + (run-hooks 'cider-connected-hook))) + +(defun cider--disconnected-handler () + "Cleanup after nREPL connection has been lost or closed. +This function is appended to `nrepl-disconnected-hook' in the client +process buffer." + ;; `nrepl-connected-hook' is run in the connection buffer + (cider-possibly-disable-on-existing-clojure-buffers) + (run-hooks 'cider-disconnected-hook)) + + +;;; Connection Info + +(defun cider--java-version () + "Retrieve the underlying connection's Java version." + (with-current-buffer (cider-current-repl) + (when nrepl-versions + (thread-first nrepl-versions + (nrepl-dict-get "java") + (nrepl-dict-get "version-string"))))) + +(defun cider--clojure-version () + "Retrieve the underlying connection's Clojure version." + (with-current-buffer (cider-current-repl) + (when nrepl-versions + (thread-first nrepl-versions + (nrepl-dict-get "clojure") + (nrepl-dict-get "version-string"))))) + +(defun cider--nrepl-version () + "Retrieve the underlying connection's nREPL version." + (with-current-buffer (cider-current-repl) + (when nrepl-versions + (thread-first nrepl-versions + (nrepl-dict-get "nrepl") + (nrepl-dict-get "version-string"))))) + +(defun cider--connection-info (connection-buffer &optional genericp) + "Return info about CONNECTION-BUFFER. +Info contains project name, current REPL namespace, host:port endpoint and +Clojure version. When GENERICP is non-nil, don't provide specific info +about this buffer (like variable `cider-repl-type')." + (with-current-buffer connection-buffer + (format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)" + (if genericp "" (upcase (concat (symbol-name cider-repl-type) " "))) + (or (cider--project-name nrepl-project-dir) "") + (plist-get nrepl-endpoint :host) + (plist-get nrepl-endpoint :port) + (cider--java-version) + (cider--clojure-version) + (cider--nrepl-version)))) + + +;;; Cider's Connection Management UI + +(defun cider-quit (&optional repl) + "Quit the CIDER connection associated with REPL. +REPL defaults to the current REPL." + (interactive) + (let ((repl (or repl + (sesman-browser-get 'object) + (cider-current-repl nil 'ensure)))) + (cider--close-connection repl)) + ;; if there are no more connections we can kill all ancillary buffers + (unless (cider-connected-p) + (cider-close-ancillary-buffers)) + ;; need this to refresh sesman browser + (run-hooks 'sesman-post-command-hook)) + +(defun cider-restart (&optional repl) + "Restart CIDER connection associated with REPL. +REPL defaults to the current REPL. Don't restart the server or other +connections within the same session. Use `sesman-restart' to restart the +entire session." + (interactive) + (let* ((repl (or repl + (sesman-browser-get 'object) + (cider-current-repl nil 'ensure))) + (params (thread-first () + (cider--gather-connect-params repl) + (plist-put :session-name (sesman-session-name-for-object 'CIDER repl)) + (plist-put :repl-buffer repl)))) + (cider--close-connection repl 'no-kill) + (cider-nrepl-connect params) + ;; need this to refresh sesman browser + (run-hooks 'sesman-post-command-hook))) + +(defun cider-close-ancillary-buffers () + "Close buffers that are shared across connections." + (interactive) + (dolist (buf-name cider-ancillary-buffers) + (when (get-buffer buf-name) + (kill-buffer buf-name)))) + +(defun cider-describe-connection (&optional repl) + "Display information about the connection associated with REPL. +REPL defaults to the current REPL." + (interactive) + (let ((repl (or repl + (sesman-browser-get 'object) + (cider-current-repl nil 'ensure)))) + (message "%s" (cider--connection-info repl)))) +(define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-connection "0.18.0") + +(defconst cider-nrepl-session-buffer "*cider-nrepl-session*") + +(defun cider-describe-nrepl-session () + "Describe an nREPL session." + (interactive) + (cider-ensure-connected) + (let* ((repl (cider-current-repl nil 'ensure)) + (selected-session (completing-read "Describe nREPL session: " (nrepl-sessions repl)))) + (when (and selected-session (not (equal selected-session ""))) + (let* ((session-info (nrepl-sync-request:describe repl)) + (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) + (session-id (nrepl-dict-get session-info "session")) + (session-type (cond + ((equal session-id (cider-nrepl-eval-session)) "Active eval") + ((equal session-id (cider-nrepl-tooling-session)) "Active tooling") + (t "Unknown")))) + (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer 'select nil 'ancillary) + (read-only-mode -1) + (insert (format "Session: %s\n" session-id) + (format "Type: %s session\n" session-type) + (format "Supported ops:\n")) + (mapc (lambda (op) (insert (format " * %s\n" op))) ops))) + (display-buffer cider-nrepl-session-buffer)))) + + +;;; Sesman's Session-Wise Management UI + +(cl-defmethod sesman-project ((_system (eql CIDER))) + (clojure-project-dir (cider-current-dir))) + +(cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2) + (sesman-more-recent-p (cdr session1) (cdr session2))) + +(cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session) + (setcdr session (seq-filter #'buffer-live-p (cdr session))) + (when-let* ((repl (cadr session)) + (proc (get-buffer-process repl)) + (file (file-truename (or (buffer-file-name) default-directory)))) + ;; With avfs paths look like /path/to/.avfs/path/to/some.jar#uzip/path/to/file.clj + (when (string-match-p "#uzip" file) + (let ((avfs-path (directory-file-name (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/"))))) + (setq file (replace-regexp-in-string avfs-path "" file t t)))) + (when (process-live-p proc) + (let* ((classpath (or (process-get proc :cached-classpath) + (let ((cp (with-current-buffer repl + (cider-sync-request:classpath)))) + (process-put proc :cached-classpath cp) + cp))) + (classpath-roots (or (process-get proc :cached-classpath-roots) + (let ((cp (thread-last classpath + (seq-filter (lambda (path) (not (string-match-p "\\.jar$" path)))) + (mapcar #'file-name-directory)))) + (process-put proc :cached-classpath-roots cp) + cp)))) + (or (seq-find (lambda (path) (string-prefix-p path file)) + classpath) + (seq-find (lambda (path) (string-prefix-p path file)) + classpath-roots)))))) + +(defvar cider-sesman-browser-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "j q") #'cider-quit) + (define-key map (kbd "j k") #'cider-quit) + (define-key map (kbd "j r") #'cider-restart) + (define-key map (kbd "j d") #'cider-describe-connection) + (define-key map (kbd "j i") #'cider-describe-connection) + (define-key map (kbd "C-c C-q") #'cider-quit) + (define-key map (kbd "C-c C-q") #'cider-quit) + (define-key map (kbd "C-c C-r") #'cider-restart) + (define-key map (kbd "C-c M-r") #'cider-restart) + (define-key map (kbd "C-c C-d") #'cider-describe-connection) + (define-key map (kbd "C-c M-d") #'cider-describe-connection) + (define-key map (kbd "C-c C-i") #'cider-describe-connection) + map) + "Map active on REPL objects in sesman browser.") + +(cl-defmethod sesman-session-info ((_system (eql CIDER)) session) + (interactive "P") + (list :objects (cdr session) + :map cider-sesman-browser-map)) + +(declare-function cider "cider") +(cl-defmethod sesman-start-session ((_system (eql CIDER))) + "Start a connection of any type interactively. +Fallback on `cider' command." + (call-interactively #'cider)) + +(cl-defmethod sesman-quit-session ((_system (eql CIDER)) session) + (mapc #'cider--close-connection (cdr session)) + ;; if there are no more connections we can kill all ancillary buffers + (unless (cider-connected-p) + (cider-close-ancillary-buffers))) + +(cl-defmethod sesman-restart-session ((_system (eql CIDER)) session) + (let* ((ses-name (car session)) + (repls (cdr session)) + (srv-buf (cider--session-server session))) + (if srv-buf + ;; session with a server + (let ((s-params (cider--gather-connect-params nil srv-buf))) + ;; 1) kill all connections, but keep the buffers + (mapc (lambda (conn) + (cider--close-connection conn 'no-kill)) + repls) + ;; 2) kill the server + (nrepl-kill-server-buffer srv-buf) + ;; 3) start server + (nrepl-start-server-process + (plist-get s-params :project-dir) + (plist-get s-params :server-command) + (lambda (server-buf) + ;; 4) restart the repls reusing the buffer + (dolist (r repls) + (cider-nrepl-connect + (thread-first () + (cider--gather-connect-params r) + ;; server params (:port, :project-dir etc) have precedence + (cider--gather-connect-params server-buf) + (plist-put :session-name ses-name) + (plist-put :repl-buffer r)))) + (sesman-browser-revert-all 'CIDER) + (message "Restarted CIDER %s session" ses-name)))) + ;; server-less session + (dolist (r repls) + (cider--close-connection r 'no-kill) + (cider-nrepl-connect + (thread-first () + (cider--gather-connect-params r) + (plist-put :session-name ses-name) + (plist-put :repl-buffer r))))))) + +(defun cider-format-connection-params (template params) + "Format PARAMS with TEMPLATE string. +The following formats can be used in TEMPLATE string: + + %h - host + %H - remote host, empty for local hosts + %p - port + %j - short project name, or directory name if no project + %J - long project name including parent dir name + %r - REPL type (clj or cljs) + %S - type of the ClojureScript runtime (Nashorn, Node, Figwheel etc.) + %s - session name as defined by `cider-session-name-template'. + +In case some values are empty, extra separators (: and -) are automatically +removed." + (let* ((dir (directory-file-name + (abbreviate-file-name + (or (plist-get params :project-dir) + (clojure-project-dir (cider-current-dir)) + default-directory)))) + (short-proj (file-name-nondirectory (directory-file-name dir))) + (parent-dir (ignore-errors + (thread-first dir file-name-directory + directory-file-name file-name-nondirectory + file-name-as-directory))) + (long-proj (format "%s%s" (or parent-dir "") short-proj)) + ;; use `dir` if it is shorter than `long-proj` or `short-proj` + (short-proj (if (>= (length short-proj) (length dir)) + dir + short-proj)) + (long-proj (if (>= (length long-proj) (length dir)) + dir + long-proj)) + (port (or (plist-get params :port) "")) + (host (or (plist-get params :host) "localhost")) + (remote-host (if (member host '("localhost" "127.0.0.1")) + "" + host)) + (repl-type (or (plist-get params :repl-type) "unknown")) + (cljs-repl-type (or (and (eq repl-type 'cljs) + (plist-get params :cljs-repl-type)) + "")) + (specs `((?h . ,host) + (?H . ,remote-host) + (?p . ,port) + (?j . ,short-proj) + (?J . ,long-proj) + (?r . ,repl-type) + (?S . ,cljs-repl-type))) + (ses-name (or (plist-get params :session-name) + (format-spec cider-session-name-template specs))) + (specs (append `((?s . ,ses-name)) specs))) + (thread-last (format-spec template specs) + ;; remove extraneous separators + (replace-regexp-in-string "\\([:-]\\)[:-]+" "\\1") + (replace-regexp-in-string "\\(^[:-]\\)\\|\\([:-]$\\)" "") + (replace-regexp-in-string "[:-]\\([])*]\\)" "\\1")))) + +(defun cider-make-session-name (params) + "Create new session name given plist of connection PARAMS. +Session name can be customized with `cider-session-name-template'." + (let* ((root-name (cider-format-connection-params cider-session-name-template params)) + (other-names (mapcar #'car (sesman-sessions 'CIDER))) + (name root-name) + (i 2)) + (while (member name other-names) + (setq name (concat root-name "#" (number-to-string i)) + i (+ i 1))) + name)) + + +;;; REPL Buffer Init + +(defvar-local cider-cljs-repl-type nil + "The type of the ClojureScript runtime (Nashorn, Node etc.)") + +(defvar-local cider-repl-type nil + "The type of this REPL buffer, usually either clj or cljs.") + +(defun cider-repl-type (repl-buffer) + "Get REPL-BUFFER's type." + (buffer-local-value 'cider-repl-type repl-buffer)) + +(defun cider-repl-type-for-buffer (&optional buffer) + "Return the matching connection type (clj or cljs) for BUFFER. +BUFFER defaults to the `current-buffer'. In cljc buffers return +multi. This function infers connection type based on the major mode. +For the REPL type use the function `cider-repl-type'." + (with-current-buffer (or buffer (current-buffer)) + (cond + ((derived-mode-p 'clojurescript-mode) 'cljs) + ((derived-mode-p 'clojurec-mode) 'multi) + ((derived-mode-p 'clojure-mode) 'clj) + (cider-repl-type)))) + +(defun cider-set-repl-type (&optional type) + "Set REPL TYPE to clj or cljs. +Assume that the current buffer is a REPL." + (interactive) + (let ((type (cider-maybe-intern (or type (completing-read + (format "Set REPL type (currently `%s') to: " + cider-repl-type) + '(clj cljs)))))) + (when (or (not (equal cider-repl-type type)) + (null mode-name)) + (setq cider-repl-type type) + (setq mode-name (format "REPL[%s]" type)) + (let ((params (cider--gather-connect-params))) + ;; We need to set current name to something else temporarily to avoid + ;; false name duplication in `nrepl-repl-buffer-name`. + (rename-buffer (generate-new-buffer-name "*dummy-cider-repl-buffer*")) + (rename-buffer (nrepl-repl-buffer-name params)) + (when (and nrepl-log-messages nrepl-messages-buffer) + (with-current-buffer nrepl-messages-buffer + (rename-buffer (nrepl-messages-buffer-name params)))))))) + +(defun cider--choose-reusable-repl-buffer (params) + "Find connection-less REPL buffer and ask the user for confirmation. +Return nil if no such buffers exists or the user has chosen not to reuse +the buffer. If multiple dead REPLs exist, ask the user to choose one. +PARAMS is a plist as received by `cider-repl-create'." + (when-let* ((repls (seq-filter (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'cider-repl-mode) + (not (process-live-p (get-buffer-process b)))))) + (buffer-list)))) + (let* ((proj-dir (plist-get params :project-dir)) + (host (plist-get params :host)) + (port (plist-get params :port)) + (cljsp (member (plist-get params :repl-type) '(cljs pending-cljs))) + (scored-repls + (delq nil + (mapcar (lambda (b) + (let ((bparams (cider--gather-connect-params nil b))) + (when (eq cljsp (member (plist-get bparams :repl-type) + '(cljs pending-cljs))) + (cons (buffer-name b) + (+ + (if (equal proj-dir (plist-get bparams :project-dir)) 8 0) + (if (equal host (plist-get bparams :host)) 4 0) + (if (equal port (plist-get bparams :port)) 2 0)))))) + repls)))) + (when scored-repls + (if (> (length scored-repls) 1) + (when (y-or-n-p "Dead REPLs exist. Reuse? ") + (let ((sorted-repls (seq-sort (lambda (a b) (> (cdr a) (cdr b))) scored-repls))) + (get-buffer (completing-read "REPL to reuse: " + (mapcar #'car sorted-repls) nil t nil nil (caar sorted-repls))))) + (when (y-or-n-p (format "A dead REPL %s exists. Reuse? " (caar scored-repls))) + (get-buffer (caar scored-repls)))))))) + +(declare-function cider-default-err-handler "cider-eval") +(declare-function cider-repl-mode "cider-repl") +(declare-function cider-repl--state-handler "cider-repl") +(declare-function cider-repl-reset-markers "cider-repl") +(defvar-local cider-session-name nil) +(defvar-local cider-repl-init-function nil) +(defun cider-repl-create (params) + "Create new repl buffer. +PARAMS is a plist which contains :repl-type, :host, :port, :project-dir, +:repl-init-function and :session-name. When non-nil, :repl-init-function +must be a function with no arguments which is called after repl creation +function with the repl buffer set as current." + ;; Connection might not have been set as yet. Please don't send requests in + ;; this function, but use cider--connected-handler instead. + (let ((buffer (or (plist-get params :repl-buffer) + (cider--choose-reusable-repl-buffer params) + (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*")))) + (ses-name (or (plist-get params :session-name) + (cider-make-session-name params)))) + (with-current-buffer buffer + (setq-local sesman-system 'CIDER) + (setq-local default-directory (or (plist-get params :project-dir) default-directory)) + ;; creates a new session if session with ses-name doesn't already exist + (sesman-add-object 'CIDER ses-name buffer 'allow-new) + (unless (derived-mode-p 'cider-repl-mode) + (cider-repl-mode)) + (setq nrepl-err-handler #'cider-default-err-handler + ;; used as a new-repl marker in cider-set-repl-type + mode-name nil + cider-session-name ses-name + nrepl-project-dir (plist-get params :project-dir) + ;; REPLs start with clj and then "upgrade" to a different type + cider-repl-type (plist-get params :repl-type) + ;; ran at the end of cider--connected-handler + cider-repl-init-function (plist-get params :repl-init-function)) + (cider-repl-reset-markers) + (add-hook 'nrepl-response-handler-functions #'cider-repl--state-handler nil 'local) + (add-hook 'nrepl-connected-hook #'cider--connected-handler nil 'local) + (add-hook 'nrepl-disconnected-hook #'cider--disconnected-handler nil 'local) + (current-buffer)))) + + +;;; Current/other REPLs + +(defun cider--no-repls-user-error (type) + "Throw \"No REPL\" user error customized for TYPE." + (let ((type (cond + ((or (eq type 'multi) (eq type 'any)) + "clj or cljs") + ((listp type) + (mapconcat #'identity type " or ")) + (type)))) + (user-error "No %s REPLs in current session \"%s\"" + type (car (sesman-current-session 'CIDER))))) + +(defun cider-current-repl (&optional type ensure) + "Get the most recent REPL of TYPE from the current session. +TYPE is either clj, cljs, multi or any. +When nil, infer the type from the current buffer. +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." + (let ((type (cider-maybe-intern type))) + (if (and (derived-mode-p 'cider-repl-mode) + (or (null type) + (eq 'any type) + (eq 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) (eq type 'multi) (eq type 'any)) 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 ((type (cond + ((listp type) + (mapcar #'cider-maybe-intern type)) + ((cider-maybe-intern type)))) + (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 (eq cur-type 'cljs) + (user-error "Clojure-only operation requested in a ClojureScript buffer"))) + (:cljs-strict (when (eq 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 (eq cur-type 'multi) + '(clj cljs) + cur-type)))) + (ensure (cl-case which + (:auto nil) + (t 'ensure))) + (repls (cider-repls type ensure))) + (mapcar function repls)))) + +;; REPLs double as connections in CIDER, so it's useful to be able to refer to +;; them as connections in certain contexts. +(defalias 'cider-current-connection #'cider-current-repl) +(defalias 'cider-connections #'cider-repls) +(defalias 'cider-map-connections #'cider-map-repls) +(defalias 'cider-connection-type-for-buffer #'cider-repl-type-for-buffer) + + +;; Deprecation after #2324 + +(define-obsolete-function-alias 'cider-current-repl-buffer 'cider-current-repl "0.18") +(define-obsolete-function-alias 'cider-repl-buffers 'cider-repls "0.18") +(define-obsolete-function-alias 'cider-current-session 'cider-nrepl-eval-session "0.18") +(define-obsolete-function-alias 'cider-current-tooling-session 'cider-nrepl-tooling-session "0.18") +(define-obsolete-function-alias 'cider-display-connection-info 'cider-describe-connection "0.18") +(define-obsolete-function-alias 'nrepl-connection-buffer-name 'nrepl-repl-buffer-name "0.18") +(define-obsolete-function-alias 'cider-repl-set-type 'cider-set-repl-type "0.18") + +(make-obsolete 'cider-assoc-buffer-with-connection 'sesman-link-with-buffer "0.18") +(make-obsolete 'cider-assoc-project-with-connection 'sesman-link-with-project "0.18") +(make-obsolete 'cider-change-buffers-designation nil "0.18") +(make-obsolete 'cider-clear-buffer-local-connection nil "0.18") +(make-obsolete 'cider-close-nrepl-session 'cider-quit "0.18") +(make-obsolete 'cider-create-sibling-cljs-repl 'cider-connect-sibling-cljs "0.18") +(make-obsolete 'cider-current-messages-buffer nil "0.18") +(make-obsolete 'cider-default-connection "see sesman." "0.18") +(make-obsolete 'cider-extract-designation-from-current-repl-buffer nil "0.18") +(make-obsolete 'cider-find-connection-buffer-for-project-directory 'sesman-current-sessions "0.18") +(make-obsolete 'cider-find-reusable-repl-buffer nil "0.18") +(make-obsolete 'cider-make-connection-default "see sesman." "0.18") +(make-obsolete 'cider-other-connection nil "0.18") +(make-obsolete 'cider-project-connections 'sesman-current-sessions "0.18") +(make-obsolete 'cider-project-connections-types nil "0.18") +(make-obsolete 'cider-prompt-for-project-on-connect nil "0.18") +(make-obsolete 'cider-read-connection `sesman-ask-for-session "0.18") +(make-obsolete 'cider-replicate-connection nil "0.18") +(make-obsolete 'cider-request-dispatch "see sesman." "0.18") +(make-obsolete 'cider-rotate-default-connection "see sesman." "0.18") +(make-obsolete 'cider-toggle-buffer-connection nil "0.18") +(make-obsolete 'cider-toggle-request-dispatch nil "0.18") +(make-obsolete 'nrepl-connection-buffer-name-template 'nrepl-repl-buffer-name-template "0.18") +(make-obsolete 'nrepl-create-client-buffer-function nil "0.18") +(make-obsolete 'nrepl-post-client-callback nil "0.18") +(make-obsolete 'nrepl-prompt-to-kill-server-buffer-on-quit nil "0.18") +(make-obsolete 'nrepl-use-this-as-repl-buffer nil "0.18") + +;; connection manager +(make-obsolete 'cider-client-name-repl-type "see sesman." "0.18") +(make-obsolete 'cider-connection-browser "see sesman." "0.18") +(make-obsolete 'cider-connections-buffer-mode "see sesman." "0.18") +(make-obsolete 'cider-connections-buffer-mode-map "see sesman." "0.18") +(make-obsolete 'cider-connections-close-connection "see sesman." "0.18") +(make-obsolete 'cider-connections-goto-connection "see sesman." "0.18") +(make-obsolete 'cider-connections-make-default "see sesman." "0.18") +(make-obsolete 'cider-display-connected-message "see sesman." "0.18") +(make-obsolete 'cider-project-name "see sesman." "0.18") + +(provide 'cider-connection) + +;;; cider-connection.el ends here diff --git a/elpa/cider-20190121.1852/cider-debug.el b/elpa/cider-20190121.1852/cider-debug.el new file mode 100644 index 00000000..ba517482 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-debug.el @@ -0,0 +1,748 @@ +;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*- + +;; Copyright © 2015-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Instrument code with `cider-debug-defun-at-point', and when the code is +;; executed cider-debug will kick in. See this function's doc for more +;; information. + +;;; Code: + +(require 'nrepl-dict) +(require 'nrepl-client) ; `nrepl--mark-id-completed' +(require 'cider-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")) + +(make-obsolete 'cider-debug-print-length 'cider-debug-print-options "0.20") +(make-obsolete 'cider-debug-print-level 'cider-debug-print-options "0.20") + +(defcustom cider-debug-print-options '(dict "length" 10 "level" 10) + "The print options for values displayed by the debugger. +This variable must be set before starting the repl connection." + :type 'listp + :group 'cider-stacktrace + :package-version '(cider . "0.20.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-options + `("print-options" ,cider-debug-print-options))) + #'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") + (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" (cider-debug-mode-send-reply ":continue") :keys "c"] + ["Continue non-stop" (cider-debug-mode-send-reply ":Continue") :keys "C"] + ["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"] + ["Quit" (cider-debug-mode-send-reply ":quit") :keys "q"] + "--" + ["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 + (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/elpa/cider-20190121.1852/cider-doc.el b/elpa/cider-20190121.1852/cider-doc.el new file mode 100644 index 00000000..df3e97d1 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-doc.el @@ -0,0 +1,533 @@ +;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- + +;; Copyright © 2014-2019 Bozhidar Batsov, Jeff Valk and CIDER contributors + +;; Author: Jeff Valk + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Mode for formatting and presenting documentation + +;;; Code: + +(require 'cider-common) +(require '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 "") #'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/elpa/cider-20190121.1852/cider-eldoc.el b/elpa/cider-20190121.1852/cider-eldoc.el new file mode 100644 index 00000000..c8c0e969 --- /dev/null +++ b/elpa/cider-20190121.1852/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-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; eldoc support for Clojure. + +;;; Code: + +(require 'cider-client) +(require 'cider-common) ; for cider-symbol-at-point +(require '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/elpa/cider-20190121.1852/cider-eval.el b/elpa/cider-20190121.1852/cider-eval.el new file mode 100644 index 00000000..58b2a572 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-eval.el @@ -0,0 +1,1117 @@ +;;; cider-eval.el --- Interactive evaluation (compilation) functionality -*- lexical-binding: t -*- + +;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; This file contains CIDER's interactive evaluation (compilation) functionality. +;; Although Clojure doesn't really have the concept of evaluation (only +;; compilation), we're using everywhere in the code the term evaluation for +;; brevity (and to be in line with the naming employed by other similar modes). +;; +;; This files also contains all the logic related to displaying errors and +;; evaluation warnings. +;; +;; Pretty much all of the commands here are meant to be used mostly from +;; `cider-mode', but some of them might make sense in other contexts as well. + +;;; Code: + +(require 'cider-client) +(require 'cider-repl) +(require 'cider-popup) +(require 'cider-common) +(require 'cider-util) +(require 'cider-stacktrace) +(require 'cider-overlays) +(require 'cider-compat) + +(require 'clojure-mode) +(require 'ansi-color) +(require 'cl-lib) +(require 'subr-x) +(require 'compile) + +(defconst cider-read-eval-buffer "*cider-read-eval*") +(defconst cider-result-buffer "*cider-result*") + +(defcustom cider-show-error-buffer t + "Control the popup behavior of cider stacktraces. +The following values are possible t or 'always, 'except-in-repl, +'only-in-repl. Any other value, including nil, will cause the stacktrace +not to be automatically shown. + +Irespective of the value of this variable, the `cider-error-buffer' is +always generated in the background. Use `cider-selector' to +navigate to this buffer." + :type '(choice (const :tag "always" t) + (const except-in-repl) + (const only-in-repl) + (const :tag "never" nil)) + :group 'cider) + +(defcustom cider-auto-jump-to-error t + "Control the cursor jump behaviour in compilation error buffer. +When non-nil automatically jump to error location during interactive +compilation. When set to 'errors-only, don't jump to warnings. +When set to nil, don't jump at all." + :type '(choice (const :tag "always" t) + (const errors-only) + (const :tag "never" nil)) + :group 'cider + :package-version '(cider . "0.7.0")) + +(defcustom cider-auto-select-error-buffer t + "Controls whether to auto-select the error popup buffer." + :type 'boolean + :group 'cider) + +(defcustom cider-auto-track-ns-form-changes t + "Controls whether to auto-evaluate a source buffer's ns form when changed. +When non-nil CIDER will check for ns form changes before each eval command. +When nil the users are expected to take care of the re-evaluating updated +ns forms manually themselves." + :type 'boolean + :group 'cider + :package-version '(cider . "0.15.0")) + +(defcustom cider-save-file-on-load 'prompt + "Controls whether to prompt to save the file when loading a buffer. +If nil, files are not saved. +If 'prompt, the user is prompted to save the file if it's been modified. +If t, save the file without confirmation." + :type '(choice (const prompt :tag "Prompt to save the file if it's been modified") + (const nil :tag "Don't save the file") + (const t :tag "Save the file without confirmation")) + :group 'cider + :package-version '(cider . "0.6.0")) + + +(defconst cider-output-buffer "*cider-out*") + +(defcustom cider-interactive-eval-output-destination 'repl-buffer + "The destination for stdout and stderr produced from interactive evaluation." + :type '(choice (const output-buffer) + (const repl-buffer)) + :group 'cider + :package-version '(cider . "0.7.0")) + +(defface cider-error-highlight-face + '((((supports :underline (:style wave))) + (:underline (:style wave :color "red") :inherit unspecified)) + (t (:inherit font-lock-warning-face :underline t))) + "Face used to highlight compilation errors in Clojure buffers." + :group 'cider) + +(defface cider-warning-highlight-face + '((((supports :underline (:style wave))) + (:underline (:style wave :color "yellow") :inherit unspecified)) + (t (:inherit font-lock-warning-face :underline (:color "yellow")))) + "Face used to highlight compilation warnings in Clojure buffers." + :group 'cider) + +(defcustom cider-comment-prefix ";; => " + "The prefix to insert before the first line of commented output." + :type 'string + :group 'cider + :package-version '(cider . "0.16.0")) + +(defcustom cider-comment-continued-prefix ";; " + "The prefix to use on the second and subsequent lines of commented output." + :type 'string + :group 'cider + :package-version '(cider . "0.16.0")) + +(defcustom cider-comment-postfix "" + "The postfix to be appended after the final line of commented output." + :type 'string + :group 'cider + :package-version '(cider . "0.16.0")) + + +;;; Utilities + +(defun cider--clear-compilation-highlights () + "Remove compilation highlights." + (remove-overlays (point-min) (point-max) 'cider-note-p t)) + +(defun cider-clear-compilation-highlights (&optional arg) + "Remove compilation highlights. +When invoked with a prefix ARG the command doesn't prompt for confirmation." + (interactive "P") + (when (or arg (y-or-n-p "Are you sure you want to clear the compilation highlights? ")) + (cider--clear-compilation-highlights))) + +(defun cider--quit-error-window () + "Buries the `cider-error-buffer' and quits its containing window." + (when-let* ((error-win (get-buffer-window cider-error-buffer))) + (save-excursion + (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-options + `("print-options" ,cider-stacktrace-print-options))) + (lambda (response) + ;; While the return value of `cider--handle-stacktrace-response' is not + ;; meaningful for the last message, we do not need the value of `causes' + ;; after it has been handled, so it's fine to set it unconditionally here + (setq causes (cider--handle-stacktrace-response response causes)))))) + +(defun cider-default-err-handler () + "This function determines how the error buffer is shown. +It delegates the actual error content to the eval or op handler." + (if (cider-nrepl-op-supported-p "stacktrace") + (cider-default-err-op-handler) + (cider-default-err-eval-handler))) + +(defvar cider-compilation-regexp + '("\\(?:.*\\(warning, \\)\\|.*?\\(, compiling\\):(\\)\\(.*?\\):\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\(\\(?: - \\(.*\\)\\)\\|)\\)" 3 4 5 (1)) + "Specifications for matching errors and warnings in Clojure stacktraces. +See `compilation-error-regexp-alist' for help on their format.") + +(add-to-list 'compilation-error-regexp-alist-alist + (cons 'cider cider-compilation-regexp)) +(add-to-list 'compilation-error-regexp-alist 'cider) + +(defun cider-extract-error-info (regexp message) + "Extract error information with REGEXP against MESSAGE." + (let ((file (nth 1 regexp)) + (line (nth 2 regexp)) + (col (nth 3 regexp)) + (type (nth 4 regexp)) + (pat (car regexp))) + (when (string-match pat message) + ;; special processing for type (1.2) style + (setq type (if (consp type) + (or (and (car type) (match-end (car type)) 1) + (and (cdr type) (match-end (cdr type)) 0) + 2))) + (list + (when file + (let ((val (match-string-no-properties file message))) + (unless (string= val "NO_SOURCE_PATH") val))) + (when line (string-to-number (match-string-no-properties line message))) + (when col + (let ((val (match-string-no-properties col message))) + (when val (string-to-number val)))) + (aref [cider-warning-highlight-face + cider-warning-highlight-face + cider-error-highlight-face] + (or type 2)) + message)))) + +(defun cider--goto-expression-start () + "Go to the beginning a list, vector, map or set outside of a string. +We do so by starting and the current position and proceeding backwards +until we find a delimiters that's not inside a string." + (if (and (looking-back "[])}]" (line-beginning-position)) + (null (nth 3 (syntax-ppss)))) + (backward-sexp) + (while (or (not (looking-at-p "[({[]")) + (nth 3 (syntax-ppss))) + (backward-char)))) + +(defun cider--find-last-error-location (message) + "Return the location (begin end buffer) from the Clojure error MESSAGE. +If location could not be found, return nil." + (save-excursion + (let ((info (cider-extract-error-info cider-compilation-regexp message))) + (when info + (let ((file (nth 0 info)) + (line (nth 1 info)) + (col (nth 2 info))) + (unless (or (not (stringp file)) + (cider--tooling-file-p file)) + (when-let* ((buffer (cider-find-file file))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line)) + (move-to-column (or col 0)) + (let ((begin (progn (if col (cider--goto-expression-start) (back-to-indentation)) + (point))) + (end (progn (if col (forward-list) (move-end-of-line nil)) + (point)))) + (list begin end buffer)))))))))))) + +(defun cider-handle-compilation-errors (message eval-buffer) + "Highlight and jump to compilation error extracted from MESSAGE. +EVAL-BUFFER is the buffer that was current during user's interactive +evaluation command. Honor `cider-auto-jump-to-error'." + (when-let* ((loc (cider--find-last-error-location message)) + (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc))) + (info (cider-extract-error-info cider-compilation-regexp message))) + (let* ((face (nth 3 info)) + (note (nth 4 info)) + (auto-jump (if (eq cider-auto-jump-to-error 'errors-only) + (not (or (eq face 'cider-warning-highlight-face) + (string-match-p "warning" note))) + cider-auto-jump-to-error))) + (overlay-put overlay 'cider-note-p t) + (overlay-put overlay 'font-lock-face face) + (overlay-put overlay 'cider-note note) + (overlay-put overlay 'help-echo note) + (overlay-put overlay 'modification-hooks + (list (lambda (o &rest _args) (delete-overlay o)))) + (when auto-jump + (with-current-buffer eval-buffer + (push-mark) + ;; At this stage selected window commonly is *cider-error* and we need to + ;; re-select the original user window. If eval-buffer is not + ;; visible it was probably covered as a result of a small screen or user + ;; configuration (https://github.com/clojure-emacs/cider/issues/847). In + ;; that case we don't jump at all in order to avoid covering *cider-error* + ;; buffer. + (when-let* ((win (get-buffer-window eval-buffer))) + (with-selected-window win + (cider-jump-to (nth 2 loc) (car loc))))))))) + + +;;; Interactive evaluation handlers +(defun cider-insert-eval-handler (&optional buffer) + "Make an nREPL evaluation handler for the BUFFER. +The handler simply inserts the result value in BUFFER." + (let ((eval-buffer (current-buffer))) + (nrepl-make-response-handler (or buffer eval-buffer) + (lambda (_buffer value) + (with-current-buffer buffer + (insert value))) + (lambda (_buffer out) + (cider-repl-emit-interactive-stdout out)) + (lambda (_buffer err) + (cider-handle-compilation-errors err eval-buffer)) + '()))) + +(defun cider--emit-interactive-eval-output (output repl-emit-function) + "Emit output resulting from interactive code evaluation. +The OUTPUT can be sent to either a dedicated output buffer or the current +REPL buffer. This is controlled by `cider-interactive-eval-output-destination'. +REPL-EMIT-FUNCTION emits the OUTPUT." + (pcase cider-interactive-eval-output-destination + (`output-buffer (let ((output-buffer (or (get-buffer cider-output-buffer) + (cider-popup-buffer cider-output-buffer t)))) + (cider-emit-into-popup-buffer output-buffer output) + (pop-to-buffer output-buffer))) + (`repl-buffer (funcall repl-emit-function output)) + (_ (error "Unsupported value %s for `cider-interactive-eval-output-destination'" + cider-interactive-eval-output-destination)))) + +(defun cider-emit-interactive-eval-output (output) + "Emit OUTPUT resulting from interactive code evaluation. +The output can be send to either a dedicated output buffer or the current +REPL buffer. This is controlled via +`cider-interactive-eval-output-destination'." + (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stdout)) + +(defun cider-emit-interactive-eval-err-output (output) + "Emit err OUTPUT resulting from interactive code evaluation. +The output can be send to either a dedicated output buffer or the current +REPL buffer. This is controlled via +`cider-interactive-eval-output-destination'." + (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stderr)) + +(defun cider--make-fringe-overlays-for-region (beg end) + "Place eval indicators on all sexps between BEG and END." + (with-current-buffer (if (markerp end) + (marker-buffer end) + (current-buffer)) + (save-excursion + (goto-char beg) + (remove-overlays beg end 'category 'cider-fringe-indicator) + (condition-case nil + (while (progn (clojure-forward-logical-sexp) + (and (<= (point) end) + (not (eobp)))) + (cider--make-fringe-overlay (point))) + (scan-error nil))))) + +(defun cider-interactive-eval-handler (&optional buffer place) + "Make an interactive eval handler for BUFFER. +PLACE is used to display the evaluation result. +If non-nil, it can be the position where the evaluated sexp ends, +or it can be a list with (START END) of the evaluated region." + (let* ((eval-buffer (current-buffer)) + (beg (car-safe place)) + (end (or (car-safe (cdr-safe place)) place)) + (beg (when beg (copy-marker beg))) + (end (when end (copy-marker end))) + (fringed nil)) + (nrepl-make-response-handler (or buffer eval-buffer) + (lambda (_buffer value) + (if beg + (unless fringed + (cider--make-fringe-overlays-for-region beg end) + (setq fringed t)) + (cider--make-fringe-overlay end)) + (cider--display-interactive-eval-result value end)) + (lambda (_buffer out) + (cider-emit-interactive-eval-output out)) + (lambda (_buffer err) + (cider-emit-interactive-eval-err-output err) + (cider-handle-compilation-errors err eval-buffer)) + '()))) + +(defun cider-load-file-handler (&optional buffer) + "Make a load file handler for BUFFER." + (let ((eval-buffer (current-buffer))) + (nrepl-make-response-handler (or buffer eval-buffer) + (lambda (buffer value) + (cider--display-interactive-eval-result value) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (cider--make-fringe-overlays-for-region (point-min) (point-max)) + (run-hooks 'cider-file-loaded-hook)))) + (lambda (_buffer value) + (cider-emit-interactive-eval-output value)) + (lambda (_buffer err) + (cider-emit-interactive-eval-err-output err) + (cider-handle-compilation-errors err eval-buffer)) + '() + (lambda () + (funcall nrepl-err-handler))))) + +(defun cider-eval-print-handler (&optional buffer) + "Make a handler for evaluating and printing result in BUFFER." + (nrepl-make-response-handler (or buffer (current-buffer)) + (lambda (buffer value) + (with-current-buffer buffer + (insert + (if (derived-mode-p 'cider-clojure-interaction-mode) + (format "\n%s\n" value) + value)))) + (lambda (_buffer out) + (cider-emit-interactive-eval-output out)) + (lambda (_buffer err) + (cider-emit-interactive-eval-err-output err)) + '())) + +(defun cider-eval-print-with-comment-handler (buffer location comment-prefix) + "Make a handler for evaluating and printing commented results in BUFFER. +LOCATION is the location at which to insert. COMMENT-PREFIX is the comment +prefix to use." + (nrepl-make-response-handler buffer + (lambda (buffer value) + (with-current-buffer buffer + (save-excursion + (goto-char location) + (insert (concat comment-prefix + value "\n"))))) + (lambda (_buffer out) + (cider-emit-interactive-eval-output out)) + (lambda (_buffer err) + (cider-emit-interactive-eval-err-output err)) + '())) + +(defun cider-eval-pprint-with-multiline-comment-handler (buffer location comment-prefix continued-prefix comment-postfix) + "Make a handler for evaluating and inserting results in BUFFER. +The inserted text is pretty-printed and region will be commented. +LOCATION is the location at which to insert. +COMMENT-PREFIX is the comment prefix for the first line of output. +CONTINUED-PREFIX is the comment prefix to use for the remaining lines. +COMMENT-POSTFIX is the text to output after the last line." + (cl-flet ((multiline-comment-handler (buffer value) + (with-current-buffer buffer + (save-excursion + (goto-char location) + (let ((lines (split-string value "[\n]+" t))) + ;; only the first line gets the normal comment-prefix + (insert (concat comment-prefix (pop lines))) + (dolist (elem lines) + (insert (concat "\n" continued-prefix elem))) + (unless (string= comment-postfix "") + (insert comment-postfix))))))) + (nrepl-make-response-handler buffer + '() + #'multiline-comment-handler + #'multiline-comment-handler + '()))) + +(defun cider-popup-eval-handler (&optional buffer) + "Make a handler for printing evaluation results in popup BUFFER. +This is used by pretty-printing commands." + (nrepl-make-response-handler (or buffer (current-buffer)) + (lambda (buffer value) + (cider-emit-into-popup-buffer buffer + (ansi-color-apply value) + nil + t)) + (lambda (_buffer out) + (cider-emit-interactive-eval-output out)) + (lambda (_buffer err) + (cider-emit-interactive-eval-err-output err)) + '())) + + +;;; 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 (&optional pretty-print) + "Evaluate the expression preceding point. +Print its value into the current buffer. +With an optional PRETTY-PRINT prefix it pretty-prints the result." + (interactive "P") + (cider-interactive-eval nil + (cider-eval-print-handler) + (cider-last-sexp 'bounds) + (when pretty-print + (cider--nrepl-pprint-request-plist (cider--pretty-print-width))))) + +(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-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[cs]?$"))) + +(defalias 'cider-eval-file 'cider-load-file + "A convenience alias as some people are confused by the load-* names.") + +(defalias 'cider-eval-all-files 'cider-load-all-files + "A convenience alias as some people are confused by the load-* names.") + +(defalias 'cider-eval-buffer 'cider-load-buffer + "A convenience alias as some people are confused by the load-* names.") + +(defun cider-load-all-project-ns () + "Load all namespaces in the current project." + (interactive) + (cider-ensure-connected) + (cider-ensure-op-supported "ns-load-all") + (when (y-or-n-p "Are you sure you want to load all namespaces in the project? ") + (message "Loading all project namespaces...") + (let ((loaded-ns-count (length (cider-sync-request:ns-load-all)))) + (message "Loaded %d namespaces" loaded-ns-count)))) + +(provide 'cider-eval) + +;;; cider-eval.el ends here diff --git a/elpa/cider-20190121.1852/cider-find.el b/elpa/cider-20190121.1852/cider-find.el new file mode 100644 index 00000000..e1a90cdd --- /dev/null +++ b/elpa/cider-20190121.1852/cider-find.el @@ -0,0 +1,231 @@ +;;; cider-find.el --- Functionality for finding things -*- lexical-binding: t -*- + +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A bunch of commands for finding resources and definitions. + +;;; Code: + +(require 'cider-client) +(require 'cider-common) + +(require 'thingatpt) + +(defun cider--find-var-other-window (var &optional line) + "Find the definition of VAR, optionally at a specific LINE. + +Display the results in a different window." + (if-let* ((info (cider-var-info var))) + (progn + (if line (setq info (nrepl-dict-put info "line" line))) + (cider--jump-to-loc-from-info info t)) + (user-error "Symbol `%s' not resolved" var))) + +(defun cider--find-var (var &optional line) + "Find the definition of VAR, optionally at a specific LINE." + (if-let* ((info (cider-var-info var))) + (progn + (if line (setq info (nrepl-dict-put info "line" line))) + (cider--jump-to-loc-from-info info)) + (user-error "Symbol `%s' not resolved" var))) + +;;;###autoload +(defun cider-find-var (&optional arg var line) + "Find definition for VAR at LINE. +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point." + (interactive "P") + (cider-ensure-op-supported "info") + (if var + (cider--find-var var line) + (funcall (cider-prompt-for-symbol-function arg) + "Symbol" + (if (cider--open-other-window-p arg) + #'cider--find-var-other-window + #'cider--find-var)))) + +;;;###autoload +(defun cider-find-dwim-at-mouse (event) + "Find and display variable or resource at mouse EVENT." + (interactive "e") + (cider-ensure-op-supported "info") + (if-let* ((symbol-file (save-excursion + (mouse-set-point event) + (cider-symbol-at-point 'look-back)))) + (cider-find-dwim symbol-file) + (user-error "No variable or resource here"))) + +(defun cider--find-dwim (symbol-file callback &optional other-window) + "Find the SYMBOL-FILE at point. +CALLBACK upon failure to invoke prompt if not prompted previously. +Show results in a different window if OTHER-WINDOW is true." + (if-let* ((info (cider-var-info symbol-file))) + (cider--jump-to-loc-from-info info other-window) + (progn + (cider-ensure-op-supported "resource") + (if-let* ((resource (cider-sync-request:resource symbol-file)) + (buffer (cider-find-file resource))) + (cider-jump-to buffer 0 other-window) + (if (cider--prompt-for-symbol-p current-prefix-arg) + (error "Resource or var %s not resolved" symbol-file) + (let ((current-prefix-arg (if current-prefix-arg nil '(4)))) + (call-interactively callback))))))) + +(defun cider--find-dwim-interactive (prompt) + "Get interactive arguments for jump-to functions using PROMPT as needed." + (if (cider--prompt-for-symbol-p current-prefix-arg) + (list + (cider-read-from-minibuffer prompt (thing-at-point 'filename))) + (list (or (thing-at-point 'filename) "")))) ; No prompt. + +(defun cider-find-dwim-other-window (symbol-file) + "Jump to SYMBOL-FILE at point, place results in other window." + (interactive (cider--find-dwim-interactive "Jump to: ")) + (cider--find-dwim symbol-file 'cider-find-dwim-other-window t)) + +;;;###autoload +(defun cider-find-dwim (symbol-file) + "Find and display the SYMBOL-FILE at point. +SYMBOL-FILE could be a var or a resource. If thing at point is empty then +show dired on project. If var is not found, try to jump to resource of the +same name. When called interactively, a prompt is given according to the +variable `cider-prompt-for-symbol'. A single or double prefix argument +inverts the meaning. A prefix of `-' or a double prefix argument causes +the results to be displayed in a different window. A default value of thing +at point is given when prompted." + (interactive (cider--find-dwim-interactive "Jump to: ")) + (cider--find-dwim symbol-file `cider-find-dwim + (cider--open-other-window-p current-prefix-arg))) + +;;;###autoload +(defun cider-find-resource (path) + "Find the resource at PATH. +Prompt for input as indicated by the variable `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix +argument causes the results to be displayed in other window. The default +value is thing at point." + (interactive + (list + (if (cider--prompt-for-symbol-p current-prefix-arg) + (completing-read "Resource: " + (cider-sync-request:resources-list) + nil nil + (thing-at-point 'filename)) + (or (thing-at-point 'filename) "")))) + (cider-ensure-op-supported "resource") + (when (= (length path) 0) + (error "Cannot find resource for empty path")) + (if-let* ((resource (cider-sync-request:resource path)) + (buffer (cider-find-file resource))) + (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg)) + (if (cider--prompt-for-symbol-p current-prefix-arg) + (error "Cannot find resource %s" path) + (let ((current-prefix-arg (cider--invert-prefix-arg current-prefix-arg))) + (call-interactively 'cider-find-resource))))) + +(defun cider--invert-prefix-arg (arg) + "Invert the effect of prefix value ARG on `cider-prompt-for-symbol'. +This function preserves the `other-window' meaning of ARG." + (let ((narg (prefix-numeric-value arg))) + (pcase narg + (16 -1) ; empty empty -> - + (-1 16) ; - -> empty empty + (4 nil) ; empty -> no-prefix + (_ 4)))) ; no-prefix -> empty + +(defun cider--prefix-invert-prompt-p (arg) + "Test prefix value ARG for its effect on `cider-prompt-for-symbol`." + (let ((narg (prefix-numeric-value arg))) + (pcase narg + (16 t) ; empty empty + (4 t) ; empty + (_ nil)))) + +(defun cider--prompt-for-symbol-p (&optional prefix) + "Check if cider should prompt for symbol. +Tests againsts PREFIX and the value of `cider-prompt-for-symbol'. +Invert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be." + (if (cider--prefix-invert-prompt-p prefix) + (not cider-prompt-for-symbol) cider-prompt-for-symbol)) + +(defun cider--find-ns (ns &optional other-window) + "Find the file containing NS's definition. +Optionally open it in a different window if OTHER-WINDOW is truthy." + (if-let* ((path (cider-sync-request:ns-path ns))) + (cider-jump-to (cider-find-file path) nil other-window) + (user-error "Can't find namespace `%s'" ns))) + +;;;###autoload +(defun cider-find-ns (&optional arg ns) + "Find the file containing NS. +A prefix ARG of `-` or a double prefix argument causes +the results to be displayed in a different window." + (interactive "P") + (cider-ensure-connected) + (cider-ensure-op-supported "ns-path") + (if ns + (cider--find-ns ns) + (let* ((namespaces (cider-sync-request:ns-list)) + (ns (completing-read "Find namespace: " namespaces))) + (cider--find-ns ns (cider--open-other-window-p arg))))) + +;;;###autoload +(defun cider-find-keyword (&optional arg) + "Find the namespace of the keyword at point and its first occurrence there. + +For instance - if the keyword at point is \":cider.demo/keyword\", this command +would find the namespace \"cider.demo\" and afterwards find the first mention +of \"::keyword\" there. + +Prompt according to prefix ARG and `cider-prompt-for-symbol'. +A single or double prefix argument inverts the meaning of +`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes +the results to be displayed in a different window. The default value is +thing at point." + (interactive "P") + (cider-ensure-connected) + (let* ((kw (let ((kw-at-point (cider-symbol-at-point 'look-back))) + (if (or cider-prompt-for-symbol arg) + (read-string + (format "Keyword (default %s): " kw-at-point) + nil nil kw-at-point) + kw-at-point))) + (ns-qualifier (and + (string-match "^:+\\(.+\\)/.+$" kw) + (match-string 1 kw))) + (kw-ns (if ns-qualifier + (cider-resolve-alias (cider-current-ns) ns-qualifier) + (cider-current-ns))) + (kw-to-find (concat "::" (replace-regexp-in-string "^:+\\(.+/\\)?" "" kw)))) + + (when (and ns-qualifier (string= kw-ns (cider-current-ns))) + (error "Could not resolve alias `%s' in `%s'" ns-qualifier (cider-current-ns))) + (cider--find-ns kw-ns arg) + (search-forward-regexp kw-to-find nil 'noerror))) + +(provide 'cider-find) +;;; cider-find.el ends here diff --git a/elpa/cider-20190121.1852/cider-format.el b/elpa/cider-20190121.1852/cider-format.el new file mode 100644 index 00000000..2cf9d09d --- /dev/null +++ b/elpa/cider-20190121.1852/cider-format.el @@ -0,0 +1,150 @@ +;;; cider-format.el --- Code and EDN formatting functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Middleware-powered code and EDN formatting functionality. + +;;; Code: + +(require 'subr-x) + +(require 'cider-client) +(require 'cider-util) + + +;; Format + +(defun cider--format-reindent (formatted start) + "Reindent FORMATTED to align with buffer position START." + (let* ((start-column (save-excursion (goto-char start) (current-column))) + (indent-line (concat "\n" (make-string start-column ? )))) + (replace-regexp-in-string "\n" indent-line formatted))) + + +;;; Format region + +(defun cider--format-region (start end formatter) + "Format the contents of the given region. + +START and END represent the region's boundaries. + +FORMATTER is a function of one argument which is used to convert +the string contents of the region into a formatted string. + +Uses the following heuristic to try to maintain point position: + +- Take a snippet of text starting at current position, up to 64 chars. +- Search for the snippet, with lax whitespace, in the formatted text. + - If snippet is less than 64 chars (point was near end of buffer), search + from end instead of beginning. +- Place point at match beginning, or `point-min' if no match." + (let* ((original (buffer-substring-no-properties start end)) + (formatted (funcall formatter original)) + (indented (cider--format-reindent formatted start))) + (unless (equal original indented) + (let* ((pos (point)) + (pos-max (1+ (buffer-size))) + (l 64) + (endp (> (+ pos l) pos-max)) + (snippet (thread-last (buffer-substring-no-properties + pos (min (+ pos l) pos-max)) + (regexp-quote) + (replace-regexp-in-string "[[:space:]\t\n\r]+" "[[:space:]\t\n\r]*")))) + (delete-region start end) + (insert indented) + (goto-char (if endp (point-max) (point-min))) + (funcall (if endp #'re-search-backward #'re-search-forward) snippet nil t) + (goto-char (or (match-beginning 0) start)) + (when (looking-at-p "\n") (forward-char)))))) + +;;;###autoload +(defun cider-format-region (start end) + "Format the Clojure code in the current region. +START and END represent the region's boundaries." + (interactive "r") + (cider-ensure-connected) + (cider--format-region start end #'cider-sync-request:format-code)) + + +;;; Format defun + +;;;###autoload +(defun cider-format-defun () + "Format the code in the current defun." + (interactive) + (cider-ensure-connected) + (let ((defun-bounds (cider-defun-at-point 't))) + (cider-format-region (car defun-bounds) (cadr defun-bounds)))) + + +;;; Format buffer + +(defun cider--format-buffer (formatter) + "Format the contents of the current buffer. + +Uses FORMATTER, a function of one argument, to convert the string contents +of the buffer into a formatted string." + (cider--format-region 1 (1+ (buffer-size)) formatter)) + +;;;###autoload +(defun cider-format-buffer () + "Format the Clojure code in the current buffer." + (interactive) + (check-parens) + (cider-ensure-connected) + (cider--format-buffer #'cider-sync-request:format-code)) + + +;;; Format EDN + +(declare-function cider--pretty-print-width "cider-repl") + +;;;###autoload +(defun cider-format-edn-buffer () + "Format the EDN data in the current buffer." + (interactive) + (check-parens) + (cider-ensure-connected) + (cider--format-buffer (lambda (edn) + (cider-sync-request:format-edn edn (cider--pretty-print-width))))) + +;;;###autoload +(defun cider-format-edn-region (start end) + "Format the EDN data in the current region. +START and END represent the region's boundaries." + (interactive "r") + (cider-ensure-connected) + (let* ((start-column (save-excursion (goto-char start) (current-column))) + (right-margin (- (cider--pretty-print-width) start-column))) + (cider--format-region start end + (lambda (edn) + (cider-sync-request:format-edn edn right-margin))))) + +;;;###autoload +(defun cider-format-edn-last-sexp () + "Format the EDN data of the last sexp." + (interactive) + (apply 'cider-format-edn-region (cider-sexp-at-point 'bounds))) + +(provide 'cider-format) +;;; cider-format.el ends here diff --git a/elpa/cider-20190121.1852/cider-grimoire.el b/elpa/cider-20190121.1852/cider-grimoire.el new file mode 100644 index 00000000..93424883 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-grimoire.el @@ -0,0 +1,130 @@ +;;; cider-grimoire.el --- Grimoire integration -*- lexical-binding: t -*- + +;; Copyright © 2014-2019 Bozhidar Batsov and CIDER contributors +;; +;; Author: Bozhidar Batsov + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A few commands for Grimoire documentation lookup. + +;;; Code: + +(require 'cider-client) +(require 'cider-common) +(require '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/elpa/cider-20190121.1852/cider-inspector.el b/elpa/cider-20190121.1852/cider-inspector.el new file mode 100644 index 00000000..c8c71f10 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-inspector.el @@ -0,0 +1,402 @@ +;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*- + +;; Copyright © 2013-2019 Vital Reactor, LLC +;; Copyright © 2014-2019 Bozhidar Batsov and CIDER contributors + +;; Author: Ian Eslick +;; Bozhidar Batsov + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Clojure object inspector inspired by SLIME. + +;;; Code: + +(require 'cl-lib) +(require 'seq) +(require 'cider-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) + (visual-line-mode 1)) + +;;;###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.") + +(defvar cider-inspector--current-repl nil + "Contains the reference to the REPL where inspector was last invoked from. +This is needed for internal inspector buffer operations (push, +pop) to execute against the correct REPL session.") + +;; Operations +;;;###autoload +(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))) + (setq cider-inspector--current-repl (cider-current-repl)) + (when-let* ((value (cider-sync-request:inspect-expr expr ns (or cider-inspector-page-size 32)))) + (cider-inspector--render-value value))) + +(defun cider-inspector-pop () + "Pop the last value off the inspector stack and render it. +See `cider-sync-request:inspect-pop' and `cider-inspector--render-value'." + (interactive) + (setq cider-inspector-last-command 'cider-inspector-pop) + (when-let* ((value (cider-sync-request:inspect-pop))) + (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 cider-inspector--current-repl) + (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 cider-inspector--current-repl) + (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 cider-inspector--current-repl) + (nrepl-dict-get "value"))) + +(defun cider-sync-request:inspect-next-page () + "Jump to the next page in paginated collection view." + (thread-first '("op" "inspect-next-page") + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) + +(defun cider-sync-request:inspect-prev-page () + "Jump to the previous page in paginated collection view." + (thread-first '("op" "inspect-prev-page") + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) + +(defun cider-sync-request:inspect-set-page-size (page-size) + "Set the page size in paginated view to PAGE-SIZE." + (thread-first `("op" "inspect-set-page-size" + "page-size" ,page-size) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) + +(defun cider-sync-request:inspect-expr (expr ns page-size) + "Evaluate EXPR in context of NS and inspect its result. +Set the page size in paginated view to PAGE-SIZE." + (thread-first (append (nrepl--eval-request expr ns) + `("inspect" "true" + "page-size" ,page-size)) + (cider-nrepl-send-sync-request cider-inspector--current-repl) + (nrepl-dict-get "value"))) + +;; Render Inspector from Structured Values +(defun cider-inspector--render-value (value) + "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/elpa/cider-20190121.1852/cider-macroexpansion.el b/elpa/cider-20190121.1852/cider-macroexpansion.el new file mode 100644 index 00000000..7efe1c08 --- /dev/null +++ b/elpa/cider-20190121.1852/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-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Macro expansion support. + +;;; Code: + +(require 'cider-mode) +(require '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/elpa/cider-20190121.1852/cider-mode.el b/elpa/cider-20190121.1852/cider-mode.el new file mode 100644 index 00000000..8c5c4dd9 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-mode.el @@ -0,0 +1,1048 @@ +;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*- + +;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Minor mode for REPL interactions. + +;;; Code: + +(require 'clojure-mode) +(require 'cider-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 + (symbol-name cider-repl-type) + (when cider-mode-line-show-connection + (format ":%s@%s:%s" + (or (cider--project-name nrepl-project-dir) "") + (pcase (car nrepl-endpoint) + ("localhost" "") + (x x)) + (cadr nrepl-endpoint))))) + "not connected")) + +;;;###autoload +(defcustom cider-mode-line + '(:eval (format " cider[%s]" (cider--modeline-info))) + "Mode line lighter for cider mode. + +The value of this variable is a mode line template as in +`mode-line-format'. See Info Node `(elisp)Mode Line Format' for details +about mode line templates. + +Customize this variable to change how cider mode displays its status in the +mode line. The default value displays the current connection. Set this +variable to nil to disable the mode line entirely." + :group 'cider + :type 'sexp + :risky t + :package-version '(cider "0.7.0")) + + +;;; Switching between REPL & source buffers + +(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 (eq type 'multi) + (eq 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 and . + +As it stands Emacs fires these events on and on 'x' and +'w32'systems while on macOS it presents them on and .") + +(defconst cider-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-d") 'cider-doc-map) + (define-key map (kbd "M-.") #'cider-find-var) + (define-key map (kbd (if cider--has-many-mouse-buttons "" "")) #'xref-pop-marker-stack) + (define-key map (kbd (if cider--has-many-mouse-buttons "" "")) #'cider-find-dwim-at-mouse) + (define-key map (kbd "C-c C-.") #'cider-find-ns) + (define-key map (kbd "C-c C-:") #'cider-find-keyword) + (define-key map (kbd "M-,") #'cider-pop-back) + (define-key map (kbd "C-c M-.") #'cider-find-resource) + (define-key map (kbd "M-TAB") #'complete-symbol) + (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 +(with-eval-after-load 'clojure-mode + (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map + "Menu for Clojure mode. + This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." + `("CIDER" :visible (not cider-mode) + ["Start a Clojure REPL" cider-jack-in-clj + :help "Starts an nREPL server and connects a Clojure REPL to it."] + ["Connect to a Clojure REPL" cider-connect-clj + :help "Connects to a REPL that's already running."] + ["Start a ClojureScript REPL" cider-jack-in-cljs + :help "Starts an nREPL server and connects a ClojureScript REPL to it."] + ["Connect to a ClojureScript REPL" cider-connect-cljs + :help "Connects to a ClojureScript REPL that's already running."] + ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clj&cljs + :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] + "--" + ["View manual online" cider-view-manual]))) + +;;; Dynamic indentation +(defcustom cider-dynamic-indentation t + "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-keyword-face'. + `function': Any defined function gets the `font-lock-function-face'. + `var': Any non-local var gets the `font-lock-variable-name-face'. + `deprecated' (default): Any deprecated var gets the `cider-deprecated-face' + face. + `core' (default): Any symbol from clojure.core (face depends on type). + +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 + (lambda (repl) + (symbol-name (cider-repl-type repl))) + (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/elpa/cider-20190121.1852/cider-ns.el b/elpa/cider-20190121.1852/cider-ns.el new file mode 100644 index 00000000..227e803c --- /dev/null +++ b/elpa/cider-20190121.1852/cider-ns.el @@ -0,0 +1,265 @@ +;;; cider-ns.el --- Namespace manipulation functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Smart code refresh functionality based on ideas from: +;; http://thinkrelevance.com/blog/2013/06/04/clojure-workflow-reloaded +;; +;; Note that refresh with clojure.tools.namespace.repl is a smarter way to +;; reload code: the traditional way to reload Clojure code without restarting +;; the JVM is (require ... :reload) or an editor/IDE feature that does the same +;; thing. +;; +;; This has several problems: +;; +;; If you modify two namespaces which depend on each other, you must remember to +;; reload them in the correct order to avoid compilation errors. +;; +;; If you remove definitions from a source file and then reload it, those +;; definitions are still available in memory. If other code depends on those +;; definitions, it will continue to work but will break the next time you +;; restart the JVM. +;; +;; If the reloaded namespace contains defmulti, you must also reload all of the +;; associated defmethod expressions. +;; +;; If the reloaded namespace contains defprotocol, you must also reload any +;; records or types implementing that protocol and replace any existing +;; instances of those records/types with new instances. +;; +;; If the reloaded namespace contains macros, you must also reload any +;; namespaces which use those macros. +;; +;; If the running program contains functions which close over values in the +;; reloaded namespace, those closed-over values are not updated (This is common +;; in web applications which construct the "handler stack" as a composition of +;; functions.) + +;;; Code: + +(require 'subr-x) + +(require 'cider-client) +(require 'cider-popup) +(require 'cider-stacktrace) + +(define-obsolete-variable-alias 'cider-save-files-on-cider-ns-refresh 'cider-ns-save-files-on-refresh "0.18") +(defcustom cider-ns-save-files-on-refresh 'prompt + "Controls whether to prompt to save Clojure files on `cider-ns-refresh'. +If nil, files are not saved. +If 'prompt, the user is prompted to save files if they have been modified. +If t, save the files without confirmation." + :type '(choice (const prompt :tag "Prompt to save files if they have been modified") + (const nil :tag "Don't save the files") + (const t :tag "Save the files without confirmation")) + :group 'cider + :package-version '(cider . "0.15.0")) + +(defconst cider-ns-refresh-log-buffer "*cider-ns-refresh-log*") + +(define-obsolete-variable-alias 'cider-refresh-show-log-buffer 'cider-ns-refresh-show-log-buffer "0.18") +(defcustom cider-ns-refresh-show-log-buffer nil + "Controls when to display the refresh log buffer. +If non-nil, the log buffer will be displayed every time `cider-ns-refresh' is +called. If nil, the log buffer will still be written to, but will never be +displayed automatically. Instead, the most relevant information will be +displayed in the echo area." + :type '(choice (const :tag "always" t) + (const :tag "never" nil)) + :group 'cider + :package-version '(cider . "0.10.0")) + +(define-obsolete-variable-alias 'cider-refresh-before-fn 'cider-ns-refresh-before-fn "0.18") +(defcustom cider-ns-refresh-before-fn nil + "Clojure function for `cider-ns-refresh' to call before reloading. +If nil, nothing will be invoked before reloading. Must be a +namespace-qualified function of zero arity. Any thrown exception will +prevent reloading from occurring." + :type 'string + :group 'cider + :package-version '(cider . "0.10.0")) + +(define-obsolete-variable-alias 'cider-refresh-after-fn 'cider-ns-refresh-after-fn "0.18") +(defcustom cider-ns-refresh-after-fn nil + "Clojure function for `cider-ns-refresh' to call after reloading. +If nil, nothing will be invoked after reloading. Must be a +namespace-qualified function of zero arity." + :type 'string + :group 'cider + :package-version '(cider . "0.10.0")) + +(defun cider-ns-refresh--handle-response (response log-buffer) + "Refresh LOG-BUFFER with RESPONSE." + (nrepl-dbind-response response (out err reloading status error error-ns after before) + (cl-flet* ((log (message &optional face) + (cider-emit-into-popup-buffer log-buffer message face t)) + + (log-echo (message &optional face) + (log message face) + (unless cider-ns-refresh-show-log-buffer + (let ((message-truncate-lines t)) + (message "cider-ns-refresh: %s" message))))) + (cond + (out + (log out)) + + (err + (log err 'font-lock-warning-face)) + + ((member "invoking-before" status) + (log-echo (format "Calling %s\n" before) 'font-lock-string-face)) + + ((member "invoked-before" status) + (log-echo (format "Successfully called %s\n" before) 'font-lock-string-face)) + + ((member "invoked-not-resolved" status) + (log-echo "Could not resolve refresh function\n" 'font-lock-string-face)) + + (reloading + (log-echo (format "Reloading %s\n" reloading) 'font-lock-string-face)) + + ((member "reloading" (nrepl-dict-keys response)) + (log-echo "Nothing to reload\n" 'font-lock-string-face)) + + ((member "ok" status) + (log-echo "Reloading successful\n" 'font-lock-string-face)) + + (error-ns + (log-echo (format "Error reloading %s\n" error-ns) 'font-lock-warning-face)) + + ((member "invoking-after" status) + (log-echo (format "Calling %s\n" after) 'font-lock-string-face)) + + ((member "invoked-after" status) + (log-echo (format "Successfully called %s\n" after) 'font-lock-string-face)))) + + (with-selected-window (or (get-buffer-window cider-ns-refresh-log-buffer) + (selected-window)) + (with-current-buffer cider-ns-refresh-log-buffer + (goto-char (point-max)))) + + (when (member "error" status) + (cider--render-stacktrace-causes error)))) + +(defun cider-ns-refresh--save-project-buffers () + "Ensure modified project buffers are saved before certain operations. +Its behavior is controlled by `cider-save-files-on-cider-ns-refresh'." + (when-let* ((project-root (clojure-project-dir))) + (when cider-save-files-on-cider-ns-refresh + (save-some-buffers + (eq cider-save-files-on-cider-ns-refresh t) + (lambda () + (and + (derived-mode-p 'clojure-mode) + (string-prefix-p project-root + (file-truename default-directory) + (eq system-type 'windows-nt)))))))) + +;;;###autoload +(defun cider-ns-reload (&optional prompt) + "Send a (require 'ns :reload) to the REPL. + +With an argument PROMPT, it prompts for a namespace name. This is the +Clojure out of the box reloading experience and does not rely on +org.clojure/tools.namespace. See Commentary of this file for a longer list +of differences. From the Clojure doc: \":reload forces loading of all the +identified libs even if they are already loaded\"." + (interactive "P") + (let ((ns (if prompt + (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns))) + (clojure-find-ns)))) + (cider-interactive-eval (format "(require '%s :reload)" ns)))) + +;;;###autoload +(defun cider-ns-reload-all (&optional prompt) + "Send a (require 'ns :reload-all) to the REPL. + +With an argument PROMPT, it prompts for a namespace name. This is the +Clojure out of the box reloading experience and does not rely on +org.clojure/tools.namespace. See Commentary of this file for a longer list +of differences. From the Clojure doc: \":reload-all implies :reload and +also forces loading of all libs that the identified libs directly or +indirectly load via require\"." + (interactive "P") + (let ((ns (if prompt + (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (clojure-find-ns))) + (clojure-find-ns)))) + (cider-interactive-eval (format "(require '%s :reload-all)" ns)))) + +;;;###autoload +(defun cider-ns-refresh (&optional mode) + "Reload modified and unloaded namespaces on the classpath. + +With a single prefix argument, or if MODE is `refresh-all', reload all +namespaces on the classpath unconditionally. + +With a double prefix argument, or if MODE is `clear', clear the state of +the namespace tracker before reloading. This is useful for recovering from +some classes of error (for example, those caused by circular dependencies) +that a normal reload would not otherwise recover from. The trade-off of +clearing is that stale code from any deleted files may not be completely +unloaded. + +With a negative prefix argument, or if MODE is `inhibit-fns', prevent any +refresh functions (defined in `cider-ns-refresh-before-fn' and +`cider-ns-refresh-after-fn') from being invoked." + (interactive "p") + (cider-ensure-connected) + (cider-ensure-op-supported "refresh") + (cider-ns-refresh--save-project-buffers) + (let ((clear? (member mode '(clear 16))) + (refresh-all? (member mode '(refresh-all 4))) + (inhibit-refresh-fns (member mode '(inhibit-fns -1)))) + (cider-map-repls :clj + (lambda (conn) + ;; Inside the lambda, so the buffer is not created if we error out. + (let ((log-buffer (or (get-buffer cider-ns-refresh-log-buffer) + (cider-make-popup-buffer cider-ns-refresh-log-buffer)))) + (when cider-ns-refresh-show-log-buffer + (cider-popup-buffer-display log-buffer)) + (when inhibit-refresh-fns + (cider-emit-into-popup-buffer log-buffer + "inhibiting refresh functions\n" + nil + t)) + (when clear? + (cider-nrepl-send-sync-request '("op" "refresh-clear") conn)) + (cider-nrepl-send-request + (nconc `("op" ,(if refresh-all? "refresh-all" "refresh")) + (when (cider--pprint-fn) + `("pprint-fn" ,(cider--pprint-fn))) + (when cider-stacktrace-print-options + `("print-options" ,cider-stacktrace-print-options)) + (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn) + `("before" ,cider-ns-refresh-before-fn)) + (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn) + `("after" ,cider-ns-refresh-after-fn))) + (lambda (response) + (cider-ns-refresh--handle-response response log-buffer)) + conn)))))) + +;;;###autoload +(define-obsolete-function-alias 'cider-refresh 'cider-ns-refresh "0.18") + +(provide 'cider-ns) +;;; cider-ns.el ends here diff --git a/elpa/cider-20190121.1852/cider-overlays.el b/elpa/cider-20190121.1852/cider-overlays.el new file mode 100644 index 00000000..5be7f00f --- /dev/null +++ b/elpa/cider-20190121.1852/cider-overlays.el @@ -0,0 +1,311 @@ +;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*- + +;; Copyright © 2015-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Use `cider--make-overlay' to place a generic overlay at point. Or use +;; `cider--make-result-overlay' to place an interactive eval result overlay at +;; the end of a specified line. + +;;; Code: + +(require 'cider-common) +(require '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/elpa/cider-20190121.1852/cider-pkg.el b/elpa/cider-20190121.1852/cider-pkg.el new file mode 100644 index 00000000..c4558ff3 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-pkg.el @@ -0,0 +1,23 @@ +(define-package "cider" "20190121.1852" "Clojure Interactive Development Environment that Rocks" + '((emacs "25") + (clojure-mode "5.9") + (pkg-info "0.4") + (queue "0.2") + (spinner "1.7") + (seq "2.16") + (sesman "0.3.2")) + :keywords + '("languages" "clojure" "cider") + :authors + '(("Tim King" . "kingtim@gmail.com") + ("Phil Hagelberg" . "technomancy@gmail.com") + ("Bozhidar Batsov" . "bozhidar@batsov.com") + ("Artur Malabarba" . "bruce.connor.am@gmail.com") + ("Hugo Duncan" . "hugo@hugoduncan.org") + ("Steve Purcell" . "steve@sanityinc.com")) + :maintainer + '("Bozhidar Batsov" . "bozhidar@batsov.com") + :url "http://www.github.com/clojure-emacs/cider") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/cider-20190121.1852/cider-popup.el b/elpa/cider-20190121.1852/cider-popup.el new file mode 100644 index 00000000..4f8fae4d --- /dev/null +++ b/elpa/cider-20190121.1852/cider-popup.el @@ -0,0 +1,137 @@ +;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- + +;; Copyright © 2015-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Common functionality for dealing with popup buffers. + +;;; Code: + +(require '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/elpa/cider-20190121.1852/cider-profile.el b/elpa/cider-20190121.1852/cider-profile.el new file mode 100644 index 00000000..d4e9b408 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-profile.el @@ -0,0 +1,208 @@ +;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*- + +;; Copyright © 2014-2019 Edwin Watkeys and CIDER contributors + +;; Author: Edwin Watkeys +;; Juan E. Maya + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Provides coarse-grained interactive profiling support. +;; Based on earlier work by Edwin Watkeys (https://github.com/thunknyc/nrepl-profile). + +;;; Code: + +(require 'cider-client) +(require 'cider-popup) +(require 'cider-eval) + +(defconst cider-profile-buffer "*cider-profile*") + +(defvar cider-profile-map + (let ((map (define-prefix-command 'cider-profile-map))) + (define-key map (kbd "t") #'cider-profile-toggle) + (define-key map (kbd "c") #'cider-profile-clear) + (define-key map (kbd "S") #'cider-profile-summary) + (define-key map (kbd "s") #'cider-profile-var-summary) + (define-key map (kbd "n") #'cider-profile-ns-toggle) + (define-key map (kbd "v") #'cider-profile-var-profiled-p) + (define-key map (kbd "+") #'cider-profile-samples) + map) + "CIDER profiler keymap.") + +(defconst cider-profile-menu + '("Profile" + ["Toggle var profiling" cider-profile-toggle] + ["Toggle namespace profiling" cider-profile-ns-toggle] + "--" + ["Display var profiling status" cider-profile-var-profiled-p] + ["Display max sample count" cider-profile-samples] + ["Display summary" cider-profile-summary] + ["Clear data" cider-profile-clear]) + "CIDER profiling submenu.") + +(defun cider-profile--make-response-handler (handler &optional buffer) + "Make a response handler using value handler HANDLER for connection BUFFER. + +Optional argument BUFFER defaults to current buffer." + (nrepl-make-response-handler + (or buffer (current-buffer)) handler nil nil nil)) + +;;;###autoload +(defun cider-profile-samples (&optional query) + "Displays current max-sample-count. +If optional QUERY is specified, set max-sample-count and display new value." + (interactive "P") + (cider-ensure-op-supported "set-max-samples") + (cider-ensure-op-supported "get-max-samples") + (if (not (null query)) + (cider-nrepl-send-request + (let ((max-samples (if (numberp query) query '()))) + (message "query: %s" max-samples) + `("op" "set-max-samples" "max-samples" ,max-samples)) + (cider-profile--make-response-handler + (lambda (_buffer value) + (let ((value (if (zerop (length value)) "unlimited" value))) + (message "max-sample-count is now %s" value))))) + (cider-nrepl-send-request + '("op" "get-max-samples") + (cider-profile--make-response-handler + (lambda (_buffer value) + (let ((value (if (zerop (length value)) "unlimited" value))) + (message "max-sample-count is now %s" value)))))) + query) + +;;;###autoload +(defun cider-profile-var-profiled-p (query) + "Displays the profiling status of var under point. +Prompts for var if none under point or QUERY is present." + (interactive "P") + (cider-ensure-op-supported "is-var-profiled") + (cider-read-symbol-name + "Report profiling status for var: " + (lambda (sym) + (let ((ns (cider-current-ns))) + (cider-nrepl-send-request + `("op" "is-var-profiled" + "ns" ,ns + "sym" ,sym) + (cider-profile--make-response-handler + (lambda (_buffer value) + (pcase value + ("profiled" (message "Profiling is currently enabled for %s/%s" ns sym)) + ("unprofiled" (message "Profiling is currently disabled for %s/%s" ns sym)) + ("unbound" (message "%s/%s is unbound" ns sym))))))))) + query) + +;;;###autoload +(defun cider-profile-ns-toggle (&optional query) + "Toggle profiling for the ns associated with optional QUERY. + +If optional argument QUERY is non-nil, prompt for ns. Otherwise use +current ns." + (interactive "P") + (cider-ensure-op-supported "toggle-profile-ns") + (let ((ns (if query + (completing-read "Toggle profiling for ns: " + (cider-sync-request:ns-list)) + (cider-current-ns)))) + (cider-nrepl-send-request + `("op" "toggle-profile-ns" + "ns" ,ns) + (cider-profile--make-response-handler + (lambda (_buffer value) + (pcase value + ("profiled" (message "Profiling enabled for %s" ns)) + ("unprofiled" (message "Profiling disabled for %s" ns))))))) + query) + +;;;###autoload +(defun cider-profile-toggle (query) + "Toggle profiling for the given QUERY. +Defaults to the symbol at point. +With prefix arg or no symbol at point, prompts for a var." + (interactive "P") + (cider-ensure-op-supported "toggle-profile") + (cider-read-symbol-name + "Toggle profiling for var: " + (lambda (sym) + (let ((ns (cider-current-ns))) + (cider-nrepl-send-request + `("op" "toggle-profile" + "ns" ,ns + "sym" ,sym) + (cider-profile--make-response-handler + (lambda (_buffer value) + (pcase value + ("profiled" (message "Profiling enabled for %s/%s" ns sym)) + ("unprofiled" (message "Profiling disabled for %s/%s" ns sym)) + ("unbound" (message "%s/%s is unbound" ns sym))))))))) + query) + +(defun cider-profile-display-stats (stats-response) + "Displays the STATS-RESPONSE on `cider-profile-buffer`." + (let ((table (nrepl-dict-get stats-response "err"))) + (if cider-profile-buffer + (let ((buffer (cider-make-popup-buffer cider-profile-buffer))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) (insert table))) + (display-buffer buffer) + (let ((window (get-buffer-window buffer))) + (set-window-point window 0) + (select-window window) + (fit-window-to-buffer window))) + (cider-emit-interactive-eval-err-output table)))) + +;;;###autoload +(defun cider-profile-summary () + "Display a summary of currently collected profile data." + (interactive) + (cider-ensure-op-supported "profile-summary") + (cider-profile-display-stats + (cider-nrepl-send-sync-request '("op" "profile-summary")))) + +;;;###autoload +(defun cider-profile-var-summary (query) + "Display profile data for var under point QUERY. +Defaults to the symbol at point. With prefix arg or no symbol at point, +prompts for a var." + (interactive "P") + (cider-ensure-op-supported "profile-var-summary") + (cider-read-symbol-name + "Profile-summary for var: " + (lambda (sym) + (cider-profile-display-stats + (cider-nrepl-send-sync-request + `("op" "profile-var-summary" + "ns" ,(cider-current-ns) + "sym" ,sym))))) + query) + +;;;###autoload +(defun cider-profile-clear () + "Clear any collected profile data." + (interactive) + (cider-ensure-op-supported "clear-profile") + (cider-nrepl-send-request + '("op" "clear-profile") + (cider-profile--make-response-handler + (lambda (_buffer value) + (when (equal value "cleared") + (message "Cleared profile data")))))) + +(provide 'cider-profile) + +;;; cider-profile.el ends here diff --git a/elpa/cider-20190121.1852/cider-repl-history.el b/elpa/cider-20190121.1852/cider-repl-history.el new file mode 100644 index 00000000..f6cd4c86 --- /dev/null +++ b/elpa/cider-20190121.1852/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 . + +;; 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/elpa/cider-20190121.1852/cider-repl.el b/elpa/cider-20190121.1852/cider-repl.el new file mode 100644 index 00000000..2d75d211 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-repl.el @@ -0,0 +1,1761 @@ +;;; cider-repl.el --- CIDER REPL mode interactions -*- lexical-binding: t -*- + +;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell +;; Reid McKenzie + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; This 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 t + "Control whether results in the REPL are pretty-printed or not. +The REPL will use the printer specified in `cider-pprint-fn'. +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 + (let ((orig-buffer (current-buffer))) + (display-buffer buffer) + ;; User popup-rules (specifically `:select nil') can cause the call to + ;; `display-buffer' to reset the current Emacs buffer to the clj/cljs + ;; buffer that the user ran `jack-in' from - we need the current-buffer + ;; to be the repl to initialize, so reset it back here to be resilient + ;; against user config + (set-buffer orig-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)) + (with-current-buffer buffer + (set-window-point (get-buffer-window) (point-max))) + buffer) + +(defun cider-repl--insert-banner-and-prompt (buffer) + "Insert REPL banner and REPL prompt in BUFFER." + (with-current-buffer buffer + (insert (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face)) + (when cider-repl-display-help-banner + (insert (propertize (cider-repl--help-banner) 'font-lock-face 'font-lock-comment-face))) + (goto-char (point-max)) + (cider-repl--mark-output-start) + (cider-repl--mark-input-start) + (cider-repl--insert-prompt cider-buffer-ns))) + +(defun cider-repl--banner () + "Generate the welcome REPL buffer banner." + (format ";; Connected to nREPL server - nrepl://%s:%s +;; CIDER %s, nREPL %s +;; Clojure %s, Java %s +;; Docs: (doc function-name) +;; (find-doc part-of-name) +;; Source: (source function-name) +;; Javadoc: (javadoc java-object-or-class) +;; Exit: +;; Results: Stored in vars *1, *2, *3, an exception in *e;" + (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 to view it. +;; In case you're seeing any warnings you should consult the manual's +;; \"Troubleshooting\" section. +;; +;; Here are few tips to get you started: +;; +;; * Press <\\[describe-mode]> to see a list of the keybindings available (this +;; will work in every Emacs buffer) +;; * Press <\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command +;; * Press <\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure file +;; * Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a +;; Java method) +;; * Press <\\[cider-doc]> to view the documentation for something (e.g. +;; a var, a Java method) +;; * Enable `eldoc-mode' to display function & method signatures in the minibuffer. +;; * Print CIDER's refcard and keep it close to your keyboard. +;; +;; CIDER is super customizable - try to +;; get a feel for this. If you're thirsty for knowledge you should try +;; . +;; +;; If you think you've encountered a bug (or have some suggestions for +;; improvements) use to report it. +;; +;; Above all else - don't panic! In case of an emergency - procure +;; some (hard) cider and enjoy it responsibly! +;; +;; You can remove this message with the 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-output))) + (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 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-output () + "Return the position at the end of the previous REPL output." + (if (eq (get-text-property (1- cider-repl-input-start-mark) 'field) + 'cider-repl-prompt) + ;; if after prompt, return eol before prompt + (previous-single-property-change cider-repl-input-start-mark + 'field nil (point-min)) + ;; else, input mark because there is no prompt (yet) + cider-repl-input-start-mark)) + +(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-output))) + (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) + (warning "warning,? +\\(\\([^\n:]+\\):\\([0-9]+\\):[0-9]+\\)" 1 nil 2 3) + (compilation ".*compiling:(\\([^\n:)]+\\):\\([0-9]+\\):[0-9]+)" 0 nil 1 2)) + "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) + "Workhorse for getting locref at point. +REG-LIST is an entry in `cider-locref-regexp-alist'." + (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." + (save-excursion + (goto-char (or pos (point))) + ;; Regexp lookup on long lines can result in significant hangs #2532. We + ;; assume that lines longer than 300 don't contain source references. + (when (< (- (point-at-eol) (point-at-bol)) 300) + (seq-some (lambda (rl) (cider--locref-at-point-1 rl)) + 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-") #'cider-repl-closing-return) + (define-key map (kbd "C-j") #'cider-repl-newline-and-indent) + (define-key map (kbd "C-c C-o") #'cider-repl-clear-output) + (define-key map (kbd "C-c M-n") #'cider-repl-set-ns) + (define-key map (kbd "C-c C-u") #'cider-repl-kill-input) + (define-key map (kbd "C-S-a") #'cider-repl-bol-mark) + (define-key map [S-home] #'cider-repl-bol-mark) + (define-key map (kbd "C-") #'cider-repl-backward-input) + (define-key map (kbd "C-") #'cider-repl-forward-input) + (define-key map (kbd "M-p") #'cider-repl-previous-input) + (define-key map (kbd "M-n") #'cider-repl-next-input) + (define-key map (kbd "M-r") #'cider-repl-previous-matching-input) + (define-key map (kbd "M-s") #'cider-repl-next-matching-input) + (define-key map (kbd "C-c C-n") #'cider-repl-next-prompt) + (define-key map (kbd "C-c C-p") #'cider-repl-previous-prompt) + (define-key map (kbd "C-c C-b") #'cider-interrupt) + (define-key map (kbd "C-c C-c") #'cider-interrupt) + (define-key map (kbd "C-c C-m") #'cider-macroexpand-1) + (define-key map (kbd "C-c M-m") #'cider-macroexpand-all) + (define-key map (kbd "C-c C-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/elpa/cider-20190121.1852/cider-resolve.el b/elpa/cider-20190121.1852/cider-resolve.el new file mode 100644 index 00000000..7963c897 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-resolve.el @@ -0,0 +1,130 @@ +;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection + +;; Copyright © 2015-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The ns cache is a dict of namespaces stored in the connection buffer. This +;; file offers functions to easily get information about variables from this +;; cache, given the variable's name and the file's namespace. This +;; functionality is similar to that offered by the `cider-var-info' function +;; (and others). The difference is that all functions in this file operate +;; without contacting the server (they still rely on an active connection +;; buffer, but no messages are actually exchanged). + +;; For this reason, the functions here are well suited for very +;; performance-sentitive operations, such as font-locking or +;; indentation. Meanwhile, operations like code-jumping are better off +;; communicating with the middleware, just in the off chance that the cache is +;; outdated. + +;; Below is a typical entry on this cache dict. Note that clojure.core symbols +;; are excluded from the refers to save space. + +;; "cider.nrepl.middleware.track-state" +;; (dict "aliases" +;; (dict "cljs" "cider.nrepl.middleware.util.cljs" +;; "misc" "cider.nrepl.middleware.util.misc" +;; "set" "clojure.set") +;; "interns" (dict a +;; "assoc-state" (dict "arglists" +;; (("response" +;; (dict "as" "msg" "keys" +;; ("session"))))) +;; "filter-core" (dict "arglists" +;; (("refers"))) +;; "make-transport" (dict "arglists" +;; (((dict "as" "msg" "keys" +;; ("transport"))))) +;; "ns-as-map" (dict "arglists" +;; (("ns"))) +;; "ns-cache" (dict) +;; "relevant-meta" (dict "arglists" +;; (("var"))) +;; "update-vals" (dict "arglists" +;; (("m" "f"))) +;; "wrap-tracker" (dict "arglists" +;; (("handler")))) +;; "refers" (dict "set-descriptor!" "#'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 (eq cider-repl-type 'cljs) + "cljs.core" + "clojure.core"))))) + +(defun cider-resolve-ns-symbols (ns) + "Return a plist of all valid symbols in NS. +Each entry's value is the metadata of the var that the symbol refers to. +NS can be the namespace name, or a dict of the namespace itself." + (when-let* ((dict (if (stringp ns) + (cider-resolve--get-in ns) + ns))) + (nrepl-dbind-response dict (interns refers aliases) + (append (cdr interns) + (nrepl-dict-flat-map (lambda (alias namespace) + (nrepl-dict-flat-map (lambda (sym meta) + (list (concat alias "/" sym) meta)) + (cider-resolve--get-in namespace "interns"))) + aliases))))) + +(provide 'cider-resolve) +;;; cider-resolve.el ends here diff --git a/elpa/cider-20190121.1852/cider-scratch.el b/elpa/cider-20190121.1852/cider-scratch.el new file mode 100644 index 00000000..5cfa1856 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-scratch.el @@ -0,0 +1,99 @@ +;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*- + +;; Copyright © 2014-2019 Bozhidar Batsov and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Imitate Emacs's *scratch* buffer. + +;;; Code: + +(require 'cider-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 +;; You can also press C-u C-j to evaluate the expression and pretty-print its result.\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/elpa/cider-20190121.1852/cider-selector.el b/elpa/cider-20190121.1852/cider-selector.el new file mode 100644 index 00000000..61d7aed7 --- /dev/null +++ b/elpa/cider-20190121.1852/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-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Buffer selection command inspired by SLIME's selector. + +;;; Code: + +(require 'cider-client) +(require 'cider-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/elpa/cider-20190121.1852/cider-stacktrace.el b/elpa/cider-20190121.1852/cider-stacktrace.el new file mode 100644 index 00000000..66a2820f --- /dev/null +++ b/elpa/cider-20190121.1852/cider-stacktrace.el @@ -0,0 +1,901 @@ +;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*- + +;; Copyright © 2014-2019 Jeff Valk, Bozhidar Batsov and CIDER contributors + +;; Author: Jeff Valk + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Stacktrace filtering and stack frame source navigation + +;;; Code: + +(require 'cl-lib) +(require 'cider-popup) +(require 'button) +(require 'easymenu) +(require 'cider-common) +(require '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")) + +(make-obsolete 'cider-stacktrace-print-length 'cider-stacktrace-print-options "0.20") +(make-obsolete 'cider-stacktrace-print-level 'cider-stacktrace-print-options "0.20") + +(defcustom cider-stacktrace-print-options '(dict "length" 50 "level" 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 \"print-length\" to `nil` will cause the attempted +printing of infinite data structures and that setting \"print-level\" to +nil cause the attempted printing of cyclical data structures." + :type 'listp + :group 'cider-stacktrace + :package-version '(cider . "0.20.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/elpa/cider-20190121.1852/cider-test.el b/elpa/cider-20190121.1852/cider-test.el new file mode 100644 index 00000000..8549ac3a --- /dev/null +++ b/elpa/cider-20190121.1852/cider-test.el @@ -0,0 +1,823 @@ +;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*- + +;; Copyright © 2014-2019 Jeff Valk, Bozhidar Batsov and CIDER contributors + +;; Author: Jeff Valk + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; This provides execution, reporting, and navigation support for Clojure tests, +;; specifically using the `clojure.test' machinery. This functionality replaces +;; the venerable `clojure-test-mode' (deprecated in June 2014), and relies on +;; nREPL middleware for report running and session support. + +;;; Code: + +(require 'cider-common) +(require 'cider-client) +(require 'cider-popup) +(require 'cider-stacktrace) +(require '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 "") #'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-options + `("print-options" ,cider-stacktrace-print-options))) + (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-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/elpa/cider-20190121.1852/cider-tracing.el b/elpa/cider-20190121.1852/cider-tracing.el new file mode 100644 index 00000000..c9821a26 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-tracing.el @@ -0,0 +1,90 @@ +;;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*- + +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Bozhidar Batsov +;; Artur Malabarba + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; A couple of commands for tracing the execution of functions. + +;;; Code: + +(require 'cider-client) +(require 'cider-common) ; for `cider-prompt-for-symbol-function' +(require 'cider-util) ; for `cider-propertize' +(require 'cider-connection) ; for `cider-map-repls' +(require 'nrepl-dict) + +(defun cider-sync-request:toggle-trace-var (symbol) + "Toggle var tracing for SYMBOL." + (thread-first `("op" "toggle-trace-var" + "ns" ,(cider-current-ns) + "sym" ,symbol) + (cider-nrepl-send-sync-request))) + +(defun cider--toggle-trace-var (sym) + "Toggle var tracing for SYM." + (let* ((trace-response (cider-sync-request:toggle-trace-var sym)) + (var-name (nrepl-dict-get trace-response "var-name")) + (var-status (nrepl-dict-get trace-response "var-status"))) + (pcase var-status + ("not-found" (error "Var %s not found" (cider-propertize sym 'fn))) + ("not-traceable" (error "Var %s can't be traced because it's not bound to a function" (cider-propertize var-name 'fn))) + (_ (message "Var %s %s" (cider-propertize var-name 'fn) var-status))))) + +;;;###autoload +(defun cider-toggle-trace-var (arg) + "Toggle var tracing. +Prompts for the symbol to use, or uses the symbol at point, depending on +the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the +opposite of what that option dictates." + (interactive "P") + (cider-ensure-op-supported "toggle-trace-var") + (funcall (cider-prompt-for-symbol-function arg) + "Toggle trace for var" + #'cider--toggle-trace-var)) + +(defun cider-sync-request:toggle-trace-ns (ns) + "Toggle namespace tracing for NS." + (thread-first `("op" "toggle-trace-ns" + "ns" ,ns) + (cider-nrepl-send-sync-request))) + +;;;###autoload +(defun cider-toggle-trace-ns (query) + "Toggle ns tracing. +Defaults to the current ns. With prefix arg QUERY, prompts for a ns." + (interactive "P") + (cider-map-repls :clj-strict + (lambda (conn) + (with-current-buffer conn + (cider-ensure-op-supported "toggle-trace-ns") + (let ((ns (if query + (completing-read "Toggle trace for ns: " + (cider-sync-request:ns-list)) + (cider-current-ns)))) + (let* ((trace-response (cider-sync-request:toggle-trace-ns ns)) + (ns-status (nrepl-dict-get trace-response "ns-status"))) + (pcase ns-status + ("not-found" (error "Namespace %s not found" (cider-propertize ns 'ns))) + (_ (message "Namespace %s %s" (cider-propertize ns 'ns) ns-status))))))))) + +(provide 'cider-tracing) +;;; cider-tracing.el ends here diff --git a/elpa/cider-20190121.1852/cider-util.el b/elpa/cider-20190121.1852/cider-util.el new file mode 100644 index 00000000..c5a09634 --- /dev/null +++ b/elpa/cider-20190121.1852/cider-util.el @@ -0,0 +1,793 @@ +;; 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-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Common utility functions that don't belong anywhere else. + +;;; Code: + +;; 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 "https://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!" + "A blank REPL promotes creativity." + "A blank REPL is infinitely better than a blank cheque." + ,(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 to inspect the defun at point's result." + "Press 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 to see every possible setting you can customize." + "Use to see every possible REPL setting you can customize." + "Enable `eldoc-mode' to display function & method signatures in the minibuffer." + "Enable `cider-enlighten-mode' to display the locals of a function when it's executed." + "Use <\\[cider-close-ancillary-buffers]> to close all ancillary buffers created by CIDER (e.g. *cider-doc*)." + "Exploring CIDER's menu-bar entries is a great way to discover features." + "Keep in mind that some commands don't have a keybinding by default. Explore CIDER!" + "Tweak `cider-repl-prompt-function' to customize your REPL prompt." + "Tweak `cider-eldoc-ns-function' to customize the way namespaces are displayed by eldoc." + "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/elpa/cider-20190121.1852/cider.el b/elpa/cider-20190121.1852/cider.el new file mode 100644 index 00000000..3727b395 --- /dev/null +++ b/elpa/cider-20190121.1852/cider.el @@ -0,0 +1,1458 @@ +;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*- + +;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell +;; Maintainer: Bozhidar Batsov +;; URL: http://www.github.com/clojure-emacs/cider +;; Version: 0.21.0-snapshot +;; Package-Requires: ((emacs "25") (clojure-mode "5.9") (pkg-info "0.4") (queue "0.2") (spinner "1.7") (seq "2.16") (sesman "0.3.2")) +;; Keywords: languages, clojure, cider + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; This file is not part of GNU Emacs. + +;;; Commentary: + +;; Provides a Clojure interactive development environment for Emacs, built on +;; top of nREPL. + +;;; Installation: + +;; Available as a package in melpa.org and stable.melpa.org + +;; (add-to-list 'package-archives +;; '("melpa" . "https://melpa.org/packages/")) +;; +;; or +;; +;; (add-to-list 'package-archives +;; '("melpa-stable" . "https://stable.melpa.org/packages/") t) +;; +;; M-x package-install cider + +;;; Usage: + +;; M-x cider-jack-in-clj +;; M-x cider-jack-in-cljs +;; +;; M-x cider-connect-sibling-clj +;; M-x cider-connect-sibling-cljs +;; +;; M-x cider-connect-clj +;; M-x cider-connect-cljs + +;;; Code: + +(defgroup cider nil + "Clojure Interactive Development Environment that Rocks." + :prefix "cider-" + :group 'applications + :link '(url-link :tag "GitHub" "https://github.com/clojure-emacs/cider") + :link '(url-link :tag "Online Manual" "https://docs.cider.mx") + :link '(emacs-commentary-link :tag "Commentary" "cider")) + +(require 'cider-client) +(require 'cider-eldoc) +(require 'cider-repl) +(require 'cider-repl-history) +(require 'cider-connection) +(require 'cider-mode) +(require 'cider-common) +(require 'cider-compat) +(require 'cider-debug) +(require 'cider-util) + +(require 'tramp-sh) +(require 'subr-x) +(require 'seq) +(require 'sesman) + +(defconst cider-version "0.21.0-snapshot" + "Fallback version used when it cannot be extracted automatically. +Normally it won't be used, unless `pkg-info' fails to extract the +version from the CIDER package or library.") + +(defconst cider-codename "New York" + "Codename used to denote stable releases.") + +(defcustom cider-lein-command + "lein" + "The command used to execute Leiningen." + :type 'string + :group 'cider) + +(defcustom cider-lein-global-options + nil + "Command global options used to execute Leiningen (e.g.: -o for offline)." + :type 'string + :group 'cider + :safe #'stringp) + +(defcustom cider-lein-parameters + "repl :headless :host localhost" + "Params passed to Leiningen to start an nREPL server via `cider-jack-in'." + :type 'string + :group 'cider + :safe #'stringp) + +(defcustom cider-boot-command + "boot" + "The command used to execute Boot." + :type 'string + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-boot-global-options + nil + "Command global options used to execute Boot (e.g.: -c for checkouts)." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.14.0")) + +(defcustom cider-boot-parameters + "cider.tasks/nrepl-server -b localhost wait" + "Params passed to boot to start an nREPL server via `cider-jack-in'." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.9.0")) + +(defcustom cider-clojure-cli-command + "clojure" + "The command used to execute clojure with tools.deps (requires Clojure 1.9+). +Don't use clj here, as it doesn't work when spawned from Emacs due to +it using rlwrap." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-clojure-cli-global-options + nil + "Command line options used to execute clojure with tools.deps." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-clojure-cli-parameters + "-m nrepl.cmdline --middleware '%s'" + "Params passed to clojure to start an nREPL server via `cider-jack-in'. +This is evaluated using `format', with the first argument being the Clojure +vector of middleware variables as a string." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-shadow-cljs-command + "npx shadow-cljs" + "The command used to execute shadow-cljs. + +By default we favor the project-specific shadow-cljs over the system-wide." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-shadow-cljs-global-options + "" + "Command line options used to execute shadow-cljs (e.g.: -v for verbose mode)." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-shadow-cljs-parameters + "server" + "Params passed to shadow-cljs to start an nREPL server via `cider-jack-in'." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.17.0")) + +(defcustom cider-gradle-command + "gradle" + "The command used to execute Gradle." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.10.0")) + +(defcustom cider-gradle-global-options + "--no-daemon" + "Command line options used to execute Gradle (e.g.: -m for dry run)." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.14.0")) + +(defcustom cider-gradle-parameters + "clojureRepl" + "Params passed to gradle to start an nREPL server via `cider-jack-in'." + :type 'string + :group 'cider + :safe #'stringp + :package-version '(cider . "0.10.0")) + +(define-obsolete-variable-alias 'cider-default-repl-command 'cider-jack-in-default) +(defcustom cider-jack-in-default (if (executable-find "clojure") 'clojure-cli 'lein) + "The default tool to use when doing `cider-jack-in' outside a project. +This value will only be consulted when no identifying file types, i.e. +project.clj for leiningen or build.boot for boot, could be found. + +As the Clojure CLI is bundled with Clojure itself, it's the default. +In the absence of the Clojure CLI (e.g. on Windows), we fallback +to Leiningen." + :type '(choice (const lein) + (const boot) + (const clojure-cli) + (const shadow-cljs) + (const gradle)) + :group 'cider + :safe #'symbolp + :package-version '(cider . "0.9.0")) + +(defcustom cider-preferred-build-tool + nil + "Allow choosing a build system when there are many. +When there are project markers from multiple build systems (e.g. lein and +boot) the user is prompted to select one of them. When non-nil, this +variable will suppress this behavior and will select whatever build system +is indicated by the variable if present. Note, this is only when CIDER +cannot decide which of many build systems to use and will never override a +command when there is no ambiguity." + :type '(choice (const lein) + (const boot) + (const clojure-cli) + (const shadow-cljs) + (const gradle) + (const :tag "Always ask" nil)) + :group 'cider + :safe #'symbolp + :package-version '(cider . "0.13.0")) + +(defcustom cider-allow-jack-in-without-project 'warn + "Controls what happens when doing `cider-jack-in' outside a project. +When set to 'warn you'd prompted to confirm the command. +When set to t `cider-jack-in' will quietly continue. +When set to nil `cider-jack-in' will fail." + :type '(choice (const :tag "always" t) + (const warn) + (const :tag "never" nil)) + :group 'cider + :safe #'symbolp + :package-version '(cider . "0.15.0")) + +(defcustom cider-known-endpoints nil + "A list of connection endpoints where each endpoint is a list. +For example: \\='((\"label\" \"host\" \"port\")). +The label is optional so that \\='(\"host\" \"port\") will suffice. +This variable is used by `cider-connect'." + :type '(repeat (list (string :tag "label") + (string :tag "host") + (string :tag "port"))) + :group 'cider) + +(defcustom cider-connected-hook nil + "List of functions to call when connected to Clojure nREPL server." + :type 'hook + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-disconnected-hook nil + "List of functions to call when disconnected from the Clojure nREPL server." + :type 'hook + :group 'cider + :package-version '(cider . "0.9.0")) + +(defcustom cider-inject-dependencies-at-jack-in t + "When nil, do not inject repl dependencies (most likely nREPL middlewares) at `cider-jack-in' time." + :type 'boolean + :safe #'booleanp + :version '(cider . "0.11.0")) + +(defcustom cider-offer-to-open-cljs-app-in-browser t + "When nil, do not offer to open ClojureScript apps in a browser on connect." + :type 'boolean + :safe #'booleanp + :version '(cider . "0.15.0")) + +(defvar cider-ps-running-nrepls-command "ps u | grep leiningen" + "Process snapshot command used in `cider-locate-running-nrepl-ports'.") + +(defvar cider-ps-running-nrepl-path-regexp-list + '("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D" + "\\(?:-classpath +:?\\(.+?\\)/self-installs\\)") + "Regexp list to get project paths. +Extract project paths from output of `cider-ps-running-nrepls-command'. +Sub-match 1 must be the project path.") + +(defvar cider-host-history nil + "Completion history for connection hosts.") + +;;;###autoload +(defun cider-version () + "Display CIDER's version." + (interactive) + (message "CIDER %s" (cider--version))) + +(defun cider-jack-in-command (project-type) + "Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE." + (pcase project-type + ('lein cider-lein-command) + ('boot cider-boot-command) + ('clojure-cli cider-clojure-cli-command) + ('shadow-cljs cider-shadow-cljs-command) + ('gradle cider-gradle-command) + (_ (user-error "Unsupported project type `%S'" project-type)))) + +(defun cider-jack-in-resolve-command (project-type) + "Determine the resolved file path to `cider-jack-in-command'. +Throws an error if PROJECT-TYPE is unknown." + (pcase project-type + ('lein (cider--resolve-command cider-lein-command)) + ('boot (cider--resolve-command cider-boot-command)) + ('clojure-cli (cider--resolve-command cider-clojure-cli-command)) + ;; here we have to account for the possibility that the command is either + ;; "npx shadow-cljs" or just "shadow-cljs" + ('shadow-cljs (let ((parts (split-string cider-shadow-cljs-command))) + (when-let* ((command (cider--resolve-command (car parts)))) + (mapconcat #'identity (cons command (cdr parts)) " ")))) + ('gradle (cider--resolve-command cider-gradle-command)) + (_ (user-error "Unsupported project type `%S'" project-type)))) + +(defun cider-jack-in-global-options (project-type) + "Determine the command line options for `cider-jack-in' for the PROJECT-TYPE." + (pcase project-type + ('lein cider-lein-global-options) + ('boot cider-boot-global-options) + ('clojure-cli cider-clojure-cli-global-options) + ('shadow-cljs cider-shadow-cljs-global-options) + ('gradle cider-gradle-global-options) + (_ (user-error "Unsupported project type `%S'" project-type)))) + +(defun cider-jack-in-params (project-type) + "Determine the commands params for `cider-jack-in' for the PROJECT-TYPE." + (pcase project-type + ('lein cider-lein-parameters) + ('boot cider-boot-parameters) + ('clojure-cli (format cider-clojure-cli-parameters + (concat + "[" + (mapconcat + (apply-partially #'format "\"%s\"") + (cider-jack-in-normalized-nrepl-middlewares) + ", ") + "]"))) + ('shadow-cljs cider-shadow-cljs-parameters) + ('gradle cider-gradle-parameters) + (_ (user-error "Unsupported project type `%S'" project-type)))) + + +;;; Jack-in dependencies injection +(defvar cider-jack-in-dependencies nil + "List of dependencies where elements are lists of artifact name and version.") +(put 'cider-jack-in-dependencies 'risky-local-variable t) +;; We inject the newest known version of nREPL just in case +;; your version of Boot or Leiningen is bundling an older one. +(cider-add-to-alist 'cider-jack-in-dependencies + "nrepl" "0.5.3") + +(defvar cider-jack-in-cljs-dependencies nil + "List of dependencies where elements are lists of artifact name and version. +Added to `cider-jack-in-dependencies' when doing `cider-jack-in-cljs'.") +(put 'cider-jack-in-cljs-dependencies 'risky-local-variable t) +(cider-add-to-alist 'cider-jack-in-cljs-dependencies "cider/piggieback" "0.3.10") + +(defvar cider-jack-in-dependencies-exclusions nil + "List of exclusions for jack in dependencies. +Elements of the list are artifact name and list of exclusions to apply for the artifact.") +(put 'cider-jack-in-dependencies-exclusions 'risky-local-variable t) + +(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.20.0" + "The minimum CIDER nREPL version that's known to work properly with CIDER.") + +(defconst cider-latest-middleware-version "0.20.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 https://docs.cider.mx/en/latest/clojurescript for details"))) + +(defun cider-verify-piggieback-is-present () + "Check whether the piggieback middleware is present." + (unless (cider-library-present-p "cider/piggieback") + (user-error "Piggieback 0.3.x (aka cider/piggieback) is not available. See https://docs.cider.mx/en/latest/clojurescript for details"))) + +(defun cider-check-nashorn-requirements () + "Check whether we can start a Nashorn ClojureScript REPL." + (cider-verify-piggieback-is-present)) + +(defun cider-check-node-requirements () + "Check whether we can start a Node ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (executable-find "node") + (user-error "Node.js is not present on the exec-path. Make sure you've installed it and your exec-path is properly set"))) + +(defun cider-check-figwheel-requirements () + "Check whether we can start a Figwheel ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (cider-library-present-p "figwheel-sidecar/figwheel-sidecar") + (user-error "Figwheel-sidecar is not available. Please check https://docs.cider.mx/en/latest/clojurescript"))) + +(defun cider-check-figwheel-main-requirements () + "Check whether we can start a Figwheel ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (cider-library-present-p "bhauman/figwheel-main") + (user-error "Figwheel-main is not available. Please check https://docs.cider.mx/en/latest/clojurescript"))) + +(defun cider-check-weasel-requirements () + "Check whether we can start a Weasel ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (cider-library-present-p "weasel/weasel") + (user-error "Weasel in not available. Please check https://docs.cider.mx/en/latest/clojurescript/#browser-connected-clojurescript-repl"))) + +(defun cider-check-boot-requirements () + "Check whether we can start a Boot ClojureScript REPL." + (cider-verify-piggieback-is-present) + (unless (cider-library-present-p "adzerk/boot-cljs-repl") + (user-error "The Boot ClojureScript REPL is not available. Please check https://github.com/adzerk-oss/boot-cljs-repl/blob/master/README.md"))) + +(defun cider-check-shadow-cljs-requirements () + "Check whether we can start a shadow-cljs REPL." + (unless (cider-library-present-p "thheller/shadow-cljs") + (user-error "The shadow-cljs ClojureScript REPL is not available"))) + +(defun cider-normalize-cljs-init-options (options) + "Normalize the OPTIONS string used for initializing a ClojureScript REPL." + (if (or (string-prefix-p "{" options) + (string-prefix-p "(" options) + (string-prefix-p "[" options) + (string-prefix-p ":" options)) + options + (concat ":" options))) + +(defcustom cider-shadow-default-options nil + "Defines default `shadow-cljs' options." + :type 'string + :safe (lambda (s) (or (null s) (stringp s))) + :package-version '(cider . "0.18.0")) + +(defun cider-shadow-select-cljs-init-form () + "Generate the init form for a shadow-cljs select-only REPL. +We have to prompt the user to select a build, that's why this is a command, +not just a string." + (let ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/nrepl-select %s))") + (options (or cider-shadow-default-options + (read-from-minibuffer "Select shadow-cljs build (e.g. dev): ")))) + (format form (cider-normalize-cljs-init-options options)))) + +(defun cider-shadow-cljs-init-form () + "Generate the init form for a shadow-cljs REPL. +We have to prompt the user to select a build, that's why +this is a command, not just a string." + (let* ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/watch %s) (shadow/nrepl-select %s))") + (options (or cider-shadow-default-options + (read-from-minibuffer "Select shadow-cljs build (e.g. dev): "))) + (build (cider-normalize-cljs-init-options options))) + (format form build build))) + +(defcustom cider-figwheel-main-default-options nil + "Defines the `figwheel.main/start' options. + +Note that figwheel-main/start can also accept a map of options, refer to +Figwheel for details." + :type 'string + :safe (lambda (s) (or (null s) (stringp s))) + :package-version '(cider . "0.18.0")) + +(defun cider-figwheel-main-init-form () + "Produce the figwheel-main ClojureScript init form." + (let ((form "(do (require 'figwheel.main) (figwheel.main/start %s))") + (options (string-trim + (or cider-figwheel-main-default-options + (read-from-minibuffer "Select figwheel-main build (e.g. :dev): "))))) + (format form (cider-normalize-cljs-init-options options)))) + +(defun cider-custom-cljs-repl-init-form () + "Prompt for a form that would start a ClojureScript REPL. +The supplied string will be wrapped in a do form if needed." + (let ((form (read-from-minibuffer "Please, provide a form to start a ClojureScript REPL: "))) + ;; TODO: We should probably make this more robust (e.g. by using a regexp or + ;; parsing the form). + (if (string-prefix-p "(do" form) + form + (format "(do %s)" form)))) + +(defvar cider-cljs-repl-types + '((nashorn "(do (require 'cljs.repl.nashorn) (cider.piggieback/cljs-repl (cljs.repl.nashorn/repl-env)))" + cider-check-nashorn-requirements) + (figwheel "(do (require 'figwheel-sidecar.repl-api) (figwheel-sidecar.repl-api/start-figwheel!) (figwheel-sidecar.repl-api/cljs-repl))" + cider-check-figwheel-requirements) + (figwheel-main cider-figwheel-main-init-form cider-check-figwheel-main-requirements) + (node "(do (require 'cljs.repl.node) (cider.piggieback/cljs-repl (cljs.repl.node/repl-env)))" + cider-check-node-requirements) + (weasel "(do (require 'weasel.repl.websocket) (cider.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \"127.0.0.1\" :port 9001)))" + cider-check-weasel-requirements) + (boot "(do (require 'adzerk.boot-cljs-repl) (adzerk.boot-cljs-repl/start-repl))" + cider-check-boot-requirements) + (shadow cider-shadow-cljs-init-form cider-check-shadow-cljs-requirements) + (shadow-select cider-shadow-select-cljs-init-form cider-check-shadow-cljs-requirements) + (custom cider-custom-cljs-repl-init-form nil)) + "A list of supported ClojureScript REPLs. + +For each one we have its name, the form we need to evaluate in a Clojure +REPL to start the ClojureScript REPL and functions to very their requirements. + +The form should be either a string or a function producing a string.") + +(defun cider-register-cljs-repl-type (type init-form &optional requirements-fn) + "Register a new ClojureScript REPL type. + +Types are defined by the following: + +- TYPE - symbol identifier that will be used to refer to the REPL type +- INIT-FORM - string or function (symbol) producing string +- REQUIREMENTS-FN - function to check whether the REPL can be started. +This param is optional. + +All this function does is modifying `cider-cljs-repl-types'. +It's intended to be used in your Emacs config." + (unless (symbolp type) + (user-error "The REPL type must be a symbol")) + (unless (or (stringp init-form) (symbolp init-form)) + (user-error "The init form must be a string or a symbol referring to a function")) + (unless (or (null requirements-fn) (symbolp requirements-fn)) + (user-error "The requirements-fn must be a symbol referring to a function")) + (add-to-list 'cider-cljs-repl-types (list type init-form requirements-fn))) + +(defcustom cider-default-cljs-repl nil + "The default ClojureScript REPL to start. +This affects commands like `cider-jack-in-cljs'. Generally it's +intended to be set via .dir-locals.el for individual projects, as its +relatively unlikely you'd like to use the same type of REPL in each project +you're working on." + :type '(choice (const :tag "Nashorn" nashorn) + (const :tag "Figwheel" figwheel) + (const :tag "Figwheel Main" figwheel-main) + (const :tag "Node" node) + (const :tag "Weasel" weasel) + (const :tag "Boot" boot) + (const :tag "Shadow" shadow) + (const :tag "Shadow w/o Server" shadow-select) + (const :tag "Custom" custom)) + :group 'cider + :safe #'symbolp + :package-version '(cider . "0.17.0")) + +(make-obsolete-variable 'cider-cljs-lein-repl 'cider-default-cljs-repl "0.17") +(make-obsolete-variable 'cider-cljs-boot-repl 'cider-default-cljs-repl "0.17") +(make-obsolete-variable 'cider-cljs-gradle-repl 'cider-default-cljs-repl "0.17") + +(defvar cider--select-cljs-repl-history nil) +(defun cider-select-cljs-repl (&optional default) + "Select the ClojureScript REPL to use with `cider-jack-in-cljs'. +DEFAULT is the default ClojureScript REPL to offer in completion." + (let ((repl-types (mapcar #'car cider-cljs-repl-types))) + (intern (completing-read "Select ClojureScript REPL type: " repl-types + nil nil nil 'cider--select-cljs-repl-history + (or default (car cider--select-cljs-repl-history)))))) + +(defun cider-cljs-repl-form (repl-type) + "Get the cljs REPL form for REPL-TYPE." + (if-let* ((repl-form (cadr (seq-find + (lambda (entry) + (eq (car entry) repl-type)) + cider-cljs-repl-types)))) + ;; repl-form can be either a string or a function producing a string + (if (symbolp repl-form) + (funcall repl-form) + repl-form) + (user-error "No ClojureScript REPL type %s found. Please make sure that `cider-cljs-repl-types' has an entry for it" repl-type))) + +(defun cider-verify-cljs-repl-requirements (&optional repl-type) + "Verify that the requirements for REPL-TYPE are met. +Return REPL-TYPE if requirements are met." + (let ((repl-type (or repl-type + cider-default-cljs-repl + (cider-select-cljs-repl)))) + (when cider-check-cljs-repl-requirements + (when-let* ((fun (nth 2 (seq-find + (lambda (entry) + (eq (car entry) repl-type)) + cider-cljs-repl-types)))) + (funcall fun))) + repl-type)) + +(defun cider--check-cljs (&optional cljs-type no-error) + "Verify that all cljs requirements are met for CLJS-TYPE connection. +Return REPL-TYPE of requirement are met, and throw an ‘user-error’ otherwise. +When NO-ERROR is non-nil, don't throw an error, issue a message and return +nil." + (if no-error + (condition-case ex + (progn + (cider-verify-clojurescript-is-present) + (cider-verify-cljs-repl-requirements cljs-type)) + (error + (message "Invalid ClojureScript dependency: %S" ex) + nil)) + (cider-verify-clojurescript-is-present) + (cider-verify-cljs-repl-requirements cljs-type))) + +(defun cider--offer-to-open-app-in-browser (server-buffer) + "Look for a server address in SERVER-BUFFER and offer to open it." + (when (buffer-live-p server-buffer) + (with-current-buffer server-buffer + (save-excursion + (goto-char (point-min)) + (when-let* ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror) + (match-string 0)))) + (when (y-or-n-p (format "Visit ‘%s’ in a browser? " url)) + (browse-url url))))))) + + +;;; User Level Connectors + +;;;###autoload (autoload 'cider-start-map "cider" "CIDER jack-in and connect keymap." t 'keymap) +(defvar cider-start-map + (let ((map (define-prefix-command 'cider-start-map))) + (define-key map (kbd "x") #'cider) + (define-key map (kbd "C-x") #'cider) + (define-key map (kbd "j j") #'cider-jack-in-clj) + (define-key map (kbd "j s") #'cider-jack-in-cljs) + (define-key map (kbd "j m") #'cider-jack-in-clj&cljs) + (define-key map (kbd "C-j j") #'cider-jack-in-clj) + (define-key map (kbd "C-j s") #'cider-jack-in-cljs) + (define-key map (kbd "C-j m") #'cider-jack-in-clj&cljs) + (define-key map (kbd "C-j C-j") #'cider-jack-in-clj) + (define-key map (kbd "C-j C-s") #'cider-jack-in-cljs) + (define-key map (kbd "C-j C-m") #'cider-jack-in-clj&cljs) + (define-key map (kbd "c j") #'cider-connect-clj) + (define-key map (kbd "c s") #'cider-connect-cljs) + (define-key map (kbd "c m") #'cider-connect-clj&cljs) + (define-key map (kbd "C-c j") #'cider-connect-clj) + (define-key map (kbd "C-c s") #'cider-connect-cljs) + (define-key map (kbd "C-c m") #'cider-connect-clj&cljs) + (define-key map (kbd "C-c C-j") #'cider-connect-clj) + (define-key map (kbd "C-c C-s") #'cider-connect-cljs) + (define-key map (kbd "C-c C-m") #'cider-connect-clj&cljs) + (define-key map (kbd "s j") #'cider-connect-sibling-clj) + (define-key map (kbd "s s") #'cider-connect-sibling-cljs) + (define-key map (kbd "C-s j") #'cider-connect-sibling-clj) + (define-key map (kbd "C-s s") #'cider-connect-sibling-cljs) + (define-key map (kbd "C-s C-j") #'cider-connect-sibling-clj) + (define-key map (kbd "C-s C-s") #'cider-connect-sibling-cljs) + map) + "CIDER jack-in and connect keymap.") + +;;;###autoload +(defun cider-jack-in-clj (params) + "Start an nREPL server for the current project and connect to it. +PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. +With the prefix argument, prompt for all these parameters." + (interactive "P") + (let ((params (thread-first params + (cider--update-project-dir) + (cider--check-existing-session) + (cider--update-jack-in-cmd)))) + (nrepl-start-server-process + (plist-get params :project-dir) + (plist-get params :jack-in-cmd) + (lambda (server-buffer) + (cider-connect-sibling-clj params server-buffer))))) + +;;;###autoload +(defun cider-jack-in-cljs (params) + "Start an nREPL server for the current project and connect to it. +PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and +:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, +prompt for all these parameters." + (interactive "P") + (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) + (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) + (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) + (orig-buffer (current-buffer))) + ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars + (let ((params (thread-first params + (cider--update-project-dir) + (cider--check-existing-session) + (cider--update-jack-in-cmd)))) + (nrepl-start-server-process + (plist-get params :project-dir) + (plist-get params :jack-in-cmd) + (lambda (server-buffer) + (with-current-buffer orig-buffer + (cider-connect-sibling-cljs params server-buffer))))))) + +;;;###autoload +(defun cider-jack-in-clj&cljs (&optional params soft-cljs-start) + "Start an nREPL server and connect with clj and cljs REPLs. +PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and +:cljs-repl-type (e.g. Node, Figwheel, etc). With the prefix argument, +prompt for all these parameters. When SOFT-CLJS-START is non-nil, start +cljs REPL only when the ClojureScript dependencies are met." + (interactive "P") + (let ((cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) + (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) + (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) + (orig-buffer (current-buffer))) + ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars + (let ((params (thread-first params + (cider--update-project-dir) + (cider--check-existing-session) + (cider--update-jack-in-cmd) + (cider--update-cljs-type) + ;; already asked, don't ask on sibling connect + (plist-put :do-prompt nil)))) + (nrepl-start-server-process + (plist-get params :project-dir) + (plist-get params :jack-in-cmd) + (lambda (server-buffer) + (with-current-buffer orig-buffer + (let ((clj-repl (cider-connect-sibling-clj params server-buffer))) + (if soft-cljs-start + (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) + (cider-connect-sibling-cljs params clj-repl)) + (cider-connect-sibling-cljs params clj-repl))))))))) + +;;;###autoload +(defun cider-connect-sibling-clj (params &optional other-repl) + "Create a Clojure REPL with the same server as OTHER-REPL. +PARAMS is for consistency with other connection commands and is currently +ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can +also be a server buffer, in which case a new session with a REPL for that +server is created." + (interactive "P") + (cider-nrepl-connect + (let* ((other-repl (or other-repl (cider-current-repl nil 'ensure))) + (other-params (cider--gather-connect-params nil other-repl)) + (ses-name (unless (nrepl-server-p other-repl) + (sesman-session-name-for-object 'CIDER other-repl)))) + (thread-first params + (cider--update-do-prompt) + (append other-params) + (plist-put :repl-init-function nil) + (plist-put :repl-type 'clj) + (plist-put :session-name ses-name))))) + +;;;###autoload +(defun cider-connect-sibling-cljs (params &optional other-repl) + "Create a ClojureScript REPL with the same server as OTHER-REPL. +PARAMS is a plist optionally containing :cljs-repl-type (e.g. Node, +Figwheel, etc). All other parameters are inferred from the OTHER-REPL. +OTHER-REPL defaults to `cider-current-repl' but in programs can also be a +server buffer, in which case a new session for that server is created." + (interactive "P") + (let* ((other-repl (or other-repl (cider-current-repl nil 'ensure))) + (other-params (cider--gather-connect-params nil other-repl)) + (ses-name (unless (nrepl-server-p other-repl) + (sesman-session-name-for-object 'CIDER other-repl)))) + (cider-nrepl-connect + (thread-first params + (cider--update-do-prompt) + (append other-params) + (cider--update-cljs-type) + (cider--update-cljs-init-function) + (plist-put :session-name ses-name) + (plist-put :repl-type 'pending-cljs))))) + +;;;###autoload +(defun cider-connect-clj (&optional params) + "Initialize a Clojure connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port and :project-dir. On +prefix argument, prompt for all the parameters." + (interactive "P") + (cider-nrepl-connect + (thread-first params + (cider--update-project-dir) + (cider--update-host-port) + (cider--check-existing-session) + (plist-put :repl-init-function nil) + (plist-put :session-name nil) + (plist-put :repl-type 'clj)))) + +;;;###autoload +(defun cider-connect-cljs (&optional params) + "Initialize a ClojureScript connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port, :project-dir and +:cljs-repl-type (e.g. Node, Figwheel, etc). On prefix, prompt for all the +parameters regardless of their supplied or default values." + (interactive "P") + (cider-nrepl-connect + (thread-first params + (cider--update-project-dir) + (cider--update-host-port) + (cider--check-existing-session) + (cider--update-cljs-type) + (cider--update-cljs-init-function) + (plist-put :session-name nil) + (plist-put :repl-type 'pending-cljs)))) + +;;;###autoload +(defun cider-connect-clj&cljs (params &optional soft-cljs-start) + "Initialize a Clojure and ClojureScript connection to an nREPL server. +PARAMS is a plist optionally containing :host, :port, :project-dir and +:cljs-repl-type (e.g. Node, Figwheel, etc). When SOFT-CLJS-START is +non-nil, don't start if ClojureScript requirements are not met." + (interactive "P") + (let* ((params (thread-first params + (cider--update-project-dir) + (cider--update-host-port) + (cider--check-existing-session) + (cider--update-cljs-type))) + (clj-repl (cider-connect-clj params))) + (if soft-cljs-start + (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) + (cider-connect-sibling-cljs params clj-repl)) + (cider-connect-sibling-cljs params clj-repl)))) + +(defvar cider-connection-init-commands + '(cider-jack-in-clj + cider-jack-in-cljs + cider-jack-in-clj&cljs + cider-connect-clj + cider-connect-cljs + cider-connect-clj&cljs + cider-connect-sibling-clj + cider-connect-sibling-cljs) + "A list of all user-level connection init commands in CIDER.") + +;;;###autoload +(defun cider () + "Start a connection of any type interactively." + (interactive) + (when-let* ((command (intern (completing-read "Select command: " cider-connection-init-commands)))) + (call-interactively command))) + + +;;; PARAMS updating + +(defun cider--update-do-prompt (params) + "Update :do-prompt in PARAMS." + (if (equal params '(4)) + (list :do-prompt t) + params)) + +(defun cider--update-project-dir (params) + "Update :project-dir in PARAMS." + (let* ((params (cider--update-do-prompt params)) + (proj-dir (if (plist-get params :do-prompt) + (read-directory-name "Project: " + (clojure-project-dir (cider-current-dir))) + (plist-get params :project-dir))) + (orig-buffer (current-buffer))) + (if (or (null proj-dir) + (file-in-directory-p default-directory proj-dir)) + (plist-put params :project-dir + (or proj-dir + (clojure-project-dir (cider-current-dir)))) + ;; If proj-dir is not a parent of default-directory, transfer all local + ;; variables and hack dir-local variables into a temporary buffer and keep + ;; that buffer within `params` for the later use by other --update- + ;; functions. The context buffer should not be used outside of the param + ;; initialization pipeline. Therefore, we don't bother with making it + ;; unique or killing it anywhere. + (let ((context-buf-name " *cider-context-buffer*")) + (when (get-buffer context-buf-name) + (kill-buffer context-buf-name)) + (with-current-buffer (get-buffer-create context-buf-name) + (dolist (pair (buffer-local-variables orig-buffer)) + (pcase pair + (`(,name . ,value) ;ignore unbound variables + (ignore-errors (set (make-local-variable name) value)))) + (setq-local buffer-file-name nil)) + (let ((default-directory proj-dir)) + (hack-dir-local-variables-non-file-buffer) + (thread-first params + (plist-put :project-dir proj-dir) + (plist-put :--context-buffer (current-buffer))))))))) + +(defun cider--update-cljs-type (params) + "Update :cljs-repl-type in PARAMS." + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let ((params (cider--update-do-prompt params)) + (inferred-type (or (plist-get params :cljs-repl-type) + cider-default-cljs-repl))) + (plist-put params :cljs-repl-type + (if (plist-get params :do-prompt) + (cider-select-cljs-repl inferred-type) + (or inferred-type + (cider-select-cljs-repl))))))) + +(defun cider--update-jack-in-cmd (params) + "Update :jack-in-cmd key in PARAMS." + (let* ((params (cider--update-do-prompt params)) + (project-dir (plist-get params :project-dir)) + (project-type (cider-project-type project-dir)) + (command (cider-jack-in-command project-type)) + (command-resolved (cider-jack-in-resolve-command project-type)) + (command-global-opts (cider-jack-in-global-options project-type)) + (command-params (cider-jack-in-params project-type))) + (if command-resolved + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let* ((command-params (if (plist-get params :do-prompt) + (read-string (format "nREPL server command: %s " command-params) + command-params) + command-params)) + (cmd-params (if cider-inject-dependencies-at-jack-in + (cider-inject-jack-in-dependencies command-global-opts command-params project-type) + command-params))) + (if (or project-dir cider-allow-jack-in-without-project) + (when (or project-dir + (eq cider-allow-jack-in-without-project t) + (and (null project-dir) + (eq cider-allow-jack-in-without-project 'warn) + (y-or-n-p "Are you sure you want to run `cider-jack-in' without a Clojure project? "))) + (let* ((cmd (format "%s %s" command-resolved cmd-params))) + (plist-put params :jack-in-cmd cmd))) + (user-error "`cider-jack-in' is not allowed without a Clojure project")))) + (user-error "The %s executable isn't on your `exec-path'" command)))) + +(defun cider--update-host-port (params) + "Update :host and :port in PARAMS." + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let* ((params (cider--update-do-prompt params)) + (host (plist-get params :host)) + (port (plist-get params :port)) + (endpoint (if (plist-get params :do-prompt) + (cider-select-endpoint) + (if (and host port) + (cons host port) + (cider-select-endpoint))))) + (thread-first params + (plist-put :host (car endpoint)) + (plist-put :port (cdr endpoint)))))) + +(defun cider--update-cljs-init-function (params) + "Update PARAMS :repl-init-function for cljs connections." + (with-current-buffer (or (plist-get params :--context-buffer) + (current-buffer)) + (let ((cljs-type (plist-get params :cljs-repl-type))) + (plist-put params :repl-init-function + (lambda () + (cider--check-cljs cljs-type) + ;; FIXME: ideally this should be done in the state handler + (setq-local cider-cljs-repl-type cljs-type) + (cider-nrepl-send-request + (list "op" "eval" + "ns" (cider-current-ns) + "code" (cider-cljs-repl-form cljs-type)) + (cider-repl-handler (current-buffer))) + (when (and (buffer-live-p nrepl-server-buffer) + cider-offer-to-open-cljs-app-in-browser) + (cider--offer-to-open-app-in-browser nrepl-server-buffer))))))) + +(defun cider--check-existing-session (params) + "Ask for confirmation if a session with similar PARAMS already exists. +If no session exists or user chose to proceed, return PARAMS. If the user +canceled the action, signal quit." + (let* ((proj-dir (plist-get params :project-dir)) + (host (plist-get params :host)) + (port (plist-get params :port)) + (session (seq-find (lambda (ses) + (let ((ses-params (cider--gather-session-params ses))) + (and (equal proj-dir (plist-get ses-params :project-dir)) + (or (null port) + (equal port (plist-get ses-params :port))) + (or (null host) + (equal host (plist-get ses-params :host)))))) + (sesman-current-sessions 'CIDER '(project))))) + (when session + (unless (y-or-n-p + (concat + "A session with the same parameters exists (" (car session) "). " + "You can connect a sibling instead. Proceed? ")) + (let ((debug-on-quit nil)) + (signal 'quit nil))))) + params) + + +;;; Aliases + + ;;;###autoload +(defalias 'cider-jack-in #'cider-jack-in-clj) + ;;;###autoload +(defalias 'cider-jack-in-clojure #'cider-jack-in-clj) +;;;###autoload +(defalias 'cider-jack-in-clojurescript #'cider-jack-in-cljs) + +;;;###autoload +(defalias 'cider-connect #'cider-connect-clj) +;;;###autoload +(defalias 'cider-connect-clojure #'cider-connect-clj) +;;;###autoload +(defalias 'cider-connect-clojurescript #'cider-connect-cljs) + +;;;###autoload +(defalias 'cider-connect-sibling-clojure #'cider-connect-sibling-clj) +;;;###autoload +(defalias 'cider-connect-sibling-clojurescript #'cider-connect-sibling-cljs) + + +;;; Helpers + +(defun cider-current-host () + "Retrieve the current host." + (or (when (stringp buffer-file-name) + (file-remote-p buffer-file-name 'host)) + "localhost")) + +(defun cider-select-endpoint () + "Interactively select the host and port to connect to." + (dolist (endpoint cider-known-endpoints) + (unless (stringp (or (nth 2 endpoint) + (nth 1 endpoint))) + (user-error "The port for %s in `cider-known-endpoints' should be a string" + (nth 0 endpoint)))) + (let* ((ssh-hosts (cider--ssh-hosts)) + (hosts (seq-uniq (append (when cider-host-history + ;; history elements are strings of the form "host:port" + (list (split-string (car cider-host-history) ":"))) + (list (list (cider-current-host))) + cider-known-endpoints + ssh-hosts + ;; always add localhost + '(("localhost"))))) + (sel-host (cider--completing-read-host hosts)) + (host (car sel-host)) + (port (or (cadr sel-host) + (cider--completing-read-port host (cider--infer-ports host ssh-hosts))))) + (cons host port))) + +(defun cider--ssh-hosts () + "Retrieve all ssh host from local configuration files." + (seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s))) + ;; `tramp-completion-mode' is obsoleted in 26 + (cl-progv (if (version< emacs-version "26") + '(tramp-completion-mode) + '(non-essential)) '(t) + (tramp-completion-handle-file-name-all-completions "" "/ssh:")))) + +(defun cider--completing-read-host (hosts) + "Interactively select host from HOSTS. +Each element in HOSTS is one of: (host), (host port) or (label host port). +Return a list of the form (HOST PORT), where PORT can be nil." + (let* ((hosts (cider-join-into-alist hosts)) + (sel-host (completing-read "Host: " hosts nil nil nil + 'cider-host-history (caar hosts))) + (host (or (cdr (assoc sel-host hosts)) (list sel-host)))) + ;; remove the label + (if (= 3 (length host)) (cdr host) host))) + +(defun cider--tramp-file-name (vec) + "A simple compatibility wrapper around `make-tramp-file-name'. +Tramp version starting 26.1 is using a `cl-defstruct' rather than vanilla VEC." + (if (version< emacs-version "26.1") + vec + (with-no-warnings + (make-tramp-file-name :method (elt vec 0) + :host (elt vec 2))))) + +(defcustom cider-infer-remote-nrepl-ports nil + "When true, cider will use ssh to try to infer nREPL ports on remote hosts." + :type 'boolean + :safe #'booleanp + :package-version '(cider . "0.19.0")) + +(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))) + (when cider-infer-remote-nrepl-ports + (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") + (gradle . "build.gradle.kts")))) + (delq nil + (mapcar (lambda (candidate) + (when (file-exists-p (cdr candidate)) + (car candidate))) + build-files)))) + +(defun cider-project-type (&optional project-dir) + "Determine the type of the project in PROJECT-DIR. +When multiple project file markers are present, check for a preferred build +tool in `cider-preferred-build-tool', otherwise prompt the user to choose. +PROJECT-DIR defaults to the current project." + (let* ((choices (cider--identify-buildtools-present project-dir)) + (multiple-project-choices (> (length choices) 1)) + ;; this needs to be a string to be used in `completing-read' + (default (symbol-name (car choices))) + ;; `cider-preferred-build-tool' used to be a string prior to CIDER + ;; 0.18, therefore the need for `cider-maybe-intern' + (preferred-build-tool (cider-maybe-intern cider-preferred-build-tool))) + (cond ((and multiple-project-choices + (member preferred-build-tool choices)) + preferred-build-tool) + (multiple-project-choices + (intern + (completing-read + (format "Which command should be used (default %s): " default) + choices nil t nil nil default))) + (choices + (car choices)) + ;; TODO: Move this fallback outside the project-type check + ;; if we're outside a project we fallback to whatever tool + ;; is specified in `cider-jack-in-default' (normally clojure-cli) + ;; `cider-jack-in-default' used to be a string prior to CIDER + ;; 0.18, therefore the need for `cider-maybe-intern' + (t (cider-maybe-intern cider-jack-in-default))))) + + +;; TODO: Implement a check for command presence over tramp +(defun cider--resolve-command (command) + "Find COMMAND in exec path (see variable `exec-path'). +Return nil if not found. In case `default-directory' is non-local we +assume the command is available." + (when-let* ((command (or (and (file-remote-p default-directory) command) + (executable-find command) + (executable-find (concat command ".bat"))))) + (shell-quote-argument command))) + +;;;###autoload +(with-eval-after-load 'clojure-mode + (define-key clojure-mode-map (kbd "C-c M-x") #'cider) + (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) + (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) + (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) + (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) + (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) + (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) + (require 'sesman) + (sesman-install-menu clojure-mode-map) + (add-hook 'clojure-mode-hook (lambda () (setq-local sesman-system 'CIDER)))) + +(provide 'cider) + +;;; cider.el ends here diff --git a/elpa/cider-20190121.1852/nrepl-client.el b/elpa/cider-20190121.1852/nrepl-client.el new file mode 100644 index 00000000..85b78c61 --- /dev/null +++ b/elpa/cider-20190121.1852/nrepl-client.el @@ -0,0 +1,1340 @@ +;;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*- + +;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov +;; Copyright © 2013-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell +;; Reid McKenzie +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;; This file is not part of GNU Emacs. +;; +;;; Commentary: +;; +;; Provides an Emacs Lisp client to connect to Clojure nREPL servers. +;; +;; A connection is an abstract idea of the communication between Emacs (client) +;; and nREPL server. On the Emacs side connections are represented by two +;; running processes. The two processes are the server process and client +;; process (the connection to the server). Each of these is represented by its +;; own process buffer, filter and sentinel. +;; +;; The nREPL communication process can be broadly represented as follows: +;; +;; 1) The server process is started as an Emacs subprocess (usually by +;; `cider-jack-in', which in turn fires up leiningen or boot). Note that +;; if a connection was established using `cider-connect' there won't be +;; a server process. +;; +;; 2) The server's process filter (`nrepl-server-filter') detects the +;; connection port from the first plain text response from the server and +;; starts a communication process (socket connection) as another Emacs +;; subprocess. This is the nREPL client process (`nrepl-client-filter'). +;; All requests and responses handling happens through this client +;; connection. +;; +;; 3) Requests are sent by `nrepl-send-request' and +;; `nrepl-send-sync-request'. A request is simply a list containing a +;; requested operation name and the parameters required by the +;; operation. Each request has an associated callback that is called once +;; the response for the request has arrived. Besides the above functions +;; there are specialized request senders for each type of common +;; operations. Examples are `nrepl-request:eval', `nrepl-request:clone', +;; `nrepl-sync-request:describe'. +;; +;; 4) Responses from the server are decoded in `nrepl-client-filter' and are +;; physically represented by alists whose structure depends on the type of +;; the response. After having been decoded, the data from the response is +;; passed over to the callback that was registered by the original +;; request. +;; +;; Please see the comments in dedicated sections of this file for more detailed +;; description. + +;;; Code: +(require 'seq) +(require '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))) + (sesman-remove-object 'CIDER nil client-buffer + (not (process-get process :keep-server)) + 'no-error) + (nrepl--clear-client-sessions client-buffer) + (with-current-buffer client-buffer + (goto-char (point-max)) + (insert-before-markers + (propertize + (format "\n*** Closed on %s ***\n" (current-time-string)) + 'face 'cider-repl-stderr-face)) + (run-hooks 'nrepl-disconnected-hook) + (let ((server-buffer nrepl-server-buffer)) + (when (and (buffer-live-p server-buffer) + (not (process-get process :keep-server))) + (setq nrepl-server-buffer nil) + (nrepl--maybe-kill-server-buffer server-buffer))))))) + + +;;; Network + +(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))) + +(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 + 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', +and 'status'. + +The presence of a particular key determines the type of the response. For +example, if 'value' key is present, the response is of type 'value', if +'out' key is present the response is 'stdout' etc. + +Depending on the type, the handler dispatches the appropriate value to one +of the supplied handlers: VALUE-HANDLER, STDOUT-HANDLER, STDERR-HANDLER, +DONE-HANDLER, EVAL-ERROR-HANDLER and +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) + (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))) + (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) + (message "Namespace `%s' not found." ns)) + (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 "") #'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/elpa/cider-20190121.1852/nrepl-dict.el b/elpa/cider-20190121.1852/nrepl-dict.el new file mode 100644 index 00000000..d77aa608 --- /dev/null +++ b/elpa/cider-20190121.1852/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-2019 Bozhidar Batsov, Artur Malabarba and CIDER contributors +;; +;; Author: Tim King +;; Phil Hagelberg +;; Bozhidar Batsov +;; Artur Malabarba +;; Hugo Duncan +;; Steve Purcell +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . +;; +;; This file is not part of GNU Emacs. +;; +;;; Commentary: +;; +;; Provides functions to interact with and create `nrepl-dict's. These are +;; simply plists with an extra element at the head. + +;;; Code: +(require 'cl-lib) + + +(defun nrepl-dict (&rest key-vals) + "Create nREPL dict from KEY-VALS." + (cons 'dict key-vals)) + +(defun nrepl-dict-p (object) + "Return t if OBJECT is an nREPL dict." + (and (listp object) + (eq (car object) 'dict))) + +(defun nrepl-dict-empty-p (dict) + "Return t if nREPL dict DICT is empty." + (null (cdr dict))) + +(defun nrepl-dict-contains (dict key) + "Return nil if nREPL dict DICT doesn't contain KEY. +If DICT does contain KEY, then a non-nil value is returned. Due to the +current implementation, this return value is the tail of DICT's key-list +whose car is KEY. Comparison is done with `equal'." + (member key (nrepl-dict-keys dict))) + +(defun nrepl-dict-get (dict key &optional default) + "Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT. +If dict is nil, return nil. If DEFAULT not provided, and KEY not in DICT, +return nil. If DICT is not an nREPL dict object, an error is thrown." + (when dict + (if (nrepl-dict-p dict) + (if (nrepl-dict-contains dict key) + (lax-plist-get (cdr dict) key) + default) + (error "Not an nREPL dict object: %s" dict)))) + +(defun nrepl-dict-put (dict key value) + "Associate in DICT, KEY to VALUE. +Return new dict. Dict is modified by side effects." + (if (null dict) + `(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