Install new packages
This commit is contained in:
parent
1f4e059413
commit
850199b21a
202
elpa/cider-20160914.2335/cider-apropos.el
Normal file
202
elpa/cider-20160914.2335/cider-apropos.el
Normal file
@ -0,0 +1,202 @@
|
|||||||
|
;;; 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
|
314
elpa/cider-20160914.2335/cider-autoloads.el
Normal file
314
elpa/cider-20160914.2335/cider-autoloads.el
Normal file
@ -0,0 +1,314 @@
|
|||||||
|
;;; cider-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil "cider" "cider.el" (22500 1819 348200 658000))
|
||||||
|
;;; 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" (22500 1819
|
||||||
|
;;;;;; 244200 101000))
|
||||||
|
;;; 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" (22500
|
||||||
|
;;;;;; 1819 228200 15000))
|
||||||
|
;;; 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" (22500
|
||||||
|
;;;;;; 1819 360200 722000))
|
||||||
|
;;; 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" (22500 1819
|
||||||
|
;;;;;; 236200 58000))
|
||||||
|
;;; 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" (22500
|
||||||
|
;;;;;; 1819 296200 380000))
|
||||||
|
;;; 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" (22500
|
||||||
|
;;;;;; 1819 288200 336000))
|
||||||
|
;;; 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"
|
||||||
|
;;;;;; (22500 1819 336200 594000))
|
||||||
|
;;; 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" (22500 1819 260200
|
||||||
|
;;;;;; 186000))
|
||||||
|
;;; 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" (22500 1819
|
||||||
|
;;;;;; 272200 251000))
|
||||||
|
;;; 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" (22500
|
||||||
|
;;;;;; 1819 352200 679000))
|
||||||
|
;;; 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" (22500 1819 332200
|
||||||
|
;;;;;; 572000))
|
||||||
|
;;; Generated autoloads from cider-test.el
|
||||||
|
|
||||||
|
(defvar cider-auto-test-mode nil "\
|
||||||
|
Non-nil if Cider-Auto-Test mode is enabled.
|
||||||
|
See the command `cider-auto-test-mode' 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" (22500 1819 340200
|
||||||
|
;;;;;; 615000))
|
||||||
|
;;; 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")
|
||||||
|
;;;;;; (22500 1819 381194 228000))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; cider-autoloads.el ends here
|
219
elpa/cider-20160914.2335/cider-browse-ns.el
Normal file
219
elpa/cider-20160914.2335/cider-browse-ns.el
Normal file
@ -0,0 +1,219 @@
|
|||||||
|
;;; 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 [return] #'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-20160914.2335/cider-classpath.el
Normal file
112
elpa/cider-20160914.2335/cider-classpath.el
Normal file
@ -0,0 +1,112 @@
|
|||||||
|
;;; 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 [return] #'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
|
1119
elpa/cider-20160914.2335/cider-client.el
Normal file
1119
elpa/cider-20160914.2335/cider-client.el
Normal file
File diff suppressed because it is too large
Load Diff
257
elpa/cider-20160914.2335/cider-common.el
Normal file
257
elpa/cider-20160914.2335/cider-common.el
Normal file
@ -0,0 +1,257 @@
|
|||||||
|
;;; 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-20160914.2335/cider-compat.el
Normal file
157
elpa/cider-20160914.2335/cider-compat.el
Normal file
@ -0,0 +1,157 @@
|
|||||||
|
;;; 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-20160914.2335/cider-debug.el
Normal file
752
elpa/cider-20160914.2335/cider-debug.el
Normal file
@ -0,0 +1,752 @@
|
|||||||
|
;;; 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-20160914.2335/cider-doc.el
Normal file
522
elpa/cider-20160914.2335/cider-doc.el
Normal file
@ -0,0 +1,522 @@
|
|||||||
|
;;; 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-20160914.2335/cider-eldoc.el
Normal file
430
elpa/cider-20160914.2335/cider-eldoc.el
Normal file
@ -0,0 +1,430 @@
|
|||||||
|
;;; 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-20160914.2335/cider-grimoire.el
Normal file
118
elpa/cider-20160914.2335/cider-grimoire.el
Normal file
@ -0,0 +1,118 @@
|
|||||||
|
;;; 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
|
390
elpa/cider-20160914.2335/cider-inspector.el
Normal file
390
elpa/cider-20160914.2335/cider-inspector.el
Normal file
@ -0,0 +1,390 @@
|
|||||||
|
;;; 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 [return] #'cider-inspector-operate-on-point)
|
||||||
|
(define-key map "\C-m" #'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-20160914.2335/cider-interaction.el
Normal file
1787
elpa/cider-20160914.2335/cider-interaction.el
Normal file
File diff suppressed because it is too large
Load Diff
207
elpa/cider-20160914.2335/cider-macroexpansion.el
Normal file
207
elpa/cider-20160914.2335/cider-macroexpansion.el
Normal file
@ -0,0 +1,207 @@
|
|||||||
|
;;; 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-20160914.2335/cider-mode.el
Normal file
750
elpa/cider-20160914.2335/cider-mode.el
Normal file
@ -0,0 +1,750 @@
|
|||||||
|
;;; 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-20160914.2335/cider-overlays.el
Normal file
311
elpa/cider-20160914.2335/cider-overlays.el
Normal file
@ -0,0 +1,311 @@
|
|||||||
|
;;; 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-20160914.2335/cider-pkg.el
Normal file
12
elpa/cider-20160914.2335/cider-pkg.el
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
(define-package "cider" "20160914.2335" "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-20160914.2335/cider-popup.el
Normal file
129
elpa/cider-20160914.2335/cider-popup.el
Normal file
@ -0,0 +1,129 @@
|
|||||||
|
;;; 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-20160914.2335/cider-repl.el
Normal file
1377
elpa/cider-20160914.2335/cider-repl.el
Normal file
File diff suppressed because it is too large
Load Diff
129
elpa/cider-20160914.2335/cider-resolve.el
Normal file
129
elpa/cider-20160914.2335/cider-resolve.el
Normal file
@ -0,0 +1,129 @@
|
|||||||
|
;;; 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-20160914.2335/cider-scratch.el
Normal file
75
elpa/cider-20160914.2335/cider-scratch.el
Normal file
@ -0,0 +1,75 @@
|
|||||||
|
;;; 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-20160914.2335/cider-selector.el
Normal file
167
elpa/cider-20160914.2335/cider-selector.el
Normal file
@ -0,0 +1,167 @@
|
|||||||
|
;;; 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-20160914.2335/cider-stacktrace.el
Normal file
716
elpa/cider-20160914.2335/cider-stacktrace.el
Normal file
@ -0,0 +1,716 @@
|
|||||||
|
;;; 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-20160914.2335/cider-test.el
Normal file
690
elpa/cider-20160914.2335/cider-test.el
Normal file
@ -0,0 +1,690 @@
|
|||||||
|
;;; 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-20160914.2335/cider-util.el
Normal file
691
elpa/cider-20160914.2335/cider-util.el
Normal file
@ -0,0 +1,691 @@
|
|||||||
|
;;; 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-20160914.2335/cider.el
Normal file
790
elpa/cider-20160914.2335/cider.el
Normal file
@ -0,0 +1,790 @@
|
|||||||
|
;;; 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-20160914.2335/nrepl-client.el
Normal file
1227
elpa/cider-20160914.2335/nrepl-client.el
Normal file
File diff suppressed because it is too large
Load Diff
187
elpa/cider-20160914.2335/nrepl-dict.el
Normal file
187
elpa/cider-20160914.2335/nrepl-dict.el
Normal file
@ -0,0 +1,187 @@
|
|||||||
|
;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
|
||||||
|
;; Copyright © 2013-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
|
126
elpa/clojure-mode-20160803.140/clojure-mode-autoloads.el
Normal file
126
elpa/clojure-mode-20160803.140/clojure-mode-autoloads.el
Normal file
@ -0,0 +1,126 @@
|
|||||||
|
;;; clojure-mode-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil "clojure-mode" "clojure-mode.el" (22500 1824
|
||||||
|
;;;;;; 812229 917000))
|
||||||
|
;;; 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))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("clojure-mode-pkg.el") (22500 1824 819441
|
||||||
|
;;;;;; 379000))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; clojure-mode-autoloads.el ends here
|
1
elpa/clojure-mode-20160803.140/clojure-mode-pkg.el
Normal file
1
elpa/clojure-mode-20160803.140/clojure-mode-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "clojure-mode" "20160803.140" "Major mode for Clojure code" '((emacs "24.3")) :url "http://github.com/clojure-emacs/clojure-mode" :keywords '("languages" "clojure" "clojurescript" "lisp"))
|
2004
elpa/clojure-mode-20160803.140/clojure-mode.el
Normal file
2004
elpa/clojure-mode-20160803.140/clojure-mode.el
Normal file
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,22 @@
|
|||||||
|
;;; 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
|
@ -0,0 +1 @@
|
|||||||
|
(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
Normal file
155
elpa/clojure-quick-repls-20150814.36/clojure-quick-repls.el
Normal file
@ -0,0 +1,155 @@
|
|||||||
|
;;; 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
|
@ -0,0 +1,29 @@
|
|||||||
|
;;; 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
|
@ -0,0 +1 @@
|
|||||||
|
(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
Normal file
221
elpa/flycheck-clojure-20160704.1221/flycheck-clojure.el
Normal file
@ -0,0 +1,221 @@
|
|||||||
|
;;; 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
|
@ -0,0 +1,23 @@
|
|||||||
|
;;; flycheck-pkg-config-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil "flycheck-pkg-config" "flycheck-pkg-config.el"
|
||||||
|
;;;;;; (22500 1790 332045 278000))
|
||||||
|
;;; Generated autoloads from flycheck-pkg-config.el
|
||||||
|
|
||||||
|
(autoload 'flycheck-pkg-config "flycheck-pkg-config" "\
|
||||||
|
Configure flycheck to use additional includes
|
||||||
|
when checking the current buffer.
|
||||||
|
|
||||||
|
\(fn)" t nil)
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; flycheck-pkg-config-autoloads.el ends here
|
@ -0,0 +1 @@
|
|||||||
|
(define-package "flycheck-pkg-config" "20160610.1335" "configure flycheck using pkg-config" '((dash "2.8.0") (s "1.9.0") (cl-lib "0.5")) :keywords '("flycheck"))
|
@ -0,0 +1,85 @@
|
|||||||
|
;;; flycheck-pkg-config.el --- configure flycheck using pkg-config -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2016
|
||||||
|
|
||||||
|
;; Author: Wilfred Hughes <me@wilfred.me.uk>
|
||||||
|
;; Keywords: flycheck
|
||||||
|
;; Package-Version: 20160610.1335
|
||||||
|
;; Version: 0.1
|
||||||
|
;; Package-Requires: ((dash "2.8.0") (s "1.9.0") (cl-lib "0.5"))
|
||||||
|
|
||||||
|
;; 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 2 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:
|
||||||
|
|
||||||
|
;; Flycheck defines a `flycheck-clang-include-path' variable that it
|
||||||
|
;; searches for headers when checking C/C++ code.
|
||||||
|
;;
|
||||||
|
;; This package provides a convenient way of adding libraries to that
|
||||||
|
;; list, using pkg-config and completion.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 's)
|
||||||
|
(require 'dash)
|
||||||
|
(require 'flycheck)
|
||||||
|
|
||||||
|
(defvar flycheck-pkg-config--libs nil)
|
||||||
|
|
||||||
|
(defun flycheck-pkg-config--ignore-case-less-p (s1 s2)
|
||||||
|
(string< (downcase s1) (downcase s2)))
|
||||||
|
|
||||||
|
(defun flycheck-pkg-config--set-libs ()
|
||||||
|
"Set `flycheck-pkg-config--libs' by calling pkg-config."
|
||||||
|
(let* ((all-libs-with-names
|
||||||
|
(shell-command-to-string "pkg-config --list-all"))
|
||||||
|
(lines (s-split "\n" (s-trim all-libs-with-names)))
|
||||||
|
(libs (--map (-first-item (s-split " " it)) lines)))
|
||||||
|
(setq flycheck-pkg-config--libs (-sort #'flycheck-pkg-config--ignore-case-less-p libs))))
|
||||||
|
|
||||||
|
(defun flycheck-pkg-config--include-paths (library-name)
|
||||||
|
"Get a list of include paths for LIBRARY-NAME.
|
||||||
|
Raises an error if pkg-config can't find any paths for this library."
|
||||||
|
(let* (;; Find the include flags, e.g. "-I/usr/lib/foo"
|
||||||
|
(pkgconfig-cmd (format "pkg-config --cflags %s" library-name))
|
||||||
|
(cc-args (s-trim (shell-command-to-string pkgconfig-cmd))))
|
||||||
|
(if (s-contains? "-I" cc-args)
|
||||||
|
;; pkg-config has found a library with this name.
|
||||||
|
(let (ret)
|
||||||
|
(dolist (x (s-split " " cc-args) ret)
|
||||||
|
(if (s-starts-with? "-I" x) (setq ret (cons (s-chop-prefix "-I" x) ret)))))
|
||||||
|
(user-error cc-args))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun flycheck-pkg-config ()
|
||||||
|
"Configure flycheck to use additional includes
|
||||||
|
when checking the current buffer."
|
||||||
|
(interactive)
|
||||||
|
;; Find out all the libraries installed on this system.
|
||||||
|
(unless flycheck-pkg-config--libs
|
||||||
|
(flycheck-pkg-config--set-libs))
|
||||||
|
(let* ((lib-name (completing-read "Library name: " flycheck-pkg-config--libs))
|
||||||
|
;; Find the include paths, e.g. "-I/usr/lib/foo"
|
||||||
|
(include-paths (flycheck-pkg-config--include-paths lib-name)))
|
||||||
|
;; Only set in this buffer.
|
||||||
|
(make-local-variable 'flycheck-clang-include-path)
|
||||||
|
;; Add include paths to `flycheck-clang-include-path' unless
|
||||||
|
;; already present.
|
||||||
|
(setq flycheck-clang-include-path
|
||||||
|
(-union flycheck-clang-include-path include-paths))
|
||||||
|
(message "flycheck-clang-include-path: %s"
|
||||||
|
flycheck-clang-include-path)))
|
||||||
|
|
||||||
|
(provide 'flycheck-pkg-config)
|
||||||
|
;;; flycheck-pkg-config.el ends here
|
26
elpa/focus-20160131.1418/focus-autoloads.el
Normal file
26
elpa/focus-20160131.1418/focus-autoloads.el
Normal file
@ -0,0 +1,26 @@
|
|||||||
|
;;; focus-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil "focus" "focus.el" (22500 1789 464040 629000))
|
||||||
|
;;; Generated autoloads from focus.el
|
||||||
|
|
||||||
|
(autoload 'focus-mode "focus" "\
|
||||||
|
Dim the font color of text in surrounding sections.
|
||||||
|
|
||||||
|
\(fn &optional ARG)" t nil)
|
||||||
|
|
||||||
|
(autoload 'focus-read-only-mode "focus" "\
|
||||||
|
A read-only mode optimized for `focus-mode'.
|
||||||
|
|
||||||
|
\(fn &optional ARG)" t nil)
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; focus-autoloads.el ends here
|
1
elpa/focus-20160131.1418/focus-pkg.el
Normal file
1
elpa/focus-20160131.1418/focus-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "focus" "20160131.1418" "Dim the font color of text in surrounding sections" '((emacs "24") (cl-lib "0.5")) :url "http://github.com/larstvei/Focus")
|
306
elpa/focus-20160131.1418/focus.el
Normal file
306
elpa/focus-20160131.1418/focus.el
Normal file
@ -0,0 +1,306 @@
|
|||||||
|
;;; focus.el --- Dim the font color of text in surrounding sections -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2015 Lars Tveito
|
||||||
|
|
||||||
|
;; Author: Lars Tveito <larstvei@ifi.uio.no>
|
||||||
|
;; URL: http://github.com/larstvei/Focus
|
||||||
|
;; Package-Version: 20160131.1418
|
||||||
|
;; Created: 11th May 2015
|
||||||
|
;; Version: 0.1.0
|
||||||
|
;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
|
||||||
|
|
||||||
|
;; 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:
|
||||||
|
|
||||||
|
;; Focus provides `focus-mode` that dims the text of surrounding sections,
|
||||||
|
;; similar to [iA Writer's](https://ia.net/writer) Focus Mode.
|
||||||
|
;;
|
||||||
|
;; Enable the mode with `M-x focus-mode'.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'thingatpt)
|
||||||
|
|
||||||
|
(defgroup focus ()
|
||||||
|
"Dim the font color of text in surrounding sections."
|
||||||
|
:group 'font-lock
|
||||||
|
:prefix "focus-")
|
||||||
|
|
||||||
|
(defcustom focus-dimness 0
|
||||||
|
"Amount of dimness in out of focus sections is determined by this integer.
|
||||||
|
|
||||||
|
A positive value increases the dimness of the sections.
|
||||||
|
A negative value decreases the dimness.
|
||||||
|
|
||||||
|
The default is 0 which means a 50/50 mixture of the background
|
||||||
|
and foreground color."
|
||||||
|
:type '(integer)
|
||||||
|
:group 'focus)
|
||||||
|
|
||||||
|
(defcustom focus-mode-to-thing '((prog-mode . defun) (text-mode . sentence))
|
||||||
|
"An associated list between mode and thing.
|
||||||
|
|
||||||
|
A thing is defined in thingatpt.el; the thing determines the
|
||||||
|
narrowness of the focused section.
|
||||||
|
|
||||||
|
Note that the order of the list matters. The first mode that the
|
||||||
|
current mode is derived from is used, so more modes that have
|
||||||
|
many derivatives should be placed by the end of the list.
|
||||||
|
|
||||||
|
Things that are defined include `symbol', `list', `sexp',
|
||||||
|
`defun', `filename', `url', `email', `word', `sentence',
|
||||||
|
`whitespace', `line', and `page'."
|
||||||
|
:type '(repeat symbol)
|
||||||
|
:group 'focus)
|
||||||
|
|
||||||
|
(defcustom focus-read-only-blink-seconds 1
|
||||||
|
"The duration of a cursor blink in `focus-read-only-mode'."
|
||||||
|
:type '(float)
|
||||||
|
:group 'focus)
|
||||||
|
|
||||||
|
(defvar focus-current-thing nil
|
||||||
|
"Overrides the choice of thing dictated by `focus-mode-to-thing' if set.")
|
||||||
|
|
||||||
|
(defvar focus-pre-overlay nil
|
||||||
|
"The overlay that dims the text prior to the current-point.")
|
||||||
|
|
||||||
|
(defvar focus-post-overlay nil
|
||||||
|
"The overlay that dims the text past the current-point.")
|
||||||
|
|
||||||
|
(defvar focus-read-only-blink-timer nil
|
||||||
|
"Timer started from `focus-read-only-cursor-blink'.
|
||||||
|
The timer calls `focus-read-only-hide-cursor' after
|
||||||
|
`focus-read-only-blink-seconds' seconds.")
|
||||||
|
|
||||||
|
;; Use make-local-variable for backwards compatibility.
|
||||||
|
(dolist (var '(focus-current-thing
|
||||||
|
focus-pre-overlay
|
||||||
|
focus-post-overlay
|
||||||
|
focus-read-only-blink-timer))
|
||||||
|
(make-local-variable var))
|
||||||
|
|
||||||
|
;; Changing major-mode should not affect Focus mode.
|
||||||
|
(dolist (var '(focus-current-thing
|
||||||
|
focus-pre-overlay
|
||||||
|
focus-post-overlay
|
||||||
|
post-command-hook))
|
||||||
|
(put var 'permanent-local t))
|
||||||
|
|
||||||
|
(defun focus-any (f lst)
|
||||||
|
"Apply F to each element of LST and return first NON-NIL."
|
||||||
|
(when lst
|
||||||
|
(let ((v (funcall f (car lst))))
|
||||||
|
(if v v (focus-any f (cdr lst))))))
|
||||||
|
|
||||||
|
(defun focus-get-thing ()
|
||||||
|
"Return the current thing, based on `focus-mode-to-thing'."
|
||||||
|
(or focus-current-thing
|
||||||
|
(let* ((modes (mapcar 'car focus-mode-to-thing))
|
||||||
|
(mode (focus-any 'derived-mode-p modes)))
|
||||||
|
(if mode (cdr (assoc mode focus-mode-to-thing)) 'sentence))))
|
||||||
|
|
||||||
|
(defun focus-bounds ()
|
||||||
|
"Return the current bounds, based on `focus-get-thing'."
|
||||||
|
(bounds-of-thing-at-point (focus-get-thing)))
|
||||||
|
|
||||||
|
(defun focus-average-colors (color &rest colors)
|
||||||
|
"Takes an average of the colors given by argument.
|
||||||
|
Argument COLOR is a color name, and so are the COLORS; COLOR is
|
||||||
|
there to ensure that the the function receives at least one
|
||||||
|
argument."
|
||||||
|
(let* ((colors (cons color colors))
|
||||||
|
(colors (mapcar 'color-name-to-rgb colors))
|
||||||
|
(len (length colors))
|
||||||
|
(sums (apply 'cl-mapcar '+ colors))
|
||||||
|
(avg (mapcar (lambda (v) (/ v len)) sums)))
|
||||||
|
(apply 'color-rgb-to-hex avg)))
|
||||||
|
|
||||||
|
(defun focus-make-dim-color ()
|
||||||
|
"Return a dimmed color relative to the current theme."
|
||||||
|
(let ((background (face-attribute 'default :background))
|
||||||
|
(foreground (face-attribute 'default :foreground))
|
||||||
|
(backgrounds (if (> focus-dimness 0) focus-dimness 1))
|
||||||
|
(foregrounds (if (< focus-dimness 0) (- focus-dimness) 1)))
|
||||||
|
(apply 'focus-average-colors
|
||||||
|
(append (make-list backgrounds background)
|
||||||
|
(make-list foregrounds foreground)))))
|
||||||
|
|
||||||
|
(defun focus-move-focus ()
|
||||||
|
"Moves the focused section according to `focus-bounds'.
|
||||||
|
|
||||||
|
If `focus-mode' is enabled, this command fires after each
|
||||||
|
command."
|
||||||
|
(let* ((bounds (focus-bounds)))
|
||||||
|
(when bounds
|
||||||
|
(focus-move-overlays (car bounds) (cdr bounds)))))
|
||||||
|
|
||||||
|
(defun focus-move-overlays (low high)
|
||||||
|
"Move `focus-pre-overlay' and `focus-post-overlay'."
|
||||||
|
(move-overlay focus-pre-overlay (point-min) low)
|
||||||
|
(move-overlay focus-post-overlay high (point-max)))
|
||||||
|
|
||||||
|
(defun focus-init ()
|
||||||
|
"This function is run when command `focus-mode' is enabled.
|
||||||
|
|
||||||
|
It sets the `focus-pre-overlay' and `focus-post-overlay' to
|
||||||
|
overlays; these are invisible until `focus-move-focus' is run. It
|
||||||
|
adds `focus-move-focus' to `post-command-hook'."
|
||||||
|
(unless (or focus-pre-overlay focus-post-overlay)
|
||||||
|
(setq focus-pre-overlay (make-overlay (point-min) (point-min))
|
||||||
|
focus-post-overlay (make-overlay (point-max) (point-max)))
|
||||||
|
(let ((color (focus-make-dim-color)))
|
||||||
|
(mapc (lambda (o) (overlay-put o 'face (cons 'foreground-color color)))
|
||||||
|
(list focus-pre-overlay focus-post-overlay)))
|
||||||
|
(add-hook 'post-command-hook 'focus-move-focus nil t)))
|
||||||
|
|
||||||
|
(defun focus-terminate ()
|
||||||
|
"This function is run when command `focus-mode' is disabled.
|
||||||
|
|
||||||
|
The overlays pointed to by `focus-pre-overlay' and `focus-post-overlay' are
|
||||||
|
deleted, and `focus-move-focus' is removed from `post-command-hook'."
|
||||||
|
(when (and focus-pre-overlay focus-post-overlay)
|
||||||
|
(mapc 'delete-overlay (list focus-pre-overlay focus-post-overlay))
|
||||||
|
(remove-hook 'post-command-hook 'focus-move-focus t)
|
||||||
|
(setq focus-pre-overlay nil
|
||||||
|
focus-post-overlay nil)))
|
||||||
|
|
||||||
|
(defun focus-goto-thing (bounds)
|
||||||
|
"Move point to the middle of BOUNDS."
|
||||||
|
(when bounds
|
||||||
|
(goto-char (/ (+ (car bounds) (cdr bounds)) 2))
|
||||||
|
(recenter nil)))
|
||||||
|
|
||||||
|
(defun focus-change-thing ()
|
||||||
|
"Adjust the narrowness of the focused section for the current buffer.
|
||||||
|
|
||||||
|
The variable `focus-mode-to-thing' dictates the default thing
|
||||||
|
according to major-mode. If `focus-current-thing' is set, this
|
||||||
|
default is overwritten. This function simply helps set the
|
||||||
|
`focus-current-thing'."
|
||||||
|
(interactive)
|
||||||
|
(let* ((candidates '(symbol list sexp defun
|
||||||
|
filename url email word
|
||||||
|
sentence whitespace line page))
|
||||||
|
(thing (completing-read "Thing: " candidates)))
|
||||||
|
(setq focus-current-thing (intern thing))))
|
||||||
|
|
||||||
|
(defun focus-pin ()
|
||||||
|
"Pin the focused section to its current location or the region,
|
||||||
|
if active."
|
||||||
|
(interactive)
|
||||||
|
(when focus-mode
|
||||||
|
(when (region-active-p)
|
||||||
|
(focus-move-overlays (region-beginning) (region-end)))
|
||||||
|
(remove-hook 'post-command-hook 'focus-move-focus t)))
|
||||||
|
|
||||||
|
(defun focus-unpin ()
|
||||||
|
"Unpin the focused section."
|
||||||
|
(interactive)
|
||||||
|
(when focus-mode
|
||||||
|
(add-hook 'post-command-hook 'focus-move-focus nil t)))
|
||||||
|
|
||||||
|
(defun focus-next-thing (&optional n)
|
||||||
|
"Moves the point to the middle of the Nth next thing."
|
||||||
|
(interactive "p")
|
||||||
|
(let ((current-bounds (focus-bounds))
|
||||||
|
(thing (focus-get-thing)))
|
||||||
|
(forward-thing thing n)
|
||||||
|
(when (equal current-bounds (focus-bounds))
|
||||||
|
(forward-thing thing (signum n)))
|
||||||
|
(focus-goto-thing (focus-bounds))))
|
||||||
|
|
||||||
|
(defun focus-prev-thing (&optional n)
|
||||||
|
"Moves the point to the middle of the Nth previous thing."
|
||||||
|
(interactive "p")
|
||||||
|
(focus-next-thing (- n)))
|
||||||
|
|
||||||
|
(defun focus-read-only-hide-cursor (&optional buffer)
|
||||||
|
"Hide the cursor.
|
||||||
|
This function is triggered by the `focus-read-only-blink-timer',
|
||||||
|
when `focus-read-only-mode' is activated."
|
||||||
|
(with-current-buffer (or buffer (current-buffer))
|
||||||
|
(when (and focus-read-only-mode (not (null focus-read-only-blink-timer)))
|
||||||
|
(setq focus-read-only-blink-timer nil)
|
||||||
|
(setq cursor-type nil))))
|
||||||
|
|
||||||
|
(defun focus-read-only-cursor-blink ()
|
||||||
|
"Make the cursor visible for `focus-read-only-blink-seconds'.
|
||||||
|
This is added to the `pre-command-hook' when
|
||||||
|
`focus-read-only-mode' is active."
|
||||||
|
(when (and focus-read-only-mode
|
||||||
|
(not (member last-command '(focus-next-thing focus-prev-thing))))
|
||||||
|
(when focus-read-only-blink-timer (cancel-timer focus-read-only-blink-timer))
|
||||||
|
(setq cursor-type t)
|
||||||
|
(setq focus-read-only-blink-timer
|
||||||
|
(run-at-time focus-read-only-blink-seconds nil
|
||||||
|
'focus-read-only-hide-cursor (current-buffer)))))
|
||||||
|
|
||||||
|
(defun focus-read-only-init ()
|
||||||
|
"Run when `focus-read-only-mode' is activated.
|
||||||
|
Enables `read-only-mode', hides the cursor and adds
|
||||||
|
`focus-read-only-cursor-blink' to `pre-command-hook'. Also
|
||||||
|
`focus-read-only-terminate' is added to the `kill-buffer-hook'."
|
||||||
|
(read-only-mode 1)
|
||||||
|
(setq cursor-type nil)
|
||||||
|
(add-hook 'pre-command-hook 'focus-read-only-cursor-blink nil t)
|
||||||
|
(add-hook 'kill-buffer-hook 'focus-read-only-terminate t))
|
||||||
|
|
||||||
|
(defun focus-read-only-terminate ()
|
||||||
|
"Run when `focus-read-only-mode' is deactivated.
|
||||||
|
Disables `read-only-mode' and shows the cursor again. It cleans
|
||||||
|
up the `focus-read-only-blink-timer' and hooks."
|
||||||
|
(read-only-mode -1)
|
||||||
|
(setq cursor-type t)
|
||||||
|
(when focus-read-only-blink-timer
|
||||||
|
(cancel-timer focus-read-only-blink-timer))
|
||||||
|
(setq focus-read-only-blink-timer nil)
|
||||||
|
(remove-hook 'pre-command-hook 'focus-read-only-cursor-blink t)
|
||||||
|
(remove-hook 'kill-buffer-hook 'focus-read-only-terminate t))
|
||||||
|
|
||||||
|
(defun turn-off-focus-read-only-mode ()
|
||||||
|
"Turn off `focus-read-only-mode'."
|
||||||
|
(interactive)
|
||||||
|
(focus-read-only-mode -1))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(define-minor-mode focus-mode
|
||||||
|
"Dim the font color of text in surrounding sections."
|
||||||
|
:init-value nil
|
||||||
|
:keymap (let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map (kbd "C-c C-q") 'focus-read-only-mode)
|
||||||
|
map)
|
||||||
|
(unless (and (color-defined-p (face-attribute 'default :background))
|
||||||
|
(color-defined-p (face-attribute 'default :foreground)))
|
||||||
|
(message "Can't enable focus mode when no theme is loaded.")
|
||||||
|
(setq focus-mode nil))
|
||||||
|
(if focus-mode (focus-init) (focus-terminate)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(define-minor-mode focus-read-only-mode
|
||||||
|
"A read-only mode optimized for `focus-mode'."
|
||||||
|
:init-value nil
|
||||||
|
:keymap (let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map (kbd "n") 'focus-next-thing)
|
||||||
|
(define-key map (kbd "SPC") 'focus-next-thing)
|
||||||
|
(define-key map (kbd "p") 'focus-prev-thing)
|
||||||
|
(define-key map (kbd "S-SPC") 'focus-prev-thing)
|
||||||
|
(define-key map (kbd "i") 'turn-off-focus-read-only-mode)
|
||||||
|
(define-key map (kbd "q") 'turn-off-focus-read-only-mode)
|
||||||
|
map)
|
||||||
|
(if focus-read-only-mode (focus-read-only-init) (focus-read-only-terminate)))
|
||||||
|
|
||||||
|
(provide 'focus)
|
||||||
|
;;; focus.el ends here
|
22
elpa/git-messenger-20160815.1952/git-messenger-autoloads.el
Normal file
22
elpa/git-messenger-20160815.1952/git-messenger-autoloads.el
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
;;; git-messenger-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil "git-messenger" "git-messenger.el" (22500 1788
|
||||||
|
;;;;;; 424035 61000))
|
||||||
|
;;; Generated autoloads from git-messenger.el
|
||||||
|
|
||||||
|
(autoload 'git-messenger:popup-message "git-messenger" "\
|
||||||
|
|
||||||
|
|
||||||
|
\(fn)" t nil)
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; git-messenger-autoloads.el ends here
|
1
elpa/git-messenger-20160815.1952/git-messenger-pkg.el
Normal file
1
elpa/git-messenger-20160815.1952/git-messenger-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "git-messenger" "20160815.1952" "Pop up last commit information of current line" '((popup "0.5.0") (cl-lib "0.5")) :url "https://github.com/syohex/emacs-git-messenger")
|
406
elpa/git-messenger-20160815.1952/git-messenger.el
Normal file
406
elpa/git-messenger-20160815.1952/git-messenger.el
Normal file
@ -0,0 +1,406 @@
|
|||||||
|
;;; git-messenger.el --- Pop up last commit information of current line
|
||||||
|
|
||||||
|
;; Copyright (C) 2016 by Syohei YOSHIDA
|
||||||
|
|
||||||
|
;; Author: Syohei YOSHIDA <syohex@gmail.com>
|
||||||
|
;; URL: https://github.com/syohex/emacs-git-messenger
|
||||||
|
;; Package-Version: 20160815.1952
|
||||||
|
;; Version: 0.17
|
||||||
|
;; Package-Requires: ((popup "0.5.0") (cl-lib "0.5"))
|
||||||
|
|
||||||
|
;; 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:
|
||||||
|
|
||||||
|
;; This package provides a function called git-messenger:popup-message
|
||||||
|
;; that when called will pop-up the last git commit message for the
|
||||||
|
;; current line. This uses the git-blame tool internally.
|
||||||
|
;;
|
||||||
|
;; Example usage:
|
||||||
|
;; (require 'git-messenger)
|
||||||
|
;; (global-set-key (kbd "C-x v p") 'git-messenger:popup-message)
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'popup)
|
||||||
|
|
||||||
|
(defgroup git-messenger nil
|
||||||
|
"git messenger"
|
||||||
|
:group 'vc)
|
||||||
|
|
||||||
|
(defcustom git-messenger:show-detail nil
|
||||||
|
"Pop up commit ID and author name too"
|
||||||
|
:type 'boolean)
|
||||||
|
|
||||||
|
(defcustom git-messenger:before-popup-hook nil
|
||||||
|
"Hook run before popup commit message. This hook is taken popup-ed message"
|
||||||
|
:type 'hook)
|
||||||
|
|
||||||
|
(defcustom git-messenger:after-popup-hook nil
|
||||||
|
"Hook run after popup commit message. This hook is taken popup-ed message"
|
||||||
|
:type 'hook)
|
||||||
|
|
||||||
|
(defcustom git-messenger:popup-buffer-hook nil
|
||||||
|
"Hook run after popup buffer(popup diff, popup show etc)"
|
||||||
|
:type 'hook)
|
||||||
|
|
||||||
|
(defcustom git-messenger:handled-backends '(git svn hg)
|
||||||
|
"List of version control backends for which `git-messenger' will be used.
|
||||||
|
Entries in this list will be tried in order to determine whether a
|
||||||
|
file is under that sort of version control."
|
||||||
|
:type '(repeat symbol))
|
||||||
|
|
||||||
|
(defvar git-messenger:last-message nil
|
||||||
|
"Last message displayed by git-messenger.
|
||||||
|
|
||||||
|
This is set before the pop-up is displayed so accessible in the hooks
|
||||||
|
and menus.")
|
||||||
|
|
||||||
|
(defvar git-messenger:last-commit-id nil
|
||||||
|
"Last commit id for the last message displayed.
|
||||||
|
|
||||||
|
This is set before the pop-up is displayed so accessible in the hooks
|
||||||
|
and menus.")
|
||||||
|
|
||||||
|
(defvar git-messenger:vcs nil)
|
||||||
|
|
||||||
|
(defconst git-messenger:directory-of-vcs
|
||||||
|
'((git . ".git")
|
||||||
|
(svn . ".svn")
|
||||||
|
(hg . ".hg")))
|
||||||
|
|
||||||
|
(defun git-messenger:blame-arguments (vcs file line)
|
||||||
|
(let ((basename (file-name-nondirectory file)))
|
||||||
|
(cl-case vcs
|
||||||
|
(git (list "--no-pager" "blame" "-w" "-L"
|
||||||
|
(format "%d,+1" line)
|
||||||
|
"--porcelain" basename))
|
||||||
|
(svn (list "blame" basename))
|
||||||
|
(hg (list "blame" "-wuc" basename)))))
|
||||||
|
|
||||||
|
(defsubst git-messenger:cat-file-arguments (commit-id)
|
||||||
|
(list "--no-pager" "cat-file" "commit" commit-id))
|
||||||
|
|
||||||
|
(defsubst git-messenger:vcs-command (vcs)
|
||||||
|
(cl-case vcs
|
||||||
|
(git "git")
|
||||||
|
(svn "svn")
|
||||||
|
(hg "hg")))
|
||||||
|
|
||||||
|
(defun git-messenger:execute-command (vcs args output)
|
||||||
|
(cl-case vcs
|
||||||
|
(git (apply 'process-file "git" nil output nil args))
|
||||||
|
(svn
|
||||||
|
(let ((process-environment (cons "LANG=C" process-environment)))
|
||||||
|
(apply 'process-file "svn" nil output nil args)))
|
||||||
|
(hg
|
||||||
|
(let ((process-environment (cons
|
||||||
|
"HGPLAIN=1"
|
||||||
|
(cons "LANG=utf-8" process-environment))))
|
||||||
|
(apply 'process-file "hg" nil output nil args)))))
|
||||||
|
|
||||||
|
(defun git-messenger:git-commit-info-at-line ()
|
||||||
|
(let* ((id-line (buffer-substring-no-properties
|
||||||
|
(line-beginning-position) (line-end-position)))
|
||||||
|
(commit-id (car (split-string id-line)))
|
||||||
|
(author (if (re-search-forward "^author \\(.+\\)$" nil t)
|
||||||
|
(match-string-no-properties 1)
|
||||||
|
"unknown")))
|
||||||
|
(cons commit-id author)))
|
||||||
|
|
||||||
|
(defun git-messenger:hg-commit-info-at-line (line)
|
||||||
|
(forward-line (1- line))
|
||||||
|
(if (looking-at "^\\s-*\\(\\S-+\\)\\s-+\\([a-z0-9]+\\)")
|
||||||
|
(cons (match-string-no-properties 2) (match-string-no-properties 1))
|
||||||
|
(cons "-" "-")))
|
||||||
|
|
||||||
|
(defun git-messenger:svn-commit-info-at-line (line)
|
||||||
|
(forward-line (1- line))
|
||||||
|
(if (looking-at "^\\s-*\\([0-9]+\\)\\s-+\\(\\S-+\\)")
|
||||||
|
(cons (match-string-no-properties 1) (match-string-no-properties 2))
|
||||||
|
(cons "-" "-")))
|
||||||
|
|
||||||
|
(defun git-messenger:commit-info-at-line (vcs file line)
|
||||||
|
(with-temp-buffer
|
||||||
|
(let ((args (git-messenger:blame-arguments vcs file line)))
|
||||||
|
(unless (zerop (git-messenger:execute-command vcs args t))
|
||||||
|
(error "Failed: '%s blame'" (git-messenger:vcs-command vcs)))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(cl-case vcs
|
||||||
|
(git (git-messenger:git-commit-info-at-line))
|
||||||
|
(svn (git-messenger:svn-commit-info-at-line line))
|
||||||
|
(hg (git-messenger:hg-commit-info-at-line line))))))
|
||||||
|
|
||||||
|
(defsubst git-messenger:not-committed-id-p (commit-id)
|
||||||
|
(or (string-match-p "\\`\\(?:0+\\|-\\)\\'" commit-id)))
|
||||||
|
|
||||||
|
(defun git-messenger:git-commit-message (commit-id)
|
||||||
|
(let ((args (git-messenger:cat-file-arguments commit-id)))
|
||||||
|
(unless (zerop (git-messenger:execute-command 'git args t))
|
||||||
|
(error "Failed: 'git cat-file'"))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(forward-paragraph)
|
||||||
|
(buffer-substring-no-properties (point) (point-max))))
|
||||||
|
|
||||||
|
(defun git-messenger:hg-commit-message (commit-id)
|
||||||
|
(let ((args (list "log" "-T" "{desc}" "-r" commit-id)))
|
||||||
|
(unless (zerop (git-messenger:execute-command 'hg args t))
|
||||||
|
(error "Failed: 'hg log"))
|
||||||
|
(buffer-substring-no-properties (point-min) (point-max))))
|
||||||
|
|
||||||
|
(defun git-messenger:svn-commit-message (commit-id)
|
||||||
|
(let ((args (list "log" "-c" commit-id)))
|
||||||
|
(unless (zerop (git-messenger:execute-command 'svn args t))
|
||||||
|
(error "Failed: 'svn log"))
|
||||||
|
(let (end)
|
||||||
|
(goto-char (point-max))
|
||||||
|
(when (re-search-backward "^-\\{25\\}" nil t)
|
||||||
|
(setq end (point)))
|
||||||
|
(buffer-substring-no-properties (point-min) (or end (point-max))))))
|
||||||
|
|
||||||
|
(defun git-messenger:commit-message (vcs commit-id)
|
||||||
|
(with-temp-buffer
|
||||||
|
(if (git-messenger:not-committed-id-p commit-id)
|
||||||
|
"* not yet committed *"
|
||||||
|
(cl-case vcs
|
||||||
|
(git (git-messenger:git-commit-message commit-id))
|
||||||
|
(svn (git-messenger:svn-commit-message commit-id))
|
||||||
|
(hg (git-messenger:hg-commit-message commit-id))))))
|
||||||
|
|
||||||
|
(defun git-messenger:commit-date (commit-id)
|
||||||
|
(let ((args (list "--no-pager" "show" "--pretty=%cd" commit-id)))
|
||||||
|
(with-temp-buffer
|
||||||
|
(unless (zerop (git-messenger:execute-command 'git args t))
|
||||||
|
(error "Failed 'git show'"))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(buffer-substring-no-properties
|
||||||
|
(line-beginning-position) (line-end-position)))))
|
||||||
|
|
||||||
|
(defun git-messenger:hg-commit-date (commit-id)
|
||||||
|
(let ((args (list "log" "-T" "{date|rfc822date}" "-r" commit-id)))
|
||||||
|
(with-temp-buffer
|
||||||
|
(unless (zerop (git-messenger:execute-command 'hg args t))
|
||||||
|
(error "Failed 'hg log'"))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(buffer-substring-no-properties
|
||||||
|
(line-beginning-position) (line-end-position)))))
|
||||||
|
|
||||||
|
(defun git-messenger:format-detail (vcs commit-id author message)
|
||||||
|
(cl-case vcs
|
||||||
|
(git (let ((date (git-messenger:commit-date commit-id)))
|
||||||
|
(format "commit : %s \nAuthor : %s\nDate : %s \n%s"
|
||||||
|
(substring commit-id 0 8) author date message)))
|
||||||
|
(hg (let ((date (git-messenger:hg-commit-date commit-id)))
|
||||||
|
(format "commit : %s \nAuthor : %s\nDate : %s \n%s"
|
||||||
|
commit-id author date message)))
|
||||||
|
(svn (with-temp-buffer
|
||||||
|
(insert message)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(forward-line 1)
|
||||||
|
(let ((line (buffer-substring-no-properties (point) (line-end-position)))
|
||||||
|
(re "^\\s-*\\(?:r[0-9]+\\)\\s-+|\\s-+\\([^|]+\\)|\\s-+\\([^|]+\\)"))
|
||||||
|
(unless (string-match re line)
|
||||||
|
(error "Can't get revision %s" line))
|
||||||
|
(let ((author (match-string-no-properties 1 line))
|
||||||
|
(date (match-string-no-properties 2 line)))
|
||||||
|
(forward-paragraph)
|
||||||
|
(format "commit : r%s \nAuthor : %s\nDate : %s\n%s"
|
||||||
|
commit-id author date
|
||||||
|
(buffer-substring-no-properties (point) (point-max)))))))))
|
||||||
|
|
||||||
|
(defun git-messenger:show-detail-p (commit-id)
|
||||||
|
(and (or git-messenger:show-detail current-prefix-arg)
|
||||||
|
(not (git-messenger:not-committed-id-p commit-id))))
|
||||||
|
|
||||||
|
(defun git-messenger:popup-close ()
|
||||||
|
(interactive)
|
||||||
|
(throw 'git-messenger-loop t))
|
||||||
|
|
||||||
|
(defun git-messenger:copy-message ()
|
||||||
|
"Copy current displayed commit message to kill-ring."
|
||||||
|
(interactive)
|
||||||
|
(when git-messenger:last-message
|
||||||
|
(kill-new git-messenger:last-message))
|
||||||
|
(git-messenger:popup-close))
|
||||||
|
|
||||||
|
(defun git-messenger:copy-commit-id ()
|
||||||
|
"Copy current displayed commit id to kill-ring."
|
||||||
|
(interactive)
|
||||||
|
(when git-messenger:last-commit-id
|
||||||
|
(kill-new git-messenger:last-commit-id))
|
||||||
|
(git-messenger:popup-close))
|
||||||
|
|
||||||
|
(defun git-messenger:popup-common (vcs args &optional mode)
|
||||||
|
(with-current-buffer (get-buffer-create "*git-messenger*")
|
||||||
|
(view-mode -1)
|
||||||
|
(fundamental-mode)
|
||||||
|
(erase-buffer)
|
||||||
|
(unless (zerop (git-messenger:execute-command vcs args t))
|
||||||
|
(error "Failed: '%s(args=%s)'" (git-messenger:vcs-command vcs) args))
|
||||||
|
(pop-to-buffer (current-buffer))
|
||||||
|
(when mode
|
||||||
|
(funcall mode))
|
||||||
|
(run-hooks 'git-messenger:popup-buffer-hook)
|
||||||
|
(view-mode +1)
|
||||||
|
(goto-char (point-min)))
|
||||||
|
(git-messenger:popup-close))
|
||||||
|
|
||||||
|
(defun git-messenger:popup-svn-show ()
|
||||||
|
(git-messenger:popup-common
|
||||||
|
'svn (list "diff" "-c" git-messenger:last-commit-id) 'diff-mode))
|
||||||
|
|
||||||
|
(defun git-messenger:popup-hg-show ()
|
||||||
|
(git-messenger:popup-common
|
||||||
|
'hg (list "diff" "-c" git-messenger:last-commit-id) 'diff-mode))
|
||||||
|
|
||||||
|
(defun git-messenger:popup-diff ()
|
||||||
|
(interactive)
|
||||||
|
(cl-case git-messenger:vcs
|
||||||
|
(git (let ((args (list "--no-pager" "diff" "--no-ext-diff"
|
||||||
|
(concat git-messenger:last-commit-id "^!"))))
|
||||||
|
(git-messenger:popup-common 'git args 'diff-mode)))
|
||||||
|
(svn (git-messenger:popup-svn-show))
|
||||||
|
(hg (git-messenger:popup-hg-show))))
|
||||||
|
|
||||||
|
(defun git-messenger:popup-show ()
|
||||||
|
(interactive)
|
||||||
|
(cl-case git-messenger:vcs
|
||||||
|
(git (let ((args (list "--no-pager" "show" "--no-ext-diff" "--stat"
|
||||||
|
git-messenger:last-commit-id)))
|
||||||
|
(git-messenger:popup-common 'git args)))
|
||||||
|
(svn (git-messenger:popup-svn-show))
|
||||||
|
(hg (let ((args (list "log" "--stat" "-r"
|
||||||
|
git-messenger:last-commit-id)))
|
||||||
|
(git-messenger:popup-common 'hg args)))))
|
||||||
|
|
||||||
|
(defun git-messenger:popup-show-verbose ()
|
||||||
|
(interactive)
|
||||||
|
(cl-case git-messenger:vcs
|
||||||
|
(git (let ((args (list "--no-pager" "show" "--no-ext-diff" "--stat" "-p"
|
||||||
|
git-messenger:last-commit-id)))
|
||||||
|
(git-messenger:popup-common 'git args)))
|
||||||
|
(svn (error "'svn' does not support `popup-show-verbose'"))
|
||||||
|
(hg (let ((args (list "log" "-p" "--stat" "-r"
|
||||||
|
git-messenger:last-commit-id)))
|
||||||
|
(git-messenger:popup-common 'hg args)))))
|
||||||
|
|
||||||
|
(defvar git-messenger-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
;; key bindings
|
||||||
|
(define-key map (kbd "q") 'git-messenger:popup-close)
|
||||||
|
(define-key map (kbd "c") 'git-messenger:copy-commit-id)
|
||||||
|
(define-key map (kbd "d") 'git-messenger:popup-diff)
|
||||||
|
(define-key map (kbd "s") 'git-messenger:popup-show)
|
||||||
|
(define-key map (kbd "S") 'git-messenger:popup-show-verbose)
|
||||||
|
(define-key map (kbd "M-w") 'git-messenger:copy-message)
|
||||||
|
(define-key map (kbd ",") 'git-messenger:show-parent)
|
||||||
|
map)
|
||||||
|
"Key mappings of git-messenger. This is enabled when commit message is popup-ed.")
|
||||||
|
|
||||||
|
(defun git-messenger:find-vcs ()
|
||||||
|
(let ((longest 0)
|
||||||
|
result)
|
||||||
|
(dolist (vcs git-messenger:handled-backends result)
|
||||||
|
(let* ((dir (assoc-default vcs git-messenger:directory-of-vcs))
|
||||||
|
(vcs-root (locate-dominating-file default-directory dir)))
|
||||||
|
(when (and vcs-root (> (length vcs-root) longest))
|
||||||
|
(setq longest (length vcs-root)
|
||||||
|
result vcs))))))
|
||||||
|
|
||||||
|
(defun git-messenger:svn-message (msg)
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert msg)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(forward-paragraph)
|
||||||
|
(buffer-substring-no-properties (point) (point-max))))
|
||||||
|
|
||||||
|
(defvar git-messenger:func-prompt
|
||||||
|
'((git-messenger:popup-show . "Show")
|
||||||
|
(git-messenger:popup-show-verbose . "Show verbose")
|
||||||
|
(git-messenger:popup-close . "Close")
|
||||||
|
(git-messenger:copy-commit-id . "Copy hash")
|
||||||
|
(git-messenger:popup-diff . "Diff")
|
||||||
|
(git-messenger:copy-message . "Copy message")
|
||||||
|
(git-messenger:show-parent . "Go Parent")
|
||||||
|
(git-messenger:popup-close . "Quit")))
|
||||||
|
|
||||||
|
(defsubst git-messenger:function-to-key (func)
|
||||||
|
(key-description (car-safe (where-is-internal func git-messenger-map))))
|
||||||
|
|
||||||
|
(defun git-messenger:prompt ()
|
||||||
|
(mapconcat (lambda (fp)
|
||||||
|
(let ((key (git-messenger:function-to-key (car fp))))
|
||||||
|
(format "[%s]%s" key (cdr fp))))
|
||||||
|
git-messenger:func-prompt " "))
|
||||||
|
|
||||||
|
(defun git-messenger:show-parent ()
|
||||||
|
(interactive)
|
||||||
|
(let ((file (buffer-file-name (buffer-base-buffer))))
|
||||||
|
(cl-case git-messenger:vcs
|
||||||
|
(git (with-temp-buffer
|
||||||
|
(unless (zerop (process-file "git" nil t nil
|
||||||
|
"blame" "--increment" git-messenger:last-commit-id "--" file))
|
||||||
|
(error "No parent commit ID"))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(when (re-search-forward (concat "^" git-messenger:last-commit-id) nil t)
|
||||||
|
(when (re-search-forward "previous \\(\\S-+\\)" nil t)
|
||||||
|
(let ((parent (match-string-no-properties 1)))
|
||||||
|
(setq git-messenger:last-commit-id parent
|
||||||
|
git-messenger:last-message (git-messenger:commit-message 'git parent)))))
|
||||||
|
(throw 'git-messenger-loop nil)))
|
||||||
|
(otherwise (error "%s does not support for getting parent commit ID" git-messenger:vcs)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun git-messenger:popup-message ()
|
||||||
|
(interactive)
|
||||||
|
(let* ((vcs (git-messenger:find-vcs))
|
||||||
|
(file (buffer-file-name (buffer-base-buffer)))
|
||||||
|
(line (line-number-at-pos))
|
||||||
|
(commit-info (git-messenger:commit-info-at-line vcs file line))
|
||||||
|
(commit-id (car commit-info))
|
||||||
|
(author (cdr commit-info))
|
||||||
|
(msg (git-messenger:commit-message vcs commit-id))
|
||||||
|
(popuped-message (if (git-messenger:show-detail-p commit-id)
|
||||||
|
(git-messenger:format-detail vcs commit-id author msg)
|
||||||
|
(cl-case vcs
|
||||||
|
(git msg)
|
||||||
|
(svn (if (string= commit-id "-")
|
||||||
|
msg
|
||||||
|
(git-messenger:svn-message msg)))
|
||||||
|
(hg msg)))))
|
||||||
|
(setq git-messenger:vcs vcs
|
||||||
|
git-messenger:last-message popuped-message
|
||||||
|
git-messenger:last-commit-id commit-id)
|
||||||
|
(let (finish)
|
||||||
|
(run-hook-with-args 'git-messenger:before-popup-hook popuped-message)
|
||||||
|
(while (not finish)
|
||||||
|
(let ((menu (popup-tip git-messenger:last-message :nowait t)))
|
||||||
|
(unwind-protect
|
||||||
|
(setq finish (catch 'git-messenger-loop
|
||||||
|
(popup-menu-event-loop menu git-messenger-map 'popup-menu-fallback
|
||||||
|
:prompt (git-messenger:prompt))
|
||||||
|
t))
|
||||||
|
(popup-delete menu)))))
|
||||||
|
(run-hook-with-args 'git-messenger:after-popup-hook popuped-message)))
|
||||||
|
|
||||||
|
(provide 'git-messenger)
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; coding: utf-8
|
||||||
|
;; indent-tabs-mode: nil
|
||||||
|
;; End:
|
||||||
|
|
||||||
|
;;; git-messenger.el ends here
|
15
elpa/gitconfig-20130718.235/gitconfig-autoloads.el
Normal file
15
elpa/gitconfig-20130718.235/gitconfig-autoloads.el
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
;;; gitconfig-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil nil ("gitconfig.el") (22500 1787 601913 796000))
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; gitconfig-autoloads.el ends here
|
1
elpa/gitconfig-20130718.235/gitconfig-pkg.el
Normal file
1
elpa/gitconfig-20130718.235/gitconfig-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "gitconfig" "20130718.235" "Emacs lisp interface to work with git-config variables" 'nil :keywords '("git" "gitconfig" "git-config"))
|
228
elpa/gitconfig-20130718.235/gitconfig.el
Normal file
228
elpa/gitconfig-20130718.235/gitconfig.el
Normal file
@ -0,0 +1,228 @@
|
|||||||
|
;;; gitconfig.el --- Emacs lisp interface to work with git-config variables
|
||||||
|
;;
|
||||||
|
;; Filename: gitconfig.el
|
||||||
|
;; Description: Emacs lisp interface to work with git-config variables
|
||||||
|
;; Author: Samuel Tonini
|
||||||
|
;; Maintainer: Samuel Tonini
|
||||||
|
;; Version: 1.0.0
|
||||||
|
;; Package-Version: 20130718.235
|
||||||
|
;; URL:
|
||||||
|
;; Keywords: git, gitconfig, git-config
|
||||||
|
|
||||||
|
;; 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, 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; see the file COPYING. If not, write to
|
||||||
|
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||||||
|
;; Floor, Boston, MA 02110-1301, USA.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; Manual Installation:
|
||||||
|
;;
|
||||||
|
;; (add-to-list 'load-path "~/path/to/gitconfig.el/")
|
||||||
|
;; (require 'gitconfig)
|
||||||
|
;;
|
||||||
|
;; Interesting variables are:
|
||||||
|
;;
|
||||||
|
;; `gitconfig-git-command'
|
||||||
|
;;
|
||||||
|
;; The shell command for <git>
|
||||||
|
;;
|
||||||
|
;; `gitconfig-buffer-name'
|
||||||
|
;;
|
||||||
|
;; Name of the <git> output buffer.
|
||||||
|
;;
|
||||||
|
;; Interactive functions are:
|
||||||
|
;;
|
||||||
|
;; M-x gitconfig-execute-command
|
||||||
|
;;
|
||||||
|
;; Run <git config> with custom ARGUMENTS and display it in `gitconfig-buffer-name'
|
||||||
|
;;
|
||||||
|
;; Non-Interactive functions are:
|
||||||
|
;;
|
||||||
|
;; `gitconfig-current-inside-git-repository-p'
|
||||||
|
;;
|
||||||
|
;; Return t if `default-directory' is a git repository
|
||||||
|
;;
|
||||||
|
;; `gitconfig-path-to-git-repository'
|
||||||
|
;;
|
||||||
|
;; Return the absolute path of the current git repository
|
||||||
|
;;
|
||||||
|
;; `gitconfig-get-variables'
|
||||||
|
;;
|
||||||
|
;; Get all variables for the given LOCATION
|
||||||
|
;; and return it as a hash table
|
||||||
|
;;
|
||||||
|
;; `gitconfig-set-variable'
|
||||||
|
;;
|
||||||
|
;; Set a specific LOCATION variable with a given NAME and VALUE
|
||||||
|
;;
|
||||||
|
;; `gitconfig-get-variable'
|
||||||
|
;;
|
||||||
|
;; Return a specific LOCATION variable for the given NAME
|
||||||
|
;;
|
||||||
|
;; `gitconfig-delete-variable'
|
||||||
|
;;
|
||||||
|
;; Delete a specific LOCATION variable for the given NAME
|
||||||
|
;;
|
||||||
|
;; `gitconfig-get-local-variables'
|
||||||
|
;;
|
||||||
|
;; Return all <git config --local --list> variables as hash table
|
||||||
|
;;
|
||||||
|
;; `gitconfig-get-global-variables'
|
||||||
|
;;
|
||||||
|
;; Return all <git config --global --list> variables as hash table
|
||||||
|
;;
|
||||||
|
;; `gitconfig-get-system-variables'
|
||||||
|
;;
|
||||||
|
;; Return all <git config --system --list> variables as hash table
|
||||||
|
;;
|
||||||
|
;; `gitconfig-get-local-variable'
|
||||||
|
;;
|
||||||
|
;; Return a specific <git config --local --list> variable by the given NAME
|
||||||
|
;;
|
||||||
|
;; `gitconfig-get-global-variable'
|
||||||
|
;;
|
||||||
|
;; Return a specific <git config --global --list> variable by the given NAME
|
||||||
|
;;
|
||||||
|
;; `gitconfig-get-system-variable'
|
||||||
|
;;
|
||||||
|
;; Return a specific <git config --system --list> variable by the given NAME
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(defcustom gitconfig-git-command "git"
|
||||||
|
"The shell command for git"
|
||||||
|
:type 'string
|
||||||
|
:group 'gitconfig)
|
||||||
|
|
||||||
|
(defvar gitconfig-buffer-name "*GITCONFIG*"
|
||||||
|
"Name of the git output buffer.")
|
||||||
|
|
||||||
|
(defun gitconfig--get-keys (hash)
|
||||||
|
"Return all keys for given HASH"
|
||||||
|
(let (keys)
|
||||||
|
(maphash (lambda (key value) (setq keys (cons key keys))) hash)
|
||||||
|
keys))
|
||||||
|
|
||||||
|
(defun gitconfig--get-buffer (name)
|
||||||
|
"Get and kills a buffer if exists and returns a new one."
|
||||||
|
(let ((buffer (get-buffer name)))
|
||||||
|
(when buffer (kill-buffer buffer))
|
||||||
|
(generate-new-buffer name)))
|
||||||
|
|
||||||
|
(defun gitconfig--buffer-setup (buffer)
|
||||||
|
"Setup the gitconfig buffer before display."
|
||||||
|
(display-buffer buffer)
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(setq buffer-read-only nil)
|
||||||
|
(local-set-key "q" 'quit-window)))
|
||||||
|
|
||||||
|
(defun gitconfig-current-inside-git-repository-p ()
|
||||||
|
"Return t if the `default-directory' is a <git> repository"
|
||||||
|
(let ((inside-work-tree (shell-command-to-string
|
||||||
|
(format "%s rev-parse --is-inside-work-tree"
|
||||||
|
gitconfig-git-command))))
|
||||||
|
(string= (replace-regexp-in-string "\n" "" inside-work-tree nil t) "true")))
|
||||||
|
|
||||||
|
(defun gitconfig-path-to-git-repository ()
|
||||||
|
"Return the absolute path of the current git repository"
|
||||||
|
(let ((path-to-git-repo (shell-command-to-string
|
||||||
|
(format "%s rev-parse --show-toplevel"
|
||||||
|
gitconfig-git-command))))
|
||||||
|
(replace-regexp-in-string "\n" "" path-to-git-repo nil t)))
|
||||||
|
|
||||||
|
(defun gitconfig--execute-command (arguments)
|
||||||
|
(unless (gitconfig-current-inside-git-repository-p)
|
||||||
|
(user-error "Fatal: Not a git repository (or any of the parent directories): .git"))
|
||||||
|
(shell-command-to-string (format "%s config %s" gitconfig-git-command arguments)))
|
||||||
|
|
||||||
|
(defun gitconfig-get-variables (location)
|
||||||
|
"Get all variables for the given LOCATION and return it as a hash table"
|
||||||
|
(let ((config-string (gitconfig--execute-command (format "--%s --list" location)))
|
||||||
|
(variable-hash (make-hash-table :test 'equal)))
|
||||||
|
(setq config-string (split-string config-string "\n"))
|
||||||
|
(delete "" config-string)
|
||||||
|
(mapcar (lambda (x) (puthash (car (split-string x "="))
|
||||||
|
(car (last (split-string x "=")))
|
||||||
|
variable-hash)) config-string)
|
||||||
|
variable-hash))
|
||||||
|
|
||||||
|
(defun gitconfig-set-variable (location name value)
|
||||||
|
"Set a specific LOCATION variable with a given NAME and VALUE"
|
||||||
|
(unless (gitconfig-current-inside-git-repository-p)
|
||||||
|
(user-error "Fatal: Not a git repository (or any of the parent directories): .git"))
|
||||||
|
(let ((exit-status (shell-command
|
||||||
|
(format "%s config --%s --replace-all %s %s"
|
||||||
|
gitconfig-git-command location name value))))
|
||||||
|
(unless (= exit-status 0)
|
||||||
|
(user-error (format "Error: key does not contain a section: %s" name)))
|
||||||
|
t))
|
||||||
|
|
||||||
|
(defun gitconfig-get-variable (location name)
|
||||||
|
"Return a specific LOCATION variable for the given NAME"
|
||||||
|
(when (string= name "")
|
||||||
|
(user-error "Error: variable does not exist."))
|
||||||
|
(let ((variable (gitconfig--execute-command (format "--%s --get %s" location name))))
|
||||||
|
(when (string-match "^error: " variable)
|
||||||
|
(user-error variable))
|
||||||
|
(if (string-match "\n+" variable)
|
||||||
|
(replace-match "" t t variable)
|
||||||
|
variable)))
|
||||||
|
|
||||||
|
(defun gitconfig-delete-variable (location name)
|
||||||
|
"Delete a specific LOCATION variable for the given NAME"
|
||||||
|
(unless (gitconfig-current-inside-git-repository-p)
|
||||||
|
(user-error "Fatal: Not a git repository (or any of the parent directories): .git"))
|
||||||
|
(let ((exit-status (shell-command
|
||||||
|
(format "%s config --%s --unset-all %s"
|
||||||
|
gitconfig-git-command location name))))
|
||||||
|
(unless (= exit-status 0)
|
||||||
|
(user-error (format "Error: key does not contain a section: %s" name)))
|
||||||
|
t))
|
||||||
|
|
||||||
|
(defun gitconfig-execute-command (arguments)
|
||||||
|
"Run <git config> with custom ARGUMENTS and display it in buffer"
|
||||||
|
(interactive "Mgit config: ")
|
||||||
|
(let ((buffer (gitconfig--get-buffer gitconfig-buffer-name)))
|
||||||
|
(shell-command (format "%s config %s" gitconfig-git-command arguments) buffer)
|
||||||
|
(gitconfig--buffer-setup buffer)))
|
||||||
|
|
||||||
|
(defun gitconfig-get-local-variables ()
|
||||||
|
"Return all <git config --local --list> variables as hash table"
|
||||||
|
(gitconfig-get-variables "local"))
|
||||||
|
|
||||||
|
(defun gitconfig-get-global-variables ()
|
||||||
|
"Return all <git config --global --list> variables as hash table"
|
||||||
|
(gitconfig-get-variables "global"))
|
||||||
|
|
||||||
|
(defun gitconfig-get-system-variables ()
|
||||||
|
"Return all <git config --system --list> variables as hash table"
|
||||||
|
(gitconfig-get-variables "system"))
|
||||||
|
|
||||||
|
(defun gitconfig-get-local-variable (name)
|
||||||
|
"Return a specific <git config --local --list> variable by the given NAME"
|
||||||
|
(gitconfig-get-variable "local" name))
|
||||||
|
|
||||||
|
(defun gitconfig-get-global-variable (name)
|
||||||
|
"Return a specific <git config --global --list> variable by the given NAME"
|
||||||
|
(gitconfig-get-variable "global" name))
|
||||||
|
|
||||||
|
(defun gitconfig-get-system-variable (name)
|
||||||
|
"Return a specific <git config --system --list> variable by the given NAME"
|
||||||
|
(gitconfig-get-variable "system" name))
|
||||||
|
|
||||||
|
(provide 'gitconfig)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;;; gitconfig.el ends here
|
@ -0,0 +1,36 @@
|
|||||||
|
;;; github-notifier-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil "github-notifier" "github-notifier.el" (22500
|
||||||
|
;;;;;; 1786 648025 550000))
|
||||||
|
;;; Generated autoloads from github-notifier.el
|
||||||
|
|
||||||
|
(defalias 'github-notifier 'github-notifier-mode)
|
||||||
|
|
||||||
|
(defvar github-notifier-mode nil "\
|
||||||
|
Non-nil if Github-Notifier mode is enabled.
|
||||||
|
See the command `github-notifier-mode' 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 `github-notifier-mode'.")
|
||||||
|
|
||||||
|
(custom-autoload 'github-notifier-mode "github-notifier" nil)
|
||||||
|
|
||||||
|
(autoload 'github-notifier-mode "github-notifier" "\
|
||||||
|
Toggle github notifications count display in mode line (Github Notifier mode).
|
||||||
|
With a prefix argument ARG, enable Github Notifier mode if ARG is
|
||||||
|
positive, and disable it otherwise. If called from Lisp, enable
|
||||||
|
the mode if ARG is omitted or nil.
|
||||||
|
|
||||||
|
\(fn &optional ARG)" t nil)
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; github-notifier-autoloads.el ends here
|
@ -0,0 +1 @@
|
|||||||
|
(define-package "github-notifier" "20160702.2112" "Displays your GitHub notifications unread count in mode-line" '((emacs "24")) :url "https://github.com/xuchunyang/github-notifier.el" :keywords '("github" "mode-line"))
|
243
elpa/github-notifier-20160702.2112/github-notifier.el
Normal file
243
elpa/github-notifier-20160702.2112/github-notifier.el
Normal file
@ -0,0 +1,243 @@
|
|||||||
|
;;; github-notifier.el --- Displays your GitHub notifications unread count in mode-line -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2015, 2016 Chunyang Xu
|
||||||
|
|
||||||
|
;; Author: Chunyang Xu <xuchunyang56@gmail.com>
|
||||||
|
;; URL: https://github.com/xuchunyang/github-notifier.el
|
||||||
|
;; Package-Version: 20160702.2112
|
||||||
|
;; Package-Requires: ((emacs "24"))
|
||||||
|
;; Keywords: github, mode-line
|
||||||
|
;; Version: 0.1
|
||||||
|
|
||||||
|
;; 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:
|
||||||
|
|
||||||
|
;; This is a global minor-mode. Turn it on everywhere with:
|
||||||
|
;;
|
||||||
|
;; M-x github-notifier-mode
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'url)
|
||||||
|
(require 'json)
|
||||||
|
|
||||||
|
(defgroup github-notifier nil
|
||||||
|
"Github Notifier"
|
||||||
|
:group 'emacs)
|
||||||
|
|
||||||
|
;;; Custom
|
||||||
|
(defcustom github-notifier-token nil
|
||||||
|
"Access token to get Github Notifications.
|
||||||
|
|
||||||
|
To generate an access token, visit
|
||||||
|
URL `https://github.com/settings/tokens/new?scopes=notifications&description=github-notifier.el'
|
||||||
|
|
||||||
|
This is similar to how erc or jabber handle authentication in
|
||||||
|
emacs, but the following disclaimer always worth reminding.
|
||||||
|
|
||||||
|
DISCLAIMER
|
||||||
|
When you save this variable, DON'T WRITE IT ANYWHERE PUBLIC. This
|
||||||
|
token grants (very) limited access to your account.
|
||||||
|
END DISCLAIMER
|
||||||
|
|
||||||
|
If nil, Github-Notifier will ask you and remember your token via
|
||||||
|
`customize-save-variable'."
|
||||||
|
:type '(choice (string :tag "Token")
|
||||||
|
(const :tag "Ask me" nil))
|
||||||
|
:group 'github-notifier)
|
||||||
|
|
||||||
|
(defcustom github-notifier-mode-line
|
||||||
|
'(:eval
|
||||||
|
(let (unread-text help-text)
|
||||||
|
(cond ((null github-notifier-unread-count)
|
||||||
|
(setq unread-text "-?"
|
||||||
|
help-text "The Github notifications number is unknown."))
|
||||||
|
((zerop github-notifier-unread-count)
|
||||||
|
(setq unread-text ""
|
||||||
|
help-text "Good job, you don't have unread notification."))
|
||||||
|
(t
|
||||||
|
(setq unread-text (format "-%d%s" github-notifier-unread-count
|
||||||
|
(if (github-notifier-notifications-checked) "*" ""))
|
||||||
|
help-text (if (= github-notifier-unread-count 1)
|
||||||
|
"You have 1 unread notification.\nmouse-1 Read it on Github."
|
||||||
|
(format "You have %d unread notifications.\nmouse-1 Read them on Github."
|
||||||
|
github-notifier-unread-count)))))
|
||||||
|
(propertize (concat " GH" unread-text)
|
||||||
|
'help-echo help-text
|
||||||
|
'local-map github-notifier-mode-line-map
|
||||||
|
'mouse-face 'mode-line-highlight)))
|
||||||
|
"Mode line lighter for Github Notifier."
|
||||||
|
:type 'sexp
|
||||||
|
:risky t
|
||||||
|
:group 'github-notifier)
|
||||||
|
|
||||||
|
(defcustom github-notifier-update-interval 60
|
||||||
|
"Seconds after which the github notifications count will be updated."
|
||||||
|
:type 'integer
|
||||||
|
:group 'github-notifier)
|
||||||
|
|
||||||
|
(defcustom github-notifier-only-participating nil
|
||||||
|
"If non-nil, only counts notifications in which the user is directly participating or mentioned."
|
||||||
|
:type 'boolean
|
||||||
|
:group 'github-notifier)
|
||||||
|
|
||||||
|
(defcustom github-notifier-enterprise-domain nil
|
||||||
|
"Domain to Github installation.
|
||||||
|
Can be overriden to support Enterprise installations"
|
||||||
|
:type 'string
|
||||||
|
:group 'github-notifier)
|
||||||
|
|
||||||
|
;;; Variables
|
||||||
|
(defvar github-notifier-unread-count nil
|
||||||
|
"Github notifications unread count.
|
||||||
|
Normally, this is a number, however, nil means unknown by Emacs.")
|
||||||
|
|
||||||
|
(defvar github-notifier-unread-json nil
|
||||||
|
"JSON object contains latest (to github-notifier) unread notifications.")
|
||||||
|
|
||||||
|
(defvar github-notifier-update-hook nil
|
||||||
|
"Run by `github-notifier-update-cb'.
|
||||||
|
Functions added to this hook takes one argument, the unread
|
||||||
|
notification json object BEFORE updating. Accordingly,
|
||||||
|
`github-notifier-unread-json' stores the unread notification json
|
||||||
|
AFTER updating.")
|
||||||
|
|
||||||
|
(defvar github-notifier-mode-line-map
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map [mode-line mouse-1] 'github-notifier-visit-github)
|
||||||
|
map))
|
||||||
|
|
||||||
|
(defvar github-notifier-last-notification nil)
|
||||||
|
(defvar github-notifier-last-notification-checked nil)
|
||||||
|
(defvar github-notifier-update-timer nil)
|
||||||
|
|
||||||
|
;;; Function
|
||||||
|
(defun github-notifier-get-url (path &optional api-request)
|
||||||
|
"Get URL to Github endpoint.
|
||||||
|
Get a url to PATH on Github or Github enterprise if
|
||||||
|
`github-enterprise-domain' is set. If API-REQUEST is true it
|
||||||
|
will return an API."
|
||||||
|
(let ((url
|
||||||
|
(if github-notifier-enterprise-domain
|
||||||
|
(concat github-notifier-enterprise-domain (when api-request "/api/v3"))
|
||||||
|
(concat (when api-request "api.") "github.com"))))
|
||||||
|
(concat "https://" url path)))
|
||||||
|
|
||||||
|
;; FIXME: Even we use `url-retrieve' to retrieve network asynchronously, Emacs
|
||||||
|
;; still gets blocked frequently (?), especially when the network situation is
|
||||||
|
;; bad, once it blocks Emacs, you have to wait to it gets finised or interrupt
|
||||||
|
;; it by hitting C-g many times. This is very annoying.
|
||||||
|
;;
|
||||||
|
;; Maybe we can try to invoke curl(1) as asynchronous process.
|
||||||
|
(defun github-notifier-update-cb (_status)
|
||||||
|
(set-buffer-multibyte t)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(if (not (string-match "200 OK" (buffer-string)))
|
||||||
|
(progn (message "[github-notifier] Problem connecting to the server")
|
||||||
|
(setq github-notifier-unread-count nil))
|
||||||
|
(re-search-forward "^$" nil 'move)
|
||||||
|
(let (json-str
|
||||||
|
(old-count github-notifier-unread-count)
|
||||||
|
(old-json github-notifier-unread-json))
|
||||||
|
(setq json-str (buffer-substring-no-properties (point) (point-max))
|
||||||
|
github-notifier-unread-json (json-read-from-string json-str))
|
||||||
|
(setq github-notifier-unread-count (length github-notifier-unread-json))
|
||||||
|
(when (> github-notifier-unread-count 0)
|
||||||
|
(setq github-notifier-last-notification (cdr (assoc 'updated_at (elt github-notifier-unread-json 0)))))
|
||||||
|
(unless (and (equal old-count github-notifier-unread-count)
|
||||||
|
(github-notifier-notifications-checked))
|
||||||
|
(force-mode-line-update t))
|
||||||
|
(run-hook-with-args 'github-notifier-update-hook old-json)
|
||||||
|
;; Debug
|
||||||
|
;; (setq a-json-string json-str)
|
||||||
|
;; (message "Github notification %d unread, updated at %s"
|
||||||
|
;; github-notifier-unread-count (current-time-string))
|
||||||
|
))
|
||||||
|
;; Debug
|
||||||
|
;; (display-buffer (current-buffer))
|
||||||
|
(kill-buffer)
|
||||||
|
(when github-notifier-mode
|
||||||
|
(setq github-notifier-update-timer
|
||||||
|
(run-at-time github-notifier-update-interval nil #'github-notifier-update))))
|
||||||
|
|
||||||
|
(defun github-notifier-update (&optional force)
|
||||||
|
"Update `github-notifier-unread-count'."
|
||||||
|
(when (or force github-notifier-mode)
|
||||||
|
(let ((url-request-extra-headers `(("Authorization" .
|
||||||
|
,(format "token %s" github-notifier-token))))
|
||||||
|
(url (github-notifier-get-url (concat "/notifications"
|
||||||
|
(when github-notifier-only-participating
|
||||||
|
"?participating=true")) t)))
|
||||||
|
(condition-case error-data
|
||||||
|
(url-retrieve url #'github-notifier-update-cb nil t t)
|
||||||
|
(error
|
||||||
|
(message "Error retrieving github notification from %s: %s" url error-data)
|
||||||
|
(when github-notifier-mode
|
||||||
|
(setq github-notifier-update-timer
|
||||||
|
(run-at-time github-notifier-update-interval nil #'github-notifier-update))))))))
|
||||||
|
|
||||||
|
(defun github-notifier-visit-github ()
|
||||||
|
(interactive)
|
||||||
|
(browse-url (github-notifier-get-url "/notifications"))
|
||||||
|
(setq github-notifier-last-notification-checked (format-time-string "%FT%TZ" (current-time) t))
|
||||||
|
(force-mode-line-update t))
|
||||||
|
|
||||||
|
(defun github-notifier-notifications-checked ()
|
||||||
|
(and github-notifier-unread-count (> github-notifier-unread-count 0)
|
||||||
|
github-notifier-last-notification github-notifier-last-notification-checked
|
||||||
|
(string< github-notifier-last-notification github-notifier-last-notification-checked)))
|
||||||
|
|
||||||
|
;;; Glboal Minor-mode
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defalias 'github-notifier 'github-notifier-mode)
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(define-minor-mode github-notifier-mode
|
||||||
|
"Toggle github notifications count display in mode line (Github Notifier mode).
|
||||||
|
With a prefix argument ARG, enable Github Notifier mode if ARG is
|
||||||
|
positive, and disable it otherwise. If called from Lisp, enable
|
||||||
|
the mode if ARG is omitted or nil."
|
||||||
|
:global t :group 'github-notifier
|
||||||
|
(unless github-notifier-token
|
||||||
|
(setq github-notifier-token
|
||||||
|
(with-temp-buffer
|
||||||
|
(when (or
|
||||||
|
(= 0 (call-process "git" nil t nil "config" "github-notifier.oauth-token"))
|
||||||
|
(= 0 (call-process "git" nil t nil "config" "github.oauth-token")))
|
||||||
|
(buffer-substring 1 (progn (goto-char 1) (line-end-position)))))))
|
||||||
|
(unless (stringp github-notifier-token)
|
||||||
|
(browse-url (github-notifier-get-url "/settings/tokens/new?scopes=notifications&description=github-notifier.el"))
|
||||||
|
(let (token)
|
||||||
|
(unwind-protect
|
||||||
|
(setq token (read-string "Paste Your Access Token: "))
|
||||||
|
(if (stringp token)
|
||||||
|
(customize-save-variable 'github-notifier-token token)
|
||||||
|
(message "No Access Token")
|
||||||
|
(setq github-notifier-mode nil)))))
|
||||||
|
(unless global-mode-string
|
||||||
|
(setq global-mode-string '("")))
|
||||||
|
(if (not github-notifier-mode)
|
||||||
|
(progn
|
||||||
|
(setq global-mode-string
|
||||||
|
(delq 'github-notifier-mode-line global-mode-string))
|
||||||
|
(when github-notifier-update-timer
|
||||||
|
(cancel-timer github-notifier-update-timer)
|
||||||
|
(setq github-notifier-update-timer nil)))
|
||||||
|
(add-to-list 'global-mode-string 'github-notifier-mode-line t)
|
||||||
|
(github-notifier-update)))
|
||||||
|
|
||||||
|
(provide 'github-notifier)
|
||||||
|
;;; github-notifier.el ends here
|
1
elpa/queue-0.1.1.signed
Normal file
1
elpa/queue-0.1.1.signed
Normal file
@ -0,0 +1 @@
|
|||||||
|
Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent <elpasign@elpa.gnu.org> (trust undefined) created at 2014-09-24T16:20:08+0200 using DSA
|
19
elpa/queue-0.1.1/queue-autoloads.el
Normal file
19
elpa/queue-0.1.1/queue-autoloads.el
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
;;; queue-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil "queue" "queue.el" (22500 1794 888069 675000))
|
||||||
|
;;; Generated autoloads from queue.el
|
||||||
|
|
||||||
|
(defalias 'make-queue 'queue-create "\
|
||||||
|
Create an empty queue data structure.")
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; queue-autoloads.el ends here
|
1
elpa/queue-0.1.1/queue-pkg.el
Normal file
1
elpa/queue-0.1.1/queue-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "queue" "0.1.1" "Queue data structure" 'nil :url "http://www.dr-qubit.org/emacs.php" :keywords '("extensions" "data structures" "queue"))
|
173
elpa/queue-0.1.1/queue.el
Normal file
173
elpa/queue-0.1.1/queue.el
Normal file
@ -0,0 +1,173 @@
|
|||||||
|
;;; queue.el --- Queue data structure -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 1991-1995, 2008-2009, 2012 Free Software Foundation, Inc
|
||||||
|
|
||||||
|
;; Author: Inge Wallin <inge@lysator.liu.se>
|
||||||
|
;; Toby Cubitt <toby-predictive@dr-qubit.org>
|
||||||
|
;; Maintainer: Toby Cubitt <toby-predictive@dr-qubit.org>
|
||||||
|
;; Version: 0.1.1
|
||||||
|
;; Keywords: extensions, data structures, queue
|
||||||
|
;; URL: http://www.dr-qubit.org/emacs.php
|
||||||
|
;; Repository: http://www.dr-qubit.org/git/predictive.git
|
||||||
|
|
||||||
|
;; This file is part of Emacs.
|
||||||
|
;;
|
||||||
|
;; GNU Emacs 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.
|
||||||
|
;;
|
||||||
|
;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
|
||||||
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||||
|
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
||||||
|
;; more details.
|
||||||
|
;;
|
||||||
|
;; You should have received a copy of the GNU General Public License along
|
||||||
|
;; with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
;; These queues can be used both as a first-in last-out (FILO) and as a
|
||||||
|
;; first-in first-out (FIFO) stack, i.e. elements can be added to the front or
|
||||||
|
;; back of the queue, and can be removed from the front. (This type of data
|
||||||
|
;; structure is sometimes called an "output-restricted deque".)
|
||||||
|
;;
|
||||||
|
;; You create a queue using `make-queue', add an element to the end of the
|
||||||
|
;; queue using `queue-enqueue', and push an element onto the front of the
|
||||||
|
;; queue using `queue-prepend'. To remove the first element from a queue, use
|
||||||
|
;; `queue-dequeue'. A number of other queue convenience functions are also
|
||||||
|
;; provided, all starting with the prefix `queue-'. Functions with prefix
|
||||||
|
;; `queue--' are for internal use only, and should never be used outside this
|
||||||
|
;; package.
|
||||||
|
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(eval-when-compile (require 'cl))
|
||||||
|
|
||||||
|
|
||||||
|
(defstruct (queue
|
||||||
|
;; A tagged list is the pre-defstruct representation.
|
||||||
|
;; (:type list)
|
||||||
|
:named
|
||||||
|
(:constructor nil)
|
||||||
|
(:constructor queue-create ())
|
||||||
|
(:copier nil))
|
||||||
|
head tail)
|
||||||
|
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defalias 'make-queue 'queue-create
|
||||||
|
"Create an empty queue data structure.")
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-enqueue (queue element)
|
||||||
|
"Append an ELEMENT to the end of the QUEUE."
|
||||||
|
(if (queue-head queue)
|
||||||
|
(setcdr (queue-tail queue)
|
||||||
|
(setf (queue-tail queue) (cons element nil)))
|
||||||
|
(setf (queue-head queue)
|
||||||
|
(setf (queue-tail queue) (cons element nil)))))
|
||||||
|
|
||||||
|
(defalias 'queue-append 'queue-enqueue)
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-prepend (queue element)
|
||||||
|
"Prepend an ELEMENT to the front of the QUEUE."
|
||||||
|
(if (queue-head queue)
|
||||||
|
(push element (queue-head queue))
|
||||||
|
(setf (queue-head queue)
|
||||||
|
(setf (queue-tail queue) (cons element nil)))))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-dequeue (queue)
|
||||||
|
"Remove the first element of QUEUE and return it.
|
||||||
|
Returns nil if the queue is empty."
|
||||||
|
(unless (cdr (queue-head queue)) (setf (queue-tail queue) nil))
|
||||||
|
(pop (queue-head queue)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-empty (queue)
|
||||||
|
"Return t if QUEUE is empty, otherwise return nil."
|
||||||
|
(null (queue-head queue)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-first (queue)
|
||||||
|
"Return the first element of QUEUE or nil if it is empty,
|
||||||
|
without removing it from the QUEUE."
|
||||||
|
(car (queue-head queue)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-nth (queue n)
|
||||||
|
"Return the nth element of a queue, without removing it.
|
||||||
|
If the length of the queue is less than N, return nil. The first
|
||||||
|
element in the queue has index 0."
|
||||||
|
(nth n (queue-head queue)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-last (queue)
|
||||||
|
"Return the last element of QUEUE, without removing it.
|
||||||
|
Returns nil if the QUEUE is empty."
|
||||||
|
(car (queue-tail queue)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-all (queue)
|
||||||
|
"Return a list of all elements of QUEUE or nil if it is empty.
|
||||||
|
The oldest element in the queue is the first in the list."
|
||||||
|
(queue-head queue))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-copy (queue)
|
||||||
|
"Return a copy of QUEUE.
|
||||||
|
The new queue contains the elements of QUEUE in the same
|
||||||
|
order. The elements themselves are *not* copied."
|
||||||
|
(let ((q (queue-create))
|
||||||
|
(list (queue-head queue)))
|
||||||
|
(when (queue-head queue)
|
||||||
|
(setf (queue-head q) (cons (car (queue-head queue)) nil)
|
||||||
|
(queue-tail q) (queue-head q))
|
||||||
|
(while (setq list (cdr list))
|
||||||
|
(setf (queue-tail q)
|
||||||
|
(setcdr (queue-tail q) (cons (car list) nil)))))
|
||||||
|
q))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-length (queue)
|
||||||
|
"Return the number of elements in QUEUE."
|
||||||
|
(length (queue-head queue)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun queue-clear (queue)
|
||||||
|
"Remove all elements from QUEUE."
|
||||||
|
(setf (queue-head queue) nil
|
||||||
|
(queue-tail queue) nil))
|
||||||
|
|
||||||
|
;;;; ChangeLog:
|
||||||
|
|
||||||
|
;; 2014-05-15 Toby S. Cubitt <tsc25@cantab.net>
|
||||||
|
;;
|
||||||
|
;; queue.el: fix buggy queue-first and queue-empty definitions.
|
||||||
|
;;
|
||||||
|
;; 2012-04-30 Toby S. Cubitt <tsc25@cantab.net>
|
||||||
|
;;
|
||||||
|
;; Minor fixes to commentaries, package headers, and whitespace
|
||||||
|
;;
|
||||||
|
;; * queue.el: fix description of data structure in Commentary; add
|
||||||
|
;; Maintainer
|
||||||
|
;; header.
|
||||||
|
;;
|
||||||
|
;; * queue.el, heap.el, tNFA.el, trie.el, dict-tree.el: trivial whitespace
|
||||||
|
;; fixes.
|
||||||
|
;;
|
||||||
|
;; 2012-04-29 Toby S. Cubitt <tsc25@cantab.net>
|
||||||
|
;;
|
||||||
|
;; Add queue.el
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'queue)
|
||||||
|
|
||||||
|
|
||||||
|
;;; queue.el ends here
|
1
elpa/spinner-1.7.1.signed
Normal file
1
elpa/spinner-1.7.1.signed
Normal file
@ -0,0 +1 @@
|
|||||||
|
Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent <elpasign@elpa.gnu.org> (trust undefined) created at 2016-04-02T11:05:01+0200 using DSA
|
67
elpa/spinner-1.7.1/spinner-autoloads.el
Normal file
67
elpa/spinner-1.7.1/spinner-autoloads.el
Normal file
@ -0,0 +1,67 @@
|
|||||||
|
;;; spinner-autoloads.el --- automatically extracted autoloads
|
||||||
|
;;
|
||||||
|
;;; Code:
|
||||||
|
(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
|
||||||
|
|
||||||
|
;;;### (autoloads nil "spinner" "spinner.el" (22500 1793 528062 392000))
|
||||||
|
;;; Generated autoloads from spinner.el
|
||||||
|
|
||||||
|
(autoload 'spinner-create "spinner" "\
|
||||||
|
Create a spinner of the given TYPE.
|
||||||
|
The possible TYPEs are described in `spinner--type-to-frames'.
|
||||||
|
|
||||||
|
FPS, if given, is the number of desired frames per second.
|
||||||
|
Default is `spinner-frames-per-second'.
|
||||||
|
|
||||||
|
If BUFFER-LOCAL is non-nil, the spinner will be automatically
|
||||||
|
deactivated if the buffer is killed. If BUFFER-LOCAL is a
|
||||||
|
buffer, use that instead of current buffer.
|
||||||
|
|
||||||
|
When started, in order to function properly, the spinner runs a
|
||||||
|
timer which periodically calls `force-mode-line-update' in the
|
||||||
|
curent buffer. If BUFFER-LOCAL was set at creation time, then
|
||||||
|
`force-mode-line-update' is called in that buffer instead. When
|
||||||
|
the spinner is stopped, the timer is deactivated.
|
||||||
|
|
||||||
|
DELAY, if given, is the number of seconds to wait after starting
|
||||||
|
the spinner before actually displaying it. It is safe to cancel
|
||||||
|
the spinner before this time, in which case it won't display at
|
||||||
|
all.
|
||||||
|
|
||||||
|
\(fn &optional TYPE BUFFER-LOCAL FPS DELAY)" nil nil)
|
||||||
|
|
||||||
|
(autoload 'spinner-start "spinner" "\
|
||||||
|
Start a mode-line spinner of given TYPE-OR-OBJECT.
|
||||||
|
If TYPE-OR-OBJECT is an object created with `make-spinner',
|
||||||
|
simply activate it. This method is designed for minor modes, so
|
||||||
|
they can use the spinner as part of their lighter by doing:
|
||||||
|
'(:eval (spinner-print THE-SPINNER))
|
||||||
|
To stop this spinner, call `spinner-stop' on it.
|
||||||
|
|
||||||
|
If TYPE-OR-OBJECT is anything else, a buffer-local spinner is
|
||||||
|
created with this type, and it is displayed in the
|
||||||
|
`mode-line-process' of the buffer it was created it. Both
|
||||||
|
TYPE-OR-OBJECT and FPS are passed to `make-spinner' (which see).
|
||||||
|
To stop this spinner, call `spinner-stop' in the same buffer.
|
||||||
|
|
||||||
|
Either way, the return value is a function which can be called
|
||||||
|
anywhere to stop this spinner. You can also call `spinner-stop'
|
||||||
|
in the same buffer where the spinner was created.
|
||||||
|
|
||||||
|
FPS, if given, is the number of desired frames per second.
|
||||||
|
Default is `spinner-frames-per-second'.
|
||||||
|
|
||||||
|
DELAY, if given, is the number of seconds to wait until actually
|
||||||
|
displaying the spinner. It is safe to cancel the spinner before
|
||||||
|
this time, in which case it won't display at all.
|
||||||
|
|
||||||
|
\(fn &optional TYPE-OR-OBJECT FPS DELAY)" nil nil)
|
||||||
|
|
||||||
|
;;;***
|
||||||
|
|
||||||
|
;; Local Variables:
|
||||||
|
;; version-control: never
|
||||||
|
;; no-byte-compile: t
|
||||||
|
;; no-update-autoloads: t
|
||||||
|
;; End:
|
||||||
|
;;; spinner-autoloads.el ends here
|
1
elpa/spinner-1.7.1/spinner-pkg.el
Normal file
1
elpa/spinner-1.7.1/spinner-pkg.el
Normal file
@ -0,0 +1 @@
|
|||||||
|
(define-package "spinner" "1.7.1" "Add spinners and progress-bars to the mode-line for ongoing operations" 'nil :url "https://github.com/Malabarba/spinner.el" :keywords '("processes" "mode-line"))
|
394
elpa/spinner-1.7.1/spinner.el
Normal file
394
elpa/spinner-1.7.1/spinner.el
Normal file
@ -0,0 +1,394 @@
|
|||||||
|
;;; spinner.el --- Add spinners and progress-bars to the mode-line for ongoing operations -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||||
|
|
||||||
|
;; Author: Artur Malabarba <emacs@endlessparentheses.com>
|
||||||
|
;; Version: 1.7.1
|
||||||
|
;; URL: https://github.com/Malabarba/spinner.el
|
||||||
|
;; Keywords: processes mode-line
|
||||||
|
|
||||||
|
;; 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:
|
||||||
|
;;
|
||||||
|
;; 1 Usage
|
||||||
|
;; ═══════
|
||||||
|
;;
|
||||||
|
;; First of all, don’t forget to add `(spinner "VERSION")' to your
|
||||||
|
;; package’s dependencies.
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;; 1.1 Major-modes
|
||||||
|
;; ───────────────
|
||||||
|
;;
|
||||||
|
;; 1. Just call `(spinner-start)' and a spinner will be added to the
|
||||||
|
;; mode-line.
|
||||||
|
;; 2. Call `(spinner-stop)' on the same buffer when you want to remove
|
||||||
|
;; it.
|
||||||
|
;;
|
||||||
|
;; The default spinner is a line drawing that rotates. You can pass an
|
||||||
|
;; argument to `spinner-start' to specify which spinner you want. All
|
||||||
|
;; possibilities are listed in the `spinner-types' variable, but here are
|
||||||
|
;; a few examples for you to try:
|
||||||
|
;;
|
||||||
|
;; • `(spinner-start 'vertical-breathing 10)'
|
||||||
|
;; • `(spinner-start 'minibox)'
|
||||||
|
;; • `(spinner-start 'moon)'
|
||||||
|
;; • `(spinner-start 'triangle)'
|
||||||
|
;;
|
||||||
|
;; You can also define your own as a vector of strings (see the examples
|
||||||
|
;; in `spinner-types').
|
||||||
|
;;
|
||||||
|
;;
|
||||||
|
;; 1.2 Minor-modes
|
||||||
|
;; ───────────────
|
||||||
|
;;
|
||||||
|
;; Minor-modes can create a spinner with `spinner-create' and then add it
|
||||||
|
;; to their mode-line lighter. They can then start the spinner by setting
|
||||||
|
;; a variable and calling `spinner-start-timer'. Finally, they can stop
|
||||||
|
;; the spinner (and the timer) by just setting the same variable to nil.
|
||||||
|
;;
|
||||||
|
;; Here’s an example for a minor-mode named `foo'. Assuming that
|
||||||
|
;; `foo--lighter' is used as the mode-line lighter, the following code
|
||||||
|
;; will add an *inactive* global spinner to the mode-line.
|
||||||
|
;; ┌────
|
||||||
|
;; │ (defvar foo--spinner (spinner-create 'rotating-line))
|
||||||
|
;; │ (defconst foo--lighter
|
||||||
|
;; │ '(" foo" (:eval (spinner-print foo--spinner))))
|
||||||
|
;; └────
|
||||||
|
;;
|
||||||
|
;; 1. To activate the spinner, just call `(spinner-start foo--spinner)'.
|
||||||
|
;; It will show up on the mode-line and start animating.
|
||||||
|
;; 2. To get rid of it, call `(spinner-stop foo--spinner)'. It will then
|
||||||
|
;; disappear again.
|
||||||
|
;;
|
||||||
|
;; Some minor-modes will need spinners to be buffer-local. To achieve
|
||||||
|
;; that, just make the `foo--spinner' variable buffer-local and use the
|
||||||
|
;; third argument of the `spinner-create' function. The snippet below is an
|
||||||
|
;; example.
|
||||||
|
;;
|
||||||
|
;; ┌────
|
||||||
|
;; │ (defvar-local foo--spinner nil)
|
||||||
|
;; │ (defconst foo--lighter
|
||||||
|
;; │ '(" foo" (:eval (spinner-print foo--spinner))))
|
||||||
|
;; │ (defun foo--start-spinner ()
|
||||||
|
;; │ "Create and start a spinner on this buffer."
|
||||||
|
;; │ (unless foo--spinner
|
||||||
|
;; │ (setq foo--spinner (spinner-create 'moon t)))
|
||||||
|
;; │ (spinner-start foo--spinner))
|
||||||
|
;; └────
|
||||||
|
;;
|
||||||
|
;; 1. To activate the spinner, just call `(foo--start-spinner)'.
|
||||||
|
;; 2. To get rid of it, call `(spinner-stop foo--spinner)'.
|
||||||
|
;;
|
||||||
|
;; This will use the `moon' spinner, but you can use any of the names
|
||||||
|
;; defined in the `spinner-types' variable or even define your own.
|
||||||
|
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
(eval-when-compile
|
||||||
|
(require 'cl))
|
||||||
|
|
||||||
|
(defconst spinner-types
|
||||||
|
'((3-line-clock . ["┤" "┘" "┴" "└" "├" "┌" "┬" "┐"])
|
||||||
|
(2-line-clock . ["┘" "└" "┌" "┐"])
|
||||||
|
(flipping-line . ["_" "\\" "|" "/"])
|
||||||
|
(rotating-line . ["-" "\\" "|" "/"])
|
||||||
|
(progress-bar . ["[ ]" "[= ]" "[== ]" "[=== ]" "[====]" "[ ===]" "[ ==]" "[ =]"])
|
||||||
|
(progress-bar-filled . ["| |" "|█ |" "|██ |" "|███ |" "|████|" "| ███|" "| ██|" "| █|"])
|
||||||
|
(vertical-breathing . ["▁" "▂" "▃" "▄" "▅" "▆" "▇" "█" "▇" "▆" "▅" "▄" "▃" "▂" "▁" " "])
|
||||||
|
(vertical-rising . ["▁" "▄" "█" "▀" "▔"])
|
||||||
|
(horizontal-breathing . [" " "▏" "▎" "▍" "▌" "▋" "▊" "▉" "▉" "▊" "▋" "▌" "▍" "▎" "▏"])
|
||||||
|
(horizontal-breathing-long
|
||||||
|
. [" " "▎ " "▌ " "▊ " "█ " "█▎" "█▌" "█▊" "██" "█▊" "█▌" "█▎" "█ " "▊ " "▋ " "▌ " "▍ " "▎ " "▏ "])
|
||||||
|
(horizontal-moving . [" " "▌ " "█ " "▐▌" " █" " ▐"])
|
||||||
|
(minibox . ["▖" "▘" "▝" "▗"])
|
||||||
|
(triangle . ["◢" "◣" "◤" "◥"])
|
||||||
|
(box-in-box . ["◰" "◳" "◲" "◱"])
|
||||||
|
(box-in-circle . ["◴" "◷" "◶" "◵"])
|
||||||
|
(half-circle . ["◐" "◓" "◑" "◒"])
|
||||||
|
(moon . ["🌑" "🌘" "🌖" "🌕" "🌔" "🌒"]))
|
||||||
|
"Predefined alist of spinners.
|
||||||
|
Each car is a symbol identifying the spinner, and each cdr is a
|
||||||
|
vector, the spinner itself.")
|
||||||
|
|
||||||
|
(defun spinner-make-progress-bar (width &optional char)
|
||||||
|
"Return a vector of strings of the given WIDTH.
|
||||||
|
The vector is a valid spinner type and is similar to the
|
||||||
|
`progress-bar' spinner, except without the sorrounding brackets.
|
||||||
|
CHAR is the character to use for the moving bar (defaults to =)."
|
||||||
|
(let ((whole-string (concat (make-string (1- width) ?\s)
|
||||||
|
(make-string 4 (or char ?=))
|
||||||
|
(make-string width ?\s))))
|
||||||
|
(apply #'vector (mapcar (lambda (n) (substring whole-string n (+ n width)))
|
||||||
|
(number-sequence (+ width 3) 0 -1)))))
|
||||||
|
|
||||||
|
(defvar spinner-current nil
|
||||||
|
"Spinner curently being displayed on the `mode-line-process'.")
|
||||||
|
(make-variable-buffer-local 'spinner-current)
|
||||||
|
|
||||||
|
(defconst spinner--mode-line-construct
|
||||||
|
'(:eval (spinner-print spinner-current))
|
||||||
|
"Construct used to display a spinner in `mode-line-process'.")
|
||||||
|
(put 'spinner--mode-line-construct 'risky-local-variable t)
|
||||||
|
|
||||||
|
(defvar spinner-frames-per-second 10
|
||||||
|
"Default speed at which spinners spin, in frames per second.
|
||||||
|
Each spinner can override this value.")
|
||||||
|
|
||||||
|
|
||||||
|
;;; The spinner object.
|
||||||
|
(defun spinner--type-to-frames (type)
|
||||||
|
"Return a vector of frames corresponding to TYPE.
|
||||||
|
The list of possible built-in spinner types is given by the
|
||||||
|
`spinner-types' variable, but you can also use your own (see
|
||||||
|
below).
|
||||||
|
|
||||||
|
If TYPE is nil, the frames of this spinner are given by the first
|
||||||
|
element of `spinner-types'.
|
||||||
|
If TYPE is a symbol, it specifies an element of `spinner-types'.
|
||||||
|
If TYPE is 'random, use a random element of `spinner-types'.
|
||||||
|
If TYPE is a list, it should be a list of symbols, and a random
|
||||||
|
one is chosen as the spinner type.
|
||||||
|
If TYPE is a vector, it should be a vector of strings and these
|
||||||
|
are used as the spinner's frames. This allows you to make your
|
||||||
|
own spinner animations."
|
||||||
|
(cond
|
||||||
|
((vectorp type) type)
|
||||||
|
((not type) (cdr (car spinner-types)))
|
||||||
|
((eq type 'random)
|
||||||
|
(cdr (elt spinner-types
|
||||||
|
(random (length spinner-types)))))
|
||||||
|
((listp type)
|
||||||
|
(cdr (assq (elt type (random (length type)))
|
||||||
|
spinner-types)))
|
||||||
|
((symbolp type) (cdr (assq type spinner-types)))
|
||||||
|
(t (error "Unknown spinner type: %s" type))))
|
||||||
|
|
||||||
|
(defstruct (spinner
|
||||||
|
(:copier nil)
|
||||||
|
(:conc-name spinner--)
|
||||||
|
(:constructor make-spinner (&optional type buffer-local frames-per-second delay-before-start)))
|
||||||
|
(frames (spinner--type-to-frames type))
|
||||||
|
(counter 0)
|
||||||
|
(fps (or frames-per-second spinner-frames-per-second))
|
||||||
|
(timer (timer-create) :read-only)
|
||||||
|
(active-p nil)
|
||||||
|
(buffer (when buffer-local
|
||||||
|
(if (bufferp buffer-local)
|
||||||
|
buffer-local
|
||||||
|
(current-buffer))))
|
||||||
|
(delay (or delay-before-start 0)))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun spinner-create (&optional type buffer-local fps delay)
|
||||||
|
"Create a spinner of the given TYPE.
|
||||||
|
The possible TYPEs are described in `spinner--type-to-frames'.
|
||||||
|
|
||||||
|
FPS, if given, is the number of desired frames per second.
|
||||||
|
Default is `spinner-frames-per-second'.
|
||||||
|
|
||||||
|
If BUFFER-LOCAL is non-nil, the spinner will be automatically
|
||||||
|
deactivated if the buffer is killed. If BUFFER-LOCAL is a
|
||||||
|
buffer, use that instead of current buffer.
|
||||||
|
|
||||||
|
When started, in order to function properly, the spinner runs a
|
||||||
|
timer which periodically calls `force-mode-line-update' in the
|
||||||
|
curent buffer. If BUFFER-LOCAL was set at creation time, then
|
||||||
|
`force-mode-line-update' is called in that buffer instead. When
|
||||||
|
the spinner is stopped, the timer is deactivated.
|
||||||
|
|
||||||
|
DELAY, if given, is the number of seconds to wait after starting
|
||||||
|
the spinner before actually displaying it. It is safe to cancel
|
||||||
|
the spinner before this time, in which case it won't display at
|
||||||
|
all."
|
||||||
|
(make-spinner type buffer-local fps delay))
|
||||||
|
|
||||||
|
(defun spinner-print (spinner)
|
||||||
|
"Return a string of the current frame of SPINNER.
|
||||||
|
If SPINNER is nil, just return nil.
|
||||||
|
Designed to be used in the mode-line with:
|
||||||
|
(:eval (spinner-print some-spinner))"
|
||||||
|
(when (and spinner (spinner--active-p spinner))
|
||||||
|
(let ((frame (spinner--counter spinner)))
|
||||||
|
(when (>= frame 0)
|
||||||
|
(elt (spinner--frames spinner) frame)))))
|
||||||
|
|
||||||
|
(defun spinner--timer-function (spinner)
|
||||||
|
"Function called to update SPINNER.
|
||||||
|
If SPINNER is no longer active, or if its buffer has been killed,
|
||||||
|
stop the SPINNER's timer."
|
||||||
|
(let ((buffer (spinner--buffer spinner)))
|
||||||
|
(if (or (not (spinner--active-p spinner))
|
||||||
|
(and buffer (not (buffer-live-p buffer))))
|
||||||
|
(spinner-stop spinner)
|
||||||
|
;; Increment
|
||||||
|
(callf (lambda (x) (if (< x 0)
|
||||||
|
(1+ x)
|
||||||
|
(% (1+ x) (length (spinner--frames spinner)))))
|
||||||
|
(spinner--counter spinner))
|
||||||
|
;; Update mode-line.
|
||||||
|
(if (buffer-live-p buffer)
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(force-mode-line-update))
|
||||||
|
(force-mode-line-update)))))
|
||||||
|
|
||||||
|
(defun spinner--start-timer (spinner)
|
||||||
|
"Start a SPINNER's timer."
|
||||||
|
(let ((old-timer (spinner--timer spinner)))
|
||||||
|
(when (timerp old-timer)
|
||||||
|
(cancel-timer old-timer))
|
||||||
|
|
||||||
|
(setf (spinner--active-p spinner) t)
|
||||||
|
|
||||||
|
(unless (ignore-errors (> (spinner--fps spinner) 0))
|
||||||
|
(error "A spinner's FPS must be a positive number"))
|
||||||
|
(setf (spinner--counter spinner) (round (- (* (or (spinner--delay spinner) 0)
|
||||||
|
(spinner--fps spinner)))))
|
||||||
|
;; Create timer.
|
||||||
|
(let* ((repeat (/ 1.0 (spinner--fps spinner)))
|
||||||
|
(time (timer-next-integral-multiple-of-time (current-time) repeat))
|
||||||
|
;; Create the timer as a lex variable so it can cancel itself.
|
||||||
|
(timer (spinner--timer spinner)))
|
||||||
|
(timer-set-time timer time repeat)
|
||||||
|
(timer-set-function timer #'spinner--timer-function (list spinner))
|
||||||
|
(timer-activate timer)
|
||||||
|
;; Return a stopping function.
|
||||||
|
(lambda () (spinner-stop spinner)))))
|
||||||
|
|
||||||
|
|
||||||
|
;;; The main functions
|
||||||
|
;;;###autoload
|
||||||
|
(defun spinner-start (&optional type-or-object fps delay)
|
||||||
|
"Start a mode-line spinner of given TYPE-OR-OBJECT.
|
||||||
|
If TYPE-OR-OBJECT is an object created with `make-spinner',
|
||||||
|
simply activate it. This method is designed for minor modes, so
|
||||||
|
they can use the spinner as part of their lighter by doing:
|
||||||
|
'(:eval (spinner-print THE-SPINNER))
|
||||||
|
To stop this spinner, call `spinner-stop' on it.
|
||||||
|
|
||||||
|
If TYPE-OR-OBJECT is anything else, a buffer-local spinner is
|
||||||
|
created with this type, and it is displayed in the
|
||||||
|
`mode-line-process' of the buffer it was created it. Both
|
||||||
|
TYPE-OR-OBJECT and FPS are passed to `make-spinner' (which see).
|
||||||
|
To stop this spinner, call `spinner-stop' in the same buffer.
|
||||||
|
|
||||||
|
Either way, the return value is a function which can be called
|
||||||
|
anywhere to stop this spinner. You can also call `spinner-stop'
|
||||||
|
in the same buffer where the spinner was created.
|
||||||
|
|
||||||
|
FPS, if given, is the number of desired frames per second.
|
||||||
|
Default is `spinner-frames-per-second'.
|
||||||
|
|
||||||
|
DELAY, if given, is the number of seconds to wait until actually
|
||||||
|
displaying the spinner. It is safe to cancel the spinner before
|
||||||
|
this time, in which case it won't display at all."
|
||||||
|
(unless (spinner-p type-or-object)
|
||||||
|
;; Choose type.
|
||||||
|
(if (spinner-p spinner-current)
|
||||||
|
(setf (spinner--frames spinner-current) (spinner--type-to-frames type-or-object))
|
||||||
|
(setq spinner-current (make-spinner type-or-object (current-buffer) fps delay)))
|
||||||
|
(setq type-or-object spinner-current)
|
||||||
|
;; Maybe add to mode-line.
|
||||||
|
(unless (memq 'spinner--mode-line-construct mode-line-process)
|
||||||
|
(setq mode-line-process
|
||||||
|
(list (or mode-line-process "")
|
||||||
|
'spinner--mode-line-construct))))
|
||||||
|
|
||||||
|
;; Create timer.
|
||||||
|
(when fps (setf (spinner--fps type-or-object) fps))
|
||||||
|
(when delay (setf (spinner--delay type-or-object) delay))
|
||||||
|
(spinner--start-timer type-or-object))
|
||||||
|
|
||||||
|
(defun spinner-start-print (spinner)
|
||||||
|
"Like `spinner-print', but also start SPINNER if it's not active."
|
||||||
|
(unless (spinner--active-p spinner)
|
||||||
|
(spinner-start spinner))
|
||||||
|
(spinner-print spinner))
|
||||||
|
|
||||||
|
(defun spinner-stop (&optional spinner)
|
||||||
|
"Stop SPINNER, defaulting to the current buffer's spinner.
|
||||||
|
It is always safe to call this function, even if there is no
|
||||||
|
active spinner."
|
||||||
|
(let ((spinner (or spinner spinner-current)))
|
||||||
|
(when (spinner-p spinner)
|
||||||
|
(let ((timer (spinner--timer spinner)))
|
||||||
|
(when (timerp timer)
|
||||||
|
(cancel-timer timer)))
|
||||||
|
(setf (spinner--active-p spinner) nil)
|
||||||
|
(force-mode-line-update))))
|
||||||
|
|
||||||
|
;;;; ChangeLog:
|
||||||
|
|
||||||
|
;; 2016-04-01 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; Remove reference to thread-last
|
||||||
|
;;
|
||||||
|
;; 2016-02-08 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; Spinner version 1.7
|
||||||
|
;;
|
||||||
|
;; Offer a spinner-make-progress-bar function. Make spinner-stop never
|
||||||
|
;; signal. Allow floating-point delays.
|
||||||
|
;;
|
||||||
|
;; 2016-02-07 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; Update the mode-line after spinner-stop
|
||||||
|
;;
|
||||||
|
;; 2015-08-11 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; Merge commit '8d8c459d7757cf5774f11be9147d7a54f5f9bbd7'
|
||||||
|
;;
|
||||||
|
;; 2015-05-02 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; * spinner: Rename constructor.
|
||||||
|
;;
|
||||||
|
;; 2015-04-30 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; * spinner/spinner.el: Rewrite spinners as structures
|
||||||
|
;;
|
||||||
|
;; 2015-04-09 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; spinner: Fix readme
|
||||||
|
;;
|
||||||
|
;; 2015-04-09 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; spinner: Fix leftover mode-line-format code
|
||||||
|
;;
|
||||||
|
;; 2015-04-09 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; Merge commit 'c44ef65515f50bd38304a6f50adebc984fb8e431'
|
||||||
|
;;
|
||||||
|
;; 2015-03-07 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; Merge commit '7eca7d023c95bc21c7838467b3a58d549afaf68d'
|
||||||
|
;;
|
||||||
|
;; 2015-03-07 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; Merge commit 'a7b4e52766977b58c6b9899305e962a2b5235bda'
|
||||||
|
;;
|
||||||
|
;; 2015-03-07 Artur Malabarba <bruce.connor.am@gmail.com>
|
||||||
|
;;
|
||||||
|
;; Add 'packages/spinner/' from commit
|
||||||
|
;; '9477ee899d62259d4b946f243cdcdd9cdeb1e910'
|
||||||
|
;;
|
||||||
|
;; git-subtree-dir: packages/spinner git-subtree-mainline:
|
||||||
|
;; 5736e852fd48a0f1ba1c328dd4d03e3fa008a406 git-subtree-split:
|
||||||
|
;; 9477ee899d62259d4b946f243cdcdd9cdeb1e910
|
||||||
|
;;
|
||||||
|
|
||||||
|
|
||||||
|
(provide 'spinner)
|
||||||
|
|
||||||
|
;;; spinner.el ends here
|
Loading…
Reference in New Issue
Block a user