diff options
| -rw-r--r-- | geiser/introspection.scm | 31 |
1 files changed, 27 insertions, 4 deletions
diff --git a/geiser/introspection.scm b/geiser/introspection.scm index 7e468e7..fd6784d 100644 --- a/geiser/introspection.scm +++ b/geiser/introspection.scm @@ -149,10 +149,33 @@ The alist keys that are currently defined are `required', `optional', ,@(if rest (list (cons 'rest 'rest)) '()))))) (else #f))) -(define (completions prefix) - (sort! (map symbol->string - (apropos-internal (string-append "^" prefix))) - string<?)) +(define (completions prefix . context) + (let ((context (and (not (null? context)) (car context))) + (prefix (string-append "^" (regexp-quote prefix)))) + (append (filter (lambda (s) (string-match prefix s)) + (map symbol->string (local-bindings context))) + (sort! (map symbol->string (apropos-internal prefix)) string<?)))) + +(define (local-bindings form) + (define (body f) (if (> (length f) 2) (cddr f) '())) + (define (decl-list d) + (let loop ((d d) (s '())) + (cond ((null? d) s) + ((symbol? d) (cons d s)) + (else (loop (cdr d) (cons (car d) s)))))) + (let loop ((form form) (bindings '())) + (cond ((not (pair? form)) bindings) + ((list? (car form)) + (loop (cdr form) (append (local-bindings (car form)) bindings))) + ((and (list? form) (< (length form) 2)) bindings) + ((memq (car form) '(define define* lambda)) + (loop (body form) (append (decl-list (cadr form)) bindings))) + ((and (memq (car form) '(let let* letrec letrec*)) + (list? (cadr form))) + (loop (body form) (append (map car (cadr form)) bindings))) + ((and (eq? 'let (car form)) (symbol? (cadr form))) + (loop (cons 'let (body form)) (cons (cadr form) bindings))) + (else (loop (cdr form) bindings))))) (define (module-location name) (make-location (module-filename name) #f)) |