gergely/my-emacs-d
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove Clojure-related packages

Browse Source
This commit is contained in:
Gergely Polonkai 2016-10-06 10:53:40 +02:00
parent 1b7f39b4ab
commit dc69a7ed04
38 changed files with 1 additions and 16516 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

202
elpa/cider-20160927.2135/cider-apropos.el
View File

@ -1,202 +0,0 @@
;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*-
;; Copyright © 2014-2016 Jeff Valk, Bozhidar Batsov and CIDER contributors
;;
;; Author: Jeff Valk <jv@jeffvalk.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Apropos functionality for Clojure.
;;; Code:
(require 'cider-doc)
(require 'cider-util)
(require 'cider-compat)
(require 'cider-client)
(require 'cider-popup)
(require 'nrepl-dict)
(require 'clojure-mode)
(require 'apropos)
(require 'button)
(defconst cider-apropos-buffer "*cider-apropos*")
(push cider-apropos-buffer cider-ancillary-buffers)
(defcustom cider-apropos-actions '(("display-doc" . cider-doc-lookup)
("find-def" . cider--find-var)
("lookup-on-grimoire" . cider-grimoire-lookup))
"Controls the actions to be applied on the symbol found by an apropos search.
The first action key in the list will be selected as default. If the list
contains only one action key, the associated action function will be
applied automatically. An action function can be any function that receives
the symbol found by the apropos search as argument."
:type '(alist :key-type string :value-type function)
:group 'cider
:package-version '(cider . "0.13.0"))
(defun cider-apropos-doc (button)
"Display documentation for the symbol represented at BUTTON."
(cider-doc-lookup (button-get button 'apropos-symbol)))
(defun cider-apropos-summary (query ns docs-p include-private-p case-sensitive-p)
"Return a short description for the performed apropos search.
QUERY can be a regular expression list of space-separated words
\(e.g take while) which will be converted to a regular expression
\(like take.+while) automatically behind the scenes. The search may be
limited to the namespace NS, and may optionally search doc strings
\(based on DOCS-P), include private vars (based on INCLUDE-PRIVATE-P),
and be case-sensitive (based on CASE-SENSITIVE-P)."
(concat (if case-sensitive-p "Case-sensitive " "")
(if docs-p "Documentation " "")
(format "Apropos for %S" query)
(if ns (format " in namespace %S" ns) "")
(if include-private-p
" (public and private symbols)"
" (public symbols only)")))
(defun cider-apropos-highlight (doc query)
"Return the DOC string propertized to highlight QUERY matches."
(let ((pos 0))
(while (string-match query doc pos)
(setq pos (match-end 0))
(put-text-property (match-beginning 0)
(match-end 0)
'font-lock-face apropos-match-face doc)))
doc)
(defun cider-apropos-result (result query docs-p)
"Emit a RESULT matching QUERY into current buffer, formatted for DOCS-P."
(nrepl-dbind-response result (name type doc)
(let* ((label (capitalize (if (string= type "variable") "var" type)))
(help (concat "Display doc for this " (downcase label))))
(cider-propertize-region (list 'apropos-symbol name
'action 'cider-apropos-doc
'help-echo help)
(insert-text-button name 'type 'apropos-symbol)
(insert "\n ")
(insert-text-button label 'type (intern (concat "apropos-" type)))
(insert ": ")
(let ((beg (point)))
(if docs-p
(insert (cider-apropos-highlight doc query) "\n")
(insert doc)
(fill-region beg (point))))
(insert "\n")))))
(declare-function cider-mode "cider-mode")
(defun cider-show-apropos (summary results query docs-p)
"Show SUMMARY and RESULTS for QUERY in a pop-up buffer, formatted for DOCS-P."
(with-current-buffer (cider-popup-buffer cider-apropos-buffer t)
(let ((inhibit-read-only t))
(apropos-mode)
(if (boundp 'header-line-format)
(setq-local header-line-format summary)
(insert summary "\n\n"))
(dolist (result results)
(cider-apropos-result result query docs-p))
(goto-char (point-min)))))
;;;###autoload
(defun cider-apropos (query &optional ns docs-p privates-p case-sensitive-p)
"Show all symbols whose names match QUERY, a regular expression.
QUERY can also be a list of space-separated words (e.g. take while) which
will be converted to a regular expression (like take.+while) automatically
behind the scenes. The search may be limited to the namespace NS, and may
optionally search doc strings (based on DOCS-P), include private vars
\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P)."
(interactive
(cons (read-string "Search for Clojure symbol (a regular expression): ")
(when current-prefix-arg
(list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list))))
(if (string= ns "") nil ns))
(y-or-n-p "Search doc strings? ")
(y-or-n-p "Include private symbols? ")
(y-or-n-p "Case-sensitive? ")))))
(cider-ensure-connected)
(cider-ensure-op-supported "apropos")
(if-let ((summary (cider-apropos-summary
query ns docs-p privates-p case-sensitive-p))
(results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))
(cider-show-apropos summary results query docs-p)
(message "No apropos matches for %S" query)))
;;;###autoload
(defun cider-apropos-documentation ()
"Shortcut for (cider-apropos <query> nil t)."
(interactive)
(cider-ensure-connected)
(cider-ensure-op-supported "apropos")
(cider-apropos (read-string "Search for Clojure documentation (a regular expression): ") nil t))
(defun cider-apropos-act-on-symbol (symbol)
"Apply selected action on SYMBOL."
(let* ((first-action-key (car (car cider-apropos-actions)))
(action-key (if (= 1 (length cider-apropos-actions))
first-action-key
(completing-read (format "Choose action to apply to `%s` (default %s): "
symbol first-action-key)
cider-apropos-actions nil nil nil nil first-action-key)))
(action-fn (cdr (assoc action-key cider-apropos-actions))))
(if action-fn
(funcall action-fn symbol)
(user-error "Unknown action `%s`" action-key))))
;;;###autoload
(defun cider-apropos-select (query &optional ns docs-p privates-p case-sensitive-p)
"Similar to `cider-apropos', but presents the results in a completing read.
Show all symbols whose names match QUERY, a regular expression.
QUERY can also be a list of space-separated words (e.g. take while) which
will be converted to a regular expression (like take.+while) automatically
behind the scenes. The search may be limited to the namespace NS, and may
optionally search doc strings (based on DOCS-P), include private vars
\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P)."
(interactive
(cons (read-string "Search for Clojure symbol (a regular expression): ")
(when current-prefix-arg
(list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list))))
(if (string= ns "") nil ns))
(y-or-n-p "Search doc strings? ")
(y-or-n-p "Include private symbols? ")
(y-or-n-p "Case-sensitive? ")))))
(cider-ensure-connected)
(cider-ensure-op-supported "apropos")
(if-let ((summary (cider-apropos-summary
query ns docs-p privates-p case-sensitive-p))
(results (mapcar (lambda (r) (nrepl-dict-get r "name"))
(cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))))
(cider-apropos-act-on-symbol (completing-read (concat summary ": ") results))
(message "No apropos matches for %S" query)))
;;;###autoload
(defun cider-apropos-documentation-select ()
"Shortcut for (cider-apropos-select <query> nil t)."
(interactive)
(cider-ensure-connected)
(cider-ensure-op-supported "apropos")
(cider-apropos-select (read-string "Search for Clojure documentation (a regular expression): ") nil t))
(provide 'cider-apropos)
;;; cider-apropos.el ends here

315
elpa/cider-20160927.2135/cider-autoloads.el
View File

@ -1,315 +0,0 @@
;;; cider-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "cider" "cider.el" (22508 49905 421980 342000))
;;; Generated autoloads from cider.el
(autoload 'cider-version "cider" "\
Display CIDER's version.
\(fn)" t nil)
(autoload 'cider-jack-in "cider" "\
Start an nREPL server for the current project and connect to it.
If PROMPT-PROJECT is t, then prompt for the project for which to
start the server.
If CLJS-TOO is non-nil, also start a ClojureScript REPL session with its
own buffer.
\(fn &optional PROMPT-PROJECT CLJS-TOO)" t nil)
(autoload 'cider-jack-in-clojurescript "cider" "\
Start an nREPL server and connect to it both Clojure and ClojureScript REPLs.
If PROMPT-PROJECT is t, then prompt for the project for which to
start the server.
\(fn &optional PROMPT-PROJECT)" t nil)
(autoload 'cider-connect "cider" "\
Connect to an nREPL server identified by HOST and PORT.
Create REPL buffer and start an nREPL client connection.
When the optional param PROJECT-DIR is present, the connection
gets associated with it.
\(fn HOST PORT &optional PROJECT-DIR)" t nil)
(eval-after-load 'clojure-mode '(progn (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in) (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-clojurescript) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect)))
;;;***
;;;### (autoloads nil "cider-apropos" "cider-apropos.el" (22508 49905
;;;;;; 341980 175000))
;;; Generated autoloads from cider-apropos.el
(autoload 'cider-apropos "cider-apropos" "\
Show all symbols whose names match QUERY, a regular expression.
QUERY can also be a list of space-separated words (e.g. take while) which
will be converted to a regular expression (like take.+while) automatically
behind the scenes. The search may be limited to the namespace NS, and may
optionally search doc strings (based on DOCS-P), include private vars
\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P).
\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil)
(autoload 'cider-apropos-documentation "cider-apropos" "\
Shortcut for (cider-apropos <query> nil t).
\(fn)" t nil)
(autoload 'cider-apropos-select "cider-apropos" "\
Similar to `cider-apropos', but presents the results in a completing read.
Show all symbols whose names match QUERY, a regular expression.
QUERY can also be a list of space-separated words (e.g. take while) which
will be converted to a regular expression (like take.+while) automatically
behind the scenes. The search may be limited to the namespace NS, and may
optionally search doc strings (based on DOCS-P), include private vars
\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P).
\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil)
(autoload 'cider-apropos-documentation-select "cider-apropos" "\
Shortcut for (cider-apropos-select <query> nil t).
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-browse-ns" "cider-browse-ns.el" (22508
;;;;;; 49905 313980 117000))
;;; Generated autoloads from cider-browse-ns.el
(autoload 'cider-browse-ns "cider-browse-ns" "\
List all NAMESPACE's vars in BUFFER.
\(fn NAMESPACE)" t nil)
(autoload 'cider-browse-ns-all "cider-browse-ns" "\
List all loaded namespaces in BUFFER.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-classpath" "cider-classpath.el" (22508
;;;;;; 49905 433980 367000))
;;; Generated autoloads from cider-classpath.el
(autoload 'cider-classpath "cider-classpath" "\
List all classpath entries.
\(fn)" t nil)
(autoload 'cider-open-classpath-entry "cider-classpath" "\
Open a classpath entry.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-debug" "cider-debug.el" (22508 49905
;;;;;; 325980 141000))
;;; Generated autoloads from cider-debug.el
(autoload 'cider-debug-defun-at-point "cider-debug" "\
Instrument the \"top-level\" expression at point.
If it is a defn, dispatch the instrumented definition. Otherwise,
immediately evaluate the instrumented expression.
While debugged code is being evaluated, the user is taken through the
source code and displayed the value of various expressions. At each step,
a number of keys will be prompted to the user.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-grimoire" "cider-grimoire.el" (22508
;;;;;; 49905 377980 250000))
;;; Generated autoloads from cider-grimoire.el
(autoload 'cider-grimoire-web "cider-grimoire" "\
Open grimoire documentation in the default web browser.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates.
\(fn &optional ARG)" t nil)
(autoload 'cider-grimoire "cider-grimoire" "\
Open grimoire documentation in a popup buffer.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "cider-inspector" "cider-inspector.el" (22508
;;;;;; 49905 369980 234000))
;;; Generated autoloads from cider-inspector.el
(autoload 'cider-inspect-last-sexp "cider-inspector" "\
Inspect the result of the the expression preceding point.
\(fn)" t nil)
(autoload 'cider-inspect-defun-at-point "cider-inspector" "\
Inspect the result of the \"top-level\" expression at point.
\(fn)" t nil)
(autoload 'cider-inspect-last-result "cider-inspector" "\
Inspect the most recent eval result.
\(fn)" t nil)
(autoload 'cider-inspect "cider-inspector" "\
Inspect the result of the preceding sexp.
With a prefix argument ARG it inspects the result of the \"top-level\" form.
With a second prefix argument it prompts for an expression to eval and inspect.
\(fn &optional ARG)" t nil)
(autoload 'cider-inspect-expr "cider-inspector" "\
Evaluate EXPR in NS and inspect its value.
Interactively, EXPR is read from the minibuffer, and NS the
current buffer's namespace.
\(fn EXPR NS)" t nil)
(define-obsolete-function-alias 'cider-inspect-read-and-inspect 'cider-inspect-expr "0.13.0")
;;;***
;;;### (autoloads nil "cider-macroexpansion" "cider-macroexpansion.el"
;;;;;; (22508 49905 413980 326000))
;;; Generated autoloads from cider-macroexpansion.el
(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\
Invoke \\=`macroexpand-1\\=` on the expression preceding point.
If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of
\\=`macroexpand-1\\=`.
\(fn &optional PREFIX)" t nil)
(autoload 'cider-macroexpand-all "cider-macroexpansion" "\
Invoke \\=`clojure.walk/macroexpand-all\\=` on the expression preceding point.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-mode" "cider-mode.el" (22508 49905 349980
;;;;;; 192000))
;;; Generated autoloads from cider-mode.el
(defvar cider-mode-line '(:eval (format " cider[%s]" (cider--modeline-info))) "\
Mode line lighter for `cider-mode'.
The value of this variable is a mode line template as in
`mode-line-format'. See Info Node `(elisp)Mode Line Format' for
details about mode line templates.
Customize this variable to change how `cider-mode' displays its
status in the mode line. The default value displays the current connection.
Set this variable to nil to disable the mode line
entirely.")
(custom-autoload 'cider-mode-line "cider-mode" t)
(eval-after-load 'clojure-mode '(easy-menu-define cider-clojure-mode-menu-open clojure-mode-map "Menu for Clojure mode.\n This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." `("CIDER" :visible (not cider-mode) ["Start a REPL" cider-jack-in :help "Starts an nREPL server (with lein, boot, or maven) and connects a REPL to it."] ["Connect to a REPL" cider-connect :help "Connects to a REPL that's already running."] ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clojurescript :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL.\n Configure `cider-cljs-lein-repl' to change the ClojureScript REPL to use."] "--" ["View manual online" cider-view-manual])))
(autoload 'cider-mode "cider-mode" "\
Minor mode for REPL interaction from a Clojure buffer.
\\{cider-mode-map}
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "cider-scratch" "cider-scratch.el" (22508 49905
;;;;;; 357980 209000))
;;; Generated autoloads from cider-scratch.el
(autoload 'cider-scratch "cider-scratch" "\
Go to the scratch buffer named `cider-scratch-buffer-name'.
\(fn)" t nil)
;;;***
;;;### (autoloads nil "cider-selector" "cider-selector.el" (22508
;;;;;; 49905 425980 351000))
;;; Generated autoloads from cider-selector.el
(autoload 'cider-selector "cider-selector" "\
Select a new buffer by type, indicated by a single character.
The user is prompted for a single character indicating the method by
which to choose a new buffer. The `?' character describes then
available methods. OTHER-WINDOW provides an optional target.
See `def-cider-selector-method' for defining new methods.
\(fn &optional OTHER-WINDOW)" t nil)
;;;***
;;;### (autoloads nil "cider-test" "cider-test.el" (22508 49905 405980
;;;;;; 309000))
;;; Generated autoloads from cider-test.el
(defvar cider-auto-test-mode nil "\
Non-nil if Cider-Auto-Test mode is enabled.
See the `cider-auto-test-mode' command
for a description of this minor mode.
Setting this variable directly does not take effect;
either customize it (see the info node `Easy Customization')
or call the function `cider-auto-test-mode'.")
(custom-autoload 'cider-auto-test-mode "cider-test" nil)
(autoload 'cider-auto-test-mode "cider-test" "\
Toggle automatic testing of Clojure files.
When enabled this reruns tests every time a Clojure file is loaded.
Only runs tests corresponding to the loaded file's namespace and does
nothing if no tests are defined or if the file failed to load.
\(fn &optional ARG)" t nil)
;;;***
;;;### (autoloads nil "cider-util" "cider-util.el" (22508 49905 417980
;;;;;; 334000))
;;; Generated autoloads from cider-util.el
(autoload 'cider-view-manual "cider-util" "\
View the manual in your default browser.
\(fn)" t nil)
;;;***
;;;### (autoloads nil nil ("cider-client.el" "cider-common.el" "cider-compat.el"
;;;;;; "cider-doc.el" "cider-eldoc.el" "cider-interaction.el" "cider-overlays.el"
;;;;;; "cider-pkg.el" "cider-popup.el" "cider-repl.el" "cider-resolve.el"
;;;;;; "cider-stacktrace.el" "nrepl-client.el" "nrepl-dict.el")
;;;;;; (22508 49905 437980 375000))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; cider-autoloads.el ends here

219
elpa/cider-20160927.2135/cider-browse-ns.el
View File

@ -1,219 +0,0 @@
;;; cider-browse-ns.el --- CIDER namespace browser
;; Copyright © 2014-2016 John Andrews, Bozhidar Batsov and CIDER contributors
;; Author: John Andrews <john.m.andrews@gmail.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; M-x cider-browse-ns
;;
;; Display a list of all vars in a namespace.
;; Pressing <enter> will take you to the cider-doc buffer for that var.
;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode').
;; M-x cider-browse-ns-all
;;
;; Explore Clojure namespaces by browsing a list of all namespaces.
;; Pressing <enter> expands into a list of that namespace's vars as if by
;; executing the command (cider-browse-ns "my.ns").
;;; Code:
(require 'cider-interaction)
(require 'cider-client)
(require 'cider-compat)
(require 'cider-util)
(require 'nrepl-dict)
(defconst cider-browse-ns-buffer "*cider-ns-browser*")
(push cider-browse-ns-buffer cider-ancillary-buffers)
(defvar-local cider-browse-ns-current-ns nil)
;; Mode Definition
(defvar cider-browse-ns-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map cider-popup-buffer-mode-map)
(define-key map "d" #'cider-browse-ns-doc-at-point)
(define-key map "s" #'cider-browse-ns-find-at-point)
(define-key map (kbd "RET") #'cider-browse-ns-operate-at-point)
(define-key map "^" #'cider-browse-ns-all)
(define-key map "n" #'next-line)
(define-key map "p" #'previous-line)
map))
(defvar cider-browse-ns-mouse-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] #'cider-browse-ns-handle-mouse)
map))
(define-derived-mode cider-browse-ns-mode special-mode "browse-ns"
"Major mode for browsing Clojure namespaces.
\\{cider-browse-ns-mode-map}"
(setq buffer-read-only t)
(setq-local electric-indent-chars nil)
(setq-local truncate-lines t)
(setq-local cider-browse-ns-current-ns nil))
(defun cider-browse-ns--text-face (var-meta)
"Return font-lock-face for a var.
VAR-META contains the metadata information used to decide a face.
Presence of \"arglists-str\" and \"macro\" indicates a macro form.
Only \"arglists-str\" indicates a function. Otherwise, its a variable.
If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn."
(cond
((not var-meta) 'font-lock-function-name-face)
((and (nrepl-dict-contains var-meta "arglists")
(string= (nrepl-dict-get var-meta "macro") "true"))
'font-lock-keyword-face)
((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face)
(t 'font-lock-variable-name-face)))
(defun cider-browse-ns--properties (var var-meta)
"Decorate VAR with a clickable keymap and a face.
VAR-META is used to decide a font-lock face."
(let ((face (cider-browse-ns--text-face var-meta)))
(propertize var
'font-lock-face face
'mouse-face 'highlight
'keymap cider-browse-ns-mouse-map)))
(defun cider-browse-ns--list (buffer title items &optional ns noerase)
"Reset contents of BUFFER.
Display TITLE at the top and ITEMS are indented underneath.
If NS is non-nil, it is added to each item as the
`cider-browse-ns-current-ns' text property. If NOERASE is non-nil, the
contents of the buffer are not reset before inserting TITLE and ITEMS."
(with-current-buffer buffer
(cider-browse-ns-mode)
(let ((inhibit-read-only t))
(unless noerase (erase-buffer))
(goto-char (point-max))
(insert (cider-propertize title 'ns) "\n")
(dolist (item items)
(insert (propertize (concat " " item "\n")
'cider-browse-ns-current-ns ns)))
(goto-char (point-min)))))
(defun cider-browse-ns--first-doc-line (doc)
"Return the first line of the given DOC string.
If the first line of the DOC string contains multiple sentences, only
the first sentence is returned. If the DOC string is nil, a Not documented
string is returned."
(if doc
(let* ((split-newline (split-string doc "\n"))
(first-line (car split-newline)))
(cond
((string-match "\\. " first-line) (substring first-line 0 (match-end 0)))
((= 1 (length split-newline)) first-line)
(t (concat first-line "..."))))
"Not documented."))
(defun cider-browse-ns--items (namespace)
"Return the items to show in the namespace browser of the given NAMESPACE.
Each item consists of a ns-var and the first line of its docstring."
(let* ((ns-vars-with-meta (cider-sync-request:ns-vars-with-meta namespace))
(propertized-ns-vars (nrepl-dict-map #'cider-browse-ns--properties ns-vars-with-meta)))
(mapcar (lambda (ns-var)
(let* ((doc (nrepl-dict-get-in ns-vars-with-meta (list ns-var "doc")))
;; to avoid (read nil)
;; it prompts the user for a Lisp expression
(doc (when doc (read doc)))
(first-doc-line (cider-browse-ns--first-doc-line doc)))
(concat ns-var " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face))))
propertized-ns-vars)))
;; Interactive Functions
;;;###autoload
(defun cider-browse-ns (namespace)
"List all NAMESPACE's vars in BUFFER."
(interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list))))
(with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)
(cider-browse-ns--list (current-buffer)
namespace
(cider-browse-ns--items namespace))
(setq-local cider-browse-ns-current-ns namespace)))
;;;###autoload
(defun cider-browse-ns-all ()
"List all loaded namespaces in BUFFER."
(interactive)
(with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)
(let ((names (cider-sync-request:ns-list)))
(cider-browse-ns--list (current-buffer)
"All loaded namespaces"
(mapcar (lambda (name)
(cider-browse-ns--properties name nil))
names))
(setq-local cider-browse-ns-current-ns nil))))
(defun cider-browse-ns--thing-at-point ()
"Get the thing at point.
Return a list of the type ('ns or 'var) and the value."
(let ((line (car (split-string (cider-string-trim (thing-at-point 'line)) " "))))
(if (string-match "\\." line)
(list 'ns line)
(list 'var (format "%s/%s"
(or (get-text-property (point) 'cider-browse-ns-current-ns)
cider-browse-ns-current-ns)
line)))))
(defun cider-browse-ns-doc-at-point ()
"Show the documentation for the thing at current point."
(interactive)
(let* ((thing (cider-browse-ns--thing-at-point))
(value (cadr thing)))
;; value is either some ns or a var
(cider-doc-lookup value)))
(defun cider-browse-ns-operate-at-point ()
"Expand browser according to thing at current point.
If the thing at point is a ns it will be browsed,
and if the thing at point is some var - its documentation will
be displayed."
(interactive)
(let* ((thing (cider-browse-ns--thing-at-point))
(type (car thing))
(value (cadr thing)))
(if (eq type 'ns)
(cider-browse-ns value)
(cider-doc-lookup value))))
(defun cider-browse-ns-find-at-point ()
"Find the definition of the thing at point."
(interactive)
(let* ((thing (cider-browse-ns--thing-at-point))
(type (car thing))
(value (cadr thing)))
(if (eq type 'ns)
(cider-find-ns nil value)
(cider-find-var current-prefix-arg value))))
(defun cider-browse-ns-handle-mouse (event)
"Handle mouse click EVENT."
(interactive "e")
(cider-browse-ns-operate-at-point))
(provide 'cider-browse-ns)
;;; cider-browse-ns.el ends here

112
elpa/cider-20160927.2135/cider-classpath.el
View File

@ -1,112 +0,0 @@
;;; cider-classpath.el --- Basic Java classpath browser
;; Copyright © 2014-2016 Bozhidar Batsov and CIDER contributors
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Basic Java classpath browser for CIDER.
;;; Code:
(require 'cider-client)
(require 'cider-popup)
(require 'cider-compat)
(defvar cider-classpath-buffer "*cider-classpath*")
(push cider-classpath-buffer cider-ancillary-buffers)
(defvar cider-classpath-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map cider-popup-buffer-mode-map)
(define-key map (kbd "RET") #'cider-classpath-operate-on-point)
(define-key map "n" #'next-line)
(define-key map "p" #'previous-line)
map))
(defvar cider-classpath-mouse-map
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] #'cider-classpath-handle-mouse)
map))
(define-derived-mode cider-classpath-mode special-mode "classpath"
"Major mode for browsing the entries in Java's classpath.
\\{cider-classpath-mode-map}"
(setq buffer-read-only t)
(setq-local electric-indent-chars nil)
(setq-local truncate-lines t))
(defun cider-classpath-list (buffer items)
"Populate BUFFER with ITEMS."
(with-current-buffer buffer
(cider-classpath-mode)
(let ((inhibit-read-only t))
(erase-buffer)
(dolist (item items)
(insert item "\n"))
(goto-char (point-min)))))
(defun cider-classpath-properties (text)
"Decorate TEXT with a clickable keymap and function face."
(let ((face (cond
((not (file-exists-p text)) 'font-lock-warning-face)
((file-directory-p text) 'dired-directory)
(t 'default))))
(propertize text
'font-lock-face face
'mouse-face 'highlight
'keymap cider-classpath-mouse-map)))
(defun cider-classpath-operate-on-point ()
"Expand browser according to thing at current point."
(interactive)
(let* ((bol (line-beginning-position))
(eol (line-end-position))
(line (buffer-substring-no-properties bol eol)))
(find-file-other-window line)))
(defun cider-classpath-handle-mouse (event)
"Handle mouse click EVENT."
(interactive "e")
(cider-classpath-operate-on-point))
;;;###autoload
(defun cider-classpath ()
"List all classpath entries."
(interactive)
(cider-ensure-connected)
(cider-ensure-op-supported "classpath")
(with-current-buffer (cider-popup-buffer cider-classpath-buffer t)
(cider-classpath-list (current-buffer)
(mapcar (lambda (name)
(cider-classpath-properties name))
(cider-sync-request:classpath)))))
;;;###autoload
(defun cider-open-classpath-entry ()
"Open a classpath entry."
(interactive)
(cider-ensure-connected)
(cider-ensure-op-supported "classpath")
(when-let ((entry (completing-read "Classpath entries: " (cider-sync-request:classpath))))
(find-file-other-window entry)))
(provide 'cider-classpath)
;;; cider-classpath.el ends here

1129
elpa/cider-20160927.2135/cider-client.el
View File

File diff suppressed because it is too large Load Diff

257
elpa/cider-20160927.2135/cider-common.el
View File

@ -1,257 +0,0 @@
;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*-
;; Copyright © 2015-2016 Artur Malabarba
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Common functions that are useful in both Clojure buffers and REPL
;; buffers.
;;; Code:
(require 'cider-compat)
(require 'nrepl-dict)
(require 'cider-util)
(require 'tramp)
(defcustom cider-prompt-for-symbol t
"Controls when to prompt for symbol when a command requires one.
When non-nil, always prompt, and use the symbol at point as the default
value at the prompt.
When nil, attempt to use the symbol at point for the command, and only
prompt if that throws an error."
:type '(choice (const :tag "always" t)
(const :tag "dwim" nil))
:group 'cider
:package-version '(cider . "0.9.0"))
(defun cider--should-prompt-for-symbol (&optional invert)
"Return the value of the variable `cider-prompt-for-symbol'.
Optionally invert the value, if INVERT is truthy."
(if invert (not cider-prompt-for-symbol) cider-prompt-for-symbol))
(defun cider-prompt-for-symbol-function (&optional invert)
"Prompt for symbol if funcall `cider--should-prompt-for-symbol' is truthy.
Otherwise attempt to use the symbol at point for the command, and only
prompt if that throws an error.
INVERT is used to invert the semantics of the function `cider--should-prompt-for-symbol'."
(if (cider--should-prompt-for-symbol invert)
#'cider-read-symbol-name
#'cider-try-symbol-at-point))
(defun cider--kw-to-symbol (kw)
"Convert the keyword KW to a symbol."
(when kw
(replace-regexp-in-string "\\`:+" "" kw)))
(declare-function cider-read-from-minibuffer "cider-interaction")
(defun cider-read-symbol-name (prompt callback)
"Read a symbol name using PROMPT with a default of the one at point.
Use CALLBACK as the completing read var callback."
(funcall callback (cider-read-from-minibuffer
prompt
;; if the thing at point is a keyword we treat it as symbol
(cider--kw-to-symbol (cider-symbol-at-point 'look-back)))))
(defun cider-try-symbol-at-point (prompt callback)
"Call CALLBACK with symbol at point.
On failure, read a symbol name using PROMPT and call CALLBACK with that."
(condition-case nil (funcall callback (cider--kw-to-symbol (cider-symbol-at-point 'look-back)))
('error (funcall callback (cider-read-from-minibuffer prompt)))))
(declare-function cider-jump-to "cider-interaction")
(defun cider--find-buffer-for-file (file)
"Return a buffer visiting FILE.
If FILE is a temp buffer name, return that buffer."
(if (string-prefix-p "*" file)
file
(and file
(not (cider--tooling-file-p file))
(cider-find-file file))))
(defun cider--jump-to-loc-from-info (info &optional other-window)
"Jump to location give by INFO.
INFO object is returned by `cider-var-info' or `cider-member-info'.
OTHER-WINDOW is passed to `cider-jump-to'."
(let* ((line (nrepl-dict-get info "line"))
(file (nrepl-dict-get info "file"))
(name (nrepl-dict-get info "name"))
;; the filename might actually be a REPL buffer name
(buffer (cider--find-buffer-for-file file)))
(if buffer
(cider-jump-to buffer (if line (cons line nil) name) other-window)
(error "No source location"))))
(declare-function url-filename "url-parse" (cl-x) t)
(defun cider--url-to-file (url)
"Return the filename from the resource URL.
Uses `url-generic-parse-url' to parse the url. The filename is extracted and
then url decoded. If the decoded filename has a Windows device letter followed
by a colon immediately after the leading '/' then the leading '/' is dropped to
create a valid path."
(let ((filename (url-unhex-string (url-filename (url-generic-parse-url url)))))
(if (string-match "^/\\([a-zA-Z]:/.*\\)" filename)
(match-string 1 filename)
filename)))
(defun cider-tramp-prefix (&optional buffer)
"Use the filename for BUFFER to determine a tramp prefix.
Defaults to the current buffer.
Return the tramp prefix, or nil if BUFFER is local."
(let* ((buffer (or buffer (current-buffer)))
(name (or (buffer-file-name buffer)
(with-current-buffer buffer
default-directory))))
(when (tramp-tramp-file-p name)
(let ((vec (tramp-dissect-file-name name)))
(tramp-make-tramp-file-name (tramp-file-name-method vec)
(tramp-file-name-user vec)
(tramp-file-name-host vec)
nil)))))
(defun cider--client-tramp-filename (name &optional buffer)
"Return the tramp filename for path NAME relative to BUFFER.
If BUFFER has a tramp prefix, it will be added as a prefix to NAME.
If the resulting path is an existing tramp file, it returns the path,
otherwise, nil."
(let* ((buffer (or buffer (current-buffer)))
(name (concat (cider-tramp-prefix buffer) name)))
(if (tramp-handle-file-exists-p name)
name)))
(defun cider--server-filename (name)
"Return the nREPL server-relative filename for NAME."
(if (tramp-tramp-file-p name)
(with-parsed-tramp-file-name name nil
localname)
name))
(defvar cider-from-nrepl-filename-function
(with-no-warnings
(if (eq system-type 'cygwin)
#'cygwin-convert-file-name-from-windows
#'identity))
"Function to translate nREPL namestrings to Emacs filenames.")
(defcustom cider-prefer-local-resources nil
"Prefer local resources to remote (tramp) ones when both are available."
:type 'boolean
:group 'cider)
(defun cider--file-path (path)
"Return PATH's local or tramp path using `cider-prefer-local-resources'.
If no local or remote file exists, return nil."
(let* ((local-path (funcall cider-from-nrepl-filename-function path))
(tramp-path (and local-path (cider--client-tramp-filename local-path))))
(cond ((equal local-path "") "")
((and cider-prefer-local-resources (file-exists-p local-path))
local-path)
((and tramp-path (file-exists-p tramp-path))
tramp-path)
((and local-path (file-exists-p local-path))
local-path))))
(declare-function archive-extract "arc-mode")
(declare-function archive-zip-extract "arc-mode")
(defun cider-find-file (url)
"Return a buffer visiting the file URL if it exists, or nil otherwise.
If URL has a scheme prefix, it must represent a fully-qualified file path
or an entry within a zip/jar archive. If URL doesn't contain a scheme
prefix and is an absolute path, it is treated as such. Finally, if URL is
relative, it is expanded within each of the open Clojure buffers till an
existing file ending with URL has been found."
(require 'arc-mode)
(cond ((string-match "^file:\\(.+\\)" url)
(when-let ((file (cider--url-to-file (match-string 1 url)))
(path (cider--file-path file)))
(find-file-noselect path)))
((string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" url)
(when-let ((entry (match-string 3 url))
(file (cider--url-to-file (match-string 2 url)))
(path (cider--file-path file))
(name (format "%s:%s" path entry)))
(or (find-buffer-visiting name)
(if (tramp-tramp-file-p path)
(progn
;; Use emacs built in archiving
(find-file path)
(goto-char (point-min))
;; Make sure the file path is followed by a newline to
;; prevent eg. clj matching cljs.
(search-forward (concat entry "\n"))
;; moves up to matching line
(forward-line -1)
(archive-extract)
(current-buffer))
;; Use external zip program to just extract the single file
(with-current-buffer (generate-new-buffer
(file-name-nondirectory entry))
(archive-zip-extract path entry)
(set-visited-file-name name)
(setq-local default-directory (file-name-directory path))
(setq-local buffer-read-only t)
(set-buffer-modified-p nil)
(set-auto-mode)
(current-buffer))))))
(t (if-let ((path (cider--file-path url)))
(find-file-noselect path)
(unless (file-name-absolute-p url)
(let ((cider-buffers (cider-util--clojure-buffers))
(url (file-name-nondirectory url)))
(or (cl-loop for bf in cider-buffers
for path = (with-current-buffer bf
(expand-file-name url))
if (and path (file-exists-p path))
return (find-file-noselect path))
(cl-loop for bf in cider-buffers
if (string= (buffer-name bf) url)
return bf))))))))
(defun cider--open-other-window-p (arg)
"Test prefix value ARG to see if it indicates displaying results in other window."
(let ((narg (prefix-numeric-value arg)))
(pcase narg
(-1 t) ; -
(16 t) ; empty empty
(_ nil))))
(defun cider-abbreviate-ns (namespace)
"Return a string that abbreviates NAMESPACE."
(when namespace
(let* ((names (reverse (split-string namespace "\\.")))
(lastname (car names)))
(concat (mapconcat (lambda (s) (concat (substring s 0 1) "."))
(reverse (cdr names))
"")
lastname))))
(defun cider-last-ns-segment (namespace)
"Return the last segment of NAMESPACE."
(when namespace
(car (reverse (split-string namespace "\\.")))))
(provide 'cider-common)
;;; cider-common.el ends here

157
elpa/cider-20160927.2135/cider-compat.el
View File

@ -1,157 +0,0 @@
;;; cider-compat.el --- Functions from newer Emacs versions for compatibility -*- lexical-binding: t -*-
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Pretty much everything here's copied from subr-x for compatibility with
;; Emacs 24.3 and 24.4.
;;; Code:
(eval-and-compile
(unless (fboundp 'internal--thread-argument)
(defmacro internal--thread-argument (first? &rest forms)
"Internal implementation for `thread-first' and `thread-last'.
When Argument FIRST? is non-nil argument is threaded first, else
last. FORMS are the expressions to be threaded."
(pcase forms
(`(,x (,f . ,args) . ,rest)
`(internal--thread-argument
,first? ,(if first? `(,f ,x ,@args) `(,f ,@args ,x)) ,@rest))
(`(,x ,f . ,rest) `(internal--thread-argument ,first? (,f ,x) ,@rest))
(_ (car forms)))))
(unless (fboundp 'thread-first)
(defmacro thread-first (&rest forms)
"Thread FORMS elements as the first argument of their successor.
Example:
(thread-first
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ (- (/ (+ 5 20) 25)) 40)
Note how the single `-' got converted into a list before
threading."
(declare (indent 1)
(debug (form &rest [&or symbolp (sexp &rest form)])))
`(internal--thread-argument t ,@forms)))
(unless (fboundp 'thread-last)
(defmacro thread-last (&rest forms)
"Thread FORMS elements as the last argument of their successor.
Example:
(thread-last
5
(+ 20)
(/ 25)
-
(+ 40))
Is equivalent to:
(+ 40 (- (/ 25 (+ 20 5))))
Note how the single `-' got converted into a list before
threading."
(declare (indent 1) (debug thread-first))
`(internal--thread-argument nil ,@forms))))
(eval-and-compile
(unless (fboundp 'internal--listify)
(defsubst internal--listify (elt)
"Wrap ELT in a list if it is not one."
(if (not (listp elt))
(list elt)
elt)))
(unless (fboundp 'internal--check-binding)
(defsubst internal--check-binding (binding)
"Check BINDING is properly formed."
(when (> (length binding) 2)
(signal
'error
(cons "`let' bindings can have only one value-form" binding)))
binding))
(unless (fboundp 'internal--build-binding-value-form)
(defsubst internal--build-binding-value-form (binding prev-var)
"Build the conditional value form for BINDING using PREV-VAR."
`(,(car binding) (and ,prev-var ,(cadr binding)))))
(unless (fboundp 'internal--build-binding)
(defun internal--build-binding (binding prev-var)
"Check and build a single BINDING with PREV-VAR."
(thread-first
binding
internal--listify
internal--check-binding
(internal--build-binding-value-form prev-var))))
(unless (fboundp 'internal--build-bindings)
(defun internal--build-bindings (bindings)
"Check and build conditional value forms for BINDINGS."
(let ((prev-var t))
(mapcar (lambda (binding)
(let ((binding (internal--build-binding binding prev-var)))
(setq prev-var (car binding))
binding))
bindings)))))
(eval-and-compile
(unless (fboundp 'if-let)
(defmacro if-let (bindings then &rest else)
"Process BINDINGS and if all values are non-nil eval THEN, else ELSE.
Argument BINDINGS is a list of tuples whose car is a symbol to be
bound and (optionally) used in THEN, and its cadr is a sexp to be
evalled to set symbol's value. In the special case you only want
to bind a single value, BINDINGS can just be a plain tuple."
(declare (indent 2)
(debug ([&or (&rest (symbolp form)) (symbolp form)] form body)))
(when (and (<= (length bindings) 2)
(not (listp (car bindings))))
;; Adjust the single binding case
(setq bindings (list bindings)))
`(let* ,(internal--build-bindings bindings)
(if ,(car (internal--listify (car (last bindings))))
,then
,@else))))
(unless (fboundp 'when-let)
(defmacro when-let (bindings &rest body)
"Process BINDINGS and if all values are non-nil eval BODY.
Argument BINDINGS is a list of tuples whose car is a symbol to be
bound and (optionally) used in BODY, and its cadr is a sexp to be
evalled to set symbol's value. In the special case you only want
to bind a single value, BINDINGS can just be a plain tuple."
(declare (indent 1) (debug if-let))
(list 'if-let bindings (macroexp-progn body)))))
(provide 'cider-compat)
;;; cider-compat.el ends here

752
elpa/cider-20160927.2135/cider-debug.el
View File

@ -1,752 +0,0 @@
;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*-
;; Copyright © 2015-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Instrument code with `cider-debug-defun-at-point', and when the code is
;; executed cider-debug will kick in. See this function's doc for more
;; information.
;;; Code:
(require 'nrepl-dict)
(require 'nrepl-client) ; `nrepl--mark-id-completed'
(require 'cider-interaction)
(require 'cider-client)
(require 'cider-util)
(require 'cider-inspector)
(require 'cider-browse-ns)
(require 'cider-common)
(require 'cider-compat)
(require 'seq)
(require 'spinner)
;;; Customization
(defgroup cider-debug nil
"Presentation and behaviour of the cider debugger."
:prefix "cider-debug-"
:group 'cider
:package-version '(cider . "0.10.0"))
(defface cider-debug-code-overlay-face
'((((class color) (background light)) :background "grey80")
(((class color) (background dark)) :background "grey30"))
"Face used to mark code being debugged."
:group 'cider-debug
:package-version '(cider . "0.9.1"))
(defface cider-debug-prompt-face
'((t :underline t :inherit font-lock-builtin-face))
"Face used to highlight keys in the debug prompt."
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defface cider-enlightened-face
'((((class color) (background light)) :inherit cider-result-overlay-face
:box (:color "darkorange" :line-width -1))
(((class color) (background dark)) :inherit cider-result-overlay-face
;; "#dd0" is a dimmer yellow.
:box (:color "#990" :line-width -1)))
"Face used to mark enlightened sexps and their return values."
:group 'cider-debug
:package-version '(cider . "0.11.0"))
(defface cider-enlightened-local-face
'((((class color) (background light)) :weight bold :foreground "darkorange")
(((class color) (background dark)) :weight bold :foreground "yellow"))
"Face used to mark enlightened locals (not their values)."
:group 'cider-debug
:package-version '(cider . "0.11.0"))
(defcustom cider-debug-prompt 'overlay
"If and where to show the keys while debugging.
If `minibuffer', show it in the minibuffer along with the return value.
If `overlay', show it in an overlay above the current function.
If t, do both.
If nil, don't list available keys at all."
:type '(choice (const :tag "Show in minibuffer" minibuffer)
(const :tag "Show above function" overlay)
(const :tag "Show in both places" t)
(const :tag "Don't list keys" nil))
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defcustom cider-debug-use-overlays t
"Whether to higlight debugging information with overlays.
Takes the same possible values as `cider-use-overlays', but only applies to
values displayed during debugging sessions.
To control the overlay that lists possible keys above the current function,
configure `cider-debug-prompt' instead."
:type '(choice (const :tag "End of line" t)
(const :tag "Bottom of screen" nil)
(const :tag "Both" both))
:group 'cider-debug
:package-version '(cider . "0.9.1"))
(defcustom cider-debug-print-level 10
"The print-level for values displayed by the debugger.
This variable must be set before starting the repl connection."
:type '(choice (const :tag "No limit" nil)
(integer :tag "Max depth" 10))
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defcustom cider-debug-print-length 10
"The print-length for values displayed by the debugger.
This variable must be set before starting the repl connection."
:type '(choice (const :tag "No limit" nil)
(integer :tag "Max depth" 10))
:group 'cider-debug
:package-version '(cider . "0.10.0"))
;;; Implementation
(defun cider-browse-instrumented-defs ()
"List all instrumented definitions."
(interactive)
(if-let ((all (thread-first (cider-nrepl-send-sync-request (list "op" "debug-instrumented-defs"))
(nrepl-dict-get "list"))))
(with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t)
(let ((inhibit-read-only t))
(erase-buffer)
(dolist (list all)
(let* ((ns (car list))
(ns-vars-with-meta (cider-sync-request:ns-vars-with-meta ns))
;; seq of metadata maps of the instrumented vars
(instrumented-meta (mapcar (apply-partially #'nrepl-dict-get ns-vars-with-meta)
(cdr list))))
(cider-browse-ns--list (current-buffer) ns
(seq-mapn #'cider-browse-ns--properties
(cdr list)
instrumented-meta)
ns 'noerase)
(goto-char (point-max))
(insert "\n"))))
(goto-char (point-min)))
(message "No currently instrumented definitions")))
(defun cider--debug-response-handler (response)
"Handles RESPONSE from the cider.debug middleware."
(nrepl-dbind-response response (status id causes)
(when (member "enlighten" status)
(cider--handle-enlighten response))
(when (or (member "eval-error" status)
(member "stack" status))
;; TODO: Make the error buffer a bit friendlier when we're just printing
;; the stack.
(cider--render-stacktrace-causes causes))
(when (member "need-debug-input" status)
(cider--handle-debug response))
(when (member "done" status)
(nrepl--mark-id-completed id))))
(defun cider--debug-init-connection ()
"Initialize a connection with the cider.debug middleware."
(cider-nrepl-send-request
(append '("op" "init-debugger")
(when cider-debug-print-level
(list "print-level" cider-debug-print-level))
(when cider-debug-print-length
(list "print-length" cider-debug-print-length)))
#'cider--debug-response-handler))
;;; Debugging overlays
(defconst cider--fringe-arrow-string
#("." 0 1 (display (left-fringe right-triangle)))
"Used as an overlay's before-string prop to place a fringe arrow.")
(defun cider--debug-display-result-overlay (value)
"Place an overlay at point displaying VALUE."
(when cider-debug-use-overlays
;; This is cosmetic, let's ensure it doesn't break the session no matter what.
(ignore-errors
;; Result
(cider--make-result-overlay (cider-font-lock-as-clojure value)
:where (point-marker)
:type 'debug-result
'before-string cider--fringe-arrow-string)
;; Code
(cider--make-overlay (save-excursion (clojure-backward-logical-sexp 1) (point))
(point) 'debug-code
'face 'cider-debug-code-overlay-face
;; Higher priority than `show-paren'.
'priority 2000))))
;;; Minor mode
(defvar-local cider--debug-mode-commands-dict nil
"An nrepl-dict from keys to debug commands.
Autogenerated by `cider--turn-on-debug-mode'.")
(defvar-local cider--debug-mode-response nil
"Response that triggered current debug session.
Set by `cider--turn-on-debug-mode'.")
(defcustom cider-debug-display-locals nil
"If non-nil, local variables are displayed while debugging.
Can be toggled at any time with `\\[cider-debug-toggle-locals]'."
:type 'boolean
:group 'cider-debug
:package-version '(cider . "0.10.0"))
(defun cider--debug-format-locals-list (locals)
"Return a string description of list LOCALS.
Each element of LOCALS should be a list of at least two elements."
(if locals
(let ((left-col-width
;; To right-indent the variable names.
(apply #'max (mapcar (lambda (l) (string-width (car l))) locals))))
;; A format string to build a format string. :-P
(mapconcat (lambda (l) (format (format " %%%ds: %%s\n" left-col-width)
(propertize (car l) 'face 'font-lock-variable-name-face)
(cider-font-lock-as-clojure (cadr l))))
locals ""))
""))
(defun cider--debug-prompt (command-dict)
"Return prompt to display for COMMAND-DICT."
;; Force `default' face, otherwise the overlay "inherits" the face of the text
;; after it.
(format (propertize "%s\n" 'face 'default)
(cider-string-join
(nrepl-dict-map (lambda (char cmd)
(when-let ((pos (cl-search char cmd)))
(put-text-property pos (1+ pos) 'face 'cider-debug-prompt-face cmd))
cmd)
command-dict)
" ")))
(defvar-local cider--debug-prompt-overlay nil)
(defun cider--debug-mode-redisplay ()
"Display the input prompt to the user."
(nrepl-dbind-response cider--debug-mode-response (debug-value input-type locals)
(when (or (eq cider-debug-prompt t)
(eq cider-debug-prompt 'overlay))
(if (overlayp cider--debug-prompt-overlay)
(overlay-put cider--debug-prompt-overlay
'before-string (cider--debug-prompt input-type))
(setq cider--debug-prompt-overlay
(cider--make-overlay
(max (car (cider-defun-at-point 'bounds))
(window-start))
nil 'debug-prompt
'before-string (cider--debug-prompt input-type)))))
(let* ((value (concat " " cider-eval-result-prefix
(cider-font-lock-as-clojure
(or debug-value "#unknown#"))))
(to-display
(concat (when cider-debug-display-locals
(cider--debug-format-locals-list locals))
(when (or (eq cider-debug-prompt t)
(eq cider-debug-prompt 'minibuffer))
(cider--debug-prompt input-type))
(when (or (not cider-debug-use-overlays)
(eq cider-debug-use-overlays 'both))
value))))
(if (> (string-width to-display) 0)
(message "%s" to-display)
;; If there's nothing to display in the minibuffer. Just send the value
;; to the Messages buffer.
(message "%s" value)
(message nil)))))
(defun cider-debug-toggle-locals ()
"Toggle display of local variables."
(interactive)
(setq cider-debug-display-locals (not cider-debug-display-locals))
(cider--debug-mode-redisplay))
(defun cider--debug-lexical-eval (key form &optional callback _point)
"Eval FORM in the lexical context of debug session given by KEY.
Do nothing if CALLBACK is provided.
Designed to be used as `cider-interactive-eval-override' and called instead
of `cider-interactive-eval' in debug sessions."
;; The debugger uses its own callback, so if the caller is passing a callback
;; we return nil and let `cider-interactive-eval' do its thing.
(unless callback
(cider-debug-mode-send-reply (format "{:response :eval, :code %s}" form)
key)
t))
(defvar cider--debug-mode-tool-bar-map
(let ((tool-bar-map (make-sparse-keymap)))
(tool-bar-add-item "right-arrow" #'cider-debug-mode-send-reply :next :label "Next step")
(tool-bar-add-item "next-node" #'cider-debug-mode-send-reply :continue :label "Continue non-stop")
(tool-bar-add-item "jump-to" #'cider-debug-mode-send-reply :out :label "Out of sexp")
(tool-bar-add-item "exit" #'cider-debug-mode-send-reply :quit :label "Quit")
tool-bar-map))
(defvar cider--debug-mode-map)
(define-minor-mode cider--debug-mode
"Mode active during debug sessions.
In order to work properly, this mode must be activated by
`cider--turn-on-debug-mode'."
nil " DEBUG" '()
(if cider--debug-mode
(if cider--debug-mode-response
(nrepl-dbind-response cider--debug-mode-response (input-type)
;; A debug session is an ongoing eval, but it's annoying to have the
;; spinner spinning while you debug.
(when spinner-current (spinner-stop))
(setq-local tool-bar-map cider--debug-mode-tool-bar-map)
(add-hook 'kill-buffer-hook #'cider--debug-quit nil 'local)
(add-hook 'before-revert-hook #'cider--debug-quit nil 'local)
(unless (consp input-type)
(error "Activated debug-mode on a message not asking for commands: %s" cider--debug-mode-response))
;; Integrate with eval commands.
(setq cider-interactive-eval-override
(apply-partially #'cider--debug-lexical-eval
(nrepl-dict-get cider--debug-mode-response "key")))
;; Set the keymap.
(nrepl-dict-map (lambda (char cmd)
(unless (string= char "h") ; `here' needs a special command.
(define-key cider--debug-mode-map char #'cider-debug-mode-send-reply))
(when (string= char "o")
(define-key cider--debug-mode-map (upcase char) #'cider-debug-mode-send-reply)))
input-type)
(setq cider--debug-mode-commands-dict input-type)
;; Show the prompt.
(cider--debug-mode-redisplay)
;; If a sync request is ongoing, the user can't act normally to
;; provide input, so we enter `recursive-edit'.
(when nrepl-ongoing-sync-request
(recursive-edit)))
(cider--debug-mode -1)
(if (called-interactively-p 'any)
(user-error (substitute-command-keys "Don't call this mode manually, use `\\[universal-argument] \\[cider-eval-defun-at-point]' instead"))
(error "Attempt to activate `cider--debug-mode' without setting `cider--debug-mode-response' first")))
(setq cider-interactive-eval-override nil)
(setq cider--debug-mode-commands-dict nil)
(setq cider--debug-mode-response nil)
;; We wait a moment before clearing overlays and the read-onlyness, so that
;; cider-nrepl has a chance to send the next message, and so that the user
;; doesn't accidentally hit `n' between two messages (thus editing the code).
(when-let ((proc (unless nrepl-ongoing-sync-request
(get-buffer-process (cider-current-connection)))))
(accept-process-output proc 1))
(unless cider--debug-mode
(setq buffer-read-only nil)
(cider--debug-remove-overlays (current-buffer)))
(when nrepl-ongoing-sync-request
(ignore-errors (exit-recursive-edit)))))
;;; Bind the `:here` command to both h and H, because it behaves differently if
;;; invoked with an uppercase letter.
(define-key cider--debug-mode-map "h" #'cider-debug-move-here)
(define-key cider--debug-mode-map "H" #'cider-debug-move-here)
(defun cider--debug-remove-overlays (&optional buffer)
"Remove CIDER debug overlays from BUFFER if variable `cider--debug-mode' is nil."
(when (or (not buffer) (buffer-live-p buffer))
(with-current-buffer (or buffer (current-buffer))
(unless cider--debug-mode
(kill-local-variable 'tool-bar-map)
(remove-overlays nil nil 'category 'debug-result)
(remove-overlays nil nil 'category 'debug-code)
(setq cider--debug-prompt-overlay nil)
(remove-overlays nil nil 'category 'debug-prompt)))))
(defun cider--debug-set-prompt (value)
"Set `cider-debug-prompt' to VALUE, then redisplay."
(setq cider-debug-prompt value)
(cider--debug-mode-redisplay))
(easy-menu-define cider-debug-mode-menu cider--debug-mode-map
"Menu for CIDER debug mode"
`("CIDER Debugger"
["Next step" (cider-debug-mode-send-reply ":next") :keys "n"]
["Continue non-stop" (cider-debug-mode-send-reply ":continue") :keys "c"]
["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"]
["Quit" (cider-debug-mode-send-reply ":quit") :keys "q"]
"--"
["Evaluate in current scope" (cider-debug-mode-send-reply ":eval") :keys "e"]
["Inject value" (cider-debug-mode-send-reply ":inject") :keys "i"]
["Inspect value" (cider-debug-mode-send-reply ":inspect")]
["Inspect local variables" (cider-debug-mode-send-reply ":locals") :keys "l"]
"--"
("Configure keys prompt"
["Don't show keys" (cider--debug-set-prompt nil) :style toggle :selected (eq cider-debug-prompt nil)]
["Show in minibuffer" (cider--debug-set-prompt 'minibuffer) :style toggle :selected (eq cider-debug-prompt 'minibuffer)]
["Show above function" (cider--debug-set-prompt 'overlay) :style toggle :selected (eq cider-debug-prompt 'overlay)]
["Show in both places" (cider--debug-set-prompt t) :style toggle :selected (eq cider-debug-prompt t)]
"--"
["List locals" cider-debug-toggle-locals :style toggle :selected cider-debug-display-locals])
["Customize" (customize-group 'cider-debug)]))
(defun cider--uppercase-command-p ()
"Return true if the last command was uppercase letter."
(ignore-errors
(let ((case-fold-search nil))
(string-match "[[:upper:]]" (string last-command-event)))))
(defun cider-debug-mode-send-reply (command &optional key force)
"Reply to the message that started current bufer's debugging session.
COMMAND is sent as the input option. KEY can be provided to reply to a
specific message. If FORCE is non-nil, send a \"force?\" argument in the
message."
(interactive (list
(if (symbolp last-command-event)
(symbol-name last-command-event)
(ignore-errors
(concat ":" (nrepl-dict-get cider--debug-mode-commands-dict
(downcase (string last-command-event))))))
nil
(cider--uppercase-command-p)))
(when (and (string-prefix-p ":" command) force)
(setq command (format "{:response %s :force? true}" command)))
(cider-nrepl-send-unhandled-request
(list "op" "debug-input" "input" (or command ":quit")
"key" (or key (nrepl-dict-get cider--debug-mode-response "key"))))
(ignore-errors (cider--debug-mode -1)))
(defun cider--debug-quit ()
"Send a :quit reply to the debugger. Used in hooks."
(when cider--debug-mode
(cider-debug-mode-send-reply ":quit")
(message "Quitting debug session")))
;;; Movement logic
(defconst cider--debug-buffer-format "*cider-debug %s*")
(defun cider--debug-trim-code (code)
"Remove whitespace and reader macros from the start of the CODE.
Return trimmed CODE."
(replace-regexp-in-string "\\`#[a-z]+[\n\r[:blank:]]*" "" code))
(declare-function cider-set-buffer-ns "cider-mode")
(defun cider--initialize-debug-buffer (code ns id &optional reason)
"Create a new debugging buffer with CODE and namespace NS.
ID is the id of the message that instrumented CODE.
REASON is a keyword describing why this buffer was necessary."
(let ((buffer-name (format cider--debug-buffer-format id)))
(if-let ((buffer (get-buffer buffer-name)))
(cider-popup-buffer-display buffer 'select)
(with-current-buffer (cider-popup-buffer buffer-name 'select
#'clojure-mode 'ancillary)
(cider-set-buffer-ns ns)
(setq buffer-undo-list nil)
(let ((inhibit-read-only t)
(buffer-undo-list t))
(erase-buffer)
(insert (format "%s" (cider--debug-trim-code code)))
(when code
(insert "\n\n\n;; We had to create this temporary buffer because we couldn't find the original definition. That probably happened because "
reason
".")
(fill-paragraph))
(cider--font-lock-ensure)
(set-buffer-modified-p nil))))
(switch-to-buffer buffer-name)
(goto-char (point-min))))
(defun cider--debug-goto-keyval (key)
"Find KEY in current sexp or return nil."
(when-let ((limit (ignore-errors (save-excursion (up-list) (point)))))
(search-forward-regexp (concat "\\_<" (regexp-quote key) "\\_>")
limit 'noerror)))
(defun cider--debug-move-point (coordinates)
"Place point on after the sexp specified by COORDINATES.
COORDINATES is a list of integers that specify how to navigate into the
sexp that is after point when this function is called.
As an example, a COORDINATES list of '(1 0 2) means:
- enter next sexp then `forward-sexp' once,
- enter next sexp,
- enter next sexp then `forward-sexp' twice.
In the following snippet, this takes us to the (* x 2) sexp (point is left
at the end of the given sexp).
(letfn [(twice [x]
(* x 2))]
(twice 15))
In addition to numbers, a coordinate can be a string. This string names the
key of a map, and it means \"go to the value associated with this key\"."
(condition-case-unless-debug nil
;; Navigate through sexps inside the sexp.
(let ((in-syntax-quote nil))
(while coordinates
(while (clojure--looking-at-non-logical-sexp)
(forward-sexp))
;; An `@x` is read as (deref x), so we pop coordinates once to account
;; for the extra depth, and move past the @ char.
(if (eq ?@ (char-after))
(progn (forward-char 1)
(pop coordinates))
(down-list)
;; Are we entering a syntax-quote?
(when (looking-back "`\\(#{\\|[{[(]\\)" (line-beginning-position))
;; If we are, this affects all nested structures until the next `~',
;; so we set this variable for all following steps in the loop.
(setq in-syntax-quote t))
(when in-syntax-quote
;; A `(. .) is read as (seq (concat (list .) (list .))). This pops
;; the `seq', since the real coordinates are inside the `concat'.
(pop coordinates)
;; Non-list seqs like `[] and `{} are read with
;; an extra (apply vector ...), so pop it too.
(unless (eq ?\( (char-before))
(pop coordinates)))
;; #(...) is read as (fn* ([] ...)), so we patch that here.
(when (looking-back "#(" (line-beginning-position))
(pop coordinates))
(if coordinates
(let ((next (pop coordinates)))
(when in-syntax-quote
;; We're inside the `concat' form, but we need to discard the
;; actual `concat' symbol from the coordinate.
(setq next (1- next)))
;; String coordinates are map keys.
(if (stringp next)
(cider--debug-goto-keyval next)
(clojure-forward-logical-sexp next)
(when in-syntax-quote
(clojure-forward-logical-sexp 1)
(forward-sexp -1)
;; Here a syntax-quote is ending.
(let ((match (when (looking-at "~@?")
(match-string 0))))
(when match
(setq in-syntax-quote nil))
;; A `~@' is read as the object itself, so we don't pop
;; anything.
(unless (equal "~@" match)
;; Anything else (including a `~') is read as a `list'
;; form inside the `concat', so we need to pop the list
;; from the coordinates.
(pop coordinates))))))
;; If that extra pop was the last coordinate, this represents the
;; entire #(...), so we should move back out.
(backward-up-list))))
;; Place point at the end of instrumented sexp.
(clojure-forward-logical-sexp 1))
;; Avoid throwing actual errors, since this happens on every breakpoint.
(error (message "Can't find instrumented sexp, did you edit the source?"))))
(defun cider--debug-position-for-code (code)
"Return non-nil if point is roughly before CODE.
This might move point one line above."
(or (looking-at-p (regexp-quote code))
(let ((trimmed (regexp-quote (cider--debug-trim-code code))))
(or (looking-at-p trimmed)
;; If this is a fake #dbg injected by `C-u
;; C-M-x', then the sexp we want is actually on
;; the line above.
(progn (forward-line -1)
(looking-at-p trimmed))))))
(defun cider--debug-find-source-position (response &optional create-if-needed)
"Return a marker of the position after the sexp specified in RESPONSE.
This marker might be in a different buffer! If the sexp can't be
found (file that contains the code is no longer visited or has been
edited), return nil. However, if CREATE-IF-NEEDED is non-nil, a new buffer
is created in this situation and the return value is never nil.
Follow the \"line\" and \"column\" entries in RESPONSE, and check whether
the code at point matches the \"code\" entry in RESPONSE. If it doesn't,
assume that the code in this file has been edited, and create a temp buffer
holding the original code.
Either way, navigate inside the code by following the \"coor\" entry which
is a coordinate measure in sexps."
(nrepl-dbind-response response (code file line column ns original-id coor)
(when (or code (and file line column))
;; This is for restoring current-buffer.
(save-excursion
(let ((out))
;; We prefer in-source debugging.
(when-let ((buf (and file line column
(ignore-errors
(cider--find-buffer-for-file file)))))
;; The logic here makes it hard to use `with-current-buffer'.
(with-current-buffer buf
;; This is for restoring point inside buf.
(save-excursion
;; Get to the proper line & column in the file
(forward-line (- line (line-number-at-pos)))
(move-to-column column)
;; Check if it worked
(when (cider--debug-position-for-code code)
;; Find the desired sexp.
(cider--debug-move-point coor)
(setq out (point-marker))))))
;; But we can create a temp buffer if that fails.
(or out
(when create-if-needed
(cider--initialize-debug-buffer
code ns original-id
(if (and line column)
"you edited the code"
"your tools.nrepl version is older than 0.2.11"))
(save-excursion
(cider--debug-move-point coor)
(point-marker)))))))))
(defun cider--handle-debug (response)
"Handle debugging notification.
RESPONSE is a message received from the nrepl describing the input
needed. It is expected to contain at least \"key\", \"input-type\", and
\"prompt\", and possibly other entries depending on the input-type."
(nrepl-dbind-response response (debug-value key input-type prompt inspect)
(condition-case-unless-debug e
(progn
(pcase input-type
("expression" (cider-debug-mode-send-reply
(condition-case nil
(cider-read-from-minibuffer
(or prompt "Expression: "))
(quit "nil"))
key))
((pred sequencep)
(let* ((marker (cider--debug-find-source-position response 'create-if-needed)))
(pop-to-buffer (marker-buffer marker))
(goto-char marker))
;; The overlay code relies on window boundaries, but point could have been
;; moved outside the window by some other code. Redisplay here to ensure the
;; visible window includes point.
(redisplay)
;; Remove overlays AFTER redisplaying! Otherwise there's a visible
;; flicker even if we immediately recreate the overlays.
(cider--debug-remove-overlays)
(when cider-debug-use-overlays
(cider--debug-display-result-overlay debug-value))
(setq cider--debug-mode-response response)
(cider--debug-mode 1)))
(when inspect
(cider-inspector--render-value inspect)))
;; If something goes wrong, we send a "quit" or the session hangs.
(error (cider-debug-mode-send-reply ":quit" key)
(message "Error encountered while handling the debug message: %S" e)))))
(defun cider--handle-enlighten (response)
"Handle an enlighten notification.
RESPONSE is a message received from the nrepl describing the value and
coordinates of a sexp. Create an overlay after the specified sexp
displaying its value."
(when-let ((marker (cider--debug-find-source-position response)))
(with-current-buffer (marker-buffer marker)
(save-excursion
(goto-char marker)
(clojure-backward-logical-sexp 1)
(nrepl-dbind-response response (debug-value erase-previous)
(when erase-previous
(remove-overlays (point) marker 'category 'enlighten))
(when debug-value
(if (memq (char-before marker) '(?\) ?\] ?}))
;; Enlightening a sexp looks like a regular return value, except
;; for a different border.
(cider--make-result-overlay (cider-font-lock-as-clojure debug-value)
:where (cons marker marker)
:type 'enlighten
:prepend-face 'cider-enlightened-face)
;; Enlightening a symbol uses a more abbreviated format. The
;; result face is the same as a regular result, but we also color
;; the symbol with `cider-enlightened-local-face'.
(cider--make-result-overlay (cider-font-lock-as-clojure debug-value)
:format "%s"
:where (cons (point) marker)
:type 'enlighten
'face 'cider-enlightened-local-face))))))))
;;; Move here command
;; This is the inverse of `cider--debug-move-point'. However, that algorithm is
;; complicated, and trying to code its inverse would probably be insane.
;; Instead, we find the coordinate by trial and error.
(defun cider--debug-find-coordinates-for-point (target &optional list-so-far)
"Return the coordinates list for reaching TARGET.
Assumes that the next thing after point is a logical Clojure sexp and that
TARGET is inside it. The returned list is suitable for use in
`cider--debug-move-point'. LIST-SO-FAR is for internal use."
(when (looking-at (rx (or "(" "[" "#{" "{")))
(let ((starting-point (point)))
(unwind-protect
(let ((x 0))
;; Keep incrementing the last coordinate until we've moved
;; past TARGET.
(while (condition-case nil
(progn (goto-char starting-point)
(cider--debug-move-point (append list-so-far (list x)))
(< (point) target))
;; Not a valid coordinate. Move back a step and stop here.
(scan-error (setq x (1- x))
nil))
(setq x (1+ x)))
(setq list-so-far (append list-so-far (list x)))
;; We have moved past TARGET, now determine whether we should
;; stop, or if target is deeper inside the previous sexp.
(if (or (= target (point))
(progn (forward-sexp -1)
(<= target (point))))
list-so-far
(goto-char starting-point)
(cider--debug-find-coordinates-for-point target list-so-far)))
;; `unwind-protect' clause.
(goto-char starting-point)))))
(defun cider-debug-move-here (&optional force)
"Skip any breakpoints up to point."
(interactive (list (cider--uppercase-command-p)))
(unless cider--debug-mode
(user-error "`cider-debug-move-here' only makes sense during a debug session"))
(let ((here (point)))
(nrepl-dbind-response cider--debug-mode-response (line column)
(if (and line column (buffer-file-name))
(progn ;; Get to the proper line & column in the file
(forward-line (1- (- line (line-number-at-pos))))
(move-to-column column))
(beginning-of-defun))
;; Is HERE inside the sexp being debugged?
(when (or (< here (point))
(save-excursion
(forward-sexp 1)
(> here (point))))
(user-error "Point is outside the sexp being debugged"))
;; Move forward untill start of sexp.
(comment-normalize-vars)
(comment-forward (point-max))
;; Find the coordinate and send it.
(cider-debug-mode-send-reply
(format "{:response :here, :coord %s :force? %s}"
(cider--debug-find-coordinates-for-point here)
(if force "true" "false"))))))
;;; User commands
;;;###autoload
(defun cider-debug-defun-at-point ()
"Instrument the \"top-level\" expression at point.
If it is a defn, dispatch the instrumented definition. Otherwise,
immediately evaluate the instrumented expression.
While debugged code is being evaluated, the user is taken through the
source code and displayed the value of various expressions. At each step,
a number of keys will be prompted to the user."
(interactive)
(cider-eval-defun-at-point 'debug-it))
(provide 'cider-debug)
;;; cider-debug.el ends here

522
elpa/cider-20160927.2135/cider-doc.el
View File

@ -1,522 +0,0 @@
;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*-
;; Copyright © 2014-2016 Bozhidar Batsov, Jeff Valk and CIDER contributors
;; Author: Jeff Valk <jv@jeffvalk.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Mode for formatting and presenting documentation
;;; Code:
(require 'cider-common)
(require 'cider-compat)
(require 'cider-util)
(require 'cider-popup)
(require 'cider-client)
(require 'cider-grimoire)
(require 'nrepl-dict)
(require 'org-table)
(require 'button)
(require 'easymenu)
;;; Variables
(defgroup cider-doc nil
"Documentation for CIDER."
:prefix "cider-doc-"
:group 'cider)
(defvar cider-doc-map
(let (cider-doc-map)
(define-prefix-command 'cider-doc-map)
(define-key cider-doc-map (kbd "a") #'cider-apropos)
(define-key cider-doc-map (kbd "C-a") #'cider-apropos)
(define-key cider-doc-map (kbd "s") #'cider-apropos-select)
(define-key cider-doc-map (kbd "C-s") #'cider-apropos-select)
(define-key cider-doc-map (kbd "f") #'cider-apropos-documentation)
(define-key cider-doc-map (kbd "C-f") #'cider-apropos-documentation)
(define-key cider-doc-map (kbd "e") #'cider-apropos-documentation-select)
(define-key cider-doc-map (kbd "C-e") #'cider-apropos-documentation-select)
(define-key cider-doc-map (kbd "d") #'cider-doc)
(define-key cider-doc-map (kbd "C-d") #'cider-doc)
(define-key cider-doc-map (kbd "r") #'cider-grimoire)
(define-key cider-doc-map (kbd "C-r") #'cider-grimoire)
(define-key cider-doc-map (kbd "w") #'cider-grimoire-web)
(define-key cider-doc-map (kbd "C-w") #'cider-grimoire-web)
(define-key cider-doc-map (kbd "j") #'cider-javadoc)
(define-key cider-doc-map (kbd "C-j") #'cider-javadoc)
cider-doc-map)
"CIDER documentation keymap.")
(defconst cider-doc-menu
'("Documentation"
["CiderDoc" cider-doc]
["JavaDoc in browser" cider-javadoc]
["Grimoire" cider-grimoire]
["Grimoire in browser" cider-grimoire-web]
["Search symbols" cider-apropos]
["Search symbols & select" cider-apropos-select]
["Search documentation" cider-apropos-documentation]
["Search documentation & select" cider-apropos-documentation-select]
"--"
["Configure Doc buffer" (customize-group 'cider-docview-mode)])
"CIDER documentation submenu.")
;;; cider-docview-mode
(defgroup cider-docview-mode nil
"Formatting/fontifying documentation viewer."
:prefix "cider-docview-"
:group 'cider)
(defcustom cider-docview-fill-column fill-column
"Fill column for docstrings in doc buffer."
:type 'list
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
;; Faces
(defface cider-docview-emphasis-face
'((t (:inherit default :underline t)))
"Face for emphasized text"
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
(defface cider-docview-strong-face
'((t (:inherit default :underline t :weight bold)))
"Face for strongly emphasized text"
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
(defface cider-docview-literal-face
'((t (:inherit font-lock-string-face)))
"Face for literal text"
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
(defface cider-docview-table-border-face
'((t (:inherit shadow)))
"Face for table borders"
:group 'cider-docview-mode
:package-version '(cider . "0.7.0"))
;; Colors & Theme Support
(defvar cider-docview-code-background-color
(cider-scale-background-color)
"Background color for code blocks.")
(defadvice enable-theme (after cider-docview-adapt-to-theme activate)
"When theme is changed, update `cider-docview-code-background-color'."
(setq cider-docview-code-background-color (cider-scale-background-color)))
;; Mode & key bindings
(defvar cider-docview-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "q" #'cider-popup-buffer-quit-function)
(define-key map "g" #'cider-docview-grimoire)
(define-key map "G" #'cider-docview-grimoire-web)
(define-key map "j" #'cider-docview-javadoc)
(define-key map "s" #'cider-docview-source)
(define-key map (kbd "<backtab>") #'backward-button)
(define-key map (kbd "TAB") #'forward-button)
(easy-menu-define cider-docview-mode-menu map
"Menu for CIDER's doc mode"
`("CiderDoc"
["Look up in Grimoire" cider-docview-grimoire]
["Look up in Grimoire (browser)" cider-docview-grimoire-web]
["JavaDoc in browser" cider-docview-javadoc]
["Jump to source" cider-docview-source]
"--"
["Quit" cider-popup-buffer-quit-function]
))
map))
(defvar cider-docview-symbol)
(defvar cider-docview-javadoc-url)
(defvar cider-docview-file)
(defvar cider-docview-line)
(define-derived-mode cider-docview-mode help-mode "Doc"
"Major mode for displaying CIDER documentation
\\{cider-docview-mode-map}"
(setq buffer-read-only t)
(setq-local truncate-lines t)
(setq-local electric-indent-chars nil)
(setq-local cider-docview-symbol nil)
(setq-local cider-docview-javadoc-url nil)
(setq-local cider-docview-file nil)
(setq-local cider-docview-line nil))
;;; Interactive functions
(defun cider-docview-javadoc ()
"Open the Javadoc for the current class, if available."
(interactive)
(if cider-docview-javadoc-url
(browse-url cider-docview-javadoc-url)
(error "No Javadoc available for %s" cider-docview-symbol)))
(defun cider-javadoc-handler (symbol-name)
"Invoke the nREPL \"info\" op on SYMBOL-NAME if available."
(when symbol-name
(let* ((info (cider-var-info symbol-name))
(url (nrepl-dict-get info "javadoc")))
(if url
(browse-url url)
(user-error "No Javadoc available for %s" symbol-name)))))
(defun cider-javadoc (arg)
"Open Javadoc documentation in a popup buffer.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates."
(interactive "P")
(cider-ensure-connected)
(cider-ensure-op-supported "info")
(funcall (cider-prompt-for-symbol-function arg)
"Javadoc for"
#'cider-javadoc-handler))
(declare-function cider-find-file "cider-common")
(declare-function cider-jump-to "cider-interaction")
(defun cider-docview-source ()
"Open the source for the current symbol, if available."
(interactive)
(if cider-docview-file
(if-let ((buffer (and (not (cider--tooling-file-p cider-docview-file))
(cider-find-file cider-docview-file))))
(cider-jump-to buffer (if cider-docview-line
(cons cider-docview-line nil)
cider-docview-symbol)
nil)
(user-error
(substitute-command-keys
"Can't find the source because it wasn't defined with `cider-eval-buffer'")))
(error "No source location for %s" cider-docview-symbol)))
(defvar cider-buffer-ns)
(declare-function cider-grimoire-lookup "cider-grimoire")
(defun cider-docview-grimoire ()
"Return the grimoire documentation for `cider-docview-symbol'."
(interactive)
(if cider-buffer-ns
(cider-grimoire-lookup cider-docview-symbol)
(error "%s cannot be looked up on Grimoire" cider-docview-symbol)))
(declare-function cider-grimoire-web-lookup "cider-grimoire")
(defun cider-docview-grimoire-web ()
"Open the grimoire documentation for `cider-docview-symbol' in a web browser."
(interactive)
(if cider-buffer-ns
(cider-grimoire-web-lookup cider-docview-symbol)
(error "%s cannot be looked up on Grimoire" cider-docview-symbol)))
(defconst cider-doc-buffer "*cider-doc*")
(add-to-list 'cider-ancillary-buffers cider-doc-buffer)
(defun cider-create-doc-buffer (symbol)
"Populates *cider-doc* with the documentation for SYMBOL."
(when-let ((info (cider-var-info symbol)))
(cider-docview-render (cider-make-popup-buffer cider-doc-buffer) symbol info)))
(defun cider-doc-lookup (symbol)
"Look up documentation for SYMBOL."
(if-let ((buffer (cider-create-doc-buffer symbol)))
(cider-popup-buffer-display buffer t)
(user-error "Symbol %s not resolved" symbol)))
(defun cider-doc (&optional arg)
"Open Clojure documentation in a popup buffer.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates."
(interactive "P")
(cider-ensure-connected)
(funcall (cider-prompt-for-symbol-function arg)
"Doc for"
#'cider-doc-lookup))
;;; Font Lock and Formatting
(defun cider-docview-fontify-code-blocks (buffer mode)
"Font lock BUFFER code blocks using MODE and remove markdown characters.
This processes the triple backtick GFM markdown extension. An overlay is used
to shade the background. Blocks are marked to be ignored by other fonification
and line wrap."
(with-current-buffer buffer
(save-excursion
(while (search-forward-regexp "```\n" nil t)
(replace-match "")
(let ((beg (point))
(bg `(:background ,cider-docview-code-background-color)))
(when (search-forward-regexp "```\n" nil t)
(replace-match "")
(cider-font-lock-region-as mode beg (point))
(overlay-put (make-overlay beg (point)) 'font-lock-face bg)
(put-text-property beg (point) 'block 'code)))))))
(defun cider-docview-fontify-literals (buffer)
"Font lock BUFFER literal text and remove backtick markdown characters.
Preformatted code text blocks are ignored."
(with-current-buffer buffer
(save-excursion
(while (search-forward "`" nil t)
(if (eq (get-text-property (point) 'block) 'code)
(forward-char)
(progn
(replace-match "")
(let ((beg (point)))
(when (search-forward "`" (line-end-position) t)
(replace-match "")
(put-text-property beg (point) 'font-lock-face 'cider-docview-literal-face)))))))))
(defun cider-docview-fontify-emphasis (buffer)
"Font lock BUFFER emphasized text and remove markdown characters.
One '*' represents emphasis, multiple '**'s represent strong emphasis.
Preformatted code text blocks are ignored."
(with-current-buffer buffer
(save-excursion
(while (search-forward-regexp "\\(*+\\)\\(\\w\\)" nil t)
(if (eq (get-text-property (point) 'block) 'code)
(forward-char)
(progn
(replace-match "\\2")
(let ((beg (1- (point)))
(face (if (> (length (match-string 1)) 1)
'cider-docview-strong-face
'cider-docview-emphasis-face)))
(when (search-forward-regexp "\\(\\w\\)\\*+" (line-end-position) t)
(replace-match "\\1")
(put-text-property beg (point) 'font-lock-face face)))))))))
(defun cider-docview-format-tables (buffer)
"Align BUFFER tables and dim borders.
This processes the GFM table markdown extension using `org-table'.
Tables are marked to be ignored by line wrap."
(with-current-buffer buffer
(save-excursion
(let ((border 'cider-docview-table-border-face))
(org-table-map-tables
(lambda ()
(org-table-align)
(goto-char (org-table-begin))
(while (search-forward-regexp "[+|-]" (org-table-end) t)
(put-text-property (match-beginning 0) (match-end 0) 'font-lock-face border))
(put-text-property (org-table-begin) (org-table-end) 'block 'table)))))))
(defun cider-docview-wrap-text (buffer)
"For text in BUFFER not propertized as 'block', apply line wrap."
(with-current-buffer buffer
(save-excursion
(while (not (eobp))
(unless (get-text-property (point) 'block)
(fill-region (point) (line-end-position)))
(forward-line)))))
;;; Rendering
(defun cider-docview-render-java-doc (buffer text)
"Emit into BUFFER formatted doc TEXT for a Java class or member."
(with-current-buffer buffer
(let ((beg (point)))
(insert text)
(save-excursion
(goto-char beg)
(cider-docview-fontify-code-blocks buffer 'java-mode) ; left alone hereafter
(cider-docview-fontify-literals buffer)
(cider-docview-fontify-emphasis buffer)
(cider-docview-format-tables buffer) ; may contain literals, emphasis
(cider-docview-wrap-text buffer))))) ; ignores code, table blocks
(defun cider--abbreviate-file-protocol (file-with-protocol)
"Abbreviate the file-path in `file:/path/to/file'."
(if (string-match "\\`file:\\(.*\\)" file-with-protocol)
(let ((file (match-string 1 file-with-protocol))
(proj-dir (clojure-project-dir)))
(if (and proj-dir
(file-in-directory-p file proj-dir))
(file-relative-name file proj-dir)
file))
file-with-protocol))
(defun cider-docview-render-info (buffer info)
"Emit into BUFFER formatted INFO for the Clojure or Java symbol."
(let* ((ns (nrepl-dict-get info "ns"))
(name (nrepl-dict-get info "name"))
(added (nrepl-dict-get info "added"))
(depr (nrepl-dict-get info "deprecated"))
(macro (nrepl-dict-get info "macro"))
(special (nrepl-dict-get info "special-form"))
(forms (nrepl-dict-get info "forms-str"))
(args (nrepl-dict-get info "arglists-str"))
(doc (or (nrepl-dict-get info "doc")
"Not documented."))
(url (nrepl-dict-get info "url"))
(class (nrepl-dict-get info "class"))
(member (nrepl-dict-get info "member"))
(javadoc (nrepl-dict-get info "javadoc"))
(super (nrepl-dict-get info "super"))
(ifaces (nrepl-dict-get info "interfaces"))
(spec (nrepl-dict-get info "spec"))
(clj-name (if ns (concat ns "/" name) name))
(java-name (if member (concat class "/" member) class))
(see-also (nrepl-dict-get info "see-also")))
(cider--help-setup-xref (list #'cider-doc-lookup (format "%s/%s" ns name)) nil buffer)
(with-current-buffer buffer
(cl-flet ((emit (text &optional face)
(insert (if face
(propertize text 'font-lock-face face)
text)
"\n")))
(emit (if class java-name clj-name) 'font-lock-function-name-face)
(when super
(emit (concat " Extends: " (cider-font-lock-as 'java-mode super))))
(when ifaces
(emit (concat "Implements: " (cider-font-lock-as 'java-mode (car ifaces))))
(dolist (iface (cdr ifaces))
(emit (concat " "(cider-font-lock-as 'java-mode iface)))))
(when (or super ifaces)
(insert "\n"))
(when (or forms args)
(insert " ")
(save-excursion
(emit (cider-font-lock-as-clojure
;; All `defn's use ([...] [...]), but some special forms use
;; (...). We only remove the parentheses on the former.
(replace-regexp-in-string "\\`(\\(\\[.*\\]\\))\\'" "\\1"
(or forms args)))))
;; It normally doesn't happen, but it's technically conceivable for
;; the args string to contain unbalanced sexps, so `ignore-errors'.
(ignore-errors
(forward-sexp 1)
(while (not (looking-at "$"))
(insert "\n")
(forward-sexp 1)))
(forward-line 1))
(when (or special macro)
(emit (if special "Special Form" "Macro") 'font-lock-variable-name-face))
(when added
(emit (concat "Added in " added) 'font-lock-comment-face))
(when depr
(emit (concat "Deprecated in " depr) 'font-lock-keyword-face))
(if class
(cider-docview-render-java-doc (current-buffer) doc)
(emit (concat " " doc)))
(when url
(insert "\n Please see ")
(insert-text-button url
'url url
'follow-link t
'action (lambda (x)
(browse-url (button-get x 'url))))
(insert "\n"))
(when javadoc
(insert "\n\nFor additional documentation, see the ")
(insert-text-button "Javadoc"
'url javadoc
'follow-link t
'action (lambda (x)
(browse-url (button-get x 'url))))
(insert ".\n"))
(insert "\n")
(when spec
(emit "Spec: " 'font-lock-function-name-face)
(mapc (lambda (s) (insert s "\n")) spec)
(insert "\n"))
(if cider-docview-file
(progn
(insert (propertize (if class java-name clj-name)
'font-lock-face 'font-lock-function-name-face)
" is defined in ")
(insert-text-button (cider--abbreviate-file-protocol cider-docview-file)
'follow-link t
'action (lambda (_x)
(cider-docview-source)))
(insert "."))
(insert "Definition location unavailable."))
(when see-also
(insert "\n\n Also see: ")
(mapc (lambda (ns-sym)
(let* ((ns-sym-split (split-string ns-sym "/"))
(see-also-ns (car ns-sym-split))
(see-also-sym (cadr ns-sym-split))
;; if the var belongs to the same namespace,
;; we omit the namespace to save some screen space
(symbol (if (equal ns see-also-ns) see-also-sym ns-sym)))
(insert-button symbol
'type 'help-xref
'help-function (apply-partially #'cider-doc-lookup symbol)))
(insert " "))
see-also))
(cider--doc-make-xrefs)
(let ((beg (point-min))
(end (point-max)))
(nrepl-dict-map (lambda (k v)
(put-text-property beg end k v))
info)))
(current-buffer))))
(declare-function cider-set-buffer-ns "cider-mode")
(defun cider-docview-render (buffer symbol info)
"Emit into BUFFER formatted documentation for SYMBOL's INFO."
(with-current-buffer buffer
(let ((javadoc (nrepl-dict-get info "javadoc"))
(file (nrepl-dict-get info "file"))
(line (nrepl-dict-get info "line"))
(ns (nrepl-dict-get info "ns"))
(inhibit-read-only t))
(cider-docview-mode)
(cider-set-buffer-ns ns)
(setq-local cider-docview-symbol symbol)
(setq-local cider-docview-javadoc-url javadoc)
(setq-local cider-docview-file file)
(setq-local cider-docview-line line)
(remove-overlays)
(cider-docview-render-info buffer info)
(goto-char (point-min))
(current-buffer))))
(provide 'cider-doc)
;;; cider-doc.el ends here

430
elpa/cider-20160927.2135/cider-eldoc.el
View File

@ -1,430 +0,0 @@
;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*-
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Artur Malabarba <bruce.connor.am@gmail.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; eldoc support for Clojure.
;;; Code:
(require 'cider-client)
(require 'cider-common) ; for cider-symbol-at-point
(require 'cider-compat)
(require 'cider-util)
(require 'nrepl-dict)
(require 'seq)
(require 'eldoc)
(defvar cider-extra-eldoc-commands '("yas-expand")
"Extra commands to be added to eldoc's safe commands list.")
(defvar cider-eldoc-max-num-sexps-to-skip 30
"The maximum number of sexps to skip while searching the beginning of current sexp.")
(defvar-local cider-eldoc-last-symbol nil
"The eldoc information for the last symbol we checked.")
(defcustom cider-eldoc-ns-function #'identity
"A function that returns a ns string to be used by eldoc.
Takes one argument, a namespace name.
For convenience, some functions are already provided for this purpose:
`cider-abbreviate-ns', and `cider-last-ns-segment'."
:type '(choice (const :tag "Full namespace" identity)
(const :tag "Abbreviated namespace" cider-abbreviate-ns)
(const :tag "Last name in namespace" cider-last-ns-segment)
(function :tag "Custom function"))
:group 'cider
:package-version '(cider . "0.13.0"))
(defcustom cider-eldoc-max-class-names-to-display 3
"The maximum number of classes to display in an eldoc string.
An eldoc string for Java interop forms can have a number of classes prefixed to
it, when the form belongs to more than 1 class. When, not nil we only display
the names of first `cider-eldoc-max-class-names-to-display' classes and add
a \"& x more\" suffix. Otherwise, all the classes are displayed."
:type 'integer
:safe #'integerp
:group 'cider
:package-version '(cider . "0.13.0"))
(defcustom cider-eldoc-display-for-symbol-at-point t
"When non-nil, display eldoc for symbol at point if available.
So in (map inc ...) when the cursor is over inc its eldoc would be
displayed. When nil, always display eldoc for first symbol of the sexp."
:type 'boolean
:safe 'booleanp
:group 'cider
:package-version '(cider . "0.13.0"))
(defun cider--eldoc-format-class-names (class-names)
"Return a formatted CLASS-NAMES prefix string.
CLASS-NAMES is a list of classes to which a Java interop form belongs.
Only keep the first `cider-eldoc-max-class-names-to-display' names, and
add a \"& x more\" suffix. Return nil if the CLASS-NAMES list is empty or
mapping `cider-eldoc-ns-function' on it returns an empty list."
(when-let ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names)))
(eldoc-class-names-length (length eldoc-class-names)))
(cond
;; truncate class-names list and then format it
((and cider-eldoc-max-class-names-to-display
(> eldoc-class-names-length cider-eldoc-max-class-names-to-display))
(format "(%s & %s more)"
(thread-first eldoc-class-names
(seq-take cider-eldoc-max-class-names-to-display)
(cider-string-join " ")
(cider-propertize 'ns))
(- eldoc-class-names-length cider-eldoc-max-class-names-to-display)))
;; format the whole list but add surrounding parentheses
((> eldoc-class-names-length 1)
(format "(%s)"
(thread-first eldoc-class-names
(cider-string-join " ")
(cider-propertize 'ns))))
;; don't add the parentheses
(t (format "%s" (car eldoc-class-names))))))
(defun cider-eldoc-format-thing (ns symbol thing type)
"Format the eldoc subject defined by NS, SYMBOL and THING.
THING represents the thing at point which triggered eldoc. Normally NS and
SYMBOL are used (they are derived from THING), but when empty we fallback to
THING (e.g. for Java methods). Format it as a function, if FUNCTION-P
is non-nil. Else format it as a variable."
(if-let ((method-name (if (and symbol (not (string= symbol "")))
symbol
thing))
(propertized-method-name (cider-propertize method-name type))
(ns-or-class (if (and ns (stringp ns))
(funcall cider-eldoc-ns-function ns)
(cider--eldoc-format-class-names ns))))
(format "%s/%s"
;; we set font-lock properties of classes in `cider--eldoc-format-class-names'
;; to avoid font locking the parentheses and "& x more"
;; so we only propertize ns-or-class if not already done
(if (get-text-property 1 'face ns-or-class)
;; it is already propertized
ns-or-class
(cider-propertize ns-or-class 'ns))
propertized-method-name)
;; in case ns-or-class is nil
propertized-method-name))
(defun cider-eldoc-format-sym-doc (var ns docstring)
"Return the formatted eldoc string for VAR and DOCSTRING.
Consider the value of `eldoc-echo-area-use-multiline-p' while formatting.
If the entire line cannot fit in the echo area, the var name may be
truncated or eliminated entirely from the output to make room for the
description.
Try to truncate the var with various strategies, so that the var and
the docstring can be displayed in the minibuffer without resizing the window.
We start with `cider-abbreviate-ns' and `cider-last-ns-segment'.
Next, if the var is in current namespace, we remove NS from the eldoc string.
Otherwise, only the docstring is returned."
(let* ((ea-multi eldoc-echo-area-use-multiline-p)
;; Subtract 1 from window width since emacs will not write
;; any chars to the last column, or in later versions, will
;; cause a wraparound and resize of the echo area.
(ea-width (1- (window-width (minibuffer-window))))
(strip (- (+ (length var) (length docstring)) ea-width))
(newline (string-match-p "\n" docstring))
;; Truncated var can be ea-var long
;; Subtract 2 to account for the : and / added when including
;; the namespace prefixed form in eldoc string
(ea-var (- (- ea-width (length docstring)) 2)))
(cond
((or (eq ea-multi t)
(and (<= strip 0) (null newline))
(and ea-multi (or (> (length docstring) ea-width) newline)))
(format "%s: %s" var docstring))
;; Now we have to truncate either the docstring or the var
(newline (cider-eldoc-format-sym-doc var ns (substring docstring 0 newline)))
;; Only return the truncated docstring
((> (length docstring) ea-width)
(substring docstring 0 ea-width))
;; Try to truncate the var with cider-abbreviate-ns
((<= (length (cider-abbreviate-ns var)) ea-var)
(format "%s: %s" (cider-abbreviate-ns var) docstring))
;; Try to truncate var with cider-last-ns-segment
((<= (length (cider-last-ns-segment var)) ea-var)
(format "%s: %s" (cider-last-ns-segment var) docstring))
;; If the var is in current namespace, we try to truncate the var by
;; skipping the namespace from the returned eldoc string
((and (string-equal ns (cider-current-ns))
(<= (- (length var) (length ns)) ea-var))
(format "%s: %s"
(replace-regexp-in-string (format "%s/" ns) "" var)
docstring))
;; We couldn't fit the var and docstring in the available space,
;; so we just display the docstring
(t docstring))))
(defun cider-eldoc-format-variable (thing pos eldoc-info)
"Return the formatted eldoc string for a variable.
THING is the variable name. POS will always be 0 here.
ELDOC-INFO is a p-list containing the eldoc information."
(let* ((ns (lax-plist-get eldoc-info "ns"))
(symbol (lax-plist-get eldoc-info "symbol"))
(docstring (lax-plist-get eldoc-info "docstring"))
(formatted-var (cider-eldoc-format-thing ns symbol thing 'var)))
(when docstring
(cider-eldoc-format-sym-doc formatted-var ns docstring))))
(defun cider-eldoc-format-function (thing pos eldoc-info)
"Return the formatted eldoc string for a function.
THING is the function name. POS is the argument-index of the functions
arglists. ELDOC-INFO is a p-list containing the eldoc information."
(let ((ns (lax-plist-get eldoc-info "ns"))
(symbol (lax-plist-get eldoc-info "symbol"))
(arglists (lax-plist-get eldoc-info "arglists")))
(format "%s: %s"
(cider-eldoc-format-thing ns symbol thing 'fn)
(cider-eldoc-format-arglist arglists pos))))
(defun cider-highlight-args (arglist pos)
"Format the the function ARGLIST for eldoc.
POS is the index of the currently highlighted argument."
(let* ((rest-pos (cider--find-rest-args-position arglist))
(i 0))
(mapconcat
(lambda (arg)
(let ((argstr (format "%s" arg)))
(if (string= arg "&")
argstr
(prog1
(if (or (= (1+ i) pos)
(and rest-pos
(> (1+ i) rest-pos)
(> pos rest-pos)))
(propertize argstr 'face
'eldoc-highlight-function-argument)
argstr)
(setq i (1+ i)))))) arglist " ")))
(defun cider--find-rest-args-position (arglist)
"Find the position of & in the ARGLIST vector."
(seq-position arglist "&"))
(defun cider-highlight-arglist (arglist pos)
"Format the ARGLIST for eldoc.
POS is the index of the argument to highlight."
(concat "[" (cider-highlight-args arglist pos) "]"))
(defun cider-eldoc-format-arglist (arglist pos)
"Format all the ARGLIST for eldoc.
POS is the index of current argument."
(concat "("
(mapconcat (lambda (args) (cider-highlight-arglist args pos))
arglist
" ")
")"))
(defun cider-eldoc-beginning-of-sexp ()
"Move to the beginning of current sexp.
Return the number of nested sexp the point was over or after. Return nil
if the maximum number of sexps to skip is exceeded."
(let ((parse-sexp-ignore-comments t)
(num-skipped-sexps 0))
(condition-case _
(progn
;; First account for the case the point is directly over a
;; beginning of a nested sexp.
(condition-case _
(let ((p (point)))
(forward-sexp -1)
(forward-sexp 1)
(when (< (point) p)
(setq num-skipped-sexps 1)))
(error))
(while
(let ((p (point)))
(forward-sexp -1)
(when (< (point) p)
(setq num-skipped-sexps
(unless (and cider-eldoc-max-num-sexps-to-skip
(>= num-skipped-sexps
cider-eldoc-max-num-sexps-to-skip))
;; Without the above guard,
;; `cider-eldoc-beginning-of-sexp' could traverse the
;; whole buffer when the point is not within a
;; list. This behavior is problematic especially with
;; a buffer containing a large number of
;; non-expressions like a REPL buffer.
(1+ num-skipped-sexps)))))))
(error))
num-skipped-sexps))
(defun cider-eldoc-thing-type (eldoc-info)
"Return the type of the thing being displayed by eldoc.
It can be a function or var now."
(pcase (lax-plist-get eldoc-info "type")
("function" 'fn)
("variable" 'var)))
(defun cider-eldoc-info-at-point ()
"Return eldoc info at point.
First go to the beginning of the sexp and check if the eldoc is to be
considered (i.e sexp is a method call) and not a map or vector literal.
Then go back to the point and return its eldoc."
(save-excursion
(unless (cider-in-comment-p)
(let* ((current-point (point)))
(cider-eldoc-beginning-of-sexp)
(unless (member (or (char-before (point)) 0) '(?\" ?\{ ?\[))
(goto-char current-point)
(when-let (eldoc-info (cider-eldoc-info
(cider--eldoc-remove-dot (cider-symbol-at-point))))
(list "eldoc-info" eldoc-info
"thing" (cider-symbol-at-point)
"pos" 0)))))))
(defun cider-eldoc-info-at-sexp-beginning ()
"Return eldoc info for first symbol in the sexp."
(save-excursion
(when-let ((beginning-of-sexp (cider-eldoc-beginning-of-sexp))
;; If we are at the beginning of function name, this will be -1
(argument-index (max 0 (1- beginning-of-sexp))))
(unless (or (memq (or (char-before (point)) 0)
'(?\" ?\{ ?\[))
(cider-in-comment-p))
(when-let (eldoc-info (cider-eldoc-info
(cider--eldoc-remove-dot (cider-symbol-at-point))))
(list "eldoc-info" eldoc-info
"thing" (cider-symbol-at-point)
"pos" argument-index))))))
(defun cider-eldoc-info-in-current-sexp ()
"Return eldoc information from the sexp.
If `cider-eldoc-display-for-symbol-at-poin' is non-nil and
the symbol at point has a valid eldoc available, return that.
Otherwise return the eldoc of the first symbol of the sexp."
(or (when cider-eldoc-display-for-symbol-at-point
(cider-eldoc-info-at-point))
(cider-eldoc-info-at-sexp-beginning)))
(defun cider-eldoc--convert-ns-keywords (thing)
"Convert THING values that match ns macro keywords to function names."
(pcase thing
(":import" "clojure.core/import")
(":refer-clojure" "clojure.core/refer-clojure")
(":use" "clojure.core/use")
(":refer" "clojure.core/refer")
(_ thing)))
(defun cider-eldoc-info (thing)
"Return the info for THING.
This includes the arglist and ns and symbol name (if available)."
(let ((thing (cider-eldoc--convert-ns-keywords thing)))
(when (and (cider-nrepl-op-supported-p "eldoc")
thing
;; ignore empty strings
(not (string= thing ""))
;; ignore strings
(not (string-prefix-p "\"" thing))
;; ignore regular expressions
(not (string-prefix-p "#" thing))
;; ignore chars
(not (string-prefix-p "\\" thing))
;; ignore numbers
(not (string-match-p "^[0-9]" thing)))
;; check if we can used the cached eldoc info
(cond
;; handle keywords for map access
((string-prefix-p ":" thing) (list "symbol" thing
"type" "function"
"arglists" '(("map") ("map" "not-found"))))
;; handle Classname. by displaying the eldoc for new
((string-match-p "^[A-Z].+\\.$" thing) (list "symbol" thing
"type" "function"
"arglists" '(("args*"))))
;; generic case
(t (if (equal thing (car cider-eldoc-last-symbol))
(cadr cider-eldoc-last-symbol)
(when-let ((eldoc-info (cider-sync-request:eldoc thing)))
(let* ((arglists (nrepl-dict-get eldoc-info "eldoc"))
(docstring (nrepl-dict-get eldoc-info "docstring"))
(type (nrepl-dict-get eldoc-info "type"))
(ns (nrepl-dict-get eldoc-info "ns"))
(class (nrepl-dict-get eldoc-info "class"))
(name (nrepl-dict-get eldoc-info "name"))
(member (nrepl-dict-get eldoc-info "member"))
(ns-or-class (if (and ns (not (string= ns "")))
ns
class))
(name-or-member (if (and name (not (string= name "")))
name
(format ".%s" member)))
(eldoc-plist (list "ns" ns-or-class
"symbol" name-or-member
"arglists" arglists
"docstring" docstring
"type" type)))
;; middleware eldoc lookups are expensive, so we
;; cache the last lookup. This eliminates the need
;; for extra middleware requests within the same sexp.
(setq cider-eldoc-last-symbol (list thing eldoc-plist))
eldoc-plist))))))))
(defun cider--eldoc-remove-dot (sym)
"Remove the preceding \".\" from a namespace qualified SYM and return sym.
Only useful for interop forms. Clojure forms would be returned unchanged."
(when sym (replace-regexp-in-string "/\\." "/" sym)))
(defun cider-eldoc ()
"Backend function for eldoc to show argument list in the echo area."
(when (and (cider-connected-p)
;; don't clobber an error message in the minibuffer
(not (member last-command '(next-error previous-error))))
(let* ((sexp-eldoc-info (cider-eldoc-info-in-current-sexp))
(eldoc-info (lax-plist-get sexp-eldoc-info "eldoc-info"))
(pos (lax-plist-get sexp-eldoc-info "pos"))
(thing (lax-plist-get sexp-eldoc-info "thing")))
(when eldoc-info
(if (equal (cider-eldoc-thing-type eldoc-info) 'fn)
(cider-eldoc-format-function thing pos eldoc-info)
(cider-eldoc-format-variable thing pos eldoc-info))))))
(defun cider-eldoc-setup ()
"Setup eldoc in the current buffer.
eldoc mode has to be enabled for this to have any effect."
(setq-local eldoc-documentation-function #'cider-eldoc)
(apply #'eldoc-add-command cider-extra-eldoc-commands))
(provide 'cider-eldoc)
;;; cider-eldoc.el ends here

118
elpa/cider-20160927.2135/cider-grimoire.el
View File

@ -1,118 +0,0 @@
;;; cider-grimoire.el --- Grimoire integration -*- lexical-binding: t -*-
;; Copyright © 2014-2016 Bozhidar Batsov and CIDER contributors
;;
;; Author: Bozhidar Batsov <bozhidar@batsov.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; A few commands for Grimoire documentation lookup.
;;; Code:
(require 'cider-client)
(require 'cider-common)
(require 'cider-compat)
(require 'cider-popup)
(require 'nrepl-dict)
(require 'url-vars)
(defconst cider-grimoire-url "http://conj.io/")
(defconst cider-grimoire-buffer "*cider-grimoire*")
(defun cider-grimoire-replace-special (name)
"Convert the dashes in NAME to a grimoire friendly format."
(thread-last name
(replace-regexp-in-string "\\?" "_QMARK_")
(replace-regexp-in-string "\\." "_DOT_")
(replace-regexp-in-string "\\/" "_SLASH_")
(replace-regexp-in-string "\\(\\`_\\)\\|\\(_\\'\\)" "")))
(defun cider-grimoire-url (name ns)
"Generate a grimoire search v0 url from NAME, NS."
(let ((base-url cider-grimoire-url))
(when (and name ns)
(concat base-url "search/v0/" ns "/" (cider-grimoire-replace-special name) "/"))))
(defun cider-grimoire-web-lookup (symbol)
"Open the grimoire documentation for SYMBOL in a web browser."
(if-let ((var-info (cider-var-info symbol)))
(let ((name (nrepl-dict-get var-info "name"))
(ns (nrepl-dict-get var-info "ns")))
(browse-url (cider-grimoire-url name ns)))
(error "Symbol %s not resolved" symbol)))
;;;###autoload
(defun cider-grimoire-web (&optional arg)
"Open grimoire documentation in the default web browser.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates."
(interactive "P")
(funcall (cider-prompt-for-symbol-function arg)
"Grimoire doc for"
#'cider-grimoire-web-lookup))
(defun cider-create-grimoire-buffer (content)
"Create a new grimoire buffer with CONTENT."
(with-current-buffer (cider-popup-buffer cider-grimoire-buffer t)
(read-only-mode -1)
(insert content)
(read-only-mode +1)
(goto-char (point-min))
(current-buffer)))
(defun cider-grimoire-lookup (symbol)
"Look up the grimoire documentation for SYMBOL."
(if-let ((var-info (cider-var-info symbol)))
(let ((name (nrepl-dict-get var-info "name"))
(ns (nrepl-dict-get var-info "ns"))
(url-request-method "GET")
(url-request-extra-headers `(("Content-Type" . "text/plain"))))
(url-retrieve (cider-grimoire-url name ns)
(lambda (_status)
;; we need to strip the http header
(goto-char (point-min))
(re-search-forward "^$")
(delete-region (point-min) (point))
(delete-blank-lines)
;; and create a new buffer with whatever is left
(pop-to-buffer (cider-create-grimoire-buffer (buffer-string))))))
(error "Symbol %s not resolved" symbol)))
;;;###autoload
(defun cider-grimoire (&optional arg)
"Open grimoire documentation in a popup buffer.
Prompts for the symbol to use, or uses the symbol at point, depending on
the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the
opposite of what that option dictates."
(interactive "P")
(when (derived-mode-p 'clojurescript-mode)
(user-error "`cider-grimoire' doesn't support ClojureScript"))
(funcall (cider-prompt-for-symbol-function arg)
"Grimoire doc for"
#'cider-grimoire-lookup))
(provide 'cider-grimoire)
;;; cider-grimoire.el ends here

389
elpa/cider-20160927.2135/cider-inspector.el
View File

@ -1,389 +0,0 @@
;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*-
;; Copyright © 2013-2016 Vital Reactor, LLC
;; Copyright © 2014-2016 Bozhidar Batsov and CIDER contributors
;; Author: Ian Eslick <ian@vitalreactor.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Clojure object inspector inspired by SLIME.
;;; Code:
(require 'cl-lib)
(require 'seq)
(require 'cider-interaction)
;; ===================================
;; Inspector Key Map and Derived Mode
;; ===================================
(defconst cider-inspector-buffer "*cider-inspect*")
(push cider-inspector-buffer cider-ancillary-buffers)
;;; Customization
(defgroup cider-inspector nil
"Presentation and behaviour of the cider value inspector."
:prefix "cider-inspector-"
:group 'cider
:package-version '(cider . "0.10.0"))
(defcustom cider-inspector-page-size 32
"Default page size in paginated inspector view.
The page size can be also changed interactively within the inspector."
:type '(integer :tag "Page size" 32)
:group 'cider-inspector
:package-version '(cider . "0.10.0"))
(defvar cider-inspector-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map cider-popup-buffer-mode-map)
(define-key map (kbd "RET") #'cider-inspector-operate-on-point)
(define-key map [mouse-1] #'cider-inspector-operate-on-click)
(define-key map "l" #'cider-inspector-pop)
(define-key map "g" #'cider-inspector-refresh)
;; Page-up/down
(define-key map [next] #'cider-inspector-next-page)
(define-key map [prior] #'cider-inspector-prev-page)
(define-key map " " #'cider-inspector-next-page)
(define-key map (kbd "M-SPC") #'cider-inspector-prev-page)
(define-key map (kbd "S-SPC") #'cider-inspector-prev-page)
(define-key map "s" #'cider-inspector-set-page-size)
(define-key map [tab] #'cider-inspector-next-inspectable-object)
(define-key map "\C-i" #'cider-inspector-next-inspectable-object)
(define-key map [(shift tab)] #'cider-inspector-previous-inspectable-object)
;; Emacs translates S-TAB to BACKTAB on X.
(define-key map [backtab] #'cider-inspector-previous-inspectable-object)
map))
(define-derived-mode cider-inspector-mode special-mode "Inspector"
"Major mode for inspecting Clojure data structures.
\\{cider-inspector-mode-map}"
(set-syntax-table clojure-mode-syntax-table)
(setq buffer-read-only t)
(setq-local electric-indent-chars nil)
(setq-local truncate-lines t))
;;;###autoload
(defun cider-inspect-last-sexp ()
"Inspect the result of the the expression preceding point."
(interactive)
(cider-inspect-expr (cider-last-sexp) (cider-current-ns)))
;;;###autoload
(defun cider-inspect-defun-at-point ()
"Inspect the result of the \"top-level\" expression at point."
(interactive)
(cider-inspect-expr (cider-defun-at-point) (cider-current-ns)))
;;;###autoload
(defun cider-inspect-last-result ()
"Inspect the most recent eval result."
(interactive)
(cider-inspect-expr "*1" (cider-current-ns)))
;;;###autoload
(defun cider-inspect (&optional arg)
"Inspect the result of the preceding sexp.
With a prefix argument ARG it inspects the result of the \"top-level\" form.
With a second prefix argument it prompts for an expression to eval and inspect."
(interactive "p")
(pcase arg
(1 (cider-inspect-last-sexp))
(4 (cider-inspect-defun-at-point))
(16 (call-interactively #'cider-inspect-expr))))
(defvar cider-inspector-location-stack nil
"A stack used to save point locations in inspector buffers.
These locations are used to emulate save-excursion between
`cider-inspector-push' and `cider-inspector-pop' operations.")
(defvar cider-inspector-page-location-stack nil
"A stack used to save point locations in inspector buffers.
These locations are used to emulate save-excursion between
`cider-inspector-next-page' and `cider-inspector-prev-page' operations.")
(defvar cider-inspector-last-command nil
"Contains the value of the most recently used `cider-inspector-*' command.
This is used as an alternative to the built-in `last-command'. Whenever we
invoke any command through M-x and its variants, the value of `last-command'
is not set to the command it invokes.")
;; Operations
;;;###autoload
(defun cider-inspect-expr (expr ns)
"Evaluate EXPR in NS and inspect its value.
Interactively, EXPR is read from the minibuffer, and NS the
current buffer's namespace."
(interactive (list (cider-read-from-minibuffer "Inspect expression: " (cider-sexp-at-point))
(cider-current-ns)))
(when-let (value (cider-sync-request:inspect-expr expr ns (or cider-inspector-page-size 32)))
(cider-inspector--render-value value)))
(defun cider-inspector-pop ()
(interactive)
(setq cider-inspector-last-command 'cider-inspector-pop)
(when-let (value (cider-sync-request:inspect-pop))
(cider-inspector--render-value value)))
(defun cider-inspector-push (idx)
(push (point) cider-inspector-location-stack)
(when-let (value (cider-sync-request:inspect-push idx))
(cider-inspector--render-value value)))
(defun cider-inspector-refresh ()
(interactive)
(when-let (value (cider-sync-request:inspect-refresh))
(cider-inspector--render-value value)))
(defun cider-inspector-next-page ()
"Jump to the next page when inspecting a paginated sequence/map.
Does nothing if already on the last page."
(interactive)
(push (point) cider-inspector-page-location-stack)
(when-let (value (cider-sync-request:inspect-next-page))
(cider-inspector--render-value value)))
(defun cider-inspector-prev-page ()
"Jump to the previous page when expecting a paginated sequence/map.
Does nothing if already on the first page."
(interactive)
(setq cider-inspector-last-command 'cider-inspector-prev-page)
(when-let (value (cider-sync-request:inspect-prev-page))
(cider-inspector--render-value value)))
(defun cider-inspector-set-page-size (page-size)
"Set the page size in pagination mode to the specified PAGE-SIZE.
Current page will be reset to zero."
(interactive "nPage size: ")
(when-let (value (cider-sync-request:inspect-set-page-size page-size))
(cider-inspector--render-value value)))
;; nREPL interactions
(defun cider-sync-request:inspect-pop ()
"Move one level up in the inspector stack."
(thread-first (list "op" "inspect-pop"
"session" (cider-current-session))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "value")))
(defun cider-sync-request:inspect-push (idx)
"Inspect the inside value specified by IDX."
(thread-first (list "op" "inspect-push"
"idx" idx
"session" (cider-current-session))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "value")))
(defun cider-sync-request:inspect-refresh ()
"Re-render the currently inspected value."
(thread-first (list "op" "inspect-refresh"
"session" (cider-current-session))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "value")))
(defun cider-sync-request:inspect-next-page ()
"Jump to the next page in paginated collection view."
(thread-first (list "op" "inspect-next-page"
"session" (cider-current-session))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "value")))
(defun cider-sync-request:inspect-prev-page ()
"Jump to the previous page in paginated collection view."
(thread-first (list "op" "inspect-prev-page"
"session" (cider-current-session))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "value")))
(defun cider-sync-request:inspect-set-page-size (page-size)
"Set the page size in paginated view to PAGE-SIZE."
(thread-first (list "op" "inspect-set-page-size"
"page-size" page-size
"session" (cider-current-session))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "value")))
(defun cider-sync-request:inspect-expr (expr ns page-size)
"Evaluate EXPR in context of NS and inspect its result.
Set the page size in paginated view to PAGE-SIZE."
(thread-first (append (nrepl--eval-request expr (cider-current-session) ns)
(list "inspect" "true"
"page-size" page-size))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "value")))
;; Render Inspector from Structured Values
(defun cider-inspector--render-value (value)
(cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode)
(cider-inspector-render cider-inspector-buffer value)
(cider-popup-buffer-display cider-inspector-buffer t)
(with-current-buffer cider-inspector-buffer
(when (eq cider-inspector-last-command 'cider-inspector-pop)
(setq cider-inspector-last-command nil)
;; Prevents error message being displayed when we try to pop
;; from the top-level of a data struture
(when cider-inspector-location-stack
(goto-char (pop cider-inspector-location-stack))))
(when (eq cider-inspector-last-command 'cider-inspector-prev-page)
(setq cider-inspector-last-command nil)
;; Prevents error message being displayed when we try to
;; go to a prev-page from the first page
(when cider-inspector-page-location-stack
(goto-char (pop cider-inspector-page-location-stack))))))
(defun cider-inspector-render (buffer str)
(with-current-buffer buffer
(cider-inspector-mode)
(let ((inhibit-read-only t))
(condition-case nil
(cider-inspector-render* (car (read-from-string str)))
(error (insert "\nInspector error for: " str))))
(goto-char (point-min))))
(defun cider-inspector-render* (elements)
(dolist (el elements)
(cider-inspector-render-el* el)))
(defun cider-inspector-render-el* (el)
(cond ((symbolp el) (insert (symbol-name el)))
((stringp el) (insert (propertize el 'font-lock-face 'font-lock-keyword-face)))
((and (consp el) (eq (car el) :newline))
(insert "\n"))
((and (consp el) (eq (car el) :value))
(cider-inspector-render-value (cadr el) (cl-caddr el)))
(t (message "Unrecognized inspector object: %s" el))))
(defun cider-inspector-render-value (value idx)
(cider-propertize-region
(list 'cider-value-idx idx
'mouse-face 'highlight)
(cider-inspector-render-el* (cider-font-lock-as-clojure value))))
;; ===================================================
;; Inspector Navigation (lifted from SLIME inspector)
;; ===================================================
(defun cider-find-inspectable-object (direction limit)
"Find the next/previous inspectable object.
DIRECTION can be either 'next or 'prev.
LIMIT is the maximum or minimum position in the current buffer.
Return a list of two values: If an object could be found, the
starting position of the found object and T is returned;
otherwise LIMIT and NIL is returned."
(let ((finder (cl-ecase direction
(next 'next-single-property-change)
(prev 'previous-single-property-change))))
(let ((prop nil) (curpos (point)))
(while (and (not prop) (not (= curpos limit)))
(let ((newpos (funcall finder curpos 'cider-value-idx nil limit)))
(setq prop (get-text-property newpos 'cider-value-idx))
(setq curpos newpos)))
(list curpos (and prop t)))))
(defun cider-inspector-next-inspectable-object (arg)
"Move point to the next inspectable object.
With optional ARG, move across that many objects.
If ARG is negative, move backwards."
(interactive "p")
(let ((maxpos (point-max)) (minpos (point-min))
(previously-wrapped-p nil))
;; Forward.
(while (> arg 0)
(seq-let (pos foundp) (cider-find-inspectable-object 'next maxpos)
(if foundp
(progn (goto-char pos) (setq arg (1- arg))
(setq previously-wrapped-p nil))
(if (not previously-wrapped-p) ; cycle detection
(progn (goto-char minpos) (setq previously-wrapped-p t))
(error "No inspectable objects")))))
;; Backward.
(while (< arg 0)
(seq-let (pos foundp) (cider-find-inspectable-object 'prev minpos)
;; CIDER-OPEN-INSPECTOR inserts the title of an inspector page
;; as a presentation at the beginning of the buffer; skip
;; that. (Notice how this problem can not arise in ``Forward.'')
(if (and foundp (/= pos minpos))
(progn (goto-char pos) (setq arg (1+ arg))
(setq previously-wrapped-p nil))
(if (not previously-wrapped-p) ; cycle detection
(progn (goto-char maxpos) (setq previously-wrapped-p t))
(error "No inspectable objects")))))))
(defun cider-inspector-previous-inspectable-object (arg)
"Move point to the previous inspectable object.
With optional ARG, move across that many objects.
If ARG is negative, move forwards."
(interactive "p")
(cider-inspector-next-inspectable-object (- arg)))
(defun cider-inspector-property-at-point ()
(let* ((properties '(cider-value-idx cider-range-button
cider-action-number))
(find-property
(lambda (point)
(cl-loop for property in properties
for value = (get-text-property point property)
when value
return (list property value)))))
(or (funcall find-property (point))
(funcall find-property (1- (point))))))
(defun cider-inspector-operate-on-point ()
"Invoke the command for the text at point.
1. If point is on a value then recursively call the inspector on
that value.
2. If point is on an action then call that action.
3. If point is on a range-button fetch and insert the range."
(interactive)
(seq-let (property value) (cider-inspector-property-at-point)
(cl-case property
(cider-value-idx
(cider-inspector-push value))
;; TODO: range and action handlers
(t (error "No object at point")))))
(defun cider-inspector-operate-on-click (event)
"Move to EVENT's position and operate the part."
(interactive "@e")
(let ((point (posn-point (event-end event))))
(cond ((and point
(or (get-text-property point 'cider-value-idx)))
(goto-char point)
(cider-inspector-operate-on-point))
(t
(error "No clickable part here")))))
;;;###autoload
(define-obsolete-function-alias 'cider-inspect-read-and-inspect
'cider-inspect-expr "0.13.0")
(provide 'cider-inspector)
;;; cider-inspector.el ends here

1787
elpa/cider-20160927.2135/cider-interaction.el
View File

File diff suppressed because it is too large Load Diff

207
elpa/cider-20160927.2135/cider-macroexpansion.el
View File

@ -1,207 +0,0 @@
;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*-
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Artur Malabarba <bruce.connor.am@gmail.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Macro expansion support.
;;; Code:
(require 'cider-mode)
(require 'cider-compat)
(defconst cider-macroexpansion-buffer "*cider-macroexpansion*")
(push cider-macroexpansion-buffer cider-ancillary-buffers)
(defcustom cider-macroexpansion-display-namespaces 'tidy
"Determines if namespaces are displayed in the macroexpansion buffer.
Possible values are:
'qualified ;=> Vars are fully-qualified in the expansion
'none ;=> Vars are displayed without namespace qualification
'tidy ;=> Vars that are :refer-ed or defined in the current namespace are
displayed with their simple name, non-refered vars from other
namespaces are refered using the alias for that namespace (if
defined), other vars are displayed fully qualified."
:type '(choice (const :tag "Suppress namespaces" none)
(const :tag "Show fully-qualified namespaces" qualified)
(const :tag "Show namespace aliases" tidy))
:group 'cider
:package-version '(cider . "0.7.0"))
(defcustom cider-macroexpansion-print-metadata nil
"Determines if metadata is included in macroexpansion results."
:type 'boolean
:group 'cider
:package-version '(cider . "0.9.0"))
(defun cider-sync-request:macroexpand (expander expr &optional display-namespaces)
"Macroexpand, using EXPANDER, the given EXPR.
The default for DISPLAY-NAMESPACES is taken from
`cider-macroexpansion-display-namespaces'."
(cider-ensure-op-supported "macroexpand")
(thread-first (list "op" "macroexpand"
"expander" expander
"code" expr
"ns" (cider-current-ns)
"display-namespaces"
(or display-namespaces
(symbol-name cider-macroexpansion-display-namespaces)))
(append (when cider-macroexpansion-print-metadata
(list "print-meta" "true")))
(cider-nrepl-send-sync-request)
(nrepl-dict-get "expansion")))
(defun cider-macroexpand-undo (&optional arg)
"Undo the last macroexpansion, using `undo-only'.
ARG is passed along to `undo-only'."
(interactive)
(let ((inhibit-read-only t))
(undo-only arg)))
(defvar cider-last-macroexpand-expression nil
"Specify the last macroexpansion preformed.
This variable specifies both what was expanded and the expander.")
(defun cider-macroexpand-expr (expander expr)
"Macroexpand, use EXPANDER, the given EXPR."
(when-let ((expansion (cider-sync-request:macroexpand expander expr)))
(setq cider-last-macroexpand-expression expr)
(cider-initialize-macroexpansion-buffer expansion (cider-current-ns))))
(defun cider-macroexpand-expr-inplace (expander)
"Substitute the form preceding point with its macroexpansion using EXPANDER."
(interactive)
(let* ((expansion (cider-sync-request:macroexpand expander (cider-last-sexp)))
(bounds (cons (save-excursion (clojure-backward-logical-sexp 1) (point)) (point))))
(cider-redraw-macroexpansion-buffer
expansion (current-buffer) (car bounds) (cdr bounds))))
(defun cider-macroexpand-again ()
"Repeat the last macroexpansion."
(interactive)
(cider-initialize-macroexpansion-buffer cider-last-macroexpand-expression (cider-current-ns)))
;;;###autoload
(defun cider-macroexpand-1 (&optional prefix)
"Invoke \\=`macroexpand-1\\=` on the expression preceding point.
If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of
\\=`macroexpand-1\\=`."
(interactive "P")
(let ((expander (if prefix "macroexpand" "macroexpand-1")))
(cider-macroexpand-expr expander (cider-last-sexp))))
(defun cider-macroexpand-1-inplace (&optional prefix)
"Perform inplace \\=`macroexpand-1\\=` on the expression preceding point.
If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of
\\=`macroexpand-1\\=`."
(interactive "P")
(let ((expander (if prefix "macroexpand" "macroexpand-1")))
(cider-macroexpand-expr-inplace expander)))
;;;###autoload
(defun cider-macroexpand-all ()
"Invoke \\=`clojure.walk/macroexpand-all\\=` on the expression preceding point."
(interactive)
(cider-macroexpand-expr "macroexpand-all" (cider-last-sexp)))
(defun cider-macroexpand-all-inplace ()
"Perform inplace \\=`clojure.walk/macroexpand-all\\=` on the expression preceding point."
(interactive)
(cider-macroexpand-expr-inplace "macroexpand-all"))
(defun cider-initialize-macroexpansion-buffer (expansion ns)
"Create a new Macroexpansion buffer with EXPANSION and namespace NS."
(pop-to-buffer (cider-create-macroexpansion-buffer))
(setq cider-buffer-ns ns)
(setq buffer-undo-list nil)
(let ((inhibit-read-only t)
(buffer-undo-list t))
(erase-buffer)
(insert (format "%s" expansion))
(goto-char (point-max))
(cider--font-lock-ensure)))
(defun cider-redraw-macroexpansion-buffer (expansion buffer start end)
"Redraw the macroexpansion with new EXPANSION.
Text in BUFFER from START to END is replaced with new expansion,
and point is placed after the expanded form."
(with-current-buffer buffer
(let ((buffer-read-only nil))
(goto-char start)
(delete-region start end)
(insert (format "%s" expansion))
(goto-char start)
(indent-sexp)
(forward-sexp))))
(declare-function cider-mode "cider-mode")
(defun cider-create-macroexpansion-buffer ()
"Create a new macroexpansion buffer."
(with-current-buffer (cider-popup-buffer cider-macroexpansion-buffer t)
(clojure-mode)
(cider-mode -1)
(cider-macroexpansion-mode 1)
(current-buffer)))
(defvar cider-macroexpansion-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "g") #'cider-macroexpand-again)
(define-key map (kbd "q") #'cider-popup-buffer-quit-function)
(define-key map (kbd "d") #'cider-doc)
(define-key map (kbd "j") #'cider-javadoc)
(define-key map (kbd ".") #'cider-find-var)
(define-key map (kbd "m") #'cider-macroexpand-1-inplace)
(define-key map (kbd "a") #'cider-macroexpand-all-inplace)
(define-key map (kbd "u") #'cider-macroexpand-undo)
(define-key map [remap undo] #'cider-macroexpand-undo)
(easy-menu-define cider-macroexpansion-mode-menu map
"Menu for CIDER's doc mode"
'("Macroexpansion"
["Restart expansion" cider-macroexpand-again]
["Macroexpand-1" cider-macroexpand-1-inplace]
["Macroexpand-all" cider-macroexpand-all-inplace]
["Macroexpand-undo" cider-macroexpand-undo]
["Go to source" cider-find-var]
["Go to doc" cider-doc]
["Go to Javadoc" cider-docview-javadoc]
["Quit" cider-popup-buffer-quit-function]))
map))
(define-minor-mode cider-macroexpansion-mode
"Minor mode for CIDER macroexpansion.
\\{cider-macroexpansion-mode-map}"
nil
" Macroexpand"
cider-macroexpansion-mode-map)
(provide 'cider-macroexpansion)
;;; cider-macroexpansion.el ends here

750
elpa/cider-20160927.2135/cider-mode.el
View File

@ -1,750 +0,0 @@
;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*-
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Artur Malabarba <bruce.connor.am@gmail.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Minor mode for REPL interactions.
;;; Code:
(require 'clojure-mode)
(require 'cider-interaction)
(require 'cider-test)
(require 'cider-eldoc)
(require 'cider-resolve)
(require 'cider-doc)
(require 'cider-compat)
(defcustom cider-mode-line-show-connection t
"If the mode-line lighter should detail the connection."
:group 'cider
:type 'boolean
:package-version '(cider "0.10.0"))
(defun cider--modeline-info ()
"Return info for the `cider-mode' modeline.
Info contains project name and host:port endpoint."
(if-let ((current-connection (ignore-errors (cider-current-connection))))
(with-current-buffer current-connection
(concat
cider-repl-type
(when cider-mode-line-show-connection
(format ":%s@%s:%s"
(or (cider--project-name nrepl-project-dir) "<no project>")
(pcase (car nrepl-endpoint)
("localhost" "")
(x x))
(cadr nrepl-endpoint)))))
"not connected"))
;;;###autoload
(defcustom cider-mode-line
'(:eval (format " cider[%s]" (cider--modeline-info)))
"Mode line lighter for `cider-mode'.
The value of this variable is a mode line template as in
`mode-line-format'. See Info Node `(elisp)Mode Line Format' for
details about mode line templates.
Customize this variable to change how `cider-mode' displays its
status in the mode line. The default value displays the current connection.
Set this variable to nil to disable the mode line
entirely."
:group 'cider
:type 'sexp
:risky t
:package-version '(cider "0.7.0"))
;;; Switching between REPL & source buffers
(defvar-local cider-last-clojure-buffer nil
"A buffer-local variable holding the last Clojure source buffer.
`cider-switch-to-last-clojure-buffer' uses this variable to jump
back to last Clojure source buffer.")
(defun cider-remember-clojure-buffer (buffer)
"Try to remember the BUFFER from which the user jumps.
The BUFFER needs to be a Clojure buffer and current major mode needs
to be `cider-repl-mode'. The user can use `cider-switch-to-last-clojure-buffer'
to jump back to the last Clojure source buffer."
(when (and buffer
(with-current-buffer buffer
(derived-mode-p 'clojure-mode))
(derived-mode-p 'cider-repl-mode))
(setq cider-last-clojure-buffer buffer)))
(defun cider--switch-to-repl-buffer (repl-buffer &optional set-namespace)
"Select the REPL-BUFFER, when possible in an existing window.
Hint: You can use `display-buffer-reuse-frames' and
`special-display-buffer-names' to customize the frame in which
the buffer should appear.
When SET-NAMESPACE is t, sets the namespace in the REPL buffer to
that of the namespace in the Clojure source buffer."
(cider-ensure-connected)
(let ((buffer (current-buffer)))
;; first we switch to the REPL buffer
(if cider-repl-display-in-current-window
(pop-to-buffer-same-window repl-buffer)
(pop-to-buffer repl-buffer))
;; then if necessary we update its namespace
(when set-namespace
(cider-repl-set-ns (with-current-buffer buffer (cider-current-ns))))
(cider-remember-clojure-buffer buffer)
(goto-char (point-max))))
(defun cider-switch-to-repl-buffer (&optional set-namespace)
"Select the REPL buffer, when possible in an existing window.
The buffer chosen is based on the file open in the current buffer.
If the REPL buffer cannot be unambiguously determined, the REPL
buffer is chosen based on the current connection buffer and a
message raised informing the user.
Hint: You can use `display-buffer-reuse-frames' and
`special-display-buffer-names' to customize the frame in which
the buffer should appear.
With a prefix arg SET-NAMESPACE sets the namespace in the REPL buffer to that
of the namespace in the Clojure source buffer."
(interactive "P")
(cider--switch-to-repl-buffer (cider-current-repl-buffer) set-namespace))
(declare-function cider-load-buffer "cider-interaction")
(defun cider-load-buffer-and-switch-to-repl-buffer (&optional set-namespace)
"Load the current buffer into the matching REPL buffer and switch to it.
When SET-NAMESPACE is true, we'll also set the REPL's ns to match that of the
Clojure buffer."
(interactive "P")
(cider-load-buffer)
(cider-switch-to-repl-buffer set-namespace))
(defun cider-switch-to-last-clojure-buffer ()
"Switch to the last Clojure buffer.
The default keybinding for this command is
the same as `cider-switch-to-repl-buffer',
so that it is very convenient to jump between a
Clojure buffer and the REPL buffer."
(interactive)
(if (and (derived-mode-p 'cider-repl-mode)
(buffer-live-p cider-last-clojure-buffer))
(if cider-repl-display-in-current-window
(pop-to-buffer-same-window cider-last-clojure-buffer)
(pop-to-buffer cider-last-clojure-buffer))
(message "Don't know the original Clojure buffer")))
(defun cider-find-and-clear-repl-output (&optional clear-repl)
"Find the current REPL buffer and clear it.
With a prefix argument CLEAR-REPL the command clears the entire REPL buffer.
Returns to the buffer in which the command was invoked."
(interactive "P")
(let ((origin-buffer (current-buffer)))
(switch-to-buffer (cider-current-repl-buffer))
(if clear-repl
(cider-repl-clear-buffer)
(cider-repl-clear-output))
(switch-to-buffer origin-buffer)))
;;; The menu-bar
(defconst cider-mode-menu
`("CIDER"
["Start a REPL" cider-jack-in
:help "Starts an nREPL server (with lein, boot, or maven) and connects a REPL to it."]
["Connect to a REPL" cider-connect
:help "Connects to a REPL that's already running."]
["Quit" cider-quit :active cider-connections]
["Restart" cider-restart :active cider-connections]
("Clojurescript"
["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clojurescript
:help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL.
Configure `cider-cljs-lein-repl' to change the ClojureScript REPL to use."]
["Create a ClojureScript REPL from a Clojure REPL" cider-create-sibling-cljs-repl]
["Configure the ClojureScript REPL to use" (customize-variable 'cider-cljs-lein-repl)])
"--"
["Connection info" cider-display-connection-info
:active cider-connections]
["Rotate default connection" cider-rotate-default-connection
:active (cdr cider-connections)]
["Select any CIDER buffer" cider-selector]
"--"
["Configure CIDER" (customize-group 'cider)]
"--"
["A sip of CIDER" cider-drink-a-sip]
["View manual online" cider-view-manual]
["View refcard online" cider-view-refcard]
["Report a bug" cider-report-bug]
["Version info" cider-version]
"--"
["Close ancillary buffers" cider-close-ancillary-buffers
:active (seq-remove #'null cider-ancillary-buffers)]
("nREPL" :active cider-connections
["Describe session" cider-describe-nrepl-session]
["Close session" cider-close-nrepl-session]))
"Menu for CIDER mode")
(defconst cider-mode-eval-menu
'("CIDER Eval" :visible cider-connections
["Eval top-level sexp" cider-eval-defun-at-point]
["Eval current sexp" cider-eval-sexp-at-point]
["Eval last sexp" cider-eval-last-sexp]
["Eval selected region" cider-eval-region]
["Eval ns form" cider-eval-ns-form]
"--"
["Interrupt evaluation" cider-interrupt]
"--"
["Eval last sexp and insert" cider-eval-print-last-sexp
:keys "\\[universal-argument] \\[cider-eval-last-sexp]"]
["Eval last sexp in popup buffer" cider-pprint-eval-last-sexp]
["Eval last sexp and replace" cider-eval-last-sexp-and-replace]
["Eval last sexp to REPL" cider-eval-last-sexp-to-repl]
["Insert last sexp in REPL" cider-insert-last-sexp-in-repl]
["Eval top-level sexp to comment" cider-eval-defun-to-comment]
"--"
["Load this buffer" cider-load-buffer]
["Load another file" cider-load-file]
["Load all project files" cider-load-all-project-ns]
["Refresh loaded code" cider-refresh]
["Run project (-main function)" cider-run])
"Menu for CIDER mode eval commands.")
(defconst cider-mode-interactions-menu
`("CIDER Interactions" :visible cider-connections
["Complete symbol" complete-symbol]
"--"
("REPL"
["Set REPL to this ns" cider-repl-set-ns]
["Switch to REPL" cider-switch-to-repl-buffer]
["REPL Pretty Print" cider-repl-toggle-pretty-printing
:style toggle :selected cider-repl-use-pretty-printing]
["Clear latest output" cider-find-and-clear-repl-output]
["Clear all output" (cider-find-and-clear-repl-output t)
:keys "\\[universal-argument] \\[cider-find-and-clear-repl-output]"]
"--"
["Configure the REPL" (customize-group 'cider-repl)])
,cider-doc-menu
("Find (jump to)"
["Find definition" cider-find-var]
["Find resource" cider-find-resource]
["Go back" cider-pop-back])
("Macroexpand"
["Macroexpand-1" cider-macroexpand-1]
["Macroexpand-all" cider-macroexpand-all])
,cider-test-menu
("Debug"
["Inspect" cider-inspect]
["Toggle var tracing" cider-toggle-trace-var]
["Toggle ns tracing" cider-toggle-trace-ns]
"--"
["Debug top-level form" cider-debug-defun-at-point
:keys "\\[universal-argument] \\[cider-eval-defun-at-point]"]
["List instrumented defs" cider-browse-instrumented-defs]
"--"
["Configure the Debugger" (customize-group 'cider-debug)])
("Browse"
["Browse namespace" cider-browse-ns]
["Browse all namespaces" cider-browse-ns-all]
["Browse classpath" cider-classpath]
["Browse classpath entry" cider-open-classpath-entry]))
"Menu for CIDER interactions.")
(defconst cider-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c C-d") 'cider-doc-map)
(define-key map (kbd "M-.") #'cider-find-var)
(define-key map (kbd "C-c C-.") #'cider-find-ns)
(define-key map (kbd "M-,") #'cider-pop-back)
(define-key map (kbd "C-c M-.") #'cider-find-resource)
(define-key map (kbd "M-TAB") #'complete-symbol)
(define-key map (kbd "C-M-x") #'cider-eval-defun-at-point)
(define-key map (kbd "C-c C-c") #'cider-eval-defun-at-point)
(define-key map (kbd "C-x C-e") #'cider-eval-last-sexp)
(define-key map (kbd "C-c C-e") #'cider-eval-last-sexp)
(define-key map (kbd "C-c C-v") 'cider-eval-commands-map)
(define-key map (kbd "C-c M-;") #'cider-eval-defun-to-comment)
(define-key map (kbd "C-c M-e") #'cider-eval-last-sexp-to-repl)
(define-key map (kbd "C-c M-p") #'cider-insert-last-sexp-in-repl)
(define-key map (kbd "C-c C-p") #'cider-pprint-eval-last-sexp)
(define-key map (kbd "C-c C-f") #'cider-pprint-eval-defun-at-point)
(define-key map (kbd "C-c M-:") #'cider-read-and-eval)
(define-key map (kbd "C-c C-u") #'cider-undef)
(define-key map (kbd "C-c C-m") #'cider-macroexpand-1)
(define-key map (kbd "C-c M-m") #'cider-macroexpand-all)
(define-key map (kbd "C-c M-n") #'cider-repl-set-ns)
(define-key map (kbd "C-c M-i") #'cider-inspect)
(define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var)
(define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns)
(define-key map (kbd "C-c C-z") #'cider-switch-to-repl-buffer)
(define-key map (kbd "C-c M-z") #'cider-load-buffer-and-switch-to-repl-buffer)
(define-key map (kbd "C-c C-o") #'cider-find-and-clear-repl-output)
(define-key map (kbd "C-c C-k") #'cider-load-buffer)
(define-key map (kbd "C-c C-l") #'cider-load-file)
(define-key map (kbd "C-c C-b") #'cider-interrupt)
(define-key map (kbd "C-c ,") 'cider-test-commands-map)
(define-key map (kbd "C-c C-t") 'cider-test-commands-map)
(define-key map (kbd "C-c M-s") #'cider-selector)
(define-key map (kbd "C-c M-r") #'cider-rotate-default-connection)
(define-key map (kbd "C-c M-d") #'cider-display-connection-info)
(define-key map (kbd "C-c C-x") #'cider-refresh)
(define-key map (kbd "C-c C-q") #'cider-quit)
(dolist (variable '(cider-mode-interactions-menu
cider-mode-eval-menu
cider-mode-menu))
(easy-menu-do-define (intern (format "%s-open" variable))
map
(get variable 'variable-documentation)
(cider--menu-add-help-strings (symbol-value variable))))
map))
;; This menu works as an easy entry-point into CIDER. Even if cider.el isn't
;; loaded yet, this will be shown in Clojure buffers next to the "Clojure"
;; menu.
;;;###autoload
(eval-after-load 'clojure-mode
'(easy-menu-define cider-clojure-mode-menu-open clojure-mode-map
"Menu for Clojure mode.
This is displayed in `clojure-mode' buffers, if `cider-mode' is not active."
`("CIDER" :visible (not cider-mode)
["Start a REPL" cider-jack-in
:help "Starts an nREPL server (with lein, boot, or maven) and connects a REPL to it."]
["Connect to a REPL" cider-connect
:help "Connects to a REPL that's already running."]
["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clojurescript
:help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL.
Configure `cider-cljs-lein-repl' to change the ClojureScript REPL to use."]
"--"
["View manual online" cider-view-manual])))
;;; Dynamic indentation
(defcustom cider-dynamic-indentation t
"Whether CIDER should aid Clojure(Script) indentation.
If non-nil, CIDER uses runtime information (such as the \":style/indent\"
metadata) to improve standard `clojure-mode' indentation.
If nil, CIDER won't interfere with `clojure-mode's indentation.
Toggling this variable only takes effect after a file is closed and
re-visited."
:type 'boolean
:package-version '(cider . "0.11.0")
:group 'cider)
(defun cider--get-symbol-indent (symbol-name)
"Return the indent metadata for SYMBOL-NAME in the current namespace."
(let* ((ns (cider-current-ns)))
(if-let ((meta (cider-resolve-var ns symbol-name))
(indent (or (nrepl-dict-get meta "style/indent")
(nrepl-dict-get meta "indent"))))
(let ((format (format ":indent metadata on ‘%s’ is unreadable! \nERROR: %%s"
symbol-name)))
(with-demoted-errors format
(cider--deep-vector-to-list (read indent))))
;; There's no indent metadata, but there might be a clojure-mode
;; indent-spec with fully-qualified namespace.
(when (string-match cider-resolve--prefix-regexp symbol-name)
(when-let ((sym (intern-soft (replace-match (save-match-data
(cider-resolve-alias ns (match-string 1 symbol-name)))
t t symbol-name 1))))
(get sym 'clojure-indent-function))))))
;;; Dynamic font locking
(defcustom cider-font-lock-dynamically '(macro core deprecated)
"Specifies how much dynamic font-locking CIDER should use.
Dynamic font-locking this refers to applying syntax highlighting to vars
defined in the currently active nREPL connection. This is done in addition
to `clojure-mode's usual (static) font-lock, so even if you set this
variable to nil you'll still see basic syntax highlighting.
The value is a list of symbols, each one indicates a different type of var
that should be font-locked:
`macro' (default): Any defined macro gets the `font-lock-builtin-face'.
`function': Any defined function gets the `font-lock-function-face'.
`var': Any non-local var gets the `font-lock-variable-face'.
`deprecated' (default): Any deprecated var gets the `cider-deprecated-face'
face.
`core' (default): Any symbol from clojure.core (face depends on type).
The value can also be t, which means to font-lock as much as possible."
:type '(choice (set :tag "Fine-tune font-locking"
(const :tag "Any defined macro" macro)
(const :tag "Any defined function" function)
(const :tag "Any defined var" var)
(const :tag "Any defined deprecated" deprecated)
(const :tag "Any symbol from clojure.core" core))
(const :tag "Font-lock as much as possible" t))
:group 'cider
:package-version '(cider . "0.10.0"))
(defface cider-deprecated-face
'((((background light)) :background "light goldenrod")
(((background dark)) :background "#432"))
"Face used on deprecated vars."
:group 'cider)
(defface cider-instrumented-face
'((((type graphic)) :box (:color "#c00" :line-width -1))
(t :underline t :background "#800"))
"Face used to mark code being debugged."
:group 'cider-debug
:group 'cider
:package-version '(cider . "0.10.0"))
(defface cider-traced-face
'((((type graphic)) :box (:color "cyan" :line-width -1))
(t :underline t :background "#066"))
"Face used to mark code being traced."
:group 'cider
:package-version '(cider . "0.11.0"))
(defun cider--unless-local-match (value)
"Return VALUE, unless `match-string' is a local var."
(unless (or (get-text-property (point) 'cider-block-dynamic-font-lock)
(member (match-string 0)
(get-text-property (point) 'cider-locals)))
value))
(defun cider--compile-font-lock-keywords (symbols-plist core-plist)
"Return a list of font-lock rules for the symbols in SYMBOLS-PLIST and CORE-PLIST."
(let ((cider-font-lock-dynamically (if (eq cider-font-lock-dynamically t)
'(function var macro core deprecated)
cider-font-lock-dynamically))
deprecated enlightened
macros functions vars instrumented traced)
(cl-labels ((handle-plist
(plist)
(let ((do-function (memq 'function cider-font-lock-dynamically))
(do-var (memq 'var cider-font-lock-dynamically))
(do-macro (memq 'macro cider-font-lock-dynamically))
(do-deprecated (memq 'deprecated cider-font-lock-dynamically)))
(while plist
(let ((sym (pop plist))
(meta (pop plist)))
(pcase (nrepl-dict-get meta "cider.nrepl.middleware.util.instrument/breakfunction")
(`nil nil)
(`"#'cider.nrepl.middleware.debug/breakpoint-if-interesting"
(push sym instrumented))
(`"#'cider.nrepl.middleware.enlighten/light-form"
(push sym enlightened)))
;; The ::traced keywords can be inlined by MrAnderson, so
;; we catch that case too.
;; FIXME: This matches values too, not just keys.
(when (seq-find (lambda (k) (and (stringp k)
(string-match (rx "clojure.tools.trace/traced" eos) k)))
meta)
(push sym traced))
(when (and do-deprecated (nrepl-dict-get meta "deprecated"))
(push sym deprecated))
(cond ((and do-macro (nrepl-dict-get meta "macro"))
(push sym macros))
((and do-function (nrepl-dict-get meta "arglists"))
(push sym functions))
(do-var (push sym vars))))))))
(when (memq 'core cider-font-lock-dynamically)
(let ((cider-font-lock-dynamically '(function var macro core deprecated)))
(handle-plist core-plist)))
(handle-plist symbols-plist))
`(
,@(when macros
`((,(concat (rx (or "(" "#'")) ; Can't take the value of macros.
"\\(" (regexp-opt macros 'symbols) "\\)")
1 (cider--unless-local-match font-lock-keyword-face))))
,@(when functions
`((,(regexp-opt functions 'symbols) 0
(cider--unless-local-match font-lock-function-name-face))))
,@(when vars
`((,(regexp-opt vars 'symbols) 0
(cider--unless-local-match font-lock-variable-name-face))))
,@(when deprecated
`((,(regexp-opt deprecated 'symbols) 0
(cider--unless-local-match 'cider-deprecated-face) append)))
,@(when enlightened
`((,(regexp-opt enlightened 'symbols) 0
(cider--unless-local-match 'cider-enlightened-face) append)))
,@(when instrumented
`((,(regexp-opt instrumented 'symbols) 0
(cider--unless-local-match 'cider-instrumented-face) append)))
,@(when traced
`((,(regexp-opt traced 'symbols) 0
(cider--unless-local-match 'cider-traced-face) append))))))
(defconst cider--static-font-lock-keywords
(eval-when-compile
`((,(regexp-opt '("#break" "#dbg" "#light") 'symbols) 0 font-lock-warning-face)))
"Default expressions to highlight in CIDER mode.")
(defvar-local cider--dynamic-font-lock-keywords nil)
(defun cider-refresh-dynamic-font-lock (&optional ns)
"Ensure that the current buffer has up-to-date font-lock rules.
NS defaults to `cider-current-ns', and it can also be a dict describing the
namespace itself."
(interactive)
(when (and cider-font-lock-dynamically
font-lock-mode)
(font-lock-remove-keywords nil cider--dynamic-font-lock-keywords)
(when-let ((ns (or ns (cider-current-ns)))
(symbols (cider-resolve-ns-symbols ns)))
(setq-local cider--dynamic-font-lock-keywords
(cider--compile-font-lock-keywords
symbols (cider-resolve-ns-symbols (cider-resolve-core-ns))))
(font-lock-add-keywords nil cider--dynamic-font-lock-keywords 'end))
(cider--font-lock-flush)))
;;; Detecting local variables
(defun cider--read-locals-from-next-sexp ()
"Return a list of all locals inside the next logical sexp."
(save-excursion
(ignore-errors
(clojure-forward-logical-sexp 1)
(let ((out nil)
(end (point)))
(forward-sexp -1)
;; FIXME: This returns locals found inside the :or clause of a
;; destructuring map.
(while (search-forward-regexp "\\_<[^:&]\\(\\sw\\|\\s_\\)*\\_>" end 'noerror)
(push (match-string-no-properties 0) out))
out))))
(defun cider--read-locals-from-bindings-vector ()
"Return a list of all locals inside the next bindings vector."
(save-excursion
(ignore-errors
(cider-start-of-next-sexp)
(when (eq (char-after) ?\[)
(forward-char 1)
(let ((out nil))
(setq out (append (cider--read-locals-from-next-sexp) out))
(while (ignore-errors (clojure-forward-logical-sexp 3)
(unless (eobp)
(forward-sexp -1)
t))
(setq out (append (cider--read-locals-from-next-sexp) out)))
out)))))
(defun cider--read-locals-from-arglist ()
"Return a list of all locals in current form's arglist(s)."
(let ((out nil))
(save-excursion
(ignore-errors
(cider-start-of-next-sexp)
;; Named fn
(when (looking-at-p "\\s_\\|\\sw")
(cider-start-of-next-sexp 1))
;; Docstring
(when (eq (char-after) ?\")
(cider-start-of-next-sexp 1))
;; Attribute map
(when (eq (char-after) ?{)
(cider-start-of-next-sexp 1))
;; The arglist
(pcase (char-after)
(?\[ (setq out (cider--read-locals-from-next-sexp)))
;; FIXME: This returns false positives. It takes all arglists of a
;; function and returns all args it finds. The logic should be changed
;; so that each arglist applies to its own scope.
(?\( (ignore-errors
(while (eq (char-after) ?\()
(save-excursion
(forward-char 1)
(setq out (append (cider--read-locals-from-next-sexp) out)))
(cider-start-of-next-sexp 1)))))))
out))
(defun cider--parse-and-apply-locals (end &optional outer-locals)
"Figure out local variables between point and END.
A list of these variables is set as the `cider-locals' text property over
the code where they are in scope.
Optional argument OUTER-LOCALS is used to specify local variables defined
before point."
(while (search-forward-regexp "(\\(ns\\_>\\|def\\|fn\\|for\\b\\|loop\\b\\|with-\\|do[a-z]+\\|\\([a-z]+-\\)?let\\b\\)"
end 'noerror)
(goto-char (match-beginning 0))
(let ((sym (match-string 1))
(sexp-end (save-excursion
(or (ignore-errors (forward-sexp 1)
(point))
end))))
;; #1324: Don't do dynamic font-lock in `ns' forms, they are special
;; macros where nothing is evaluated, so we'd get a lot of false
;; positives.
(if (equal sym "ns")
(add-text-properties (point) sexp-end '(cider-block-dynamic-font-lock t))
(forward-char 1)
(forward-sexp 1)
(let ((locals (append outer-locals
(pcase sym
((or "fn" "def" "") (cider--read-locals-from-arglist))
(_ (cider--read-locals-from-bindings-vector))))))
(add-text-properties (point) sexp-end (list 'cider-locals locals))
(clojure-forward-logical-sexp 1)
(cider--parse-and-apply-locals sexp-end locals)))
(goto-char sexp-end))))
(defun cider--update-locals-for-region (beg end)
"Update the `cider-locals' text property for region from BEG to END."
(save-excursion
(goto-char beg)
;; If the inside of a `ns' form changed, reparse it from the start.
(when (and (not (bobp))
(get-text-property (1- (point)) 'cider-block-dynamic-font-lock))
(ignore-errors (beginning-of-defun)))
(save-excursion
;; Move up until we reach a sexp that encloses the entire region (or
;; a top-level sexp), and set that as the new BEG.
(goto-char end)
(while (and (or (> (point) beg)
(not (eq (char-after) ?\()))
(condition-case nil
(progn (backward-up-list) t)
(scan-error nil))))
(setq beg (min beg (point)))
;; If there are locals above the current sexp, reapply them to the
;; current sexp.
(let ((locals-above (when (> beg (point-min))
(get-text-property (1- beg) 'cider-locals))))
(condition-case nil
(clojure-forward-logical-sexp 1)
(error (goto-char end)))
(add-text-properties beg (point) `(cider-locals ,locals-above))
;; Extend the region being font-locked to include whole sexps.
(setq end (max end (point)))
(goto-char beg)
(ignore-errors
(cider--parse-and-apply-locals end locals-above))))))
(defun cider--docview-as-string (sym info)
"Return a string of what would be displayed by `cider-docview-render'."
(with-temp-buffer
(cider-docview-render (current-buffer) sym info)
(goto-char (point-max))
(forward-line -1)
(replace-regexp-in-string
"[`']" "\\\\=\\&"
(buffer-substring-no-properties (point-min) (1- (point))))))
(defcustom cider-use-tooltips t
"If non-nil, CIDER displays mouse-over tooltips."
:group 'cider
:type 'boolean
:package-version '(cider "0.12.0"))
(defvar cider--debug-mode-response)
(defvar cider--debug-mode)
(defun cider--help-echo (_ obj pos)
"Return the help-echo string for OBJ at POS.
See \(info \"(elisp) Special Properties\")"
(while-no-input
(when (and (bufferp obj) (cider-connected-p)
cider-use-tooltips (not help-at-pt-display-when-idle))
(with-current-buffer obj
(ignore-errors
(save-excursion
(goto-char pos)
(when-let ((sym (cider-symbol-at-point)))
(if (member sym (get-text-property (point) 'cider-locals))
(concat (format "`%s' is a local" sym)
(when cider--debug-mode
(let* ((locals (nrepl-dict-get cider--debug-mode-response "locals"))
(local-val (cadr (assoc sym locals))))
(format " with value:\n%s" local-val))))
(let* ((info (cider-sync-request:info sym))
(candidates (nrepl-dict-get info "candidates")))
(if candidates
(concat "There were ambiguities resolving this symbol:\n\n"
(mapconcat (lambda (x) (cider--docview-as-string sym x))
candidates
(concat "\n\n" (make-string 60 ?-) "\n\n")))
(cider--docview-as-string sym info)))))))))))
(defun cider--wrap-fontify-locals (func)
"Return a function that will call FUNC after parsing local variables.
The local variables are stored in a list under the `cider-locals' text
property."
(lambda (beg end &rest rest)
(with-silent-modifications
(remove-text-properties beg end '(cider-locals nil cider-block-dynamic-font-lock nil))
(add-text-properties beg end '(help-echo cider--help-echo))
(when cider-font-lock-dynamically
(cider--update-locals-for-region beg end)))
(apply func beg end rest)))
;;; Minor-mode definition
(defvar x-gtk-use-system-tooltips)
;;;###autoload
(define-minor-mode cider-mode
"Minor mode for REPL interaction from a Clojure buffer.
\\{cider-mode-map}"
nil
cider-mode-line
cider-mode-map
(if cider-mode
(progn
(cider-eldoc-setup)
(make-local-variable 'completion-at-point-functions)
(add-to-list 'completion-at-point-functions
#'cider-complete-at-point)
(font-lock-add-keywords nil cider--static-font-lock-keywords)
(cider-refresh-dynamic-font-lock)
;; `font-lock-mode' might get enabled after `cider-mode'.
(add-hook 'font-lock-mode-hook #'cider-refresh-dynamic-font-lock nil 'local)
(setq-local font-lock-fontify-region-function
(cider--wrap-fontify-locals font-lock-fontify-region-function))
;; GTK tooltips look bad, and we have no control over the face.
(setq-local x-gtk-use-system-tooltips nil)
;; `tooltip' has variable-width by default, which looks terrible.
(set-face-attribute 'tooltip nil :inherit 'unspecified)
(when cider-dynamic-indentation
(setq-local clojure-get-indent-function #'cider--get-symbol-indent))
(setq-local clojure-expected-ns-function #'cider-expected-ns)
(setq next-error-function #'cider-jump-to-compilation-error))
(mapc #'kill-local-variable '(completion-at-point-functions
next-error-function
x-gtk-use-system-tooltips
font-lock-fontify-region-function
clojure-get-indent-function))
(remove-hook 'font-lock-mode-hook #'cider-refresh-dynamic-font-lock 'local)
(font-lock-remove-keywords nil cider--dynamic-font-lock-keywords)
(font-lock-remove-keywords nil cider--static-font-lock-keywords)
(cider--font-lock-flush)))
(defun cider-set-buffer-ns (ns)
"Set this buffer's namespace to NS and refresh font-locking."
(setq-local cider-buffer-ns ns)
(when (or cider-mode (derived-mode-p 'cider-repl-mode))
(cider-refresh-dynamic-font-lock ns)))
(provide 'cider-mode)
;;; cider-mode.el ends here

311
elpa/cider-20160927.2135/cider-overlays.el
View File

@ -1,311 +0,0 @@
;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*-
;; Copyright © 2015-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Use `cider--make-overlay' to place a generic overlay at point. Or use
;; `cider--make-result-overlay' to place an interactive eval result overlay at
;; the end of a specified line.
;;; Code:
(require 'cider-common)
(require 'cider-compat)
(require 'cl-lib)
;;; Customization
(defface cider-result-overlay-face
'((((class color) (background light))
:background "grey90" :box (:line-width -1 :color "yellow"))
(((class color) (background dark))
:background "grey10" :box (:line-width -1 :color "black")))
"Face used to display evaluation results at the end of line.
If `cider-overlays-use-font-lock' is non-nil, this face is
applied with lower priority than the syntax highlighting."
:group 'cider
:package-version '(cider "0.9.1"))
(defcustom cider-result-use-clojure-font-lock t
"If non-nil, interactive eval results are font-locked as Clojure code."
:group 'cider
:type 'boolean
:package-version '(cider . "0.10.0"))
(defcustom cider-overlays-use-font-lock t
"If non-nil, results overlays are font-locked as Clojure code.
If nil, apply `cider-result-overlay-face' to the entire overlay instead of
font-locking it."
:group 'cider
:type 'boolean
:package-version '(cider . "0.10.0"))
(defcustom cider-use-overlays 'both
"Whether to display evaluation results with overlays.
If t, use overlays. If nil, display on the echo area. If both, display on
both places.
Only applies to evaluation commands. To configure the debugger overlays,
see `cider-debug-use-overlays'."
:type '(choice (const :tag "End of line" t)
(const :tag "Bottom of screen" nil)
(const :tag "Both" both))
:group 'cider
:package-version '(cider . "0.10.0"))
(defcustom cider-eval-result-prefix "=> "
"The prefix displayed in the minibuffer before a result value."
:type 'string
:group 'cider
:package-version '(cider . "0.5.0"))
(defcustom cider-eval-result-duration 'command
"Duration, in seconds, of CIDER's eval-result overlays.
If nil, overlays last indefinitely.
If the symbol `command', they're erased after the next command.
Also see `cider-use-overlays'."
:type '(choice (integer :tag "Duration in seconds")
(const :tag "Until next command" command)
(const :tag "Last indefinitely" nil))
:group 'cider
:package-version '(cider . "0.10.0"))
;;; Overlay logic
(defun cider--delete-overlay (ov &rest _)
"Safely delete overlay OV.
Never throws errors, and can be used in an overlay's modification-hooks."
(ignore-errors (delete-overlay ov)))
(defun cider--make-overlay (l r type &rest props)
"Place an overlay between L and R and return it.
TYPE is a symbol put on the overlay's category property. It is used to
easily remove all overlays from a region with:
(remove-overlays start end 'category TYPE)
PROPS is a plist of properties and values to add to the overlay."
(let ((o (make-overlay l (or r l) (current-buffer))))
(overlay-put o 'category type)
(overlay-put o 'cider-temporary t)
(while props (overlay-put o (pop props) (pop props)))
(push #'cider--delete-overlay (overlay-get o 'modification-hooks))
o))
(defun cider--remove-result-overlay ()
"Remove result overlay from current buffer.
This function also removes itself from `post-command-hook'."
(remove-hook 'post-command-hook #'cider--remove-result-overlay 'local)
(remove-overlays nil nil 'category 'result))
(defun cider--remove-result-overlay-after-command ()
"Add `cider--remove-result-overlay' locally to `post-command-hook'.
This function also removes itself from `post-command-hook'."
(remove-hook 'post-command-hook #'cider--remove-result-overlay-after-command 'local)
(add-hook 'post-command-hook #'cider--remove-result-overlay nil 'local))
(defface cider-fringe-good-face
'((((class color) (background light)) :foreground "lightgreen")
(((class color) (background dark)) :foreground "darkgreen"))
"Face used on the fringe indicator for successful evaluation."
:group 'cider)
(defconst cider--fringe-overlay-good
(propertize " " 'display '(left-fringe empty-line cider-fringe-good-face))
"The before-string property that adds a green indicator on the fringe.")
(defcustom cider-use-fringe-indicators t
"Whether to display evaluation indicators on the left fringe."
:safe #'booleanp
:group 'cider
:type 'boolean)
(defun cider--make-fringe-overlay (&optional end)
"Place an eval indicator at the fringe before a sexp.
END is the position where the sexp ends, and defaults to point."
(when cider-use-fringe-indicators
(with-current-buffer (if (markerp end)
(marker-buffer end)
(current-buffer))
(save-excursion
(if end
(goto-char end)
(setq end (point)))
(clojure-forward-logical-sexp -1)
;; Create the green-circle overlay.
(cider--make-overlay (point) end 'cider-fringe-indicator
'before-string cider--fringe-overlay-good)))))
(cl-defun cider--make-result-overlay (value &rest props &key where duration (type 'result)
(format (concat " " cider-eval-result-prefix "%s "))
(prepend-face 'cider-result-overlay-face)
&allow-other-keys)
"Place an overlay displaying VALUE at the end of line.
VALUE is used as the overlay's after-string property, meaning it is
displayed at the end of the overlay. The overlay itself is placed from
beginning to end of current line.
Return nil if the overlay was not placed or if it might not be visible, and
return the overlay otherwise.
Return the overlay if it was placed successfully, and nil if it failed.
This function takes some optional keyword arguments:
If WHERE is a number or a marker, apply the overlay over
the entire line at that place (defaulting to `point'). If
it is a cons cell, the car and cdr determine the start and
end of the overlay.
DURATION takes the same possible values as the
`cider-eval-result-duration' variable.
TYPE is passed to `cider--make-overlay' (defaults to `result').
FORMAT is a string passed to `format'. It should have
exactly one %s construct (for VALUE).
All arguments beyond these (PROPS) are properties to be used on the
overlay."
(declare (indent 1))
(while (keywordp (car props))
(setq props (cdr (cdr props))))
;; If the marker points to a dead buffer, don't do anything.
(let ((buffer (cond
((markerp where) (marker-buffer where))
((markerp (car-safe where)) (marker-buffer (car where)))
(t (current-buffer)))))
(with-current-buffer buffer
(save-excursion
(when (number-or-marker-p where)
(goto-char where))
;; Make sure the overlay is actually at the end of the sexp.
(skip-chars-backward "\r\n[:blank:]")
(let* ((beg (if (consp where)
(car where)
(save-excursion
(clojure-backward-logical-sexp 1)
(point))))
(end (if (consp where)
(cdr where)
(line-end-position)))
(display-string (format format value))
(o nil))
(remove-overlays beg end 'category type)
(funcall (if cider-overlays-use-font-lock
#'font-lock-prepend-text-property
#'put-text-property)
0 (length display-string)
'face prepend-face
display-string)
;; If the display spans multiple lines or is very long, display it at
;; the beginning of the next line.
(when (or (string-match "\n." display-string)
(> (string-width display-string)
(- (window-width) (current-column))))
(setq display-string (concat " \n" display-string)))
;; Put the cursor property only once we're done manipulating the
;; string, since we want it to be at the first char.
(put-text-property 0 1 'cursor 0 display-string)
(when (> (string-width display-string) (* 3 (window-width)))
(setq display-string
(concat (substring display-string 0 (* 3 (window-width)))
(substitute-command-keys
"...\nResult truncated. Type `\\[cider-inspect-last-result]' to inspect it."))))
;; Create the result overlay.
(setq o (apply #'cider--make-overlay
beg end type
'after-string display-string
props))
(pcase duration
((pred numberp) (run-at-time duration nil #'cider--delete-overlay o))
(`command
;; If inside a command-loop, tell `cider--remove-result-overlay'
;; to only remove after the *next* command.
(if this-command
(add-hook 'post-command-hook
#'cider--remove-result-overlay-after-command
nil 'local)
(cider--remove-result-overlay-after-command))))
(when-let ((win (get-buffer-window buffer)))
;; Left edge is visible.
(when (and (<= (window-start win) (point))
;; In 24.3 `<=' is still a binary perdicate.
(<= (point) (window-end win))
;; Right edge is visible. This is a little conservative
;; if the overlay contains line breaks.
(or (< (+ (current-column) (string-width value))
(window-width win))
(not truncate-lines)))
o)))))))
;;; Displaying eval result
(defun cider--display-interactive-eval-result (value &optional point)
"Display the result VALUE of an interactive eval operation.
VALUE is syntax-highlighted and displayed in the echo area.
If POINT and `cider-use-overlays' are non-nil, it is also displayed in an
overlay at the end of the line containing POINT.
Note that, while POINT can be a number, it's preferable to be a marker, as
that will better handle some corner cases where the original buffer is not
focused."
(let* ((font-value (if cider-result-use-clojure-font-lock
(cider-font-lock-as-clojure value)
value))
(used-overlay (when (and point cider-use-overlays)
(cider--make-result-overlay font-value
:where point
:duration cider-eval-result-duration))))
(message
"%s"
(propertize (format "%s%s" cider-eval-result-prefix font-value)
;; The following hides the message from the echo-area, but
;; displays it in the Messages buffer. We only hide the message
;; if the user wants to AND if the overlay succeeded.
'invisible (and used-overlay
(not (eq cider-use-overlays 'both)))))))
;;; Fragile buttons
(defface cider-fragile-button-face
'((((type graphic))
:box (:line-width 3 :style released-button)
:inherit font-lock-warning-face)
(t :inverse-video t))
"Face for buttons that vanish when clicked."
:package-version '(cider . "0.12.0")
:group 'cider)
(define-button-type 'cider-fragile
'action 'cider--overlay-destroy
'follow-link t
'face nil
'modification-hooks '(cider--overlay-destroy)
'help-echo "RET: delete this.")
(defun cider--overlay-destroy (ov &rest r)
"Delete overlay OV and its underlying text.
If any other arguments are given (collected in R), only actually do anything
if the first one is non-nil. This is so it works in `modification-hooks'."
(unless (and r (not (car r)))
(let ((inhibit-modification-hooks t)
(beg (copy-marker (overlay-start ov)))
(end (copy-marker (overlay-end ov))))
(delete-overlay ov)
(delete-region beg end)
(goto-char beg)
(when (= (char-after) (char-before) ?\n)
(delete-char 1)))))
(provide 'cider-overlays)
;;; cider-overlays.el ends here

12
elpa/cider-20160927.2135/cider-pkg.el
View File

@ -1,12 +0,0 @@
(define-package "cider" "20160927.2135" "Clojure Interactive Development Environment that Rocks"
'((emacs "24.3")
(clojure-mode "5.5.2")
(pkg-info "0.4")
(queue "0.1.1")
(spinner "1.7")
(seq "2.16"))
:url "http://www.github.com/clojure-emacs/cider" :keywords
'("languages" "clojure" "cider"))
;; Local Variables:
;; no-byte-compile: t
;; End:

129
elpa/cider-20160927.2135/cider-popup.el
View File

@ -1,129 +0,0 @@
;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*-
;; Copyright © 2015-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Common functionality for dealing with popup buffers.
;;; Code:
(require 'cider-compat)
(define-minor-mode cider-popup-buffer-mode
"Mode for CIDER popup buffers"
nil
(" cider-tmp")
'(("q" . cider-popup-buffer-quit-function)))
(defvar-local cider-popup-buffer-quit-function #'cider-popup-buffer-quit
"The function that is used to quit a temporary popup buffer.")
(defun cider-popup-buffer-quit-function (&optional kill-buffer-p)
"Wrapper to invoke the function `cider-popup-buffer-quit-function'.
KILL-BUFFER-P is passed along."
(interactive)
(funcall cider-popup-buffer-quit-function kill-buffer-p))
(defun cider-popup-buffer (name &optional select mode ancillary)
"Create new popup buffer called NAME.
If SELECT is non-nil, select the newly created window.
If major MODE is non-nil, enable it for the popup buffer.
If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers'
and automatically removed when killed."
(thread-first (cider-make-popup-buffer name mode ancillary)
(cider-popup-buffer-display select)))
(defun cider-popup-buffer-display (buffer &optional select)
"Display BUFFER.
If SELECT is non-nil, select the BUFFER."
(let ((window (get-buffer-window buffer 'visible)))
(when window
(with-current-buffer buffer
(set-window-point window (point))))
;; If the buffer we are popping up is already displayed in the selected
;; window, the below `inhibit-same-window' logic will cause it to be
;; displayed twice - so we early out in this case. Note that we must check
;; `selected-window', as async request handlers are executed in the context
;; of the current connection buffer (i.e. `current-buffer' is dynamically
;; bound to that).
(unless (eq window (selected-window))
;; Non nil `inhibit-same-window' ensures that current window is not covered
;; Non nil `inhibit-switch-frame' ensures that the other frame is not selected
;; if that's where the buffer is being shown.
(funcall (if select #'pop-to-buffer #'display-buffer)
buffer `(nil . ((inhibit-same-window . ,pop-up-windows)
(reusable-frames . visible))))))
buffer)
(defun cider-popup-buffer-quit (&optional kill)
"Quit the current (temp) window.
Bury its buffer using `quit-restore-window'.
If prefix argument KILL is non-nil, kill the buffer instead of burying it."
(interactive)
(quit-restore-window (selected-window) (if kill 'kill 'append)))
(defvar-local cider-popup-output-marker nil)
(defvar cider-ancillary-buffers nil)
(defun cider-make-popup-buffer (name &optional mode ancillary)
"Create a temporary buffer called NAME using major MODE (if specified).
If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers'
and automatically removed when killed."
(with-current-buffer (get-buffer-create name)
(kill-all-local-variables)
(setq buffer-read-only nil)
(erase-buffer)
(when mode
(funcall mode))
(cider-popup-buffer-mode 1)
(setq cider-popup-output-marker (point-marker))
(setq buffer-read-only t)
(when ancillary
(add-to-list 'cider-ancillary-buffers name)
(add-hook 'kill-buffer-hook
(lambda () (setq cider-ancillary-buffers (remove name cider-ancillary-buffers)))
nil 'local))
(current-buffer)))
(defun cider-emit-into-popup-buffer (buffer value &optional face)
"Emit into BUFFER the provided VALUE optionally using FACE."
;; Long string output renders Emacs unresponsive and users might intentionally
;; kill the frozen popup buffer. Therefore, we don't re-create the buffer and
;; silently ignore the output.
(when (buffer-live-p buffer)
(with-current-buffer buffer
(let ((inhibit-read-only t)
(buffer-undo-list t)
(moving (= (point) cider-popup-output-marker)))
(save-excursion
(goto-char cider-popup-output-marker)
(let ((value-str (format "%s" value)))
(when face
(if (fboundp 'add-face-text-property)
(add-face-text-property 0 (length value-str) face nil value-str)
(add-text-properties 0 (length value-str) (list 'face face) value-str)))
(insert value-str))
(indent-sexp)
(set-marker cider-popup-output-marker (point)))
(when moving (goto-char cider-popup-output-marker))))))
(provide 'cider-popup)
;;; cider-popup.el ends here

1377
elpa/cider-20160927.2135/cider-repl.el
View File

File diff suppressed because it is too large Load Diff

129
elpa/cider-20160927.2135/cider-resolve.el
View File

@ -1,129 +0,0 @@
;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection
;; Copyright © 2015-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; The ns cache is a dict of namespaces stored in the connection buffer. This
;; file offers functions to easily get information about variables from this
;; cache, given the variable's name and the file's namespace. This
;; functionality is similar to that offered by the `cider-var-info' function
;; (and others). The difference is that all functions in this file operate
;; without contacting the server (they still rely on an active connection
;; buffer, but no messages are actually exchanged).
;; For this reason, the functions here are well suited for very
;; performance-sentitive operations, such as font-locking or
;; indentation. Meanwhile, operations like code-jumping are better off
;; communicating with the middleware, just in the off chance that the cache is
;; outdated.
;; Below is a typical entry on this cache dict. Note that clojure.core symbols
;; are excluded from the refers to save space.
;; "cider.nrepl.middleware.track-state"
;; (dict "aliases"
;; (dict "cljs" "cider.nrepl.middleware.util.cljs"
;; "misc" "cider.nrepl.middleware.util.misc"
;; "set" "clojure.set")
;; "interns" (dict a
;; "assoc-state" (dict "arglists"
;; (("response"
;; (dict "as" "msg" "keys"
;; ("session")))))
;; "filter-core" (dict "arglists"
;; (("refers")))
;; "make-transport" (dict "arglists"
;; (((dict "as" "msg" "keys"
;; ("transport")))))
;; "ns-as-map" (dict "arglists"
;; (("ns")))
;; "ns-cache" (dict)
;; "relevant-meta" (dict "arglists"
;; (("var")))
;; "update-vals" (dict "arglists"
;; (("m" "f")))
;; "wrap-tracker" (dict "arglists"
;; (("handler"))))
;; "refers" (dict "set-descriptor!" "#'clojure.tools.nrepl.middleware/set-descriptor!"))
;;; Code:
(require 'cider-client)
(require 'nrepl-dict)
(require 'cider-util)
(defvar cider-repl-ns-cache)
(defun cider-resolve--get-in (&rest keys)
"Return (nrepl-dict-get-in cider-repl-ns-cache KEYS)."
(when cider-connections
(with-current-buffer (cider-current-connection)
(nrepl-dict-get-in cider-repl-ns-cache keys))))
(defun cider-resolve-alias (ns alias)
"Return the namespace that ALIAS refers to in namespace NS.
If it doesn't point anywhere, returns ALIAS."
(or (cider-resolve--get-in ns "aliases" alias)
alias))
(defconst cider-resolve--prefix-regexp "\\`\\(?:#'\\)?\\([^/]+\\)/")
(defun cider-resolve-var (ns var)
"Return a dict of the metadata of a clojure var VAR in namespace NS.
VAR is a string.
Return nil only if VAR cannot be resolved."
(let* ((var-ns (when (string-match cider-resolve--prefix-regexp var)
(cider-resolve-alias ns (match-string 1 var))))
(name (replace-regexp-in-string cider-resolve--prefix-regexp "" var)))
(or
(cider-resolve--get-in (or var-ns ns) "interns" name)
(unless var-ns
;; If the var had no prefix, it might be referred.
(if-let ((referal (cider-resolve--get-in ns "refers" name)))
(cider-resolve-var ns referal)
;; Or it might be from core.
(unless (equal ns "clojure.core")
(cider-resolve-var "clojure.core" name)))))))
(defun cider-resolve-core-ns ()
"Return a dict of the core namespace for current connection.
This will be clojure.core or cljs.core depending on `cider-repl-type'."
(when (cider-connected-p)
(with-current-buffer (cider-current-connection)
(cider-resolve--get-in (if (equal cider-repl-type "cljs")
"cljs.core"
"clojure.core")))))
(defun cider-resolve-ns-symbols (ns)
"Return a plist of all valid symbols in NS.
Each entry's value is the metadata of the var that the symbol refers to.
NS can be the namespace name, or a dict of the namespace itself."
(when-let ((dict (if (stringp ns)
(cider-resolve--get-in ns)
ns)))
(nrepl-dbind-response dict (interns refers aliases)
(append (cdr interns)
(nrepl-dict-flat-map (lambda (alias namespace)
(nrepl-dict-flat-map (lambda (sym meta)
(list (concat alias "/" sym) meta))
(cider-resolve--get-in namespace "interns")))
aliases)))))
(provide 'cider-resolve)
;;; cider-resolve.el ends here

75
elpa/cider-20160927.2135/cider-scratch.el
View File

@ -1,75 +0,0 @@
;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*-
;; Copyright © 2014-2016 Bozhidar Batsov and CIDER contributors
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Artur Malabarba <bruce.connor.am@gmail.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Imitate Emacs's *scratch* buffer.
;;; Code:
(require 'cider-interaction)
(require 'clojure-mode)
(defvar cider-clojure-interaction-mode-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map clojure-mode-map)
(define-key map (kbd "C-j") #'cider-eval-print-last-sexp)
(define-key map [remap paredit-newline] #'cider-eval-print-last-sexp)
map))
(defconst cider-scratch-buffer-name "*cider-scratch*")
(push cider-scratch-buffer-name cider-ancillary-buffers)
;;;###autoload
(defun cider-scratch ()
"Go to the scratch buffer named `cider-scratch-buffer-name'."
(interactive)
(pop-to-buffer (cider-find-or-create-scratch-buffer)))
(defun cider-find-or-create-scratch-buffer ()
"Find or create the scratch buffer."
(or (get-buffer cider-scratch-buffer-name)
(cider-create-scratch-buffer)))
(define-derived-mode cider-clojure-interaction-mode clojure-mode "Clojure Interaction"
"Major mode for typing and evaluating Clojure forms.
Like clojure-mode except that \\[cider-eval-print-last-sexp] evals the Lisp expression
before point, and prints its value into the buffer, advancing point.
\\{cider-clojure-interaction-mode-map}")
(defun cider-create-scratch-buffer ()
"Create a new scratch buffer."
(with-current-buffer (get-buffer-create cider-scratch-buffer-name)
(cider-clojure-interaction-mode)
(insert ";; This buffer is for Clojure experiments and evaluation.\n"
";; Press C-j to evaluate the last expression.\n\n")
(current-buffer)))
(provide 'cider-scratch)
;;; cider-scratch.el ends here

167
elpa/cider-20160927.2135/cider-selector.el
View File

@ -1,167 +0,0 @@
;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*-
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Artur Malabarba <bruce.connor.am@gmail.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Buffer selection command inspired by SLIME's selector.
;;; Code:
(require 'cider-client)
(require 'cider-interaction)
(require 'cider-scratch)
(defconst cider-selector-help-buffer "*CIDER Selector Help*"
"The name of the selector's help buffer.")
(defvar cider-selector-methods nil
"List of buffer-selection methods for the `cider-selector' command.
Each element is a list (KEY DESCRIPTION FUNCTION).
DESCRIPTION is a one-line description of what the key selects.")
(defvar cider-selector-other-window nil
"If non-nil use `switch-to-buffer-other-window'.")
(defun cider--recently-visited-buffer (mode)
"Return the most recently visited buffer, deriving its `major-mode' from MODE.
Only considers buffers that are not already visible."
(cl-loop for buffer in (buffer-list)
when (and (with-current-buffer buffer
(derived-mode-p mode))
;; names starting with space are considered hidden by Emacs
(not (string-match-p "^ " (buffer-name buffer)))
(null (get-buffer-window buffer 'visible)))
return buffer
finally (error "Can't find unshown buffer in %S" mode)))
;;;###autoload
(defun cider-selector (&optional other-window)
"Select a new buffer by type, indicated by a single character.
The user is prompted for a single character indicating the method by
which to choose a new buffer. The `?' character describes then
available methods. OTHER-WINDOW provides an optional target.
See `def-cider-selector-method' for defining new methods."
(interactive)
(message "Select [%s]: "
(apply #'string (mapcar #'car cider-selector-methods)))
(let* ((cider-selector-other-window other-window)
(ch (save-window-excursion
(select-window (minibuffer-window))
(read-char)))
(method (cl-find ch cider-selector-methods :key #'car)))
(cond (method
(funcall (cl-caddr method)))
(t
(message "No method for character: ?\\%c" ch)
(ding)
(sleep-for 1)
(discard-input)
(cider-selector)))))
(defmacro def-cider-selector-method (key description &rest body)
"Define a new `cider-select' buffer selection method.
KEY is the key the user will enter to choose this method.
DESCRIPTION is a one-line sentence describing how the method
selects a buffer.
BODY is a series of forms which are evaluated when the selector
is chosen. The returned buffer is selected with
`switch-to-buffer'."
(let ((method `(lambda ()
(let ((buffer (progn ,@body)))
(cond ((not (get-buffer buffer))
(message "No such buffer: %S" buffer)
(ding))
((get-buffer-window buffer)
(select-window (get-buffer-window buffer)))
(cider-selector-other-window
(switch-to-buffer-other-window buffer))
(t
(switch-to-buffer buffer)))))))
`(setq cider-selector-methods
(cl-sort (cons (list ,key ,description ,method)
(cl-remove ,key cider-selector-methods :key #'car))
#'< :key #'car))))
(def-cider-selector-method ?? "Selector help buffer."
(ignore-errors (kill-buffer cider-selector-help-buffer))
(with-current-buffer (get-buffer-create cider-selector-help-buffer)
(insert "CIDER Selector Methods:\n\n")
(cl-loop for (key line nil) in cider-selector-methods
do (insert (format "%c:\t%s\n" key line)))
(goto-char (point-min))
(help-mode)
(display-buffer (current-buffer) t))
(cider-selector)
(current-buffer))
(cl-pushnew (list ?4 "Select in other window" (lambda () (cider-selector t)))
cider-selector-methods :key #'car)
(def-cider-selector-method ?c
"Most recently visited clojure-mode buffer."
(cider--recently-visited-buffer 'clojure-mode))
(def-cider-selector-method ?e
"Most recently visited emacs-lisp-mode buffer."
(cider--recently-visited-buffer 'emacs-lisp-mode))
(def-cider-selector-method ?q "Abort."
(top-level))
(def-cider-selector-method ?r
"Current REPL buffer."
(cider-current-repl-buffer))
(def-cider-selector-method ?n
"Connections browser buffer."
(cider-connection-browser)
cider--connection-browser-buffer-name)
(def-cider-selector-method ?m
"Current connection's *nrepl-messages* buffer."
(cider-current-messages-buffer))
(def-cider-selector-method ?x
"*cider-error* buffer."
cider-error-buffer)
(def-cider-selector-method ?d
"*cider-doc* buffer."
cider-doc-buffer)
(declare-function cider-find-or-create-scratch-buffer "cider-scratch")
(def-cider-selector-method ?s
"*cider-scratch* buffer."
(cider-find-or-create-scratch-buffer))
(provide 'cider-selector)
;;; cider-selector.el ends here

716
elpa/cider-20160927.2135/cider-stacktrace.el
View File

@ -1,716 +0,0 @@
;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*-
;; Copyright © 2014-2016 Jeff Valk, Bozhidar Batsov and CIDER contributors
;; Author: Jeff Valk <jv@jeffvalk.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Stacktrace filtering and stack frame source navigation
;;; Code:
(require 'cl-lib)
(require 'cider-popup)
(require 'button)
(require 'easymenu)
(require 'cider-common)
(require 'cider-compat)
(require 'cider-client)
(require 'cider-util)
(require 'seq)
;; Variables
(defgroup cider-stacktrace nil
"Stacktrace filtering and navigation."
:prefix "cider-stacktrace-"
:group 'cider)
(defcustom cider-stacktrace-fill-column t
"Fill column for error messages in stacktrace display.
If nil, messages will not be wrapped. If truthy but non-numeric,
`fill-column' will be used."
:type 'list
:group 'cider-stacktrace
:package-version '(cider . "0.7.0"))
(defcustom cider-stacktrace-default-filters '(tooling dup)
"Frame types to omit from initial stacktrace display."
:type 'list
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defcustom cider-stacktrace-print-length 50
"Set the maximum length of sequences in displayed cause data.
This sets the value of Clojure's `*print-length*` when pretty printing the
`ex-data` map for exception causes in the stacktrace that are instances of
`IExceptionInfo`.
Be advised that setting this to `nil` will cause the attempted printing of
infinite data structures."
:type '(choice integer (const nil))
:group 'cider-stacktrace
:package-version '(cider . "0.9.0"))
(defcustom cider-stacktrace-print-level 50
"Set the maximum level of nesting in displayed cause data.
This sets the value of Clojure's `*print-level*` when pretty printing the
`ex-data` map for exception causes in the stacktrace that are instances of
`IExceptionInfo`.
Be advised that setting this to `nil` will cause the attempted printing of
cyclical data structures."
:type '(choice integer (const nil))
:group 'cider-stacktrace
:package-version '(cider . "0.8.0"))
(defvar cider-stacktrace-detail-max 2
"The maximum detail level for causes.")
(defvar-local cider-stacktrace-hidden-frame-count 0)
(defvar-local cider-stacktrace-filters nil)
(defvar-local cider-stacktrace-prior-filters nil)
(defvar-local cider-stacktrace-cause-visibility nil)
(defconst cider-error-buffer "*cider-error*")
(add-to-list 'cider-ancillary-buffers cider-error-buffer)
(defcustom cider-stacktrace-suppressed-errors '()
"A set of errors that won't make the stacktrace buffer 'pop-over' your active window.
The error types are represented as strings."
:type 'list
:group 'cider-stacktrace
:package-version '(cider . "0.12.0"))
;; Faces
(defface cider-stacktrace-error-class-face
'((t (:inherit font-lock-warning-face)))
"Face for exception class names"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-error-message-face
'((t (:inherit font-lock-doc-face)))
"Face for exception messages"
:group 'cider-stacktrace
:package-version '(cider . "0.7.0"))
(defface cider-stacktrace-filter-shown-face
'((t (:inherit button :underline t :weight normal)))
"Face for filter buttons representing frames currently visible"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-filter-hidden-face
'((t (:inherit button :underline nil :weight normal)))
"Face for filter buttons representing frames currently filtered out"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-face
'((t (:inherit default)))
"Face for stack frame text"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-ns-face
'((t (:inherit font-lock-comment-face)))
"Face for stack frame namespace name"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-fn-face
'((t (:inherit default :weight bold)))
"Face for stack frame function name"
:group 'cider-stacktrace
:package-version '(cider . "0.6.0"))
(defface cider-stacktrace-promoted-button-face
'((((type graphic))
:box (:line-width 3 :style released-button)
:inherit error)
(t :inverse-video t))
"A button with this face represents a promoted (non-suppressed) error type."
:group 'cider-stacktrace
:package-version '(cider . "0.12.0"))
(defface cider-stacktrace-suppressed-button-face
'((((type graphic))
:box (:line-width 3 :style pressed-button)
:inherit widget-inactive-face)
(t :inverse-video t))
"A button with this face represents a suppressed error type."
:group 'cider-stacktrace
:package-version '(cider . "0.12.0"))
;; Colors & Theme Support
(defvar cider-stacktrace-frames-background-color
(cider-scale-background-color)
"Background color for stacktrace frames.")
(defadvice enable-theme (after cider-stacktrace-adapt-to-theme activate)
"When theme is changed, update `cider-stacktrace-frames-background-color'."
(setq cider-stacktrace-frames-background-color (cider-scale-background-color)))
;; Mode & key bindings
(defvar cider-stacktrace-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "M-p") #'cider-stacktrace-previous-cause)
(define-key map (kbd "M-n") #'cider-stacktrace-next-cause)
(define-key map (kbd "M-.") #'cider-stacktrace-jump)
(define-key map "q" #'cider-popup-buffer-quit-function)
(define-key map "j" #'cider-stacktrace-toggle-java)
(define-key map "c" #'cider-stacktrace-toggle-clj)
(define-key map "r" #'cider-stacktrace-toggle-repl)
(define-key map "t" #'cider-stacktrace-toggle-tooling)
(define-key map "d" #'cider-stacktrace-toggle-duplicates)
(define-key map "a" #'cider-stacktrace-toggle-all)
(define-key map "1" #'cider-stacktrace-cycle-cause-1)
(define-key map "2" #'cider-stacktrace-cycle-cause-2)
(define-key map "3" #'cider-stacktrace-cycle-cause-3)
(define-key map "4" #'cider-stacktrace-cycle-cause-4)
(define-key map "5" #'cider-stacktrace-cycle-cause-5)
(define-key map "0" #'cider-stacktrace-cycle-all-causes)
(define-key map [tab] #'cider-stacktrace-cycle-current-cause)
(define-key map [backtab] #'cider-stacktrace-cycle-all-causes)
(easy-menu-define cider-stacktrace-mode-menu map
"Menu for CIDER's stacktrace mode"
'("Stacktrace"
["Previous cause" cider-stacktrace-previous-cause]
["Next cause" cider-stacktrace-next-cause]
"--"
["Jump to frame source" cider-stacktrace-jump]
"--"
["Cycle current cause detail" cider-stacktrace-cycle-current-cause]
["Cycle cause #1 detail" cider-stacktrace-cycle-cause-1]
["Cycle cause #2 detail" cider-stacktrace-cycle-cause-2]
["Cycle cause #3 detail" cider-stacktrace-cycle-cause-3]
["Cycle cause #4 detail" cider-stacktrace-cycle-cause-4]
["Cycle cause #5 detail" cider-stacktrace-cycle-cause-5]
["Cycle all cause detail" cider-stacktrace-cycle-all-causes]
"--"
["Show/hide Java frames" cider-stacktrace-toggle-java]
["Show/hide Clojure frames" cider-stacktrace-toggle-clj]
["Show/hide REPL frames" cider-stacktrace-toggle-repl]
["Show/hide tooling frames" cider-stacktrace-toggle-tooling]
["Show/hide duplicate frames" cider-stacktrace-toggle-duplicates]
["Show/hide all frames" cider-stacktrace-toggle-all]))
map))
(define-derived-mode cider-stacktrace-mode special-mode "Stacktrace"
"Major mode for filtering and navigating CIDER stacktraces.
\\{cider-stacktrace-mode-map}"
(setq buffer-read-only t)
(setq-local truncate-lines t)
(setq-local electric-indent-chars nil)
(setq-local cider-stacktrace-prior-filters nil)
(setq-local cider-stacktrace-hidden-frame-count 0)
(setq-local cider-stacktrace-filters cider-stacktrace-default-filters)
(setq-local cider-stacktrace-cause-visibility (make-vector 10 0)))
;; Stacktrace filtering
(defun cider-stacktrace-indicate-filters (filters)
"Update enabled state of filter buttons.
Find buttons with a 'filter property; if filter is a member of FILTERS, or
if filter is nil ('show all') and the argument list is non-nil, fontify the
button as disabled. Upon finding text with a 'hidden-count property, stop
searching and update the hidden count text."
(with-current-buffer cider-error-buffer
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t)
(get-face (lambda (hide)
(if hide
'cider-stacktrace-filter-hidden-face
'cider-stacktrace-filter-shown-face))))
;; Toggle buttons
(while (not (or (get-text-property (point) 'hidden-count) (eobp)))
(let ((button (button-at (point))))
(when button
(let* ((filter (button-get button 'filter))
(face (funcall get-face (if filter
(member filter filters)
filters))))
(button-put button 'face face)))
(goto-char (or (next-property-change (point))
(point-max)))))
;; Update hidden count
(when (and (get-text-property (point) 'hidden-count)
(re-search-forward "[0-9]+" (line-end-position) t))
(replace-match
(number-to-string cider-stacktrace-hidden-frame-count)))))))
(defun cider-stacktrace-apply-filters (filters)
"Set visibility on stack frames using FILTERS.
Update `cider-stacktrace-hidden-frame-count' and indicate filters applied.
Currently collapsed stacktraces are ignored, and do not contribute to the
hidden count."
(with-current-buffer cider-error-buffer
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t)
(hidden 0))
(while (not (eobp))
(unless (get-text-property (point) 'collapsed)
(let* ((flags (get-text-property (point) 'flags))
(hide (if (seq-intersection filters flags) t nil)))
(when hide (cl-incf hidden))
(put-text-property (point) (line-beginning-position 2) 'invisible hide)))
(forward-line 1))
(setq cider-stacktrace-hidden-frame-count hidden)))
(cider-stacktrace-indicate-filters filters)))
(defun cider-stacktrace-apply-cause-visibility ()
"Apply `cider-stacktrace-cause-visibility' to causes and reapply filters."
(with-current-buffer cider-error-buffer
(save-excursion
(goto-char (point-min))
(cl-flet ((next-detail (end)
(when-let ((pos (next-single-property-change (point) 'detail)))
(when (< pos end)
(goto-char pos)))))
(let ((inhibit-read-only t))
;; For each cause...
(while (cider-stacktrace-next-cause)
(let* ((num (get-text-property (point) 'cause))
(level (elt cider-stacktrace-cause-visibility num))
(cause-end (cadr (cider-property-bounds 'cause))))
;; For each detail level within the cause, set visibility.
(while (next-detail cause-end)
(let* ((detail (get-text-property (point) 'detail))
(detail-end (cadr (cider-property-bounds 'detail)))
(hide (if (> detail level) t nil)))
(add-text-properties (point) detail-end
(list 'invisible hide
'collapsed hide))))))))
(cider-stacktrace-apply-filters
cider-stacktrace-filters))))
;;; Internal/Middleware error suppression
(defun cider-stacktrace-some-suppressed-errors-p (error-types)
"Return intersection of ERROR-TYPES and CIDER-STACKTRACE-SUPPRESSED-ERRORS.
I.e, Return non-nil if the seq ERROR-TYPES shares any elements with
`cider-stacktrace-suppressed-errors'. This means that even a 'well-behaved' (ie,
promoted) error type will be 'guilty by association' if grouped with a
suppressed error type."
(seq-intersection error-types cider-stacktrace-suppressed-errors))
(defun cider-stacktrace-suppress-error (error-type)
"Destructively add element ERROR-TYPE to the `cider-stacktrace-suppressed-errors' set."
(setq cider-stacktrace-suppressed-errors
(cl-adjoin error-type cider-stacktrace-suppressed-errors :test 'equal)))
(defun cider-stacktrace-promote-error (error-type)
"Destructively remove element ERROR-TYPE from the `cider-stacktrace-suppressed-errors' set."
(setq cider-stacktrace-suppressed-errors
(remove error-type cider-stacktrace-suppressed-errors)))
(defun cider-stacktrace-suppressed-error-p (error-type)
"Return non-nil if element ERROR-TYPE is a member of the `cider-stacktrace-suppressed-errors' set."
(member error-type cider-stacktrace-suppressed-errors))
;; Interactive functions
(defun cider-stacktrace-previous-cause ()
"Move point to the previous exception cause, if one exists."
(interactive)
(with-current-buffer cider-error-buffer
(when-let ((pos (previous-single-property-change (point) 'cause)))
(goto-char pos))))
(defun cider-stacktrace-next-cause ()
"Move point to the next exception cause, if one exists."
(interactive)
(with-current-buffer cider-error-buffer
(when-let ((pos (next-single-property-change (point) 'cause)))
(goto-char pos))))
(defun cider-stacktrace-cycle-cause (num &optional level)
"Update element NUM of `cider-stacktrace-cause-visibility', optionally to LEVEL.
If LEVEL is not specified, its current value is incremented. When it reaches 3,
it wraps to 0."
(let ((level (or level (1+ (elt cider-stacktrace-cause-visibility num)))))
(aset cider-stacktrace-cause-visibility num (mod level 3))
(cider-stacktrace-apply-cause-visibility)))
(defun cider-stacktrace-cycle-all-causes ()
"Cycle the visibility of all exception causes."
(interactive)
(with-current-buffer cider-error-buffer
(save-excursion
;; Find nearest cause.
(unless (get-text-property (point) 'cause)
(cider-stacktrace-next-cause)
(unless (get-text-property (point) 'cause)
(cider-stacktrace-previous-cause)))
;; Cycle its level, and apply that to all causes.
(let* ((num (get-text-property (point) 'cause))
(level (1+ (elt cider-stacktrace-cause-visibility num))))
(setq-local cider-stacktrace-cause-visibility
(make-vector 10 (mod level 3)))
(cider-stacktrace-apply-cause-visibility)))))
(defun cider-stacktrace-cycle-current-cause ()
"Cycle the visibility of current exception at point, if any."
(interactive)
(with-current-buffer cider-error-buffer
(when-let ((num (get-text-property (point) 'cause)))
(cider-stacktrace-cycle-cause num))))
(defun cider-stacktrace-cycle-cause-1 ()
"Cycle the visibility of exception cause #1."
(interactive)
(cider-stacktrace-cycle-cause 1))
(defun cider-stacktrace-cycle-cause-2 ()
"Cycle the visibility of exception cause #2."
(interactive)
(cider-stacktrace-cycle-cause 2))
(defun cider-stacktrace-cycle-cause-3 ()
"Cycle the visibility of exception cause #3."
(interactive)
(cider-stacktrace-cycle-cause 3))
(defun cider-stacktrace-cycle-cause-4 ()
"Cycle the visibility of exception cause #4."
(interactive)
(cider-stacktrace-cycle-cause 4))
(defun cider-stacktrace-cycle-cause-5 ()
"Cycle the visibility of exception cause #5."
(interactive)
(cider-stacktrace-cycle-cause 5))
(defun cider-stacktrace-toggle-all ()
"Reset `cider-stacktrace-filters' if present; otherwise restore prior filters."
(interactive)
(when cider-stacktrace-filters
(setq-local cider-stacktrace-prior-filters
cider-stacktrace-filters))
(cider-stacktrace-apply-filters
(setq cider-stacktrace-filters
(unless cider-stacktrace-filters ; when current filters are nil,
cider-stacktrace-prior-filters)))) ; reenable prior filter set
(defun cider-stacktrace-toggle (flag)
"Update `cider-stacktrace-filters' to add or remove FLAG, and apply filters."
(cider-stacktrace-apply-filters
(setq cider-stacktrace-filters
(if (memq flag cider-stacktrace-filters)
(remq flag cider-stacktrace-filters)
(cons flag cider-stacktrace-filters)))))
(defun cider-stacktrace-toggle-java ()
"Toggle display of Java stack frames."
(interactive)
(cider-stacktrace-toggle 'java))
(defun cider-stacktrace-toggle-clj ()
"Toggle display of Clojure stack frames."
(interactive)
(cider-stacktrace-toggle 'clj))
(defun cider-stacktrace-toggle-repl ()
"Toggle display of REPL stack frames."
(interactive)
(cider-stacktrace-toggle 'repl))
(defun cider-stacktrace-toggle-tooling ()
"Toggle display of Tooling stack frames (compiler, nREPL middleware, etc)."
(interactive)
(cider-stacktrace-toggle 'tooling))
(defun cider-stacktrace-toggle-duplicates ()
"Toggle display of stack frames that are duplicates of their descendents."
(interactive)
(cider-stacktrace-toggle 'dup))
;; Text button functions
(defun cider-stacktrace-filter (button)
"Apply filter(s) indicated by the BUTTON."
(with-temp-message "Filters may also be toggled with the keyboard."
(let ((flag (button-get button 'filter)))
(if flag
(cider-stacktrace-toggle flag)
(cider-stacktrace-toggle-all)))
(sit-for 5)))
(defun cider-stacktrace-toggle-suppression (button)
"Toggle stacktrace pop-over/pop-under behavior for the `error-type' in BUTTON.
Achieved by destructively manipulating the `cider-stacktrace-suppressed-errors' set."
(with-current-buffer cider-error-buffer
(let ((inhibit-read-only t)
(suppressed (button-get button 'suppressed))
(error-type (button-get button 'error-type)))
(if suppressed
(progn
(cider-stacktrace-promote-error error-type)
(button-put button 'face 'cider-stacktrace-promoted-button-face)
(button-put button 'help-echo "Click to suppress these stacktraces."))
(cider-stacktrace-suppress-error error-type)
(button-put button 'face 'cider-stacktrace-suppressed-button-face)
(button-put button 'help-echo "Click to promote these stacktraces."))
(button-put button 'suppressed (not suppressed)))))
(defun cider-stacktrace-navigate (button)
"Navigate to the stack frame source represented by the BUTTON."
(let* ((var (button-get button 'var))
(class (button-get button 'class))
(method (button-get button 'method))
(info (or (and var (cider-var-info var))
(and class method (cider-member-info class method))
(nrepl-dict)))
;; Stacktrace returns more accurate line numbers, but if the function's
;; line was unreliable, then so is the stacktrace by the same amount.
;; Set `line-shift' to the number of lines from the beginning of defn.
(line-shift (- (or (button-get button 'line) 0)
(or (nrepl-dict-get info "line") 1)))
;; give priority to `info` files as `info` returns full paths.
(info (nrepl-dict-put info "file" (or (nrepl-dict-get info "file")
(button-get button 'file)))))
(cider--jump-to-loc-from-info info t)
(forward-line line-shift)
(back-to-indentation)))
(defun cider-stacktrace-jump (&optional arg)
"Find definition for stack frame at point, if available.
The prefix ARG and `cider-prompt-for-symbol' decide whether to
prompt and whether to use a new window. Similar to `cider-find-var'."
(interactive "P")
(let ((button (button-at (point))))
(if (and button (button-get button 'line))
(cider-stacktrace-navigate button)
(cider-find-var arg))))
;; Rendering
(defun cider-stacktrace-emit-indented (text indent &optional fill)
"Insert TEXT, and INDENT and optionally FILL the entire block."
(let ((beg (point)))
(insert text)
(goto-char beg)
(while (not (eobp))
(insert indent)
(forward-line))
(when (and fill cider-stacktrace-fill-column)
(when (and (numberp cider-stacktrace-fill-column))
(setq-local fill-column cider-stacktrace-fill-column))
(setq-local fill-prefix indent)
(fill-region beg (point)))))
(defun cider-stacktrace-render-filters (buffer filters)
"Emit into BUFFER toggle buttons for each of the FILTERS."
(with-current-buffer buffer
(insert " Show: ")
(dolist (filter filters)
(insert-text-button (car filter)
'filter (cadr filter)
'follow-link t
'action 'cider-stacktrace-filter
'help-echo (format "Toggle %s stack frames"
(car filter)))
(insert " "))
(let ((hidden "(0 frames hidden)"))
(put-text-property 0 (length hidden) 'hidden-count t hidden)
(insert " " hidden "\n"))))
(defun cider-stacktrace-render-suppression-toggle (buffer error-types)
"Emit into BUFFER toggle buttons for each of the ERROR-TYPES leading this stacktrace buffer."
(with-current-buffer buffer
(when error-types
(insert " This is an unexpected CIDER middleware error.\n Please submit a bug report via `")
(insert-text-button "M-x cider-report-bug"
'follow-link t
'action (lambda (_button) (cider-report-bug))
'help-echo "Report bug to the CIDER team.")
(insert "`.\n\n")
(insert "\
If these stacktraces are occuring frequently, consider using the
button(s) below to suppress these types of errors for the duration of
your current CIDER session. The stacktrace buffer will still be
generated, but it will \"pop under\" your current buffer instead of
\"popping over\". The button toggles this behavior.\n\n ")
(dolist (error-type error-types)
(let ((suppressed (cider-stacktrace-suppressed-error-p error-type)))
(insert-text-button (format "%s %s" (if suppressed "Promote" "Suppress") error-type)
'follow-link t
'error-type error-type
'action 'cider-stacktrace-toggle-suppression
'suppressed suppressed
'face (if suppressed
'cider-stacktrace-suppressed-button-face
'cider-stacktrace-promoted-button-face)
'help-echo (format "Click to %s these stacktraces."
(if suppressed "promote" "suppress"))))
(insert " ")))))
(defun cider-stacktrace-render-frame (buffer frame)
"Emit into BUFFER function call site info for the stack FRAME.
This associates text properties to enable filtering and source navigation."
(with-current-buffer buffer
(nrepl-dbind-response frame (file line flags class method name var ns fn)
(let ((flags (mapcar 'intern flags))) ; strings -> symbols
(insert-text-button (format "%26s:%5d %s/%s"
(if (member 'repl flags) "REPL" file) line
(if (member 'clj flags) ns class)
(if (member 'clj flags) fn method))
'var var 'class class 'method method
'name name 'file file 'line line
'flags flags 'follow-link t
'action 'cider-stacktrace-navigate
'help-echo "View source at this location"
'font-lock-face 'cider-stacktrace-face
'type 'cider-plain-button)
(save-excursion
(let ((p4 (point))
(p1 (search-backward " "))
(p2 (search-forward "/"))
(p3 (search-forward-regexp "[^/$]+")))
(put-text-property p1 p4 'font-lock-face 'cider-stacktrace-ns-face)
(put-text-property p2 p3 'font-lock-face 'cider-stacktrace-fn-face)))
(insert "\n")))))
(declare-function cider-jump-to "cider-interaction")
(defun cider-stacktrace-render-compile-error (buffer cause)
"Emit into BUFFER the compile error CAUSE, and enable jumping to it."
(with-current-buffer buffer
(nrepl-dbind-response cause (file path line column)
(let ((indent " ")
(message-face 'cider-stacktrace-error-message-face))
(insert indent)
(insert (propertize "Error compiling " 'font-lock-face message-face))
(insert-text-button path 'compile-error t
'file file 'line line 'column column 'follow-link t
'action (lambda (_button)
(cider-jump-to (cider-find-file file)
(cons line column))))
(insert (propertize (format " at (%d:%d)" line column)
'font-lock-face message-face))))))
(defun cider-stacktrace-render-cause (buffer cause num note)
"Emit into BUFFER the CAUSE NUM, exception class, message, data, and NOTE."
(with-current-buffer buffer
(nrepl-dbind-response cause (class message data stacktrace)
(let ((indent " ")
(class-face 'cider-stacktrace-error-class-face)
(message-face 'cider-stacktrace-error-message-face))
(cider-propertize-region `(cause ,num)
;; Detail level 0: exception class
(cider-propertize-region '(detail 0)
(insert (format "%d. " num)
(propertize note 'font-lock-face 'font-lock-comment-face) " "
(propertize class 'font-lock-face class-face)
"\n"))
;; Detail level 1: message + ex-data
(cider-propertize-region '(detail 1)
(if (equal class "clojure.lang.Compiler$CompilerException")
(cider-stacktrace-render-compile-error buffer cause)
(cider-stacktrace-emit-indented
(propertize (or message "(No message)")
'font-lock-face message-face) indent t))
(insert "\n")
(when data
(cider-stacktrace-emit-indented
(cider-font-lock-as-clojure data) indent nil)))
;; Detail level 2: stacktrace
(cider-propertize-region '(detail 2)
(insert "\n")
(let ((beg (point))
(bg `(:background ,cider-stacktrace-frames-background-color)))
(dolist (frame stacktrace)
(cider-stacktrace-render-frame buffer frame))
(overlay-put (make-overlay beg (point)) 'font-lock-face bg)))
;; Add line break between causes, even when collapsed.
(cider-propertize-region '(detail 0)
(insert "\n")))))))
(defun cider-stacktrace-initialize (causes)
"Set and apply CAUSES initial visibility, filters, and cursor position."
(nrepl-dbind-response (car causes) (class)
(let ((compile-error-p (equal class "clojure.lang.Compiler$CompilerException")))
;; Partially display outermost cause if it's a compiler exception (the
;; description reports reader location of the error).
(when compile-error-p
(cider-stacktrace-cycle-cause (length causes) 1))
;; Fully display innermost cause. This also applies visibility/filters.
(cider-stacktrace-cycle-cause 1 cider-stacktrace-detail-max)
;; Move point (DWIM) to the compile error location if present, or to the
;; first stacktrace frame in displayed cause otherwise. If the error
;; buffer is visible in a window, ensure that window is selected while moving
;; point, so as to move both the buffer's and the window's point.
(with-selected-window (or (get-buffer-window cider-error-buffer)
(selected-window))
(with-current-buffer cider-error-buffer
(goto-char (point-min))
(if compile-error-p
(goto-char (next-single-property-change (point) 'compile-error))
(progn
(while (cider-stacktrace-next-cause))
(goto-char (next-single-property-change (point) 'flags)))))))))
(defun cider-stacktrace-render (buffer causes &optional error-types)
"Emit into BUFFER useful stacktrace information for the CAUSES.
Takes an optional ERROR-TYPES list which will render a 'suppression' toggle
that alters the pop-over/pop-under behavorior of the stacktrace buffers
created by these types of errors. The suppressed errors set can be customized
through the `cider-stacktrace-suppressed-errors' variable."
(with-current-buffer buffer
(let ((inhibit-read-only t))
(erase-buffer)
(insert "\n")
;; Stacktrace filters
(cider-stacktrace-render-filters
buffer
`(("Clojure" clj) ("Java" java) ("REPL" repl)
("Tooling" tooling) ("Duplicates" dup) ("All" ,nil)))
(insert "\n")
;; Option to suppress internal/middleware errors
(when error-types
(cider-stacktrace-render-suppression-toggle buffer error-types)
(insert "\n\n"))
;; Stacktrace exceptions & frames
(let ((num (length causes)))
(dolist (cause causes)
(let ((note (if (= num (length causes)) "Unhandled" "Caused by")))
(cider-stacktrace-render-cause buffer cause num note)
(setq num (1- num))))))
(cider-stacktrace-initialize causes)
(font-lock-refresh-defaults)))
(provide 'cider-stacktrace)
;;; cider-stacktrace.el ends here

690
elpa/cider-20160927.2135/cider-test.el
View File

@ -1,690 +0,0 @@
;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*-
;; Copyright © 2014-2016 Jeff Valk, Bozhidar Batsov and CIDER contributors
;; Author: Jeff Valk <jv@jeffvalk.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; This provides execution, reporting, and navigation support for Clojure tests,
;; specifically using the `clojure.test' machinery. This functionality replaces
;; the venerable `clojure-test-mode' (deprecated in June 2014), and relies on
;; nREPL middleware for report running and session support.
;;; Code:
(require 'cider-common)
(require 'cider-client)
(require 'cider-popup)
(require 'cider-stacktrace)
(require 'cider-compat)
(require 'cider-overlays)
(require 'button)
(require 'easymenu)
(require 'seq)
;;; Variables
(defgroup cider-test nil
"Presentation and navigation for test results."
:prefix "cider-test-"
:group 'cider)
(defcustom cider-test-show-report-on-success nil
"Whether to show the `*cider-test-report*` buffer on passing tests."
:type 'boolean
:group 'cider-test
:package-version '(cider . "0.8.0"))
(defcustom cider-auto-select-test-report-buffer t
"Determines if the test-report buffer should be auto-selected."
:type 'boolean
:group 'cider-test
:package-version '(cider . "0.9.0"))
(defvar cider-test-last-summary nil
"The summary of the last run test.")
(defvar cider-test-last-results nil
"The results of the last run test.")
(defconst cider-test-report-buffer "*cider-test-report*"
"Buffer name in which to display test reports.")
(add-to-list 'cider-ancillary-buffers cider-test-report-buffer)
;;; Faces
(defface cider-test-failure-face
'((((class color) (background light))
:background "orange red")
(((class color) (background dark))
:background "firebrick"))
"Face for failed tests."
:group 'cider-test
:package-version '(cider . "0.7.0"))
(defface cider-test-error-face
'((((class color) (background light))
:background "orange1")
(((class color) (background dark))
:background "orange4"))
"Face for erring tests."
:group 'cider-test
:package-version '(cider . "0.7.0"))
(defface cider-test-success-face
'((((class color) (background light))
:foreground "black"
:background "green")
(((class color) (background dark))
:foreground "black"
:background "green"))
"Face for passing tests."
:group 'cider-test
:package-version '(cider . "0.7.0"))
;; Colors & Theme Support
(defvar cider-test-items-background-color
(cider-scale-background-color)
"Background color for test assertion items.")
(defadvice enable-theme (after cider-test-adapt-to-theme activate)
"When theme is changed, update `cider-test-items-background-color'."
(setq cider-test-items-background-color (cider-scale-background-color)))
;;; Report mode & key bindings
;; The primary mode of interacting with test results is the report buffer, which
;; allows navigation among tests, jumping to test definitions, expected/actual
;; diff-ing, and cause/stacktrace inspection for test errors.
(defvar cider-test-commands-map
(let ((map (define-prefix-command 'cider-test-commands-map)))
;; Duplicates of keys below with C- for convenience
(define-key map (kbd "C-r") #'cider-test-rerun-tests)
(define-key map (kbd "C-t") #'cider-test-run-test)
(define-key map (kbd "C-n") #'cider-test-run-ns-tests)
(define-key map (kbd "C-l") #'cider-test-run-loaded-tests)
(define-key map (kbd "C-p") #'cider-test-run-project-tests)
(define-key map (kbd "C-b") #'cider-test-show-report)
;; Single-key bindings defined last for display in menu
(define-key map (kbd "r") #'cider-test-rerun-tests)
(define-key map (kbd "t") #'cider-test-run-test)
(define-key map (kbd "n") #'cider-test-run-ns-tests)
(define-key map (kbd "l") #'cider-test-run-loaded-tests)
(define-key map (kbd "p") #'cider-test-run-project-tests)
(define-key map (kbd "b") #'cider-test-show-report)
map))
(defconst cider-test-menu
'("Test"
["Run test" cider-test-run-test]
["Run namespace tests" cider-test-run-ns-tests]
["Run all loaded tests" cider-test-run-loaded-tests]
["Run all project tests" cider-test-run-project-tests]
["Run tests after load-file" cider-auto-test-mode
:style toggle :selected cider-auto-test-mode]
"--"
["Interrupt running tests" cider-interrupt]
["Rerun failed/erring tests" cider-test-rerun-tests]
["Show test report" cider-test-show-report]
"--"
["Configure testing" (customize-group 'cider-test)])
"CIDER test submenu.")
(defvar cider-test-report-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-c ,") 'cider-test-commands-map)
(define-key map (kbd "C-c C-t") 'cider-test-commands-map)
(define-key map (kbd "M-p") #'cider-test-previous-result)
(define-key map (kbd "M-n") #'cider-test-next-result)
(define-key map (kbd "M-.") #'cider-test-jump)
(define-key map (kbd "<backtab>") #'cider-test-previous-result)
(define-key map (kbd "TAB") #'cider-test-next-result)
(define-key map (kbd "RET") #'cider-test-jump)
(define-key map (kbd "t") #'cider-test-jump)
(define-key map (kbd "d") #'cider-test-ediff)
(define-key map (kbd "e") #'cider-test-stacktrace)
;; `f' for "run failed".
(define-key map "f" #'cider-test-rerun-tests)
;; `g' generally reloads the buffer. The closest thing we have to that is
;; "run the test at point". But it's not as nice as rerunning all tests in
;; this buffer.
(define-key map "g" #'cider-test-run-test)
(define-key map "q" #'cider-popup-buffer-quit-function)
(easy-menu-define cider-test-report-mode-menu map
"Menu for CIDER's test result mode"
'("Test-Report"
["Previous result" cider-test-previous-result]
["Next result" cider-test-next-result]
"--"
["Rerun current test" cider-test-run-test]
["Rerun failed/erring tests" cider-test-rerun-tests]
["Run all loaded tests" cider-test-run-loaded-tests]
["Run all project tests" cider-test-run-project-tests]
"--"
["Jump to test definition" cider-test-jump]
["Display test error" cider-test-stacktrace]
["Display expected/actual diff" cider-test-ediff]))
map))
(define-derived-mode cider-test-report-mode fundamental-mode "Test Report"
"Major mode for presenting Clojure test results.
\\{cider-test-report-mode-map}"
(setq buffer-read-only t)
(setq-local truncate-lines t)
(setq-local electric-indent-chars nil))
;; Report navigation
(defun cider-test-show-report ()
"Show the test report buffer, if one exists."
(interactive)
(if-let ((report-buffer (get-buffer cider-test-report-buffer)))
(switch-to-buffer report-buffer)
(message "No test report buffer")))
(defun cider-test-previous-result ()
"Move point to the previous test result, if one exists."
(interactive)
(with-current-buffer (get-buffer cider-test-report-buffer)
(when-let ((pos (previous-single-property-change (point) 'type)))
(if (get-text-property pos 'type)
(goto-char pos)
(when-let ((pos (previous-single-property-change pos 'type)))
(goto-char pos))))))
(defun cider-test-next-result ()
"Move point to the next test result, if one exists."
(interactive)
(with-current-buffer (get-buffer cider-test-report-buffer)
(when-let ((pos (next-single-property-change (point) 'type)))
(if (get-text-property pos 'type)
(goto-char pos)
(when-let ((pos (next-single-property-change pos 'type)))
(goto-char pos))))))
(defun cider-test-jump (&optional arg)
"Find definition for test at point, if available.
The prefix ARG and `cider-prompt-for-symbol' decide whether to
prompt and whether to use a new window. Similar to `cider-find-var'."
(interactive "P")
(let ((ns (get-text-property (point) 'ns))
(var (get-text-property (point) 'var))
(line (get-text-property (point) 'line)))
(if (and ns var)
(cider-find-var arg (concat ns "/" var) line)
(cider-find-var arg))))
;;; Error stacktraces
(defvar cider-auto-select-error-buffer)
(defun cider-test-stacktrace-for (ns var index)
"Display stacktrace for the erring NS VAR test with the assertion INDEX."
(let (causes)
(cider-nrepl-send-request
(append
(list "op" "test-stacktrace" "session" (cider-current-session)
"ns" ns "var" var "index" index)
(when (cider--pprint-fn)
(list "pprint-fn" (cider--pprint-fn)))
(when cider-stacktrace-print-length
(list "print-length" cider-stacktrace-print-length))
(when cider-stacktrace-print-level
(list "print-level" cider-stacktrace-print-level)))
(lambda (response)
(nrepl-dbind-response response (class status)
(cond (class (setq causes (cons response causes)))
(status (when causes
(cider-stacktrace-render
(cider-popup-buffer cider-error-buffer
cider-auto-select-error-buffer
#'cider-stacktrace-mode)
(reverse causes))))))))))
(defun cider-test-stacktrace ()
"Display stacktrace for the erring test at point."
(interactive)
(let ((ns (get-text-property (point) 'ns))
(var (get-text-property (point) 'var))
(index (get-text-property (point) 'index))
(err (get-text-property (point) 'error)))
(if (and err ns var index)
(cider-test-stacktrace-for ns var index)
(message "No test error at point"))))
;;; Expected vs actual diffing
(defvar cider-test-ediff-buffers nil
"The expected/actual buffers used to display diff.")
(defun cider-test-ediff ()
"Show diff of the expected vs actual value for the test at point.
With the actual value, the outermost '(not ...)' s-expression is removed."
(interactive)
(let ((expected (get-text-property (point) 'expected))
(actual (get-text-property (point) 'actual)))
(if (and expected actual)
(let ((expected-buffer (generate-new-buffer " *expected*"))
(actual-buffer (generate-new-buffer " *actual*")))
(with-current-buffer expected-buffer
(insert expected)
(clojure-mode))
(with-current-buffer actual-buffer
(insert actual)
(goto-char (point-min))
(forward-char)
(forward-sexp)
(forward-whitespace 1)
(let ((beg (point)))
(forward-sexp)
(let ((actual* (buffer-substring beg (point))))
(erase-buffer)
(insert actual*)))
(clojure-mode))
(apply 'ediff-buffers
(setq cider-test-ediff-buffers
(list (buffer-name expected-buffer)
(buffer-name actual-buffer)))))
(message "No test failure at point"))))
(defun cider-test-ediff-cleanup ()
"Cleanup expected/actual buffers used for diff."
(interactive)
(mapc (lambda (b) (when (get-buffer b) (kill-buffer b)))
cider-test-ediff-buffers))
(add-hook 'ediff-cleanup-hook #'cider-test-ediff-cleanup)
;;; Report rendering
(defun cider-test-type-face (type)
"Return the font lock face for the test result TYPE."
(pcase type
("pass" 'cider-test-success-face)
("fail" 'cider-test-failure-face)
("error" 'cider-test-error-face)
(_ 'default)))
(defun cider-test-type-simple-face (type)
"Return a face for the test result TYPE using the highlight color as foreground."
(let ((face (cider-test-type-face type)))
`(:foreground ,(face-attribute face :background))))
(defun cider-test-render-summary (buffer summary)
"Emit into BUFFER the report SUMMARY statistics."
(with-current-buffer buffer
(nrepl-dbind-response summary (ns var test pass fail error)
(insert (format "Tested %d namespaces\n" ns))
(insert (format "Ran %d assertions, in %d test functions\n" test var))
(unless (zerop fail)
(cider-insert (format "%d failures" fail) 'cider-test-failure-face t))
(unless (zerop error)
(cider-insert (format "%d errors" error) 'cider-test-error-face t))
(when (zerop (+ fail error))
(cider-insert (format "%d passed" pass) 'cider-test-success-face t))
(insert "\n\n"))))
(defun cider-test-render-assertion (buffer test)
"Emit into BUFFER report detail for the TEST assertion."
(with-current-buffer buffer
(nrepl-dbind-response test (var context type message expected actual error gen-input)
(cider-propertize-region (cider-intern-keys (cdr test))
(let ((beg (point))
(type-face (cider-test-type-simple-face type))
(bg `(:background ,cider-test-items-background-color)))
(cider-insert (capitalize type) type-face nil " in ")
(cider-insert var 'font-lock-function-name-face t)
(when context (cider-insert context 'font-lock-doc-face t))
(when message (cider-insert message 'font-lock-doc-string-face t))
(when expected
(cider-insert "expected: " 'font-lock-comment-face nil
(cider-font-lock-as-clojure expected)))
(when actual
(cider-insert " actual: " 'font-lock-comment-face nil
(cider-font-lock-as-clojure actual)))
(when error
(cider-insert " error: " 'font-lock-comment-face nil)
(insert-text-button error
'follow-link t
'action '(lambda (_button) (cider-test-stacktrace))
'help-echo "View causes and stacktrace")
(insert "\n"))
(when gen-input
(cider-insert " input: " 'font-lock-comment-face nil
(cider-font-lock-as-clojure gen-input)))
(overlay-put (make-overlay beg (point)) 'font-lock-face bg))
(insert "\n")))))
(defun cider-test-non-passing (tests)
"For a list of TESTS, each an nrepl-dict, return only those that did not pass."
(seq-filter (lambda (test)
(unless (equal (nrepl-dict-get test "type") "pass")
test))
tests))
(defun cider-test-render-report (buffer summary results)
"Emit into BUFFER the report for the SUMMARY, and test RESULTS."
(with-current-buffer buffer
(let ((inhibit-read-only t))
(cider-test-report-mode)
(cider-insert "Test Summary" 'bold t)
(dolist (ns (nrepl-dict-keys results))
(insert (cider-propertize ns 'ns) "\n"))
(cider-insert "\n")
(cider-test-render-summary buffer summary)
(nrepl-dbind-response summary (fail error)
(unless (zerop (+ fail error))
(cider-insert "Results" 'bold t "\n")
;; Results are a nested dict, keyed first by ns, then var. Within each
;; var is a sequence of test assertion results.
(nrepl-dict-map
(lambda (ns vars)
(nrepl-dict-map
(lambda (_var tests)
(let* ((problems (cider-test-non-passing tests))
(count (length problems)))
(when (< 0 count)
(insert (format "%s\n%d non-passing tests:\n\n"
(cider-propertize ns 'ns) count))
(dolist (test problems)
(cider-test-render-assertion buffer test)))))
vars))
results)))
(goto-char (point-min))
(current-buffer))))
;;; Message echo
(defun cider-test-echo-running (ns &optional test)
"Echo a running message for the test NS, which may be a keyword.
The optional arg TEST denotes an individual test name."
(if test
(message "Running test %s in %s..."
(cider-propertize test 'bold)
(cider-propertize ns 'ns))
(message "Running tests in %s..."
(concat (cider-propertize
(cond ((stringp ns) ns)
((eq :non-passing ns) "failing")
((eq :loaded ns) "all loaded")
((eq :project ns) "all project"))
'ns)
(unless (stringp ns) " namespaces")))))
(defun cider-test-echo-summary (summary results)
"Echo SUMMARY statistics for a test run returning RESULTS."
(nrepl-dbind-response summary (ns test var fail error)
(if (nrepl-dict-empty-p results)
(message (concat (propertize "No assertions (or no tests) were run." 'face 'cider-test-error-face)
"Did you forget to use `is' in your tests?"))
(message (propertize
"%sRan %d assertions, in %d test functions. %d failures, %d errors."
'face (cond ((not (zerop error)) 'cider-test-error-face)
((not (zerop fail)) 'cider-test-failure-face)
(t 'cider-test-success-face)))
(concat (if (= 1 ns) ; ns count from summary
(cider-propertize (car (nrepl-dict-keys results)) 'ns)
(propertize (format "%d namespaces" ns) 'face 'default))
(propertize ": " 'face 'default))
test var fail error))))
;;; Test definition highlighting
;; On receipt of test results, failing/erring test definitions are highlighted.
;; Highlights are cleared on the next report run, and may be cleared manually
;; by the user.
;; NOTE If keybindings specific to test sources are desired, it would be
;; straightforward to turn this into a `cider-test-mode' minor mode, which we
;; enable on test sources, much like the legacy `clojure-test-mode'. At present,
;; though, there doesn't seem to be much value in this, since the report buffer
;; provides the primary means of interacting with test results.
(defun cider-test-highlight-problem (buffer test)
"Highlight the BUFFER test definition for the non-passing TEST."
(with-current-buffer buffer
(nrepl-dbind-response test (type file line message expected actual)
;; we have to watch out for vars without proper location metadata
;; right now everything evaluated interactively lacks this data
;; TODO: Figure out what to do when the metadata is missing
(when (and file line (not (cider--tooling-file-p file)))
(save-excursion
(goto-char (point-min))
(forward-line (1- line))
(search-forward "(" nil t)
(let ((beg (point)))
(forward-sexp)
(cider--make-overlay beg (point) 'cider-test
'font-lock-face (cider-test-type-face type)
'type type
'help-echo message
'message message
'expected expected
'actual actual)))))))
(defun cider-find-var-file (ns var)
"Return the buffer visiting the file in which the NS VAR is defined.
Or nil if not found."
(cider-ensure-op-supported "info")
(when-let ((info (cider-var-info (concat ns "/" var)))
(file (nrepl-dict-get info "file")))
(cider-find-file file)))
(defun cider-test-highlight-problems (results)
"Highlight all non-passing tests in the test RESULTS."
(nrepl-dict-map
(lambda (ns vars)
(nrepl-dict-map
(lambda (var tests)
(when-let ((buffer (cider-find-var-file ns var)))
(dolist (test tests)
(nrepl-dbind-response test (type)
(unless (equal "pass" type)
(cider-test-highlight-problem buffer test))))))
vars))
results))
(defun cider-test-clear-highlights ()
"Clear highlighting of non-passing tests from the last test run."
(interactive)
(when cider-test-last-results
(nrepl-dict-map
(lambda (ns vars)
(dolist (var (nrepl-dict-keys vars))
(when-let ((buffer (cider-find-var-file ns var)))
(with-current-buffer buffer
(remove-overlays nil nil 'category 'cider-test)))))
cider-test-last-results)))
;;; Test namespaces
;; Test namespace inference exists to enable DWIM test running functions: the
;; same "run-tests" function should be able to be used in a source file, and in
;; its corresponding test namespace. To provide this, we need to map the
;; relationship between those namespaces.
(defcustom cider-test-infer-test-ns 'cider-test-default-test-ns-fn
"Function to infer the test namespace for NS.
The default implementation uses the simple Leiningen convention of appending
'-test' to the namespace name."
:type 'symbol
:group 'cider-test
:package-version '(cider . "0.7.0"))
(defun cider-test-default-test-ns-fn (ns)
"For a NS, return the test namespace, which may be the argument itself.
This uses the Leiningen convention of appending '-test' to the namespace name."
(when ns
(let ((suffix "-test"))
;; string-suffix-p is only available in Emacs 24.4+
(if (string-match-p (rx-to-string `(: ,suffix eos) t) ns)
ns
(concat ns suffix)))))
;;; Test execution
(declare-function cider-emit-interactive-eval-output "cider-interaction")
(declare-function cider-emit-interactive-eval-err-output "cider-interaction")
(defun cider-test-execute (ns &optional tests silent)
"Run tests for NS, which may be a keyword, optionally specifying TESTS.
This tests a single NS, or multiple namespaces when using keywords `:project',
`:loaded' or `:non-passing'. Optional TESTS are only honored when a single
namespace is specified. Upon test completion, results are echoed and a test
report is optionally displayed. When test failures/errors occur, their sources
are highlighted.
If SILENT is non-nil, suppress all messages other then test results."
(cider-test-clear-highlights)
(cider-map-connections
(lambda (conn)
(unless silent
(if (and tests (= (length tests) 1))
;; we generate a different message when running individual tests
(cider-test-echo-running ns (car tests))
(cider-test-echo-running ns)))
(cider-nrepl-send-request
(list "op" (cond ((stringp ns) "test")
((eq :project ns) "test-all")
((eq :loaded ns) "test-all")
((eq :non-passing ns) "retest"))
"ns" (when (stringp ns) ns)
"tests" (when (stringp ns) tests)
"load?" (when (or (stringp ns)
(eq :project ns))
"true")
"session" (cider-current-session))
(lambda (response)
(nrepl-dbind-response response (summary results status out err)
(cond ((member "namespace-not-found" status)
(unless silent
(message "No test namespace: %s" (cider-propertize ns 'ns))))
(out (cider-emit-interactive-eval-output out))
(err (cider-emit-interactive-eval-err-output err))
(results
(nrepl-dbind-response summary (error fail)
(setq cider-test-last-summary summary)
(setq cider-test-last-results results)
(cider-test-highlight-problems results)
(cider-test-echo-summary summary results)
(if (or (not (zerop (+ error fail)))
cider-test-show-report-on-success)
(cider-test-render-report
(cider-popup-buffer cider-test-report-buffer
cider-auto-select-test-report-buffer)
summary results)
(when (get-buffer cider-test-report-buffer)
(with-current-buffer cider-test-report-buffer
(let ((inhibit-read-only t))
(erase-buffer)))
(cider-test-render-report
cider-test-report-buffer
summary results))))))))
conn))
:clj))
(defun cider-test-rerun-tests ()
"Rerun failed and erring tests from the last test run."
(interactive)
(if cider-test-last-summary
(nrepl-dbind-response cider-test-last-summary (fail error)
(if (not (zerop (+ error fail)))
(cider-test-execute :non-passing)
(message "No prior failures to retest")))
(message "No prior results to retest")))
(defun cider-test-run-loaded-tests ()
"Run all tests defined in currently loaded namespaces."
(interactive)
(cider-test-execute :loaded))
(defun cider-test-run-project-tests ()
"Run all tests defined in all project namespaces, loading these as needed."
(interactive)
(cider-test-execute :project))
(defun cider-test-run-ns-tests (suppress-inference &optional silent)
"Run all tests for the current Clojure namespace context.
If SILENT is non-nil, suppress all messages other then test results.
With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the
current ns."
(interactive "P")
(if-let ((ns (if suppress-inference
(cider-current-ns t)
(funcall cider-test-infer-test-ns (cider-current-ns t)))))
(cider-test-execute ns nil silent)
(if (eq major-mode 'cider-test-report-mode)
(when (y-or-n-p (concat "Test report does not define a namespace. "
"Rerun failed/erring tests?"))
(cider-test-rerun-tests))
(unless silent
(message "No namespace to test in current context")))))
(defun cider-test-run-test ()
"Run the test at point.
The test ns/var exist as text properties on report items and on highlighted
failed/erred test definitions. When not found, a test definition at point
is searched."
(interactive)
(let ((ns (get-text-property (point) 'ns))
(var (get-text-property (point) 'var)))
(if (and ns var)
(cider-test-execute ns (list var))
(let ((ns (clojure-find-ns))
(def (clojure-find-def)))
(if (and ns (member (car def) '("deftest" "defspec")))
(cider-test-execute ns (cdr def))
(message "No test at point"))))))
;;; Auto-test mode
(defun cider--test-silently ()
"Like `cider-test-run-tests', but with less feedback.
Only notify the user if there actually were any tests to run and only after
the results are received."
(when (cider-connected-p)
(let ((cider-auto-select-test-report-buffer nil)
(cider-test-show-report-on-success nil))
(cider-test-run-ns-tests nil 'soft))))
;;;###autoload
(define-minor-mode cider-auto-test-mode
"Toggle automatic testing of Clojure files.
When enabled this reruns tests every time a Clojure file is loaded.
Only runs tests corresponding to the loaded file's namespace and does
nothing if no tests are defined or if the file failed to load."
nil (cider-mode " Test") nil
:global t
(if cider-auto-test-mode
(add-hook 'cider-file-loaded-hook #'cider--test-silently)
(remove-hook 'cider-file-loaded-hook #'cider--test-silently)))
(provide 'cider-test)
;;; cider-test.el ends here

691
elpa/cider-20160927.2135/cider-util.el
View File

@ -1,691 +0,0 @@
;;; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*-
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Artur Malabarba <bruce.connor.am@gmail.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Common utility functions that don't belong anywhere else.
;;; Code:
(require 'seq)
(require 'cl-lib)
(require 'clojure-mode)
(require 'cider-compat)
(require 'nrepl-dict)
(defalias 'cider-pop-back 'pop-tag-mark)
(defcustom cider-font-lock-max-length 10000
"The max length of strings to fontify in `cider-font-lock-as'.
Setting this to nil removes the fontification restriction."
:group 'cider
:type 'boolean
:package-version '(cider . "0.10.0"))
(defun cider-util--hash-keys (hashtable)
"Return a list of keys in HASHTABLE."
(let ((keys '()))
(maphash (lambda (k _v) (setq keys (cons k keys))) hashtable)
keys))
(defun cider-util--clojure-buffers ()
"Return a list of all existing `clojure-mode' buffers."
(seq-filter
(lambda (buffer) (with-current-buffer buffer (derived-mode-p 'clojure-mode)))
(buffer-list)))
(defun cider-current-dir ()
"Return the directory of the current buffer."
(if buffer-file-name
(file-name-directory buffer-file-name)
default-directory))
(defun cider-in-string-p ()
"Return true if point is in a string."
(let ((beg (save-excursion (beginning-of-defun) (point))))
(nth 3 (parse-partial-sexp beg (point)))))
(defun cider-in-comment-p ()
"Return true if point is in a comment."
(let ((beg (save-excursion (beginning-of-defun) (point))))
(nth 4 (parse-partial-sexp beg (point)))))
(defun cider--tooling-file-p (file-name)
"Return t if FILE-NAME is not a 'real' source file.
Currently, only check if the relative file name starts with 'form-init'
which nREPL uses for temporary evaluation file names."
(let ((fname (file-name-nondirectory file-name)))
(string-match-p "^form-init" fname)))
(defun cider--cljc-or-cljx-buffer-p (&optional buffer)
"Return true if the current buffer is visiting a cljc or cljx file.
If BUFFER is provided act on that buffer instead."
(with-current-buffer (or buffer (current-buffer))
(or (derived-mode-p 'clojurec-mode) (derived-mode-p 'clojurex-mode))))
;;; Thing at point
(defun cider-defun-at-point (&optional bounds)
"Return the text of the top-level sexp at point.
If BOUNDS is non-nil, return a list of its starting and ending position
instead."
(save-excursion
(save-match-data
(end-of-defun)
(let ((end (point)))
(clojure-backward-logical-sexp 1)
(funcall (if bounds #'list #'buffer-substring-no-properties)
(point) end)))))
(defun cider-ns-form ()
"Retrieve the ns form."
(when (clojure-find-ns)
(save-excursion
(goto-char (match-beginning 0))
(cider-defun-at-point))))
(defun cider-symbol-at-point (&optional look-back)
"Return the name of the symbol at point, otherwise nil.
Ignores the REPL prompt. If LOOK-BACK is non-nil, move backwards trying to
find a symbol if there isn't one at point."
(or (when-let ((str (thing-at-point 'symbol)))
(unless (text-property-any 0 (length str) 'field 'cider-repl-prompt str)
(substring-no-properties str)))
(when look-back
(save-excursion
(ignore-errors
(while (not (looking-at "\\sw\\|\\s_\\|\\`"))
(forward-sexp -1)))
(cider-symbol-at-point)))))
;;; sexp navigation
(defun cider-sexp-at-point (&optional bounds)
"Return the sexp at point as a string, otherwise nil.
If BOUNDS is non-nil, return a list of its starting and ending position
instead."
(when-let ((b (or (and (equal (char-after) ?\()
(member (char-before) '(?\' ?\, ?\@))
;; hide stuff before ( to avoid quirks with '( etc.
(save-restriction
(narrow-to-region (point) (point-max))
(bounds-of-thing-at-point 'sexp)))
(bounds-of-thing-at-point 'sexp))))
(funcall (if bounds #'list #'buffer-substring-no-properties)
(car b) (cdr b))))
(defun cider-last-sexp (&optional bounds)
"Return the sexp preceding the point.
If BOUNDS is non-nil, return a list of its starting and ending position
instead."
(apply (if bounds #'list #'buffer-substring-no-properties)
(save-excursion
(clojure-backward-logical-sexp 1)
(list (point)
(progn (clojure-forward-logical-sexp 1)
(skip-chars-forward "[:blank:]")
(when (looking-at-p "\n") (forward-char 1))
(point))))))
(defun cider-start-of-next-sexp (&optional skip)
"Move to the start of the next sexp.
Skip any non-logical sexps like ^metadata or #reader macros.
If SKIP is an integer, also skip that many logical sexps first.
Can only error if SKIP is non-nil."
(while (clojure--looking-at-non-logical-sexp)
(forward-sexp 1))
(when (and skip (> skip 0))
(dotimes (_ skip)
(forward-sexp 1)
(cider-start-of-next-sexp))))
;;; Text properties
(defun cider-maybe-intern (name)
"If NAME is a symbol, return it; otherwise, intern it."
(if (symbolp name) name (intern name)))
(defun cider-intern-keys (plist)
"Copy PLIST, with any non-symbol keys replaced with symbols."
(when plist
(cons (cider-maybe-intern (pop plist))
(cons (pop plist) (cider-intern-keys plist)))))
(defmacro cider-propertize-region (props &rest body)
"Execute BODY and add PROPS to all the inserted text.
More precisely, PROPS are added to the region between the point's
positions before and after executing BODY."
(declare (indent 1))
(let ((start (make-symbol "start")))
`(let ((,start (point)))
(prog1 (progn ,@body)
(add-text-properties ,start (point) ,props)))))
(put 'cider-propertize-region 'lisp-indent-function 1)
(defun cider-property-bounds (prop)
"Return the the positions of the previous and next change to PROP.
PROP is the name of a text property."
(let ((end (next-single-char-property-change (point) prop)))
(list (previous-single-char-property-change end prop) end)))
(defun cider-insert (text &optional face break more-text)
"Insert TEXT with FACE, optionally followed by a line BREAK and MORE-TEXT."
(insert (if face (propertize text 'font-lock-face face) text))
(when more-text (insert more-text))
(when break (insert "\n")))
;;; Font lock
(defalias 'cider--font-lock-ensure
(if (fboundp 'font-lock-ensure)
#'font-lock-ensure
(with-no-warnings
(lambda (&optional _beg _end)
(when font-lock-mode
(font-lock-fontify-buffer))))))
(defalias 'cider--font-lock-flush
(if (fboundp 'font-lock-flush)
#'font-lock-flush
(with-no-warnings
(lambda (&optional _beg _end)
(when font-lock-mode
(font-lock-fontify-buffer))))))
(defvar cider--mode-buffers nil
"A list of buffers for different major modes.")
(defun cider--make-buffer-for-mode (mode)
"Return a temp buffer using major-mode MODE.
This buffer is not designed to display anything to the user. For that, use
`cider-make-popup-buffer' instead."
(setq cider--mode-buffers (seq-filter (lambda (x) (buffer-live-p (cdr x)))
cider--mode-buffers))
(or (cdr (assq mode cider--mode-buffers))
(let ((b (generate-new-buffer (format " *cider-temp %s*" mode))))
(push (cons mode b) cider--mode-buffers)
(with-current-buffer b
;; suppress major mode hooks as we care only about their font-locking
;; otherwise modes like whitespace-mode and paredit might interfere
(setq-local delay-mode-hooks t)
(setq delayed-mode-hooks nil)
(funcall mode))
b)))
(defun cider-font-lock-as (mode string)
"Use MODE to font-lock the STRING."
(if (or (null cider-font-lock-max-length)
(< (length string) cider-font-lock-max-length))
(with-current-buffer (cider--make-buffer-for-mode mode)
(erase-buffer)
(insert string)
(font-lock-fontify-region (point-min) (point-max))
(buffer-string))
string))
(defun cider-font-lock-region-as (mode beg end &optional buffer)
"Use MODE to font-lock text between BEG and END.
Unless you specify a BUFFER it will default to the current one."
(with-current-buffer (or buffer (current-buffer))
(let ((text (buffer-substring beg end)))
(delete-region beg end)
(goto-char beg)
(insert (cider-font-lock-as mode text)))))
(defun cider-font-lock-as-clojure (string)
"Font-lock STRING as Clojure code."
(cider-font-lock-as 'clojure-mode string))
;; Button allowing use of `font-lock-face', ignoring any inherited `face'
(define-button-type 'cider-plain-button
'face nil)
;;; Colors
(defun cider-scale-color (color scale)
"For a COLOR hex string or name, adjust intensity of RGB components by SCALE."
(let* ((rgb (color-values color))
(scaled-rgb (mapcar (lambda (n)
(format "%04x" (round (+ n (* scale 65535)))))
rgb)))
(apply #'concat "#" scaled-rgb)))
(defun cider-scale-background-color ()
"Scale the current background color to get a slighted muted version."
(let ((color (frame-parameter nil 'background-color))
(dark (eq (frame-parameter nil 'background-mode) 'dark)))
(cider-scale-color color (if dark 0.05 -0.05))))
(autoload 'pkg-info-version-info "pkg-info.el")
(defvar cider-version)
(defvar cider-codename)
(defun cider--version ()
"Retrieve CIDER's version.
A codename is added to stable versions."
(let ((version (condition-case nil
(pkg-info-version-info 'cider)
(error cider-version))))
(if (string-match-p "-snapshot" cider-version)
version
(format "%s (%s)" version cider-codename))))
;;; Strings
(defun cider-string-trim-left (string)
"Remove leading whitespace from STRING."
(if (string-match "\\`[ \t\n\r]+" string)
(replace-match "" t t string)
string))
(defun cider-string-trim-right (string)
"Remove trailing whitespace from STRING."
(if (string-match "[ \t\n\r]+\\'" string)
(replace-match "" t t string)
string))
(defun cider-string-trim (string)
"Remove leading and trailing whitespace from STRING."
(cider-string-trim-left (cider-string-trim-right string)))
(defun cider-string-join (strings &optional separator)
"Join all STRINGS using SEPARATOR."
(mapconcat #'identity strings separator))
(defun cider-join-into-alist (candidates &optional separator)
"Make an alist from CANDIDATES.
The keys are the elements joined with SEPARATOR and values are the original
elements. Useful for `completing-read' when candidates are complex
objects."
(mapcar (lambda (el)
(if (listp el)
(cons (cider-string-join el (or separator ":")) el)
(cons el el)))
candidates))
(defun cider-add-to-alist (symbol car cadr)
"Add '(CAR CADR) to the alist stored in SYMBOL.
If CAR already corresponds to an entry in the alist, destructively replace
the entry's second element with CADR.
This can be used, for instance, to update the version of an injected
plugin or dependency with:
(cider-add-to-alist 'cider-jack-in-lein-plugins
\"plugin/artifact-name\" \"THE-NEW-VERSION\")"
(let ((alist (symbol-value symbol)))
(if-let ((cons (assoc car alist)))
(setcdr cons (list cadr))
(set symbol (cons (list car cadr) alist)))))
(defun cider-namespace-qualified-p (sym)
"Return t if SYM is namespace-qualified."
(string-match-p "[^/]+/" sym))
(defvar cider-version)
(defconst cider-manual-url "http://cider.readthedocs.org/en/%s/"
"The URL to CIDER's manual.")
(defun cider--manual-version ()
"Convert the version to a ReadTheDocs-friendly version."
(if (string-match-p "-snapshot" cider-version)
"latest"
"stable"))
(defun cider-manual-url ()
"The CIDER manual's url."
(format cider-manual-url (cider--manual-version)))
;;;###autoload
(defun cider-view-manual ()
"View the manual in your default browser."
(interactive)
(browse-url (cider-manual-url)))
(defun cider--manual-button (label section-id)
"Return a button string that links to the online manual.
LABEL is the displayed string, and SECTION-ID is where it points
to."
(with-temp-buffer
(insert-text-button
label
'follow-link t
'action (lambda (&rest _) (interactive)
(browse-url (concat (cider-manual-url)
section-id))))
(buffer-string)))
(defconst cider-refcard-url "https://github.com/clojure-emacs/cider/raw/%s/doc/cider-refcard.pdf"
"The URL to CIDER's refcard.")
(defun cider--github-version ()
"Convert the version to a GitHub-friendly version."
(if (string-match-p "-snapshot" cider-version)
"master"
(concat "v" cider-version)))
(defun cider-refcard-url ()
"The CIDER manual's url."
(format cider-refcard-url (cider--github-version)))
(defun cider-view-refcard ()
"View the refcard in your default browser."
(interactive)
(browse-url (cider-refcard-url)))
(defconst cider-report-bug-url "https://github.com/clojure-emacs/cider/issues/new"
"The URL to report a CIDER issue.")
(defun cider-report-bug ()
"Report a bug in your default browser."
(interactive)
(browse-url cider-report-bug-url))
(defun cider--project-name (dir)
"Extracts a project name from DIR, possibly nil.
The project name is the final component of DIR if not nil."
(when dir
(file-name-nondirectory (directory-file-name dir))))
;;; Vectors
(defun cider--deep-vector-to-list (x)
"Convert vectors in X to lists.
If X is a sequence, return a list of `cider--deep-vector-to-list' applied to
each of its elements.
Any other value is just returned."
(if (sequencep x)
(mapcar #'cider--deep-vector-to-list x)
x))
;;; Help mode
;; Same as https://github.com/emacs-mirror/emacs/blob/86d083438dba60dc00e9e96414bf7e832720c05a/lisp/help-mode.el#L355
;; the original function uses some buffer local variables, but the buffer used
;; is not configurable. It defaults to (help-buffer)
(defun cider--help-setup-xref (item interactive-p buffer)
"Invoked from commands using the \"*Help*\" buffer to install some xref info.
ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help
buffer after following a reference. INTERACTIVE-P is non-nil if the
calling command was invoked interactively. In this case the stack of
items for help buffer \"back\" buttons is cleared. Use BUFFER for the
buffer local variables.
This should be called very early, before the output buffer is cleared,
because we want to record the \"previous\" position of point so we can
restore it properly when going back."
(with-current-buffer buffer
(when help-xref-stack-item
(push (cons (point) help-xref-stack-item) help-xref-stack)
(setq help-xref-forward-stack nil))
(when interactive-p
(let ((tail (nthcdr 10 help-xref-stack)))
;; Truncate the stack.
(if tail (setcdr tail nil))))
(setq help-xref-stack-item item)))
(defcustom cider-doc-xref-regexp "`\\(.*?\\)`"
"The regexp used to search Clojure vars in doc buffers."
:type 'regexp
:safe #'stringp
:group 'cider
:package-version '(cider . "0.13.0"))
(defun cider--find-symbol-xref ()
"Parse and return the first clojure symbol in current-buffer.
Use `cider-doc-xref-regexp' for the search. Set match data and return a
string of the Clojure symbol. Return nil if there are no more matches in
the buffer."
(when (re-search-forward cider-doc-xref-regexp nil t)
(match-string 1)))
(declare-function cider-doc-lookup "cider-doc")
(declare-function cider--eldoc-remove-dot "cider-eldoc")
;; Similar to https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L404
(defun cider--doc-make-xrefs ()
"Parse and hyperlink documentation cross-references in current-buffer.
Find cross-reference information in a buffer and activate such cross
references for selection with `help-xref'. Cross-references are parsed
using `cider--find-symbol-xref'.
Special references `back' and `forward' are made to go back and forth
through a stack of help buffers. Variables `help-back-label' and
`help-forward-label' specify the text for that."
(interactive "b")
;; parse the docstring and create xrefs for symbols
(save-excursion
(goto-char (point-min))
(let ((symbol))
(while (setq symbol (cider--find-symbol-xref))
(replace-match "")
(insert-text-button symbol
'type 'help-xref
'help-function (apply-partially #'cider-doc-lookup
(cider--eldoc-remove-dot symbol))))))
;; create back and forward buttons if appropiate
(insert "\n")
(when (or help-xref-stack help-xref-forward-stack)
(insert "\n"))
;; Make a back-reference in this buffer if appropriate.
(when help-xref-stack
(help-insert-xref-button help-back-label 'help-back
(current-buffer)))
;; Make a forward-reference in this buffer if appropriate.
(when help-xref-forward-stack
(when help-xref-stack
(insert "\t"))
(help-insert-xref-button help-forward-label 'help-forward
(current-buffer)))
(when (or help-xref-stack help-xref-forward-stack)
(insert "\n")))
;;; Words of inspiration
(defun cider-user-first-name ()
"Find the current user's first name."
(let ((name (if (string= (user-full-name) "")
(user-login-name)
(user-full-name))))
(string-match "^[^ ]*" name)
(capitalize (match-string 0 name))))
(defvar cider-words-of-inspiration
`("The best way to predict the future is to invent it. -Alan Kay"
"A point of view is worth 80 IQ points. -Alan Kay"
"Lisp isn't a language, it's a building material. -Alan Kay"
"Simple things should be simple, complex things should be possible. -Alan Kay"
"Everything should be as simple as possible, but not simpler. -Albert Einstein"
"Measuring programming progress by lines of code is like measuring aircraft building progress by weight. -Bill Gates"
"Controlling complexity is the essence of computer programming. -Brian Kernighan"
"The unavoidable price of reliability is simplicity. -C.A.R. Hoare"
"You're bound to be unhappy if you optimize everything. -Donald Knuth"
"Simplicity is prerequisite for reliability. -Edsger W. Dijkstra"
"Elegance is not a dispensable luxury but a quality that decides between success and failure. -Edsger W. Dijkstra"
"Deleted code is debugged code. -Jeff Sickel"
"The key to performance is elegance, not battalions of special cases. -Jon Bentley and Doug McIlroy"
"First, solve the problem. Then, write the code. -John Johnson"
"Simplicity is the ultimate sophistication. -Leonardo da Vinci"
"Programming is not about typing... it's about thinking. -Rich Hickey"
"Design is about pulling things apart. -Rich Hickey"
"Programmers know the benefits of everything and the tradeoffs of nothing. -Rich Hickey"
"Code never lies, comments sometimes do. -Ron Jeffries"
"The true delight is in the finding out rather than in the knowing. -Isaac Asimov"
"If paredit is not for you, then you need to become the sort of person that paredit is for. -Phil Hagelberg"
"Express Yourself. -Madonna"
"Put on your red shoes and dance the blues. -David Bowie"
"Do. Or do not. There is no try. -Yoda"
"The enjoyment of one's tools is an essential ingredient of successful work. -Donald E. Knuth"
"Not all those who wander are lost. -J.R.R. Tolkien"
"The best way to learn is to do. -P.R. Halmos"
"If you wish to make an apple pie from scratch, you must first invent the universe. -Carl Sagan"
"Learn the rules like a pro, so you can break them like an artist. -Pablo Picasso"
"The only way of discovering the limits of the possible is to venture a little way past them into the impossible. -Arthur C. Clarke"
"Don't wish it were easier. Wish you were better. -Jim Rohn"
"One chord is fine. Two chords is pushing it. Three chords and you're into jazz. -Lou Reed"
"We are all apprentices in a craft where no one ever becomes a master. -Ernest Hemingway"
"Clojure isn't a language, it's a building material."
"Think big!"
"Think bold!"
"Think fun!"
"Code big!"
"Code bold!"
"Code fun!"
"Take this REPL, fellow hacker, and may it serve you well."
"Let the hacking commence!"
"Hacks and glory await!"
"Hack and be merry!"
"Your hacking starts... NOW!"
"May the Source be with you!"
"May the Source shine upon thy REPL!"
"Code long and prosper!"
"Happy hacking!"
"nREPL server is up, CIDER REPL is online!"
"CIDER REPL operational!"
"Your imagination is the only limit to what you can do with this REPL!"
"This REPL is yours to command!"
"Fame is but a hack away!"
"The REPL is not enough, but it is such a perfect place to start..."
"Keep on codin' in the free world!"
"What we do in the REPL echoes in eternity!"
"Evaluating is believing."
"To infinity... and beyond."
"Showtime!"
"Unfortunately, no one can be told what CIDER is. You have to figure this out yourself."
"Procure a bottle of cider to achieve optimum programming results."
"In parentheses we trust!"
"Write you some Clojure for Great Good!"
"Oh, what a day... what a lovely day!"
"What a day! What cannot be accomplished on such a splendid day!"
"Home is where your REPL is."
,(format "%s, I've a feeling we're not in Kansas anymore."
(cider-user-first-name))
,(format "%s, this could be the start of a beautiful program."
(cider-user-first-name)))
"Scientifically-proven optimal words of hackerish encouragement.")
(defun cider-random-words-of-inspiration ()
"Select a random entry from `cider-words-of-inspiration'."
(eval (nth (random (length cider-words-of-inspiration))
cider-words-of-inspiration)))
(defvar cider-tips
'("Press <\\[cider-connect]> to connect to a running nREPL server."
"Press <\\[cider-quit]> to quit the current connection."
"Press <\\[cider-view-manual]> to view CIDER's manual."
"Press <\\[cider-view-refcard]> to view CIDER's refcard."
"Press <\\[describe-mode]> to see a list of the keybindings available (this will work in every Emacs buffer)."
"Press <\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command."
"Press <\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure source buffer."
"Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a Java method)."
"Press <\\[cider-doc]> to view the documentation for something (e.g. a var, a Java method)."
"Press <\\[cider-find-resource]> to find a resource on the classpath."
"Press <\\[cider-selector]> to quickly select a CIDER buffer."
"Press <\\[cider-test-run-ns-tests]> to run the tests for the current namespace."
"Press <\\[cider-test-run-loaded-tests]> to run all loaded tests."
"Press <\\[cider-test-run-project-tests]> to run all tests for the current project."
"Press <\\[cider-apropos]> to look for a symbol by some search string."
"Press <\\[cider-apropos-documentation]> to look for a symbol that has some string in its docstring."
"Press <\\[cider-eval-defun-at-point]> to eval the top-level form at point."
"Press <\\[cider-eval-buffer]> to eval the entire source buffer."
"Press <\\[cider-scratch]> to create a Clojure scratchpad. Pretty handy for prototyping."
"Press <\\[cider-read-and-eval]> to evaluate some Clojure expression directly in the minibuffer."
"Press <\\[cider-drink-a-sip]> to get more CIDER tips."
"Press <\\[cider-browse-ns-all]> to start CIDER's namespace browser."
"Press <\\[cider-classpath]> to start CIDER's classpath browser."
"Press <\\[cider-macroexpand-1]> to expand the preceding macro."
"Press <\\[cider-inspect]> to inspect the preceding expression's result."
"Press <C-u \\[cider-inspect]> to inspect the defun at point's result."
"Press <C-u C-u \\[cider-inspect]> to read Clojure code from the minibuffer and inspect its result."
"Press <\\[cider-refresh]> to reload modified and unloaded namespaces."
"You can define Clojure functions to be called before and after `cider-refresh' (see `cider-refresh-before-fn' and `cider-refresh-after-fn'."
"Press <\\[cider-display-connection-info]> to view information about the connection."
"Press <\\[cider-undef]> to undefine a symbol in the current namespace."
"Press <\\[cider-interrupt]> to interrupt an ongoing evaluation."
"Use <M-x customize-group RET cider RET> to see every possible setting you can customize."
"Use <M-x customize-group RET cider-repl RET> to see every possible REPL setting you can customize."
"Enable `eldoc-mode' to display function & method signatures in the minibuffer."
"Enable `cider-enlighten-mode' to display the locals of a function when it's executed."
"Use <\\[cider-close-ancillary-buffers]> to close all ancillary buffers created by CIDER (e.g. *cider-doc*)."
"Exploring CIDER's menu-bar entries is a great way to discover features."
"Keep in mind that some commands don't have a keybinding by default. Explore CIDER!"
"Tweak `cider-repl-prompt-function' to customize your REPL prompt."
"Tweak `cider-eldoc-ns-function' to customize the way namespaces are displayed by eldoc.")
"Some handy CIDER tips."
)
(defun cider-random-tip ()
"Select a random tip from `cider-tips'."
(substitute-command-keys (nth (random (length cider-tips)) cider-tips)))
(defun cider-drink-a-sip ()
"Show a random tip."
(interactive)
(message (cider-random-tip)))
(defun cider-column-number-at-pos (pos)
"Analog to `line-number-at-pos'.
Return buffer column number at position POS."
(save-excursion (goto-char pos) (current-column)))
(defun cider-propertize (text kind)
"Propertize TEXT as KIND.
KIND can be the symbols `ns', `var', `emph', `fn', or a face name."
(propertize text 'face (pcase kind
(`fn 'font-lock-function-name-face)
(`var 'font-lock-variable-name-face)
(`ns 'font-lock-type-face)
(`emph 'font-lock-keyword-face)
(face face))))
(defun cider--menu-add-help-strings (menu-list)
"Add a :help entries to items in MENU-LIST."
(mapcar (lambda (x)
(cond
((listp x) (cider--menu-add-help-strings x))
((and (vectorp x)
(not (plist-get (append x nil) :help))
(functionp (elt x 1)))
(vconcat x `[:help ,(documentation (elt x 1))]))
(t x)))
menu-list))
(provide 'cider-util)
;;; cider-util.el ends here

790
elpa/cider-20160927.2135/cider.el
View File

@ -1,790 +0,0 @@
;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*-
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Artur Malabarba <bruce.connor.am@gmail.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;; Maintainer: Bozhidar Batsov <bozhidar@batsov.com>
;; URL: http://www.github.com/clojure-emacs/cider
;; Version: 0.14.0-cvs
;; Package-Requires: ((emacs "24.3") (clojure-mode "5.5.2") (pkg-info "0.4") (queue "0.1.1") (spinner "1.7") (seq "2.16"))
;; Keywords: languages, clojure, cider
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Provides a Clojure interactive development environment for Emacs, built on
;; top of nREPL.
;;; Installation:
;; Available as a package in melpa.org and stable.melpa.org
;; (add-to-list 'package-archives
;; '("melpa" . "https://melpa.org/packages/"))
;;
;; or
;;
;; (add-to-list 'package-archives
;; '("melpa-stable" . "https://stable.melpa.org/packages/") t)
;;
;; M-x package-install cider
;;; Usage:
;; M-x cider-jack-in
;;; Code:
(defgroup cider nil
"Clojure Interactive Development Environment that Rocks."
:prefix "cider-"
:group 'applications
:link '(url-link :tag "Github" "https://github.com/clojure-emacs/cider")
:link '(url-link :tag "Online Manual" "https://cider.readthedocs.org")
:link '(emacs-commentary-link :tag "Commentary" "cider"))
(defcustom cider-prompt-for-project-on-connect 'when-needed
"Controls whether to prompt for associated project on `cider-connect'.
When set to when-needed, the project will be derived from the buffer you're
visiting, when invoking `cider-connect'.
When set to t, you'll always to prompted to select the matching project.
When set to nil, you'll never be prompted to select a project and no
project inference will take place."
:type '(choice (const :tag "always" t)
(const when-needed)
(const :tag "never" nil))
:group 'cider
:package-version '(cider . "0.10.0"))
(require 'cider-client)
(require 'cider-eldoc)
(require 'cider-repl)
(require 'cider-mode)
(require 'cider-common)
(require 'cider-compat)
(require 'cider-debug)
(require 'tramp-sh)
(require 'seq)
(defconst cider-version "0.14.0-snapshot"
"Fallback version used when it cannot be extracted automatically.
Normally it won't be used, unless `pkg-info' fails to extract the
version from the CIDER package or library.")
(defconst cider-codename "Berlin"
"Codename used to denote stable releases.")
(defcustom cider-lein-command
"lein"
"The command used to execute Leiningen."
:type 'string
:group 'cider)
(defcustom cider-lein-parameters
"repl :headless"
"Params passed to Leiningen to start an nREPL server via `cider-jack-in'."
:type 'string
:group 'cider)
(defcustom cider-boot-command
"boot"
"The command used to execute Boot."
:type 'string
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-boot-parameters
"repl -s wait"
"Params passed to boot to start an nREPL server via `cider-jack-in'."
:type 'string
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-gradle-command
"gradle"
"The command used to execute Gradle."
:type 'string
:group 'cider
:package-version '(cider . "0.10.0"))
(defcustom cider-gradle-parameters
"--no-daemon clojureRepl"
"Params passed to gradle to start an nREPL server via `cider-jack-in'."
:type 'string
:group 'cider
:package-version '(cider . "0.10.0"))
(defcustom cider-default-repl-command
"lein"
"The default command and parameters to use when connecting to nREPL.
This value will only be consulted when no identifying file types, i.e.
project.clj for leiningen or build.boot for boot, could be found."
:type 'string
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-preferred-build-tool
nil
"Allow choosing a build system when there are many.
When there are artifacts from multiple build systems (\"lein\", \"boot\",
\"gradle\") the user is prompted to select one of them. When non-nil, this
variable will suppress this behavior and will select whatever build system
is indicated by the variable if present. Note, this is only when CIDER
cannot decide which of many build systems to use and will never override a
command when there is no ambiguity."
:type '(choice (const "lein")
(const "boot")
(const "gradle")
(const :tag "Always ask" nil))
:group 'cider
:package-version '(cider . "0.13.0"))
(defcustom cider-known-endpoints nil
"A list of connection endpoints where each endpoint is a list.
For example: \\='((\"label\" \"host\" \"port\")).
The label is optional so that \\='(\"host\" \"port\") will suffice.
This variable is used by `cider-connect'."
:type '(repeat (list (string :tag "label")
(string :tag "host")
(string :tag "port")))
:group 'cider)
(defcustom cider-connected-hook nil
"List of functions to call when connected to Clojure nREPL server."
:type 'hook
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-disconnected-hook nil
"List of functions to call when disconnected from the Clojure nREPL server."
:type 'hook
:group 'cider
:package-version '(cider . "0.9.0"))
(defcustom cider-auto-mode t
"When non-nil, automatically enable `cider-mode' for all Clojure buffers."
:type 'boolean
:package-version '(cider . "0.9.0"))
(defcustom cider-inject-dependencies-at-jack-in t
"When nil, do not inject repl dependencies (most likely nREPL middlewares) at `cider-jack-in' time."
:type 'boolean
:version '(cider . "0.11.0"))
(defvar cider-ps-running-nrepls-command "ps u | grep leiningen"
"Process snapshot command used in `cider-locate-running-nrepl-ports'.")
(defvar cider-ps-running-nrepl-path-regexp-list
'("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D"
"\\(?:-classpath +:?\\(.+?\\)/self-installs\\)")
"Regexp list to get project paths.
Extract project paths from output of `cider-ps-running-nrepls-command'.
Sub-match 1 must be the project path.")
(defvar cider-host-history nil
"Completion history for connection hosts.")
;;;###autoload
(defun cider-version ()
"Display CIDER's version."
(interactive)
(message "CIDER %s" (cider--version)))
(defun cider-jack-in-command (project-type)
"Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE."
(pcase project-type
("lein" cider-lein-command)
("boot" cider-boot-command)
("gradle" cider-gradle-command)
(_ (user-error "Unsupported project type `%s'" project-type))))
(defun cider-jack-in-resolve-command (project-type)
"Determine the resolved file path to `cider-jack-in-command' if it can be
found for the PROJECT-TYPE"
(pcase project-type
("lein" (cider--lein-resolve-command))
("boot" (cider--boot-resolve-command))
("gradle" (cider--gradle-resolve-command))
(_ (user-error "Unsupported project type `%s'" project-type))))
(defun cider-jack-in-params (project-type)
"Determine the commands params for `cider-jack-in' for the PROJECT-TYPE."
(pcase project-type
("lein" cider-lein-parameters)
("boot" cider-boot-parameters)
("gradle" cider-gradle-parameters)
(_ (user-error "Unsupported project type `%s'" project-type))))
;;; Jack-in dependencies injection
(defvar cider-jack-in-dependencies nil
"List of dependencies where elements are lists of artifact name and version.")
(put 'cider-jack-in-dependencies 'risky-local-variable t)
(cider-add-to-alist 'cider-jack-in-dependencies
"org.clojure/tools.nrepl" "0.2.12")
(defvar cider-jack-in-dependencies-exclusions nil
"List of exclusions for jack in dependencies.
Elements of the list are artifact name and list of exclusions to apply for the artifact.")
(put 'cider-jack-in-dependencies-exclusions 'risky-local-variable t)
(cider-add-to-alist 'cider-jack-in-dependencies-exclusions
"org.clojure/tools.nrepl" '("org.clojure/clojure"))
(defcustom cider-jack-in-auto-inject-clojure nil
"Version of clojure to auto-inject into REPL.
If nil, do not inject clojure into the REPL. If `latest', inject
`cider-latest-clojure-version', which should approximate to the most recent
version of clojure. If `minimal', inject `cider-minimum-clojure-version',
which will be the lowest version cider supports. If a string, use this as
the version number. If it is a list, the first element should be a string,
specifying the artifact ID, and the second element the version number."
:type '(choice (const :tag "None" nil)
(const :tag "Latest" 'latest)
(const :tag "Minimal" 'minimal)
(string :tag "Specific Version")
(list :tag "Artifact ID and Version"
(string :tag "Artifact ID")
(string :tag "Version"))))
(defvar cider-jack-in-lein-plugins nil
"List of Leiningen plugins where elements are lists of artifact name and version.")
(put 'cider-jack-in-lein-plugins 'risky-local-variable t)
(cider-add-to-alist 'cider-jack-in-lein-plugins
"cider/cider-nrepl" (upcase cider-version))
(defvar cider-jack-in-nrepl-middlewares nil
"List of Clojure variable names.
Each of these Clojure variables should hold a vector of nREPL middlewares.")
(put 'cider-jack-in-nrepl-middlewares 'risky-local-variable t)
(add-to-list 'cider-jack-in-nrepl-middlewares "cider.nrepl/cider-middleware")
(defun cider--list-as-boot-artifact (list)
"Return a boot artifact string described by the elements of LIST.
LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). The returned
string is quoted for passing as argument to an inferior shell."
(concat "-d " (shell-quote-argument (format "%s:%s" (car list) (cadr list)))))
(defun cider-boot-command-prefix (dependencies)
"Return a list of boot artifact strings created from DEPENDENCIES."
(concat (mapconcat #'cider--list-as-boot-artifact dependencies " ")
" "))
(defun cider-boot-repl-task-params (params middlewares)
(if (string-match "\\_<repl\\_>" params)
(replace-match (concat "repl "
(mapconcat (lambda (middleware)
(format "-m %s" (shell-quote-argument middleware)))
middlewares
" "))
'fixed 'literal params)
(message "Warning: `cider-boot-parameters' doesn't call the \"repl\" task, jacking-in might not work")
params))
(defun cider-boot-jack-in-dependencies (params dependencies plugins middlewares)
(concat (cider-boot-command-prefix (append dependencies plugins))
(cider-boot-repl-task-params params middlewares)))
(defun cider--lein-artifact-exclusions (exclusions)
"Return an exclusions vector described by the elements of EXCLUSIONS."
(if exclusions
(format " :exclusions [%s]" (mapconcat #'identity exclusions " "))
""))
(defun cider--list-as-lein-artifact (list &optional exclusions)
"Return an artifact string described by the elements of LIST.
LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). Optionally a list
of EXCLUSIONS can be provided as well. The returned
string is quoted for passing as argument to an inferior shell."
(shell-quote-argument (format "[%s %S%s]" (car list) (cadr list) (cider--lein-artifact-exclusions exclusions))))
(defun cider-lein-jack-in-dependencies (params dependencies dependencies-exclusions lein-plugins)
(concat
(mapconcat #'identity
(append (seq-map (lambda (dep)
(let ((exclusions (cadr (assoc (car dep) dependencies-exclusions))))
(concat "update-in :dependencies conj "
(cider--list-as-lein-artifact dep exclusions))))
dependencies)
(seq-map (lambda (plugin)
(concat "update-in :plugins conj "
(cider--list-as-lein-artifact plugin)))
lein-plugins))
" -- ")
" -- "
params))
(defun cider-add-clojure-dependencies-maybe (dependencies)
"Return DEPENDENCIES with an added Clojure dependency if requested.
See also `cider-jack-in-auto-inject-clojure'."
(if cider-jack-in-auto-inject-clojure
(if (consp cider-jack-in-auto-inject-clojure)
(cons cider-jack-in-auto-inject-clojure dependencies)
(cons (list cider-clojure-artifact-id
(cond
((stringp cider-jack-in-auto-inject-clojure)
cider-jack-in-auto-inject-clojure)
((eq cider-jack-in-auto-inject-clojure 'minimal)
cider-minimum-clojure-version)
((eq cider-jack-in-auto-inject-clojure 'latest)
cider-latest-clojure-version)))
dependencies))
dependencies))
(defun cider-inject-jack-in-dependencies (params project-type)
"Return PARAMS with injected REPL dependencies.
These are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' and
`cider-jack-in-nrepl-middlewares' are injected from the CLI according to
the used PROJECT-TYPE. Eliminates the need for hacking profiles.clj or the
boot script for supporting cider with its nREPL middleware and
dependencies."
(pcase project-type
("lein" (cider-lein-jack-in-dependencies
params
(cider-add-clojure-dependencies-maybe
cider-jack-in-dependencies)
cider-jack-in-dependencies-exclusions
cider-jack-in-lein-plugins))
("boot" (cider-boot-jack-in-dependencies
params
(cider-add-clojure-dependencies-maybe
cider-jack-in-dependencies)
cider-jack-in-lein-plugins
cider-jack-in-nrepl-middlewares))
("gradle" params)
(_ (error "Unsupported project type `%s'" project-type))))
;;; ClojureScript REPL creation
(defconst cider--cljs-repl-types
'(("(cemerick.piggieback/cljs-repl (cljs.repl.rhino/repl-env))"
"Rhino" "")
("(do (require 'figwheel-sidecar.repl-api) (figwheel-sidecar.repl-api/start-figwheel!) (figwheel-sidecar.repl-api/cljs-repl))"
"Figwheel-sidecar" " (add figwheel-sidecar to your plugins)")
("(do (require 'cljs.repl.node) (cemerick.piggieback/cljs-repl (cljs.repl.node/repl-env)))"
"Node" " (requires NodeJS to be installed)")
("(do (require 'weasel.repl.websocket) (cemerick.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \"127.0.0.1\" :port 9001)))"
"Weasel" " (see Readme for additional configuration)")))
(defcustom cider-cljs-lein-repl "(cemerick.piggieback/cljs-repl (cljs.repl.rhino/repl-env))"
"Clojure form that returns a ClojureScript REPL environment.
This is only used in lein projects. It is evaluated in a Clojure REPL and
it should start a ClojureScript REPL."
:type `(choice ,@(seq-map (lambda (x) `(const :tag ,(apply #'concat (cdr x)) ,(car x)))
cider--cljs-repl-types)
(string :tag "Custom"))
:safe (lambda (x) (assoc x cider--cljs-repl-types))
:group 'cider)
(defun cider--offer-to-open-app-in-browser (server-buffer)
"Look for a server address in SERVER-BUFFER and offer to open it."
(when (buffer-live-p server-buffer)
(with-current-buffer server-buffer
(save-excursion
(goto-char (point-min))
(when-let ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror)
(match-string 0))))
(when (y-or-n-p (format "Visit ‘%s’ in a browser? " url))
(browse-url url)))))))
(defun cider-create-sibling-cljs-repl (client-buffer)
"Create a ClojureScript REPL with the same server as CLIENT-BUFFER.
The new buffer will correspond to the same project as CLIENT-BUFFER, which
should be the regular Clojure REPL started by the server process filter."
(interactive (list (cider-current-connection)))
(let* ((nrepl-repl-buffer-name-template "*cider-repl CLJS%s*")
(nrepl-create-client-buffer-function #'cider-repl-create)
(nrepl-use-this-as-repl-buffer 'new)
(client-process-args (with-current-buffer client-buffer
(unless (or nrepl-server-buffer nrepl-endpoint)
(error "This is not a REPL buffer, is there a REPL active?"))
(list (car nrepl-endpoint)
(elt nrepl-endpoint 1)
(when (buffer-live-p nrepl-server-buffer)
(get-buffer-process nrepl-server-buffer)))))
(cljs-proc (apply #'nrepl-start-client-process client-process-args))
(cljs-buffer (process-buffer cljs-proc)))
(with-current-buffer cljs-buffer
;; The new connection has now been bumped to the top, but it's still a
;; Clojure REPL! Additionally, some ClojureScript REPLs can actually take
;; a while to start (some even depend on the user opening a browser).
;; Meanwhile, this REPL will gladly receive requests in place of the
;; original Clojure REPL. Our solution is to bump the original REPL back
;; up the list, so it takes priority on Clojure requests.
(cider-make-connection-default client-buffer)
(pcase (assoc cider-cljs-lein-repl cider--cljs-repl-types)
(`(,_ ,name ,info)
(message "Starting a %s REPL%s" name (or info "")))
(_ (message "Starting a custom ClojureScript REPL")))
(cider-nrepl-send-request
(list "op" "eval"
"ns" (cider-current-ns)
"session" nrepl-session
"code" cider-cljs-lein-repl)
(cider-repl-handler (current-buffer)))
(cider--offer-to-open-app-in-browser nrepl-server-buffer))))
(defun cider--select-zombie-buffer (repl-buffers)
"Return a zombie buffer from REPL-BUFFERS, or nil if none exists."
(when-let ((zombie-buffs (seq-remove #'get-buffer-process repl-buffers)))
(when (y-or-n-p
(format "Zombie REPL buffers exist (%s). Reuse? "
(mapconcat #'buffer-name zombie-buffs ", ")))
(if (= (length zombie-buffs) 1)
(car zombie-buffs)
(completing-read "Choose REPL buffer: "
(mapcar #'buffer-name zombie-buffs)
nil t)))))
(defun cider-find-reusable-repl-buffer (endpoint project-directory)
"Check whether a reusable connection buffer already exists.
Looks for buffers where `nrepl-endpoint' matches ENDPOINT, or
`nrepl-project-dir' matches PROJECT-DIRECTORY. If such a buffer was found,
and has no process, return it. If the process is alive, ask the user for
confirmation and return 'new/nil for y/n answer respectively. If other
REPL buffers with dead process exist, ask the user if any of those should
be reused."
(if-let ((repl-buffers (cider-repl-buffers))
(exact-buff (seq-find
(lambda (buff)
(with-current-buffer buff
(or (and endpoint
(equal endpoint nrepl-endpoint))
(and project-directory
(equal project-directory nrepl-project-dir)))))
repl-buffers)))
(if (get-buffer-process exact-buff)
(when (y-or-n-p (format "REPL buffer already exists (%s). \
Do you really want to create a new one? "
exact-buff))
'new)
exact-buff)
(or (cider--select-zombie-buffer repl-buffers) 'new)))
;;;###autoload
(defun cider-jack-in (&optional prompt-project cljs-too)
"Start an nREPL server for the current project and connect to it.
If PROMPT-PROJECT is t, then prompt for the project for which to
start the server.
If CLJS-TOO is non-nil, also start a ClojureScript REPL session with its
own buffer."
(interactive "P")
(setq cider-current-clojure-buffer (current-buffer))
(let* ((project-type (cider-project-type))
(command (cider-jack-in-command project-type))
(command-resolved (cider-jack-in-resolve-command project-type))
(command-params (cider-jack-in-params project-type)))
(if command-resolved
(let* ((project (when prompt-project
(read-directory-name "Project: ")))
(project-dir (clojure-project-dir
(or project (cider-current-dir))))
(params (if prompt-project
(read-string (format "nREPL server command: %s "
command-params)
command-params)
command-params))
(params (if cider-inject-dependencies-at-jack-in
(cider-inject-jack-in-dependencies params project-type)
params))
(cmd (format "%s %s" command-resolved params)))
(when-let ((repl-buff (cider-find-reusable-repl-buffer nil project-dir)))
(let ((nrepl-create-client-buffer-function #'cider-repl-create)
(nrepl-use-this-as-repl-buffer repl-buff))
(nrepl-start-server-process
project-dir cmd
(when cljs-too #'cider-create-sibling-cljs-repl)))))
(user-error "The %s executable isn't on your `exec-path'" command))))
;;;###autoload
(defun cider-jack-in-clojurescript (&optional prompt-project)
"Start an nREPL server and connect to it both Clojure and ClojureScript REPLs.
If PROMPT-PROJECT is t, then prompt for the project for which to
start the server."
(interactive "P")
(cider-jack-in prompt-project 'cljs-too))
;;;###autoload
(defun cider-connect (host port &optional project-dir)
"Connect to an nREPL server identified by HOST and PORT.
Create REPL buffer and start an nREPL client connection.
When the optional param PROJECT-DIR is present, the connection
gets associated with it."
(interactive (cider-select-endpoint))
(setq cider-current-clojure-buffer (current-buffer))
(when-let ((repl-buff (cider-find-reusable-repl-buffer `(,host ,port) nil)))
(let* ((nrepl-create-client-buffer-function #'cider-repl-create)
(nrepl-use-this-as-repl-buffer repl-buff)
(conn (process-buffer (nrepl-start-client-process host port))))
(if project-dir
(cider-assoc-project-with-connection project-dir conn)
(let ((project-dir (clojure-project-dir)))
(cond
;; associate only if we're in a project
((and project-dir (null cider-prompt-for-project-on-connect)) (cider-assoc-project-with-connection project-dir conn))
;; associate if we're in a project, prompt otherwise
((eq cider-prompt-for-project-on-connect 'when-needed) (cider-assoc-project-with-connection project-dir conn))
;; always prompt
(t (cider-assoc-project-with-connection nil conn))))))))
(defun cider-current-host ()
"Retrieve the current host."
(if (and (stringp buffer-file-name)
(file-remote-p buffer-file-name))
tramp-current-host
"localhost"))
(defun cider-select-endpoint ()
"Interactively select the host and port to connect to."
(dolist (endpoint cider-known-endpoints)
(unless (stringp (or (nth 2 endpoint)
(nth 1 endpoint)))
(user-error "The port for %s in `cider-known-endpoints' should be a string"
(nth 0 endpoint))))
(let* ((ssh-hosts (cider--ssh-hosts))
(hosts (seq-uniq (append (when cider-host-history
;; history elements are strings of the form "host:port"
(list (split-string (car cider-host-history) ":")))
(list (list (cider-current-host)))
cider-known-endpoints
ssh-hosts
(when (file-remote-p default-directory)
;; add localhost even in remote buffers
'(("localhost"))))))
(sel-host (cider--completing-read-host hosts))
(host (car sel-host))
(port (or (cadr sel-host)
(cider--completing-read-port host (cider--infer-ports host ssh-hosts)))))
(list host port)))
(defun cider--ssh-hosts ()
"Retrieve all ssh host from local configuration files."
(seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s)))
(let ((tramp-completion-mode t))
(tramp-completion-handle-file-name-all-completions "" "/ssh:"))))
(defun cider--completing-read-host (hosts)
"Interactively select host from HOSTS.
Each element in HOSTS is one of: (host), (host port) or (label host port).
Return a list of the form (HOST PORT), where PORT can be nil."
(let* ((hosts (cider-join-into-alist hosts))
(sel-host (completing-read "Host: " hosts nil nil nil
'cider-host-history (caar hosts)))
(host (or (cdr (assoc sel-host hosts)) (list sel-host))))
;; remove the label
(if (= 3 (length host)) (cdr host) host)))
(defun cider--infer-ports (host ssh-hosts)
"Infer nREPL ports on HOST.
Return a list of elements of the form (directory port). SSH-HOSTS is a list
of remote SSH hosts."
(let ((localp (or (nrepl-local-host-p host)
(not (assoc-string host ssh-hosts)))))
(if localp
;; change dir: current file might be remote
(let* ((change-dir-p (file-remote-p default-directory))
(default-directory (if change-dir-p "~/" default-directory)))
(cider-locate-running-nrepl-ports (unless change-dir-p default-directory)))
(let ((vec (vector "sshx" nil host "" nil))
;; change dir: user might want to connect to a different remote
(dir (when (file-remote-p default-directory)
(with-parsed-tramp-file-name default-directory cur
(when (string= cur-host host) default-directory)))))
(tramp-maybe-open-connection vec)
(with-current-buffer (tramp-get-connection-buffer vec)
(cider-locate-running-nrepl-ports dir))))))
(defun cider--completing-read-port (host ports)
"Interactively select port for HOST from PORTS."
(let* ((ports (cider-join-into-alist ports))
(sel-port (completing-read (format "Port for %s: " host) ports
nil nil nil nil (caar ports)))
(port (or (cdr (assoc sel-port ports)) sel-port))
(port (if (listp port) (cadr port) port)))
(if (stringp port) (string-to-number port) port)))
(defun cider-locate-running-nrepl-ports (&optional dir)
"Locate ports of running nREPL servers.
When DIR is non-nil also look for nREPL port files in DIR. Return a list
of list of the form (project-dir port)."
(let* ((paths (cider--running-nrepl-paths))
(proj-ports (mapcar (lambda (d)
(when-let ((port (and d (nrepl-extract-port (cider--file-path d)))))
(list (file-name-nondirectory (directory-file-name d)) port)))
(cons (clojure-project-dir dir) paths))))
(seq-uniq (delq nil proj-ports))))
(defun cider--running-nrepl-paths ()
"Retrieve project paths of running nREPL servers.
Use `cider-ps-running-nrepls-command' and `cider-ps-running-nrepl-path-regexp-list'."
(let (paths)
(with-temp-buffer
(insert (shell-command-to-string cider-ps-running-nrepls-command))
(dolist (regexp cider-ps-running-nrepl-path-regexp-list)
(goto-char 1)
(while (re-search-forward regexp nil t)
(setq paths (cons (match-string 1) paths)))))
(seq-uniq paths)))
(defun cider--identify-buildtools-present ()
"Identify build systems present by their build files."
(let* ((default-directory (clojure-project-dir (cider-current-dir)))
(build-files '(("lein" . "project.clj")
("boot" . "build.boot")
("gradle" . "build.gradle"))))
(delq nil
(mapcar (lambda (candidate)
(when (file-exists-p (cdr candidate))
(car candidate)))
build-files))))
(defun cider-project-type ()
"Determine the type, either leiningen, boot or gradle, of the current project.
If more than one project file types are present, check for a preferred
build tool in `cider-preferred-build-tool`, otherwise prompt the user to
choose."
(let* ((choices (cider--identify-buildtools-present))
(multiple-project-choices (> (length choices) 1))
(default (car choices)))
(cond ((and multiple-project-choices
(member cider-preferred-build-tool choices))
cider-preferred-build-tool)
(multiple-project-choices
(completing-read (format "Which command should be used (default %s): " default)
choices nil t nil nil default))
(choices
(car choices))
(t cider-default-repl-command))))
;; TODO: Implement a check for `cider-lein-command' over tramp
(defun cider--lein-resolve-command ()
"Find `cider-lein-command' on `exec-path' if possible, or return `nil'.
In case `default-directory' is non-local we assume the command is available."
(when-let ((command (or (file-remote-p default-directory)
(executable-find cider-lein-command)
(executable-find (concat cider-lein-command ".bat")))))
(shell-quote-argument command)))
(defun cider--boot-resolve-command ()
"Find `cider-boot-command' on `exec-path' if possible, or return `nil'.
In case `default-directory' is non-local we assume the command is available."
(when-let ((command (or (file-remote-p default-directory)
(executable-find cider-boot-command)
(executable-find (concat cider-boot-command ".exe")))))
(shell-quote-argument command)))
(defun cider--gradle-resolve-command ()
"Find `cider-gradle-command' on `exec-path' if possible, or return `nil'.
In case `default-directory' is non-local we assume the command is available."
(when-let ((command (or (file-remote-p default-directory)
(executable-find cider-gradle-command)
(executable-find (concat cider-gradle-command ".exe")))))
(shell-quote-argument command)))
;;; Check that the connection is working well
;; TODO: This is nrepl specific. It should eventually go into some cider-nrepl-client
;; file.
(defun cider--check-required-nrepl-version ()
"Check whether we're using a compatible nREPL version."
(if-let ((nrepl-version (cider--nrepl-version)))
(when (version< nrepl-version cider-required-nrepl-version)
(cider-repl-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212"
"CIDER requires nREPL %s (or newer) to work properly"
cider-required-nrepl-version))
(cider-repl-manual-warning "troubleshooting/#warning-saying-you-have-to-use-nrepl-0212"
"Can't determine nREPL's version.\nPlease, update nREPL to %s."
cider-required-nrepl-version)))
(defun cider--check-clojure-version-supported ()
"Ensure that we are meeting the minimum supported version of Clojure."
(if-let ((clojure-version (cider--clojure-version)))
(when (version< clojure-version cider-minimum-clojure-version)
(cider-repl-manual-warning "installation/#prerequisites"
"Clojure version (%s) is not supported (minimum %s). CIDER will not work."
clojure-version cider-minimum-clojure-version))
(cider-repl-manual-warning "installation/#prerequisites"
"Clojure version information could not be determined. Requires a minimum version %s."
cider-minimum-clojure-version)))
(defun cider--check-middleware-compatibility ()
"CIDER frontend/backend compatibility check.
Retrieve the underlying connection's CIDER-nREPL version and checks if the
middleware used is compatible with CIDER. If not, will display a warning
message in the REPL area."
(let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-connection)))
(middleware-version (nrepl-dict-get version-dict "version-string" "not installed")))
(unless (equal cider-version middleware-version)
(cider-repl-manual-warning "troubleshooting/#cider-complains-of-the-cider-nrepl-version"
"CIDER's version (%s) does not match cider-nrepl's version (%s). Things will break!"
cider-version middleware-version))))
(defun cider--subscribe-repl-to-server-out ()
"Subscribe to the server's *out*."
(cider-nrepl-send-request '("op" "out-subscribe")
(cider-interactive-eval-handler (current-buffer))))
(defun cider--connected-handler ()
"Handle cider initialization after nREPL connection has been established.
This function is appended to `nrepl-connected-hook' in the client process
buffer."
;; `nrepl-connected-hook' is run in connection buffer
(cider-make-connection-default (current-buffer))
(cider-repl-init (current-buffer))
(cider--check-required-nrepl-version)
(cider--check-clojure-version-supported)
(cider--check-middleware-compatibility)
(cider--debug-init-connection)
(cider--subscribe-repl-to-server-out)
(when cider-auto-mode
(cider-enable-on-existing-clojure-buffers))
(run-hooks 'cider-connected-hook))
(defun cider--disconnected-handler ()
"Cleanup after nREPL connection has been lost or closed.
This function is appended to `nrepl-disconnected-hook' in the client
process buffer."
;; `nrepl-connected-hook' is run in connection buffer
(cider-possibly-disable-on-existing-clojure-buffers)
(run-hooks 'cider-disconnected-hook))
;;;###autoload
(eval-after-load 'clojure-mode
'(progn
(define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in)
(define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-clojurescript)
(define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect)))
(provide 'cider)
;;; cider.el ends here

1227
elpa/cider-20160927.2135/nrepl-client.el
View File

File diff suppressed because it is too large Load Diff

187
elpa/cider-20160927.2135/nrepl-dict.el
View File

@ -1,187 +0,0 @@
;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*-
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
;; Copyright © 2013-2016 Bozhidar Batsov, Artur Malabarba and CIDER contributors
;;
;; Author: Tim King <kingtim@gmail.com>
;; Phil Hagelberg <technomancy@gmail.com>
;; Bozhidar Batsov <bozhidar@batsov.com>
;; Artur Malabarba <bruce.connor.am@gmail.com>
;; Hugo Duncan <hugo@hugoduncan.org>
;; Steve Purcell <steve@sanityinc.com>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;; Provides functions to interact with and create `nrepl-dict's. These are
;; simply plists with an extra element at the head.
;;; Code:
(require 'cl-lib)
(defun nrepl-dict (&rest key-vals)
"Create nREPL dict from KEY-VALS."
(cons 'dict key-vals))
(defun nrepl-dict-p (object)
"Return t if OBJECT is an nREPL dict."
(and (listp object)
(eq (car object) 'dict)))
(defun nrepl-dict-empty-p (dict)
"Return t if nREPL dict DICT is empty."
(null (cdr dict)))
(defun nrepl-dict-contains (dict key)
"Return nil if nREPL dict DICT doesn't contain KEY.
If DICT does contain KEY, then a non-nil value is returned. Due to the
current implementation, this return value is the tail of DICT's key-list
whose car is KEY. Comparison is done with `equal'."
(member key (nrepl-dict-keys dict)))
(defun nrepl-dict-get (dict key &optional default)
"Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT.
If dict is nil, return nil. If DEFAULT not provided, and KEY not in DICT,
return nil. If DICT is not an nREPL dict object, an error is thrown."
(when dict
(if (nrepl-dict-p dict)
(if (nrepl-dict-contains dict key)
(lax-plist-get (cdr dict) key)
default)
(error "Not an nREPL dict object: %s" dict))))
(defun nrepl-dict-put (dict key value)
"Associate in DICT, KEY to VALUE.
Return new dict. Dict is modified by side effects."
(if (null dict)
(list 'dict key value)
(if (not (nrepl-dict-p dict))
(error "Not an nREPL dict object: %s" dict)
(setcdr dict (lax-plist-put (cdr dict) key value))
dict)))
(defun nrepl-dict-keys (dict)
"Return all the keys in the nREPL DICT."
(if (nrepl-dict-p dict)
(cl-loop for l on (cdr dict) by #'cddr
collect (car l))
(error "Not an nREPL dict")))
(defun nrepl-dict-vals (dict)
"Return all the values in the nREPL DICT."
(if (nrepl-dict-p dict)
(cl-loop for l on (cdr dict) by #'cddr
collect (cadr l))
(error "Not an nREPL dict")))
(defun nrepl-dict-map (fn dict)
"Map FN on nREPL DICT.
FN must accept two arguments key and value."
(if (nrepl-dict-p dict)
(cl-loop for l on (cdr dict) by #'cddr
collect (funcall fn (car l) (cadr l)))
(error "Not an nREPL dict")))
(defun nrepl-dict-merge (dict1 dict2)
"Destructively merge DICT2 into DICT1.
Keys in DICT2 override those in DICT1."
(let ((base (or dict1 '(dict))))
(nrepl-dict-map (lambda (k v)
(nrepl-dict-put base k v))
(or dict2 '(dict)))
base))
(defun nrepl-dict-get-in (dict keys)
"Return the value in a nested DICT.
KEYS is a list of keys. Return nil if any of the keys is not present or if
any of the values is nil."
(let ((out dict))
(while (and keys out)
(setq out (nrepl-dict-get out (pop keys))))
out))
(defun nrepl-dict-flat-map (function dict)
"Map FUNCTION over DICT and flatten the result.
FUNCTION follows the same restrictions as in `nrepl-dict-map', and it must
also alway return a sequence (since the result will be flattened)."
(when dict
(apply #'append (nrepl-dict-map function dict))))
;;; More specific functions
(defun nrepl--cons (car list-or-dict)
"Generic cons of CAR to LIST-OR-DICT."
(if (eq (car list-or-dict) 'dict)
(cons 'dict (cons car (cdr list-or-dict)))
(cons car list-or-dict)))
(defun nrepl--nreverse (list-or-dict)
"Generic `nreverse' which works on LIST-OR-DICT."
(if (eq (car list-or-dict) 'dict)
(cons 'dict (nreverse (cdr list-or-dict)))
(nreverse list-or-dict)))
(defun nrepl--push (obj stack)
"Cons OBJ to the top element of the STACK."
;; stack is assumed to be a list
(if (eq (caar stack) 'dict)
(cons (cons 'dict (cons obj (cdar stack)))
(cdr stack))
(cons (if (null stack)
obj
(cons obj (car stack)))
(cdr stack))))
(defun nrepl--merge (dict1 dict2 &optional no-join)
"Join nREPL dicts DICT1 and DICT2 in a meaningful way.
String values for non \"id\" and \"session\" keys are concatenated. Lists
are appended. nREPL dicts merged recursively. All other objects are
accumulated into a list. DICT1 is modified destructively and
then returned.
If NO-JOIN is given, return the first non nil dict."
(if no-join
(or dict1 dict2)
(cond ((null dict1) dict2)
((null dict2) dict1)
((stringp dict1) (concat dict1 dict2))
((nrepl-dict-p dict1)
(nrepl-dict-map
(lambda (k2 v2)
(nrepl-dict-put dict1 k2
(nrepl--merge (nrepl-dict-get dict1 k2) v2
(member k2 '("id" "session")))))
dict2)
dict1)
((and (listp dict2) (listp dict1)) (append dict1 dict2))
((listp dict1) (append dict1 (list dict2)))
(t (list dict1 dict2)))))
;;; Dbind
(defmacro nrepl-dbind-response (response keys &rest body)
"Destructure an nREPL RESPONSE dict.
Bind the value of the provided KEYS and execute BODY."
(declare (debug (form (&rest symbolp) body)))
`(let ,(cl-loop for key in keys
collect `(,key (nrepl-dict-get ,response ,(format "%s" key))))
,@body))
(put 'nrepl-dbind-response 'lisp-indent-function 2)
(provide 'nrepl-dict)
;;; nrepl-dict.el ends here

121
elpa/clojure-mode-20161004.2314/clojure-mode-autoloads.el
View File

@ -1,121 +0,0 @@
;;; clojure-mode-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
;;;### (autoloads nil "clojure-mode" "clojure-mode.el" (22516 57909
;;;;;; 485546 83000))
;;; Generated autoloads from clojure-mode.el
(autoload 'clojure-mode "clojure-mode" "\
Major mode for editing Clojure code.
\\{clojure-mode-map}
\(fn)" t nil)
(autoload 'clojure-unwind "clojure-mode" "\
Unwind thread at point or above point by one level.
Return nil if there are no more levels to unwind.
\(fn)" t nil)
(autoload 'clojure-unwind-all "clojure-mode" "\
Fully unwind thread at point or above point.
\(fn)" t nil)
(autoload 'clojure-thread "clojure-mode" "\
Thread by one more level an existing threading macro.
\(fn)" t nil)
(autoload 'clojure-thread-first-all "clojure-mode" "\
Fully thread the form at point using ->.
When BUT-LAST is passed the last expression is not threaded.
\(fn BUT-LAST)" t nil)
(autoload 'clojure-thread-last-all "clojure-mode" "\
Fully thread the form at point using ->>.
When BUT-LAST is passed the last expression is not threaded.
\(fn BUT-LAST)" t nil)
(autoload 'clojure-cycle-privacy "clojure-mode" "\
Make public the current private def, or vice-versa.
See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-privacy
\(fn)" t nil)
(autoload 'clojure-convert-collection-to-list "clojure-mode" "\
Convert collection at (point) to list.
\(fn)" t nil)
(autoload 'clojure-convert-collection-to-quoted-list "clojure-mode" "\
Convert collection at (point) to quoted list.
\(fn)" t nil)
(autoload 'clojure-convert-collection-to-map "clojure-mode" "\
Convert collection at (point) to map.
\(fn)" t nil)
(autoload 'clojure-convert-collection-to-vector "clojure-mode" "\
Convert collection at (point) to vector.
\(fn)" t nil)
(autoload 'clojure-convert-collection-to-set "clojure-mode" "\
Convert collection at (point) to set.
\(fn)" t nil)
(autoload 'clojure-cycle-if "clojure-mode" "\
Change a surrounding if to if-not, or vice-versa.
See: https://github.com/clojure-emacs/clj-refactor.el/wiki/cljr-cycle-if
\(fn)" t nil)
(autoload 'clojurescript-mode "clojure-mode" "\
Major mode for editing ClojureScript code.
\\{clojurescript-mode-map}
\(fn)" t nil)
(autoload 'clojurec-mode "clojure-mode" "\
Major mode for editing ClojureC code.
\\{clojurec-mode-map}
\(fn)" t nil)
(autoload 'clojurex-mode "clojure-mode" "\
Major mode for editing ClojureX code.
\\{clojurex-mode-map}
\(fn)" t nil)
(add-to-list 'auto-mode-alist '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-mode))
(add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-mode))
(add-to-list 'auto-mode-alist '("\\.cljx\\'" . clojurex-mode))
(add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-mode))
(add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-mode))
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; clojure-mode-autoloads.el ends here

2
elpa/clojure-mode-20161004.2314/clojure-mode-pkg.el
View File

@ -1,2 +0,0 @@
;;; -*- no-byte-compile: t -*-
(define-package "clojure-mode" "20161004.2314" "Major mode for Clojure code" '((emacs "24.3")) :url "http://github.com/clojure-emacs/clojure-mode" :keywords '("languages" "clojure" "clojurescript" "lisp"))

2116
elpa/clojure-mode-20161004.2314/clojure-mode.el
View File

File diff suppressed because it is too large Load Diff

22
elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-autoloads.el
View File

@ -1,22 +0,0 @@
;;; clojure-quick-repls-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "clojure-quick-repls" "clojure-quick-repls.el"
;;;;;; (22500 1822 828219 293000))
;;; Generated autoloads from clojure-quick-repls.el
(autoload 'clojure-quick-repls-connect "clojure-quick-repls" "\
Launch Clojure and ClojureScript repls for the current project
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; clojure-quick-repls-autoloads.el ends here

1
elpa/clojure-quick-repls-20150814.36/clojure-quick-repls-pkg.el
View File

@ -1 +0,0 @@
(define-package "clojure-quick-repls" "20150814.36" "Quickly create Clojure and ClojureScript repls for a project." '((cider "0.8.1") (dash "2.9.0")) :url "https://github.com/symfrog/clojure-quick-repls" :keywords '("languages" "clojure" "cider" "clojurescript"))

155
elpa/clojure-quick-repls-20150814.36/clojure-quick-repls.el
View File

@ -1,155 +0,0 @@
;;; clojure-quick-repls.el --- Quickly create Clojure and ClojureScript repls for a project.
;; Copyright (C) 2014 symfrog
;; URL: https://github.com/symfrog/clojure-quick-repls
;; Package-Version: 20150814.36
;; Keywords: languages, clojure, cider, clojurescript
;; Version: 0.2.0-cvs
;; Package-Requires: ((cider "0.8.1") (dash "2.9.0"))
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 3
;; of the License, or (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Quickly create Clojure and ClojureScript repls for a project.
;; Once the repls are created the usual CIDER commands can be used in either a clj/cljs buffer and the forms will be routed automatically via the correct connection.
;; So no need to manually switch connections!
;;; Installation:
;; Available as a package in melpa.org.
;; M-x package-install clojure-quick-repls
;;; Usage:
;; (require 'clojure-quick-repls)
;;; Code:
(require 'cider)
(require 'dash)
(defcustom clojure-quick-repls-cljs-setup
"(require 'cljs.repl.browser)
(cemerick.piggieback/cljs-repl
:repl-env (cljs.repl.browser/repl-env :port 9000))"
"Default form to initialize ClojureScript REPL"
:type '(string)
:group 'clojure-quick-repls)
(defvar clojure-quick-repls-nrepl-connected-fn nil)
(defvar clojure-quick-repls-current-buffer nil)
(defvar clojure-quick-repls-nrepl-connect-done nil)
(defvar clojure-quick-repls-clj-con-buf nil)
(defvar clojure-quick-repls-cljs-con-buf nil)
(defun clojure-quick-repls-noop-nrepl-connected-fn ()
(fset 'clojure-quick-repls-nrepl-connected-fn (lambda (buf) nil)))
(clojure-quick-repls-noop-nrepl-connected-fn)
(defun clojure-quick-repls-clear-con-bufs ()
(setq clojure-quick-repls-clj-con-buf nil)
(setq clojure-quick-repls-cljs-con-buf nil))
(add-hook 'nrepl-connected-hook (lambda ()
(clojure-quick-repls-nrepl-connected-fn clojure-quick-repls-current-buffer)))
(add-hook 'nrepl-disconnected-hook #'clojure-quick-repls-clear-con-bufs)
;;;###autoload
(defun clojure-quick-repls-connect ()
"Launch Clojure and ClojureScript repls for the current project"
(interactive)
(setq clojure-quick-repls-current-buffer (current-buffer))
(clojure-quick-repls-noop-nrepl-connected-fn)
(cider-jack-in)
(clojure-quick-repls-clear-con-bufs)
(lexical-let* ((cljs-fn (lambda (buf)
(with-current-buffer buf
(clojure-quick-repls-noop-nrepl-connected-fn)
(if (string= "ex" (cadr (nrepl-sync-request:eval clojure-quick-repls-cljs-setup)))
(message "Failed to initialize cljs connection with form %s" clojure-quick-repls-cljs-setup)
(progn
(setq clojure-quick-repls-cljs-con-buf (nrepl-current-connection-buffer))
(message "Clj connection buffer: %s Cljs connection buffer %s" clojure-quick-repls-clj-con-buf clojure-quick-repls-cljs-con-buf)
(message "Cljs browser repl ready")
; Make the clj buf default after completion
(nrepl-make-connection-default clojure-quick-repls-clj-con-buf))))))
(clj-fn (lambda (buf)
(with-current-buffer buf
(clojure-quick-repls-noop-nrepl-connected-fn )
(fset 'clojure-quick-repls-nrepl-connected-fn cljs-fn)
(setq clojure-quick-repls-clj-con-buf (nrepl-current-connection-buffer))
(message "Creating nrepl connection for cljs")
(clojure-quick-repls-new-repl-connection)))))
(fset 'clojure-quick-repls-nrepl-connected-fn clj-fn)))
(defun clojure-quick-repls-new-repl-connection ()
(let* ((host (nrepl-current-host))
(port (nrepl-extract-port)))
(message "Creating repl connection to nrepl server on port %s, host %s" host port)
(cider-connect host port)))
(defun clojure-quick-repls-bound-truthy-p (s)
(and (boundp s) (symbol-value s)))
(defun clojure-quick-repls-buffer-extension (buffer)
(let ((name (buffer-name buffer)))
(-when-let (p-loc (string-match-p "\\." name))
(substring name (1+ p-loc) nil))) )
(defun clojure-quick-repls-set-connection (f h)
(let ((ext (clojure-quick-repls-buffer-extension (current-buffer))))
(if (and (clojure-quick-repls-bound-truthy-p 'clojure-quick-repls-clj-con-buf)
(clojure-quick-repls-bound-truthy-p 'clojure-quick-repls-cljs-con-buf)
ext
(or (string= ext "clj") (string= ext "boot") (string= ext "cljs")))
(progn
(if (string= ext "cljs")
(nrepl-make-connection-default clojure-quick-repls-cljs-con-buf)
(nrepl-make-connection-default clojure-quick-repls-clj-con-buf))
(when f
(funcall f)))
(when h
(funcall h)))))
(defun clojure-quick-repls-switch-to-relevant-repl (arg)
(interactive)
(lexical-let ((a arg))
(clojure-quick-repls-set-connection (lambda () (cider-switch-to-current-repl-buffer a))
(lambda () (cider-switch-to-relevant-repl-buffer a)))))
(if (version< emacs-version "24.4")
(progn
(defadvice cider-interactive-eval (before clojure-quick-repls-nrepl-current-session activate)
(clojure-quick-repls-set-connection nil nil))
(defadvice cider-tooling-eval (before clojure-quick-repls-nrepl-current-session activate)
(clojure-quick-repls-set-connection nil nil))
(defadvice cider-complete-at-point (before clojure-quick-repls-nrepl-current-session activate)
(clojure-quick-repls-set-connection nil nil)))
(defun clojure-quick-repls-nrepl-current-session (&optional arg1 arg2 arg3)
(clojure-quick-repls-set-connection nil nil))
(advice-add 'cider-interactive-eval :before #'clojure-quick-repls-nrepl-current-session)
(advice-add 'cider-tooling-eval :before #'clojure-quick-repls-nrepl-current-session)
(advice-add 'cider-complete-at-point :before #'clojure-quick-repls-nrepl-current-session))
(provide 'clojure-quick-repls)
;;; clojure-quick-repls.el ends here

29
elpa/flycheck-clojure-20160704.1221/flycheck-clojure-autoloads.el
View File

@ -1,29 +0,0 @@
;;; flycheck-clojure-autoloads.el --- automatically extracted autoloads
;;
;;; Code:
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
;;;### (autoloads nil "flycheck-clojure" "flycheck-clojure.el" (22500
;;;;;; 1821 852214 67000))
;;; Generated autoloads from flycheck-clojure.el
(autoload 'flycheck-clojure-parse-cider-errors "flycheck-clojure" "\
Parse cider errors from JSON VALUE from CHECKER.
Return a list of parsed `flycheck-error' objects.
\(fn VALUE CHECKER)" nil nil)
(autoload 'flycheck-clojure-setup "flycheck-clojure" "\
Setup Flycheck for Clojure.
\(fn)" t nil)
;;;***
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
;;; flycheck-clojure-autoloads.el ends here

1
elpa/flycheck-clojure-20160704.1221/flycheck-clojure-pkg.el
View File

@ -1 +0,0 @@
(define-package "flycheck-clojure" "20160704.1221" "Flycheck: Clojure support" '((cider "0.8.1") (flycheck "0.22alpha1") (let-alist "1.0.1") (emacs "24")) :url "https://github.com/clojure-emacs/squiggly-clojure")

221
elpa/flycheck-clojure-20160704.1221/flycheck-clojure.el
View File

@ -1,221 +0,0 @@
;;; flycheck-clojure.el --- Flycheck: Clojure support -*- lexical-binding: t; -*-
;; Copyright © 2014 Peter Fraenkel
;; Copyright (C) 2014 Sebastian Wiesner <swiesner@lunaryorn.com>
;;
;; Author: Peter Fraenkel <pnf@podsnap.com>
;; Sebastian Wiesner <swiesner@lunaryorn.com>
;; Maintainer: Peter Fraenkel <pnf@podsnap.com>
;; URL: https://github.com/clojure-emacs/squiggly-clojure
;; Package-Version: 20160704.1221
;; Version: 1.1.0
;; Package-Requires: ((cider "0.8.1") (flycheck "0.22-cvs1") (let-alist "1.0.1") (emacs "24"))
;; This file is not part of GNU Emacs.
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Add Clojure support to Flycheck.
;;
;; Provide syntax checkers to check Clojure code using a running Cider repl.
;;
;; Installation:
;;
;; (eval-after-load 'flycheck '(flycheck-clojure-setup))
;;; Code:
(require 'cider-client)
(require 'flycheck)
(require 'json)
(require 'url-parse)
(eval-when-compile (require 'let-alist))
(defcustom flycheck-clojure-inject-dependencies-at-jack-in t
"When nil, do not inject repl dependencies (i.e. the linters/checkers) at `cider-jack-in' time."
:group 'flycheck-clojure
:type 'boolean)
(defvar flycheck-clojure-dep-version "0.1.6"
"Version of `acyclic/squiggly-clojure' compatible with this version of flycheck-clojure.")
;;;###autoload
(defun flycheck-clojure-parse-cider-errors (value checker)
"Parse cider errors from JSON VALUE from CHECKER.
Return a list of parsed `flycheck-error' objects."
;; Parse the nested JSON from Cider. The outer JSON contains the return value
;; from Cider, and the inner JSON the errors returned by the individual
;; checker.
(let ((error-objects (json-read-from-string (json-read-from-string value))))
(mapcar (lambda (o)
(let-alist o
;; Use the file name reported by the syntax checker, but only if
;; its absolute, because typed reports relative file names that
;; are hard to expand correctly, since they are relative to the
;; source directory (not the project directory).
(let* ((parsed-file (when .file
(url-filename
(url-generic-parse-url .file))))
(filename (if (and parsed-file
(file-name-absolute-p parsed-file))
parsed-file
(buffer-file-name))))
(flycheck-error-new-at .line .column (intern .level) .msg
:checker checker
:filename filename))))
error-objects)))
(defun cider-flycheck-eval (input callback)
"Send the request INPUT and register the CALLBACK as the response handler.
Uses the tooling session, with no specified namespace."
(cider-tooling-eval input callback))
(defun flycheck-clojure-may-use-cider-checker ()
"Determine whether a cider checker may be used.
Checks for `cider-mode', and a current nREPL connection.
Standard predicate for cider checkers."
(let ((connection-buffer (cider-default-connection :no-error)))
(and (bound-and-true-p cider-mode)
connection-buffer
(buffer-live-p (get-buffer connection-buffer))
(clojure-find-ns))))
(defun flycheck-clojure-start-cider (checker callback)
"Start a cider syntax CHECKER with CALLBACK."
(let ((ns (clojure-find-ns))
(form (get checker 'flycheck-clojure-form)))
(cider-flycheck-eval
(funcall form ns)
(nrepl-make-response-handler
(current-buffer)
(lambda (buffer value)
(funcall callback 'finished
(with-current-buffer buffer
(flycheck-clojure-parse-cider-errors value checker))))
nil ; stdout
nil ; stderr
(lambda (_)
;; If the evaluation completes without returning any value, there has
;; gone something wrong. Ideally, we'd report *what* was wrong, but
;; `nrepl-make-response-handler' is close to useless for this :(,
;; because it just `message's for many status codes that are errors for
;; us :(
(funcall callback 'errored "Done with no errors"))
(lambda (_buffer ex _rootex _sess)
(funcall callback 'errored
(format "Form %s of checker %s failed: %s"
form checker ex))))))
)
(defun flycheck-clojure-define-cider-checker (name docstring &rest properties)
"Define a Cider syntax checker with NAME, DOCSTRING and PROPERTIES.
NAME, DOCSTRING, and PROPERTIES are like for
`flycheck-define-generic-checker', except that `:start' and
`:modes' are invalid PROPERTIES. A syntax checker defined with
this function will always check in `clojure-mode', and only if
`cider-mode' is enabled.
Instead of `:start', this syntax checker requires a `:form
FUNCTION' property. FUNCTION takes the current Clojure namespace
as single argument, and shall return a string containing a
Clojure form to be sent to Cider to check the current buffer."
(declare (indent 1)
(doc-string 2))
(let* ((form (plist-get properties :form))
(orig-predicate (plist-get properties :predicate)))
(when (plist-get :start properties)
(error "Checker %s may not have :start" name))
(when (plist-get :modes properties)
(error "Checker %s may not have :modes" name))
(unless (functionp form)
(error ":form %s of %s not a valid function" form name))
(apply #'flycheck-define-generic-checker
name docstring
:start #'flycheck-clojure-start-cider
:modes '(clojure-mode)
:predicate (if orig-predicate
(lambda ()
(and (flycheck-clojure-may-use-cider-checker)
(funcall orig-predicate)))
#'flycheck-clojure-may-use-cider-checker)
properties)
(put name 'flycheck-clojure-form form)))
(flycheck-clojure-define-cider-checker 'clojure-cider-eastwood
"A syntax checker for Clojure, using Eastwood in Cider.
See URL `https://github.com/jonase/eastwood' and URL
`https://github.com/clojure-emacs/cider/' for more information."
:form (lambda (ns)
(format "(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-ew '%s))"
ns))
:next-checkers '(clojure-cider-kibit clojure-cider-typed))
(flycheck-clojure-define-cider-checker 'clojure-cider-kibit
"A syntax checker for Clojure, using Kibit in Cider.
See URL `https://github.com/jonase/kibit' and URL
`https://github.com/clojure-emacs/cider/' for more information."
:form (lambda (ns)
(format
"(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-kb '%s %s))"
ns
;; Escape file name for Clojure
(flycheck-sexp-to-string (buffer-file-name))))
:predicate (lambda () (buffer-file-name))
:next-checkers '(clojure-cider-typed))
(flycheck-clojure-define-cider-checker 'clojure-cider-typed
"A syntax checker for Clojure, using Typed Clojure in Cider.
See URL `https://github.com/clojure-emacs/cider/' and URL
`https://github.com/clojure/core.typed' for more information."
:form (lambda (ns)
(format
"(do (require 'squiggly-clojure.core) (squiggly-clojure.core/check-tc '%s))"
ns)))
(defun flycheck-clojure-inject-jack-in-dependencies ()
"Inject the REPL dependencies of flycheck-clojure at `cider-jack-in'.
If injecting the dependencies is not preferred set `flycheck-clojure-inject-dependencies-at-jack-in' to nil."
(when (and flycheck-clojure-inject-dependencies-at-jack-in
(boundp 'cider-jack-in-dependencies))
(add-to-list 'cider-jack-in-dependencies `("acyclic/squiggly-clojure" ,flycheck-clojure-dep-version))))
;;;###autoload
(defun flycheck-clojure-setup ()
"Setup Flycheck for Clojure."
(interactive)
;; Add checkers in reverse order, because `add-to-list' adds to front.
(dolist (checker '(clojure-cider-typed
clojure-cider-kibit
clojure-cider-eastwood))
(add-to-list 'flycheck-checkers checker))
(flycheck-clojure-inject-jack-in-dependencies))
(provide 'flycheck-clojure)
;; Local Variables:
;; indent-tabs-mode: nil
;; End:
;;; flycheck-clojure.el ends here

2
init.el
View File

@ -73,7 +73,7 @@
("e6h" . "http://www.e6h.org/packages/")))) ("e6h" . "http://www.e6h.org/packages/"))))
'(package-selected-packages '(package-selected-packages
(quote (quote
(gobgen goto-last-change wakatime-mode command-log-mode magithub nyan-prompt zone-nyan helm-google helm-projectile helm-spotify helm-swoop helm-unicode id-manager identica-mode mc-extras multiple-cursors electric-spacing flycheck-clojure flycheck-pkg-config focus git-messenger gitconfig github-notifier gnome-calendar gnugo google helm-chrome helm-company helm-flycheck clojure-quick-repls electric-case emamux flycheck drag-stuff django-manage clojure-mode hyde org-jekyll smart-mode-line-powerline-theme yaml-mode xlicense vala-mode sass-mode nyan-mode muse markdown-mode mark magit-gerrit json-mode js2-mode jinja2-mode helm-make helm-gtags helm-flyspell helm-ag go-mode gitignore-mode gitconfig-mode git-gutter ggtags fiplr erlang django-mode company-shell company-quickhelp company-c-headers coffee-mode buffer-move ag))) (gobgen goto-last-change wakatime-mode command-log-mode magithub nyan-prompt zone-nyan helm-google helm-projectile helm-spotify helm-swoop helm-unicode id-manager identica-mode mc-extras multiple-cursors electric-spacing flycheck-pkg-config focus git-messenger gitconfig github-notifier gnome-calendar gnugo google helm-chrome helm-company helm-flycheck electric-case emamux flycheck drag-stuff django-manage hyde org-jekyll smart-mode-line-powerline-theme yaml-mode xlicense vala-mode sass-mode nyan-mode muse markdown-mode mark magit-gerrit json-mode js2-mode jinja2-mode helm-make helm-gtags helm-flyspell helm-ag go-mode gitignore-mode gitconfig-mode git-gutter ggtags fiplr erlang django-mode company-shell company-quickhelp company-c-headers coffee-mode buffer-move ag)))
'(safe-local-variable-values '(safe-local-variable-values
(quote (quote
((company-clang-arguments "-I.." "-I/home/polesz/jhbuild/install/include/atk-1.0" "-I/home/polesz/jhbuild/install/include/at-spi-2.0" "-I/home/polesz/jhbuild/install/include/at-spi2-atk/2.0" "-I/home/polesz/jhbuild/install/include/cairo" "-I/home/polesz/jhbuild/install/include/gdk-pixbuf-2.0" "-I/home/polesz/jhbuild/install/include/gio-unix-2.0/" "-I/home/polesz/jhbuild/install/include/glib-2.0" "-I/home/polesz/jhbuild/install/include/gtk-3.0" "-I/home/polesz/jhbuild/install/include/harfbuzz" "-I/home/polesz/jhbuild/install/include/libgda-5.0" "-I/home/polesz/jhbuild/install/include/libgda-5.0/libgda" "-I/home/polesz/jhbuild/install/include/librsvg-2.0" "-I/home/polesz/jhbuild/install/include/libsoup-2.4" "-I/home/polesz/jhbuild/install/include/pango-1.0" "-I/home/polesz/jhbuild/install/include/swe-glib" "-I/home/polesz/jhbuild/install/include/webkitgtk-4.0" "-I/home/polesz/jhbuild/install/lib/glib-2.0/include" "-I/usr/include/dbus-1.0" "-I/usr/include/freetype2" "-I/usr/include/libdrm" "-I/usr/include/libpng16" "-I/usr/include/libxml2" "-I/usr/include/pixman-1" "-I/usr/lib64/dbus-1.0/include") ((company-clang-arguments "-I.." "-I/home/polesz/jhbuild/install/include/atk-1.0" "-I/home/polesz/jhbuild/install/include/at-spi-2.0" "-I/home/polesz/jhbuild/install/include/at-spi2-atk/2.0" "-I/home/polesz/jhbuild/install/include/cairo" "-I/home/polesz/jhbuild/install/include/gdk-pixbuf-2.0" "-I/home/polesz/jhbuild/install/include/gio-unix-2.0/" "-I/home/polesz/jhbuild/install/include/glib-2.0" "-I/home/polesz/jhbuild/install/include/gtk-3.0" "-I/home/polesz/jhbuild/install/include/harfbuzz" "-I/home/polesz/jhbuild/install/include/libgda-5.0" "-I/home/polesz/jhbuild/install/include/libgda-5.0/libgda" "-I/home/polesz/jhbuild/install/include/librsvg-2.0" "-I/home/polesz/jhbuild/install/include/libsoup-2.4" "-I/home/polesz/jhbuild/install/include/pango-1.0" "-I/home/polesz/jhbuild/install/include/swe-glib" "-I/home/polesz/jhbuild/install/include/webkitgtk-4.0" "-I/home/polesz/jhbuild/install/lib/glib-2.0/include" "-I/usr/include/dbus-1.0" "-I/usr/include/freetype2" "-I/usr/include/libdrm" "-I/usr/include/libpng16" "-I/usr/include/libxml2" "-I/usr/include/pixman-1" "-I/usr/lib64/dbus-1.0/include")