scheme/chibi/geiser/geiser.scm

   1 (define (all-environment-exports environment prefix)
   2   (if environment
   3       (append (filter (lambda (identifier)
   4                         (if (string=? prefix "")
   5                             #t
   6                             (string-contains identifier prefix)))
   7                       (map symbol->string (env-exports environment)))
   8               (all-environment-exports (env-parent environment) prefix))
   9       '()))
  10
  11 (define (geiser:completions prefix . rest)
  12   rest
  13   (sort (all-environment-exports (current-environment) prefix)
  14         string-ci<?))
  15
  16 (define (write-to-string form)
  17   (let ((out (open-output-string)))
  18     (write form out)
  19     (get-output-string out)))
  20
  21 (define (geiser:eval module form . rest)
  22   rest
  23   (let ((output (open-output-string))
  24         (result (if module
  25                     (let ((mod (module-env (find-module module))))
  26                       (eval form mod))
  27                     (eval form))))
  28     (write `((result ,(write-to-string result))
  29              (output . ,(get-output-string output))))
  30     (values)))
  31
  32 (define (geiser:module-completions prefix . rest)
  33   ;; (available-modules) walks the directory tree and is too slow
  34   (let ((modules (map car *modules*)))
  35     (map write-to-string
  36          (delete-duplicates
  37           (filter (lambda (module)
  38                     (if (string=? "" prefix)
  39                         #t
  40                         (string-contains prefix (write-to-string module))))
  41                   modules)))))
  42
  43 (define (procedure-arglist id fun)
  44   (let ((arglist (lambda-params (procedure-analysis fun))))
  45     (if (pair? arglist)
  46         (let loop ((arglist arglist)
  47                    (optionals? #f)
  48                    (required '())
  49                    (optional '()))
  50           (cond ((null? arglist)
  51                  `(,id ("args" (("required" ,@(reverse required))
  52                                 ("optional" ,@(reverse optional))
  53                                 ("key")
  54                                 ("module" ,(let ((mod (containing-module fun))) (if mod (car mod) #f)))))))
  55                 ((symbol? arglist)
  56                  (loop '()
  57                        #t
  58                        required
  59                        (cons "..." (cons arglist optional))))
  60                 (else
  61                  (loop
  62                   (cdr arglist)
  63                   optionals?
  64                   (if optionals? required (cons (car arglist) required))
  65                   (if optionals? (cons (car arglist) optional) optional)))))
  66         '())))
  67
  68 (define (geiser:operator-arglist id)
  69   (let ((binding (eval id)))
  70     (cond ((procedure? binding)
  71            (if (opcode? binding)
  72                '()
  73                (procedure-arglist id binding)))
  74           (else
  75            '()))))
  76
  77 (define (geiser:autodoc ids . rest)
  78   rest
  79   (cond ((null? ids) '())
  80         ((not (list? ids))
  81          (geiser:autodoc (list ids)))
  82         ((not (symbol? (car ids)))
  83          (geiser:autodoc (cdr ids)))
  84         (else
  85          (map (lambda (id)
  86                 (geiser:operator-arglist id))
  87               ids))))
  88
  89 (define (geiser:no-values)
  90   #f)
  91
  92 (define (geiser:newline)
  93   #f)