about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el
diff options
context:
space:
mode:
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el481
1 files changed, 0 insertions, 481 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el b/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el
deleted file mode 100644
index b055824df3df..000000000000
--- a/configs/shared/emacs/.emacs.d/elpa/cider-20180908.1925/cider-eldoc.el
+++ /dev/null
@@ -1,481 +0,0 @@
-;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*-
-
-;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov
-;; Copyright © 2013-2018 Bozhidar Batsov, Artur Malabarba and CIDER contributors
-;;
-;; Author: Tim King <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