Skip to content

Instantly share code, notes, and snippets.

Created Apr 11, 2021
What would you like to do?
Extend cider eldoc to pick up `recur` targets
(defun cider-eldoc--get-recur-targets ()
"Return a list of bindings from the nearest loop or fn form."
(let ((end (point))
pair? res)
(while (not (looking-at "(\\(loop\\|defn-?\\|defmacro\\|fn\\)\\_>"))
(condition-case nil
(setq pair? (string= (match-string 1) "loop"))
;; Step inside the form
(forward-char 1)
;; Look for a binding vector
(while (not (looking-at-p (if pair? "\\[" "(?\\[")))
(cider-start-of-next-sexp 1)))
;; Multi-arity function - goto the () containing original point
(when (eq (char-after) ?\()
(while (< (point) end)
(forward-char 1))
;; Step inside the vector
(forward-char 1)
(clojure-forward-logical-sexp 1)
(while (< (point) end)
(let ((binding (thing-at-point 'sexp)))
;; Simplify destructured bindings if possible by looking for :as
(when (string-match ":as[[:space:]\n\t]+\\(\\(?:\\sw\\|\\s_\\)+\\)"
(setq binding (match-string 1 binding)))
(push binding res))
(clojure-forward-logical-sexp (if pair? 2 1))))
(list (reverse res))))
;; Patch the function cider-eldoc-info:
(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")
;; ignore blank things
(not (string-blank-p thing))
;; ignore string literals
(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
;; handle keywords for map access
((string-prefix-p ":" thing) (list "symbol" thing
"type" "function"
"arglists" '(("map") ("map" "not-found"))))
;; handle `recur' special form by getting the bindings in
;; the parent loop / fn form
((string= "recur" thing)
(list "symbol" thing
"type" "function"
"arglists" (cider-eldoc--get-recur-targets)))
;; 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 "")))
(name-or-member (if (and name (not (string= 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
;; 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)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment