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