about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/cider-20180719.542/cider-eldoc.el
blob: b055824df3df175d8a5aaa038e66c6c86600b513 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
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