blob: 79a1b4e4e90a95e1a31b015abd2d45c8bad0ae3b (
plain)
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
|
(define (all-environment-exports environment prefix)
(if environment
(append (filter (lambda (identifier)
(if (string=? prefix "")
#t
(string-contains identifier prefix)))
(map symbol->string (env-exports environment)))
(all-environment-exports (env-parent environment) prefix))
'()))
(define (geiser:completions prefix . rest)
rest
(sort (all-environment-exports (current-environment) prefix)
string-ci<?))
(define (write-to-string form)
(let ((out (open-output-string)))
(write form out)
(get-output-string out)))
(define (geiser:eval module form . rest)
rest
(let ((output (open-output-string))
(result (if module
(let ((mod (module-env (find-module module))))
(eval form mod))
(eval form))))
(write `((result ,(write-to-string result))
(output . ,(get-output-string output))))
(values)))
(define (geiser:module-completions prefix . rest)
;; (available-modules) walks the directory tree and is too slow
(let ((modules (map car *modules*)))
(map write-to-string
(delete-duplicates
(filter (lambda (module)
(if (string=? "" prefix)
#t
(string-contains prefix (write-to-string module))))
modules)))))
(define (procedure-arglist id fun)
(let ((arglist (lambda-params (procedure-analysis fun))))
(if (pair? arglist)
(let loop ((arglist arglist)
(optionals? #f)
(required '())
(optional '()))
(cond ((null? arglist)
`(,id ("args" (("required" ,@(reverse required))
("optional" ,@(reverse optional))
("key")
("module" ,(let ((mod (containing-module fun))) (if mod (car mod) #f)))))))
((symbol? arglist)
(loop '()
#t
required
(cons "..." (cons arglist optional))))
(else
(loop
(cdr arglist)
optionals?
(if optionals? required (cons (car arglist) required))
(if optionals? (cons (car arglist) optional) optional)))))
'())))
(define (geiser:operator-arglist id)
(let ((binding (eval id)))
(cond ((procedure? binding)
(if (opcode? binding)
'()
(procedure-arglist id binding)))
(else
'()))))
(define (geiser:autodoc ids . rest)
rest
(cond ((null? ids) '())
((not (list? ids))
(geiser:autodoc (list ids)))
((not (symbol? (car ids)))
(geiser:autodoc (cdr ids)))
(else
(map (lambda (id)
(geiser:operator-arglist id))
ids))))
(define (geiser:no-values)
#f)
(define (geiser:newline)
#f)
|
