diff --git a/README.md b/README.md index 3042219..f2ab3ee 100644 --- a/README.md +++ b/README.md @@ -1,17 +1,19 @@ # Example Config -Example Emacs configuration for clojure development with cider and clj-refactor. +An example Emacs configuration for Clojure development with CIDER and clj-refactor. ## Usage -1. Clone this repository as your `~/.emacs.d/` directory (or alternatively copy the contents into your `.emacs.d`) -2. copy the provided `profiles_sample.clj` to your `~/.lein/` directory and rename it to `profiles.clj` (again alternatively just merge the contents of the sample profiles.clj with your existing profiles.clj if you already have one) +You can use this configuration as your base Emacs configuration, or adapt it to your own configuration. -Alternatively you can cherry pick packages and/or config from here for clojure development with cider and clj-refactor and add it to your already existing `~/.emacs.d` directory. +1. Clone, copy, or merge this repository as your `~/.emacs.d/` directory +2. Copy or merge the provided `profiles_sample.clj` to your `~/.lein/` directory as `profiles.clj` -Either way you should be able to `cider-jack-in` on any clojure file of your favourite clojure project with `C-c M-j`. Prefix for clj-refactor is set to `C-c RET` so for example introduce let would be `C-c RET i l`. +Load a Clojure file, and execute `cider-jack-in` (`C-c M-j`). -Happy clojure hacking! +clj-refactor's prefix is `C-c RET`. It uses mnemonic keywords to provide shortcuts for common tasks. One example of its functionality is introduce let, which would be `C-c RET i l`. To view a complete list of its functionality, hit `C-c RET C-h`. + +Happy Clojure hacking! ## Featured packages @@ -22,33 +24,20 @@ Happy clojure hacking! ## Package versions -All package versions come from melpa stable apart from `clj-refactor`: this might change in the near future and `clj-refactor` will come from stable too. If you are not sure what melpa stable means check out next section about Emacs package management. +Our dependencies largely come from MELPA Stable, which aims to hold only stable versions of packages. The main exception is `clj-refactor` and its dependencies. clj-refactor is available on MELPA Stable, but it has a very out-dated version. ### Using Emacs package management -if you look at this code snippet - - ```elisp - (require 'package) - (add-to-list 'package-archives - '("melpa-stable" . "http://stable.melpa.org/packages/") t) - (setq package-user-dir (concat user-emacs-directory "packages")) - (package-initialize) - ``` - -this basically says that -- we want to use the emacs package management system -- we want to use the melpa-stable repo for packages (no snapshot versions from head of master branch of projects only released versions) -- we want the use the directory named `packages` under user-emacs-directory (resolves to `~/.emacs.d` here) to store the packages. +Where possible, we make use of a helper function, require-package, that checks if a package is installed locally. If it is not installed locally, it will attempt to download and install that package from the package repositories. When you first use this config, Emacs will download all of the requirements that are not included with this configuration (i.e., the ones that we do not get from MELPA stable). -the above code snippet actually helps the maintainer when the time comes to upgrade packages (there are new releases) with a simple `M-x install package RET cider` for example. More detailed info about emacs [package management](http://ergoemacs.org/emacs/emacs_package_system.html). +[Here is a link](http://ergoemacs.org/emacs/emacs_package_system.html) to more detailed information about package management in Emacs. ## Rationale -See [this issue](https://github.com/clojure-emacs/clj-refactor.el/issues/110) for the discussion which resulted in creating this sample configuration. The goal of this to provide a reference emacs config which is specially focused on clojure development with all the bells and whistles but does not have much else in it. +See [this issue](https://github.com/clojure-emacs/clj-refactor.el/issues/110) for the discussion which resulted in creating this sample configuration. The goal of this to provide a reference Emacs config which is specially focused on Clojure development with all the bells and whistles but does not have much else in it. ## License Copyright © 2015 [contributors](https://github.com/clojure-emacs/example-config/graphs/contributors) -Distributed under the GNU General Public License, version 3 \ No newline at end of file +Distributed under the GNU General Public License, version 3 diff --git a/cfg-cider.el b/cfg-cider.el index f37240f..68b9749 100644 --- a/cfg-cider.el +++ b/cfg-cider.el @@ -1,3 +1,9 @@ +;; Clojure IDE and REPL for Emacs +(require-package 'cider) + +;; autocompletion +(require-package 'company) + ;; REPL related stuff ;; REPL history file diff --git a/cfg-cljrefactor.el b/cfg-cljrefactor.el index c52f86f..dd8a84a 100644 --- a/cfg-cljrefactor.el +++ b/cfg-cljrefactor.el @@ -1,3 +1,14 @@ +;; clj-refactor and dependencies + +;; available on MELPA stable +(require-package 'multiple-cursors) +(require-package 'dash) + +;; manual dependencies +(add-to-list 'load-path (concat user-emacs-directory "site-lisp/" "s-20140910.334")) +(add-to-list 'load-path (concat user-emacs-directory "site-lisp/" "yasnippet-20141223.303")) +(add-to-list 'load-path (concat user-emacs-directory "site-lisp/" "clj-refactor-20150104.1358")) + (require 'clj-refactor) (add-hook 'clojure-mode-hook (lambda () diff --git a/cfg-hlsexp.el b/cfg-hlsexp.el index b91c4f2..2687e2e 100644 --- a/cfg-hlsexp.el +++ b/cfg-hlsexp.el @@ -1,3 +1,5 @@ +(require-package 'hl-sexp) + ;; hl-sexp: minor mode to highlight s-expression (require 'hl-sexp) diff --git a/cfg-paredit.el b/cfg-paredit.el index 3df41e2..878ff79 100644 --- a/cfg-paredit.el +++ b/cfg-paredit.el @@ -1,3 +1,5 @@ +(require-package 'paredit) + ;; Paredit (require 'paredit) (add-hook 'lisp-mode-hook #'paredit-mode) diff --git a/init.el b/init.el index 77a45b1..cafa685 100644 --- a/init.el +++ b/init.el @@ -22,14 +22,35 @@ ;; emacs package management ;; use MELPA stable (require 'package) + (add-to-list 'package-archives '("melpa-stable" . "http://stable.melpa.org/packages/") t) -(setq package-user-dir (concat user-emacs-directory "packages")) + +(setq package-user-dir (concat user-emacs-directory "elpa")) +(add-to-list 'load-path (concat user-emacs-directory "site-lisp")) + +(defun require-package (package &optional min-version no-refresh) + "Install given PACKAGE, optionally requiring MIN-VERSION. +If NO-REFRESH is non-nil, the available package lists will not be +re-downloaded in order to locate PACKAGE." + (if (package-installed-p package min-version) + t + (if (or (assoc package package-archive-contents) no-refresh) + (package-install package) + (progn + (package-refresh-contents) + (require-package package min-version t))))) + +(setq package-enable-at-startup nil) ; Don't initialize later as well + (package-initialize) ;; show opening, closing parens (show-paren-mode) +(require-package 'epl) + +(require-package 'exec-path-from-shell) ;; Sort out the $PATH for OSX (require 'exec-path-from-shell) (when (memq window-system '(mac ns)) diff --git a/packages/cider-0.8.2/cider-apropos.el b/packages/cider-0.8.2/cider-apropos.el deleted file mode 100644 index 37ee316..0000000 --- a/packages/cider-0.8.2/cider-apropos.el +++ /dev/null @@ -1,119 +0,0 @@ -;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014 Jeff Valk, Bozhidar Batsov -;; -;; Author: Jeff Valk - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Apropos functionality for Clojure. - -;;; Code: - -(require 'cider-interaction) - -(defconst cider-apropos-buffer "*cider-apropos*") - -(push cider-apropos-buffer cider-ancillary-buffers) - -(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." - (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 - (progn (insert (cider-apropos-highlight doc query)) - (newline)) - (progn (insert doc) - (fill-region beg (point))))) - (newline))))) - -(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)) - (set-syntax-table clojure-mode-syntax-table) - (apropos-mode) - (cider-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. -The search may be limited to the namespace NS, and may optionally search doc -strings, include private vars, and be case sensitive." - (interactive - (if current-prefix-arg - (list (read-string "Clojure Apropos: ") - (let ((ns (read-string "Namespace: "))) - (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? ")) - (list (read-string "Clojure Apropos: ")))) - (cider-ensure-op-supported "apropos") - (-if-let* ((summary (cider-apropos-summary - query ns docs-p privates-p case-sensitive-p)) - (results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))) - (cider-show-apropos summary results query docs-p) - (message "No apropos matches for %S" query))) - -;;;###autoload -(defun cider-apropos-documentation () - "Shortcut for (cider-apropos nil t)." - (interactive) - (cider-apropos (read-string "Clojure documentation Apropos: ") nil t)) - -(provide 'cider-apropos) diff --git a/packages/cider-0.8.2/cider-autoloads.el b/packages/cider-0.8.2/cider-autoloads.el deleted file mode 100644 index 658fcde..0000000 --- a/packages/cider-0.8.2/cider-autoloads.el +++ /dev/null @@ -1,195 +0,0 @@ -;;; cider-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - - -;;;### (autoloads (cider-connect cider-jack-in cider-version) "cider" -;;;;;; "cider.el" (21682 41327 0 0)) -;;; Generated autoloads from cider.el - -(autoload 'cider-version "cider" "\ -Display CIDER's version. - -\(fn)" t nil) - -(autoload 'cider-jack-in "cider" "\ -Start a 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. - -\(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. - -\(fn HOST PORT)" 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-c") 'cider-connect))) - -;;;*** - -;;;### (autoloads (cider-apropos-documentation cider-apropos) "cider-apropos" -;;;;;; "cider-apropos.el" (21682 41327 0 0)) -;;; Generated autoloads from cider-apropos.el - -(autoload 'cider-apropos "cider-apropos" "\ -Show all symbols whose names match QUERY, a regular expression. -The search may be limited to the namespace NS, and may optionally search doc -strings, include private vars, and be case sensitive. - -\(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t nil) - -(autoload 'cider-apropos-documentation "cider-apropos" "\ -Shortcut for (cider-apropos nil t). - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (cider-browse-ns-all cider-browse-ns) "cider-browse-ns" -;;;;;; "cider-browse-ns.el" (21682 41327 0 0)) -;;; Generated autoloads from cider-browse-ns.el - -(autoload 'cider-browse-ns "cider-browse-ns" "\ -List all NAMESPACE's vars in BUFFER. - -\(fn NAMESPACE)" t nil) - -(autoload 'cider-browse-ns-all "cider-browse-ns" "\ -List all loaded namespaces in BUFFER. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (cider-open-classpath-entry cider-classpath) "cider-classpath" -;;;;;; "cider-classpath.el" (21682 41327 0 0)) -;;; Generated autoloads from cider-classpath.el - -(autoload 'cider-classpath "cider-classpath" "\ -List all classpath entries. - -\(fn)" t nil) - -(autoload 'cider-open-classpath-entry "cider-classpath" "\ -Open a classpath entry. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (cider-grimoire cider-grimoire-web) "cider-grimoire" -;;;;;; "cider-grimoire.el" (21682 41327 0 0)) -;;; Generated autoloads from cider-grimoire.el - -(autoload 'cider-grimoire-web "cider-grimoire" "\ -Open the grimoire documentation for QUERY in the default web browser. - -\(fn QUERY)" t nil) - -(autoload 'cider-grimoire "cider-grimoire" "\ -Open the grimoire documentation for QUERY in a popup buffer. - -\(fn QUERY)" t nil) - -;;;*** - -;;;### (autoloads (cider-inspect) "cider-inspector" "cider-inspector.el" -;;;;;; (21682 41327 0 0)) -;;; Generated autoloads from cider-inspector.el - -(autoload 'cider-inspect "cider-inspector" "\ -Eval the string EXPRESSION and inspect the result. - -\(fn EXPRESSION)" t nil) - -;;;*** - -;;;### (autoloads (cider-macroexpand-all cider-macroexpand-1) "cider-macroexpansion" -;;;;;; "cider-macroexpansion.el" (21682 41327 0 0)) -;;; Generated autoloads from cider-macroexpansion.el - -(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\ -Invoke 'macroexpand-1' on the expression preceding point. -If invoked with a PREFIX argument, use 'macroexpand' instead of -'macroexpand-1'. - -\(fn &optional PREFIX)" t nil) - -(autoload 'cider-macroexpand-all "cider-macroexpansion" "\ -Invoke 'clojure.walk/macroexpand-all' on the expression preceding point. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (cider-mode cider-mode-line) "cider-mode" "cider-mode.el" -;;;;;; (21682 41327 0 0)) -;;; Generated autoloads from cider-mode.el - -(defvar cider-mode-line '(:eval (format " cider[%s]" (cider-current-ns))) "\ -Mode line ligher 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 ns. -Set this variable to nil to disable the mode line -entirely.") - -(custom-autoload 'cider-mode-line "cider-mode" t) - -(autoload 'cider-mode "cider-mode" "\ -Minor mode for REPL interaction from a Clojure buffer. - -\\{cider-mode-map} - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads (cider-scratch) "cider-scratch" "cider-scratch.el" -;;;;;; (21682 41327 0 0)) -;;; Generated autoloads from cider-scratch.el - -(autoload 'cider-scratch "cider-scratch" "\ -Create a scratch buffer. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (cider-selector) "cider-selector" "cider-selector.el" -;;;;;; (21682 41327 0 0)) -;;; Generated autoloads from cider-selector.el - -(autoload 'cider-selector "cider-selector" "\ -Select a new buffer by type, indicated by a single character. -The user is prompted for a single character indicating the method by -which to choose a new buffer. The `?' character describes then -available methods. OTHER-WINDOW provides an optional target. - -See `def-cider-selector-method' for defining new methods. - -\(fn &optional OTHER-WINDOW)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("cider-client.el" "cider-doc.el" "cider-eldoc.el" -;;;;;; "cider-interaction.el" "cider-pkg.el" "cider-repl.el" "cider-stacktrace.el" -;;;;;; "cider-test.el" "cider-util.el" "nrepl-client.el") (21682 -;;;;;; 41327 869061 0)) - -;;;*** - -(provide 'cider-autoloads) -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; cider-autoloads.el ends here diff --git a/packages/cider-0.8.2/cider-browse-ns.el b/packages/cider-0.8.2/cider-browse-ns.el deleted file mode 100644 index 972d9fb..0000000 --- a/packages/cider-0.8.2/cider-browse-ns.el +++ /dev/null @@ -1,139 +0,0 @@ -;;; cider-browse-ns.el --- CIDER namespace browser - -;; Copyright © 2014 John Andrews - -;; Author: John Andrews - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; (cider-browse-ns) -;; Display a list of all vars in a namespace. -;; Pressing will take you to the cider-doc buffer for that var. -;; Pressing ^ will take you to a list of all namespaces (akin to dired mode) - -;; (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-repl) -(require 'cider-client) -(require 'cider-interaction) - -(defvar cider-browse-ns-buffer "*Browse NS*") -(defvar-local cider-browse-ns-current-ns nil) - -;; Utility Functions - -(defun cider-browse-ns-properties (text) - "Decorate TEXT with a clickable keymap and function face." - (propertize text - 'font-lock-face 'font-lock-function-name-face - 'mouse-face 'highlight - 'keymap cider-browse-ns-mouse-map)) - - -;; 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 [return] 'cider-browse-ns-operate-on-point) - (define-key map "^" 'cider-browse-ns-all) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) - map)) - -(define-derived-mode cider-browse-ns-mode special-mode "browse-ns" - "Major mode for browsing Clojure namespaces. - -\\{cider-browse-ns-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) - (setq-local cider-browse-ns-current-ns nil)) - -(defun cider-browse-ns-list (buffer title items) - "Reset contents of BUFFER. Then display TITLE at the top and ITEMS are indented underneath." - (with-current-buffer buffer - (cider-browse-ns-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (propertize title 'font-lock-face 'cider-doc-strong-face)) - (newline) - (dolist (item items) - (insert " " item) - (newline)) - (goto-char (point-min))))) - -(defvar cider-browse-ns-mouse-map (make-sparse-keymap)) -(define-key cider-browse-ns-mouse-map [mouse-1] 'cider-browse-ns-handle-mouse) - - -;; 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) - (let ((vars (cider-sync-request:ns-vars namespace))) - (cider-browse-ns-list (current-buffer) - namespace - (mapcar (lambda (var) - (format "/%s" - (cider-browse-ns-properties var))) - vars)) - (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)) - names)) - (setq-local cider-browse-ns-current-ns nil)))) - -(defun cider-browse-ns-operate-on-point () - "Expand browser according to thing at current point." - (interactive) - (let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) - (cond - ((= 1 (line-number-at-pos)) - 'nothing-to-do) - ((string-match " +/\\(.+\\)" line) - (cider-doc-lookup (format "%s/%s" cider-browse-ns-current-ns (match-string 1 line)))) - ('else - (cider-browse-ns (replace-regexp-in-string " " "" line)))))) - -(defun cider-browse-ns-handle-mouse (event) - "Handle mouse click EVENT." - (interactive "e") - (cider-browse-ns-operate-on-point)) - -(provide 'cider-browse-ns) - -;;; cider-browse-ns.el ends here diff --git a/packages/cider-0.8.2/cider-classpath.el b/packages/cider-0.8.2/cider-classpath.el deleted file mode 100644 index 076378f..0000000 --- a/packages/cider-0.8.2/cider-classpath.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; cider-classpath.el --- Basic Java classpath browser - -;; Copyright © 2014 Bozhidar Batsov - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Basic Java classpath browser for CIDER. - -;;; Code: - -(require 'cider-client) -(require 'cider-interaction) - -(defvar cider-classpath-buffer "*Classpath*") - -(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)) - -(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) - (newline)) - (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) - (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) - (-when-let (entry (completing-read "Classpath entries: " (cider-sync-request:classpath))) - (find-file-other-window entry))) - -(defvar cider-classpath-mouse-map (make-sparse-keymap)) -(define-key cider-classpath-mouse-map [mouse-1] 'cider-classpath-handle-mouse) - -(provide 'cider-classpath) - -;;; cider-classpath.el ends here diff --git a/packages/cider-0.8.2/cider-client.el b/packages/cider-0.8.2/cider-client.el deleted file mode 100644 index 556cc49..0000000 --- a/packages/cider-0.8.2/cider-client.el +++ /dev/null @@ -1,263 +0,0 @@ -;;; cider-client.el --- A layer of abstraction above the actual client code. -*- lexical-binding: t -*- - -;; Copyright © 2013-2014 Bozhidar Batsov -;; -;; Author: Bozhidar Batsov - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A layer of abstraction above the actual client code. - -;;; Code: - -(require 'nrepl-client) - -;;; 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" - "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!" - ,(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))) - -(defun cider-display-connected-message () - "Message displayed on successful connection." - (message "Connected. %s" (cider-random-words-of-inspiration))) - -(add-hook 'nrepl-connected-hook 'cider-display-connected-message) - -;;; Evaluation helpers -(defun cider-ns-form-p (form) - "Check if FORM is an ns form." - (string-match "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form)) - -(defun cider-eval (input callback &optional ns session) - "Send the request INPUT and register the CALLBACK as the response handler. -NS & SESSION specify the context in which to evaluate the request." - ;; namespace forms are always evaluated in the "user" namespace - (let ((ns (if (cider-ns-form-p input) - "user" - (or ns (cider-current-ns))))) - (nrepl-request:eval input callback ns session))) - -(defun cider-tooling-eval (input callback &optional ns) - "Send the request INPUT and register the CALLBACK as the response handler. -NS specifies the namespace in which to evaluate the request." - ;; namespace forms are always evaluated in the "user" namespace - (cider-eval input callback ns (nrepl-current-tooling-session))) - -(defun cider-interrupt () - "Interrupt any pending evaluations." - (interactive) - (with-current-buffer (nrepl-current-connection-buffer) - (let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests))) - (dolist (request-id pending-request-ids) - (nrepl-request:interrupt request-id (cider-interrupt-handler (current-buffer))))))) - -(defun cider-current-repl-buffer () - "The current REPL buffer." - (-when-let (repl-buf (nrepl-current-connection-buffer 'no-error)) - (buffer-local-value 'nrepl-repl-buffer (get-buffer repl-buf)))) - -(defun cider--var-choice (var-info) - "Prompt to choose from among multiple VAR-INFO candidates, if required. -This is needed only when the symbol queried is an unqualified host platform -method, and multiple classes have a so-named member. If VAR-INFO does not -contain a `candidates' key, it is returned as is." - (let ((candidates (nrepl-dict-get var-info "candidates"))) - (if candidates - (let* ((classes (nrepl-dict-keys candidates)) - (choice (completing-read "Member in class: " classes nil t)) - (info (nrepl-dict-get candidates choice))) - info) - var-info))) - -(defun cider-var-info (var &optional all) - "Return VAR's info as an alist with list cdrs. -When multiple matching vars are returned you'll be prompted to select one, -unless ALL is truthy." - (when (and var (not (string= var ""))) - (let ((var-info (cider-sync-request:info var))) - (if all var-info (cider--var-choice var-info))))) - -(defun cider-member-info (class member) - "Return the CLASS MEMBER's info as an alist with list cdrs." - (when (and class member) - (cider-sync-request:info nil class member))) - - -;;; Requests - -(defun cider-request:load-file (file-contents file-path file-name &optional callback) - "Perform the nREPL \"load-file\" op. -FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be -loaded. If CALLBACK is nil, use `cider-load-file-handler'." - (nrepl-send-request (list "op" "load-file" - "session" (nrepl-current-session) - "file" file-contents - "file-path" file-path - "file-name" file-name) - (or callback - (cider-load-file-handler (current-buffer))))) - - -;;; Sync Requests -(defun cider--sync-request-value (request) - "Send sync REQUEST and return the \"value\" slot." - (cider-ensure-op-supported (lax-plist-get request "op")) - (nrepl-dict-get (nrepl-send-sync-request request) "value")) - -(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p) - "Send \"apropos\" op with args SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." - (-> `("op" "apropos" - "ns" ,(cider-current-ns) - "query" ,query - ,@(when search-ns `("search-ns" ,search-ns)) - ,@(when docs-p '("docs?" "t")) - ,@(when privates-p '("privates?" "t")) - ,@(when case-sensitive-p '("case-sensitive?" "t"))) - (nrepl-send-sync-request) - (nrepl-dict-get "apropos-matches"))) - -(defun cider-sync-request:classpath () - "Return a list of classpath entries." - (cider-ensure-op-supported "classpath") - (-> (list "op" "classpath" - "session" (nrepl-current-session)) - (nrepl-send-sync-request) - (nrepl-dict-get "classpath"))) - -(defun cider-sync-request:complete (str context) - "Return a list of completions for STR using nREPL's \"complete\" op." - (-> (list "op" "complete" - "session" (nrepl-current-session) - "ns" (cider-current-ns) - "symbol" str - "context" context) - (nrepl-send-sync-request) - (nrepl-dict-get "completions"))) - -(defun cider-sync-request:info (symbol &optional class member) - "Send \"info\" op with parameters SYMBOL or CLASS and MEMBER." - (let ((var-info (-> `("op" "info" - "session" ,(nrepl-current-session) - "ns" ,(cider-current-ns) - ,@(when symbol (list "symbol" symbol)) - ,@(when class (list "class" class)) - ,@(when member (list "member" member))) - (nrepl-send-sync-request)))) - (if (member "no-info" (nrepl-dict-get var-info "status")) - nil - var-info))) - -(defun cider-sync-request:eldoc (symbol &optional class member) - "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER." - (let ((eldoc (-> `("op" "eldoc" - "session" ,(nrepl-current-session) - "ns" ,(cider-current-ns) - ,@(when symbol (list "symbol" symbol)) - ,@(when class (list "class" class)) - ,@(when member (list "member" member))) - (nrepl-send-sync-request)))) - (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) - nil - eldoc))) - -(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") - (-> (list "op" "macroexpand" - "expander" expander - "code" expr - "ns" (cider-current-ns) - "display-namespaces" - (or display-namespaces - (symbol-name cider-macroexpansion-display-namespaces))) - (nrepl-send-sync-request) - (nrepl-dict-get "expansion"))) - -(defun cider-sync-request:ns-list () - "Get a list of the available namespaces." - (cider--sync-request-value (list "op" "ns-list" - "session" (nrepl-current-session)))) - -(defun cider-sync-request:ns-vars (ns) - "Get a list of the vars in NS." - (cider--sync-request-value (list "op" "ns-vars" - "session" (nrepl-current-session) - "ns" ns))) - -(defun cider-sync-request:resource (name) - "Perform nREPL \"resource\" op with resource name NAME." - (-> (list "op" "resource" - "name" name) - (nrepl-send-sync-request) - (nrepl-dict-get "resource-path"))) - -(provide 'cider-client) - -;;; cider-client.el ends here diff --git a/packages/cider-0.8.2/cider-doc.el b/packages/cider-0.8.2/cider-doc.el deleted file mode 100644 index ec66c34..0000000 --- a/packages/cider-0.8.2/cider-doc.el +++ /dev/null @@ -1,365 +0,0 @@ -;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- - -;; Copyright © 2014 Jeff Valk - -;; Author: Jeff Valk - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Mode for formatting and presenting documentation - -;;; Code: - -(require 'cider-util) -(require 'org-table) -(require 'button) -(require 'dash) -(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 "A") 'cider-apropos-documentation) - (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 "g") 'cider-grimoire) - (define-key cider-doc-map (kbd "C-g") 'cider-grimoire) - (define-key cider-doc-map (kbd "h") '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.") - -(defvar cider-doc-menu - '("Documentation ..." - ["CiderDoc" cider-doc] - ["JavaDoc in browser" cider-javadoc] - ["Grimoire" cider-grimoire] - ["Grimoire in browser" cider-grimoire-web] - ["Search functions/vars" cider-apropos] - ["Search documentation" cider-apropos-documentation]) - "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 "j" 'cider-docview-javadoc) - (define-key map "s" 'cider-docview-source) - (define-key map (kbd "") 'backward-button) - (define-key map (kbd "TAB") 'forward-button) - (easy-menu-define cider-docview-mode-menu map - "Menu for CIDER's doc mode" - `("CiderDoc" - ["JavaDoc in browser" cider-docview-javadoc] - ["Jump to source" cider-docview-source] - "--" - ["Quit" cider-popup-buffer-quit-function] - )) - map)) - -(define-derived-mode cider-docview-mode special-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) - (message "No Javadoc available for %s" cider-docview-symbol))) - -(defun cider-docview-source () - "Open the source for the current symbol, if available." - (interactive) - (if cider-docview-file - (let ((buffer (and cider-docview-file - (not (cider--tooling-file-p cider-docview-file)) - (cider-find-file cider-docview-file)))) - (cider-jump-to buffer (cons cider-docview-line nil) nil)) - (message "No source location for %s" cider-docview-symbol))) - - -;;; 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-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 (nrepl-dict-get info "doc")) - (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")) - (clj-name (if ns (concat ns "/" name) name)) - (java-name (if member (concat class "/" member) class))) - (with-current-buffer buffer - (cl-flet ((emit (text &optional face) - (insert (if face - (propertize text 'font-lock-face face) - text)) - (newline))) - (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) - (newline)) - (when (or forms args) - (emit (cider-font-lock-as-clojure (or forms args)))) - (when (or special macro) - (emit (if special "Special Form" "Macro") 'font-lock-comment-face)) - (when added - (emit (concat "Added in " added) 'font-lock-comment-face)) - (when depr - (emit (concat "Deprecated in " depr) 'font-lock-comment-face)) - (when doc - (if class - (cider-docview-render-java-doc (current-buffer) doc) - (emit (concat " " doc)))) - (when url - (newline) - (insert " Please see ") - (insert-text-button url - 'url url - 'follow-link t - 'action (lambda (x) - (browse-url (button-get x 'url)))) - (newline)) - (when javadoc - (newline) - (newline) - (insert "For additional documentation, see the ") - (insert-text-button "Javadoc" - 'url javadoc - 'follow-link t - 'action (lambda (x) - (browse-url (button-get x 'url)))) - (insert ".") - (newline)) - (let ((beg (point-min)) - (end (point-max))) - (nrepl-dict-map (lambda (k v) - (put-text-property beg end k v)) - info))) - (current-buffer)))) - -(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")) - (inhibit-read-only t)) - (cider-docview-mode) - - (setq-local cider-docview-symbol symbol) - (setq-local cider-docview-javadoc-url javadoc) - (setq-local cider-docview-file file) - (setq-local cider-docview-line line) - - (remove-overlays) - (cider-docview-render-info buffer info) - - (goto-char (point-min)) - (current-buffer)))) - - -(provide 'cider-doc) - -;;; cider-doc.el ends here diff --git a/packages/cider-0.8.2/cider-eldoc.el b/packages/cider-0.8.2/cider-eldoc.el deleted file mode 100644 index bf05e5d..0000000 --- a/packages/cider-0.8.2/cider-eldoc.el +++ /dev/null @@ -1,160 +0,0 @@ -;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; eldoc support for Clojure. - -;;; Code: - -(require 'cider-client) -(require 'cider-interaction) ; for cider-symbol-at-point - -(require 'eldoc) -(require 'dash) - -(defvar cider-extra-eldoc-commands '("yas-expand") - "Extra commands to be added to eldoc's safe commands list.") - -(defvar-local cider-eldoc-last-symbol nil - "The eldoc information for the last symbol we checked.") - -(defun cider-eldoc-format-thing (thing) - "Format the eldoc THING." - (propertize thing 'face 'font-lock-function-name-face)) - -(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 (eq 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." - (-elem-index '& (append 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. " - (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 (1+ num-skipped-sexps)))))) - (error)) - num-skipped-sexps)) - -(defun cider-eldoc-info-in-current-sexp () - "Return a list of the current sexp and the current argument index." - (save-excursion - (let ((argument-index (1- (cider-eldoc-beginning-of-sexp)))) - ;; If we are at the beginning of function name, this will be -1. - (when (< argument-index 0) - (setq argument-index 0)) - ;; Don't do anything if current word is inside a string, vector, - ;; hash or set literal. - (if (member (or (char-after (1- (point))) 0) '(?\" ?\{ ?\[)) - nil - (list (cider-symbol-at-point) argument-index))))) - -(defun cider-eldoc-arglist (thing) - "Return the arglist for THING." - (when (and (nrepl-op-supported-p "eldoc") - thing - (not (string= thing "")) - (not (string-prefix-p ":" thing))) - ;; check if we can used the cached eldoc info - (if (string= thing (car cider-eldoc-last-symbol)) - (cdr cider-eldoc-last-symbol) - (-when-let (eldoc-info (cider-sync-request:eldoc (substring-no-properties thing))) - (let ((arglist (nrepl-dict-get eldoc-info "eldoc"))) - (setq cider-eldoc-last-symbol (cons thing arglist)) - arglist))))) - -(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* ((info (cider-eldoc-info-in-current-sexp)) - (thing (car info)) - (pos (cadr info)) - (value (cider-eldoc-arglist thing))) - (when value - (format "%s: %s" - (cider-eldoc-format-thing thing) - (cider-eldoc-format-arglist value pos)))))) - -(defun cider-turn-on-eldoc-mode () - "Turn on eldoc mode in the current buffer." - (setq-local eldoc-documentation-function 'cider-eldoc) - (apply 'eldoc-add-command cider-extra-eldoc-commands) - (eldoc-mode +1)) - -(provide 'cider-eldoc) - -;;; cider-eldoc.el ends here diff --git a/packages/cider-0.8.2/cider-grimoire.el b/packages/cider-0.8.2/cider-grimoire.el deleted file mode 100644 index 0d6dcbf..0000000 --- a/packages/cider-0.8.2/cider-grimoire.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; cider-grimoire.el --- Grimoire integration -*- lexical-binding: t -*- - -;; Copyright © 2014 Bozhidar Batsov -;; -;; Author: Bozhidar Batsov - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A few commands for Grimoire documentation lookup. - -;;; Code: - -(require 'cider-interaction) - -(defconst cider-grimoire-url "http://conj.io/") - -(defun cider-grimoire-replace-special (name) - "Convert the dashes in NAME to a grimoire friendly format." - (->> 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 clojure-version) - "Generate a grimoire url from NAME, NS and CLOJURE-VERSION." - (let ((clojure-version (concat (substring clojure-version 0 4) "0")) - (base-url cider-grimoire-url)) - (if name - (concat base-url clojure-version "/" ns "/" (cider-grimoire-replace-special name) "/") - (concat base-url clojure-version "/" ns "/")))) - -(defun cider-grimoire-web-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"))) - ;; TODO: add a whitelist of supported namespaces - (browse-url (cider-grimoire-url name ns (cider--clojure-version)))) - (message "Symbol %s not resolved" symbol))) - -;;;###autoload -(defun cider-grimoire-web (query) - "Open the grimoire documentation for QUERY in the default web browser." - (interactive "P") - (cider-read-symbol-name "Symbol: " 'cider-grimoire-web-lookup query)) - -(defun cider-create-grimoire-buffer (content) - "Create a new grimoire buffer with CONTENT." - (with-current-buffer (cider-popup-buffer "*cider grimoire*" 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")))) - ;; TODO: add a whitelist of supported namespaces - (url-retrieve (cider-grimoire-url name ns (cider--clojure-version)) - (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)))))) - (message "Symbol %s not resolved" symbol))) - -;;;###autoload -(defun cider-grimoire (query) - "Open the grimoire documentation for QUERY in a popup buffer." - (interactive "P") - (cider-read-symbol-name "Symbol: " 'cider-grimoire-lookup query)) - -(provide 'cider-grimoire) diff --git a/packages/cider-0.8.2/cider-inspector.el b/packages/cider-0.8.2/cider-inspector.el deleted file mode 100644 index bdafe7d..0000000 --- a/packages/cider-0.8.2/cider-inspector.el +++ /dev/null @@ -1,238 +0,0 @@ -;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*- - -;; Copyright © 2013-2014 Vital Reactor, LLC -;; Copyright © 2014 Bozhidar Batsov - -;; Author: Ian Eslick -;; Bozhidar Batsov - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Clojure object inspector inspired by SLIME. - -;;; Code: - -(require 'cl-lib) -(require 'cider-interaction) - -;; =================================== -;; Inspector Key Map and Derived Mode -;; =================================== - -(defconst cider-inspector-buffer "*cider inspect*") - -(push cider-inspector-buffer cider-ancillary-buffers) - -(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) - (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 - (define-key map [backtab] 'cider-inspector-previous-inspectable-object) ; to BACKTAB on X. - map)) - -(define-derived-mode cider-inspector-mode fundamental-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 (expression) - "Eval the string EXPRESSION and inspect the result." - (interactive - (list (cider-read-from-minibuffer "Inspect value: " - (cider-sexp-at-point)))) - (cider-ensure-op-supported "inspect-start") - (cider-inspect-sym expression (cider-current-ns))) - -;; Operations -(defun cider-render-response (buffer) - (nrepl-make-response-handler - buffer - (lambda (buffer str) - (cider-irender buffer str)) - '() - (lambda (buffer _str) - (cider-emit-into-popup-buffer buffer "Oops")) - '())) - -(defun cider-inspect-sym (sym ns) - (let ((buffer (cider-popup-buffer cider-inspector-buffer t))) - (nrepl-send-request (list "op" "inspect-start" "sym" sym "ns" ns) - (cider-render-response buffer)))) - -(defun cider-inspector-pop () - (interactive) - (let ((buffer (cider-popup-buffer cider-inspector-buffer t))) - (nrepl-send-request (list "op" "inspect-pop") - (cider-render-response buffer)))) - -(defun cider-inspector-push (idx) - (let ((buffer (cider-popup-buffer cider-inspector-buffer t))) - (nrepl-send-request (list "op" "inspect-push" "idx" (number-to-string idx)) - (cider-render-response buffer)))) - -(defun cider-inspector-refresh () - (interactive) - (let ((buffer (cider-popup-buffer cider-inspector-buffer t))) - (nrepl-send-request (list "op" "inspect-refresh") - (cider-render-response buffer)))) - -;; Render Inspector from Structured Values -(defun cider-irender (buffer str) - (with-current-buffer buffer - (cider-inspector-mode) - (let ((inhibit-read-only t)) - (condition-case nil - (cider-irender* (car (read-from-string str))) - (error (newline) (insert "Inspector error for: " str)))) - (goto-char (point-min)))) - -(defun cider-irender* (elements) - (dolist (el elements) - (cider-irender-el* el))) - -(defun cider-irender-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)) - (newline)) - ((and (consp el) (eq (car el) :value)) - (cider-irender-value (cadr el) (caddr el))) - (t (message "Unrecognized inspector object: %s" el)))) - -(defun cider-irender-value (value idx) - (cider-propertize-region - (list 'cider-value-idx idx - 'mouse-face 'highlight) - (cider-irender-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 (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) - (cl-destructuring-bind (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) - (cl-destructuring-bind (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 recursivly 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) - (cl-destructuring-bind (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))) - ;; (get-text-property point 'cider-range-button) - ;; (get-text-property point 'cider-action-number))) - (goto-char point) - (cider-inspector-operate-on-point)) - (t - (error "No clickable part here"))))) - -(provide 'cider-inspector) - -;;; cider-inspector.el ends here diff --git a/packages/cider-0.8.2/cider-interaction.el b/packages/cider-0.8.2/cider-interaction.el deleted file mode 100644 index 1d320e2..0000000 --- a/packages/cider-0.8.2/cider-interaction.el +++ /dev/null @@ -1,1802 +0,0 @@ -;;; cider-interaction.el --- IDE for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides an Emacs Lisp client to connect to Clojure nREPL servers. - -;;; Code: - -(require 'cider-client) -(require 'cider-util) -(require 'cider-stacktrace) -(require 'cider-test) -(require 'cider-doc) - -(require 'clojure-mode) -(require 'dash) -(require 'thingatpt) -(require 'etags) -(require 'arc-mode) -(require 'ansi-color) -(require 'cl-lib) -(require 'compile) -(require 'tramp) -(require 'button) -(require 'apropos) - -(defconst cider-error-buffer "*cider-error*") -(defconst cider-read-eval-buffer "*cider-read-eval*") -(defconst cider-doc-buffer "*cider-doc*") -(defconst cider-result-buffer "*cider-result*") -(defconst cider-nrepl-session-buffer "*cider-nrepl-session*") - -(define-obsolete-variable-alias 'cider-use-local-resources - 'cider-prefer-local-resources "0.7.0") - -(defcustom cider-prefer-local-resources nil - "Prefer local resources to remote (tramp) ones when both are available." - :type 'boolean - :group 'cider) - -(defcustom cider-show-error-buffer t - "Control the popup behavior of cider stacktraces. -The following values are possible t or 'always, 'except-in-repl, -'only-in-repl. Any other value, including nil, will cause the stacktrace -not to be automatically shown. - -Irespective of the value of this variable, the `cider-error-buffer' is -always generated in the background. Use `cider-visit-error-buffer' to -navigate to this buffer." - :type '(choice (const :tag "always" t) - (const except-in-repl) - (const only-in-repl) - (const :tag "never" nil)) - :group 'cider) - -(define-obsolete-variable-alias 'cider-popup-stacktraces - 'cider-show-error-buffer "0.7.0") - -(defcustom cider-auto-jump-to-error t - "When non-nil automatically jump to error location during interactive compilation. -When set to 'errors-only, don't jump to warnings." - :type '(choice (const :tag "always" t) - (const errors-only) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-auto-select-error-buffer t - "Controls whether to auto-select the error popup buffer." - :type 'boolean - :group 'cider) - -(defcustom cider-interactive-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-switch-to-repl-command 'cider-switch-to-relevant-repl-buffer - "Select the command to be invoked when switching-to-repl. -The default option is `cider-switch-to-relevant-repl-buffer'. If -you'd like to not use smart matching of repl buffer based on -project directory, you can assign it to `cider-switch-to-current-repl-buffer' -which will use the default REPL connection." - :type 'symbol - :group 'cider) - -(defcustom cider-prompt-save-file-on-load t - "Controls whether to prompt to save the file when loading a buffer." - :type 'boolean - :group 'cider - :package-version '(cider . "0.6.0")) - -(defcustom cider-completion-use-context t - "When true, uses context at point to improve completion suggestions." - :type 'boolean - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-annotate-completion-candidates nil - "When true, annotate completion candidates with some extra information." - :type 'boolean - :group 'cider - :package-version '(cider . "0.8.0")) - -(defconst cider-output-buffer "*cider-out*") - -(defcustom cider-interactive-eval-output-destination 'repl-buffer - "The destination for stdout and stderr produced from interactive evaluation." - :type '(choice (const output-buffer) - (const repl-buffer)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defface cider-error-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "red") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline t))) - "Face used to highlight compilation errors in Clojure buffers." - :group 'cider) - -(defface cider-warning-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "yellow") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline (:color "yellow")))) - "Face used to highlight compilation warnings in Clojure buffers." - :group 'cider) - -(defvar cider-required-nrepl-ops - '("apropos" "classpath" "complete" "eldoc" "info" - "inspect-start" "inspect-refresh" - "inspect-pop" "inspect-push" "inspect-reset" - "macroexpand" "ns-list" "ns-vars" - "resource" "stacktrace" "toggle-trace-var" "toggle-trace-ns" "undef") - "A list of nREPL ops required by CIDER to function properly. - -All of them are provided by CIDER's nREPL middleware (cider-nrepl).") - -(defun cider-ensure-op-supported (op) - "Check for support of middleware op OP. -Signal an error if it is not supported." - (unless (nrepl-op-supported-p op) - (error "Can't find nREPL middleware providing op \"%s\". Please, install (or update) cider-nrepl %s and restart CIDER" op (upcase cider-version)))) - -(defun cider--check-required-nrepl-ops () - "Check whether all required nREPL ops are present." - (let ((missing-ops (-remove 'nrepl-op-supported-p cider-required-nrepl-ops))) - (when missing-ops - (cider-repl-emit-interactive-output - (format "WARNING: The following required nREPL ops are not supported: \n%s\nPlease, install (or update) cider-nrepl %s and restart CIDER" - (cider-string-join missing-ops " ") - (upcase cider-version)))))) - -;;; Connection info -(defun cider--java-version () - "Retrieve the underlying connection's Java version." - (with-current-buffer (nrepl-current-connection-buffer) - (when nrepl-versions - (-> nrepl-versions - (nrepl-dict-get "java") - (nrepl-dict-get "version-string"))))) - -(defun cider--clojure-version () - "Retrieve the underlying connection's Clojure version." - (with-current-buffer (nrepl-current-connection-buffer) - (when nrepl-versions - (-> nrepl-versions - (nrepl-dict-get "clojure") - (nrepl-dict-get "version-string"))))) - -(defun cider--nrepl-version () - "Retrieve the underlying connection's nREPL version." - (with-current-buffer (nrepl-current-connection-buffer) - (when nrepl-versions - (-> nrepl-versions - (nrepl-dict-get "nrepl") - (nrepl-dict-get "version-string"))))) - -(defun cider--check-middleware-compatibility-callback (buffer) - "A callback to check if the middleware used is compatible with CIDER." - (nrepl-make-response-handler - buffer - (lambda (_buffer result) - (let ((middleware-version (read result))) - (unless (and middleware-version (equal cider-version middleware-version)) - (cider-repl-emit-interactive-err-output (format "WARNING: CIDER's version (%s) does not match cider-nrepl's version (%s)" cider-version middleware-version))))) - '() - '() - '())) - -(defun cider--check-middleware-compatibility () - "Retrieve the underlying connection's CIDER nREPL version." - (cider-eval "(try (require 'cider.nrepl.version) - (:version-string @(resolve 'cider.nrepl.version/version)) - (catch Throwable _ \"not installed\"))" - (cider--check-middleware-compatibility-callback (current-buffer)))) - -(defun cider--connection-info (connection-buffer) - "Return info about CONNECTION-BUFFER. - -Info contains project name, current REPL namespace, host:port -endpoint and Clojure version." - (with-current-buffer (get-buffer connection-buffer) - (format "Active nREPL connection: %s:%s, %s:%s (Java %s, Clojure %s, nREPL %s)" - (or (nrepl--project-name nrepl-project-dir) "") - nrepl-buffer-ns - (car nrepl-endpoint) - (cadr nrepl-endpoint) - (cider--java-version) - (cider--clojure-version) - (cider--nrepl-version)))) - -(defun cider-display-current-connection-info () - "Display information about the current connection." - (interactive) - (message (cider--connection-info (nrepl-current-connection-buffer)))) - -(defun cider-rotate-connection () - "Rotate and display the current nREPL connection." - (interactive) - (cider-ensure-connected) - (setq nrepl-connection-list - (append (cdr nrepl-connection-list) - (list (car nrepl-connection-list)))) - (message (cider--connection-info (car nrepl-connection-list)))) - -(defun cider-extract-designation-from-current-repl-buffer () - "Extract the designation from the cider repl buffer name." - (let ((repl-buffer-name (cider-current-repl-buffer)) - (template (split-string nrepl-repl-buffer-name-template "%s"))) - (string-match (format "^%s\\(.*\\)%s" - (regexp-quote (concat (car template) nrepl-buffer-name-separator)) - (regexp-quote (cadr template))) - repl-buffer-name) - (or (match-string 1 repl-buffer-name) ""))) - -(defun cider-change-buffers-designation () - "Change the designation in cider buffer names. -Buffer names changed are cider-repl and nrepl-server." - (interactive) - (cider-ensure-connected) - (let* ((designation (read-string (format "Change CIDER buffer designation from '%s': " - (cider-extract-designation-from-current-repl-buffer)))) - (new-repl-buffer-name (nrepl-format-buffer-name-template - nrepl-repl-buffer-name-template designation))) - (with-current-buffer (cider-current-repl-buffer) - (rename-buffer new-repl-buffer-name) - (setq-local nrepl-repl-buffer new-repl-buffer-name) - (setq-local nrepl-connection-buffer new-repl-buffer-name) - (setq nrepl-connection-list - (cons new-repl-buffer-name (cdr nrepl-connection-list))) - (when nrepl-server-buffer - (let ((new-server-buffer-name (nrepl-format-buffer-name-template - nrepl-server-buffer-name-template designation))) - (with-current-buffer nrepl-server-buffer - (rename-buffer new-server-buffer-name)) - (setq-local nrepl-server-buffer new-server-buffer-name)))) - (message "CIDER buffer designation changed to: %s" designation))) - -;;; 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.") - -(defvar cider-current-clojure-buffer nil - "This variable holds current buffer temporarily when connecting to a REPL. -It is set to current buffer when `cider' or `cider-jack-in' is called. -After the REPL buffer is created, the value of this variable is used -to call `cider-remember-clojure-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 (&optional arg) - "Invoke `cider-switch-to-repl-command'." - (interactive "p") - (funcall cider-switch-to-repl-command arg)) - -(defun cider-switch-to-current-repl-buffer (&optional arg) - "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. - -With a prefix ARG sets the namespace in the REPL buffer to that -of the namespace in the Clojure source buffer." - (interactive "p") - (cider-ensure-connected) - (let ((buffer (current-buffer))) - (when (eq 4 arg) - (cider-repl-set-ns (cider-current-ns))) - (pop-to-buffer (cider-get-repl-buffer)) - (cider-remember-clojure-buffer buffer) - (goto-char (point-max)))) - -(defun cider-find-connection-buffer-for-project-directory (project-directory) - "Find the relevant connection-buffer for the given PROJECT-DIRECTORY. - -A check is made to ensure that all connection buffers have a project-directory -otherwise there is ambiguity as to which connection buffer should be selected. - -If there are multiple connection buffers matching PROJECT-DIRECTORY there -is ambiguity, therefore nil is returned." - (unless (-filter - (lambda (conn) - (not - (with-current-buffer (get-buffer conn) - nrepl-project-dir))) - nrepl-connection-list) - (let ((matching-connections - (-filter - (lambda (conn) - (let ((conn-proj-dir (with-current-buffer (get-buffer conn) - nrepl-project-dir))) - (when conn-proj-dir - (equal (file-truename project-directory) - (file-truename conn-proj-dir))))) - nrepl-connection-list))) - (when (= 1 (length matching-connections)) - (car matching-connections))))) - -(defun cider-switch-to-relevant-repl-buffer (&optional arg) - "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 sets the namespace in the REPL buffer to that -of the namespace in the Clojure source buffer. - -With a second prefix ARG the chosen REPL buffer is based on a -supplied project directory." - (interactive "p") - (cider-ensure-connected) - (let* ((project-directory - (or (when (eq 16 arg) (read-directory-name "Project: ")) - (nrepl-project-directory-for (nrepl-current-dir)))) - (connection-buffer - (or - (and (= 1 (length nrepl-connection-list)) (car nrepl-connection-list)) - (and project-directory - (cider-find-connection-buffer-for-project-directory project-directory))))) - (when connection-buffer - (setq nrepl-connection-list - (cons connection-buffer (delq connection-buffer nrepl-connection-list)))) - (cider-switch-to-current-repl-buffer arg) - (message - (format (if connection-buffer - "Switched to REPL: %s" - "Could not determine relevant nREPL connection, using: %s") - (with-current-buffer (nrepl-current-connection-buffer) - (format "%s:%s, %s:%s" - (or (nrepl--project-name nrepl-project-dir) "") - nrepl-buffer-ns - (car nrepl-endpoint) - (cadr nrepl-endpoint))))))) - -(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)) - (pop-to-buffer cider-last-clojure-buffer) - (message "Don't know the original Clojure buffer"))) - -(defun cider-find-and-clear-repl-buffer () - "Find the current REPL buffer and clear it. -Returns to the buffer in which the command was invoked." - (interactive) - (let ((origin-buffer (current-buffer))) - (switch-to-buffer (cider-current-repl-buffer)) - (cider-repl-clear-buffer) - (switch-to-buffer origin-buffer))) - -(defvar cider-minibuffer-history '() - "History list of expressions read from the minibuffer.") - -(defvar cider-minibuffer-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "TAB") 'complete-symbol) - (define-key map (kbd "M-TAB") 'complete-symbol) - map) - "Minibuffer keymap used for reading Clojure expressions.") - -(defun cider-read-from-minibuffer (prompt &optional initial-value) - "Read a string from the minibuffer, prompting with PROMPT. -If INITIAL-VALUE is non-nil, it is inserted into the minibuffer before -reading input." - (minibuffer-with-setup-hook - (lambda () - (set-syntax-table clojure-mode-syntax-table) - (add-hook 'completion-at-point-functions - #'cider-complete-at-point nil t) - (run-hooks 'eval-expression-minibuffer-setup-hook)) - (read-from-minibuffer prompt initial-value - cider-minibuffer-map nil - 'cider-minibuffer-history))) - - -;;; Utilities - -(defun cider--clear-compilation-highlights () - "Remove compilation highlights." - (remove-overlays (point-min) (point-max) 'cider-note-p t)) - -(defun cider-clear-compilation-highlights (&optional arg) - "Remove compilation highlights. - -When invoked with a prefix ARG the command doesn't prompt for confirmation." - (interactive "P") - (when (or arg (y-or-n-p "Are you sure you want to clear the compilation highlights? ")) - (cider--clear-compilation-highlights))) - -(defun cider-defun-at-point () - "Return the text of the top-level sexp at point." - (apply #'buffer-substring-no-properties - (cider--region-for-defun-at-point))) - -(defun cider--region-for-defun-at-point () - "Return the start and end position of defun at point." - (save-excursion - (save-match-data - (end-of-defun) - (let ((end (point))) - (beginning-of-defun) - (list (point) end))))) - -(defun cider-defun-at-point-start-pos () - "Return the starting position of the current defun." - (car (cider--region-for-defun-at-point))) - -(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-bounds-of-sexp-at-point () - "Return the bounds sexp at point as a pair (or nil)." - (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))) - -;; FIXME: This doesn't have properly at the beginning of the REPL prompt -(defun cider-symbol-at-point () - "Return the name of the symbol at point, otherwise nil." - (let ((str (substring-no-properties (or (thing-at-point 'symbol) "")))) - (if (equal str (concat (cider-current-ns) "> ")) - "" - str))) - -(defun cider-sexp-at-point () - "Return the sexp at point as a string, otherwise nil." - (let ((bounds (cider-bounds-of-sexp-at-point))) - (if bounds - (buffer-substring-no-properties (car bounds) - (cdr bounds))))) - -(defun cider-sexp-at-point-with-bounds () - "Return a list containing the sexp at point and its bounds." - (let ((bounds (cider-bounds-of-sexp-at-point))) - (if bounds - (let ((start (car bounds)) - (end (cdr bounds))) - (list (buffer-substring-no-properties start end) - (cons (set-marker (make-marker) start) - (set-marker (make-marker) end))))))) - -(defun cider-last-sexp () - "Return the sexp preceding the point." - (buffer-substring-no-properties - (save-excursion - (backward-sexp) - (point)) - (point))) - -(defun cider-last-sexp-start-pos () - (save-excursion - (backward-sexp) - (point))) - -;;; -(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 - (if (eq system-type 'cygwin) - (lambda (resource) (let ((fixed-resource (replace-regexp-in-string "^/" "" resource))) - (replace-regexp-in-string - "\n" "" - (shell-command-to-string (format "cygpath --unix '%s'" fixed-resource))))) - #'identity) - "Function to translate nREPL namestrings to Emacs filenames.") - -(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)))) - -(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--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." - (string-match-p "\\bform-init" (file-name-nondirectory file-name))) - -(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." - (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 (get-file-buffer 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-find-var-file (var) - "Return the buffer visiting the file in which VAR is defined, or nil if -not found." - (cider-ensure-op-supported "info") - (-when-let* ((info (cider-var-info var)) - (file (nrepl-dict-get info "file"))) - (cider-find-file file))) - -(defun cider-jump-to (buffer &optional pos other-window) - "Push current point onto marker ring, and jump to BUFFER and POS. -POS can be either a numeric position in BUFFER or a cons (LINE . COLUMN) -where COLUMN can be nil. If OTHER-WINDOW is non-nil don't reuse current -window." - (ring-insert find-tag-marker-ring (point-marker)) - (if other-window - (pop-to-buffer buffer) - ;; like switch-to-buffer, but reuse existing window if BUFFER is visible - (pop-to-buffer buffer '((display-buffer-reuse-window display-buffer-same-window)))) - (with-current-buffer buffer - (widen) - (goto-char (point-min)) - (cider-mode +1) - (if (consp pos) - (progn - (forward-line (1- (or (car pos) 1))) - (if (cdr pos) - (move-to-column (cdr pos)) - (back-to-indentation))) - (when pos - (goto-char pos))))) - -(defun cider-jump-to-resource (path) - "Jump to the resource at the resource-relative PATH. -When called interactively, this operates on point." - (interactive (list (thing-at-point 'filename))) - (cider-ensure-op-supported "resource") - (-if-let* ((resource (cider-sync-request:resource path)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer) - (message "Cannot find resource %s" path))) - -(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-jamp-to'." - (let* ((line (nrepl-dict-get info "line")) - (file (nrepl-dict-get info "file")) - (buffer (and file - (not (cider--tooling-file-p file)) - (cider-find-file file)))) - (if buffer - (cider-jump-to buffer (cons line nil) other-window) - (message "No source location")))) - -(defun cider-jump-to-var (&optional var line) - "Jump to the definition of VAR, optionally at a specific LINE. -When called interactively, this operates on point, or falls back to a prompt." - (interactive) - (cider-ensure-op-supported "info") - (cider-read-symbol-name - "Symbol: " (lambda (var) - (-if-let (info (cider-var-info var)) - (cider--jump-to-loc-from-info info) - (message "Symbol %s not resolved" var))))) - -(define-obsolete-function-alias 'cider-jump 'cider-jump-to-var "0.7.0") -(defalias 'cider-jump-back 'pop-tag-mark) - -(defvar cider-completion-last-context nil) - -(defun cider-completion-symbol-start-pos () - "Find the starting position of the symbol at point, unless inside a string." - (let ((sap (symbol-at-point))) - (when (and sap (not (in-string-p))) - (car (bounds-of-thing-at-point 'symbol))))) - -(defun cider-completion-get-context-at-point () - "Extract the context at point. -If point is not inside the list, returns nil; otherwise return top-level -form, with symbol at point replaced by __prefix__." - (when (save-excursion - (condition-case _ - (progn - (up-list) - (check-parens) - t) - (scan-error nil) - (user-error nil))) - (save-excursion - (let* ((pref-end (point)) - (pref-start (cider-completion-symbol-start-pos)) - (context (cider-defun-at-point)) - (_ (beginning-of-defun)) - (expr-start (point))) - (concat (substring context 0 (- pref-start expr-start)) - "__prefix__" - (substring context (- pref-end expr-start))))))) - -(defun cider-completion-get-context () - "Extract context depending on `cider-completion-use-context' and major mode." - (let ((context (if (and cider-completion-use-context - ;; Important because `beginning-of-defun' and - ;; `ending-of-defun' work incorrectly in the REPL - ;; buffer, so context extraction fails there. - (derived-mode-p 'clojure-mode)) - (or (cider-completion-get-context-at-point) - "nil") - "nil"))) - (if (string= cider-completion-last-context context) - ":same" - (setq cider-completion-last-context context) - context))) - -(defun cider-complete (str) - "Complete STR with context at point." - (cider-sync-request:complete str (cider-completion-get-context))) - -(defun cider-annotate-symbol (symbol) - "Append extra information to SYMBOL's name. - -Currently we annotate macros, special-forms and functions, -as it's not obvious from their names alone which is which." - (if cider-annotate-completion-candidates - (-when-let (info (cider-var-info symbol)) - (let ((macro (nrepl-dict-get info "macro")) - (special (nrepl-dict-get info "special-form")) - (args (nrepl-dict-get info "arglists-str"))) - (cond - (macro " ") - (special " ") - (args " ")))) - "")) - -(defun cider-complete-at-point () - "Complete the symbol at point." - (let ((sap (symbol-at-point))) - (when (and sap (not (in-string-p)) (cider-connected-p)) - (let ((bounds (bounds-of-thing-at-point 'symbol))) - (list (car bounds) (cdr bounds) - (completion-table-dynamic #'cider-complete) - :annotation-function #'cider-annotate-symbol - :company-doc-buffer #'cider-create-doc-buffer - :company-location #'cider-company-location - :company-docsig #'cider-company-docsig))))) - -(defun cider-company-location (var) - "Open VAR's definition in a buffer. - -Returns the cons of the buffer itself and the location of VAR's definition -in the buffer." - (-when-let* ((info (cider-var-info var)) - (file (nrepl-dict-get info "file")) - (line (nrepl-dict-get info "line")) - (buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (cons buffer (point)))))) - -(defun cider-company-docsig (thing) - "Return signature for THING." - (let ((arglist (cider-eldoc-arglist thing))) - (when arglist - (format "%s: %s" - (cider-eldoc-format-thing thing) - (cider-eldoc-format-arglist arglist 0))))) - -(defun cider-javadoc-handler (symbol-name) - "Invoke the nREPL \"info\" op on SYMBOL-NAME if available." - (when symbol-name - (cider-ensure-op-supported "info") - (let* ((info (cider-var-info symbol-name)) - (url (nrepl-dict-get info "javadoc"))) - (if url - (browse-url url) - (error "No Javadoc available for %s" symbol-name))))) - -(defun cider-javadoc (query) - "Browse Javadoc on the Java symbol QUERY at point." - (interactive "P") - (cider-read-symbol-name "Javadoc for: " 'cider-javadoc-handler query)) - -(defun cider-stdin-handler (&optional buffer) - "Make a stdin response handler for BUFFER." - (nrepl-make-response-handler (or buffer (current-buffer)) - (lambda (buffer value) - (cider-repl-emit-result buffer value t)) - (lambda (buffer out) - (cider-repl-emit-output buffer out)) - (lambda (buffer err) - (cider-repl-emit-output buffer err)) - nil)) - -(defun cider-insert-eval-handler (&optional buffer) - "Make a nREPL evaluation handler for the BUFFER. -The handler simply inserts the result value in BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (with-current-buffer buffer - (insert value))) - (lambda (_buffer out) - (cider-repl-emit-interactive-output out)) - (lambda (buffer err) - (cider-handle-compilation-errors err eval-buffer)) - '()))) - -(defun cider--emit-interactive-eval-output (output repl-emit-function) - "Emit output resulting from interactive code evaluation. - -The output can be send to either a dedicated output buffer or the current REPL buffer. -This is controlled via `cider-interactive-eval-output-destination'." - (pcase cider-interactive-eval-output-destination - (`output-buffer (let ((output-buffer (or (get-buffer cider-output-buffer) - (cider-popup-buffer cider-output-buffer t)))) - (cider-emit-into-popup-buffer output-buffer output) - (pop-to-buffer output-buffer))) - (`repl-buffer (funcall repl-emit-function output)) - (t (error "Unsupported value %s for `cider-interactive-eval-output-destination'" - cider-interactive-eval-output-destination)))) - -(defun cider-emit-interactive-eval-output (output) - "Emit output resulting from interactive code evaluation. - -The output can be send to either a dedicated output buffer or the current REPL buffer. -This is controlled via `cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-output)) - -(defun cider-emit-interactive-eval-err-output (output) - "Emit err output resulting from interactive code evaluation. - -The output can be send to either a dedicated output buffer or the current REPL buffer. -This is controlled via `cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-err-output)) - -(defun cider--display-interactive-eval-result (value) - "Display the result VALUE of an interactive eval operation." - (message "%s%s" - cider-interactive-eval-result-prefix - (cider-font-lock-as-clojure value))) - -(defun cider-interactive-eval-handler (&optional buffer) - "Make an interactive eval handler for BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (cider--display-interactive-eval-result value)) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (buffer err) - (cider-emit-interactive-eval-err-output err) - (cider-handle-compilation-errors err eval-buffer)) - '()))) - -(defun cider-load-file-handler (&optional buffer) - "Make a load file handler for BUFFER." - (let ((eval-buffer (current-buffer))) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (buffer value) - (cider--display-interactive-eval-result value) - (with-current-buffer buffer - (run-hooks 'cider-file-loaded-hook))) - (lambda (_buffer value) - (cider-emit-interactive-eval-output value)) - (lambda (buffer err) - (cider-emit-interactive-eval-err-output err) - (cider-handle-compilation-errors err eval-buffer)) - '() - (lambda (buffer ex root-ex session) - (funcall nrepl-err-handler - buffer ex root-ex session))))) - -(defun cider-eval-print-handler (&optional buffer) - "Make a handler for evaluating and printing result in BUFFER." - (nrepl-make-response-handler (or buffer (current-buffer)) - (lambda (buffer value) - (with-current-buffer buffer - (insert - (if (derived-mode-p 'cider-clojure-interaction-mode) - (format "\n%s\n" value) - value)))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - '())) - -(defun cider-popup-eval-out-handler (&optional buffer) - "Make a handler for evaluating and printing stdout/stderr in popup BUFFER. - -This is used by pretty-printing commands and intentionally discards their results." - (nrepl-make-response-handler (or buffer (current-buffer)) - '() - (lambda (buffer str) - (cider-emit-into-popup-buffer buffer str)) - (lambda (buffer str) - (cider-emit-into-popup-buffer buffer str)) - '())) - -(defun cider-visit-error-buffer () - "Visit the `cider-error-buffer' (usually *cider-error*) if it exists." - (interactive) - (let ((buffer (get-buffer cider-error-buffer))) - (if buffer - (cider-popup-buffer-display buffer cider-auto-select-error-buffer) - (error "No %s buffer" cider-error-buffer)))) - -(defun cider-find-property (property &optional backward) - "Find the next text region which has the specified PROPERTY. -If BACKWARD is t, then search backward. -Returns the position at which PROPERTY was found, or nil if not found." - (let ((p (if backward - (previous-single-char-property-change (point) property) - (next-single-char-property-change (point) property)))) - (when (and (not (= p (point-min))) (not (= p (point-max)))) - p))) - -(defun cider-jump-to-compilation-error (&optional _arg _reset) - "Jump to the line causing the current compilation error. - -_ARG and _RESET are ignored, as there is only ever one compilation error. -They exist for compatibility with `next-error'." - (interactive) - (cl-labels ((goto-next-note-boundary - () - (let ((p (or (cider-find-property 'cider-note-p) - (cider-find-property 'cider-note-p t)))) - (when p - (goto-char p) - (message (get-char-property p 'cider-note)))))) - ;; if we're already on a compilation error, first jump to the end of - ;; it, so that we find the next error. - (when (get-char-property (point) 'cider-note-p) - (goto-next-note-boundary)) - (goto-next-note-boundary))) - -(defun cider-default-err-eval-handler (buffer session) - "Display in BUFFER the last SESSION exception, without middleware support." - (cider-eval "(clojure.stacktrace/print-cause-trace *e)" - (lambda (response) - (nrepl-dbind-response response (out) - (when out - (with-current-buffer buffer - (cider-emit-into-color-buffer buffer out) - (compilation-minor-mode +1))))) - nil - session)) - -(defun cider-default-err-op-handler (buffer session) - "Display in BUFFER the last SESSION exception, with middleware support." - (let (causes) - (nrepl-send-request - (append - (list "op" "stacktrace" "session" session) - (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 buffer (reverse causes)))))))))) - -(defun cider--show-error-buffer-p (buffer) - "Return non-nil if stacktrace buffer must be shown on error. -Takes into account the current BUFFER and the value of `cider-show-error-buffer'." - (let ((replp (with-current-buffer buffer (derived-mode-p 'cider-repl-mode)))) - (memq cider-show-error-buffer - (if replp - '(t always only-in-repl) - '(t always except-in-repl))))) - -(defun cider-default-err-handler (buffer ex root-ex session) - "Make an error handler for BUFFER, EX, ROOT-EX and SESSION. -This function determines how the error buffer is shown, and then delegates -the actual error content to the eval or op handler." - (let* ((error-buffer (if (cider--show-error-buffer-p buffer) - (cider-popup-buffer cider-error-buffer - cider-auto-select-error-buffer) - (cider-make-popup-buffer cider-error-buffer)))) - (if (nrepl-op-supported-p "stacktrace") - (cider-default-err-op-handler error-buffer session) - (cider-default-err-eval-handler error-buffer session)))) - -(defvar cider-compilation-regexp - '("\\(?:.*\\(warning, \\)\\|.*?\\(, compiling\\):(\\)\\([^:]*\\):\\([[:digit:]]+\\)\\(?::\\([[:digit:]]+\\)\\)?\\(\\(?: - \\(.*\\)\\)\\|)\\)" 3 4 5 (1)) - "Specifications for matching errors and warnings in Clojure stacktraces. -See `compilation-error-regexp-alist' for help on their format.") - -(add-to-list 'compilation-error-regexp-alist-alist - (cons 'cider cider-compilation-regexp)) -(add-to-list 'compilation-error-regexp-alist 'cider) - -(defun cider-extract-error-info (regexp message) - "Extract error information with REGEXP against MESSAGE." - (let ((file (nth 1 regexp)) - (line (nth 2 regexp)) - (col (nth 3 regexp)) - (type (nth 4 regexp)) - (pat (car regexp))) - (when (string-match pat message) - ;; special processing for type (1.2) style - (setq type (if (consp type) - (or (and (car type) (match-end (car type)) 1) - (and (cdr type) (match-end (cdr type)) 0) - 2))) - (list - (when file - (let ((val (match-string-no-properties file message))) - (unless (string= val "NO_SOURCE_PATH") val))) - (when line (string-to-number (match-string-no-properties line message))) - (when col - (let ((val (match-string-no-properties col message))) - (when val (string-to-number val)))) - (aref [cider-warning-highlight-face - cider-warning-highlight-face - cider-error-highlight-face] - (or type 2)) - message)))) - -(defun cider--goto-expression-start () - "Go to the beginning a list, vector, map or set outside of a string. - -We do so by starting and the current position and proceeding backwards -until we find a delimiters that's not inside a string." - (if (and (looking-back "[])}]") - (null (nth 3 (syntax-ppss)))) - (backward-sexp) - (while (or (not (looking-at "[({[]")) - (nth 3 (syntax-ppss))) - (backward-char)))) - -(defun cider--find-last-error-location (message) - "Return the location (begin end buffer) from the Clojure error MESSAGE. -If location could not be found, return nil." - (save-excursion - (let ((info (cider-extract-error-info cider-compilation-regexp message))) - (when info - (let ((file (nth 0 info)) - (line (nth 1 info)) - (col (nth 2 info))) - (-when-let (buffer (cider-find-file file)) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)) - (move-to-column (or col 0)) - (let ((begin (progn (if col (cider--goto-expression-start) (back-to-indentation)) - (point))) - (end (progn (if col (forward-list) (move-end-of-line nil)) - (point)))) - (list begin end buffer))))))))))) - -(defun cider-handle-compilation-errors (message eval-buffer) - "Highlight and jump to compilation error extracted from MESSAGE. -EVAL-BUFFER is the buffer that was current during user's interactive -evaluation command. Honor `cider-auto-jump-to-error'." - (-when-let* ((loc (cider--find-last-error-location message)) - (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc))) - (info (cider-extract-error-info cider-compilation-regexp message))) - (let* ((face (nth 3 info)) - (note (nth 4 info)) - (auto-jump (if (eq cider-auto-jump-to-error 'errors-only) - (not (eq face 'cider-warning-highlight-face)) - cider-auto-jump-to-error))) - (overlay-put overlay 'cider-note-p t) - (overlay-put overlay 'font-lock-face face) - (overlay-put overlay 'cider-note note) - (overlay-put overlay 'help-echo note) - (overlay-put overlay 'modification-hooks - (list (lambda (o &rest _args) (delete-overlay o)))) - (when auto-jump - (with-current-buffer eval-buffer - (push-mark) - ;; At this stage selected window commonly is *cider-error* and we need to - ;; re-select the original user window. If eval-buffer is not - ;; visible it was probably covered as a result of a small screen or user - ;; configuration (https://github.com/clojure-emacs/cider/issues/847). In - ;; that case we don't jump at all in order to avoid covering *cider-error* - ;; buffer. - (-when-let (win (get-buffer-window eval-buffer)) - (with-selected-window win - (cider-jump-to (nth 2 loc) (car loc))))))))) - -(defun cider-need-input (buffer) - "Handle an need-input request from BUFFER." - (with-current-buffer buffer - (nrepl-request:stdin (concat (read-from-minibuffer "Stdin: ") "\n") - (cider-stdin-handler buffer)))) - - -;;;; Popup buffers -(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) - "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." - (-> (cider-make-popup-buffer name mode) - (cider-popup-buffer-display select))) - -(defun cider-popup-buffer-display (buffer &optional select) - "Display BUFFER. -If SELECT is non-nil, select the BUFFER." - (-when-let (win (get-buffer-window buffer)) - (with-current-buffer buffer - (set-window-point win (point)))) - ;; Non nil `inhibit-same-window' ensures that current window is not covered - (if select - (pop-to-buffer buffer `(nil . ((inhibit-same-window . ,pop-up-windows)))) - (display-buffer buffer `(nil . ((inhibit-same-window . ,pop-up-windows))))) - buffer) - -(defun cider-popup-buffer-quit (&optional kill) - "Quit the current (temp) window and 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))) - -(defun cider-make-popup-buffer (name &optional mode) - "Create a temporary buffer called NAME using major MODE (if specified)." - (with-current-buffer (get-buffer-create name) - (kill-all-local-variables) - (setq buffer-read-only nil) - (erase-buffer) - (when mode - (funcall mode)) - (setq-local cider-popup-output-marker (point-marker)) - (cider-popup-buffer-mode 1) - (setq buffer-read-only t) - (current-buffer))) - -(defun cider-emit-into-popup-buffer (buffer value) - "Emit into BUFFER the provided VALUE." - ;; 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) - (insert (format "%s" value)) - (indent-sexp) - (set-marker cider-popup-output-marker (point))) - (when moving (goto-char cider-popup-output-marker)))))) - -(defun cider-emit-into-color-buffer (buffer value) - "Emit into color BUFFER the provided VALUE." - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (goto-char (point-max)) - (insert (format "%s" value)) - (ansi-color-apply-on-region (point-min) (point-max))) - (goto-char (point-min)))) - -(defun cider-current-ns () - "Return current ns. -The ns is extracted from the ns form. If missing, use current REPL's ns, -otherwise fall back to \"user\"." - (if (derived-mode-p 'cider-repl-mode) - nrepl-buffer-ns - (or (clojure-find-ns) - (-when-let (repl-buf (cider-current-repl-buffer)) - (buffer-local-value 'nrepl-buffer-ns (get-buffer repl-buf))) - nrepl-buffer-ns - "user"))) - - -;;; Evaluation - -(defun cider-interactive-source-tracking-eval (form &optional start-pos callback) - "Evaluate FORM and dispatch the response to CALLBACK. -START-POS is a starting position of the form in the original context. -Unlike `cider-interactive-eval' this command will set proper metadata for var -definitions. If CALLBACK -is nil use `cider-interactive-eval-handler'." - (cider--clear-compilation-highlights) - (-when-let (error-win (get-buffer-window cider-error-buffer)) - (quit-window nil error-win)) - (let ((filename (or (buffer-file-name) - (buffer-name)))) - (cider-request:load-file - (cider--dummy-file-contents form start-pos) - (funcall cider-to-nrepl-filename-function (cider--server-filename filename)) - (file-name-nondirectory filename) - (or callback (cider-interactive-eval-handler))))) - -(defun cider-interactive-eval (form &optional callback) - "Evaluate FORM and dispatch the response to CALLBACK. -This function is the main entry point in CIDER's interactive evaluation -API. Most other interactive eval functions should rely on this function. -If CALLBACK is nil use `cider-interactive-eval-handler'." - (cider--clear-compilation-highlights) - (-when-let (error-win (get-buffer-window cider-error-buffer)) - (quit-window nil error-win)) - (nrepl-request:eval - form - (or callback (cider-interactive-eval-handler)) - (cider-current-ns))) - -(defun cider--dummy-file-contents (form start-pos) - "Wrap FORM to make it suitable for `cider-request:load-file'. -START-POS is a starting position of the form in the original context." - (let* ((ns-form (if (cider-ns-form-p form) - "" - (or (-when-let (form (cider-ns-form)) - (replace-regexp-in-string ":reload\\(-all\\)?\\>" "" form)) - (format "(ns %s)" (cider-current-ns))))) - (ns-form-lines (length (split-string ns-form "\n"))) - (start-pos (or start-pos 1)) - (start-line (line-number-at-pos start-pos)) - (start-column (save-excursion (goto-char start-pos) (current-column)))) - (concat - ns-form - (make-string (max 0 (- start-line ns-form-lines)) ?\n) - (make-string start-column ? ) - form))) - -(defun cider-eval-region (start end) - "Evaluate the region between START and END." - (interactive "r") - (let ((code (buffer-substring-no-properties start end))) - (cider-interactive-source-tracking-eval code start))) - -(defun cider-eval-buffer () - "Evaluate the current buffer." - (interactive) - (cider-eval-region (point-min) (point-max))) - -(defun cider-eval-last-sexp (&optional prefix) - "Evaluate the expression preceding point. -If invoked with a PREFIX argument, print the result in the current buffer." - (interactive "P") - (cider-interactive-eval (cider-last-sexp) - (when prefix (cider-eval-print-handler)))) - -(defun cider-eval-last-sexp-and-replace () - "Evaluate the expression preceding point and replace it with its result." - (interactive) - (let ((last-sexp (cider-last-sexp)) - (start-pos (cider-last-sexp-start-pos))) - ;; we have to be sure the evaluation won't result in an error - (nrepl-sync-request:eval last-sexp) - ;; seems like the sexp is valid, so we can safely kill it - (backward-kill-sexp) - (cider-interactive-eval last-sexp (cider-eval-print-handler)))) - -(defun cider-eval-last-sexp-to-repl (&optional prefix) - "Evaluate the expression preceding point and insert its result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider-interactive-eval (cider-last-sexp) - (cider-insert-eval-handler (cider-current-repl-buffer))) - (when prefix - (cider-switch-to-repl-buffer))) - -(defun cider-eval-print-last-sexp () - "Evaluate the expression preceding point. -Print its value into the current buffer." - (interactive) - (cider-interactive-eval (cider-last-sexp) - (cider-eval-print-handler))) - -(defun cider--pprint-eval-form (form) - "Pretty print FORM in popup buffer." - (let* ((result-buffer (cider-popup-buffer cider-result-buffer nil 'clojure-mode)) - (right-margin (max fill-column - (1- (window-width (get-buffer-window result-buffer)))))) - (cider-interactive-eval (cider-format-pprint-eval form right-margin) - (cider-popup-eval-out-handler result-buffer)))) - -(defun cider-pprint-eval-last-sexp () - "Evaluate the sexp preceding point and pprint its value in a popup buffer." - (interactive) - (cider--pprint-eval-form (cider-last-sexp))) - -(defun cider-eval-defun-at-point (&optional prefix) - "Evaluate the current toplevel form, and print result in the minibuffer. -With a PREFIX argument, print the result in the current buffer." - (interactive "P") - (cider-interactive-source-tracking-eval - (cider-defun-at-point) - (cider-defun-at-point-start-pos) - (when prefix (cider-eval-print-handler)))) - -(defun cider-pprint-eval-defun-at-point () - "Evaluate the top-level form at point and pprint its value in a popup buffer." - (interactive) - (cider--pprint-eval-form (cider-defun-at-point))) - -(defun cider-eval-ns-form () - "Evaluate the current buffer's namespace form." - (interactive) - (when (clojure-find-ns) - (save-excursion - (goto-char (match-beginning 0)) - (cider-eval-defun-at-point)))) - -(defun cider-read-and-eval () - "Read a sexp from the minibuffer and output its result to the echo area." - (interactive) - (let* ((form (cider-read-from-minibuffer "CIDER Eval: ")) - (ns-form (if (cider-ns-form-p form) "" (format "(ns %s)" (cider-current-ns))))) - (with-current-buffer (get-buffer-create cider-read-eval-buffer) - (erase-buffer) - (clojure-mode) - (unless (string= "" ns-form) - (insert ns-form "\n\n")) - (insert form) - (cider-interactive-eval form)))) - - -;; Connection and REPL - -(defun cider-insert-in-repl (form eval) - "Insert FORM in the REPL buffer and switch to it. -If EVAL is non-nil the form will also be evaluated." - (let ((start-pos (point))) - (while (string-match "\\`[ \t\n\r]+\\|[ \t\n\r]+\\'" form) - (setq form (replace-match "" t t form))) - (with-current-buffer (cider-current-repl-buffer) - (insert form) - (indent-region start-pos (point)) - (when eval - (cider-repl-return)))) - (cider-switch-to-repl-buffer)) - -(defun cider-insert-last-sexp-in-repl (&optional arg) - "Insert the expression preceding point in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-last-sexp) arg)) - -(defun cider-insert-defun-in-repl (&optional arg) - "Insert the top-level form at point in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-defun-at-point) arg)) - -(defun cider-insert-ns-form-in-repl (&optional arg) - "Insert the current buffer's ns form in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-ns-form) arg)) - -(defun cider-ping () - "Check that communication with the nREPL server works." - (interactive) - (message (read (nrepl-dict-get (nrepl-sync-request:eval "\"PONG\"") "value")))) - -(defun clojure-enable-cider () - "Turn on CIDER mode (see command `cider-mode'). -Useful in hooks." - (cider-mode 1) - (setq next-error-function 'cider-jump-to-compilation-error)) - -(defun clojure-disable-cider () - "Turn off CIDER mode (see command `cider-mode'). -Useful in hooks." - (cider-mode -1)) - -(defun cider-connected-p () - "Return t if CIDER is currently connected, nil otherwise." - (nrepl-current-connection-buffer 'no-error)) - -(defun cider-ensure-connected () - "Ensure there is a cider connection present, otherwise -an error is signalled." - (unless (cider-connected-p) - (error "No active nREPL connection"))) - -(defun cider-enable-on-existing-clojure-buffers () - "Enable interaction mode on existing Clojure buffers. -See command `cider-mode'." - (interactive) - (add-hook 'clojure-mode-hook 'clojure-enable-cider) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (clojure-enable-cider)))) - -(defun cider-disable-on-existing-clojure-buffers () - "Disable `cider-mode' on existing Clojure buffers. -See command `cider-mode'." - (interactive) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (clojure-disable-cider)))) - -(defun cider-possibly-disable-on-existing-clojure-buffers () - "If not connected, disable `cider-mode' on existing Clojure buffers." - (unless (cider-connected-p) - (cider-disable-on-existing-clojure-buffers))) - -(defun cider-fetch-vars-form (ns) - "Construct a Clojure form to read vars inside for NS." - `(concat (if (find-ns (symbol ,ns)) - (map name (concat (keys (ns-interns (symbol ,ns))) - (keys (ns-refers (symbol ,ns)))))) - (if (not= "" ,ns) [".."]) - (->> (all-ns) - (map (fn [n] - (re-find (re-pattern (str "^" (if (not= ,ns "") - (str ,ns "\\.")) - "[^\\.]+")) - (str n)))) - (filter identity) - (map (fn [n] (str n "/"))) - (into (hash-set))))) - -(defun cider-parent-ns (ns) - "Go up a level of NS. -For example \"foo.bar.tar\" -> \"foo.bar\"." - (cider-string-join (butlast (split-string ns "\\.")) ".")) - - -;;; Completion - -(defun cider-completing-read-var-select (prompt callback ns selected targets) - "Peform completing read using SELECTED and TARGETS. -If SELECTED is \"..\" then another selection is made for vars in the parent namespace of -NS using PROMPT. -If SELECTED is a namespace then another selection is made against that namespace -using PROMPT. -Once a selecton is made CALLBACK is called with SELECTED." - ;; TODO: immediate RET gives "" as selected for some reason - ;; this is an OK workaround though - (cond ((equal "" selected) - (cider-completing-read-var-select prompt callback ns (car targets) targets)) - ((equal "/" (substring selected -1)) ; selected a namespace - (cider-completing-read-var prompt (substring selected 0 -1) callback)) - ((equal ".." selected) - (cider-completing-read-var prompt (cider-parent-ns ns) callback)) - ;; non ido variable selection techniques don't return qualified symbols, so this shouldn't either - (t (funcall callback selected)))) - -(defun cider-completing-read-sym-handler (label completing-read-callback buffer) - "Create an nrepl response handler for BUFFER. -The handler will parse the response from nrepl to create targets for a completing read. -The result of the completing read will be passed to COMPLETING-READ-CALLBACK." - (nrepl-make-response-handler buffer - (lambda (buffer value) - ;; make sure to eval the callback in the buffer that the symbol was requested from so we get the right namespace - (with-current-buffer buffer - (let* ((targets (car (read-from-string value))) - (selected (completing-read label targets nil t))) - (funcall completing-read-callback selected targets)))) - nil nil nil)) - -(defun cider-completing-read-sym-form (label form callback) - "Eval the FORM and pass the result to the response handler." - (cider-tooling-eval form (cider-completing-read-sym-handler label callback (current-buffer)))) - -(defun cider-completing-read-var (prompt ns callback) - "Perform completing read var in NS using CALLBACK." - (cider-completing-read-sym-form prompt (prin1-to-string (cider-fetch-vars-form ns)) - (lambda (selected targets) - (cider-completing-read-var-select prompt callback ns selected targets)))) - -(defun cider-fetch-fns-form (ns) - "Construct a Clojure form for reading fns using supplied NS." - (format "(let [fn-pred (fn [[k v]] (and (fn? (.get v)) - (not (re-find #\"clojure.\" (str v)))))] - (sort - (map (comp name key) - (filter fn-pred - (concat - (ns-interns '%s) - (ns-refers '%s))))))" ns ns)) - -(defun cider-load-fn-into-repl-buffer () - "Browse functions available in current repl buffer. -Once selected, the name of the fn will appear in the repl buffer in parens -ready to call." - (interactive) - (let ((ns (cider-current-ns))) - (cider-completing-read-sym-form (format "Fn: %s/" ns) - (cider-fetch-fns-form ns) - (lambda (f _targets) - (with-current-buffer (cider-current-repl-buffer) - (cider-repl--replace-input (format "(%s)" f)) - (goto-char (- (point-max) 1))))))) - -(defun cider-read-symbol-name (prompt callback &optional query) - "Either read a symbol name using PROMPT or choose the one at point. -Use CALLBACK as the completing read var callback. -The user is prompted with PROMPT if a prefix argument is in effect, -if there is no symbol at point, or if QUERY is non-nil." - (let ((symbol-name (cider-symbol-at-point))) - (if (not (or current-prefix-arg - query - (not symbol-name) - (equal "" symbol-name))) - (funcall callback symbol-name) - (funcall callback (cider-read-from-minibuffer prompt))))) - -(defun cider-sync-request:toggle-trace-var (symbol) - "Toggle var tracing for SYMBOL." - (cider-ensure-op-supported "toggle-trace-var") - (-> (list "op" "toggle-trace-var" - "ns" (cider-current-ns) - "sym" symbol) - (nrepl-send-sync-request))) - -(defun cider-toggle-trace-var (query) - "Toggle var tracing. -Defaults to the symbol at point. With prefix arg QUERY or no symbol at -point, prompts for a var." - (interactive "P") - (cider-ensure-op-supported "toggle-trace-var") - (cider-read-symbol-name - "Toggle trace for var: " - (lambda (sym) - (let* ((trace-response (cider-sync-request:toggle-trace-var sym)) - (var-name (nrepl-dict-get trace-response "var-name")) - (var-status (nrepl-dict-get trace-response "var-status"))) - (pcase var-status - ("not-found" (message "Var %s not found" sym)) - ("not-traceable" (message "Var %s can't be traced because it's not bound to a function" var-name)) - (t (message "Var %s %s" var-name var-status))))) - query)) - -(defun cider-sync-request:toggle-trace-ns (ns) - "Toggle namespace tracing for NS." - (cider-ensure-op-supported "toggle-trace-ns") - (-> (list "op" "toggle-trace-ns" - "ns" ns) - (nrepl-send-sync-request))) - -(defun cider-toggle-trace-ns (query) - "Toggle ns tracing. -Defaults to the current ns. With prefix arg QUERY, prompts for a ns." - (interactive "P") - (cider-ensure-op-supported "toggle-trace-ns") - (let ((ns (if query - (completing-read "Toggle trace for ns: " (cider-sync-request:ns-list)) - (cider-current-ns)))) - (let* ((trace-response (cider-sync-request:toggle-trace-ns ns)) - (ns-status (nrepl-dict-get trace-response "ns-status"))) - (pcase ns-status - ("not-found" (message "ns %s not found" ns)) - (t (message "ns %s %s" ns ns-status)))))) - -(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) - (message "Symbol %s not resolved" symbol))) - -(defun cider-doc (query) - "Open a window with the docstring for the given QUERY. -Defaults to the symbol at point. With prefix arg or no symbol -under point, prompts for a var." - (interactive "P") - (cider-read-symbol-name "Symbol: " 'cider-doc-lookup query)) - -(defun cider-undef (symbol) - "Undefine the SYMBOL." - (interactive "P") - (cider-ensure-op-supported "undef") - (cider-read-symbol-name - "Undefine symbol: " - (lambda (sym) - (nrepl-send-request - (list "op" "undef" - "ns" (cider-current-ns) - "symbol" sym) - (cider-interactive-eval-handler (current-buffer)))) - symbol)) - -(defun cider-refresh () - "Refresh loaded code." - (interactive) - (cider-tooling-eval - "(clojure.core/require 'clojure.tools.namespace.repl) (clojure.tools.namespace.repl/refresh)" - (cider-interactive-eval-handler (current-buffer)))) - -(defun cider-file-string (file) - "Read the contents of a FILE and return as a string." - (with-current-buffer (find-file-noselect file) - (substring-no-properties (buffer-string)))) - -(defvar cider-to-nrepl-filename-function - (if (eq system-type 'cygwin) - (lambda (filename) - (->> (expand-file-name filename) - (format "cygpath.exe --windows '%s'") - (shell-command-to-string) - (replace-regexp-in-string "\n" "") - (replace-regexp-in-string "\\\\" "/"))) - #'identity) - "Function to translate Emacs filenames to nREPL namestrings.") - -(defun cider-load-file (filename) - "Load (eval) the Clojure file FILENAME in nREPL." - (interactive (list - (read-file-name "Load file: " nil nil nil - (if (buffer-file-name) - (file-name-nondirectory - (buffer-file-name)))))) - (cider--clear-compilation-highlights) - (-when-let (error-win (get-buffer-window cider-error-buffer)) - (quit-window nil error-win)) - (cider-request:load-file - (cider-file-string filename) - (funcall cider-to-nrepl-filename-function (cider--server-filename filename)) - (file-name-nondirectory filename)) - (message "Loading %s..." filename)) - -(defun cider-load-buffer (&optional buffer) - "Load (eval) BUFFER's file in nREPL. -If no buffer is provided the command acts on the current buffer." - (interactive) - (check-parens) - (setq buffer (or buffer (current-buffer))) - (with-current-buffer buffer - (unless buffer-file-name - (error "Buffer %s is not associated with a file" (buffer-name))) - (when (and cider-prompt-save-file-on-load - (buffer-modified-p) - (y-or-n-p (format "Save file %s? " buffer-file-name))) - (save-buffer)) - (cider-load-file buffer-file-name))) - -(defalias 'cider-eval-file 'cider-load-file - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-buffer 'cider-load-buffer - "A convenience alias as some people are confused by the load-* names.") - -;;; interrupt evaluation -(defun cider-interrupt-handler (buffer) - "Create an interrupt response handler for BUFFER." - (nrepl-make-response-handler buffer nil nil nil nil)) - -(defun cider-describe-nrepl-session () - "Describe an nREPL session." - (interactive) - (let ((selected-session (completing-read "Describe nREPL session: " (nrepl-sessions)))) - (when (and selected-session (not (equal selected-session ""))) - (let* ((session-info (nrepl-sync-request:describe selected-session)) - (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) - (session-id (nrepl-dict-get session-info "session")) - (session-type (cond - ((equal session-id (nrepl-current-session)) "Active eval") - ((equal session-id (nrepl-current-tooling-session)) "Active tooling") - (t "Unknown")))) - (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer) - (read-only-mode -1) - (insert (format "Session: %s" session-id)) - (newline) - (insert (format "Type: %s session" session-type)) - (newline) - (insert (format "Supported ops:")) - (newline) - (-each ops (lambda (op) (insert (format " * %s" op)) (newline))))) - (display-buffer cider-nrepl-session-buffer)))) - -(defun cider-close-nrepl-session () - "Close an nREPL session for the current connection." - (interactive) - (let ((selected-session (completing-read "Close nREPL session: " (nrepl-sessions)))) - (when selected-session - (nrepl-sync-request:close selected-session) - (message "Closed nREPL session %s" selected-session)))) - -;;; quiting -(defun cider--close-buffer (buffer) - "Close the BUFFER and kill its associated process (if any)." - (when (get-buffer-process buffer) - (delete-process (get-buffer-process buffer))) - (when (get-buffer buffer) - (kill-buffer buffer))) - -(defvar cider-ancillary-buffers - (list cider-error-buffer - cider-doc-buffer - cider-test-report-buffer - cider-nrepl-session-buffer - nrepl-message-buffer-name)) - -(defun cider-close-ancillary-buffers () - "Close buffers that are shared across connections." - (interactive) - (dolist (buf-name cider-ancillary-buffers) - (cider--close-buffer buf-name))) - -(defun cider-quit (&optional arg) - "Quit CIDER. - -With a prefix ARG the command won't ask for confirmation. -Quitting closes all active nREPL connections and kills all CIDER buffers." - (interactive "P") - (when (or arg (y-or-n-p "Are you sure you want to quit CIDER? ")) - (dolist (connection nrepl-connection-list) - (when connection - (nrepl-close connection))) - (message "All active nREPL connections were closed") - (cider-close-ancillary-buffers))) - -(defun cider-restart (&optional prompt-project) - "Quit CIDER and restart it. -If PROMPT-PROJECT is t, then prompt for the project in which to -restart the server." - (interactive "P") - (let ((project-dir (with-current-buffer (nrepl-current-connection-buffer) nrepl-project-dir))) - (cider-quit) - ;; Workaround for a nasty race condition https://github.com/clojure-emacs/cider/issues/439 - ;; TODO: Find a better way to ensure `cider-quit' has finished - (message "Waiting for CIDER to quit...") - (sleep-for 2) - (if project-dir - (let ((default-directory project-dir)) - (cider-jack-in prompt-project)) - (error "Can't restart CIDER for unknown project")))) - -(add-hook 'nrepl-connected-hook 'cider-enable-on-existing-clojure-buffers) -(add-hook 'nrepl-disconnected-hook - 'cider-possibly-disable-on-existing-clojure-buffers) - -(provide 'cider-interaction) - -;;; cider-interaction.el ends here diff --git a/packages/cider-0.8.2/cider-macroexpansion.el b/packages/cider-0.8.2/cider-macroexpansion.el deleted file mode 100644 index db256e8..0000000 --- a/packages/cider-0.8.2/cider-macroexpansion.el +++ /dev/null @@ -1,187 +0,0 @@ -;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Macro expansion support. - -;;; Code: - -(require 'cider-mode) - -(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")) - -(define-obsolete-variable-alias - 'cider-macroexpansion-suppress-namespaces - 'cider-macroexpansion-display-namespaces - "0.8.0") - -(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." - (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 (backward-sexp) (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 nrepl-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)) - (font-lock-fontify-buffer))) - -(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)))) - -(defun cider-create-macroexpansion-buffer () - "Create a new macroexpansion buffer." - (with-current-buffer (cider-popup-buffer cider-macroexpansion-buffer t) - (clojure-mode) - (clojure-disable-cider) - (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-jump-to-var) - (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] - ["Go to source" cider-jump-to-var] - ["Go to doc" cider-doc] - ["Go to Javadoc" cider-docview-javadoc] - ["Quit" cider-popup-buffer-quit-function])) - (cl-labels ((redefine-key (from to) - (dolist (mapping (where-is-internal from cider-mode-map)) - (define-key map mapping to)))) - (redefine-key 'cider-macroexpand-1 'cider-macroexpand-1-inplace) - (redefine-key 'cider-macroexpand-all 'cider-macroexpand-all-inplace) - (redefine-key 'advertised-undo 'cider-macroexpand-undo) - (redefine-key 'undo 'cider-macroexpand-undo)) - map)) - -(define-minor-mode cider-macroexpansion-mode - "Minor mode for CIDER macroexpansion. - -\\{cider-macroexpansion-mode-map}" - nil - " Macroexpand" - cider-macroexpansion-mode-map) - -(provide 'cider-macroexpansion) - -;;; cider-macroexpansion.el ends here diff --git a/packages/cider-0.8.2/cider-mode.el b/packages/cider-0.8.2/cider-mode.el deleted file mode 100644 index aa9acc2..0000000 --- a/packages/cider-0.8.2/cider-mode.el +++ /dev/null @@ -1,158 +0,0 @@ -;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Minor mode for REPL interactions. - -;;; Code: - -(require 'cider-interaction) - -;;;###autoload -(defcustom cider-mode-line - '(:eval (format " cider[%s]" (cider-current-ns))) - "Mode line ligher 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 ns. -Set this variable to nil to disable the mode line -entirely." - :group 'cider - :type 'sexp - :risky t - :package-version '(cider "0.7.0")) - -(defvar 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-jump-to-var) - (define-key map (kbd "M-,") 'cider-jump-back) - (define-key map (kbd "C-c M-.") 'cider-jump-to-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-w") 'cider-eval-last-sexp-and-replace) - (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 C-r") 'cider-eval-region) - (define-key map (kbd "C-c C-n") 'cider-eval-ns-form) - (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-o") 'cider-find-and-clear-repl-buffer) - (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-run-tests) - (define-key map (kbd "C-c C-,") 'cider-test-rerun-tests) - (define-key map (kbd "C-c M-,") 'cider-test-run-test) - (define-key map (kbd "C-c C-t") 'cider-test-show-report) - (define-key map (kbd "C-c M-s") 'cider-selector) - (define-key map (kbd "C-c M-r") 'cider-rotate-connection) - (define-key map (kbd "C-c M-d") 'cider-display-current-connection-info) - (define-key map (kbd "C-c C-x") 'cider-refresh) - (define-key map (kbd "C-c C-q") 'cider-quit) - (easy-menu-define cider-mode-menu map - "Menu for CIDER mode" - `("CIDER" - ["Complete symbol" complete-symbol] - "--" - ,cider-doc-menu - "--" - ["Eval top-level sexp at point" cider-eval-defun-at-point] - ["Eval last sexp" cider-eval-last-sexp] - ["Eval last sexp in popup buffer" cider-pprint-eval-last-sexp] - ["Eval last sexp to REPL buffer" cider-eval-last-sexp-to-repl] - ["Eval last sexp and replace" cider-eval-last-sexp-and-replace] - ["Eval region" cider-eval-region] - ["Eval ns form" cider-eval-ns-form] - ["Insert last sexp in REPL" cider-insert-last-sexp-in-repl] - "--" - ["Load (eval) buffer" cider-load-buffer] - ["Load (eval) file" cider-load-file] - "--" - ["Macroexpand-1" cider-macroexpand-1] - ["Macroexpand-all" cider-macroexpand-all] - "--" - ["Jump to source" cider-jump-to-var] - ["Jump to resource" cider-jump-to-resource] - ["Jump back" cider-jump-back] - "--" - ["Run test" cider-test-run-test] - ["Run all tests" cider-test-run-tests] - ["Rerun failed/erring tests" cider-test-rerun-tests] - ["Show test report" cider-test-show-report] - "--" - ["Inspect" cider-inspect] - "--" - ["Set ns" cider-repl-set-ns] - ["Switch to REPL" cider-switch-to-repl-buffer] - ["Switch to Relevant REPL" cider-switch-to-relevant-repl-buffer] - ["Toggle REPL Pretty Print" cider-repl-toggle-pretty-printing] - ["Clear REPL" cider-find-and-clear-repl-buffer] - ["Refresh loaded code" cider-refresh] - ["Interrupt evaluation" cider-interrupt] - ["Quit" cider-quit] - ["Restart" cider-restart] - "--" - ["Describe nREPL session" cider-describe-nrepl-session] - ["Close nREPL session" cider-close-nrepl-session] - ["Display nREPL connection" cider-display-current-connection-info] - ["Rotate nREPL connection" cider-rotate-connection] - "--" - ["Version info" cider-version])) - map)) - -;;;###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 - (make-local-variable 'completion-at-point-functions) - (add-to-list 'completion-at-point-functions - 'cider-complete-at-point)) - -(provide 'cider-mode) - -;;; cider-mode.el ends here diff --git a/packages/cider-0.8.2/cider-pkg.el b/packages/cider-0.8.2/cider-pkg.el deleted file mode 100644 index 55facae..0000000 --- a/packages/cider-0.8.2/cider-pkg.el +++ /dev/null @@ -1,12 +0,0 @@ -(define-package "cider" "0.8.2" "Clojure Integrated Development Environment and REPL" - '((clojure-mode "3.0.0") - (cl-lib "0.5") - (dash "2.4.1") - (pkg-info "0.4") - (emacs "24") - (queue "0.1.1")) - :url "http://www.github.com/clojure-emacs/cider" :keywords - '("languages" "clojure" "cider")) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/packages/cider-0.8.2/cider-repl.el b/packages/cider-0.8.2/cider-repl.el deleted file mode 100644 index 4d4a77f..0000000 --- a/packages/cider-0.8.2/cider-repl.el +++ /dev/null @@ -1,1076 +0,0 @@ -;;; cider-repl.el --- REPL interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; REPL interactions. - -;;; Code: - -(require 'cider-client) -(require 'cider-interaction) -(require 'cider-doc) -(require 'cider-eldoc) ; for cider-turn-on-eldoc-mode -(require 'cider-util) - -(require 'clojure-mode) -(require 'easymenu) - -(eval-when-compile - (defvar paredit-version) - (defvar paredit-space-for-delimiter-predicates)) - - -(defgroup cider-repl nil - "Interaction with the REPL." - :prefix "cider-repl-" - :group 'cider) - -(defface cider-repl-prompt-face - '((t (:inherit font-lock-keyword-face))) - "Face for the prompt in the REPL buffer." - :group 'cider-repl) - -(defface cider-repl-output-face - '((t (:inherit font-lock-string-face))) - "Face for STDOUT output in the REPL buffer." - :group 'cider-repl) - -(defface cider-repl-err-output-face - '((t (:inherit font-lock-warning-face))) - "Face for STDERR output in the REPL buffer." - :group 'cider-repl - :package-version '(cider . "0.6.0")) - -(defface cider-repl-input-face - '((t (:bold t))) - "Face for previous input in the REPL buffer." - :group 'cider-repl) - -(defface cider-repl-result-face - '((t ())) - "Face for the result of an evaluation in the REPL buffer." - :group 'cider-repl) - -(defcustom cider-repl-pop-to-buffer-on-connect t - "Controls whether to pop to the REPL buffer on connect. - -When set to nil the buffer will only be created." - :type 'boolean - :group 'cider-repl) - -(defcustom cider-repl-display-in-current-window nil - "Controls whether the REPL buffer is displayed in the current window." - :type 'boolean - :group 'cider-repl) - -(defcustom cider-repl-use-pretty-printing nil - "Control whether the results in REPL are pretty-printed or not. -The `cider-toggle-pretty-printing' command can be used to interactively -change the setting's value." - :type 'boolean - :group 'cider-repl) - -(defcustom cider-repl-use-clojure-font-lock nil - "Non-nil means to use Clojure mode font-locking for input and result. -Nil means that `cider-repl-input-face' and `cider-repl-result-face' -will be used." - :type 'boolean - :group 'cider-repl - :package-version '(cider . "0.5.0")) - -(defcustom cider-repl-result-prefix "" - "The prefix displayed in the REPL before a result value." - :type 'string - :group 'cider - :package-version '(cider . "0.5.0")) - -(defcustom cider-repl-tab-command 'cider-repl-indent-and-complete-symbol - "Select the command to be invoked by the TAB key. -The default option is `cider-repl-indent-and-complete-symbol'. If -you'd like to use the default Emacs behavior use -`indent-for-tab-command'." - :type 'symbol - :group 'cider-repl) - - -;;;; REPL buffer local variables -(defvar-local cider-repl-input-start-mark nil) - -(defvar-local cider-repl-prompt-start-mark nil) - -(defvar-local cider-repl-old-input-counter 0 - "Counter used to generate unique `cider-old-input' properties. -This property value must be unique to avoid having adjacent inputs be -joined together.") - -(defvar-local cider-repl-input-history '() - "History list of strings read from the REPL buffer.") - -(defvar-local cider-repl-input-history-items-added 0 - "Variable counting the items added in the current session.") - -(defvar-local cider-repl-output-start nil - "Marker for the start of output.") - -(defvar-local cider-repl-output-end nil - "Marker for the end of output.") - -(defun cider-repl-tab () - "Invoked on TAB keystrokes in `cider-repl-mode' buffers." - (interactive) - (funcall cider-repl-tab-command)) - -(defun cider-repl-reset-markers () - "Reset all REPL markers." - (dolist (markname '(cider-repl-output-start - cider-repl-output-end - cider-repl-prompt-start-mark - cider-repl-input-start-mark)) - (set markname (make-marker)) - (set-marker (symbol-value markname) (point)))) - - -;;; REPL init -(defun cider-repl-buffer-name (&optional project-dir host port) - "Generate a REPL buffer name based on current connection buffer. -PROJECT-DIR, PORT and HOST are as in `nrepl-make-buffer-name'." - (with-current-buffer (or (nrepl-current-connection-buffer 'no-error) - (current-buffer)) - (nrepl-make-buffer-name nrepl-repl-buffer-name-template project-dir host port))) - -(defun cider-repl-create (&optional project-dir host port) - "Create a REPL buffer and install `cider-repl-mode'. -PROJECT-DIR, PORT and HOST are as in `nrepl-make-buffer-name'." - ;; Connection might not have been set as yet. Please don't send requests here. - (let ((buf (nrepl-make-buffer-name nrepl-repl-buffer-name-template - project-dir host port))) - (with-current-buffer (get-buffer-create buf) - (unless (derived-mode-p 'cider-repl-mode) - (cider-repl-mode)) - (cider-repl-reset-markers)) - buf)) - -(defun cider-repl-require-repl-utils () - "Require standard REPL util functions into the current REPL." - (interactive) - (cider-eval - "(when (clojure.core/resolve 'clojure.main/repl-requires) - (clojure.core/map clojure.core/require clojure.main/repl-requires))" - (lambda (response) nil))) - -(defun cider-repl-set-initial-ns (buffer) - "Set the REPL BUFFER's initial namespace (by altering `nrepl-buffer-ns'). -This is \"user\" by default but can be overridden in apps like lein (:init-ns)." - ;; we don't want to get a timeout during init - (let ((nrepl-sync-request-timeout nil)) - (with-current-buffer buffer - (let ((initial-ns (read (nrepl-dict-get (nrepl-sync-request:eval "(str *ns*)") "value")))) - (when initial-ns - (setq nrepl-buffer-ns initial-ns)))))) - -(defun cider-repl-init (buffer &optional no-banner) - "Initialize the REPL in BUFFER. -BUFFER must be a REPL buffer with `cider-repl-mode' and a running -client process connection. Unless NO-BANNER is non-nil, insert a banner." - (cider-repl-set-initial-ns buffer) - (cider-repl-require-repl-utils) - (unless no-banner - (cider-repl--insert-banner-and-prompt buffer)) - (when cider-repl-display-in-current-window - (add-to-list 'same-window-buffer-names buffer)) - (when cider-repl-pop-to-buffer-on-connect - (pop-to-buffer buffer)) - (cider-remember-clojure-buffer cider-current-clojure-buffer) - buffer) - -(defun cider-repl--banner () - "Generate the welcome REPL buffer banner." - (format "; CIDER %s (Java %s, Clojure %s, nREPL %s)" - (cider--version) - (cider--java-version) - (cider--clojure-version) - (cider--nrepl-version))) - -(defun cider-repl--insert-banner-and-prompt (buffer) - "Insert REPL banner and REPL prompt in BUFFER." - (with-current-buffer buffer - (when (zerop (buffer-size)) - (insert (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face))) - (goto-char (point-max)) - (cider-repl--mark-output-start) - (cider-repl--mark-input-start) - (cider-repl--insert-prompt nrepl-buffer-ns))) - -(defun cider-get-repl-buffer () - "Return the REPL buffer for current connection." - (let ((buffer (get-buffer-create (cider-current-repl-buffer)))) - (if (buffer-live-p buffer) - buffer - (error "No active REPL")))) - - -;;; REPL interaction - -(defun cider-repl--in-input-area-p () - "Return t if in input area." - (<= cider-repl-input-start-mark (point))) - -(defun cider-repl--current-input (&optional until-point-p) - "Return the current input as string. -The input is the region from after the last prompt to the end of -buffer. If UNTIL-POINT-P is non-nil, the input is until the current -point." - (buffer-substring-no-properties cider-repl-input-start-mark - (if until-point-p - (point) - (point-max)))) - -(defun cider-repl-previous-prompt () - "Move backward to the previous prompt." - (interactive) - (cider-repl--find-prompt t)) - -(defun cider-repl-next-prompt () - "Move forward to the next prompt." - (interactive) - (cider-repl--find-prompt)) - -(defun cider-repl--find-prompt (&optional backward) - "Find the next prompt. -If BACKWARD is non-nil look backward." - (let ((origin (point)) - (prop 'cider-repl-prompt)) - (while (progn - (cider-search-property-change prop backward) - (not (or (cider-end-of-proprange-p prop) (bobp) (eobp))))) - (unless (cider-end-of-proprange-p prop) - (goto-char origin)))) - -(defun cider-search-property-change (prop &optional backward) - "Search forward for a property change to PROP. -If BACKWARD is non-nil search backward." - (cond (backward - (goto-char (previous-single-char-property-change (point) prop))) - (t - (goto-char (next-single-char-property-change (point) prop))))) - -(defun cider-end-of-proprange-p (property) - "Return t if at the the end of a property range for PROPERTY." - (and (get-char-property (max 1 (1- (point))) property) - (not (get-char-property (point) property)))) - -(defun cider-repl--mark-input-start () - "Mark the input start." - (set-marker cider-repl-input-start-mark (point) (current-buffer))) - -(defun cider-repl--mark-output-start () - "Mark the output start." - (set-marker cider-repl-output-start (point)) - (set-marker cider-repl-output-end (point))) - -(defun cider-repl--mark-output-end () - "Mark the output end." - (add-text-properties cider-repl-output-start cider-repl-output-end - '(face cider-repl-output-face - rear-nonsticky (face)))) - -(defun cider-repl--same-line-p (pos1 pos2) - "Return t if buffer positions POS1 and POS2 are on the same line." - (save-excursion (goto-char (min pos1 pos2)) - (<= (max pos1 pos2) (line-end-position)))) - -(defun cider-repl--bol-internal () - "Go to the beginning of line or the prompt." - (cond ((and (>= (point) cider-repl-input-start-mark) - (cider-repl--same-line-p (point) cider-repl-input-start-mark)) - (goto-char cider-repl-input-start-mark)) - (t (beginning-of-line 1)))) - -(defun cider-repl-mode-beginning-of-defun (&optional arg) - (if (and arg (< arg 0)) - (cider-repl-mode-end-of-defun (- arg)) - (dotimes (_ (or arg 1)) - (cider-repl-previous-prompt)))) - -(defun cider-repl-mode-end-of-defun (&optional arg) - (if (and arg (< arg 0)) - (cider-repl-mode-beginning-of-defun (- arg)) - (dotimes (_ (or arg 1)) - (cider-repl-next-prompt)))) - -(defun cider-repl-beginning-of-defun () - "Move to beginning of defun." - (interactive) - ;; We call `beginning-of-defun' if we're at the start of a prompt - ;; already, to trigger `cider-repl-mode-beginning-of-defun' by means - ;; of the locally bound `beginning-of-defun-function', in order to - ;; jump to the start of the previous prompt. - (if (and (not (cider-repl--at-prompt-start-p)) - (cider-repl--in-input-area-p)) - (goto-char cider-repl-input-start-mark) - (beginning-of-defun))) - -(defun cider-repl-end-of-defun () - "Move to end of defun." - (interactive) - ;; C.f. `cider-repl-beginning-of-defun.' - (if (and (not (= (point) (point-max))) - (cider-repl--in-input-area-p)) - (goto-char (point-max)) - (end-of-defun))) - -(defun cider-repl-bol () - "Go to the beginning of line or the prompt." - (interactive) - (deactivate-mark) - (cider-repl--bol-internal)) - -(defun cider-repl-bol-mark () - "Set the mark and go to the beginning of line or the prompt." - (interactive) - (unless mark-active - (set-mark (point))) - (cider-repl--bol-internal)) - -(defun cider-repl--at-prompt-start-p () - "Return t if point is at the start of prompt. -This will not work on non-current prompts." - (= (point) cider-repl-input-start-mark)) - -(defun cider-repl--show-maximum-output () - "Put the end of the buffer at the bottom of the window." - (when (eobp) - (let ((win (get-buffer-window (current-buffer)))) - (when win - (with-selected-window win - (set-window-point win (point-max)) - (recenter -1)))))) - -(defmacro cider-save-marker (marker &rest body) - "Save MARKER and execute BODY." - (let ((pos (make-symbol "pos"))) - `(let ((,pos (marker-position ,marker))) - (prog1 (progn . ,body) - (set-marker ,marker ,pos))))) - -(put 'cider-save-marker 'lisp-indent-function 1) - -(defun cider-repl--insert-prompt (namespace) - "Insert the prompt (before markers!), taking into account NAMESPACE. -Set point after the prompt. -Return the position of the prompt beginning." - (goto-char cider-repl-input-start-mark) - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (unless (bolp) (insert-before-markers "\n")) - (let ((prompt-start (point)) - (prompt (format "%s> " namespace))) - (cider-propertize-region - '(font-lock-face cider-repl-prompt-face read-only t intangible t - cider-repl-prompt t - rear-nonsticky (cider-repl-prompt read-only font-lock-face intangible)) - (insert-before-markers prompt)) - (set-marker cider-repl-prompt-start-mark prompt-start) - prompt-start)))) - -(defun cider-repl-emit-output-at-pos (buffer string output-face position &optional bol) - "Using BUFFER, insert STRING (applying to it OUTPUT-FACE) at POSITION. -If BOL is non-nil insert at the beginning of line." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (goto-char position) - ;; TODO: Review the need for bol - (when (and bol (not (bolp))) (insert-before-markers "\n")) - (cider-propertize-region `(font-lock-face ,output-face - rear-nonsticky (font-lock-face)) - (insert-before-markers string) - (when (and (= (point) cider-repl-prompt-start-mark) - (not (bolp))) - (insert-before-markers "\n") - (set-marker cider-repl-output-end (1- (point)))))))) - (cider-repl--show-maximum-output))) - -(defun cider-repl--emit-interactive-output (string face) - "Emit STRING as interactive output using FACE." - (with-current-buffer (cider-current-repl-buffer) - (let ((pos (1- (cider-repl--input-line-beginning-position))) - (string (replace-regexp-in-string "\n\\'" "" string))) - (cider-repl-emit-output-at-pos (current-buffer) string face pos t) - (ansi-color-apply-on-region pos (point-max))))) - -(defun cider-repl-emit-interactive-output (string) - "Emit STRING as interactive output." - (cider-repl--emit-interactive-output string 'cider-repl-output-face)) - -(defun cider-repl-emit-interactive-err-output (string) - "Emit STRING as interactive err output." - (cider-repl--emit-interactive-output string 'cider-repl-err-output-face)) - -(defun cider-repl--emit-output (buffer string face &optional bol) - "Using BUFFER, emit STRING font-locked with FACE. -If BOL is non-nil, emit at the beginning of the line." - (with-current-buffer buffer - (let ((pos (1- (cider-repl--input-line-beginning-position)))) - (cider-repl-emit-output-at-pos buffer string face cider-repl-input-start-mark bol) - (ansi-color-apply-on-region pos (point-max))))) - -(defun cider-repl-emit-output (buffer string) - "Using BUFFER, emit STRING as standard output." - (cider-repl--emit-output buffer string 'cider-repl-output-face)) - -(defun cider-repl-emit-err-output (buffer string) - "Using BUFFER, emit STRING as error output." - (cider-repl--emit-output buffer string 'cider-repl-err-output-face)) - -(defun cider-repl-emit-prompt (buffer) - "Emit the REPL prompt into BUFFER." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (cider-repl--insert-prompt nrepl-buffer-ns)))) - (cider-repl--show-maximum-output))) - -(defun cider-repl-emit-result (buffer string &optional bol) - "Emit into BUFFER the result STRING and mark it as an evaluation result. -If BOL is non-nil insert at the beginning of the line." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (goto-char cider-repl-input-start-mark) - (when (and bol (not (bolp))) - (insert-before-markers "\n")) - (insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face)) - (if cider-repl-use-clojure-font-lock - (insert-before-markers (cider-font-lock-as-clojure string)) - (cider-propertize-region - '(font-lock-face cider-repl-result-face rear-nonsticky (font-lock-face)) - (insert-before-markers string)))))) - (cider-repl--show-maximum-output))) - -(defun cider-repl-newline-and-indent () - "Insert a newline, then indent the next line. -Restrict the buffer from the prompt for indentation, to avoid being -confused by strange characters (like unmatched quotes) appearing -earlier in the buffer." - (interactive) - (save-restriction - (narrow-to-region cider-repl-prompt-start-mark (point-max)) - (insert "\n") - (lisp-indent-line))) - -(defun cider-repl-indent-and-complete-symbol () - "Indent the current line and perform symbol completion. -First indent the line. If indenting doesn't move point, complete -the symbol." - (interactive) - (let ((pos (point))) - (lisp-indent-line) - (when (= pos (point)) - (if (save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t)) - (completion-at-point))))) - -(defun cider-repl-kill-input () - "Kill all text from the prompt to point." - (interactive) - (cond ((< (marker-position cider-repl-input-start-mark) (point)) - (kill-region cider-repl-input-start-mark (point))) - ((= (point) (marker-position cider-repl-input-start-mark)) - (cider-repl-delete-current-input)))) - -(defun cider-repl--input-complete-p (start end) - "Return t if the region from START to END is a complete sexp." - (save-excursion - (goto-char start) - (cond ((looking-at "\\s *[@'`#]?[(\"]") - (ignore-errors - (save-restriction - (narrow-to-region start end) - ;; Keep stepping over blanks and sexps until the end of - ;; buffer is reached or an error occurs. Tolerate extra - ;; close parens. - (cl-loop do (skip-chars-forward " \t\r\n)") - until (eobp) - do (forward-sexp)) - t))) - (t t)))) - -(defun cider-repl-handler (buffer) - "Make a nREPL evaluation handler for the REPL BUFFER." - (nrepl-make-response-handler buffer - (lambda (buffer value) - (unless cider-repl-use-pretty-printing - (cider-repl-emit-result buffer value t))) - (lambda (buffer out) - (cider-repl-emit-output buffer out)) - (lambda (buffer err) - (cider-repl-emit-err-output buffer err)) - (lambda (buffer) - (cider-repl-emit-prompt buffer)))) - -(defun cider-repl--send-input (&optional newline) - "Go to the end of the input and send the current input. -If NEWLINE is true then add a newline at the end of the input." - (unless (cider-repl--in-input-area-p) - (error "No input at point")) - (goto-char (point-max)) - (let ((end (point))) ; end of input, without the newline - (cider-repl--add-to-input-history (buffer-substring cider-repl-input-start-mark end)) - (when newline - (insert "\n") - (cider-repl--show-maximum-output)) - (let ((inhibit-modification-hooks t)) - (add-text-properties cider-repl-input-start-mark - (point) - `(cider-old-input - ,(cl-incf cider-repl-old-input-counter)))) - (if cider-repl-use-clojure-font-lock - (let ((input-string (buffer-substring cider-repl-input-start-mark end))) - (save-excursion - ;; TODO: Think of a more efficient way to do that - (cider-repl-kill-input) - ;; replace the current input with a Clojure font-locked version of itself - (insert (cider-font-lock-as-clojure input-string) "\n"))) - (let ((overlay (make-overlay cider-repl-input-start-mark end))) - ;; These properties are on an overlay so that they won't be taken - ;; by kill/yank. - (overlay-put overlay 'read-only t) - (overlay-put overlay 'font-lock-face 'cider-repl-input-face)))) - (let* ((input (cider-repl--current-input)) - (form (if (and (not (string-match "\\`[ \t\r\n]*\\'" input)) - cider-repl-use-pretty-printing) - (cider-format-pprint-eval input (1- (window-width))) - input))) - (goto-char (point-max)) - (cider-repl--mark-input-start) - (cider-repl--mark-output-start) - (cider-eval form (cider-repl-handler (current-buffer))))) - -(defun cider-repl-return (&optional end-of-input) - "Evaluate the current input string, or insert a newline. -Send the current input ony if a whole expression has been entered, -i.e. the parenthesis are matched. -When END-OF-INPUT is non-nil, send the input even if the parentheses -are not balanced." - (interactive "P") - (cond - (end-of-input - (cider-repl--send-input)) - ((and (get-text-property (point) 'cider-old-input) - (< (point) cider-repl-input-start-mark)) - (cider-repl--grab-old-input end-of-input) - (cider-repl--recenter-if-needed)) - ((cider-repl--input-complete-p cider-repl-input-start-mark (point-max)) - (cider-repl--send-input t)) - (t - (cider-repl-newline-and-indent) - (message "[input not complete]")))) - -(defun cider-repl--recenter-if-needed () - "Make sure that the point is visible." - (unless (pos-visible-in-window-p (point-max)) - (save-excursion - (goto-char (point-max)) - (recenter -1)))) - -(defun cider-repl--grab-old-input (replace) - "Resend the old REPL input at point. -If REPLACE is non-nil the current input is replaced with the old -input; otherwise the new input is appended. The old input has the -text property `cider-old-input'." - (multiple-value-bind (beg end) (cider-property-bounds 'cider-old-input) - (let ((old-input (buffer-substring beg end)) ;;preserve - ;;properties, they will be removed later - (offset (- (point) beg))) - ;; Append the old input or replace the current input - (cond (replace (goto-char cider-repl-input-start-mark)) - (t (goto-char (point-max)) - (unless (eq (char-before) ?\ ) - (insert " ")))) - (delete-region (point) (point-max)) - (save-excursion - (insert old-input) - (when (equal (char-before) ?\n) - (delete-char -1))) - (forward-char offset)))) - -(defun cider-repl-closing-return () - "Evaluate the current input string after closing all open lists." - (interactive) - (goto-char (point-max)) - (save-restriction - (narrow-to-region cider-repl-input-start-mark (point)) - (while (ignore-errors (save-excursion (backward-up-list 1)) t) - (insert ")"))) - (cider-repl-return)) - -(defun cider-repl-toggle-pretty-printing () - "Toggle pretty-printing in the REPL." - (interactive) - (setq cider-repl-use-pretty-printing (not cider-repl-use-pretty-printing)) - (message "Pretty printing in nREPL %s." - (if cider-repl-use-pretty-printing "enabled" "disabled"))) - -(defvar cider-repl-clear-buffer-hook) - -(defun cider-repl-clear-buffer () - "Delete the output generated by the Clojure process." - (interactive) - (let ((inhibit-read-only t)) - (delete-region (point-min) cider-repl-prompt-start-mark) - (delete-region cider-repl-output-start cider-repl-output-end) - (when (< (point) cider-repl-input-start-mark) - (goto-char cider-repl-input-start-mark)) - (recenter t)) - (run-hooks 'cider-repl-clear-buffer-hook)) - -(defun cider-repl--input-line-beginning-position () - "Return the position of the beginning of input." - (save-excursion - (goto-char cider-repl-input-start-mark) - (line-beginning-position))) - -(defun cider-repl-clear-output () - "Delete the output inserted since the last input." - (interactive) - (let ((start (save-excursion - (cider-repl-previous-prompt) - (ignore-errors (forward-sexp)) - (forward-line) - (point))) - (end (1- (cider-repl--input-line-beginning-position)))) - (when (< start end) - (let ((inhibit-read-only t)) - (delete-region start end) - (save-excursion - (goto-char start) - (insert - (propertize ";;; output cleared" 'font-lock-face 'font-lock-comment-face))))))) - -(defun cider-repl-set-ns (ns) - "Switch the namespace of the REPL buffer to NS. - -If invoked in a REPL buffer the command will prompt you for the name of the -namespace to switch to." - (interactive (list (if (or (derived-mode-p 'cider-repl-mode) - (null (cider-ns-form))) - (completing-read "Switch to namespace: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (if ns - (with-current-buffer (cider-current-repl-buffer) - (setq nrepl-buffer-ns ns) - (cider-repl-emit-prompt (current-buffer))) - (error "Cannot determine the current namespace"))) - - -;;;;; History - -(defcustom cider-repl-wrap-history nil - "T to wrap history around when the end is reached." - :type 'boolean - :group 'cider-repl) - -;; These two vars contain the state of the last history search. We -;; only use them if `last-command' was `cider-repl--history-replace', -;; otherwise we reinitialize them. - -(defvar cider-repl-input-history-position -1 - "Newer items have smaller indices.") - -(defvar cider-repl-history-pattern nil - "The regexp most recently used for finding input history.") - -(defun cider-repl--add-to-input-history (string) - "Add STRING to the input history. -Empty strings and duplicates are ignored." - (unless (or (equal string "") - (equal string (car cider-repl-input-history))) - (push string cider-repl-input-history) - (cl-incf cider-repl-input-history-items-added))) - -(defun cider-repl-delete-current-input () - "Delete all text after the prompt." - (goto-char (point-max)) - (delete-region cider-repl-input-start-mark (point-max))) - -(defun cider-repl--replace-input (string) - "Replace the current REPL input with STRING." - (cider-repl-delete-current-input) - (insert-and-inherit string)) - -(defun cider-repl--position-in-history (start-pos direction regexp) - "Return the position of the history item starting at START-POS. -Search in DIRECTION for REGEXP. -Return -1 resp the length of the history if no item matches." - ;; Loop through the history list looking for a matching line - (let* ((step (ecase direction - (forward -1) - (backward 1))) - (history cider-repl-input-history) - (len (length history))) - (cl-loop for pos = (+ start-pos step) then (+ pos step) - if (< pos 0) return -1 - if (<= len pos) return len - if (string-match regexp (nth pos history)) return pos))) - -(defun cider-repl--history-replace (direction &optional regexp) - "Replace the current input with the next line in DIRECTION. -DIRECTION is 'forward' or 'backward' (in the history list). -If REGEXP is non-nil, only lines matching REGEXP are considered." - (setq cider-repl-history-pattern regexp) - (let* ((min-pos -1) - (max-pos (length cider-repl-input-history)) - (pos0 (cond ((cider-history-search-in-progress-p) - cider-repl-input-history-position) - (t min-pos))) - (pos (cider-repl--position-in-history pos0 direction (or regexp ""))) - (msg nil)) - (cond ((and (< min-pos pos) (< pos max-pos)) - (cider-repl--replace-input (nth pos cider-repl-input-history)) - (setq msg (format "History item: %d" pos))) - ((not cider-repl-wrap-history) - (setq msg (cond ((= pos min-pos) "End of history") - ((= pos max-pos) "Beginning of history")))) - (cider-repl-wrap-history - (setq pos (if (= pos min-pos) max-pos min-pos)) - (setq msg "Wrapped history"))) - (when (or (<= pos min-pos) (<= max-pos pos)) - (when regexp - (setq msg (concat msg "; no matching item")))) - (message "%s%s" msg (cond ((not regexp) "") - (t (format "; current regexp: %s" regexp)))) - (setq cider-repl-input-history-position pos) - (setq this-command 'cider-repl--history-replace))) - -(defun cider-history-search-in-progress-p () - "Return t if a current history search is in progress." - (eq last-command 'cider-repl--history-replace)) - -(defun cider-terminate-history-search () - "Terminate the current history search." - (setq last-command this-command)) - -(defun cider-repl-previous-input () - "Cycle backwards through input history. -If the `last-command' was a history navigation command use the -same search pattern for this command. -Otherwise use the current input as search pattern." - (interactive) - (cider-repl--history-replace 'backward (cider-repl-history-pattern t))) - -(defun cider-repl-next-input () - "Cycle forwards through input history. -See `cider-previous-input'." - (interactive) - (cider-repl--history-replace 'forward (cider-repl-history-pattern t))) - -(defun cider-repl-forward-input () - "Cycle forwards through input history." - (interactive) - (cider-repl--history-replace 'forward (cider-repl-history-pattern))) - -(defun cider-repl-backward-input () - "Cycle backwards through input history." - (interactive) - (cider-repl--history-replace 'backward (cider-repl-history-pattern))) - -(defun cider-repl-previous-matching-input (regexp) - "Find the previous input matching REGEXP." - (interactive "sPrevious element matching (regexp): ") - (cider-terminate-history-search) - (cider-repl--history-replace 'backward regexp)) - -(defun cider-repl-next-matching-input (regexp) - "Find then next input matching REGEXP." - (interactive "sNext element matching (regexp): ") - (cider-terminate-history-search) - (cider-repl--history-replace 'forward regexp)) - -(defun cider-repl-history-pattern (&optional use-current-input) - "Return the regexp for the navigation commands. -If USE-CURRENT-INPUT is non-nil, use the current input." - (cond ((cider-history-search-in-progress-p) - cider-repl-history-pattern) - (use-current-input - (assert (<= cider-repl-input-start-mark (point))) - (let ((str (cider-repl--current-input t))) - (cond ((string-match "^[ \n]*$" str) nil) - (t (concat "^" (regexp-quote str)))))) - (t nil))) - -;;; persistent history -(defcustom cider-repl-history-size 500 - "The maximum number of items to keep in the REPL history." - :type 'integer - :safe 'integerp - :group 'cider-repl) - -(defcustom cider-repl-history-file nil - "File to save the persistent REPL history to." - :type 'string - :safe 'stringp - :group 'cider-repl) - -(defun cider-repl--history-read-filename () - "Ask the user which file to use, defaulting `cider-repl-history-file'." - (read-file-name "Use CIDER REPL history file: " - cider-repl-history-file)) - -(defun cider-repl--history-read (filename) - "Read history from FILENAME and return it. -It does not yet set the input history." - (if (file-readable-p filename) - (with-temp-buffer - (insert-file-contents filename) - (when (> (buffer-size (current-buffer)) 0) - (read (current-buffer)))) - '())) - -(defun cider-repl-history-load (&optional filename) - "Load history from FILENAME into current session. -FILENAME defaults to the value of `cider-repl-history-file' but user -defined filenames can be used to read special history files. - -The value of `cider-repl-input-history' is set by this function." - (interactive (list (cider-repl--history-read-filename))) - (let ((f (or filename cider-repl-history-file))) - ;; TODO: probably need to set cider-repl-input-history-position as well. - ;; in a fresh connection the newest item in the list is currently - ;; not available. After sending one input, everything seems to work. - (setq cider-repl-input-history (cider-repl--history-read f)))) - -(defun cider-repl--history-write (filename) - "Write history to FILENAME. -Currently coding system for writing the contents is hardwired to -utf-8-unix." - (let* ((mhist (cider-repl--histories-merge cider-repl-input-history - cider-repl-input-history-items-added - (cider-repl--history-read filename))) - ;; newest items are at the beginning of the list, thus 0 - (hist (cl-subseq mhist 0 (min (length mhist) cider-repl-history-size)))) - (unless (file-writable-p filename) - (error (format "History file not writable: %s" filename))) - (let ((print-length nil) (print-level nil)) - (with-temp-file filename - ;; TODO: really set cs for output - ;; TODO: does cs need to be customizable? - (insert ";; -*- coding: utf-8-unix -*-\n") - (insert ";; Automatically written history of CIDER REPL session\n") - (insert ";; Edit at your own risk\n\n") - (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))) - -(defun cider-repl-history-save (&optional filename) - "Save the current REPL input history to FILENAME. -FILENAME defaults to the value of `cider-repl-history-file'." - (interactive (list (cider-repl--history-read-filename))) - (let* ((file (or filename cider-repl-history-file))) - (cider-repl--history-write file))) - -(defun cider-repl-history-just-save () - "Just save the history to `cider-repl-history-file'. -This function is meant to be used in hooks to avoid lambda -constructs." - (cider-repl-history-save cider-repl-history-file)) - -;; SLIME has different semantics and will not save any duplicates. -;; we keep track of how many items were added to the history in the -;; current session in `cider-repl--add-to-input-history' and merge only the -;; new items with the current history found in the file, which may -;; have been changed in the meantime by another session. -(defun cider-repl--histories-merge (session-hist n-added-items file-hist) - "Merge histories from SESSION-HIST adding N-ADDED-ITEMS into FILE-HIST." - (append (cl-subseq session-hist 0 n-added-items) - file-hist)) - - -;;; REPL shortcuts -(defcustom cider-repl-shortcut-dispatch-char ?\, - "Character used to distinguish REPL commands from Lisp forms." - :type '(character) - :group 'cider-repl) - -(defvar cider-repl-shortcuts (make-hash-table :test 'equal)) - -(defun cider-repl-add-shortcut (name handler) - "Add a REPL shortcut command, defined by NAME and HANDLER." - (puthash name handler cider-repl-shortcuts)) - -(cider-repl-add-shortcut "hasta la vista" 'cider-quit) -(cider-repl-add-shortcut "version" 'cider-version) -(cider-repl-add-shortcut "conn-info" 'cider-display-current-connection-info) -(cider-repl-add-shortcut "conn-rotate" 'cider-rotate-connection) -(cider-repl-add-shortcut "clear" 'cider-repl-clear-buffer) -(cider-repl-add-shortcut "ns" 'cider-repl-set-ns) -(cider-repl-add-shortcut "help" 'cider-repl-shortcuts-help) - -(defun cider-repl-shortcuts-help () - "Display a help buffer." - (interactive) - (ignore-errors (kill-buffer "*CIDER REPL Shortcuts Help*")) - (with-current-buffer (get-buffer-create "*CIDER REPL Shortcuts Help*") - (insert "CIDER REPL shortcuts:\n\n") - (maphash (lambda (k v) (insert (format "%s:\n\t%s\n" k v))) cider-repl-shortcuts) - (goto-char (point-min)) - (help-mode) - (display-buffer (current-buffer) t)) - (cider-repl-handle-shortcut) - (current-buffer)) - -(defun cider-repl--available-shortcuts () - "Return the available REPL shortcuts." - (cider-util--hash-keys cider-repl-shortcuts)) - -(defun cider-repl-handle-shortcut () - "Execute a REPL shortcut." - (interactive) - (if (> (point) cider-repl-input-start-mark) - (insert (string cider-repl-shortcut-dispatch-char)) - (let ((command (completing-read "Command: " - (cider-repl--available-shortcuts)))) - (if (not (equal command "")) - (call-interactively (gethash command cider-repl-shortcuts)) - (error "No command selected"))))) - - -;;;;; CIDER REPL mode -(defvar cider-repl-mode-hook nil - "Hook executed when entering `cider-repl-mode'.") - -(defvar cider-repl-mode-syntax-table - (copy-syntax-table clojure-mode-syntax-table)) - -(defvar cider-repl-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map clojure-mode-map) - (define-key map (kbd "C-c C-d") 'cider-doc-map) - (define-key map (kbd "M-.") 'cider-jump-to-var) - (define-key map (kbd "M-,") 'cider-jump-back) - (define-key map (kbd "C-c M-.") 'cider-jump-to-resource) - (define-key map (kbd "RET") 'cider-repl-return) - (define-key map (kbd "TAB") 'cider-repl-tab) - (define-key map (kbd "C-") 'cider-repl-closing-return) - (define-key map (kbd "C-j") 'cider-repl-newline-and-indent) - (define-key map (kbd "C-c C-o") 'cider-repl-clear-output) - (define-key map (kbd "C-c M-o") 'cider-repl-clear-buffer) - (define-key map (kbd "C-c M-n") 'cider-repl-set-ns) - (define-key map (kbd "C-c C-u") 'cider-repl-kill-input) - (define-key map (kbd "C-a") 'cider-repl-bol) - (define-key map (kbd "C-S-a") 'cider-repl-bol-mark) - (define-key map [home] 'cider-repl-bol) - (define-key map [S-home] 'cider-repl-bol-mark) - (define-key map (kbd "C-") 'cider-repl-backward-input) - (define-key map (kbd "C-") 'cider-repl-forward-input) - (define-key map (kbd "M-p") 'cider-repl-previous-input) - (define-key map (kbd "M-n") 'cider-repl-next-input) - (define-key map (kbd "M-r") 'cider-repl-previous-matching-input) - (define-key map (kbd "M-s") 'cider-repl-next-matching-input) - (define-key map (kbd "C-c C-n") 'cider-repl-next-prompt) - (define-key map (kbd "C-c C-p") 'cider-repl-previous-prompt) - (define-key map (kbd "C-c C-b") 'cider-interrupt) - (define-key map (kbd "C-c C-c") 'cider-interrupt) - (define-key map (kbd "C-c C-m") 'cider-macroexpand-1) - (define-key map (kbd "C-c M-m") 'cider-macroexpand-all) - (define-key map (kbd "C-c C-z") 'cider-switch-to-last-clojure-buffer) - (define-key map (kbd "C-c M-s") 'cider-selector) - (define-key map (kbd "C-c M-f") 'cider-load-fn-into-repl-buffer) - (define-key map (kbd "C-c C-q") 'cider-quit) - (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-x") 'cider-refresh) - (define-key map (kbd "C-x C-e") 'cider-eval-last-sexp) - (define-key map (kbd "C-c C-r") 'cider-eval-region) - (define-key map (string cider-repl-shortcut-dispatch-char) 'cider-repl-handle-shortcut) - (easy-menu-define cider-repl-mode-menu map - "Menu for CIDER's REPL mode" - `("REPL" - ["Complete symbol" complete-symbol] - "--" - ,cider-doc-menu - "--" - ["Jump to source" cider-jump-to-var] - ["Jump to resource" cider-jump-to-resource] - ["Jump back" cider-jump-back] - ["Switch to Clojure buffer" cider-switch-to-last-clojure-buffer] - "--" - ["Inspect" cider-inspect] - ["Macroexpand" cider-macroexpand-1] - ["Macroexpand all" cider-macroexpand-all] - ["Refresh loaded code" cider-refresh] - ["Toggle var tracing" cider-toggle-trace-var] - ["Toggle ns tracing" cider-toggle-trace-ns] - "--" - ["Set REPL ns" cider-repl-set-ns] - ["Toggle pretty printing" cider-repl-toggle-pretty-printing] - "--" - ["Next prompt" cider-repl-next-prompt] - ["Previous prompt" cider-repl-previous-prompt] - ["Clear output" cider-repl-clear-output] - ["Clear buffer" cider-repl-clear-buffer] - ["Kill input" cider-repl-kill-input] - ["Interrupt evaluation" cider-interrupt] - "--" - ["Quit" cider-quit] - ["Restart" cider-restart] - "--" - ["Version info" cider-version])) - map)) - -(define-derived-mode cider-repl-mode fundamental-mode "REPL" - "Major mode for Clojure REPL interactions. - -\\{cider-repl-mode-map}" - (lisp-mode-variables nil) - (setq-local lisp-indent-function 'clojure-indent-function) - (setq-local indent-line-function 'lisp-indent-line) - (make-local-variable 'completion-at-point-functions) - (add-to-list 'completion-at-point-functions - 'cider-complete-at-point) - (set-syntax-table cider-repl-mode-syntax-table) - (cider-turn-on-eldoc-mode) - ;; At the REPL, we define beginning-of-defun and end-of-defun to be - ;; the start of the previous prompt or next prompt respectively. - ;; Notice the interplay with `cider-repl-beginning-of-defun'. - (setq-local beginning-of-defun-function 'cider-repl-mode-beginning-of-defun) - (setq-local end-of-defun-function 'cider-repl-mode-end-of-defun) - (setq-local prettify-symbols-alist clojure--prettify-symbols-alist) - (if (fboundp 'hack-dir-local-variables-non-file-buffer) - (hack-dir-local-variables-non-file-buffer)) - (when cider-repl-history-file - (cider-repl-history-load cider-repl-history-file) - (add-hook 'kill-buffer-hook 'cider-repl-history-just-save t t) - (add-hook 'kill-emacs-hook 'cider-repl-history-just-save)) - (add-hook 'paredit-mode-hook 'clojure-paredit-setup)) - - -(provide 'cider-repl) - -;;; cider-repl.el ends here diff --git a/packages/cider-0.8.2/cider-scratch.el b/packages/cider-0.8.2/cider-scratch.el deleted file mode 100644 index a5dfff7..0000000 --- a/packages/cider-0.8.2/cider-scratch.el +++ /dev/null @@ -1,71 +0,0 @@ -;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014 Bozhidar Batsov -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Imitate Emacs's *scratch* buffer. - -;;; Code: - -(require 'cider-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) - map)) - -(defconst cider-scratch-buffer-name "*cider-scratch*") - -;;;###autoload -(defun cider-scratch () - "Create a scratch buffer." - (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 Lisp 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 diff --git a/packages/cider-0.8.2/cider-selector.el b/packages/cider-0.8.2/cider-selector.el deleted file mode 100644 index 070f1b4..0000000 --- a/packages/cider-0.8.2/cider-selector.el +++ /dev/null @@ -1,160 +0,0 @@ -;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Buffer selection command inspired by SLIME's selector. - -;;; Code: - -(require 'cider-client) -(require 'cider-interaction) -(require 'cider-repl) ; for cider-get-repl-buffer - -(defconst cider-selector-help-buffer "*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 whose `major-mode' is MODE. -Only considers buffers that are not already visible." - (cl-loop for buffer in (buffer-list) - when (and (with-current-buffer buffer (eq major-mode mode)) - (not (string-match "^ " (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)) - -(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-get-repl-buffer)) - -(def-cider-selector-method ?n - "Connections browser buffer." - (nrepl-connection-browser) - nrepl--connection-browser-buffer-name) - -(def-cider-selector-method ?m - "*nrepl-messages* buffer." - nrepl-message-buffer-name) - -(def-cider-selector-method ?x - "*cider-error* buffer." - cider-error-buffer) - -(def-cider-selector-method ?s - "Cycle to the next CIDER connection's REPL." - (cider-rotate-connection) - (cider-get-repl-buffer)) - -(provide 'cider-selector) - -;;; cider-selector.el ends here diff --git a/packages/cider-0.8.2/cider-stacktrace.el b/packages/cider-0.8.2/cider-stacktrace.el deleted file mode 100644 index 05fc64d..0000000 --- a/packages/cider-0.8.2/cider-stacktrace.el +++ /dev/null @@ -1,549 +0,0 @@ -;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*- - -;; Copyright © 2014 Jeff Valk - -;; Author: Jeff Valk - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Stacktrace filtering and stack frame source navigation - -;;; Code: - -(require 'cl-lib) -(require 'button) -(require 'dash) -(require 'easymenu) -(require 'cider-util) -(require 'cider-client) - -;; 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-level 50 - "Set the maximum level of nested data to print. -Used when displaying stacktrace data (used for clojure's *print-level*)." - :type '(choice integer (const nil)) - :group 'cider - :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) - - -;; 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")) - - -;; 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 (apply 'vector (-repeat 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 (get-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 'font-lock-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 (get-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 (-intersection filters flags) t nil))) - (when hide (setq hidden (+ 1 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 (get-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)))) - - -;; Interactive functions - -(defun cider-stacktrace-previous-cause () - "Move point to the previous exception cause, if one exists." - (interactive) - (with-current-buffer (get-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 (get-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 (get-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 - (apply 'vector (-repeat 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 (get-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-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)) - `(dict "file" ,(button-get button 'file)))) - ;; stacktrace returns more accurate line numbers - (info (nrepl-dict-put info "line" (button-get button 'line)))) - (cider--jump-to-loc-from-info info t))) - -(defun cider-stacktrace-jump () - "Like `cider-jump-to-var', but uses the stack frame source at point, if available." - (interactive) - (let ((button (button-at (point)))) - (if (and button (button-get button 'line)) - (cider-stacktrace-navigate button) - (call-interactively 'cider-jump-to-var)))) - - -;; 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 (first filter) - 'filter (second filter) - 'follow-link t - 'action 'cider-stacktrace-filter - 'help-echo (format "Toggle %s stack frames" - (first filter))) - (insert " ")) - (let ((hidden "(0 frames hidden)")) - (put-text-property 0 (length hidden) 'hidden-count t hidden) - (insert " " hidden)) - (newline))) - -(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 "%30s:%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) - (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))) - (newline))))) - -(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)) - (newline)) - ;; Detail level 1: message + ex-data - (cider-propertize-region '(detail 1) - (cider-stacktrace-emit-indented - (propertize (or message "(No message)") 'font-lock-face message-face) indent t) - (newline) - (when data - (cider-stacktrace-emit-indented - (cider-font-lock-as-clojure data) indent nil))) - ;; Detail level 2: stacktrace - (cider-propertize-region '(detail 2) - (newline) - (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) - (newline))))))) - -(defun cider-stacktrace-initialize (causes) - "Set and apply CAUSES initial visibility, filters, and cursor position." - ;; Partially display outermost cause if it's a compiler exception (the - ;; description reports reader location of the error). - (nrepl-dbind-response (first causes) (class) - (when (equal class "clojure.lang.Compiler$CompilerException") - (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 to first stacktrace frame in displayed cause. - (goto-char (point-min)) - (while (cider-stacktrace-next-cause)) - (goto-char (next-single-property-change (point) 'flags))) - -(defun cider-stacktrace-render (buffer causes) - "Emit into BUFFER useful stacktrace information for the CAUSES." - (with-current-buffer buffer - (cider-stacktrace-mode) - (let ((inhibit-read-only t)) - (newline) - ;; Stacktrace filters - (cider-stacktrace-render-filters - buffer - `(("Clojure" clj) ("Java" java) ("REPL" repl) - ("Tooling" tooling) ("Duplicates" dup) ("All" ,nil))) - (newline) - ;; Stacktrace exceptions & frames - (let ((num (length causes))) - (dolist (cause causes) - (let ((note (if (= num (length causes)) "Unhandled" "Caused by"))) - (cider-stacktrace-render-cause buffer cause num note) - (setq num (1- num)))))) - (cider-stacktrace-initialize causes) - (font-lock-refresh-defaults))) - -(provide 'cider-stacktrace) - -;;; cider-stacktrace.el ends here diff --git a/packages/cider-0.8.2/cider-test.el b/packages/cider-0.8.2/cider-test.el deleted file mode 100644 index 232b47b..0000000 --- a/packages/cider-0.8.2/cider-test.el +++ /dev/null @@ -1,470 +0,0 @@ -;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*- - -;; Copyright © 2014 Jeff Valk - -;; Author: Jeff Valk - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This provides execution, reporting, and navigation support for Clojure tests, -;; specifically using the `clojure.test' machinery. This functionality replaces -;; the venerable `clojure-test-mode' (deprecated in June 2014), and relies on -;; nREPL middleware for report running and session support. - -;;; Code: - -(require 'cider-util) -(require 'cider-stacktrace) -(require 'button) -(require 'dash) -(require 'easymenu) - -;;; 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")) - -(defvar cider-test-last-test-ns nil - "The namespace for which tests were last run.") - -(defvar cider-test-last-results nil - "The results of the last run test.") - -(defconst cider-test-report-buffer "*cider-test-report*" - "Buffer name in which to display test reports.") - - -;;; Faces -;; These are as defined in clojure-test-mode. - -(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")) - - -;;; 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-report-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c ,") 'cider-test-run-tests) - (define-key map (kbd "C-c C-,") 'cider-test-rerun-tests) - (define-key map (kbd "C-c M-,") 'cider-test-run-test) - (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 "t") 'cider-test-jump) - (define-key map (kbd "d") 'cider-test-ediff) - (define-key map (kbd "e") 'cider-test-stacktrace) - (define-key map "q" 'cider-popup-buffer-quit-function) - (define-key map (kbd "") 'backward-button) - (define-key map (kbd "TAB") 'forward-button) - (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] - ["Rerun all tests" cider-test-run-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)) - (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)) - (goto-char pos)))) - -(defun cider-test-jump () - "Like `cider-jump-to-var', but uses the test at point's definition, if available." - (interactive) - (let ((ns (get-text-property (point) 'ns)) - (var (get-text-property (point) 'var)) - (line (get-text-property (point) 'line))) - (if (and ns var) - (cider-jump-to-var (concat ns "/" var) line) - (call-interactively 'cider-jump-to-var)))) - - -;;; Error stacktraces - -(defun cider-test-stacktrace-for (ns var index) - "Display stacktrace for the erring NS VAR test with the assertion INDEX." - (let (causes) - (nrepl-send-request - (append - (list "op" "test-stacktrace" "session" (nrepl-current-session) - "ns" ns "var" var "index" index) - (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) - (reverse causes)))))))))) - -(defun cider-test-stacktrace (&optional button) - "Display stacktrace for the erring test at point, optionally from BUTTON." - (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) - (t 'default))) - -(defun cider-test-render-summary (buffer summary) - "Emit into BUFFER the report SUMMARY statistics." - (with-current-buffer buffer - (nrepl-dbind-response summary (var test pass fail error) - (insert (format "Ran %d tests, 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)) - (newline) - (newline)))) - -(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) - (cider-propertize-region (cider-intern-keys (cdr test)) - (cider-insert (capitalize type) (cider-test-type-face type) 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) - (if error - (progn (insert-text-button - error - 'follow-link t - 'action 'cider-test-stacktrace - 'help-echo "View causes and stacktrace") - (newline)) - (insert (cider-font-lock-as-clojure actual))))) - (newline)))) - -(defun cider-test-render-report (buffer ns summary results) - "Emit into BUFFER the report for the NS, SUMMARY, and test RESULTS." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (cider-test-report-mode) - (cider-insert "Test Summary" 'bold t) - (cider-insert ns 'font-lock-function-name-face t "\n") - (cider-test-render-summary buffer summary) - (nrepl-dbind-response summary (fail error) - (unless (zerop (+ fail error)) - (cider-insert "Results" 'bold t "\n") - (nrepl-dict-map - (lambda (var tests) - (dolist (test tests) - (nrepl-dbind-response test (type) - (unless (equal "pass" type) - (cider-test-render-assertion buffer test))))) - results))) - (goto-char (point-min)) - (current-buffer)))) - - -;;; Summary echo - -(defun cider-test-echo-summary (summary) - "Echo SUMMARY statistics for a test run." - (nrepl-dbind-response summary (test fail error) - (message - (propertize - (format "Ran %s tests. %s failures, %s errors." test fail error) - 'face (cond ((not (zerop error)) 'cider-test-error-face) - ((not (zerop fail)) 'cider-test-failure-face) - (t 'cider-test-success-face)))))) - - -;;; 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 line message expected actual) - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (forward-whitespace 1) - (forward-char) - (let ((beg (point))) - (forward-sexp) - (let ((overlay (make-overlay beg (point)))) - (overlay-put overlay 'font-lock-face (cider-test-type-face type)) - (overlay-put overlay 'type type) - (overlay-put overlay 'help-echo message) - (overlay-put overlay 'message message) - (overlay-put overlay 'expected expected) - (overlay-put overlay 'actual actual))))))) - -(defun cider-test-highlight-problems (ns results) - "Highlight all non-passing tests in the NS test RESULTS." - (nrepl-dict-map - (lambda (var tests) - (-when-let (buffer (cider-find-var-file (concat ns "/" var))) - (dolist (test tests) - (nrepl-dbind-response test (type) - (unless (equal "pass" type) - (cider-test-highlight-problem buffer test)))))) - results)) - -(defun cider-test-clear-highlights () - "Clear highlighting of non-passing tests from the last test run." - (interactive) - (-when-let (ns cider-test-last-test-ns) - (dolist (var (nrepl-dict-keys cider-test-last-results)) - (-when-let (buffer (cider-find-var-file (concat ns "/" var))) - (with-current-buffer buffer - (remove-overlays)))))) - - -;;; 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 (rx-to-string `(: ,suffix eos) t) ns) - ns - (concat ns suffix))))) - - -;;; Test execution - -(defun cider-test-execute (ns &optional retest tests) - "Run tests for NS; optionally RETEST failures or run only specified TESTS. -Upon test completion, results are echoed and a test report is optionally -displayed. When test failures/errors occur, their sources are highlighted." - (cider-test-clear-highlights) - (message "Testing...") - (nrepl-send-request - (list "ns" ns "op" (if retest "retest" "test") - "tests" tests "session" (nrepl-current-session)) - (lambda (response) - (nrepl-dbind-response response (summary results status out err) - (cond ((member "namespace-not-found" status) - (message "No tests namespace: %s" 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-test-ns ns) - (setq cider-test-last-results results) - (cider-test-highlight-problems ns results) - (cider-test-echo-summary summary) - (when (or (not (zerop (+ error fail))) - cider-test-show-report-on-success) - (cider-test-render-report - (cider-popup-buffer cider-test-report-buffer t) - ns summary results))))))))) - -(defun cider-test-rerun-tests () - "Rerun failed and erring tests from the last tested namespace." - (interactive) - (-if-let (ns cider-test-last-test-ns) - (cider-test-execute ns t) - (message "No namespace to retest"))) - -(defun cider-test-run-tests (suppress-inference) - "Run all tests for the current Clojure source or test report context. - -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 - (clojure-find-ns) - (or (funcall cider-test-infer-test-ns (clojure-find-ns)) - (when (eq major-mode 'cider-test-report-mode) - cider-test-last-test-ns)))) - (cider-test-execute ns nil) - (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 nil (list var)) - (let ((ns (clojure-find-ns)) - (def (clojure-find-def))) - (if (and ns (member (first def) '("deftest" "defspec"))) - (cider-test-execute ns nil (rest def)) - (message "No test at point")))))) - -(provide 'cider-test) - -;;; cider-test.el ends here diff --git a/packages/cider-0.8.2/cider-util.el b/packages/cider-0.8.2/cider-util.el deleted file mode 100644 index fabc396..0000000 --- a/packages/cider-0.8.2/cider-util.el +++ /dev/null @@ -1,181 +0,0 @@ -;;; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Common utility functions that don't belong anywhere else - -;;; Code: - -(require 'dash) -(require 'cl-lib) -(require 'clojure-mode) - -;;; Compatibility -(eval-and-compile - ;; `defvar-local' for Emacs 24.2 and below - (unless (fboundp 'defvar-local) - (defmacro defvar-local (var val &optional docstring) - "Define VAR as a buffer-local variable with default value VAL. -Like `defvar' but additionally marks the variable as being automatically -buffer-local wherever it is set." - (declare (debug defvar) (doc-string 3)) - `(progn - (defvar ,var ,val ,docstring) - (make-variable-buffer-local ',var)))) - - ;; `setq-local' for Emacs 24.2 and below - (unless (fboundp 'setq-local) - (defmacro setq-local (var val) - "Set variable VAR to value VAL in current buffer." - `(set (make-local-variable ',var) ,val)))) - -(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." - (-filter - (lambda (buffer) (with-current-buffer buffer (derived-mode-p 'clojure-mode))) - (buffer-list))) - -;;; 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 (props) - "Copy plist-style PROPS with any non-symbol keys replaced with symbols." - (-map-indexed (lambda (i x) (if (oddp i) x (cider-maybe-intern x))) props)) - -(defmacro cider-propertize-region (props &rest body) - "Execute BODY and add PROPS to all the text it inserts. -More precisely, PROPS are added to the region between the point's -positions before and after executing BODY." - (let ((start (cl-gensym))) - `(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 - -(defun cider-font-lock-as (mode string) - "Use MODE to font-lock the STRING." - (with-temp-buffer - (insert string) - ;; 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) - (font-lock-fontify-buffer) - (buffer-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)) - -;;; 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)))) - -(defun cider-format-pprint-eval (form &optional right-margin) - "Return a string of Clojure code that will eval and pretty-print FORM. -Pretty printing will avoid going beyond column RIGHT-MARGIN which defaults -to `fill-column'." - (format "(clojure.core/let [x %s] - (binding [clojure.pprint/*print-right-margin* %d] - (clojure.pprint/pprint x)) x)" - form (or right-margin fill-column))) - -(autoload 'pkg-info-version-info "pkg-info.el") - -(defun cider--version () - "Retrieve CIDER's version." - (condition-case nil - (pkg-info-version-info 'cider) - (error cider-version))) - -;;; Strings - -(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)) - -(provide 'cider-util) - -;;; cider-util.el ends here diff --git a/packages/cider-0.8.2/cider.el b/packages/cider-0.8.2/cider.el deleted file mode 100644 index ff779a2..0000000 --- a/packages/cider-0.8.2/cider.el +++ /dev/null @@ -1,248 +0,0 @@ -;;; cider.el --- Clojure Integrated Development Environment and REPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell -;; URL: http://www.github.com/clojure-emacs/cider -;; Version: 0.8.2 -;; Package-Requires: ((clojure-mode "3.0.0") (cl-lib "0.5") (dash "2.4.1") (pkg-info "0.4") (emacs "24") (queue "0.1.1")) -;; Keywords: languages, clojure, cider - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides a Clojure IDE and REPL for Emacs, built on top of nREPL. - -;;; Installation: - -;; Available as a package in marmalade-repo.org and melpa.org - -;; (add-to-list 'package-archives -;; '("marmalade" . "http://marmalade-repo.org/packages/")) -;; -;; or -;; -;; (add-to-list 'package-archives -;; '("melpa" . "http://melpa.org/packages/") t) -;; -;; M-x package-install cider - -;;; Usage: - -;; M-x cider-jack-in - -;;; Code: - -(defgroup cider nil - "Clojure Interactive Development Environment Reimagined." - :prefix "cider-" - :group 'applications - :link '(url-link :tag "Github" "https://github.com/clojure-emacs/cider") - :link '(emacs-commentary-link :tag "Commentary" "cider")) - -(require 'cider-client) -(require 'cider-interaction) -(require 'cider-eldoc) -(require 'cider-repl) -(require 'cider-mode) -(require 'cider-util) -(require 'tramp-sh) - -(defvar cider-version "0.8.2" - "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.") - -(defcustom cider-lein-command - "lein" - "The command used to execute Leiningen 2.x." - :type 'string - :group 'cider) - -(defcustom cider-lein-parameters - "repl :headless" - "Params passed to lein to start an nREPL server via `cider-jack-in'." - :type 'string - :group 'cider) - -(defcustom cider-known-endpoints nil - "Specify a list of custom 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 'list - :group 'cider) - -(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 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))) - -;;;###autoload -(defun cider-jack-in (&optional prompt-project) - "Start a 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." - (interactive "P") - (setq cider-current-clojure-buffer (current-buffer)) - (if (cider--lein-present-p) - (let* ((project (when prompt-project - (read-directory-name "Project: "))) - (project-dir (nrepl-project-directory-for - (or project (nrepl-current-dir)))) - (lein-params (if prompt-project - (read-string (format "nREPL server command: %s " - cider-lein-command) - cider-lein-parameters) - cider-lein-parameters)) - (cmd (format "%s %s" cider-lein-command lein-params))) - (when (nrepl-check-for-repl-buffer nil project-dir) - (nrepl-start-server-process project-dir cmd))) - (message "The %s executable (specified by `cider-lein-command') isn't on your exec-path" - cider-lein-command))) - -;;;###autoload -(defun cider-connect (host port) - "Connect to an nREPL server identified by HOST and PORT. -Create REPL buffer and start an nREPL client connection." - (interactive (cider-select-endpoint)) - (setq cider-current-clojure-buffer (current-buffer)) - (when (nrepl-check-for-repl-buffer `(,host ,port) nil) - (nrepl-start-client-process host port t))) - -(defun cider-select-endpoint () - "Interactively select the host and port to connect to." - (let* ((ssh-hosts (cider--ssh-hosts)) - (hosts (-distinct (append (when cider-host-history - (list (list (car cider-host-history)))) - (list (list (nrepl-current-host))) - cider-known-endpoints - ssh-hosts - (when (file-remote-p default-directory) - ;; add localhost even in remote buffers - (list (list "localhost")))))) - (sel-host (cider--completing-read-host hosts)) - (host (car sel-host)) - (local-p (or (nrepl-local-host-p host) - (not (assoc-string host ssh-hosts)))) - ;; Each lein-port is a list of the form (dir port) - (lein-ports (if local-p - ;; might connect to localhost from a remote file - (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 "ssh" nil host "" nil)) - ;; might 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))))) - (ports (append (cdr sel-host) lein-ports)) - (port (cider--completing-read-port host ports))) - (list host port))) - -(defun cider--ssh-hosts () - "Retrieve all ssh host from local configuration files." - (-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--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) (second 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 (nrepl-project-directory-for dir) - paths)))) - (-distinct (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))))) - (-distinct paths))) - -;; TODO: Implement a check for `cider-lein-command' over tramp -(defun cider--lein-present-p () - "Check if `cider-lein-command' is on the `exec-path'. - -In case `default-directory' is non-local we assume the command is available." - (or (file-remote-p default-directory) - (executable-find cider-lein-command) - (executable-find (concat cider-lein-command ".bat")))) - -;;;###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-c") 'cider-connect))) - - -(define-obsolete-function-alias 'cider 'cider-connect) - -(provide 'cider) - -;;; cider.el ends here diff --git a/packages/cider-0.8.2/nrepl-client.el b/packages/cider-0.8.2/nrepl-client.el deleted file mode 100644 index e1afe26..0000000 --- a/packages/cider-0.8.2/nrepl-client.el +++ /dev/null @@ -1,1338 +0,0 @@ -;;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2014 Tim King, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov, Hugo Duncan, Steve Purcell -;; -;; Author: Tim King -;; Phil Hagelberg -;; Bozhidar Batsov -;; Hugo Duncan -;; Steve Purcell -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . -;; -;; This file is not part of GNU Emacs. -;; -;;; Commentary: -;; -;; Provides an Emacs Lisp client to connect to Clojure nREPL servers. -;; -;; A connection is an abstract idea of the communication between Emacs (client) -;; and nREPL server. On Emacs side connections are represented by two running -;; processes. The two processes are the server process and client process. Each -;; of these is represented by it's own process buffer, filter and sentinel. -;; -;; The nREPL communication process can be broadly represented as follows: -;; -;; 1) Server process is started as an Emacs subprocess (usually by -;; `cider-jack-in') -;; -;; 2) Server's process filter (`nrepl-server-filter') detects the connection -;; port from the first plain text response from server and starts -;; communication process as another Emacs subprocess. This is the nREPL -;; client process (`nrepl-client-filter'). All requests and responses -;; handling happen through this client connection. -;; -;; 3) Requests are sent by `nrepl-send-request' and -;; `nrepl-send-sync-request'. Request is simply a list containing a -;; requested operation name and the parameters required by the -;; operation. Each request has an associated callback that is called once -;; the response for the request has arrived. Besides the above functions -;; there are specialized request senders for each type of common -;; operations. Examples are `nrepl-request:eval', `nrepl-request:clone', -;; `nrepl-request:describe'. -;; -;; 4) Responses from the server are decoded in `nrepl-client-filter' and are -;; physically represented by alists whose structure depends on the type of -;; the response. After having been decoded, the data from the response is -;; passed over to the callback that was registered by the original -;; request. -;; -;; Please see the comments in dedicated sections of this file for more detailed -;; description. - -;;; Code: -(require 'dash) -(require 'thingatpt) -(require 'etags) -(require 'ansi-color) -(require 'ewoc) -(require 'cl-lib) -(require 'cider-util) -(require 'queue) -(require 'tramp) - - -;;; Custom - -(defgroup nrepl nil - "Interaction with the Clojure nREPL Server." - :prefix "nrepl-" - :group 'applications) - -(defcustom nrepl-buffer-name-separator " " - "Used in constructing the REPL buffer name. -The `nrepl-buffer-name-separator' separates cider-repl from the project name." - :type '(string) - :group 'nrepl) - -(defcustom nrepl-buffer-name-show-port nil - "Show the connection port in the nrepl REPL buffer name, if set to t." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-connected-hook nil - "List of functions to call when connecting to the nREPL server." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-disconnected-hook nil - "List of functions to call when disconnected from the nREPL server." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-file-loaded-hook nil - "List of functions to call when a load file has completed." - :type 'hook - :group 'nrepl) - -(defcustom nrepl-host "localhost" - "The default hostname (or IP address) to connect to." - :type 'string - :group 'nrepl) - -(defcustom nrepl-force-ssh-for-remote-hosts nil - "If non-nil, do not attempt a direct connection for remote hosts." - :type 'boolean - :group 'nrepl) - -(defcustom nrepl-port nil - "The default port to connect to." - :type 'string - :group 'nrepl) - -(defcustom nrepl-sync-request-timeout 10 - "The number of seconds to wait for a sync response. -Setting this to nil disables the timeout functionality." - :type 'integer - :group 'nrepl) - -(defcustom nrepl-hide-special-buffers nil - "Control the display of some special buffers in buffer switching commands. -When true some special buffers like the connection and the server -buffer will be hidden." - :type 'boolean - :group 'nrepl) - - -;;; nREPL Buffer Names - -(defconst nrepl-message-buffer-name "*nrepl-messages*") -(defconst nrepl-repl-buffer-name-template "*cider-repl%s*") -(defconst nrepl-connection-buffer-name-template "*nrepl-connection%s*") -(defconst nrepl-server-buffer-name-template "*nrepl-server%s*") -(defconst nrepl-tunnel-buffer-name-template "*nrepl-tunnel%s*") - -(defun nrepl-format-buffer-name-template (buffer-name-template designation) - "Apply the DESIGNATION to the corresponding BUFFER-NAME-TEMPLATE." - (format buffer-name-template - (if (> (length designation) 0) - (concat nrepl-buffer-name-separator designation) - ""))) - -(defun nrepl-make-buffer-name (buffer-name-template &optional project-dir host port) - "Generate a buffer name using BUFFER-NAME-TEMPLATE. - -If not supplied PROJECT-DIR, PORT and HOST default to the buffer local -value of the `nrepl-project-dir' and `nrepl-endpoint'. - -The name will include the project name if available or the endpoint host if -it is not. The name will also include the connection port if -`nrepl-buffer-name-show-port' is true." - (generate-new-buffer-name - (let ((project-name (nrepl--project-name (or project-dir nrepl-project-dir))) - (nrepl-proj-port (or port (cadr nrepl-endpoint)))) - (nrepl-format-buffer-name-template - buffer-name-template - (concat (if project-name project-name (or host (car nrepl-endpoint))) - (if (and nrepl-proj-port nrepl-buffer-name-show-port) - (format ":%s" nrepl-proj-port) "")))))) - -(defun nrepl--make-hidden-name (buffer-name) - "Apply a prefix to BUFFER-NAME that will hide the buffer." - (concat (if nrepl-hide-special-buffers " " "") buffer-name)) - -(defun nrepl-connection-buffer-name (&optional project-dir host port) - "Return the name of the connection buffer. -PROJECT-DIR, HOST and PORT are as in `/nrepl-make-buffer-name'." - (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-connection-buffer-name-template - project-dir host port))) - -(defun nrepl-server-buffer-name (&optional project-dir host port) - "Return the name of the server buffer. -PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." - (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-server-buffer-name-template - project-dir host port))) - -(defun nrepl-tunnel-buffer-name (&optional project-dir host port) - "Return the name of the tunnel buffer. -PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." - (nrepl--make-hidden-name - (nrepl-make-buffer-name nrepl-tunnel-buffer-name-template - project-dir host port))) - - -;;; Buffer Local Declarations - -;; These variables are used to track the state of nREPL connections -(defvar-local nrepl-connection-buffer nil) -(defvar-local nrepl-server-buffer nil) -(defvar-local nrepl-repl-buffer nil) -(defvar-local nrepl-endpoint nil) -(defvar-local nrepl-project-dir nil) -(defvar-local nrepl-tunnel-buffer nil) - -(defvar-local nrepl-session nil - "Current nREPL session id.") - -(defvar-local nrepl-tooling-session nil - "Current nREPL tooling session id. -To be used for tooling calls (i.e. completion, eldoc, etc)") - -(defvar-local nrepl-request-counter 0 - "Continuation serial number counter.") - -(defvar-local nrepl-pending-requests nil) - -(defvar-local nrepl-completed-requests nil) - -(defvar-local nrepl-buffer-ns nil - "Current Clojure namespace of this buffer.") - -(defvar-local nrepl-last-sync-response nil - "Result of the last sync request.") - -(defvar-local nrepl-last-sync-request-timestamp nil - "The time when the last sync request was initiated.") - -(defvar-local nrepl-ops nil - "Available nREPL server ops (from describe).") - -(defvar-local nrepl-versions nil - "Version information received from the describe op.") - - -;;; Utilities -(defmacro nrepl-dbind-response (response keys &rest body) - "Destructure an nREPL RESPONSE dict. -Bind the value of the provided KEYS and execute 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) - -(defun nrepl-op-supported-p (op) - "Return t iff the given operation OP is supported by nREPL server." - (with-current-buffer (nrepl-current-connection-buffer) - (and nrepl-ops (nrepl-dict-get nrepl-ops op)))) - -(defun nrepl-current-dir () - "Return the directory of the current buffer." - (or (-when-let (file-name (buffer-file-name (current-buffer))) - (file-name-directory file-name)) - list-buffers-directory)) - -(defun nrepl-local-host-p (host) - "Return t if HOST is local." - (string-match-p tramp-local-host-regexp host)) - -(defun nrepl-project-directory-for (dir-name) - "Return the project directory for the specified DIR-NAME." - (when dir-name - (locate-dominating-file dir-name "project.clj"))) - -(defun nrepl-check-for-repl-buffer (endpoint project-directory) - "Check whether a matching connection buffer already exists. -Looks for buffers where `nrepl-endpoint' matches ENDPOINT, -or `nrepl-project-dir' matches PROJECT-DIRECTORY. -If so ask the user for confirmation." - (if (cl-find-if - (lambda (buffer) - (let ((buffer (get-buffer buffer))) - (or (and endpoint - (equal endpoint - (buffer-local-value 'nrepl-endpoint buffer))) - (and project-directory - (equal project-directory - (buffer-local-value 'nrepl-project-dir buffer)))))) - (nrepl-connection-buffers)) - (y-or-n-p - "An nREPL connection buffer already exists. Do you really want to create a new one? ") - t)) - -(defun nrepl-extract-port (&optional dir) - "Read port from .nrepl-port, nrepl-port or target/repl-port files in directory DIR." - (-when-let (dir (or dir (nrepl-project-directory-for (nrepl-current-dir)))) - (or (nrepl--port-from-file (expand-file-name "repl-port" dir)) - (nrepl--port-from-file (expand-file-name ".nrepl-port" dir)) - (nrepl--port-from-file (expand-file-name "target/repl-port" dir))))) - -(defun nrepl--port-from-file (file) - "Attempts to read port from a file named by FILE." - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents file) - (buffer-string)))) - - -;;; nREPL dict - -(defun nrepl-dict-p (object) - "Return t if OBJECT is a nREPL dict." - (and (listp object) - (eq (car object) 'dict))) - -(defun nrepl-dict-empty-p (dict) - "Return t if nREPL dict is empty." - (null (cdr dict))) - -(defun nrepl-dict-get (dict key) - "Get from DICT value associated with KEY. -If dict is nil, return nil." - (when dict - (if (nrepl-dict-p dict) - (lax-plist-get (cdr dict) key) - (error "Not a 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 a 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 a 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 a 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 a nREPL dict."))) - -(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 accumulated into a list. DICT1 is modified destructively and -then returned." - (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))))) - - -;;; Bencode - -(cl-defstruct (nrepl-response-queue - (:include queue) - (:constructor nil) - (:constructor nrepl-response-queue (&optional stub))) - stub) - -(put 'nrepl-response-queue 'function-documentation - "Create queue object used by nREPL to store decoded server requests. -The STUB slot stores a stack of nested, incompletely parsed objects.") - -(defun nrepl--bdecode-list (&optional stack) - "Decode a bencode list or dict starting at point. -STACK is as in `nrepl--bdecode-1'." - ;; skip leading l or d - (forward-char 1) - (let* ((istack (nrepl--bdecode-1 stack)) - (pos0 (point)) - (info (car istack))) - (while (null info) - (setq istack (nrepl--bdecode-1 (cdr istack)) - pos0 (point) - info (car istack))) - (cond ((eq info :e) - (cons nil (cdr istack))) - ((eq info :stub) - (goto-char pos0) - istack) - (t istack)))) - -(defun nrepl--bdecode-1 (&optional stack) - "Decode one elementary bencode object starting at point. -Bencoded object is either list, dict, integer or string. See -http://en.wikipedia.org/wiki/Bencode#Encoding_algorithm for the encoding -rules. - -STACK is a list of so far decoded components of the current message. Car -of STACK is the innermost incompletely decoded object. The algorithm pops -this list when inner object was completely decoded or grows it by one when -new list or dict was encountered. - -The returned value is of the form (INFO . STACK) where INFO is -:stub, nil, :end or :eob and STACK is either an incomplete parsing state as -above (INFO is :stub, nil or :eob) or a list of one component representing -the completely decoded message (INFO is :end). INFO is nil when an -elementary non-root object was successfully decoded. INFO is :end when this -object is a root list or dict." - (cond - ;; list - ((eq (char-after) ?l) - (nrepl--bdecode-list (cons () stack))) - ;; dict - ((eq (char-after) ?d) - (nrepl--bdecode-list (cons '(dict) stack))) - ;; end of a list or a dict - ((eq (char-after) ?e) - (forward-char 1) - (cons (if (cdr stack) :e :end) - (nrepl--push (nrepl--nreverse (car stack)) - (cdr stack)))) - ;; string - ((looking-at "\\([0-9]+\\):") - (let ((pos0 (point)) - (beg (goto-char (match-end 0))) - (end (byte-to-position (+ (position-bytes (point)) - (string-to-number (match-string 1)))))) - (if (null end) - (progn (goto-char pos0) - (cons :stub stack)) - (goto-char end) - (cons nil (nrepl--push (buffer-substring-no-properties beg end) - stack))))) - ;; integer - ((looking-at "i\\(-?[0-9]+\\)e") - (goto-char (match-end 0)) - (cons nil (nrepl--push (string-to-number (match-string 1)) - stack))) - ;; should happen in tests only as eobp is checked in nrepl-bdecode. - ((eobp) - (cons :eob stack)) - ;; truncation in the middle of an integer or in 123: string prefix - ((looking-at "[0-9i]") - (cons :stub stack)) - ;; else, throw a quiet error - (t - (message "Invalid bencode message detected. See %s buffer." - nrepl-message-buffer-name) - (nrepl-log-message - (format "Decoder error at position %d ('%s'):" - (point) (buffer-substring (point) (min (+ (point) 10) (point-max))))) - (nrepl-log-message (buffer-string)) - (ding) - ;; Ensure loop break and clean queues' states in nrepl-bdecode: - (goto-char (point-max)) - (cons :end nil)))) - -(defun nrepl--bdecode-message (&optional stack) - "Decode one full message starting at point. -STACK is as in `nrepl--bdecode-1'. Return a cons (INFO . STACK)." - (let* ((istack (nrepl--bdecode-1 stack)) - (info (car istack)) - (stack (cdr istack))) - (while (or (null info) - (eq info :e)) - (setq istack (nrepl--bdecode-1 stack) - info (car istack) - stack (cdr istack))) - istack)) - -(defun nrepl-bdecode (string-q &optional response-q) - "Decode STRING-Q and place the results into RESPONSE-Q. -STRING-Q is either a queue of strings or a string. RESPONSE-Q is a queue of -server requests (nREPL dicts). STRING-Q and RESPONSE-Q are modified by side -effects. - -Return a cons (STRING-Q . RESPONSE-Q) where STRING-Q is the original queue -containing the remainder of the input strings which could not be -decoded. RESPONSE-Q is the original queue with successfully decoded messages -enqueued and with slot STUB containing a nested stack of an incompletely -decoded message or nil if the strings were completely decoded." - (with-temp-buffer - (if (queue-p string-q) - (while (queue-head string-q) - (insert (queue-dequeue string-q))) - (insert string-q) - (setq string-q (queue-create))) - (goto-char 1) - (unless response-q - (setq response-q (nrepl-response-queue))) - (let ((istack (nrepl--bdecode-message - (nrepl-response-queue-stub response-q)))) - (while (and (eq (car istack) :end) - (not (eobp))) - (queue-enqueue response-q (cadr istack)) - (setq istack (nrepl--bdecode-message))) - (unless (eobp) - (queue-enqueue string-q (buffer-substring (point) (point-max)))) - (if (not (eq (car istack) :end)) - (setf (nrepl-response-queue-stub response-q) (cdr istack)) - (queue-enqueue response-q (cadr istack)) - (setf (nrepl-response-queue-stub response-q) nil)) - (cons string-q response-q)))) - -(defun nrepl-bencode (object) - "Encode OBJECT with bencode. -Integers, lists and nrepl-dicts are treated according to bencode -specification. Everything else is encoded as string." - (cond - ((integerp object) (format "i%de" object)) - ((nrepl-dict-p object) (format "d%se" (apply 'concat (-map 'nrepl-bencode (cdr object))))) - ((listp object) (format "l%se" (apply 'concat (-map 'nrepl-bencode object)))) - (t (format "%s:%s" (string-bytes object) object)))) - - -;;; Client: Process Filter - -(defun nrepl-client-filter (proc string) - "Decode message(s) from PROC contained in STRING and dispatch them." - ;; (nrepl-log-message string) - (let ((string-q (process-get proc :string-q))) - (queue-enqueue string-q string) - ;; Start decoding only if the last letter is 'e' - (when (eq ?e (aref string (1- (length string)))) - (let ((response-q (process-get proc :response-q))) - (nrepl-bdecode string-q response-q) - (while (queue-head response-q) - (with-current-buffer (process-buffer proc) - (nrepl--dispatch-response (queue-dequeue response-q)))))))) - -(defun nrepl--dispatch-response (response) - "Dispatch the RESPONSE to associated callback. -First we check the callbacks of pending requests. If no callback was found, -we check the completed requests, since responses could be received even for -older requests with \"done\" status." - (nrepl-dbind-response response (id) - (nrepl-log-message (cons '<- (cdr response))) - (let ((callback (or (gethash id nrepl-pending-requests) - (gethash id nrepl-completed-requests)))) - ;; normally all responses should have an associated callback - ;; in some scenarios, however, we get some nREPL responses - ;; without a matching request (https://github.com/clojure-emacs/cider/issues/853) - ;; until this is resolved we need the fallback handler - (if callback - (funcall callback response) - (message "nREPL: No response handler with id %s found" id) - ;; FIXME: This should be removed when we identify what's causing - ;; the problems described in https://github.com/clojure-emacs/cider/issues/853 - (funcall (nrepl--make-fallback-handler) response))))) - -(defun nrepl-client-sentinel (process message) - "Handle sentinel events from PROCESS. -Display MESSAGE and if the process is closed kill the -process buffer and run the hook `nrepl-disconnected-hook'." - (message "nREPL: Connection closed (%s)" message) - (if (equal (process-status process) 'closed) - (run-hooks 'nrepl-disconnected-hook))) - - -;;; Network - -(defun nrepl-connect (host port) - "Connect to machine identified by HOST and PORT. -For local hosts use a direct connection. For remote hosts, if -`nrepl-force-ssh-for-remote-hosts' is nil, attempt a direct connection -first. If `nrepl-force-ssh-for-remote-hosts' is non-nil or the direct -connection failed, try to start a SSH tunneled connection. Return a plist -of the form (:proc PROC :host \"HOST\" :port PORT) that might contain -additional key-values depending on the connection type." - (let ((localp (if host - (nrepl-local-host-p host) - (not (file-remote-p default-directory))))) - (if localp - (nrepl--direct-connect (or host "localhost") port) - (or (and host (not nrepl-force-ssh-for-remote-hosts) - (nrepl--direct-connect host port 'no-error)) - (nrepl--ssh-tunnel-connect host port))))) - -(defun nrepl--direct-connect (host port &optional no-error) - "If HOST and PORT are given, try to `open-network-stream'. -If NO-ERROR is non-nil, show messages instead of throwing an error." - (if (not (and host port)) - (unless no-error - (error "Host (%s) and port (%s) must be provided" host port)) - (message "nREPL: Establishing direct connection to %s:%s ..." host port) - (condition-case nil - (prog1 (list :proc (open-network-stream "nrepl" nil host port) - :host host :port port) - (message "nREPL: Direct connection established")) - (error (let ((mes "nREPL: Direct connection failed")) - (if no-error (message mes) (error mes)) - nil))))) - -(defun nrepl--ssh-tunnel-connect (host port) - "Connect to a remote machine identified by HOST and PORT through SSH tunnel." - (message "nREPL: Establishing SSH tunneled connection ...") - (let* ((remote-dir (if host (format "/ssh:%s:" host) default-directory)) - (ssh (or (executable-find "ssh") - (error "nREPL: Cannot locate 'ssh' executable"))) - (cmd (nrepl--ssh-tunnel-command ssh remote-dir port)) - (tunnel-buf (nrepl-tunnel-buffer-name)) - (tunnel (start-process-shell-command "nrepl-tunnel" tunnel-buf cmd))) - (process-put tunnel :waiting-for-port t) - (set-process-filter tunnel (nrepl--ssh-tunnel-filter port)) - (while (and (process-live-p tunnel) - (process-get tunnel :waiting-for-port)) - (accept-process-output nil 0.005)) - (if (not (process-live-p tunnel)) - (error "nREPL: SSH port forwarding failed. Check the '%s' buffer." tunnel-buf) - (message "nREPL: SSH port forwarding established to localhost:%s" port) - (let ((endpoint (nrepl--direct-connect "localhost" port))) - (-> endpoint - (plist-put :tunnel tunnel) - (plist-put :remote-host host)))))) - -(defun nrepl--ssh-tunnel-command (ssh dir port) - "Command string to open SSH tunnel to the host associated with DIR's PORT." - (with-parsed-tramp-file-name dir nil - ;; this abuses the -v option for ssh to get output when the port - ;; forwarding is set up, which is used to synchronise on, so that - ;; the port forwarding is up when we try to connect. - (format-spec - "%s -v -N -L %p:localhost:%p %u'%h'" - `((?s . ,ssh) - (?p . ,port) - (?h . ,host) - (?u . ,(if user (format "-l '%s' " user) "")))))) - -(defun nrepl--ssh-tunnel-filter (port) - "Return a process filter that waits for PORT to appear in process output." - (let ((port-string (format "LOCALHOST:%s" port))) - (lambda (proc string) - (when (string-match port-string string) - (process-put proc :waiting-for-port nil)) - (when (and (process-live-p proc) - (buffer-live-p (process-buffer proc))) - (with-current-buffer (process-buffer proc) - (let ((moving (= (point) (process-mark proc)))) - (save-excursion - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point))) - (if moving (goto-char (process-mark proc))))))))) - - -;;; Client: Process Handling - -;; `nrepl-start-client-process' is called from `nrepl-server-filter'. It -;; starts the client process described by `nrepl-client-filter' and -;; `nrepl-client-sentinel'. -(defun nrepl-start-client-process (&optional host port replp server-proc) - "Create new client process identified by HOST and PORT. -If eitehr HOST or PORT are nil, pick them from the value returned by -`nrepl-connection-endpoint'. If REPLP is non-nil create a client -connection which is associated with a repl buffer. When non-nil, -SERVER-PROC must be a running nrepl server process within Emacs. Return -the newly created client connection process." - (let* ((endpoint (nrepl-connect host port)) - (client-proc (plist-get endpoint :proc)) - (host (plist-get endpoint :host)) - (port (plist-get endpoint :port)) - (client-buf (if replp - (cider-repl-create default-directory host port) - (nrepl-create-connection-buffer default-directory host port)))) - - (set-process-buffer client-proc (get-buffer client-buf)) - - (set-process-filter client-proc 'nrepl-client-filter) - (set-process-sentinel client-proc 'nrepl-client-sentinel) - (set-process-coding-system client-proc 'utf-8-unix 'utf-8-unix) - - (process-put client-proc :string-q (queue-create)) - (process-put client-proc :response-q (nrepl-response-queue)) - - (with-current-buffer client-buf - (-when-let (server-buf (and server-proc (process-buffer server-proc))) - (setq nrepl-project-dir (buffer-local-value 'nrepl-project-dir server-buf) - nrepl-server-buffer server-buf)) - (setq nrepl-endpoint `(,host ,port) - ;; FIXME: REPL and connection buffers are the same thing - nrepl-connection-buffer client-buf - nrepl-repl-buffer (when replp client-buf) - nrepl-buffer-ns "user" - nrepl-tunnel-buffer (-when-let (tunnel (plist-get endpoint :tunnel)) - (process-buffer tunnel)) - nrepl-pending-requests (make-hash-table :test 'equal) - nrepl-completed-requests (make-hash-table :test 'equal))) - - (nrepl-make-connection-default client-buf) - (nrepl--init-client-sessions client-proc) - (nrepl--init-connection-buffer client-buf replp) - (cider--check-required-nrepl-ops) - (cider--check-middleware-compatibility) - (run-hooks 'nrepl-connected-hook) - - client-proc)) - -(defun nrepl--init-client-sessions (client) - "Initialize CLIENT nREPL sessions. - -We create two client nREPL sessions per connection - a main session and a tooling -session. The main session is general purpose and is used for pretty much -every request that needs a session. The tooling session is used only for -functionality that's implemented in terms of the \"eval\" op, so that eval requests -for functionality like pretty-printing won't clobber the values of *1, *2, etc." - (let ((response-main (nrepl-sync-request:clone)) - (response-tooling (nrepl-sync-request:clone))) - (nrepl-dbind-response response-main (new-session err) - (if new-session - (with-current-buffer (process-buffer client) - (setq nrepl-session new-session)) - (error "Could not create new session (%s)" err))) - (nrepl-dbind-response response-tooling (new-session err) - (if new-session - (with-current-buffer (process-buffer client) - (setq nrepl-tooling-session new-session)) - (error "Could not create new tooling session (%s)" err))))) - -(defun nrepl--init-connection-buffer (conn-buffer replp) - "Initialize CONN-BUFFER as a connection buffer. -If REPLP is non-nil, initialize as a REPL buffer. - -Here we determine the main session's capabilities using the \"describe\" op -and store that information as buffer-local data in the connection buffer." - (let ((description (nrepl-sync-request:describe))) - (nrepl-dbind-response description (ops versions) - (with-current-buffer conn-buffer - (setq nrepl-ops ops) - (setq nrepl-versions versions))) - (when replp - (cider-repl-init conn-buffer)))) - -(defun nrepl-close-client-sessions () - "Close the nREPL sessions for the active connection." - (nrepl-sync-request:close (nrepl-current-session)) - (nrepl-sync-request:close (nrepl-current-tooling-session))) - -(defun nrepl-close (connection-buffer) - "Close the nREPL connection for CONNECTION-BUFFER." - (interactive (list (nrepl-current-connection-buffer))) - (nrepl-close-client-sessions) - (nrepl--close-connection-buffer connection-buffer) - (run-hooks 'nrepl-disconnected-hook) - (nrepl--connections-refresh)) - - -;;; Client: Response Handling -;; After being decoded, responses (aka, messages from the server) are dispatched -;; to handlers. Handlers are constructed with `nrepl-make-response-handler'. - -(defvar nrepl-err-handler 'cider-default-err-handler - "Evaluation error handler.") - -(defun nrepl-make-response-handler (buffer value-handler stdout-handler - stderr-handler done-handler - &optional eval-error-handler) - "Make a response handler for connection BUFFER. -A handler is a function that takes one argument - response received from -the server process. The response is an alist that contains at least 'id' -and 'session' keys. Other standard response keys are 'value', 'out', 'err' -and 'status'. - -The presence of a particular key determines the type of the response. For -example, if 'value' key is present, the response is of type 'value', if -'out' key is present the response is 'stdout' etc. Depending on the typea, -the handler dispatches the appropriate value to one of the supplied -handlers: VALUE-HANDLER, STDOUT-HANDLER, STDERR-HANDLER, DONE-HANDLER, and -EVAL-ERROR-HANDLER. If the optional EVAL-ERROR-HANDLER is nil, the default -`nrepl-err-handler' is used. If any of the other supplied handlers are nil -nothing happens for the coresponding type of response. - -When `nrepl-log-messages' is non-nil, *nrepl-messages* buffer contains -server responses." - (lambda (response) - (nrepl-dbind-response response (value ns out err status id ex root-ex - session) - (cond (value - (with-current-buffer buffer - (when (and ns (not (derived-mode-p 'clojure-mode))) - (setq nrepl-buffer-ns ns))) - (when value-handler - (funcall value-handler buffer value))) - (out - (when stdout-handler - (funcall stdout-handler buffer out))) - (err - (when stderr-handler - (funcall stderr-handler buffer err))) - (status - (when (member "interrupted" status) - (message "Evaluation interrupted.")) - (when (member "eval-error" status) - (funcall (or eval-error-handler nrepl-err-handler) - buffer ex root-ex session)) - (when (member "namespace-not-found" status) - (message "Namespace not found.")) - (when (member "need-input" status) - (cider-need-input buffer)) - (when (member "done" status) - (puthash id (gethash id nrepl-pending-requests) nrepl-completed-requests) - (remhash id nrepl-pending-requests) - (when done-handler - (funcall done-handler buffer)))))))) - -(defun nrepl--make-fallback-handler () - "Fallback handler which is invoked when no handler is found. -Handles only stdout and stderr responses." - (nrepl-make-response-handler (cider-current-repl-buffer) - ;; VALUE - '() - ;; STDOUT - (lambda (buffer out) - ;; fixme: rename into emit-out-output - (cider-repl-emit-output buffer out)) - ;; STDERR - (lambda (buffer err) - (cider-repl-emit-err-output buffer err)) - ;; DONE - '())) - - -;;; Client: Request Core API - -;; Requests are messages from an nREPL client (like CIDER) to an nREPL server. -;; Requests can be asynchronous (sent with `nrepl-send-request') or -;; synchronous (send with `nrepl-send-sync-request'). The request is a pair list -;; of operation name and operation parameters. The core operations are described -;; at https://github.com/clojure/tools.nrepl/blob/master/doc/ops.md. CIDER adds -;; many more operations through nREPL middleware. See -;; https://github.com/clojure-emacs/cider-nrepl#supplied-nrepl-middleware for -;; the up to date list. -(defun nrepl-current-session () - "Return the current session." - (with-current-buffer (nrepl-current-connection-buffer) - nrepl-session)) - -(defun nrepl-current-tooling-session () - "Return the current tooling session." - (with-current-buffer (nrepl-current-connection-buffer) - nrepl-tooling-session)) - -(defun nrepl-next-request-id () - "Return the next request id." - (with-current-buffer (nrepl-current-connection-buffer) - (number-to-string (cl-incf nrepl-request-counter)))) - -(defun nrepl-send-request (request callback) - "Send REQUEST and register response handler CALLBACK. -REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" -\"par1\" ... ). See the code of `nrepl-request:clone', -`nrepl-request:stdin', etc." - (let* ((id (nrepl-next-request-id)) - (request (cons 'dict (lax-plist-put request "id" id))) - (message (nrepl-bencode request))) - (nrepl-log-message (cons '---> (cdr request))) - (with-current-buffer (nrepl-current-connection-buffer) - (puthash id callback nrepl-pending-requests) - (process-send-string nil message)))) - -(defun nrepl-send-sync-request (request) - "Send REQUEST to the nREPL server synchronously. -Hold till final \"done\" message has arrived and join all response messages -of the same \"op\" that came along." - (let* ((time0 (current-time)) - (response (cons 'dict nil))) - (nrepl-send-request request (lambda (resp) (nrepl--merge response resp))) - (while (not (member "done" (nrepl-dict-get response "status"))) - (accept-process-output nil 0.01) - ;; break out in case we don't receive a response for a while - (when (and nrepl-sync-request-timeout - (> (cadr (time-subtract (current-time) time0)) - nrepl-sync-request-timeout)) - (error "Sync nREPL request timed out %s" request))) - (-when-let* ((ex (nrepl-dict-get response "ex")) - (err (nrepl-dict-get response "err"))) - (cider-repl-emit-interactive-err-output err) - (message err)) - (-when-let (id (nrepl-dict-get response "id")) - ;; FIXME: This should go away eventually when we get rid of - ;; pending-request hash table - (with-current-buffer (nrepl-current-connection-buffer) - (remhash id nrepl-pending-requests))) - response)) - -(defun nrepl-request:stdin (input callback) - "Send a :stdin request with INPUT. -Register CALLBACK as the response handler." - (nrepl-send-request (list "op" "stdin" - "stdin" input - "session" (nrepl-current-session)) - callback)) - -(defun nrepl-request:interrupt (pending-request-id callback) - "Send an :interrupt request for PENDING-REQUEST-ID. -Register CALLBACK as the response handler." - (nrepl-send-request (list "op" "interrupt" - "session" (nrepl-current-session) - "interrupt-id" pending-request-id) - callback)) - -(defun nrepl--eval-request (input &optional ns session) - "Prepare :eval request message for INPUT in the context of NS ans SESSION." - (append (and ns (list "ns" ns)) - (list "op" "eval" - "session" (or session (nrepl-current-session)) - "code" input))) - -(defun nrepl-request:eval (input callback &optional ns session) - "Send the request INPUT and register the CALLBACK as the response handler. -If NS is non-nil, include it in the request. SESSION defaults to current session." - (nrepl-send-request (nrepl--eval-request input ns session) callback)) - -(defun nrepl-sync-request:clone () - "Sent a :clone request to create a new client session." - (nrepl-send-sync-request '("op" "clone"))) - -(defun nrepl-sync-request:close (session) - "Sent a :close request to close SESSION." - (nrepl-send-sync-request (list "op" "close" "session" session))) - -(defun nrepl-sync-request:describe (&optional session) - "Perform :describe request." - (if session - (nrepl-send-sync-request (list "session" session "op" "describe")) - (nrepl-send-sync-request '("op" "describe")))) - -(defun nrepl-sync-request:ls-sessions () - "Perform :ls-sessions request." - (nrepl-send-sync-request '("op" "ls-sessions"))) - -(defun nrepl-sync-request:eval (input &optional ns session) - "Send the INPUT to the nREPL server synchronously. -If NS is non-nil, include it in the request. SESSION defaults to current -session." - (nrepl-send-sync-request (nrepl--eval-request input ns session))) - -(defun nrepl-sessions () - "Get a list of active sessions for the current nREPL connections." - (nrepl-dict-get (nrepl-sync-request:ls-sessions) "sessions")) - - -;;; Server - -;; The server side process is started by `nrepl-start-server-process' and has a -;; very simple filter that pipes its output directly into its process buffer -;; (*nrepl-server*). The main purpose of this process is to start the actual -;; nrepl communication client (`nrepl-client-filter') when the message "nREPL -;; server started on port ..." is detected. - -(defun nrepl-start-server-process (directory cmd) - "Start nREPL server process in DIRECTORY using shell command CMD. -Return a newly created process." - (let* ((default-directory (or directory default-directory)) - (serv-buf (get-buffer-create (generate-new-buffer-name - (nrepl-server-buffer-name directory)))) - (serv-proc (start-file-process-shell-command - "nrepl-server" serv-buf cmd))) - (set-process-filter serv-proc 'nrepl-server-filter) - (set-process-sentinel serv-proc 'nrepl-server-sentinel) - (set-process-coding-system serv-proc 'utf-8-unix 'utf-8-unix) - (with-current-buffer serv-buf - (setq nrepl-project-dir directory)) - (message "Starting nREPL server via %s..." - (propertize cmd 'face 'font-lock-keyword-face)) - serv-proc)) - -(defun nrepl-server-filter (process output) - "Process nREPL server output from PROCESS contained in OUTPUT." - (with-current-buffer (process-buffer process) - (save-excursion - (goto-char (point-max)) - (insert output))) - (when (string-match "nREPL server started on port \\([0-9]+\\)" output) - (let ((port (string-to-number (match-string 1 output)))) - (message (format "nREPL server started on %s" port)) - (with-current-buffer (process-buffer process) - (let ((client-proc (nrepl-start-client-process nil port t process))) - ;; FIXME: Bad connection tracking system. There can be multiple client - ;; connections per server - (setq nrepl-connection-buffer (buffer-name (process-buffer client-proc)))))))) - -(defun nrepl-server-sentinel (process event) - "Handle nREPL server PROCESS EVENT." - (let* ((nrepl-buffer (process-buffer process)) - (connection-buffer (buffer-local-value 'nrepl-connection-buffer nrepl-buffer)) - (problem (if (and nrepl-buffer (buffer-live-p nrepl-buffer)) - (with-current-buffer nrepl-buffer - (buffer-substring (point-min) (point-max))) - ""))) - (when nrepl-buffer - (kill-buffer nrepl-buffer)) - (cond - ((string-match "^killed" event) - nil) - ((string-match "^hangup" event) - (when connection-buffer - (nrepl-close connection-buffer))) - ((string-match "Wrong number of arguments to repl task" problem) - (error "Leiningen 2.x is required by CIDER")) - (t (error "Could not start nREPL server: %s" problem))))) - - -;;; Messages - -(defcustom nrepl-log-messages nil - "If non-nil, log protocol messages to the `nrepl-message-buffer-name' buffer." - :type 'boolean - :group 'nrepl) - -(defconst nrepl-message-buffer-max-size 1000000 - "Maximum size for the nREPL message buffer. -Defaults to 1000000 characters, which should be an insignificant -memory burden, while providing reasonable history.") - -(defconst nrepl-message-buffer-reduce-denominator 4 - "Divisor by which to reduce message buffer size. -When the maximum size for the nREPL message buffer is exceed, the -size of the buffer is reduced by one over this value. Defaults -to 4, so that 1/4 of the buffer is removed, which should ensure -the buffer's maximum is reasonably utilised, while limiting the -number of buffer shrinking operations.") - -(defvar nrepl-messages-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "n") 'next-line) - (define-key map (kbd "p") 'previous-line) - map)) - -(define-derived-mode nrepl-messages-mode special-mode "nREPL Messages" - "Major mode for displaying nREPL messages. - -\\{nrepl-messages-mode-map}" - (setq buffer-read-only t) - (setq-local truncate-lines t) - (setq-local electric-indent-chars nil) - (setq-local comment-start ";") - (setq-local comment-end "") - (setq-local paragraph-start "(--->\\|(<-") - (setq-local paragraph-separate "(<-")) - -(defun nrepl-log-message (msg) - "Log the given MSG to the buffer given by `nrepl-message-buffer-name'." - (when nrepl-log-messages - (with-current-buffer (nrepl-messages-buffer) - (setq buffer-read-only nil) - (when (> (buffer-size) nrepl-message-buffer-max-size) - (goto-char (/ (buffer-size) nrepl-message-buffer-reduce-denominator)) - (re-search-forward "^(" nil t) - (delete-region (point-min) (- (point) 1))) - (goto-char (point-max)) - (nrepl--pp msg) - (-when-let (win (get-buffer-window)) - (set-window-point win (point-max))) - (setq buffer-read-only t)))) - -(defvar nrepl--message-colors - '("red" "brown" "coral" "orange" "green" "deep sky blue" "blue" "dark violet") - "Colors used in `nrepl-messages-buffer'.") - -(defun nrepl--pp (object) - "Pretty print nREPL OBJECT." - (if (not (and (listp object) - (memq (car object) '(<- ---> dict)))) - (progn (pp object (current-buffer)) - (unless (listp object) (insert "\n"))) - (let* ((id (lax-plist-get (cdr object) "id")) - (id (and id (mod (string-to-number id) - (length nrepl--message-colors)))) - (head (format "(%s" (car object))) - (foreground (and id (nth id nrepl--message-colors)))) - (cl-flet ((color (str) - (propertize str 'face `(:weight ultra-bold :foreground ,foreground)))) - (insert (color head)) - (let ((indent (+ 2 (- (current-column) (length head))))) - (if (null (cdr object)) - (insert ")\n") - (insert "\n") - (cl-loop for l on (cdr object) by #'cddr - do (let ((str (format "%s%s " (make-string indent ? ) (car l)))) - (insert str) - (nrepl--pp (cadr l)))) - (insert (color (format "%s)\n" (make-string (- indent 2) ? )))))))))) - -(defun nrepl-messages-buffer () - "Return or create the buffer given by `nrepl-message-buffer-name'. -The default buffer name is *nrepl-messages*." - (or (get-buffer nrepl-message-buffer-name) - (let ((buffer (get-buffer-create nrepl-message-buffer-name))) - (with-current-buffer buffer - (buffer-disable-undo) - (nrepl-messages-mode) - buffer)))) - - -;;; Connection Buffer Management - -(defvar nrepl-connection-list nil - "A list of connections.") - -(defun nrepl-current-host () - "Retrieve the current host." - (if (and (stringp buffer-file-name) - (file-remote-p buffer-file-name)) - tramp-current-host - nrepl-host)) - -(defun nrepl-create-connection-buffer (&optional project-dir host port) - "Create an nREPL connection buffer. -PROJECT-DIR, HOST and PORT are as in `nrepl-make-buffer-name'." - (let ((buffer (generate-new-buffer (nrepl-connection-buffer-name project-dir host port)))) - (with-current-buffer buffer - (buffer-disable-undo) - (setq-local kill-buffer-query-functions nil)) - buffer)) - -(defun nrepl-current-connection-buffer (&optional no-error) - "The connection to use for nREPL interaction. -When NO-ERROR is non-nil, don't throw an error when no connection has been -found." - (or nrepl-connection-buffer - (car (nrepl-connection-buffers)) - (unless no-error - (error "No nREPL connection buffer")))) - -(defun nrepl-connection-buffers () - "Return the connection list. -Purge the dead buffers from the `nrepl-connection-list' beforehand." - (setq nrepl-connection-list - (-remove (lambda (buffer) - (not (buffer-live-p (get-buffer buffer)))) - nrepl-connection-list))) - -;; FIXME: Bad user api; don't burden users with management of -;; the connection list, same holds for `cider-rotate-connection'. -(defun nrepl-make-connection-default (connection-buffer) - "Make the nREPL CONNECTION-BUFFER the default connection. -Moves CONNECITON-BUFFER to the front of `nrepl-connection-list'." - (interactive (list nrepl-connection-buffer)) - (if connection-buffer - ;; maintain the connection list in most recently used order - (let ((buf-name (buffer-name (get-buffer connection-buffer)))) - (setq nrepl-connection-list - (cons buf-name (delq buf-name nrepl-connection-list))) - (nrepl--connections-refresh)) - (message "Not in an nREPL REPL buffer."))) - -(defun nrepl--close-connection-buffer (conn-buffer) - "Closes CONN-BUFFER, removing it from `nrepl-connection-list'. -Also closes associated REPL and server buffers." - (let ((buffer (get-buffer conn-buffer))) - (setq nrepl-connection-list - (delq (buffer-name buffer) nrepl-connection-list)) - (when (buffer-live-p buffer) - (dolist (buf `(,(buffer-local-value 'nrepl-server-buffer buffer) - ,(buffer-local-value 'nrepl-tunnel-buffer buffer) - ,buffer)) - (when buf - (cider--close-buffer buf)))))) - - -;;; Connection Browser - -;; FIXME: Naming conventions are pretty messy here. Some -;; interactive commands are named with "--". nrepl--project-name` is pretty -;; often used across cider, so it's not very internal. -(defvar nrepl-connections-buffer-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "d" 'nrepl-connections-make-default) - (define-key map "g" 'nrepl-connection-browser) - (define-key map (kbd "C-k") 'nrepl-connections-close-connection) - (define-key map (kbd "RET") 'nrepl-connections-goto-connection) - map)) - -(define-derived-mode nrepl-connections-buffer-mode cider-popup-buffer-mode - "nREPL-Connections" - "nREPL Connections Buffer Mode. -\\{nrepl-connections-buffer-mode-map} -\\{cider-popup-buffer-mode-map}" - (setq-local truncate-lines t)) - -(defvar nrepl--connection-ewoc) -(defconst nrepl--connection-browser-buffer-name "*nrepl-connections*") - -(defun nrepl-connection-browser () - "Open a browser buffer for nREPL connections." - (interactive) - (let ((buffer (get-buffer nrepl--connection-browser-buffer-name))) - (if buffer - (progn - (nrepl--connections-refresh-buffer buffer) - (unless (get-buffer-window buffer) - (select-window (display-buffer buffer)))) - (nrepl--setup-connection-browser)))) - -(defun nrepl--connections-refresh () - "Refresh the connections buffer, if the buffer exists. -The connections buffer is determined by -`nrepl--connection-browser-buffer-name'" - (let ((buffer (get-buffer nrepl--connection-browser-buffer-name))) - (when buffer - (nrepl--connections-refresh-buffer buffer)))) - -(defun nrepl--connections-refresh-buffer (buffer) - "Refresh the connections BUFFER." - (nrepl--update-connections-display - (buffer-local-value 'nrepl--connection-ewoc buffer) - nrepl-connection-list)) - -(defun nrepl--setup-connection-browser () - "Create a browser buffer for nREPL connections." - (with-current-buffer (get-buffer-create nrepl--connection-browser-buffer-name) - (let ((ewoc (ewoc-create - 'nrepl--connection-pp - " Host Port Project\n"))) - (setq-local nrepl--connection-ewoc ewoc) - (nrepl--update-connections-display ewoc nrepl-connection-list) - (setq buffer-read-only t) - (nrepl-connections-buffer-mode) - (display-buffer (current-buffer))))) - -(defun nrepl--connection-pp (connection) - "Print an nREPL CONNECTION to the current buffer." - (let* ((buffer-read-only nil) - (buffer (get-buffer connection)) - (endpoint (buffer-local-value 'nrepl-endpoint buffer))) - (insert - (format "%s %-16s %5s %s" - (if (equal connection (car nrepl-connection-list)) "*" " ") - (car endpoint) - (prin1-to-string (cadr endpoint)) - (or (nrepl--project-name - (buffer-local-value 'nrepl-project-dir buffer)) - ""))))) - -(defun nrepl--project-name (stack) - "Extracts a project name from STACK, possibly nil. -The project name is the final component of STACK if not nil." - (when stack - (file-name-nondirectory (directory-file-name stack)))) - -(defun nrepl--update-connections-display (ewoc connections) - "Update the connections EWOC to show CONNECTIONS." - (ewoc-filter ewoc (lambda (n) (member n connections))) - (let ((existing)) - (ewoc-map (lambda (n) (setq existing (cons n existing))) ewoc) - (let ((added (-difference connections existing))) - (mapc (apply-partially 'ewoc-enter-last ewoc) added) - (save-excursion (ewoc-refresh ewoc))))) - -(defun nrepl--ewoc-apply-at-point (f) - "Apply function F to the ewoc node at point. -F is a function of two arguments, the ewoc and the data at point." - (let* ((ewoc nrepl--connection-ewoc) - (node (and ewoc (ewoc-locate ewoc)))) - (when node - (funcall f ewoc (ewoc-data node))))) - -(defun nrepl-connections-make-default () - "Make default the connection at point in the connection browser." - (interactive) - (save-excursion - (nrepl--ewoc-apply-at-point #'nrepl--connections-make-default))) - -(defun nrepl--connections-make-default (ewoc data) - "Make the connection in EWOC specified by DATA default. -Refreshes EWOC." - (interactive) - (nrepl-make-connection-default data) - (ewoc-refresh ewoc)) - -(defun nrepl-connections-close-connection () - "Close connection at point in the connection browser." - (interactive) - (nrepl--ewoc-apply-at-point #'nrepl--connections-close-connection)) - -(defun nrepl--connections-close-connection (ewoc data) - "Close the connection in EWOC specified by DATA." - (nrepl-close (get-buffer data)) - (nrepl--update-connections-display ewoc nrepl-connection-list)) - -(defun nrepl-connections-goto-connection () - "Goto connection at point in the connection browser." - (interactive) - (nrepl--ewoc-apply-at-point #'nrepl--connections-goto-connection)) - -(defun nrepl--connections-goto-connection (_ewoc data) - "Goto the REPL for the connection in _EWOC specified by DATA." - (let ((buffer (buffer-local-value 'nrepl-repl-buffer (get-buffer data)))) - (when buffer - (select-window (display-buffer buffer))))) - - -(define-obsolete-function-alias 'nrepl-send-request-sync 'nrepl-send-sync-request "0.8.0") -(define-obsolete-function-alias 'nrepl-send-string 'nrepl-request:eval "0.8.0") -(define-obsolete-function-alias 'nrepl-send-string-sync 'nrepl-sync-request:eval "0.8.0") -(define-obsolete-variable-alias 'nrepl-log-events 'nrepl-log-messages "0.7.0") - -(provide 'nrepl-client) - -;;; nrepl-client.el ends here diff --git a/packages/clojure-mode-4.0.1/clojure-mode-autoloads.el b/packages/clojure-mode-4.0.1/clojure-mode-autoloads.el deleted file mode 100644 index b054423..0000000 --- a/packages/clojure-mode-4.0.1/clojure-mode-autoloads.el +++ /dev/null @@ -1,33 +0,0 @@ -;;; clojure-mode-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - - -;;;### (autoloads (clojure-mode) "clojure-mode" "clojure-mode.el" -;;;;;; (21682 41267 0 0)) -;;; Generated autoloads from clojure-mode.el - -(autoload 'clojure-mode "clojure-mode" "\ -Major mode for editing Clojure code. - -\\{clojure-mode-map} - -\(fn)" t nil) - -(add-to-list 'auto-mode-alist '("\\.\\(clj[sx]?\\|dtm\\|edn\\)\\'" . clojure-mode)) - -;;;*** - -;;;### (autoloads nil nil ("clojure-mode-pkg.el") (21682 41267 73005 -;;;;;; 0)) - -;;;*** - -(provide 'clojure-mode-autoloads) -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; clojure-mode-autoloads.el ends here diff --git a/packages/clojure-mode-4.0.1/clojure-mode-pkg.el b/packages/clojure-mode-4.0.1/clojure-mode-pkg.el deleted file mode 100644 index 2c87f9f..0000000 --- a/packages/clojure-mode-4.0.1/clojure-mode-pkg.el +++ /dev/null @@ -1 +0,0 @@ -(define-package "clojure-mode" "4.0.1" "Major mode for Clojure code" (quote ((emacs "24.1")))) diff --git a/packages/clojure-mode-4.0.1/clojure-mode.el b/packages/clojure-mode-4.0.1/clojure-mode.el deleted file mode 100644 index bff903c..0000000 --- a/packages/clojure-mode-4.0.1/clojure-mode.el +++ /dev/null @@ -1,1080 +0,0 @@ -;;; clojure-mode.el --- Major mode for Clojure code -*- lexical-binding: t; -*- - -;; Copyright © 2007-2014 Jeffrey Chu, Lennart Staflin, Phil Hagelberg -;; Copyright © 2013-2014 Bozhidar Batsov -;; -;; Authors: Jeffrey Chu -;; Lennart Staflin -;; Phil Hagelberg -;; Bozhidar Batsov -;; URL: http://github.com/clojure-emacs/clojure-mode -;; Keywords: languages clojure clojurescript lisp -;; Version: 4.0.1 -;; X-Original-Version: 4.0.1 -;; Package-Requires: ((emacs "24.1")) - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides font-lock, indentation, and navigation for the Clojure -;; programming language (http://clojure.org). - -;; Using clojure-mode with paredit or smartparens is highly recommended. - -;; Here are some example configurations: - -;; ;; require or autoload paredit-mode -;; (add-hook 'clojure-mode-hook 'paredit-mode) - -;; ;; require or autoload smartparens -;; (add-hook 'clojure-mode-hook 'smartparens-strict-mode) - -;; See inf-clojure (http://github.com/clojure-emacs/inf-clojure) for -;; basic interaction with Clojure subprocesses. - -;; See CIDER (http://github.com/clojure-emacs/cider) for -;; better interaction with subprocesses via nREPL. - -;;; License: - -;; 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 GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Code: - - -;;; Compatibility -(eval-and-compile - ;; `setq-local' for Emacs 24.2 and below - (unless (fboundp 'setq-local) - (defmacro setq-local (var val) - "Set variable VAR to value VAL in current buffer." - `(set (make-local-variable ',var) ,val)))) - -(eval-when-compile - (defvar calculate-lisp-indent-last-sexp) - (defvar font-lock-beg) - (defvar font-lock-end) - (defvar paredit-space-for-delimiter-predicates) - (defvar paredit-version) - (defvar paredit-mode)) - -(require 'cl) -(require 'imenu) - -(declare-function lisp-fill-paragraph "lisp-mode" (&optional justify)) - -(defgroup clojure nil - "Major mode for editing Clojure code." - :prefix "clojure-" - :group 'languages - :link '(url-link :tag "Github" "https://github.com/clojure-emacs/clojure-mode") - :link '(emacs-commentary-link :tag "Commentary" "clojure-mode")) - -(defconst clojure-mode-version "4.0.1" - "The current version of `clojure-mode'.") - -(defface clojure-keyword-face - '((t (:inherit font-lock-constant-face))) - "Face used to font-lock Clojure keywords (:something)." - :group 'clojure - :package-version '(clojure-mode . "3.0.0")) - -(defface clojure-character-face - '((t (:inherit font-lock-string-face))) - "Face used to font-lock Clojure character literals." - :group 'clojure - :package-version '(clojure-mode . "3.0.0")) - -(defface clojure-interop-method-face - '((t (:inherit font-lock-preprocessor-face))) - "Face used to font-lock interop method names (camelCase)." - :group 'clojure - :package-version '(clojure-mode . "3.0.0")) - -(defcustom clojure-defun-style-default-indent nil - "When non-nil, use default indenting for functions and macros. -Otherwise check `define-clojure-indent' and `put-clojure-indent'." - :type 'boolean - :group 'clojure - :safe 'booleanp) - -(defcustom clojure-use-backtracking-indent t - "When non-nil, enable context sensitive indentation." - :type 'boolean - :group 'clojure - :safe 'booleanp) - -(defcustom clojure-max-backtracking 3 - "Maximum amount to backtrack up a list to check for context." - :type 'integer - :group 'clojure - :safe 'integerp) - -(defcustom clojure-docstring-fill-column fill-column - "Value of `fill-column' to use when filling a docstring." - :type 'integer - :group 'clojure - :safe 'integerp) - -(defcustom clojure-docstring-fill-prefix-width 2 - "Width of `fill-prefix' when filling a docstring. -The default value conforms with the de facto convention for -Clojure docstrings, aligning the second line with the opening -double quotes on the third column." - :type 'integer - :group 'clojure - :safe 'integerp) - -(defcustom clojure-omit-space-between-tag-and-delimiters '(?\[ ?\{) - "Allowed opening delimiter characters after a reader literal tag. -For example, \[ is allowed in :db/id[:db.part/user]." - :type '(set (const :tag "[" ?\[) - (const :tag "{" ?\{) - (const :tag "(" ?\() - (const :tag "\"" ?\")) - :group 'clojure - :safe (lambda (value) - (and (listp value) - (every 'characterp value)))) - -(defvar clojure-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-:") 'clojure-toggle-keyword-string) - (easy-menu-define clojure-mode-menu map "Clojure Mode Menu" - '("Clojure" - ["Toggle between string & keyword" clojure-toggle-keyword-string] - ["Mark string" clojure-mark-string] - ["Insert ns form at point" clojure-insert-ns-form-at-point] - ["Insert ns form at beginning" clojure-insert-ns-form] - ["Update ns form" clojure-update-ns] - "--" - ["Version" clojure-mode-display-version])) - map) - "Keymap for Clojure mode. Inherits from `lisp-mode-shared-map'.") - -(defvar clojure-mode-syntax-table - (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) - (modify-syntax-entry ?~ "' " table) - (modify-syntax-entry ?\{ "(}" table) - (modify-syntax-entry ?\} "){" table) - (modify-syntax-entry ?\[ "(]" table) - (modify-syntax-entry ?\] ")[" table) - (modify-syntax-entry ?^ "'" table) - (modify-syntax-entry ?@ "'" table) - ;; Make hash a usual word character - (modify-syntax-entry ?# "_ p" table) - table)) - -(defconst clojure--prettify-symbols-alist - '(("fn" . ?λ))) - -(defun clojure-mode-display-version () - "Display the current `clojure-mode-version' in the minibuffer." - (interactive) - (message "clojure-mode (version %s)" clojure-mode-version)) - -(defun clojure-space-for-delimiter-p (endp delim) - "Prevent paredit from inserting useless spaces. -See `paredit-space-for-delimiter-predicates' for the meaning of -ENDP and DELIM." - (if (or (derived-mode-p 'clojure-mode) - (derived-mode-p 'cider-repl-mode)) - (save-excursion - (backward-char) - (if (and (or (char-equal delim ?\() - (char-equal delim ?\") - (char-equal delim ?{)) - (not endp)) - (if (char-equal (char-after) ?#) - (and (not (bobp)) - (or (char-equal ?w (char-syntax (char-before))) - (char-equal ?_ (char-syntax (char-before))))) - t) - t)) - t)) - -(defun clojure-no-space-after-tag (endp delimiter) - "Prevent inserting a space after a reader-literal tag? - -When a reader-literal tag is followed be an opening delimiter -listed in `clojure-omit-space-between-tag-and-delimiters', this -function returns t. - -This allows you to write things like #db/id[:db.part/user] -without inserting a space between the tag and the opening -bracket. - -See `paredit-space-for-delimiter-predicates' for the meaning of -ENDP and DELIMITER." - (if endp - t - (or (not (member delimiter clojure-omit-space-between-tag-and-delimiters)) - (save-excursion - (let ((orig-point (point))) - (not (and (re-search-backward - "#\\([a-zA-Z0-9._-]+/\\)?[a-zA-Z0-9._-]+" - (line-beginning-position) - t) - (= orig-point (match-end 0))))))))) - -(defun clojure-paredit-setup () - "Make \"paredit-mode\" play nice with `clojure-mode'." - (when (>= paredit-version 21) - (define-key clojure-mode-map "{" 'paredit-open-curly) - (define-key clojure-mode-map "}" 'paredit-close-curly) - (add-to-list 'paredit-space-for-delimiter-predicates - 'clojure-space-for-delimiter-p) - (add-to-list 'paredit-space-for-delimiter-predicates - 'clojure-no-space-after-tag))) - -(defun clojure-mode-variables () - "Set up initial buffer-local variables for Clojure mode." - (setq-local imenu-create-index-function - (lambda () - (imenu--generic-function '((nil clojure-match-next-def 0))))) - (setq-local indent-tabs-mode nil) - (lisp-mode-variables nil) - (setq fill-paragraph-function 'clojure-fill-paragraph) - (setq adaptive-fill-function 'clojure-adaptive-fill-function) - (setq-local normal-auto-fill-function 'clojure-auto-fill-function) - (setq-local comment-start-skip - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") - (setq-local indent-line-function 'clojure-indent-line) - (setq-local lisp-indent-function 'clojure-indent-function) - (setq-local lisp-doc-string-elt-property 'clojure-doc-string-elt) - (setq-local parse-sexp-ignore-comments t) - (setq-local prettify-symbols-alist clojure--prettify-symbols-alist) - (setq-local open-paren-in-column-0-is-defun-start nil)) - -;;;###autoload -(define-derived-mode clojure-mode prog-mode "Clojure" - "Major mode for editing Clojure code. - -\\{clojure-mode-map}" - (clojure-mode-variables) - (clojure-font-lock-setup) - (add-hook 'paredit-mode-hook 'clojure-paredit-setup)) - -(defsubst clojure-in-docstring-p () - "Check whether point is in a docstring." - (eq (get-text-property (1- (point-at-eol)) 'face) - 'font-lock-doc-face)) - -(defsubst clojure-docstring-fill-prefix () - "The prefix string used by `clojure-fill-paragraph'. - -It is simply `clojure-docstring-fill-prefix-width' number of spaces." - (make-string clojure-docstring-fill-prefix-width ? )) - -(defun clojure-adaptive-fill-function () - "Clojure adaptive fill function. -This only takes care of filling docstring correctly." - (when (clojure-in-docstring-p) - (clojure-docstring-fill-prefix))) - -(defun clojure-fill-paragraph (&optional justify) - "Like `fill-paragraph', but can handle Clojure docstrings. - -If JUSTIFY is non-nil, justify as well as fill the paragraph." - (if (clojure-in-docstring-p) - (let ((paragraph-start - (concat paragraph-start - "\\|\\s-*\\([(;:\"[]\\|~@\\|`(\\|#'(\\)")) - (paragraph-separate - (concat paragraph-separate "\\|\\s-*\".*[,\\.]$")) - (fill-column (or clojure-docstring-fill-column fill-column)) - (fill-prefix (clojure-docstring-fill-prefix))) - (fill-paragraph justify)) - (let ((paragraph-start (concat paragraph-start - "\\|\\s-*\\([(;:\"[]\\|`(\\|#'(\\)")) - (paragraph-separate - (concat paragraph-separate "\\|\\s-*\".*[,\\.[]$"))) - (or (fill-comment-paragraph justify) - (fill-paragraph justify)) - ;; Always return `t' - t))) - -(defun clojure-auto-fill-function () - "Clojure auto-fill function." - ;; Check if auto-filling is meaningful. - (let ((fc (current-fill-column))) - (when (and fc (> (current-column) fc)) - (let ((fill-column (if (clojure-in-docstring-p) - clojure-docstring-fill-column - fill-column)) - (fill-prefix (clojure-adaptive-fill-function))) - (do-auto-fill))))) - - - -(defun clojure-match-next-def () - "Scans the buffer backwards for the next \"top-level\" definition. -Called by `imenu--generic-function'." - (when (re-search-backward "^(def\\sw*" nil t) - (save-excursion - (let (found? - (start (point))) - (down-list) - (forward-sexp) - (while (not found?) - (forward-sexp) - (or (if (char-equal ?[ (char-after (point))) - (backward-sexp)) - (if (char-equal ?) (char-after (point))) - (backward-sexp))) - (destructuring-bind (def-beg . def-end) (bounds-of-thing-at-point 'sexp) - (if (char-equal ?^ (char-after def-beg)) - (progn (forward-sexp) (backward-sexp)) - (setq found? t) - (set-match-data (list def-beg def-end))))) - (goto-char start))))) - -(defconst clojure-font-lock-keywords - (eval-when-compile - `(;; Top-level variable definition - (,(concat "(\\(?:clojure.core/\\)?\\(" - (regexp-opt '("def" "defonce")) - ;; variable declarations - "\\)\\>" - ;; Any whitespace - "[ \r\n\t]*" - ;; Possibly type or metadata - "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" - "\\(\\sw+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-variable-name-face nil t)) - ;; Type definition - (,(concat "(\\(?:clojure.core/\\)?\\(" - (regexp-opt '("defstruct" "deftype" "defprotocol" - "defrecord")) - ;; type declarations - "\\)\\>" - ;; Any whitespace - "[ \r\n\t]*" - ;; Possibly type or metadata - "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" - "\\(\\sw+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-type-face nil t)) - ;; Function definition (anything that starts with def and is not - ;; listed above) - (,(concat "(\\(?:[a-z\.-]+/\\)?\\(def\[a-z\-\]*-?\\)" - ;; Function declarations - "\\>" - ;; Any whitespace - "[ \r\n\t]*" - ;; Possibly type or metadata - "\\(?:#?^\\(?:{[^}]*}\\|\\sw+\\)[ \r\n\t]*\\)*" - "\\(\\sw+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-function-name-face nil t)) - ;; (fn name? args ...) - (,(concat "(\\(?:clojure.core/\\)?\\(fn\\)[ \t]+" - ;; Possibly type - "\\(?:#?^\\sw+[ \t]*\\)?" - ;; Possibly name - "\\(t\\sw+\\)?" ) - (1 font-lock-keyword-face) - (2 font-lock-function-name-face nil t)) - ;; lambda arguments - %, %1, %2, etc - ("\\<%[1-9]?" (0 font-lock-variable-name-face)) - ;; Special forms - (,(concat - "(" - (regexp-opt - '("def" "do" "if" "let" "var" "fn" "loop" - "recur" "throw" "try" "catch" "finally" - "set!" "new" "." - "monitor-enter" "monitor-exit" "quote") t) - "\\>") - 1 font-lock-keyword-face) - ;; Built-in binding and flow of control forms - (,(concat - "(\\(?:clojure.core/\\)?" - (regexp-opt - '("letfn" "case" "cond" "cond->" "cond->>" "condp" - "for" "when" "when-not" "when-let" "when-first" "when-some" - "if-let" "if-not" "if-some" - ".." "->" "->>" "as->" "doto" "and" "or" - "dosync" "doseq" "dotimes" "dorun" "doall" - "load" "import" "unimport" "ns" "in-ns" "refer" - "with-open" "with-local-vars" "binding" - "gen-class" "gen-and-load-class" "gen-and-save-class" - "handler-case" "handle" "declare") t) - "\\>") - 1 font-lock-keyword-face) - (,(concat - "\\<" - (regexp-opt - '("*1" "*2" "*3" "*agent*" - "*allow-unresolved-vars*" "*assert*" "*clojure-version*" - "*command-line-args*" "*compile-files*" - "*compile-path*" "*e" "*err*" "*file*" "*flush-on-newline*" - "*in*" "*macro-meta*" "*math-context*" "*ns*" "*out*" - "*print-dup*" "*print-length*" "*print-level*" - "*print-meta*" "*print-readably*" - "*read-eval*" "*source-path*" - "*use-context-classloader*" "*warn-on-reflection*") - t) - "\\>") - 0 font-lock-builtin-face) - ;; Dynamic variables - *something* or @*something* - ("\\<@?\\(\\*[a-z-]*\\*\\)\\>" 1 font-lock-variable-name-face) - ;; Global constants - nil, true, false - (,(concat - "\\<" - (regexp-opt - '("true" "false" "nil") t) - "\\>") - 0 font-lock-constant-face) - ;; Character literals - \1, \a, \newline, \u0000 - ;; FIXME: handle properly some punctuation characters (like commas and semicolumns) - ("\\\\\\([[:punct:]]\\|[a-z0-9]+\\)\\>" 0 'clojure-character-face) - ;; Constant values (keywords), including as metadata e.g. ^:static - ("\\<^?\\(:\\(\\sw\\|\\s_\\)+\\(\\>\\|\\_>\\)\\)" 1 'clojure-keyword-face) - ;; cljx annotations (#+clj and #+cljs) - ("#\\+cljs?\\>" 0 font-lock-preprocessor-face) - ;; Java interop highlighting - ;; CONST SOME_CONST (optionally prefixed by /) - ("\\(?:\\<\\|/\\)\\([A-Z]+\\|\\([A-Z]+_[A-Z1-9_]+\\)\\)\\>" 1 font-lock-constant-face) - ;; .foo .barBaz .qux01 .-flibble .-flibbleWobble - ("\\<\\.-?[a-z][a-zA-Z0-9]*\\>" 0 'clojure-interop-method-face) - ;; Foo Bar$Baz Qux_ World_OpenUDP Foo. Babylon15. - ("\\(?:\\<\\|\\.\\|/\\|#?^\\)\\([A-Z][a-zA-Z0-9_]*[a-zA-Z0-9$_]+\\.?\\>\\)" 1 font-lock-type-face) - ;; foo.bar.baz - ("\\<^?\\([a-z][a-z0-9_-]+\\.\\([a-z][a-z0-9_-]*\\.?\\)+\\)" 1 font-lock-type-face) - ;; (ns namespace) - special handling for single segment namespaces - (,(concat "(\\[ \r\n\t]*" - ;; Possibly metadata - "\\(?:\\^?{[^}]+}[ \r\n\t]*\\)*" - ;; namespace - "\\([a-z0-9-]+\\)") - (1 font-lock-type-face nil t)) - ;; foo/ Foo/ @Foo/ /FooBar - ("\\(?:\\<\\|\\.\\)@?\\([a-zA-Z][a-zA-Z0-9$_-]*\\)/" 1 font-lock-type-face) - ;; fooBar - ("\\(?:\\<\\|/\\)\\([a-z]+[A-Z]+[a-zA-Z0-9$]*\\>\\)" 1 'clojure-interop-method-face) - ;; Highlight grouping constructs in regular expressions - (clojure-font-lock-regexp-groups - (1 'font-lock-regexp-grouping-construct prepend)))) - "Default expressions to highlight in Clojure mode.") - -(defun clojure-font-lock-syntactic-face-function (state) - "Find and highlight text with a Clojure-friendly syntax table. - -This function is passed to `font-lock-syntactic-face-function', -which is called with a single parameter, STATE (which is, in -turn, returned by `parse-partial-sexp' at the beginning of the -highlighted region)." - (if (nth 3 state) - ;; This might be a (doc)string or a |...| symbol. - (let ((startpos (nth 8 state))) - (if (eq (char-after startpos) ?|) - ;; This is not a string, but a |...| symbol. - nil - (let* ((listbeg (nth 1 state)) - (firstsym (and listbeg - (save-excursion - (goto-char listbeg) - (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") - (match-string 1))))) - (docelt (and firstsym - (function-get (intern-soft firstsym) - lisp-doc-string-elt-property)))) - (if (and docelt - ;; It's a string in a form that can have a docstring. - ;; Check whether it's in docstring position. - (save-excursion - (when (functionp docelt) - (goto-char (match-end 1)) - (setq docelt (funcall docelt))) - (goto-char listbeg) - (forward-char 1) - (condition-case nil - (while (and (> docelt 0) (< (point) startpos) - (progn (forward-sexp 1) t)) - ;; ignore metadata and type hints - (unless (looking-at "[ \n\t]*\\(\\^[A-Z:].+\\|\\^?{.+\\)") - (setq docelt (1- docelt)))) - (error nil)) - (and (zerop docelt) (<= (point) startpos) - (progn (forward-comment (point-max)) t) - (= (point) (nth 8 state))))) - font-lock-doc-face - font-lock-string-face)))) - font-lock-comment-face)) - -(defun clojure-font-lock-setup () - "Configures font-lock for editing Clojure code." - (setq-local font-lock-multiline t) - (add-to-list 'font-lock-extend-region-functions - 'clojure-font-lock-extend-region-def t) - (setq font-lock-defaults - '(clojure-font-lock-keywords ; keywords - nil nil - (("+-*/.<>=!?$%_&~^:@" . "w")) ; syntax alist - nil - (font-lock-mark-block-function . mark-defun) - (font-lock-syntactic-face-function - . clojure-font-lock-syntactic-face-function)))) - -(defun clojure-font-lock-def-at-point (point) - "Range between the top-most def* and the fourth element after POINT. -Note that this means that there is no guarantee of proper font -locking in def* forms that are not at top level." - (goto-char point) - (condition-case nil - (beginning-of-defun) - (error nil)) - - (let ((beg-def (point))) - (when (and (not (= point beg-def)) - (looking-at "(def")) - (condition-case nil - (progn - ;; move forward as much as possible until failure (or success) - (forward-char) - (dotimes (_ 4) - (forward-sexp))) - (error nil)) - (cons beg-def (point))))) - -(defun clojure-font-lock-extend-region-def () - "Set region boundaries to include the first four elements of def* forms." - (let ((changed nil)) - (let ((def (clojure-font-lock-def-at-point font-lock-beg))) - (when def - (destructuring-bind (def-beg . def-end) def - (when (and (< def-beg font-lock-beg) - (< font-lock-beg def-end)) - (setq font-lock-beg def-beg - changed t))))) - (let ((def (clojure-font-lock-def-at-point font-lock-end))) - (when def - (destructuring-bind (def-beg . def-end) def - (when (and (< def-beg font-lock-end) - (< font-lock-end def-end)) - (setq font-lock-end def-end - changed t))))) - changed)) - -(defun clojure-font-lock-regexp-groups (bound) - "Highlight grouping constructs in regular expression. - -BOUND denotes the maximum number of characters (relative to the -point) to check." - (catch 'found - (while (re-search-forward (concat - ;; A group may start using several alternatives: - "\\(\\(?:" - ;; 1. (? special groups - "(\\?\\(?:" - ;; a) non-capturing group (?:X) - ;; b) independent non-capturing group (?>X) - ;; c) zero-width positive lookahead (?=X) - ;; d) zero-width negative lookahead (?!X) - "[:=!>]\\|" - ;; e) zero-width positive lookbehind (?<=X) - ;; f) zero-width negative lookbehind (?X) - "<[[:alnum:]]+>" - "\\)\\|" ;; end of special groups - ;; 2. normal capturing groups ( - ;; 3. we also highlight alternative - ;; separarators |, and closing parens ) - "[|()]" - "\\)\\)") - bound t) - (let ((face (get-text-property (1- (point)) 'face))) - (when (and (or (and (listp face) - (memq 'font-lock-string-face face)) - (eq 'font-lock-string-face face)) - (clojure-string-start t)) - (throw 'found t)))))) - -;; Docstring positions -(put 'ns 'clojure-doc-string-elt 2) -(put 'def 'clojure-doc-string-elt 2) -(put 'defn 'clojure-doc-string-elt 2) -(put 'defn- 'clojure-doc-string-elt 2) -(put 'defmulti 'clojure-doc-string-elt 2) -(put 'defmacro 'clojure-doc-string-elt 2) -(put 'definline 'clojure-doc-string-elt 2) -(put 'defprotocol 'clojure-doc-string-elt 2) - - - -(defun clojure-indent-line () - "Indent current line as Clojure code." - (if (clojure-in-docstring-p) - (save-excursion - (beginning-of-line) - (when (looking-at "^\\s-*") - (replace-match (clojure-docstring-fill-prefix)))) - (lisp-indent-line))) - -(defun clojure-indent-function (indent-point state) - "When indenting a line within a function call, indent properly. - -INDENT-POINT is the position where the user typed TAB, or equivalent. -Point is located at the point to indent under (for default indentation); -STATE is the `parse-partial-sexp' state for that position. - -If the current line is in a call to a Clojure function with a -non-nil property `clojure-indent-function', that specifies how to do -the indentation. - -The property value can be - -- `defun', meaning indent `defun'-style; -- an integer N, meaning indent the first N arguments specially - like ordinary function arguments and then indent any further - arguments like a body; -- a function to call just as this function was called. - If that function returns nil, that means it doesn't specify - the indentation. - -This function also returns nil meaning don't specify the indentation." - (let ((normal-indent (current-column))) - (goto-char (1+ (elt state 1))) - (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t) - (if (and (elt state 2) - (not (looking-at "\\sw\\|\\s_"))) - ;; car of form doesn't seem to be a symbol - (progn - (if (not (> (save-excursion (forward-line 1) (point)) - calculate-lisp-indent-last-sexp)) - (progn (goto-char calculate-lisp-indent-last-sexp) - (beginning-of-line) - (parse-partial-sexp (point) - calculate-lisp-indent-last-sexp 0 t))) - ;; Indent under the list or under the first sexp on the same - ;; line as calculate-lisp-indent-last-sexp. Note that first - ;; thing on that line has to be complete sexp since we are - ;; inside the innermost containing sexp. - (backward-prefix-chars) - (current-column)) - (let* ((function (buffer-substring (point) - (progn (forward-sexp 1) (point)))) - (open-paren (elt state 1)) - (method nil) - (function-tail (first - (last - (split-string (substring-no-properties function) "/"))))) - (setq method (get (intern-soft function-tail) 'clojure-indent-function)) - (cond ((member (char-after open-paren) '(?\[ ?\{)) - (goto-char open-paren) - (1+ (current-column))) - ((or (eq method 'defun) - (and clojure-defun-style-default-indent - ;; largely to preserve useful alignment of :require, etc in ns - (not (string-match "^:" function)) - (not method)) - (and (null method) - (> (length function) 3) - (string-match "\\`\\(?:\\S +/\\)?\\(def\\|with-\\)" - function))) - (lisp-indent-defform state indent-point)) - ((integerp method) - (lisp-indent-specform method state - indent-point normal-indent)) - (method - (funcall method indent-point state)) - (clojure-use-backtracking-indent - (clojure-backtracking-indent - indent-point state normal-indent))))))) - -(defun clojure-backtracking-indent (indent-point state normal-indent) - "Experimental backtracking support. - -Given an INDENT-POINT, the STATE, and the NORMAL-INDENT, will -move upwards in an sexp to check for contextual indenting." - (let (indent (path) (depth 0)) - (goto-char (elt state 1)) - (while (and (not indent) - (< depth clojure-max-backtracking)) - (let ((containing-sexp (point))) - (parse-partial-sexp (1+ containing-sexp) indent-point 1 t) - (when (looking-at "\\sw\\|\\s_") - (let* ((start (point)) - (fn (buffer-substring start (progn (forward-sexp 1) (point)))) - (meth (get (intern-soft fn) 'clojure-backtracking-indent))) - (let ((n 0)) - (when (< (point) indent-point) - (condition-case () - (progn - (forward-sexp 1) - (while (< (point) indent-point) - (parse-partial-sexp (point) indent-point 1 t) - (incf n) - (forward-sexp 1))) - (error nil))) - (push n path)) - (when meth - (let ((def meth)) - (dolist (p path) - (if (and (listp def) - (< p (length def))) - (setq def (nth p def)) - (if (listp def) - (setq def (car (last def))) - (setq def nil)))) - (goto-char (elt state 1)) - (when def - (setq indent (+ (current-column) def))))))) - (goto-char containing-sexp) - (condition-case () - (progn - (backward-up-list 1) - (incf depth)) - (error (setq depth clojure-max-backtracking))))) - indent)) - -;; clojure backtracking indent is experimental and the format for these -;; entries are subject to change -(put 'implement 'clojure-backtracking-indent '(4 (2))) -(put 'letfn 'clojure-backtracking-indent '((2) 2)) -(put 'proxy 'clojure-backtracking-indent '(4 4 (2))) -(put 'reify 'clojure-backtracking-indent '((2))) -(put 'deftype 'clojure-backtracking-indent '(4 4 (2))) -(put 'defrecord 'clojure-backtracking-indent '(4 4 (2))) -(put 'defprotocol 'clojure-backtracking-indent '(4 (2))) -(put 'extend-type 'clojure-backtracking-indent '(4 (2))) -(put 'extend-protocol 'clojure-backtracking-indent '(4 (2))) -(put 'specify 'clojure-backtracking-indent '(4 (2))) -(put 'specify! 'clojure-backtracking-indent '(4 (2))) - -(defun put-clojure-indent (sym indent) - "Instruct `clojure-indent-function' to indent the body of SYM by INDENT." - (put sym 'clojure-indent-function indent)) - -(defmacro define-clojure-indent (&rest kvs) - "Call `put-clojure-indent' on a series, KVS." - `(progn - ,@(mapcar (lambda (x) `(put-clojure-indent - (quote ,(first x)) ,(second x))) - kvs))) - -(defun add-custom-clojure-indents (name value) - "Allow `clojure-defun-indents' to indent user-specified macros. - -Requires the macro's NAME and a VALUE." - (custom-set-default name value) - (mapcar (lambda (x) - (put-clojure-indent x 'defun)) - value)) - -(defcustom clojure-defun-indents nil - "List of additional symbols with defun-style indentation in Clojure. - -You can use this to let Emacs indent your own macros the same way -that it indents built-in macros like with-open. To manually set -it from Lisp code, use (put-clojure-indent 'some-symbol 'defun)." - :type '(repeat symbol) - :group 'clojure - :set 'add-custom-clojure-indents) - -(define-clojure-indent - ;; built-ins - (ns 1) - (fn 'defun) - (def 'defun) - (defn 'defun) - (bound-fn 'defun) - (if 1) - (if-not 1) - (case 1) - (cond 0) - (condp 2) - (cond-> 1) - (cond->> 1) - (when 1) - (while 1) - (when-not 1) - (when-first 1) - (do 0) - (future 0) - (comment 0) - (doto 1) - (locking 1) - (proxy 2) - (as-> 2) - (with-open 1) - (with-precision 1) - (with-local-vars 1) - - (reify 'defun) - (deftype 2) - (defrecord 2) - (defprotocol 1) - (extend 1) - (extend-protocol 1) - (extend-type 1) - - (try 0) - (catch 2) - (finally 0) - - ;; binding forms - (let 1) - (letfn 1) - (binding 1) - (loop 1) - (for 1) - (doseq 1) - (dotimes 1) - (when-let 1) - (if-let 1) - (when-some 1) - (if-some 1) - - (defmethod 'defun) - - ;; clojure.test - (testing 1) - (deftest 'defun) - (are 1) - (use-fixtures 'defun) - - ;; core.logic - (run 'defun) - (run* 'defun) - (fresh 'defun) - - ;; core.async - (alt! 0) - (alt!! 0) - (go 0) - (go-loop 1) - (thread 0)) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Better docstring filling for clojure-mode -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun clojure-string-start (&optional regex) - "Return the position of the \" that begins the string at point. -If REGEX is non-nil, return the position of the # that begins the -regex at point. If point is not inside a string or regex, return -nil." - (when (nth 3 (syntax-ppss)) ;; Are we really in a string? - (save-excursion - (save-match-data - ;; Find a quote that appears immediately after whitespace, - ;; beginning of line, hash, or an open paren, brace, or bracket - (re-search-backward "\\(\\s-\\|^\\|#\\|(\\|\\[\\|{\\)\\(\"\\)") - (let ((beg (match-beginning 2))) - (when beg - (if regex - (and (char-before beg) (char-equal ?# (char-before beg)) (1- beg)) - (when (not (char-equal ?# (char-before beg))) - beg)))))))) - -(defun clojure-char-at-point () - "Return the char at point or nil if at buffer end." - (when (not (= (point) (point-max))) - (buffer-substring-no-properties (point) (1+ (point))))) - -(defun clojure-char-before-point () - "Return the char before point or nil if at buffer beginning." - (when (not (= (point) (point-min))) - (buffer-substring-no-properties (point) (1- (point))))) - -;; TODO: Deal with the fact that when point is exactly at the -;; beginning of a string, it thinks that is the end. -(defun clojure-string-end () - "Return the position of the \" that ends the string at point. - -Note that point must be inside the string - if point is -positioned at the opening quote, incorrect results will be -returned." - (save-excursion - (save-match-data - ;; If we're at the end of the string, just return point. - (if (and (string= (clojure-char-at-point) "\"") - (not (string= (clojure-char-before-point) "\\"))) - (point) - ;; We don't want to get screwed by starting out at the - ;; backslash in an escaped quote. - (when (string= (clojure-char-at-point) "\\") - (backward-char)) - ;; Look for a quote not preceeded by a backslash - (re-search-forward "[^\\]\\\(\\\"\\)") - (match-beginning 1))))) - -(defun clojure-mark-string () - "Mark the string at point." - (interactive) - (goto-char (clojure-string-start)) - (forward-char) - (set-mark (clojure-string-end))) - -(defun clojure-toggle-keyword-string () - "Convert the string or keyword at point to keyword or string." - (interactive) - (let ((original-point (point))) - (while (and (> (point) 1) - (not (equal "\"" (buffer-substring-no-properties (point) (+ 1 (point))))) - (not (equal ":" (buffer-substring-no-properties (point) (+ 1 (point)))))) - (backward-char)) - (cond - ((equal 1 (point)) - (error "Beginning of file reached, this was probably a mistake")) - ((equal "\"" (buffer-substring-no-properties (point) (+ 1 (point)))) - (insert ":" (substring (clojure-delete-and-extract-sexp) 1 -1))) - ((equal ":" (buffer-substring-no-properties (point) (+ 1 (point)))) - (insert "\"" (substring (clojure-delete-and-extract-sexp) 1) "\""))) - (goto-char original-point))) - -(defun clojure-delete-and-extract-sexp () - "Delete the sexp and return it." - (interactive) - (let ((begin (point))) - (forward-sexp) - (let ((result (buffer-substring-no-properties begin (point)))) - (delete-region begin (point)) - result))) - - - -(defconst clojure-namespace-name-regex - (rx line-start - (zero-or-more whitespace) - "(" - (zero-or-one (group (regexp "clojure.core/"))) - (zero-or-one (submatch "in-")) - "ns" - (zero-or-one "+") - (one-or-more (any whitespace "\n")) - (zero-or-more (or (submatch (zero-or-one "#") - "^{" - (zero-or-more (not (any "}"))) - "}") - (zero-or-more "^:" - (one-or-more (not (any whitespace))))) - (one-or-more (any whitespace "\n"))) - ;; why is this here? oh (in-ns 'foo) or (ns+ :user) - (zero-or-one (any ":'")) - (group (one-or-more (not (any "()\"" whitespace))) word-end))) - -;; for testing clojure-namespace-name-regex, you can evaluate this code and make -;; sure foo (or whatever the namespace name is) shows up in results. some of -;; these currently fail. -;; (mapcar (lambda (s) (let ((n (string-match clojure-namespace-name-regex s))) -;; (if n (match-string 4 s)))) -;; '("(ns foo)" -;; "(ns -;; foo)" -;; "(ns foo.baz)" -;; "(ns ^:bar foo)" -;; "(ns ^:bar ^:baz foo)" -;; "(ns ^{:bar true} foo)" -;; "(ns #^{:bar true} foo)" -;; "(ns #^{:fail {}} foo)" -;; "(ns ^{:fail2 {}} foo.baz)" -;; "(ns ^{} foo)" -;; "(ns ^{:skip-wiki true} -;; aleph.netty -;; " -;; "(ns -;; foo)" -;; "foo")) - - - -(defun clojure-expected-ns () - "Return the namespace name that the file should have." - (let* ((project-dir (file-truename - (locate-dominating-file default-directory - "project.clj"))) - (relative (substring (file-truename (buffer-file-name)) - (length project-dir) - (- (length (file-name-extension (buffer-file-name) t)))))) - (replace-regexp-in-string - "_" "-" (mapconcat 'identity (cdr (split-string relative "/")) ".")))) - -(defun clojure-insert-ns-form-at-point () - "Insert a namespace form at point." - (interactive) - (insert (format "(ns %s)" (clojure-expected-ns)))) - -(defun clojure-insert-ns-form () - "Insert a namespace form at the beginning of the buffer." - (interactive) - (widen) - (goto-char (point-min)) - (clojure-insert-ns-form-at-point)) - -(defun clojure-update-ns () - "Update the namespace of the current buffer. -Useful if a file has been renamed." - (interactive) - (let ((nsname (clojure-expected-ns))) - (when nsname - (save-excursion - (save-match-data - (if (clojure-find-ns) - (replace-match nsname nil nil nil 4) - (error "Namespace not found"))))))) - -(defun clojure-find-ns () - "Find the namespace of the current Clojure buffer." - (let ((regexp clojure-namespace-name-regex)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (when (re-search-forward regexp nil t) - (match-string-no-properties 4)))))) - -(defun clojure-find-def () - "Find the var declaration macro and symbol name of the current form. -Returns a list pair, e.g. (\"defn\" \"abc\") or (\"deftest\" \"some-test\")." - (let ((re (concat "(\\(?:\\(?:\\sw\\|\\s_\\)+/\\)?" - ;; Declaration - "\\(def\\sw*\\)\\>" - ;; Any whitespace - "[ \r\n\t]*" - ;; Possibly type or metadata - "\\(?:#?^\\(?:{[^}]*}\\|\\(?:\\sw\\|\\s_\\)+\\)[ \r\n\t]*\\)*" - ;; Symbol name - "\\(\\(?:\\sw\\|\\s_\\)+\\)"))) - (save-excursion - (unless (looking-at re) - (beginning-of-defun)) - (when (search-forward-regexp re nil t) - (list (match-string 1) - (match-string 2)))))) - -;;;###autoload -(add-to-list 'auto-mode-alist - '("\\.\\(clj[sx]?\\|dtm\\|edn\\)\\'" . clojure-mode)) - -(provide 'clojure-mode) - -;; Local Variables: -;; coding: utf-8 -;; byte-compile-warnings: (not cl-functions) -;; indent-tabs-mode: nil -;; End: - -;;; clojure-mode.el ends here diff --git a/packages/company-0.8.7/.dir-locals.el b/packages/company-0.8.7/.dir-locals.el deleted file mode 100644 index 79d9a12..0000000 --- a/packages/company-0.8.7/.dir-locals.el +++ /dev/null @@ -1,4 +0,0 @@ -((nil . ((indent-tabs-mode . nil) - (fill-column . 80) - (sentence-end-double-space . t) - (emacs-lisp-docstring-fill-column . 75)))) diff --git a/packages/company-0.8.7/.travis.yml b/packages/company-0.8.7/.travis.yml deleted file mode 100644 index ed76f79..0000000 --- a/packages/company-0.8.7/.travis.yml +++ /dev/null @@ -1,23 +0,0 @@ -# https://github.com/rolandwalker/emacs-travis - -language: emacs-lisp - -env: - matrix: - - EMACS=emacs24 - - EMACS=emacs-snapshot - -install: - - if [ "$EMACS" = "emacs24" ]; then - sudo add-apt-repository -y ppa:cassou/emacs && - sudo apt-get update -qq && - sudo apt-get install -qq emacs24 emacs24-el; - fi - - if [ "$EMACS" = "emacs-snapshot" ]; then - sudo add-apt-repository -y ppa:ubuntu-elisp/ppa && - sudo apt-get update -qq && - sudo apt-get install -qq emacs-snapshot; - fi - -script: - make test-batch EMACS=${EMACS} diff --git a/packages/company-0.8.7/ChangeLog b/packages/company-0.8.7/ChangeLog deleted file mode 100644 index 3979f34..0000000 --- a/packages/company-0.8.7/ChangeLog +++ /dev/null @@ -1,282 +0,0 @@ -2014-10-28 Dmitry Gutov - - Merge commit 'd3fcbefcf56d2caad172e22f24de95397c635bf2' from company - -2014-10-15 Stefan Monnier - - * packages/company/company-xcode.el (company-xcode-fetch): Avoid - add-to-list on local var. - * packages/company/company.el (company--window-height) - (company--window-width): Move before first use. - -2014-10-15 Dmitry Gutov - - Merge commit '60d4c09c982a1c562a70cd6aa705f47ab3badcfb' from company - -2014-09-14 Dmitry Gutov - - Merge commit 'fa4ba155a3e22ddc4b8bc33fcbf8cc69ef8f0043' from company - -2014-09-13 Dmitry Gutov - - Merge commit '2ef6263c65a109b4d36503e6484fdbf4cb307d0f' from company - -2014-08-27 Dmitry Gutov - - Merge commit 'f4ffe2b47cf6854ff3bc3ca1717efe1258c01547' from company - -2014-07-26 Dmitry Gutov - - Merge commit 'b1d019a4c815ac8bdc240d69eaa74eb4e34640e8' from - company-master - -2014-07-01 Dmitry Gutov - - Merge commit '7c14dedc79bf0c6eaad5bf50b80ea80dd721afdc' from company - - Conflicts: - packages/company/company-pysmell.el - -2014-06-14 Stefan Monnier - - * company/company-capf.el: Don't ignore things like semantic-capf. - -2014-04-19 Dmitry Gutov - - Merge commit '51c140ca9ee32d27cacc7b2b07d4539bf98ae575' from - company-master - - Conflicts: - packages/company/company-pysmell.el - -2014-03-25 Dmitry Gutov - - Merge commit '4a7995ff69b25990dc520ed9e466dfbcdb7eafc8' from company - -2014-03-19 Dmitry Gutov - - Merge commit 'fec7c0b4a8651160c5d759cc6703b2c45852d5bb' - -2014-03-18 Dmitry Gutov - - Merge commit '7be4321260f0c73ef4c3cadc646f6bb496650253' from company - -2014-02-18 Dmitry Gutov - - Merge commit '119822078ee3024c2d27017d45ef4578fa36040f' from company - -2014-02-03 Dmitry Gutov - - Merge commit '67ab56a5469f16652e73667ec3b4f76ff6befee6' from company - -2014-01-25 Dmitry Gutov - - Merge commit '8dc8f9525714db66f659a2a51322345068764bd3' from company - - Conflicts: - packages/company/company-capf.el - -2014-01-24 Stefan Monnier - - * company-capf.el (company--capf-data): Don't get confused by lambda - exps. - -2014-01-20 Dmitry Gutov - - Merge commit '2badcc6227a88e1aba288f442af5f4e1ce55d366' from company - -2014-01-15 Dmitry Gutov - - Merge commit '8b4d7da0d6aa1e24379fe5ace5bd2705352ea07e' from company - -2014-01-14 Dmitry Gutov - - Merge commit '67a96dbbfe645b64291ed62eab6f1eb391a834e0' from company - - Conflicts: - packages/company/company-elisp.el - packages/company/company-oddmuse.el - -2014-01-13 Stefan Monnier - - * packages/company/company-etags.el: Require `cl' for `case'. - * packages/company/company-oddmuse.el: Avoid `eval-when' before - requiring `cl'. - * packages/company/company-elisp.el (company-elisp): Simplify. - -2013-10-06 Dmitry Gutov - - Sync from company/master - -2013-08-29 Stefan Monnier - - * packages/company/company-capf.el (company-capf): Add preliminary - support for doc-buffer, meta, location, and require-match. - -2013-08-21 Stefan Monnier - - * packages/company/company-cmake.el: Fix up copyright. Require CL. - * packages/company/company-template.el - (company-template--buffer-templates): Declare before first use. - * packages/company/company-eclim.el (json-array-type): Declare - json-array-type. - (company-eclim--candidates): Remove unused var `project-name'. - -2013-08-21 Stefan Monnier - - Sync from company/master - -2013-08-14 Stefan Monnier - - Mark merge point of company. - -2013-06-27 Stefan Monnier - - * GNUmakefile: Rename from Makefile. Add targets for in-place use. - (all, all-in-place): New targets. - * admin/archive-contents.el (archive--simple-package-p): Ignore - autosave files. - (archive--refresh-pkg-file): New function. - (archive--write-pkg-file): Print with ' and ` shorthands. - * packages/company/company-pysmell.el: Don't require pysmell during - compile. - * packages/muse/htmlize-hack.el: Don't require htmlize during compile. - * packages/shen-mode/shen-mode.el (shen-functions): Define during - compile. - * smart-operator/smart-operator.el (smart-operator-insert-1): Use - pcase. - -2013-05-26 Dmitry Gutov - - company: Release 0.6.10 - - * Plays nicer with `org-indent-mode`. - * Works in horizontally scrolled windows. - - Git commit 764d2aa4ba50081adf69408e62d4863905b68b7f - -2013-05-10 Dmitry Gutov - - company: Release 0.6.9 - - * `company-capf` respects `:exit-function` completion property. - * `company-backends`: `prefix` command can return `t` in the cdr. - * `company-clang-begin-after-member-access`: New option. - * Mouse click outside the tooltip aborts completion. - * `company-clang` uses standard input to pass the contents of current - buffer to - Clang 2.9+, otherwise saves the buffer and passes the path to the - file. - * `company-clang-auto-save` option has been removed. - * Better interaction with `outline-minor-mode`. - * `company-dabbrev-code` supports all `prog-mode` derivatives. - - Git commit 4c735454d91f9674da0ecea950504888b1e10ff7 - -2013-04-27 Stefan Monnier - - * company.el (company-capf): Add support for `sorted' and - `post-completion'. - (company--capf-data): New function. - (company-backend): Declare before first use. - (company-require-match-p): Only call company-require-match is needed. - (company--continue-failed): Don't use backward-delete-char - non-interactively. - (company-search-assert-enabled): Demote it, since it comes too late to - be inlined. - (company-begin-with): Use a lexical closure, so the code is - byte-compiled. - (company--replacement-string, company--create-lines) - (company-pseudo-tooltip-edit, company-doc-buffer): Silence the - byte-compiler. - -2013-04-16 Dmitry Gutov - - Release 0.6.8 - - * `company-auto-complete` is disabled by default. - * `company-auto-complete-chars` default value includes fewer syntax - classes. - * In expanded function calls, arguments skipped by the user default to - "argN". - * `company-eclim` and `company-clang` do not strip argument types from - fields. - * `company-clang` expands function calls for all three modes now. - * `company-clang` supports `c++-mode` by default. - - Git commit 92ac3d0ef663bca26abbda33cc20a02a58b1c328 - -2013-04-05 Dmitry Gutov - - company: Release 0.6.7 - - * Two `company-elisp` tweaks. - - Git commit 8dceda389115b397de48becc4b68a64f4dc4bbab - -2013-04-01 Dmitry Gutov - - company: Release 0.6.6 - - ## 2013-04-01 (0.6.6) - - * `company-elisp` doesn't offer completions when typing the name and - the arguments of a new function or macro definition, allowing to - fall back to other back-ends like `company-dabbrev-code`. - - ## 2013-03-30 (0.6.5) - - * Fixed keybindings when running in a terminal. - * `company-elisp-show-locals-first`: new customizable variable. - * `company-elisp` shows more accurate and comprehensive candidates - list. - - ## 2013-03-26 (0.6.4) - - * `company-eclim` shows valid completions after an opening paren. - * Expanded template does not get removed until the point leaves it. - After your input the last argument in a method call expanded by - `company-eclim`, you can press `` once more, to jump after the - closing paren. No other bundled back-ends are affected. - - ## 2013-03-25 (0.6.3) - - * New tooltip face colors used on themes with light background. - * Pseudo-tooltip stays up-to-date when text is inserted after the - point. - * Fixed `company-require-match` mechanics. - -2013-03-24 Dmitry Gutov - - company: Release 0.6.2 - -2013-03-23 Dmitry Gutov - - company: Release 0.6.1 - -2013-03-21 Dmitry Gutov - - company: Remove angle brackets from README - -2013-03-19 Dmitry Gutov - - company: Update pkg.el and summary string - -2013-03-19 Dmitry Gutov - - company-tests.el: add copyright boilerplate - -2013-03-19 Dmitry Gutov - - company-mode: Release 0.6 - -2011-08-01 Stefan Monnier - - * company/*.el: Fix case misunderstanding. Use checkdoc. - * company/company.el (company-capf): First cut at making Company use - completion-at-point-functions. - -2011-06-30 Chong Yidong - - Remove version numbers in packages/ directory - diff --git a/packages/company-0.8.7/Makefile b/packages/company-0.8.7/Makefile deleted file mode 100644 index c52be4b..0000000 --- a/packages/company-0.8.7/Makefile +++ /dev/null @@ -1,31 +0,0 @@ -EMACS=emacs - -.PHONY: ert test test-batch - -package: *.el - @ver=`grep -o "Version: .*" company.el | cut -c 10-`; \ - tar cjvf company-$$ver.tar.bz2 --mode 644 `git ls-files '*.el' | xargs` - -elpa: *.el - @version=`grep -o "Version: .*" company.el | cut -c 10-`; \ - dir=company-$$version; \ - mkdir -p "$$dir"; \ - cp `git ls-files '*.el' | xargs` company-$$version; \ - echo "(define-package \"company\" \"$$version\" \ - \"Modular in-buffer completion framework\")" \ - > "$$dir"/company-pkg.el; \ - tar cvf company-$$version.tar --mode 644 "$$dir" - -clean: - @rm -rf company-*/ company-*.tar company-*.tar.bz2 *.elc ert.el - -test: - ${EMACS} -Q -nw -L . -l company-tests.el -l company-elisp-tests.el \ - --eval "(let (pop-up-windows) (ert t))" - -test-batch: - ${EMACS} -Q --batch -L . -l company-tests.el -l company-elisp-tests.el \ - --eval "(ert-run-tests-batch-and-exit '(not (tag interactive)))" - -compile: - ${EMACS} -Q --batch -L . -f batch-byte-compile company.el company-*.el diff --git a/packages/company-0.8.7/NEWS.md b/packages/company-0.8.7/NEWS.md deleted file mode 100644 index 56bebb6..0000000 --- a/packages/company-0.8.7/NEWS.md +++ /dev/null @@ -1,300 +0,0 @@ -# History of user-visible changes - -## 2014-10-15 (0.8.6) - -* `company-clang` and `company-template-c-like-templatify` support templated - functions and arguments. -* `company-dabbrev` ignores "uninteresting" buffers by default. Depends on the - new user option, `company-dabbrev-ignore-buffers`. -* `company-files` checks directory's last modification time. -* `company-files` supports relative paths and Windows drive letters. - -## 2014-08-13 (0.8.4) - -* `company-ropemacs` is only used when `ropemacs-mode` is on. -* `company-gtags` is enabled in all `prog-mode` derivatives by default. -* `company-end-of-buffer-workaround` is not used anymore. -* `company-begin-commands` includes several `cc-mode` commands. - -## 2014-08-27 (0.8.3) - -* On Emacs 24.4 or newer, tooltip positioning takes line-spacing into account. -* New face `company-tooltip-search`, used for the search string in the tooltip. -* The default value of `company-dabbrev-minimum-length` is set to 4, independent - of the `company-minimum-prefix-length` value. - -## 2014-07-26 (0.8.2) - -* New user option `company-occurrence-weight-function`, allowing to tweak the - behavior of the transformer `company-sort-by-occurrence`. -* Setting `company-idle-delay` to `t` is deprecated. Use the value 0 instead. - -## 2014-07-01 (0.8.1) - -* `company-require-match` is not in effect when the new input doesn't continue - the previous prefix, and that prefix was a match. -* The meaning of `company-begin-commands` value t has slightly changed. -* New transformer, `company-sort-by-backend-importance`. -* When grouped back-ends are used, the back-end of the current candidate is - indicated in the mode-line, enclosed in angle brackets. -* New user option `company-gtags-insert-arguments`, t by default. -* `company-css` knows about CSS3. -* `company-gtags` supports `meta` and `annotation`. -* User option `company-dabbrev-code-other-buffers` can have a new value: `code`. -* New user option `company-tooltip-flip-when-above`. -* `company-clang` uses the standard header search paths by default. -* `C-h` is bound to `company-show-doc-buffer` (like `f1`). - -## 2014-04-19 (0.8.0) - -* `company-capf` is included in `company-backends` in any supported Emacs - version (>= 24.1). `company-elisp` goes before it if Emacs version is < 24.4. -* New user option `company-clang-insert-arguments`, by default t. -* Default value of `company-idle-delay` lowered to `0.5`. -* New user option `company-tooltip-minimum-width`, by default 0. -* New function `company-grab-symbol-cons`. -* `company-clang` fetches completion candidates asynchronously. -* Added support for asynchronous back-ends (experimental). -* Support for back-end command `crop` dropped (it was never documented). -* Support for Emacs 23 dropped. -* New user option `company-abort-manual-when-too-short`. - -## 2014-03-25 (0.7.3) - -* New user option `company-etags-ignore-case`. - -## 2014-03-19 (0.7.2) - -* Support for Emacs 22 officially dropped. -* `company-clang` supports `indent-tabs-mode` and multibyte chars before point. - -## 2014-03-18 (0.7.1) - -* Group of back-ends can now contain keyword `:with`, which makes all back-ends - after it to be skipped for prefix calculation. -* New function `company-version`. -* New bundled back-end `company-yasnippet`. -* Completion candidates returned from grouped back-ends are tagged to remember - which back-end each came from. -* New user option `company-tooltip-align-annotations`, off by default. -* New bundled back-end `company-bbdb`. - -## 2014-02-18 (0.7) - -* New back-end command, `match`, for non-prefix completion. -* New user option `company-continue-commands`. The default value aborts - completion on buffer saving commands. -* New back-end command, `annotation`, for text displayed inline in the popup - that's not a part of completion candidate. -* `company-capf`, `company-clang` and `company-eclim` use `annotation`. -* `company-preview*` faces inherit from `company-tooltip-selection` and - `company-tooltip-common-selection` on light themes. -* New user option `company-transformers`. -* First transformer, `company-sort-by-occurrence`. -* New user options controlling `company-dabbrev` and `company-dabbrev-code`. - -## 2014-01-25 (0.6.14) - -* The tooltip front-end is rendered with scrollbar, controlled by the user - option `company-tooltip-offset-display`. -* The tooltip front-end is rendered with margins, controlled by the user option - `company-tooltip-margin`. - -## 2014-01-14 (0.6.13) - -* Experimental support for non-prefix completion. -* Starting with Emacs version 24.4, `company-capf` is included in - `company-backends` and replaces `company-elisp`. -* `company-capf` supports completion tables that return non-default boundaries. -* `company-elisp` is enabled in `inferior-emacs-lisp-mode`. - -## 2013-09-28 (0.6.12) - -* Default value of `company-begin-commands` changed to `(self-insert-command)`. -* Futher improvement in `org-indent-mode` compatibility. - -## 2013-08-18 (0.6.11) - -* `company-template-c-like-templatify` removes all text after closing paren, for - use in backends that display additional info there. -* `company-cmake` is now bundled. -* Better `linum` compatibility in Emacs <= 24.2. -* `company-global-modes`: New option. - -## 2013-05-26 (0.6.10) - -* Plays nicer with `org-indent-mode`. -* Works in horizontally scrolled windows. - -## 2013-05-10 (0.6.9) - -* `company-capf` respects `:exit-function` completion property. -* `company-backends`: `prefix` command can return `t` in the cdr. -* `company-clang-begin-after-member-access`: New option. -* Mouse click outside the tooltip aborts completion. -* `company-clang` uses standard input to pass the contents of current buffer to - Clang 2.9+, otherwise saves the buffer and passes the path to the file. -* `company-clang-auto-save` option has been removed. -* Better interaction with `outline-minor-mode`. -* `company-dabbrev-code` supports all `prog-mode` derivatives. - -## 2013-04-16 (0.6.8) - -* `company-auto-complete` is disabled by default. -* `company-auto-complete-chars` default value includes fewer syntax classes. -* In expanded function calls, arguments skipped by the user default to "argN". -* `company-eclim` and `company-clang` do not strip argument types from fields. -* `company-clang` expands function calls for all three modes now. -* `company-clang` supports `c++-mode` by default. - -## 2013-04-05 (0.6.7) - -* Two `company-elisp` tweaks. - -## 2013-04-01 (0.6.6) - -* `company-elisp` doesn't offer completions when typing the name and the - arguments of a new function or macro definition, allowing to fall back to - other back-ends like `company-dabbrev-code`. - -## 2013-03-30 (0.6.5) - -* Fixed keybindings when running in a terminal. -* `company-elisp-show-locals-first`: new customizable variable. -* `company-elisp` shows more accurate and comprehensive candidates list. - -## 2013-03-26 (0.6.4) - -* `company-eclim` shows valid completions after an opening paren. -* Expanded template does not get removed until the point leaves it. After your - input the last argument in a method call expanded by `company-eclim`, you can - press `` once more, to jump after the closing paren. No other bundled - back-ends are affected. - -## 2013-03-25 (0.6.3) - -* New tooltip face colors used on themes with light background. -* Pseudo-tooltip stays up-to-date when text is inserted after the point. -* Fixed `company-require-match` mechanics. - -## 2013-03-24 (0.6.2) - -* `global-company-mode` is now autoloaded. - -## 2013-03-23 (0.6.1) - -* Documented `init` and `post-completion` back-end commands. -* `company-eclim` and `company-clang` only expand the template on explicit user - action (such as `company-complete-{selection,number,mouse}`). -* `company-template` has some breaking changes. When point is at one of the - fields, it's displayed at the beginning, not right after it; `` jumps to - the next field, `forward-word` and `subword-forward` remappings are removed; - when you jump to the next field, if the current one hasn't been edited, the - overlay gets removed but the text remains. -* `company-eclim` shows method overloads and expands templates for calls. -* `company-clang-objc-templatify` does not insert spaces after colons anymore. -* `company-clang` is now only initialized in supported buffers. - So, no error messages if you don't have Clang until you open a C file. -* `company-clang` recognizes Clang included in recent Xcode. -* New commands `company-select-previous-or-abort` and - `company-select-next-or-abort`, bound to `` and ``. - -## 2013-03-19 (0.6) - -* Across-the-board bugfixing. -* `company-pysmell` is not used by default anymore. -* Loading of `nxml`, `semantic`, `pymacs` and `ropemacs` is now deferred. -* Candidates from grouped back-ends are merged more conservatively: only - back-ends that return the same prefix at point are used. -* `company-clang` now shows meta information, too. -* Some performance improvements. -* Fixed two old tooltip annoyances. -* Instead of `overrriding-terminal-local-map`, we're now using - `emulation-mode-map-alists` (experimental). This largely means that when the - completion keymap is active, other minor modes' keymaps are still used, so, - for example, it's not as easy to accidentally circumvent `paredit-mode` - when it's enabled. -* `company-elisp` has seen some improvements. -* Added `company-capf`: completion adapter using - `completion-at-point-functions`. (Stefan Monnier) -* Clang completions now include macros and are case-sensitive. -* Switching between tag files now works correctly with `company-etags`. - -## 2010-02-24 (0.5) - -* `company-ropemacs` now provides location and docs. (Fernando H. Silva) -* Added `company-with-candidate-inserted` macro. -* Added `company-clang` back-end. -* Added new mechanism for non-consecutive insertion. - (So far only used by clang for ObjC.) -* The semantic back-end now shows meta information for local symbols. -* Added compatibility for CEDET in Emacs 23.2 and from CVS. (Oleg Andreev) - -## 2009-05-07 (0.4.3) - -* Added `company-other-backend`. -* Idle completion no longer interrupts multi-key command input. -* Added `company-ropemacs` and `company-pysmell` back-ends. - -## 2009-04-25 (0.4.2) - -* In C modes . and -> now count towards `company-minimum-prefix-length`. -* Reverted default front-end back to `company-preview-if-just-one-frontend`. -* The pseudo tooltip will no longer be clipped at the right window edge. -* Added `company-tooltip-minimum`. -* Windows compatibility fixes. - -## 2009-04-19 (0.4.1) - -* Added `global-company-mode`. -* Performance enhancements. -* Added `company-eclim` back-end. -* Added safer workaround for Emacs `posn-col-row` bug. - -## 2009-04-18 (0.4) - -* Automatic completion is now aborted if the prefix gets too short. -* Added option `company-dabbrev-time-limit`. -* `company-backends` now supports merging back-ends. -* Added back-end `company-dabbrev-code` for generic code. -* Fixed `company-begin-with`. - -## 2009-04-15 (0.3.1) - -* Added 'stop prefix to prevent dabbrev from completing inside of symbols. -* Fixed issues with tabbar-mode and line-spacing. -* Performance enhancements. - -## 2009-04-12 (0.3) - -* Added `company-begin-commands` option. -* Added abbrev, tempo and Xcode back-ends. -* Back-ends are now interactive. You can start them with M-x backend-name. -* Added `company-begin-with` for starting company from elisp-code. -* Added hooks. -* Added `company-require-match` and `company-auto-complete` options. - -## 2009-04-05 (0.2.1) - -* Improved Emacs Lisp back-end behavior for local variables. -* Added `company-elisp-detect-function-context` option. -* The mouse can now be used for selection. - -## 2009-03-22 (0.2) - -* Added `company-show-location`. -* Added etags back-end. -* Added work-around for end-of-buffer bug. -* Added `company-filter-candidates`. -* More local Lisp variables are now included in the candidates. - -## 2009-03-21 (0.1.5) - -* Fixed elisp documentation buffer always showing the same doc. -* Added `company-echo-strip-common-frontend`. -* Added `company-show-numbers` option and M-0 ... M-9 default bindings. -* Don't hide the echo message if it isn't shown. - -## 2009-03-20 (0.1) - -* Initial release. diff --git a/packages/company-0.8.7/README.md b/packages/company-0.8.7/README.md deleted file mode 100644 index 4f79bbc..0000000 --- a/packages/company-0.8.7/README.md +++ /dev/null @@ -1,4 +0,0 @@ -See the [homepage](http://company-mode.github.com/). -[![githalytics.com alpha](https://cruel-carlota.pagodabox.com/336ef4be2595a7859d52e2c17b7da2b2 "githalytics.com")](http://githalytics.com/company-mode/company-mode) - -[![Build Status](https://travis-ci.org/company-mode/company-mode.png?branch=master)](https://travis-ci.org/company-mode/company-mode) diff --git a/packages/company-0.8.7/company-abbrev.el b/packages/company-0.8.7/company-abbrev.el deleted file mode 100644 index a454aaa..0000000 --- a/packages/company-0.8.7/company-abbrev.el +++ /dev/null @@ -1,51 +0,0 @@ -;;; company-abbrev.el --- company-mode completion back-end for abbrev - -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. - -;; Author: Nikolaj Schumacher - -;; This file is part of GNU 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 . - - -;;; Commentary: -;; - -;;; Code: - -(require 'company) -(require 'cl-lib) -(require 'abbrev) - -(defun company-abbrev-insert (match) - "Replace MATCH with the expanded abbrev." - (expand-abbrev)) - -;;;###autoload -(defun company-abbrev (command &optional arg &rest ignored) - "`company-mode' completion back-end for abbrev." - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'company-abbrev - 'company-abbrev-insert)) - (prefix (company-grab-symbol)) - (candidates (nconc - (delete "" (all-completions arg global-abbrev-table)) - (delete "" (all-completions arg local-abbrev-table)))) - (meta (abbrev-expansion arg)) - (require-match t))) - -(provide 'company-abbrev) -;;; company-abbrev.el ends here diff --git a/packages/company-0.8.7/company-autoloads.el b/packages/company-0.8.7/company-autoloads.el deleted file mode 100644 index 5886e8a..0000000 --- a/packages/company-0.8.7/company-autoloads.el +++ /dev/null @@ -1,297 +0,0 @@ -;;; company-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - - -;;;### (autoloads (global-company-mode company-mode) "company" "company.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company.el - -(autoload 'company-mode "company" "\ -\"complete anything\"; is an in-buffer completion framework. -Completion starts automatically, depending on the values -`company-idle-delay' and `company-minimum-prefix-length'. - -Completion can be controlled with the commands: -`company-complete-common', `company-complete-selection', `company-complete', -`company-select-next', `company-select-previous'. If these commands are -called before `company-idle-delay', completion will also start. - -Completions can be searched with `company-search-candidates' or -`company-filter-candidates'. These can be used while completion is -inactive, as well. - -The completion data is retrieved using `company-backends' and displayed -using `company-frontends'. If you want to start a specific back-end, call -it interactively or use `company-begin-backend'. - -regular keymap (`company-mode-map'): - -\\{company-mode-map} -keymap during active completions (`company-active-map'): - -\\{company-active-map} - -\(fn &optional ARG)" t nil) - -(defvar global-company-mode nil "\ -Non-nil if Global-Company mode is enabled. -See the command `global-company-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 `global-company-mode'.") - -(custom-autoload 'global-company-mode "company" nil) - -(autoload 'global-company-mode "company" "\ -Toggle Company mode in all buffers. -With prefix ARG, enable Global-Company mode if ARG is positive; -otherwise, disable it. If called from Lisp, enable the mode if -ARG is omitted or nil. - -Company mode is enabled in all buffers where -`company-mode-on' would do it. -See `company-mode' for more information on Company mode. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads (company-abbrev) "company-abbrev" "company-abbrev.el" -;;;;;; (21682 44667 0 0)) -;;; Generated autoloads from company-abbrev.el - -(autoload 'company-abbrev "company-abbrev" "\ -`company-mode' completion back-end for abbrev. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-bbdb) "company-bbdb" "company-bbdb.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-bbdb.el - -(autoload 'company-bbdb "company-bbdb" "\ -`company-mode' completion back-end for `bbdb'. - -\(fn COMMAND &optional ARG &rest IGNORE)" t nil) - -;;;*** - -;;;### (autoloads (company-css) "company-css" "company-css.el" (21682 -;;;;;; 44667 0 0)) -;;; Generated autoloads from company-css.el - -(autoload 'company-css "company-css" "\ -`company-mode' completion back-end for `css-mode'. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-dabbrev) "company-dabbrev" "company-dabbrev.el" -;;;;;; (21682 44667 0 0)) -;;; Generated autoloads from company-dabbrev.el - -(autoload 'company-dabbrev "company-dabbrev" "\ -dabbrev-like `company-mode' completion back-end. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-dabbrev-code) "company-dabbrev-code" "company-dabbrev-code.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-dabbrev-code.el - -(autoload 'company-dabbrev-code "company-dabbrev-code" "\ -dabbrev-like `company-mode' back-end for code. -The back-end looks for all symbols in the current buffer that aren't in -comments or strings. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-elisp) "company-elisp" "company-elisp.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-elisp.el - -(autoload 'company-elisp "company-elisp" "\ -`company-mode' completion back-end for Emacs Lisp. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-etags) "company-etags" "company-etags.el" -;;;;;; (21682 44667 0 0)) -;;; Generated autoloads from company-etags.el - -(autoload 'company-etags "company-etags" "\ -`company-mode' completion back-end for etags. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-files) "company-files" "company-files.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-files.el - -(autoload 'company-files "company-files" "\ -`company-mode' completion back-end existing file names. -Completions works for proper absolute and relative files paths. -File paths with spaces are only supported inside strings. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-gtags) "company-gtags" "company-gtags.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-gtags.el - -(autoload 'company-gtags "company-gtags" "\ -`company-mode' completion back-end for GNU Global. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-ispell) "company-ispell" "company-ispell.el" -;;;;;; (21682 44667 0 0)) -;;; Generated autoloads from company-ispell.el - -(autoload 'company-ispell "company-ispell" "\ -`company-mode' completion back-end using Ispell. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-keywords) "company-keywords" "company-keywords.el" -;;;;;; (21682 44667 0 0)) -;;; Generated autoloads from company-keywords.el - -(autoload 'company-keywords "company-keywords" "\ -`company-mode' back-end for programming language keywords. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-nxml) "company-nxml" "company-nxml.el" -;;;;;; (21682 44667 0 0)) -;;; Generated autoloads from company-nxml.el - -(autoload 'company-nxml "company-nxml" "\ -`company-mode' completion back-end for `nxml-mode'. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-oddmuse) "company-oddmuse" "company-oddmuse.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-oddmuse.el - -(autoload 'company-oddmuse "company-oddmuse" "\ -`company-mode' completion back-end for `oddmuse-mode'. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-pysmell) "company-pysmell" "company-pysmell.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-pysmell.el - -(autoload 'company-pysmell "company-pysmell" "\ -`company-mode' completion back-end for pysmell. -This requires pysmell.el and pymacs.el. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-semantic) "company-semantic" "company-semantic.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-semantic.el - -(autoload 'company-semantic "company-semantic" "\ -`company-mode' completion back-end using CEDET Semantic. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-tempo) "company-tempo" "company-tempo.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-tempo.el - -(autoload 'company-tempo "company-tempo" "\ -`company-mode' completion back-end for tempo. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-xcode) "company-xcode" "company-xcode.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-xcode.el - -(autoload 'company-xcode "company-xcode" "\ -`company-mode' completion back-end for Xcode projects. - -\(fn COMMAND &optional ARG &rest IGNORED)" t nil) - -;;;*** - -;;;### (autoloads (company-yasnippet) "company-yasnippet" "company-yasnippet.el" -;;;;;; (21682 44668 0 0)) -;;; Generated autoloads from company-yasnippet.el - -(autoload 'company-yasnippet "company-yasnippet" "\ -`company-mode' back-end for `yasnippet'. - -This back-end should be used with care, because as long as there are -snippets defined for the current major mode, this back-end will always -shadow back-ends that come after it. Recommended usages: - -* In a buffer-local value of `company-backends', grouped with a back-end or - several that provide actual text completions. - - (add-hook 'js-mode-hook - (lambda () - (set (make-local-variable 'company-backends) - '((company-dabbrev-code company-yasnippet))))) - -* After keyword `:with', grouped with other back-ends. - - (push '(company-semantic :with company-yasnippet) company-backends) - -* Not in `company-backends', just bound to a key. - - (global-set-key (kbd \"C-c y\") 'company-yasnippet) - -\(fn COMMAND &optional ARG &rest IGNORE)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("company-capf.el" "company-clang.el" "company-cmake.el" -;;;;;; "company-eclim.el" "company-elisp-tests.el" "company-pkg.el" -;;;;;; "company-ropemacs.el" "company-template.el" "company-tests.el") -;;;;;; (21682 44668 778154 0)) - -;;;*** - -(provide 'company-autoloads) -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; company-autoloads.el ends here diff --git a/packages/company-0.8.7/company-bbdb.el b/packages/company-0.8.7/company-bbdb.el deleted file mode 100644 index 22741a2..0000000 --- a/packages/company-0.8.7/company-bbdb.el +++ /dev/null @@ -1,52 +0,0 @@ -;;; company-bbdb.el --- company-mode completion back-end for BBDB in message-mode - -;; Copyright (C) 2013-2014 Free Software Foundation, Inc. - -;; Author: Jan Tatarik - -;; This file is part of GNU 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 . - -(require 'company) -(require 'cl-lib) - -(declare-function bbdb-record-get-field "bbdb") -(declare-function bbdb-records "bbdb") -(declare-function bbdb-dwim-mail "bbdb-com") -(declare-function bbdb-search "bbdb-com") - -(defun company-bbdb--candidates (arg) - (cl-mapcan (lambda (record) - (mapcar (lambda (mail) (bbdb-dwim-mail record mail)) - (bbdb-record-get-field record 'mail))) - (eval '(bbdb-search (bbdb-records) arg nil arg)))) - -;;;###autoload -(defun company-bbdb (command &optional arg &rest ignore) - "`company-mode' completion back-end for `bbdb'." - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'company-bbdb)) - (prefix (and (eq major-mode 'message-mode) - (featurep 'bbdb-com) - (looking-back "^\\(To\\|Cc\\|Bcc\\):.*" - (line-beginning-position)) - (company-grab-symbol))) - (candidates (company-bbdb--candidates arg)) - (sorted t) - (no-cache t))) - -(provide 'company-bbdb) -;;; company-bbdb.el ends here diff --git a/packages/company-0.8.7/company-capf.el b/packages/company-0.8.7/company-capf.el deleted file mode 100644 index b630025..0000000 --- a/packages/company-0.8.7/company-capf.el +++ /dev/null @@ -1,148 +0,0 @@ -;;; company-capf.el --- company-mode completion-at-point-functions back-end -*- lexical-binding: t -*- - -;; Copyright (C) 2013-2014 Free Software Foundation, Inc. - -;; Author: Stefan Monnier - -;; This file is part of GNU 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 . - - -;;; Commentary: -;; - -;;; Code: - -(require 'company) -(require 'cl-lib) - -(defvar company--capf-cache nil) - -(defun company--capf-data () - (let ((cache company--capf-cache)) - (if (and (equal (current-buffer) (car cache)) - (equal (point) (car (setq cache (cdr cache)))) - (equal (buffer-chars-modified-tick) (car (setq cache (cdr cache))))) - (cadr cache) - (let ((data (company--capf-data-real))) - (setq company--capf-cache - (list (current-buffer) (point) (buffer-chars-modified-tick) data)) - data)))) - -(defun company--capf-data-real () - (cl-letf* (((default-value 'completion-at-point-functions) - ;; Ignore tags-completion-at-point-function because it subverts - ;; company-etags in the default value of company-backends, where - ;; the latter comes later. - (remove 'tags-completion-at-point-function - (default-value 'completion-at-point-functions))) - (data (run-hook-wrapped 'completion-at-point-functions - ;; Ignore misbehaving functions. - #'completion--capf-wrapper 'optimist))) - (when (and (consp (cdr data)) (numberp (nth 1 data))) data))) - -(defun company-capf (command &optional arg &rest _args) - "`company-mode' back-end using `completion-at-point-functions'." - (interactive (list 'interactive)) - (pcase command - (`interactive (company-begin-backend 'company-capf)) - (`prefix - (let ((res (company--capf-data))) - (when res - (if (> (nth 2 res) (point)) - 'stop - (buffer-substring-no-properties (nth 1 res) (point)))))) - (`candidates - (let ((res (company--capf-data))) - (when res - (let* ((table (nth 3 res)) - (pred (plist-get (nthcdr 4 res) :predicate)) - (meta (completion-metadata - (buffer-substring (nth 1 res) (nth 2 res)) - table pred)) - (sortfun (cdr (assq 'display-sort-function meta))) - (candidates (completion-all-completions arg table pred (length arg))) - (last (last candidates)) - (base-size (and (numberp (cdr last)) (cdr last)))) - (when base-size - (setcdr last nil)) - (when sortfun - (setq candidates (funcall sortfun candidates))) - (if (not (zerop (or base-size 0))) - (let ((before (substring arg 0 base-size))) - (mapcar (lambda (candidate) - (concat before candidate)) - candidates)) - candidates))))) - (`sorted - (let ((res (company--capf-data))) - (when res - (let ((meta (completion-metadata - (buffer-substring (nth 1 res) (nth 2 res)) - (nth 3 res) (plist-get (nthcdr 4 res) :predicate)))) - (cdr (assq 'display-sort-function meta)))))) - (`match - ;; Can't just use 0 when base-size (see above) is non-zero. - (let ((start (if (get-text-property 0 'font-lock-face arg) - 0 - (next-single-property-change 0 'font-lock-face arg)))) - (when start - ;; completions-common-part comes first, but we can't just look for this - ;; value because it can be in a list. - (or - (let ((value (get-text-property start 'font-lock-face arg))) - (text-property-not-all start (length arg) - 'font-lock-face value arg)) - (length arg))))) - (`duplicates t) - (`no-cache t) ;Not much can be done here, as long as we handle - ;non-prefix matches. - (`meta - (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig))) - (when f (funcall f arg)))) - (`doc-buffer - (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer))) - (when f (funcall f arg)))) - (`location - (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location))) - (when f (funcall f arg)))) - (`annotation - (save-excursion - ;; FIXME: `company-begin' sets `company-point' after calling - ;; `company--begin-new'. We shouldn't rely on `company-point' here, - ;; better to cache the capf-data value instead. However: we can't just - ;; save the last capf-data value in `prefix', because that command can - ;; get called more often than `candidates', and at any point in the - ;; buffer (https://github.com/company-mode/company-mode/issues/153). - ;; We could try propertizing the returned prefix string, but it's not - ;; passed to `annotation', and `company-prefix' is set only after - ;; `company--strip-duplicates' is called. - (when company-point - (goto-char company-point)) - (let ((f (plist-get (nthcdr 4 (company--capf-data)) :annotation-function))) - (when f (funcall f arg))))) - (`require-match - (plist-get (nthcdr 4 (company--capf-data)) :company-require-match)) - (`init nil) ;Don't bother: plenty of other ways to initialize the code. - (`post-completion - (let* ((res (company--capf-data)) - (exit-function (plist-get (nthcdr 4 res) :exit-function))) - (if exit-function - (funcall exit-function arg 'finished)))) - )) - -(provide 'company-capf) - -;;; company-capf.el ends here diff --git a/packages/company-0.8.7/company-clang.el b/packages/company-0.8.7/company-clang.el deleted file mode 100644 index 90757a8..0000000 --- a/packages/company-0.8.7/company-clang.el +++ /dev/null @@ -1,327 +0,0 @@ -;;; company-clang.el --- company-mode completion back-end for Clang -*- lexical-binding: t -*- - -;; Copyright (C) 2009, 2011, 2013-2014 Free Software Foundation, Inc. - -;; Author: Nikolaj Schumacher - -;; This file is part of GNU 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 . - - -;;; Commentary: -;; - -;;; Code: - -(require 'company) -(require 'company-template) -(require 'cl-lib) - -(defgroup company-clang nil - "Completion back-end for Clang." - :group 'company) - -(defcustom company-clang-executable - (executable-find "clang") - "Location of clang executable." - :type 'file) - -(defcustom company-clang-begin-after-member-access t - "When non-nil, automatic completion will start whenever the current -symbol is preceded by \".\", \"->\" or \"::\", ignoring -`company-minimum-prefix-length'. - -If `company-begin-commands' is a list, it should include `c-electric-lt-gt' -and `c-electric-colon', for automatic completion right after \">\" and -\":\".") - -(defcustom company-clang-arguments nil - "Additional arguments to pass to clang when completing. -Prefix files (-include ...) can be selected with `company-clang-set-prefix' -or automatically through a custom `company-clang-prefix-guesser'." - :type '(repeat (string :tag "Argument"))) - -(defcustom company-clang-prefix-guesser 'company-clang-guess-prefix - "A function to determine the prefix file for the current buffer." - :type '(function :tag "Guesser function" nil)) - -(defvar company-clang-modes '(c-mode c++-mode objc-mode) - "Major modes which clang may complete.") - -(defcustom company-clang-insert-arguments t - "When non-nil, insert function arguments as a template after completion." - :type 'boolean - :package-version '(company . "0.8.0")) - -;; prefix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar company-clang--prefix nil) - -(defsubst company-clang--guess-pch-file (file) - (let ((dir (directory-file-name (file-name-directory file)))) - (when (equal (file-name-nondirectory dir) "Classes") - (setq dir (file-name-directory dir))) - (car (directory-files dir t "\\([^.]h\\|[^h]\\).pch\\'" t)))) - -(defsubst company-clang--file-substring (file beg end) - (with-temp-buffer - (insert-file-contents-literally file nil beg end) - (buffer-string))) - -(defun company-clang-guess-prefix () - "Try to guess the prefix file for the current buffer." - ;; Prefixes seem to be called .pch. Pre-compiled headers do, too. - ;; So we look at the magic number to rule them out. - (let* ((file (company-clang--guess-pch-file buffer-file-name)) - (magic-number (and file (company-clang--file-substring file 0 4)))) - (unless (member magic-number '("CPCH" "gpch")) - file))) - -(defun company-clang-set-prefix (&optional prefix) - "Use PREFIX as a prefix (-include ...) file for clang completion." - (interactive (let ((def (funcall company-clang-prefix-guesser))) - (unless (stringp def) - (setq def default-directory)) - (list (read-file-name "Prefix file: " - (when def (file-name-directory def)) - def t (when def (file-name-nondirectory def)))))) - ;; TODO: pre-compile? - (setq company-clang--prefix (and (stringp prefix) - (file-regular-p prefix) - prefix))) - -;; Clean-up on exit. -(add-hook 'kill-emacs-hook 'company-clang-set-prefix) - -;; parsing ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO: Handle Pattern (syntactic hints would be neat). -;; Do we ever see OVERLOAD (or OVERRIDE)? -(defconst company-clang--completion-pattern - "^COMPLETION: \\_<\\(%s[a-zA-Z0-9_:<>]*\\)\\(?: : \\(.*\\)$\\)?$") - -(defconst company-clang--error-buffer-name "*clang-error*") - -(defun company-clang--lang-option () - (if (eq major-mode 'objc-mode) - (if (string= "m" (file-name-extension buffer-file-name)) - "objective-c" "objective-c++") - (substring (symbol-name major-mode) 0 -5))) - -(defun company-clang--parse-output (prefix _objc) - (goto-char (point-min)) - (let ((pattern (format company-clang--completion-pattern - (regexp-quote prefix))) - (case-fold-search nil) - lines match) - (while (re-search-forward pattern nil t) - (setq match (match-string-no-properties 1)) - (unless (equal match "Pattern") - (save-match-data - (when (string-match ":" match) - (setq match (substring match 0 (match-beginning 0))))) - (let ((meta (match-string-no-properties 2))) - (when (and meta (not (string= match meta))) - (put-text-property 0 1 'meta - (company-clang--strip-formatting meta) - match))) - (push match lines))) - lines)) - -(defun company-clang--meta (candidate) - (get-text-property 0 'meta candidate)) - -(defun company-clang--annotation (candidate) - (let ((meta (company-clang--meta candidate))) - (cond - ((null meta) nil) - ((string-match "[^:]:[^:]" meta) - (substring meta (1+ (match-beginning 0)))) - ((string-match "\\((.*)[ a-z]*\\'\\)" meta) - (match-string 1 meta))))) - -(defun company-clang--strip-formatting (text) - (replace-regexp-in-string - "#]" " " - (replace-regexp-in-string "[<{[]#\\|#[>}]" "" text t) - t)) - -(defun company-clang--handle-error (res args) - (goto-char (point-min)) - (let* ((buf (get-buffer-create company-clang--error-buffer-name)) - (cmd (concat company-clang-executable " " (mapconcat 'identity args " "))) - (pattern (format company-clang--completion-pattern "")) - (err (if (re-search-forward pattern nil t) - (buffer-substring-no-properties (point-min) - (1- (match-beginning 0))) - ;; Warn the user more aggressively if no match was found. - (message "clang failed with error %d:\n%s" res cmd) - (buffer-string)))) - - (with-current-buffer buf - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (current-time-string) - (format "\nclang failed with error %d:\n" res) - cmd "\n\n") - (insert err) - (setq buffer-read-only t) - (goto-char (point-min)))))) - -(defun company-clang--start-process (prefix callback &rest args) - (let ((objc (derived-mode-p 'objc-mode)) - (buf (get-buffer-create "*clang-output*"))) - (with-current-buffer buf (erase-buffer)) - (if (get-buffer-process buf) - (funcall callback nil) - (let ((process (apply #'start-process "company-clang" buf - company-clang-executable args))) - (set-process-sentinel - process - (lambda (proc status) - (unless (string-match-p "hangup" status) - (funcall - callback - (let ((res (process-exit-status proc))) - (with-current-buffer buf - (unless (eq 0 res) - (company-clang--handle-error res args)) - ;; Still try to get any useful input. - (company-clang--parse-output prefix objc))))))) - (unless (company-clang--auto-save-p) - (send-region process (point-min) (point-max)) - (send-string process "\n") - (process-send-eof process)))))) - -(defsubst company-clang--build-location (pos) - (save-excursion - (goto-char pos) - (format "%s:%d:%d" - (if (company-clang--auto-save-p) buffer-file-name "-") - (line-number-at-pos) - (1+ (length - (encode-coding-region - (line-beginning-position) - (point) - 'utf-8 - t)))))) - -(defsubst company-clang--build-complete-args (pos) - (append '("-fsyntax-only" "-Xclang" "-code-completion-macros") - (unless (company-clang--auto-save-p) - (list "-x" (company-clang--lang-option))) - company-clang-arguments - (when (stringp company-clang--prefix) - (list "-include" (expand-file-name company-clang--prefix))) - (list "-Xclang" (format "-code-completion-at=%s" - (company-clang--build-location pos))) - (list (if (company-clang--auto-save-p) buffer-file-name "-")))) - -(defun company-clang--candidates (prefix callback) - (and (company-clang--auto-save-p) - (buffer-modified-p) - (basic-save-buffer)) - (when (null company-clang--prefix) - (company-clang-set-prefix (or (funcall company-clang-prefix-guesser) - 'none))) - (apply 'company-clang--start-process - prefix - callback - (company-clang--build-complete-args (- (point) (length prefix))))) - -(defun company-clang--prefix () - (if company-clang-begin-after-member-access - (company-grab-symbol-cons "\\.\\|->\\|::" 2) - (company-grab-symbol))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst company-clang-required-version 1.1) - -(defvar company-clang--version nil) - -(defun company-clang--auto-save-p () - (< company-clang--version 2.9)) - -(defsubst company-clang-version () - "Return the version of `company-clang-executable'." - (with-temp-buffer - (call-process company-clang-executable nil t nil "--version") - (goto-char (point-min)) - (if (re-search-forward "clang\\(?: version \\|-\\)\\([0-9.]+\\)" nil t) - (let ((ver (string-to-number (match-string-no-properties 1)))) - (if (> ver 100) - (/ ver 100) - ver)) - 0))) - -(defun company-clang-objc-templatify (selector) - (let* ((end (point-marker)) - (beg (- (point) (length selector) 1)) - (templ (company-template-declare-template beg end)) - (cnt 0)) - (save-excursion - (goto-char beg) - (catch 'stop - (while (search-forward ":" end t) - (when (looking-at "([^)]*) ?") - (delete-region (match-beginning 0) (match-end 0))) - (company-template-add-field templ (point) (format "arg%d" cnt)) - (if (< (point) end) - (insert " ") - (throw 'stop t)) - (cl-incf cnt)))) - (company-template-move-to-first templ))) - -(defun company-clang (command &optional arg &rest ignored) - "`company-mode' completion back-end for Clang. -Clang is a parser for C and ObjC. Clang version 1.1 or newer is required. - -Additional command line arguments can be specified in -`company-clang-arguments'. Prefix files (-include ...) can be selected -with `company-clang-set-prefix' or automatically through a custom -`company-clang-prefix-guesser'. - -With Clang versions before 2.9, we have to save the buffer before -performing completion. With Clang 2.9 and later, buffer contents are -passed via standard input." - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'company-clang)) - (init (when (memq major-mode company-clang-modes) - (unless company-clang-executable - (error "Company found no clang executable")) - (setq company-clang--version (company-clang-version)) - (when (< company-clang--version company-clang-required-version) - (error "Company requires clang version 1.1")))) - (prefix (and (memq major-mode company-clang-modes) - buffer-file-name - company-clang-executable - (not (company-in-string-or-comment)) - (or (company-clang--prefix) 'stop))) - (candidates (cons :async - (lambda (cb) (company-clang--candidates arg cb)))) - (meta (company-clang--meta arg)) - (annotation (company-clang--annotation arg)) - (post-completion (let ((anno (company-clang--annotation arg))) - (when (and company-clang-insert-arguments anno) - (insert anno) - (if (string-match "\\`:[^:]" anno) - (company-clang-objc-templatify anno) - (company-template-c-like-templatify - (concat arg anno)))))))) - -(provide 'company-clang) -;;; company-clang.el ends here diff --git a/packages/company-0.8.7/company-cmake.el b/packages/company-0.8.7/company-cmake.el deleted file mode 100644 index a466f60..0000000 --- a/packages/company-0.8.7/company-cmake.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; company-cmake.el --- company-mode completion back-end for CMake - -;; Copyright (C) 2013 Free Software Foundation, Inc. - -;; Author: Chen Bin -;; 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 . - -;;; Commentary: -;; -;; company-cmake offers completions for module names, variable names and -;; commands used by CMake. And their descriptions. - -;;; Code: - -(require 'company) -(require 'cl-lib) - -(defgroup company-cmake nil - "Completion back-end for CMake." - :group 'company) - -(defcustom company-cmake-executable - (executable-find "cmake") - "Location of cmake executable." - :type 'file) - -(defvar company-cmake-executable-arguments - '("--help-command-list" - "--help-module-list" - "--help-variable-list") - "The arguments we pass to cmake, separately. -They affect which types of symbols we get completion candidates for.") - -(defvar company-cmake--completion-pattern - "^\\(%s[a-zA-Z0-9_]%s\\)$" - "Regexp to match the candidates.") - -(defvar company-cmake-modes '(cmake-mode) - "Major modes in which cmake may complete.") - -(defvar company-cmake--meta-command-cache nil - "Cache for command arguments to retrieve descriptions for the candidates.") - -(defun company-cmake--parse-output (prefix cmd) - "Analyze the temp buffer and collect lines." - (goto-char (point-min)) - (let ((pattern (format company-cmake--completion-pattern - (regexp-quote prefix) - (if (zerop (length prefix)) "+" "*"))) - (case-fold-search nil) - lines match) - (while (re-search-forward pattern nil t) - (setq match (match-string-no-properties 1)) - (puthash match cmd company-cmake--meta-command-cache) - (push match lines)) - lines)) - -(defun company-cmake--candidates (prefix) - (let ((res 0) - results - cmd) - (setq company-cmake--meta-command-cache (make-hash-table :test 'equal)) - (dolist (arg company-cmake-executable-arguments) - (with-temp-buffer - (setq res (call-process company-cmake-executable nil t nil arg)) - (unless (eq 0 res) - (message "cmake executable exited with error=%d" res)) - (setq cmd (replace-regexp-in-string "-list$" "" arg) ) - (setq results (nconc results (company-cmake--parse-output prefix cmd))))) - results)) - -(defun company-cmake--meta (prefix) - (let ((cmd-opts (gethash prefix company-cmake--meta-command-cache)) - result) - (with-temp-buffer - (call-process company-cmake-executable nil t nil cmd-opts prefix) - ;; Go to the third line, trim it and return the result. - ;; Tested with cmake 2.8.9. - (goto-char (point-min)) - (forward-line 2) - (setq result (buffer-substring-no-properties (line-beginning-position) - (line-end-position))) - (setq result (replace-regexp-in-string "^[ \t\n\r]+" "" result)) - result))) - -(defun company-cmake--doc-buffer (prefix) - (let ((cmd-opts (gethash prefix company-cmake--meta-command-cache))) - (with-temp-buffer - (call-process company-cmake-executable nil t nil cmd-opts prefix) - ;; Go to the third line, trim it and return the doc buffer. - ;; Tested with cmake 2.8.9. - (goto-char (point-min)) - (forward-line 2) - (company-doc-buffer - (buffer-substring-no-properties (line-beginning-position) - (point-max)))))) - -(defun company-cmake (command &optional arg &rest ignored) - "`company-mode' completion back-end for CMake. -CMake is a cross-platform, open-source make system." - (interactive (list 'interactive)) - (cl-case command - (interactive (company-begin-backend 'company-cmake)) - (init (when (memq major-mode company-cmake-modes) - (unless company-cmake-executable - (error "Company found no cmake executable")))) - (prefix (and (memq major-mode company-cmake-modes) - (not (company-in-string-or-comment)) - (company-grab-symbol))) - (candidates (company-cmake--candidates arg)) - (meta (company-cmake--meta arg)) - (doc-buffer (company-cmake--doc-buffer arg)) - )) - -(provide 'company-cmake) -;;; company-cmake.el ends here diff --git a/packages/company-0.8.7/company-css.el b/packages/company-0.8.7/company-css.el deleted file mode 100644 index ec48653..0000000 --- a/packages/company-0.8.7/company-css.el +++ /dev/null @@ -1,438 +0,0 @@ -;;; company-css.el --- company-mode completion back-end for css-mode -*- lexical-binding: t -*- - -;; Copyright (C) 2009, 2011, 2014 Free Software Foundation, Inc. - -;; Author: Nikolaj Schumacher - -;; This file is part of GNU 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 . - -;;; Commentary: - -;;; Code: - -(require 'company) -(require 'cl-lib) - -(defconst company-css-property-alist - ;; see http://www.w3.org/TR/CSS21/propidx.html - '(("azimuth" angle "left-side" "far-left" "left" "center-left" "center" - "center-right" "right" "far-right" "right-side" "behind" "leftwards" - "rightwards") - ("background" background-color background-image background-repeat - background-attachment background-position - background-clip background-origin background-size) - ("background-attachment" "scroll" "fixed") - ("background-color" color "transparent") - ("background-image" uri "none") - ("background-position" percentage length "left" "center" "right" percentage - length "top" "center" "bottom" "left" "center" "right" "top" "center" - "bottom") - ("background-repeat" "repeat" "repeat-x" "repeat-y" "no-repeat") - ("border" border-width border-style border-color) - ("border-bottom" border) - ("border-bottom-color" border-color) - ("border-bottom-style" border-style) - ("border-bottom-width" border-width) - ("border-collapse" "collapse" "separate") - ("border-color" color "transparent") - ("border-left" border) - ("border-left-color" border-color) - ("border-left-style" border-style) - ("border-left-width" border-width) - ("border-right" border) - ("border-right-color" border-color) - ("border-right-style" border-style) - ("border-right-width" border-width) - ("border-spacing" length length) - ("border-style" border-style) - ("border-top" border) - ("border-top-color" border-color) - ("border-top-style" border-style) - ("border-top-width" border-width) - ("border-width" border-width) - ("bottom" length percentage "auto") - ("caption-side" "top" "bottom") - ("clear" "none" "left" "right" "both") - ("clip" shape "auto") - ("color" color) - ("content" "normal" "none" string uri counter "attr()" "open-quote" - "close-quote" "no-open-quote" "no-close-quote") - ("counter-increment" identifier integer "none") - ("counter-reset" identifier integer "none") - ("cue" cue-before cue-after) - ("cue-after" uri "none") - ("cue-before" uri "none") - ("cursor" uri "*" "auto" "crosshair" "default" "pointer" "move" "e-resize" - "ne-resize" "nw-resize" "n-resize" "se-resize" "sw-resize" "s-resize" - "w-resize" "text" "wait" "help" "progress") - ("direction" "ltr" "rtl") - ("display" "inline" "block" "list-item" "run-in" "inline-block" "table" - "inline-table" "table-row-group" "table-header-group" "table-footer-group" - "table-row" "table-column-group" "table-column" "table-cell" - "table-caption" "none") - ("elevation" angle "below" "level" "above" "higher" "lower") - ("empty-cells" "show" "hide") - ("float" "left" "right" "none") - ("font" font-style font-weight font-size "/" line-height - font-family "caption" "icon" "menu" "message-box" "small-caption" - "status-bar" "normal" "small-caps" - ;; CSS3 - font-stretch) - ("font-family" family-name generic-family) - ("font-size" absolute-size relative-size length percentage) - ("font-style" "normal" "italic" "oblique") - ("font-weight" "normal" "bold" "bolder" "lighter" "100" "200" "300" "400" - "500" "600" "700" "800" "900") - ("height" length percentage "auto") - ("left" length percentage "auto") - ("letter-spacing" "normal" length) - ("line-height" "normal" number length percentage) - ("list-style" list-style-type list-style-position list-style-image) - ("list-style-image" uri "none") - ("list-style-position" "inside" "outside") - ("list-style-type" "disc" "circle" "square" "decimal" "decimal-leading-zero" - "lower-roman" "upper-roman" "lower-greek" "lower-latin" "upper-latin" - "armenian" "georgian" "lower-alpha" "upper-alpha" "none") - ("margin" margin-width) - ("margin-bottom" margin-width) - ("margin-left" margin-width) - ("margin-right" margin-width) - ("margin-top" margin-width) - ("max-height" length percentage "none") - ("max-width" length percentage "none") - ("min-height" length percentage) - ("min-width" length percentage) - ("orphans" integer) - ("outline" outline-color outline-style outline-width) - ("outline-color" color "invert") - ("outline-style" border-style) - ("outline-width" border-width) - ("overflow" "visible" "hidden" "scroll" "auto" - ;; CSS3: - "no-display" "no-content") - ("padding" padding-width) - ("padding-bottom" padding-width) - ("padding-left" padding-width) - ("padding-right" padding-width) - ("padding-top" padding-width) - ("page-break-after" "auto" "always" "avoid" "left" "right") - ("page-break-before" "auto" "always" "avoid" "left" "right") - ("page-break-inside" "avoid" "auto") - ("pause" time percentage) - ("pause-after" time percentage) - ("pause-before" time percentage) - ("pitch" frequency "x-low" "low" "medium" "high" "x-high") - ("pitch-range" number) - ("play-during" uri "mix" "repeat" "auto" "none") - ("position" "static" "relative" "absolute" "fixed") - ("quotes" string string "none") - ("richness" number) - ("right" length percentage "auto") - ("speak" "normal" "none" "spell-out") - ("speak-header" "once" "always") - ("speak-numeral" "digits" "continuous") - ("speak-punctuation" "code" "none") - ("speech-rate" number "x-slow" "slow" "medium" "fast" "x-fast" "faster" - "slower") - ("stress" number) - ("table-layout" "auto" "fixed") - ("text-align" "left" "right" "center" "justify") - ("text-indent" length percentage) - ("text-transform" "capitalize" "uppercase" "lowercase" "none") - ("top" length percentage "auto") - ("unicode-bidi" "normal" "embed" "bidi-override") - ("vertical-align" "baseline" "sub" "super" "top" "text-top" "middle" - "bottom" "text-bottom" percentage length) - ("visibility" "visible" "hidden" "collapse") - ("voice-family" specific-voice generic-voice "*" specific-voice - generic-voice) - ("volume" number percentage "silent" "x-soft" "soft" "medium" "loud" - "x-loud") - ("white-space" "normal" "pre" "nowrap" "pre-wrap" "pre-line") - ("widows" integer) - ("width" length percentage "auto") - ("word-spacing" "normal" length) - ("z-index" "auto" integer) - ;; CSS3 - ("align-content" align-stretch "space-between" "space-around") - ("align-items" align-stretch "baseline") - ("align-self" align-items "auto") - ("animation" animation-name animation-duration animation-timing-function - animation-delay animation-iteration-count animation-direction - animation-fill-mode) - ("animation-delay" time) - ("animation-direction" "normal" "reverse" "alternate" "alternate-reverse") - ("animation-duration" time) - ("animation-fill-mode" "none" "forwards" "backwards" "both") - ("animation-iteration-count" integer "infinite") - ("animation-name" "none") - ("animation-play-state" "paused" "running") - ("animation-timing-function" transition-timing-function - "step-start" "step-end" "steps(,)") - ("backface-visibility" "visible" "hidden") - ("background-clip" background-origin) - ("background-origin" "border-box" "padding-box" "content-box") - ("background-size" length percentage "auto" "cover" "contain") - ("border-image" border-image-outset border-image-repeat border-image-source - border-image-slice border-image-width) - ("border-image-outset" length) - ("border-image-repeat" "stretch" "repeat" "round" "space") - ("border-image-source" uri "none") - ("border-image-slice" length) - ("border-image-width" length percentage) - ("border-radius" length) - ("border-top-left-radius" length) - ("border-top-right-radius" length) - ("border-bottom-left-radius" length) - ("border-bottom-right-radius" length) - ("box-decoration-break" "slice" "clone") - ("box-shadow" length color) - ("box-sizing" "content-box" "border-box") - ("break-after" "auto" "always" "avoid" "left" "right" "page" "column" - "avoid-page" "avoid-column") - ("break-before" break-after) - ("break-inside" "avoid" "auto") - ("columns" column-width column-count) - ("column-count" integer) - ("column-fill" "auto" "balance") - ("column-gap" length "normal") - ("column-rule" column-rule-width column-rule-style column-rule-color) - ("column-rule-color" color) - ("column-rule-style" border-style) - ("column-rule-width" border-width) - ("column-span" "all" "none") - ("column-width" length "auto") - ("filter" url "blur()" "brightness()" "contrast()" "drop-shadow()" - "grayscale()" "hue-rotate()" "invert()" "opacity()" "saturate()" "sepia()") - ("flex" flex-grow flex-shrink flex-basis) - ("flex-basis" percentage length "auto") - ("flex-direction" "row" "row-reverse" "column" "column-reverse") - ("flex-flow" flex-direction flex-wrap) - ("flex-grow" number) - ("flex-shrink" number) - ("flex-wrap" "nowrap" "wrap" "wrap-reverse") - ("font-feature-setting" normal string number) - ("font-kerning" "auto" "normal" "none") - ("font-language-override" "normal" string) - ("font-size-adjust" "none" number) - ("font-stretch" "normal" "ultra-condensed" "extra-condensed" "condensed" - "semi-condensed" "semi-expanded" "expanded" "extra-expanded" "ultra-expanded") - ("font-synthesis" "none" "weight" "style") - ("font-variant" font-variant-alternates font-variant-caps - font-variant-east-asian font-variant-ligatures font-variant-numeric - font-variant-position) - ("font-variant-alternates" "normal" "historical-forms" "stylistic()" - "styleset()" "character-variant()" "swash()" "ornaments()" "annotation()") - ("font-variant-caps" "normal" "small-caps" "all-small-caps" "petite-caps" - "all-petite-caps" "unicase" "titling-caps") - ("font-variant-east-asian" "jis78" "jis83" "jis90" "jis04" "simplified" - "traditional" "full-width" "proportional-width" "ruby") - ("font-variant-ligatures" "normal" "none" "common-ligatures" - "no-common-ligatures" "discretionary-ligatures" "no-discretionary-ligatures" - "historical-ligatures" "no-historical-ligatures" "contextual" "no-contextual") - ("font-variant-numeric" "normal" "ordinal" "slashed-zero" - "lining-nums" "oldstyle-nums" "proportional-nums" "tabular-nums" - "diagonal-fractions" "stacked-fractions") - ("font-variant-position" "normal" "sub" "super") - ("hyphens" "none" "manual" "auto") - ("justify-content" align-common "space-between" "space-around") - ("line-break" "auto" "loose" "normal" "strict") - ("marquee-direction" "forward" "reverse") - ("marquee-play-count" integer "infinite") - ("marquee-speed" "slow" "normal" "fast") - ("marquee-style" "scroll" "slide" "alternate") - ("opacity" number) - ("order" number) - ("outline-offset" length) - ("overflow-x" overflow) - ("overflow-y" overflow) - ("overflow-style" "auto" "marquee-line" "marquee-block") - ("overflow-wrap" "normal" "break-word") - ("perspective" "none" length) - ("perspective-origin" percentage length "left" "center" "right" "top" "bottom") - ("resize" "none" "both" "horizontal" "vertical") - ("tab-size" integer length) - ("text-align-last" "auto" "start" "end" "left" "right" "center" "justify") - ("text-decoration" text-decoration-color text-decoration-line text-decoration-style) - ("text-decoration-color" color) - ("text-decoration-line" "none" "underline" "overline" "line-through" "blink") - ("text-decoration-style" "solid" "double" "dotted" "dashed" "wavy") - ("text-overflow" "clip" "ellipsis") - ("text-shadow" color length) - ("text-underline-position" "auto" "under" "left" "right") - ("transform" "matrix(,,,,,)" "translate(,)" "translateX()" "translateY()" - "scale()" "scaleX()" "scaleY()" "rotate()" "skewX()" "skewY()" "none") - ("transform-origin" perspective-origin) - ("transform-style" "flat" "preserve-3d") - ("transition" transition-property transition-duration - transition-timing-function transition-delay) - ("transition-delay" time) - ("transition-duration" time) - ("transition-timing-function" - "ease" "linear" "ease-in" "ease-out" "ease-in-out" "cubic-bezier(,,,)") - ("transition-property" "none" "all" identifier) - ("word-wrap" overflow-wrap) - ("word-break" "normal" "break-all" "keep-all")) - "A list of CSS properties and their possible values.") - -(defconst company-css-value-classes - '((absolute-size "xx-small" "x-small" "small" "medium" "large" "x-large" - "xx-large") - (align-common "flex-start" "flex-end" "center") - (align-stretch align-common "stretch") - (border-style "none" "hidden" "dotted" "dashed" "solid" "double" "groove" - "ridge" "inset" "outset") - (border-width "thick" "medium" "thin") - (color "aqua" "black" "blue" "fuchsia" "gray" "green" "lime" "maroon" "navy" - "olive" "orange" "purple" "red" "silver" "teal" "white" "yellow") - (counter "counter(,)") - (family-name "Courier" "Helvetica" "Times") - (generic-family "serif" "sans-serif" "cursive" "fantasy" "monospace") - (generic-voice "male" "female" "child") - (margin-width "auto") ;; length percentage - (relative-size "larger" "smaller") - (shape "rect(,,,)") - (uri "url()")) - "A list of CSS property value classes and their contents.") -;; missing, because not completable -;; -;;