Remove ignored files

elpa/geiser-20180626.440/scheme/chez/geiser/geiser.ss

@@ -0,0 +1,152 @@
+(library (geiser)
+  (export geiser:eval
+          geiser:completions
+          geiser:module-completions
+          geiser:autodoc
+          geiser:no-values
+	  geiser:load-file
+          geiser:newline)
+  (import (chezscheme))
+
+  (define (last-index-of str-list char idx last-idx)
+    (if (null? str-list)
+	last-idx
+	(last-index-of (cdr str-list) char (+ 1 idx) (if (char=? char (car str-list)) idx last-idx))))
+
+  (define (obj-file-name name)
+    (let ((idx (last-index-of (string->list name) #\. 0 -1)))
+      (if (= idx -1)
+	  (string-append name ".so")
+	  (string-append (substring name 0 idx) ".so"))))
+
+  (define (geiser:load-file filename)
+    (let ((output-filename (obj-file-name filename)))
+      (maybe-compile-file filename output-filename)
+      (load output-filename)))
+
+  (define string-prefix?
+    (lambda (x y)
+      (let ([n (string-length x)])
+        (and (fx<= n (string-length y))
+             (let prefix? ([i 0])
+               (or (fx= i n)
+                   (and (char=? (string-ref x i) (string-ref y i))
+                        (prefix? (fx+ i 1)))))))))
+
+  (define (geiser:completions prefix . rest)
+    rest
+    (sort string-ci<?
+          (filter (lambda (el)
+                    (string-prefix? prefix el))
+                  (map write-to-string (environment-symbols (interaction-environment))))))
+
+  (define (write-to-string x)
+    (with-output-to-string
+      (lambda ()
+        (write x))))
+
+  (define (geiser:eval module form . rest)
+    rest
+    (let* ((body (lambda ()
+		   (if module
+		       (eval form (environment module))
+		       (eval form))))
+	   (gen-result (lambda (result-mid is-error?)
+			 (if is-error?
+			     `((result "")
+			       (output . "")
+			       (error . ,(list
+					(cons 'key
+					      (with-output-to-string
+						(lambda ()
+						  (display-condition result-mid)))))))
+			     `((result ,(with-output-to-string
+					  (lambda ()
+					    (pretty-print result-mid))))
+			       (output . "")))))
+	   (result (call/cc
+		    (lambda (k)
+		      (with-exception-handler
+			  (lambda (e)
+			    (k (gen-result e #t)))
+			(lambda ()
+			  (call-with-values
+			      (lambda ()
+				(body))
+			    (lambda (x . y)
+			      (if (null? y)
+				  (k (gen-result x #f))
+				  (k (gen-result (cons x y) #f)))))))))))
+      (write result)
+      (newline)))
+
+  (define (geiser:module-completions prefix . rest)
+    (define (substring? s1 s2)
+      (let ([n1 (string-length s1)] [n2 (string-length s2)])
+        (let loop2 ([i2 0])
+          (let loop1 ([i1 0] [j i2])
+            (if (fx= i1 n1)
+                i2
+                (and (not (fx= j n2))
+                     (if (char=? (string-ref s1 i1) (string-ref s2 j))
+                         (loop1 (fx+ i1 1) (fx+ j 1))
+                         (loop2 (fx+ i2 1)))))))))
+    (filter (lambda (el)
+              (substring? prefix el))
+            (map write-to-string (library-list))))
+
+  (define (procedure-parameter-list p)
+    ;; same as (inspect object), then hitting c
+    (let ((s (((inspect/object p) 'code) 'source)))
+      (if s
+          (let ((form (s 'value)))
+            (if (and (list? form)
+                     (> (length form) 2)
+                     (eq? (car form) 'lambda))
+                (cadr form)
+                #f))
+          #f)))
+
+  (define (operator-arglist operator)
+    (let ((binding (eval operator)))
+      (if binding
+          (let ((arglist (procedure-parameter-list binding)))
+            (let loop ((arglist arglist)
+                       (optionals? #f)
+                       (required '())
+                       (optional '()))
+              (cond ((null? arglist)
+                     `(,operator ("args" (("required" ,@(reverse required))
+                                          ("optional" ,@(reverse optional))
+                                          ("key")
+                                          ;; ("module" ,module)
+                                          ))))
+                    ((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:autodoc ids . rest)
+    (cond ((null? ids) '())
+          ((not (list? ids))
+           (geiser:autodoc (list ids)))
+          ((not (symbol? (car ids)))
+           (geiser:autodoc (cdr ids)))
+          (else
+           (map (lambda (id)
+                  (operator-arglist id))
+                ids))))
+
+  (define (geiser:no-values)
+    #f)
+
+  (define (geiser:newline)
+    #f))

elpa/geiser-20180626.440/scheme/chez/geiser/test.ss

@@ -0,0 +1,90 @@
+(import (geiser)
+	(chezscheme))
+
+
+(define-syntax get-result
+  (syntax-rules ()
+    ((_ form)
+     (with-output-to-string
+       (lambda ()
+	 (geiser:eval #f form))))))
+
+(define-syntax do-test
+  (syntax-rules ()
+    ((_ form result)
+     (assert
+      (equal?
+       (get-result form)
+       result)))))
+
+;; (something-doesnot-exist)
+;;=> Error: Exception: variable something-doesnot-exist is not bound
+(do-test
+ '(something-doesnot-exist)
+ "((result \"\") (output . \"\") (error (key . \"Exception: variable something-doesnot-exist is not bound\")))\n"
+ )
+
+;; (make-violation)
+;;=> #<condition &violation>
+(do-test
+ '(make-violation) 
+ "((result \"#<condition &violation>\\n\") (output . \"\"))\n")
+
+;; (values 1 2 3)
+;;==> (1 2 3)
+(do-test
+ '(values 1 2 3)
+ "((result \"(1 2 3)\\n\") (output . \"\"))\n")
+
+;; 1
+;;=> 1
+(do-test '1 "((result \"1\\n\") (output . \"\"))\n")
+
+
+;; '(case-lambda
+;;    [(x1 x2) (+ x1 x2)]
+;;    [(x1 x2 x3) (+ (+ x1 x2) x3)]
+;;    [(x1 x2 . rest)
+;;     ((letrec ([loop (lambda (x1 x2 rest)
+;; 		      (let ([x (+ x1 x2)])
+;; 			(if (null? rest)
+;; 			    x
+;; 			    (loop x (car rest) (cdr rest)))))])
+;;        loop)
+;;      x1
+;;      x2
+;;      rest)]
+;;    [(x1) (+ x1)]
+;;    [() (+)])
+#|=> (case-lambda
+  [(x1 x2) (+ x1 x2)]
+  [(x1 x2 x3) (+ (+ x1 x2) x3)]
+  [(x1 x2 . rest)
+   ((letrec ([loop (lambda (x1 x2 rest)
+                     (let ([x (+ x1 x2)])
+                       (if (null? rest)
+                           x
+                           (loop x (car rest) (cdr rest)))))])
+      loop)
+     x1
+     x2
+     rest)]
+  [(x1) (+ x1)]
+  [() (+)])
+  |#
+(do-test (quote '(case-lambda
+  [(x1 x2) (+ x1 x2)]
+  [(x1 x2 x3) (+ (+ x1 x2) x3)]
+  [(x1 x2 . rest)
+   ((letrec ([loop (lambda (x1 x2 rest)
+                     (let ([x (+ x1 x2)])
+                       (if (null? rest)
+                           x
+                           (loop x (car rest) (cdr rest)))))])
+      loop)
+     x1
+     x2
+     rest)]
+  [(x1) (+ x1)]
+  [() (+)])) "((result \"(case-lambda\\n  [(x1 x2) (+ x1 x2)]\\n  [(x1 x2 x3) (+ (+ x1 x2) x3)]\\n  [(x1 x2 . rest)\\n   ((letrec ([loop (lambda (x1 x2 rest)\\n                     (let ([x (+ x1 x2)])\\n                       (if (null? rest)\\n                           x\\n                           (loop x (car rest) (cdr rest)))))])\\n      loop)\\n     x1\\n     x2\\n     rest)]\\n  [(x1) (+ x1)]\\n  [() (+)])\\n\") (output . \"\"))\n")
+

elpa/geiser-20180626.440/scheme/chibi/geiser/geiser.scm

@@ -0,0 +1,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)

elpa/geiser-20180626.440/scheme/chibi/geiser/geiser.sld

@@ -0,0 +1,9 @@
+(define-library (geiser)
+  (export geiser:completions
+          geiser:eval
+          geiser:autodoc
+          geiser:module-completions
+          geiser:no-values
+          geiser:newline)
+  (import (scheme small) (chibi modules) (chibi) (meta) (chibi ast) (chibi string) (srfi 1) (srfi 95))
+  (include "geiser.scm"))

elpa/geiser-20180626.440/scheme/chicken/geiser/emacs.scm

@@ -0,0 +1,687 @@
+;; -*- geiser-scheme-implementation: 'chicken
+
+;; Copyright (C) 2015 Daniel J Leslie
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+(module geiser
+  (geiser-eval
+   geiser-no-values
+   geiser-newline
+   geiser-start-server
+   geiser-completions
+   geiser-autodoc
+   geiser-object-signature
+   geiser-symbol-location
+   geiser-symbol-documentation
+   geiser-find-file
+   geiser-add-to-load-path
+   geiser-load-file
+   geiser-compile-file
+   geiser-compile
+   geiser-module-exports
+   geiser-module-path
+   geiser-module-location
+   geiser-module-completions
+   geiser-macroexpand
+   geiser-chicken-use-debug-log
+   geiser-chicken-load-paths)
+
+  (import chicken scheme)
+  (use
+    apropos
+    chicken-doc
+    data-structures
+    extras
+    ports
+    posix
+    srfi-1
+    srfi-13
+    srfi-14
+    srfi-18
+    srfi-69
+    tcp
+    utils)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Symbol lists
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
+  (define geiser-r4rs-symbols
+    (make-parameter
+     '(not boolean? eq? eqv? equal? pair? cons car cdr caar cadr cdar cddr
+           caaar caadr cadar caddr cdaar cdadr cddar cdddr caaaar caaadr caadar
+           caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar
+           cddadr cdddar cddddr set-car! set-cdr! null? list? list length
+           list-tail list-ref append reverse memq memv member assq assv assoc
+           symbol? symbol->string string->symbol number? integer? exact? real?
+           complex? inexact? rational? zero? odd? even? positive? negative?
+           max min + - * / = > < >= <= quotient remainder modulo gcd lcm abs
+           floor ceiling truncate round exact->inexact inexact->exact exp log
+           expt sqrt sin cos tan asin acos atan number->string string->number
+           char? char=? char>? char<? char>=? char<=? char-ci=? char-ci<?
+           char-ci>? char-ci>=? char-ci<=? char-alphabetic? char-whitespace?
+           char-numeric? char-upper-case? char-lower-case? char-upcase
+           char-downcase char->integer integer->char string? string=? string>?
+           string<? string>=? string<=? string-ci=? string-ci<? string-ci>?
+           string-ci>=? string-ci<=?  make-string string-length string-ref
+           string-set! string-append string-copy string->list list->string
+           substring string-fill! vector? make-vector vector-ref vector-set!
+           string vector vector-length vector->list list->vector vector-fill!
+           procedure? map for-each apply force call-with-current-continuation
+           input-port? output-port? current-input-port current-output-port
+           call-with-input-file call-with-output-file open-input-file
+           open-output-file close-input-port close-output-port load
+           read eof-object? read-char peek-char write display write-char
+           newline with-input-from-file with-output-to-file eval char-ready?
+           imag-part real-part magnitude numerator denominator
+           scheme-report-environment null-environment interaction-environment
+           else)))
+
+  (define geiser-r5rs-symbols
+    (make-parameter
+     '(abs acos and angle append apply asin assoc assq assv atan begin
+           boolean? caar cadr call-with-current-continuation
+           call-with-input-file call-with-output-file call-with-values
+           car case cdddar cddddr cdr ceiling char->integer char-alphabetic?
+           char-ci<=? char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase
+           char-lower-case? char-numeric? char-ready? char-upcase
+           char-upper-case? char-whitespace? char<=? char<? char=? char>=?
+           char>? char? close-input-port close-output-port complex? cond cons
+           cos current-input-port current-output-port define define-syntax
+           delay denominator display do dynamic-wind else eof-object? eq?
+           equal? eqv? eval even? exact->inexact exact? exp expt floor
+           for-each force gcd if imag-part inexact->exact inexact? input-port?
+           integer->char integer? interaction-environment lambda lcm length
+           let let* let-syntax letrec letrec-syntax list list->string
+           list->vector list-ref list-tail list? load log magnitude make-polar
+           make-rectangular make-string make-vector map max member memq memv
+           min modulo negative? newline not null-environment null?
+           number->string number? numerator odd? open-input-file
+           open-output-file or output-port? pair? peek-char port? positive?
+           procedure? quasiquote quote quotient rational? rationalize read
+           read-char real-part real? remainder reverse round
+           scheme-report-environment set! set-car! set-cdr! setcar sin sqrt
+           string string->list string->number string->symbol string-append
+           string-ci<=? string-ci<? string-ci=? string-ci>=? string-ci>?
+           string-copy string-fill! string-length string-ref string-set!
+           string<=? string<? string=? string>=? string>? string? substring
+           symbol->string symbol? syntax-rules tan transcript-off transcript-on
+           truncate values vector vector->list vector-fill! vector-length
+           vector-ref vector-set! vector? with-input-from-file with-output-to-file
+           write write-char zero?)))
+
+  (define geiser-r7rs-small-symbols
+    (make-parameter
+     '(* + - ... / < <= = => > >= abs and append apply assoc assq
+         assv begin binary-port? boolean=? boolean? bytevector
+         bytevector-append bytevector-copy bytevector-copy! bytevector-length
+         bytevector-u8-ref bytevector-u8-set! bytevector? caar cadr
+         call-with-current-continuation call-with-port call-with-values call/cc
+         car case cdar cddr cdr ceiling char->integer char-ready? char<=?
+         char<? char=? char>=? char>? char? close-input-port
+         close-output-port close-port complex? cond cond-expand cons
+         current-error-port current-input-port current-output-port
+         define define-record-type define-syntax define-values denominator do
+         dynamic-wind else eof-object? equal? error error-object-message
+         even? exact-integer-sqrt exact? features floor floor-remainder
+         flush-output-port gcd get-output-string if include-ci inexact?
+         input-port? integer? lcm let let*-values let-values letrec* list
+         list->vector list-ref list-tail make-bytevector make-parameter
+         make-vector max memq min negative? not number->string numerator
+         open-input-bytevector open-output-bytevector or output-port?
+         parameterize peek-u8 positive? quasiquote quotient raise-continuable
+         rationalize read-bytevector! read-error? read-string real? reverse
+         set! set-cdr! string string->number string->utf8 string-append
+         eof-object eq? eqv? error-object-irritants error-object? exact
+         exact-integer? expt file-error? floor-quotient floor/ for-each
+         get-output-bytevector guard include inexact input-port-open?
+         integer->char lambda length let* let-syntax letrec letrec-syntax
+         list->string list-copy list-set! list? make-list make-string map
+         member memv modulo newline null? number? odd? open-input-string
+         open-output-string output-port-open? pair? peek-char port?
+         procedure? quote raise rational? read-bytevector read-char read-line
+         read-u8 remainder round set-car! square string->list string->symbol
+         string->vector string-copy string-copy! string-for-each string-map
+         string-set! string<? string>=? string? symbol->string symbol?
+         syntax-rules truncate truncate-remainder u8-ready? unquote
+         utf8->string vector vector->string vector-copy vector-fill!
+         vector-length vector-ref vector? with-exception-handler write-char
+         write-u8 string-fill! string-length string-ref string<=?
+         string=? string>? substring symbol=? syntax-error textual-port?
+         truncate-quotient truncate/ unless unquote-splicing values
+         vector->list vector-append vector-copy! vector-for-each vector-map
+         vector-set! when write-bytevector write-string zero?)))
+
+  (define geiser-chicken-builtin-symbols
+    (make-parameter
+     '(and-let* assume compiler-typecase cond-expand condition-case cut cute declare define-constant
+                define-inline define-interface define-record define-record-type define-specialization
+                define-syntax-rule define-type define-values dotimes ecase fluid-let foreign-lambda
+                foreign-lambda* foreign-primitive foreign-safe-lambda foreign-safe-lambda* functor
+                handle-exceptions import let*-values let-location let-optionals let-optionals*
+                let-values letrec* letrec-values match-letrec module parameterize regex-case
+                require-extension select set! unless use when with-input-from-pipe match
+                match-lambda match-lambda* match-let match-let* receive)))
+
+  (define geiser-chicken-crunch-symbols
+    (make-parameter
+     '(* + - / < <= = > >= abs acos add1 argc argv-ref arithmetic-shift asin
+	 atan atan2 bitwise-and bitwise-ior bitwise-not bitwise-xor
+	 blob->f32vector blob->f32vector/shared blob->f64vector
+	 blob->f64vector/shared blob->s16vector blob->s16vector/shared
+	 blob->s32vector blob->s32vector/shared blob->s8vector
+	 blob->s8vector/shared blob->string blob->string/shared blob->u16vector
+	 blob->u16vector/shared blob->u32vector blob->u32vector/shared
+	 blob->u8vector blob->u8vector/shared ceiling char->integer
+	 char-alphabetic? char-ci<=? char-ci<? char-ci=? char-ci>=? char-ci>?
+	 char-downcase char-lower-case? char-numeric? char-upcase
+	 char-upper-case? char-whitespace? char<=? char<? char=? char>=? char>?
+	 cond-expand cos display display eq? equal? eqv? error even?
+	 exact->inexact exact? exit exp expt f32vector->blob
+	 f32vector->blob/shared f32vector-length f32vector-ref f32vector-set!
+	 f64vector->blob f64vector->blob/shared f64vector-length f64vector-ref
+	 f64vector-set! floor flush-output inexact->exact inexact?
+	 integer->char integer? log make-f32vector make-f64vector make-s16vector
+	 make-s32vector make-s8vector make-string make-u16vector make-u32vector
+	 make-u8vector max min modulo negative? newline not number->string odd?
+	 pointer-f32-ref pointer-f32-set! pointer-f64-ref pointer-f64-set!
+	 pointer-s16-ref pointer-s16-set! pointer-s32-ref pointer-s32-set!
+	 pointer-s8-ref pointer-s8-set! pointer-u16-ref pointer-u16-set!
+	 pointer-u32-ref pointer-u32-set! pointer-u8-ref pointer-u8-set!
+	 positive? quotient rec remainder round s16vector->blob
+	 s16vector->blob/shared s16vector-length s16vector-ref s16vector-set!
+	 s32vector->blob s32vector->blob/shared s32vector-length s32vector-ref
+	 s32vector-set! s8vector->blob s8vector->blob/shared s8vector-length
+	 s8vector-ref s8vector-set! sin sqrt string->blob string->blob/shared
+	 string->number string-append string-ci<=? string-ci<? string-ci=?
+	 string-ci>=? string-ci>? string-copy string-fill! string-length
+	 string-ref string-set! string<=? string<? string=? string>=? string>?
+	 sub1 subf32vector subf64vector subs16vector subs32vector subs8vector
+	 substring subu16vector subu32vector subu8vector switch tan truncate
+	 u16vector->blob u16vector->blob/shared u16vector-length u16vector-ref
+	 u16vector-set! u32vector->blob u32vector->blob/shared u32vector-length
+	 u32vector-ref u32vector-set! u8vector->blob u8vector->blob/shared
+	 u8vector-length u8vector-ref u8vector-set! unless void when write-char
+	 zero?)))
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Utilities
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define geiser-chicken-use-debug-log (make-parameter #f))
+
+  (define find-module ##sys#find-module)
+  (define current-module ##sys#current-module)
+  (define switch-module ##sys#switch-module)
+  (define module-name ##sys#module-name)
+  (define (list-modules) (map car ##sys#module-table))
+
+  (define empty-symbol (string->symbol ""))
+
+  (define (symbol-information-list partial-string)
+    (map (lambda (lst)
+	   (let* ((module (if (eq? empty-symbol (caar lst)) #f (caar lst)))
+		  (name (cdar lst)))
+	     (append (list name module) (cdr lst))))
+	 (apropos-information-list partial-string #:macros? #t)))
+  
+  (define debug-log (make-parameter #f))
+  (define (write-to-log form)
+    (when (geiser-chicken-use-debug-log)
+      (when (not (debug-log))
+	(debug-log (file-open "geiser.log" (+ open/wronly open/append open/text open/creat)))
+	(set-file-position! (debug-log) 0 seek/end))
+      (file-write (debug-log) (with-all-output-to-string (lambda () (write form) (newline))))
+      (file-write (debug-log) "\n")))
+
+  (define (string-has-prefix? s prefix)
+    (cond
+     ((= 0 (string-length prefix)) #t)
+     ((= 0 (string-length s)) #f)
+     ((eq? (string-ref s 0) (string-ref prefix 0))
+      (string-has-prefix? (substring/shared s 1) (substring/shared prefix 1)))
+     (else #f)))
+  
+  ;; This really should be a chicken library function
+  (define (write-exception exn)
+    (define (write-call-entry call)
+      (let ((type (vector-ref call 0))
+            (line (vector-ref call 1)))
+        (cond
+         ((equal? type "<syntax>")
+          (display (string-append type " ")) (write line) (newline))
+         ((equal? type "<eval>")
+          (display (string-append type "   ")) (write line) (newline)))))
+
+    (display (format "Error: (~s) ~s: ~s"
+                     ((condition-property-accessor 'exn 'location) exn)
+                     ((condition-property-accessor 'exn 'message) exn)
+                     ((condition-property-accessor 'exn 'arguments) exn)))
+    (newline)
+    (display "Call history: ") (newline)
+    (map write-call-entry ((condition-property-accessor 'exn 'call-chain) exn))
+    (newline))
+
+  ;; And this should be a chicken library function as well
+  (define (with-all-output-to-string thunk)
+    (with-output-to-string
+      (lambda ()
+        (with-error-output-to-port
+         (current-output-port)
+         thunk))))
+
+  (define (maybe-call func val)
+    (if val (func val) #f))
+
+  ;; Wraps output from geiser functions
+  (define (call-with-result module thunk)
+    (let* ((result (if #f #f))
+           (output (if #f #f))
+           (module (maybe-call (lambda (v) (find-module module)) module))
+           (original-module (current-module)))
+
+      (set! output
+            (handle-exceptions exn
+             (with-all-output-to-string
+              (lambda () (write-exception exn)))
+             (with-all-output-to-string
+              (lambda ()
+                (switch-module module)
+                (call-with-values thunk (lambda v (set! result v)))))))
+
+      (switch-module original-module)
+
+      (set! result
+        (cond
+         ((list? result)
+          (map (lambda (v) (with-output-to-string (lambda () (write v)))) result))
+         ((eq? result (if #f #t))
+          (list output))
+         (else
+          (list (with-output-to-string (lambda () (write result)))))))
+
+      (let ((out-form
+             `((result ,@result)
+               (output . ,output))))
+        (write out-form)
+	(write-to-log '[[RESPONSE]])
+        (write-to-log out-form))
+
+      (newline)))
+
+  (define (find-standards-with-symbol sym)
+    (append
+     (if (any (cut eq? <> sym) (geiser-r4rs-symbols))
+         '(r4rs)
+         '())
+     (if (any (cut eq? <> sym) (geiser-r5rs-symbols))
+         '(r5rs)
+         '())
+     (if (any (cut eq? <> sym) (geiser-r7rs-small-symbols))
+         '(r7rs)
+         '())
+     (if (any (cut eq? <> sym) (geiser-chicken-builtin-symbols))
+         '(chicken)
+         '())
+     (if (any (cut eq? <> sym) (geiser-chicken-crunch-symbols))
+	 '(crunch)
+	 '())))
+
+  ;; Locates any paths at which a particular symbol might be located
+  (define (find-library-paths sym types)
+    ;; Removes the given sym from the node path
+    (define (remove-self sym path)
+      (cond
+       ((not (list? path)) path)
+       ((null? path) path)
+       ((null? (cdr path))
+        (if (eq? (car path) sym)
+            '()
+            path))
+       (else
+        (cons (car path) (remove-self sym (cdr path))))))
+
+    (append
+     (map
+      (cut list <>)
+      (find-standards-with-symbol sym))
+     (map
+      (lambda (node)
+        (remove-self sym (node-path node)))
+      (filter
+       (lambda (n)
+         (let ((type (node-type n)))
+           (any (cut eq? type <>) types)))
+       (match-nodes sym)))))
+
+  (define (make-module-list sym module-sym)
+    (append
+     (if (not module-sym)
+	 (find-standards-with-symbol sym)
+	 (cons module-sym (find-standards-with-symbol sym)))))
+
+  (define (read* str)
+    (with-input-from-string str (lambda () (read))))
+  
+  (define (eval* str)
+    (cond
+     ((symbol? str) (eval str))
+     ((string? str) (eval (read* str)))
+     (else (eval* (->string str)))))
+  
+  (define (fmt node)
+    (let* ((mod (cadr node))
+	   (sym (car node))
+	   (rest (cddr node))
+	   (type (if (or (list? rest) (pair? rest)) (car rest) rest))
+	   (mod-list (make-module-list sym mod)))
+      (cond
+       ((equal? 'macro type)
+	`(,sym ("args" (("required" <macro>)
+			("optional" ...)
+			("key")))
+	       ("module" ,@mod-list)))
+       ((or (equal? 'variable type)
+	    (equal? 'constant type))
+	(if (not mod)
+	    `(,sym ("value" . ,(eval* sym)))
+	    (let* ((original-module (current-module))
+		   (desired-module (find-module mod))
+		   (value (begin (switch-module desired-module)
+				 (eval* sym))))
+	      (switch-module original-module)
+	      `(,sym ("value" . ,value)
+		     ("module" ,@mod-list)))))
+       (else
+	(let ((reqs '())
+	      (opts '())
+	      (keys '())
+	      (args (if (or (list? rest) (pair? rest)) (cdr rest) '())))
+
+	  (define (clean-arg arg)
+	    (let ((s (->string arg)))
+	      (read* (substring/shared s 0 (add1 (string-skip-right s char-set:digit))))))
+
+	  (define (collect-args args #!key (reqs? #t) (opts? #f) (keys? #f))
+	    (when (not (null? args))
+	      (cond
+	       ((or (pair? args) (list? args))
+		(cond
+		 ((eq? '#!key (car args))
+		  (collect-args (cdr args) reqs?: #f opts?: #f keys?: #t))
+		 ((eq? '#!optional (car args))
+		  (collect-args (cdr args) reqs?: #f opts?: #t keys?: #f))
+		 (else
+		  (begin
+		    (cond
+		     (reqs?
+		      (set! reqs (append reqs (list (clean-arg (car args))))))
+		     (opts?
+		      (set! opts (append opts (list (cons (clean-arg (caar args)) (cdar args))))))
+		     (keys?
+		      (set! keys (append keys (list (cons (clean-arg (caar args)) (cdar args)))))))
+		    (collect-args (cdr args))))))
+	       (else
+		(set! opts (list (clean-arg args) '...))))))
+
+	  (collect-args args)
+
+	  `(,sym ("args" (("required" ,@reqs)
+			  ("optional" ,@opts)
+			  ("key" ,@keys)))
+		 ("module" ,@mod-list)))))))
+
+  ;; Builds a signature list from an identifier
+  (define (find-signatures sym)
+    (let ((result (symbol-information-list sym)))
+      (map fmt result)))
+
+  ;; Builds the documentation from Chicken Doc for a specific symbol
+  (define (make-doc symbol #!optional (filter-for-type #f))
+    (with-output-to-string
+      (lambda ()
+        (map (lambda (node)
+               (display (string-append "= Node: " (->string (node-id node)) " " " =\n"))
+               (describe node)
+               (display "\n\n"))
+             (filter
+              (lambda (n)
+                (or (not filter-for-type)
+                    (eq? (node-type n) filter-for-type)))
+              (match-nodes symbol))))))
+  
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Geiser core functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; Basically all non-core functions pass through geiser-eval
+
+  (define (form-has-safe-geiser? form)
+    (any (cut eq? (car form) <>)
+	 '(geiser-no-values geiser-newline geiser-completions
+	   geiser-autodoc geiser-object-signature geiser-symbol-location
+	   geiser-symbol-documentation geiser-module-exports
+	   geiser-module-path geiser-module-location
+	   geiser-module-completions geiser-chicken-use-debug-log)))
+    
+  (define (form-has-any-geiser? form)
+    (string-has-prefix? (->string (car form)) "geiser-"))
+
+  (define (form-defines-any-module? form)
+    (or
+     ;; Geiser seems to send buffers as (begin ..buffer contents..)
+     (and (eq? (car form) 'begin)
+	  (form-defines-any-module? (cadr form)))
+     (any (cut eq? (car form) <>)
+	  '(module define-library))))
+
+  (define (module-matches-defined-module? module)
+    (any (cut eq? module <>) (list-modules)))
+
+  (define (geiser-eval module form . rest)
+    (when (and module (not (symbol? module)))
+      (error "Module should be a symbol"))
+    
+    ;; All calls start at toplevel
+    (let* ((is-safe-geiser? (form-has-safe-geiser? form))
+	   (host-module (and (not is-safe-geiser?)
+			     (not (form-has-any-geiser? form))
+			     (not (form-defines-any-module? form))
+			     (module-matches-defined-module? module)
+                             module))
+	   (thunk (lambda () (eval form))))
+
+      (write-to-log `[[REQUEST host-module: ,host-module]])
+      (write-to-log form)
+
+      (if is-safe-geiser?
+	  (call-with-result #f thunk)
+	  (call-with-result host-module thunk))))
+
+  ;; Load a file
+
+  (define (geiser-load-file file)
+    (let* ((file (if (symbol? file) (symbol->string file) file))
+           (found-file (geiser-find-file file)))
+      (call-with-result #f
+       (lambda ()
+         (when found-file
+           (load found-file))))))
+
+  ;; The no-values identity
+
+  (define (geiser-no-values)
+    (values))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Miscellaneous
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; Invoke a newline
+
+  (define (geiser-newline . rest)
+    (newline))
+
+  ;; Spawn a server for remote repl access
+
+  (define (geiser-start-server . rest)
+    (let* ((listener (tcp-listen 0))
+           (port (tcp-listener-port listener)))
+      (define (remote-repl)
+        (receive (in out) (tcp-accept listener)
+          (current-input-port in)
+          (current-output-port out)
+          (current-error-port out)
+
+          (repl)))
+
+      (thread-start! (make-thread remote-repl))
+
+      (write-to-log `(geiser-start-server . ,rest))
+      (write-to-log `(port ,port))
+
+      (write `(port ,port))
+      (newline)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Completions, Autodoc and Signature
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define (geiser-completions prefix . rest)
+    (let ((prefix (->string prefix)))
+      (filter (cut string-has-prefix? <> prefix)
+	      (map ->string (map car (symbol-information-list prefix))))))
+
+  (define (geiser-module-completions prefix . rest)
+    (let ((prefix (->string prefix)))
+      (filter (cut string-has-prefix? <> prefix) (map ->string (list-modules)))))
+
+  (define (geiser-autodoc ids . rest)
+    (cond
+     ((null? ids) '())
+     ((not (list? ids))
+      (geiser-autodoc (list ids)))
+     (else
+      (let ((details (find-signatures (car ids))))
+	(if (null? details)
+	    (geiser-autodoc (cdr ids))
+	    details)))))
+  
+  (define (geiser-object-signature name object . rest)
+    (let* ((sig (geiser-autodoc `(,name))))
+      (if (null? sig) '() (car sig))))
+
+    ;; TODO: Divine some way to support this functionality
+
+  (define (geiser-symbol-location symbol . rest)
+    '(("file") ("line")))
+
+  (define (geiser-symbol-documentation symbol . rest)
+    (let* ((sig (find-signatures symbol)))
+      `(("signature" ,@(car sig))
+        ("docstring" . ,(make-doc symbol)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; File and Buffer Operations
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define geiser-chicken-load-paths (make-parameter '("" ".")))
+
+  (define (geiser-find-file file . rest)
+    (when file
+      (let ((paths (geiser-chicken-load-paths)))
+	(define (try-find file paths)
+	  (cond
+	   ((null? paths) #f)
+	   ((file-exists? (string-append (car paths) file))
+	    (string-append (car paths) file))
+	   (else (try-find file (cdr paths)))))
+	(try-find file paths))))
+
+  (define (geiser-add-to-load-path directory . rest)
+    (let* ((directory (if (symbol? directory)
+                          (symbol->string directory)
+                          directory))
+           (directory (if (not (equal? #\/ (string-ref directory (- (string-length directory)))))
+                          (string-append directory "/")
+                          directory)))
+      (call-with-result #f
+       (lambda ()
+         (when (directory-exists? directory)
+           (geiser-chicken-load-paths (cons directory (geiser-chicken-load-paths))))))))
+
+  (define (geiser-compile-file file . rest)
+    (let* ((file (if (symbol? file) (symbol->string file) file))
+           (found-file (geiser-find-file file)))
+      (call-with-result #f
+       (lambda ()
+         (when found-file
+           (compile-file found-file))))))
+
+    ;; TODO: Support compiling regions
+
+  (define (geiser-compile form module . rest)
+    (error "Chicken does not support compiling regions"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Modules
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  ;; Should return:
+  ;; '(("modules" . sub-modules) ("procs" . procedures) ("syntax" . macros) ("vars" . variables))
+  (define (geiser-module-exports module-name . rest)
+    (let* ((nodes (match-nodes module-name)))
+      (if (null? nodes)
+          '()
+          (let ((mod '())
+                (proc '())
+                (syn '())
+                (var '()))
+            (map
+             (lambda (node)
+               (let ((type (node-type node))
+                     (name (node-id node))
+                     (path (node-path node)))
+                 (cond
+                  ((memq type '(unit egg))
+                   (set! mod (cons name mod)))
+                  ((memq type '(procedure record setter class method))
+                   (set! proc (cons name proc)))
+                  ((memq type '(read syntax))
+                   (set! syn (cons name syn)))
+                  ((memq type '(parameter constant))
+                   (set! var (cons name var))))))
+             nodes)
+            `(("modules" . ,mod)
+              ("procs" . ,proc)
+              ("syntax" . ,syn)
+              ("vars" . ,var))))))
+
+  ;; Returns the path for the file in which an egg or module was defined
+
+  (define (geiser-module-path module-name . rest)
+    #f)
+
+  ;; Returns:
+  ;; `(("file" . ,(module-path name)) ("line"))
+
+  (define (geiser-module-location name . rest)
+    #f)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Misc
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define (geiser-macroexpand form . rest)
+    (with-output-to-string
+      (lambda ()
+        (write (expand form)))))
+
+;; End module
+  )

elpa/geiser-20180626.440/scheme/guile/geiser/completion.scm

@@ -0,0 +1,27 @@
+;;; completion.scm -- completing known symbols and module names
+
+;; Copyright (C) 2009, 2012 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Mon Mar 02, 2009 02:22
+
+(define-module (geiser completion)
+  #:export (completions module-completions)
+  #:use-module (geiser utils)
+  #:use-module (geiser modules)
+  #:use-module (ice-9 session)
+  #:use-module (ice-9 regex))
+
+(define (completions prefix)
+  (let ((prefix (string-append "^" (regexp-quote prefix))))
+    (sort! (map symbol->string (apropos-internal prefix)) string<?)))
+
+(define (module-completions prefix)
+  (let* ((prefix (string-append "^" (regexp-quote prefix)))
+         (matcher (lambda (s) (string-match prefix s)))
+         (names (filter matcher (all-modules))))
+    (sort! names string<?)))

elpa/geiser-20180626.440/scheme/guile/geiser/doc.scm

@@ -0,0 +1,258 @@
+;;; doc.scm -- procedures providing documentation on scheme objects
+
+;; Copyright (C) 2009, 2010, 2018 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sun Feb 08, 2009 18:44
+
+(define-module (geiser doc)
+  #:export (autodoc
+            symbol-documentation
+            module-exports
+            object-signature)
+  #:use-module (geiser utils)
+  #:use-module (geiser modules)
+  #:use-module (system vm program)
+  #:use-module (system vm debug)
+  #:use-module (ice-9 session)
+  #:use-module (ice-9 documentation)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 format)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-1))
+
+(define (autodoc ids)
+  (if (not (list? ids))
+      '()
+      (map (lambda (id) (or (autodoc* id) (list id))) ids)))
+
+(define* (autodoc* id)
+  (let ((args (obj-args (symbol->object id))))
+    (and args
+         `(,@(signature id args)
+           ("module" . ,(symbol-module id))))))
+
+(define (object-signature name obj)
+  (let ((args (obj-args obj)))
+    (and args (signature name args))))
+
+(define (value-str obj)
+  (format #f "~:@y" obj))
+
+(define* (signature id args-list #:optional (detail #t))
+  (define (arglst args kind)
+    (let ((args (assq-ref args kind)))
+      (cond ((or (not args) (null? args)) '())
+            ((list? args) args)
+            (else (list args)))))
+  (define (mkargs as)
+    `(("required" ,@(arglst as 'required))
+      ("optional" ,@(arglst as 'optional)
+       ,@(if (assq-ref as 'rest) (list "...") '()))
+      ("key" ,@(arglst as 'keyword))))
+  (let* ((args-list (map mkargs (if (list? args-list) args-list '())))
+         (value (and (and detail (null? args-list))
+                     (value-str (symbol->object id)))))
+    `(,id ("args" ,@args-list) ,@(if value `(("value" . ,value)) '()))))
+
+(define default-macro-args '(((required ...))))
+
+(define geiser-args-key (gensym "geiser-args-key-"))
+
+(define (obj-args obj)
+  (cond ((not obj) #f)
+        ((or (procedure? obj) (program? obj))
+         (cond ((procedure-property obj geiser-args-key))
+               ((arguments obj) =>
+                (lambda (args)
+                  (set-procedure-property! obj geiser-args-key args)
+                  args))
+               (else #f)))
+        ((and (macro? obj) (macro-transformer obj)) => macro-args)
+        ((macro? obj) default-macro-args)
+        (else 'variable)))
+
+(define (program-arities prog)
+  (let ((addrs (program-address-range prog)))
+    (when (pair? addrs) (find-program-arities (car addrs)))))
+
+(define (arguments proc)
+  (define (p-args prog)
+    (let ((as (map arity-arguments-alist (or (program-arities prog) '()))))
+      (and (not (null? as)) as)))
+  (define (clist f) (lambda (x) (let ((y (f x))) (and y (list y)))))
+  (cond ((is-a? proc <generic>) (generic-args proc))
+        ((doc->args proc) => list)
+        ((procedure-property proc 'arglist) => (clist arglist->args))
+        ((procedure-source proc) => (clist source->args))
+        ((and (program? proc) (p-args proc)))
+        ((procedure-property proc 'arity) => (clist arity->args))
+        (else #f)))
+
+(define (source->args src)
+  (let ((formals (cadr src)))
+    (cond ((list? formals) `((required . ,formals)))
+          ((pair? formals)
+           `((required . ,(car formals)) (rest . ,(cdr formals))))
+          (else #f))))
+
+(define (macro-args tf)
+  (define* (collect args #:optional (req '()))
+    (cond ((null? args) (arglist->args `(,(reverse req) #f #f r #f)))
+          ((symbol? args) (arglist->args `(,(reverse req) #f #f r ,args)))
+          ((and (pair? args) (symbol? (car args)))
+           (collect (cdr args) (cons (car args) req)))
+          (else #f)))
+  (let* ((pats (procedure-property tf 'patterns))
+         (args (and pats (filter-map collect pats))))
+    (or (and args (not (null? args)) args) default-macro-args)))
+
+(define (arity->args art)
+  (define (gen-arg-names count)
+    (map (lambda (x) '_) (iota (max count 0))))
+  (let ((req (car art))
+        (opt (cadr art))
+        (rest (caddr art)))
+    `(,@(if (> req 0)
+            (list (cons 'required (gen-arg-names req)))
+            '())
+      ,@(if (> opt 0)
+            (list (cons 'optional (gen-arg-names opt)))
+            '())
+      ,@(if rest (list (cons 'rest 'rest)) '()))))
+
+(define (arglist->args arglist)
+  `((required . ,(car arglist))
+    (optional . ,(cadr arglist))
+    (keyword . ,(caddr arglist))
+    (rest . ,(car (cddddr arglist)))))
+
+(define (doc->args proc)
+  ;; Guile 2.0.9+ uses the (texinfo ...) modules to produce
+  ;; `guile-procedures.txt', and the output has a single hyphen, whereas
+  ;; `makeinfo' produces two hyphens.
+  (define proc-rx "--? Scheme Procedure: ([^[\n]+)\n")
+  (define proc-rx2 "--? Scheme Procedure: ([^[\n]+\\[[^\n]*(\n[^\n]+\\]+)?)")
+  (let ((doc (object-documentation proc)))
+    (and doc
+         (let ((match (or (string-match proc-rx doc)
+                          (string-match proc-rx2 doc))))
+           (and match
+                (parse-signature-string (match:substring match 1)))))))
+
+(define (parse-signature-string str)
+  (define opt-arg-rx "\\[([^] ]+)\\]?")
+  (define opt-arg-rx2 "([^ ])+\\]+")
+  (let ((tokens (string-tokenize str)))
+    (if (< (length tokens) 2)
+        '()
+        (let loop ((tokens (cdr tokens)) (req '()) (opt '()) (rest #f))
+          (cond ((null? tokens)
+                 `((required ,@(map string->symbol (reverse! req)))
+                   (optional ,@(map string->symbol (reverse! opt)))
+                   ,@(if rest
+                         (list (cons 'rest (string->symbol rest)))
+                         '())))
+                ((string=? "." (car tokens))
+                 (if (not (null? (cdr tokens)))
+                     (loop (cddr tokens) req opt (cadr tokens))
+                     (loop '() req opt "rest")))
+                ((or (string-match opt-arg-rx (car tokens))
+                     (string-match opt-arg-rx2 (car tokens)))
+                 => (lambda (m)
+                      (loop (cdr tokens)
+                            req
+                            (cons (match:substring m 1) opt)
+                            rest)))
+                (else (loop (cdr tokens)
+                            (cons (car tokens) req)
+                            opt
+                            rest)))))))
+
+(define (generic-args gen)
+  (define (src> src1 src2)
+    (> (length (cadr src1)) (length (cadr src2))))
+  (define (src m)
+    (catch #t
+      (lambda () (method-source m))
+      (lambda (k . a) #f)))
+  (let* ((methods (generic-function-methods gen))
+         (srcs (filter identity (map src methods))))
+    (cond ((and (null? srcs)
+                (not (null? methods))
+                (method-procedure (car methods))) => arguments)
+          ((not (null? srcs)) (list (source->args (car (sort! srcs src>)))))
+          (else '(((rest . rest)))))))
+
+(define (symbol-documentation sym)
+  (let ((obj (symbol->object sym)))
+    (if obj
+        `(("signature" . ,(or (obj-signature sym obj #f) sym))
+          ("docstring" . ,(docstring sym obj))))))
+
+(define (docstring sym obj)
+  (define (valuable?)
+    (not (or (macro? obj) (procedure? obj) (program? obj))))
+  (with-output-to-string
+    (lambda ()
+      (let* ((type (cond ((macro? obj) "A macro")
+                         ((procedure? obj) "A procedure")
+                         ((program? obj) "A compiled program")
+                         (else "An object")))
+             (modname (symbol-module sym))
+             (doc (object-documentation obj)))
+        (display type)
+        (if modname
+            (begin
+              (display " in module ")
+              (display modname)
+              (display ".")))
+        (newline)
+        (if doc (begin (newline) (display doc)))
+        (if (valuable?) (begin (newline)
+                               (display "Value:")
+                               (newline)
+                               (display "   ")
+                               (display (value-str obj))))))))
+
+(define* (obj-signature sym obj #:optional (detail #t))
+  (let ((args (obj-args obj)))
+    (and args (signature sym args detail))))
+
+(define (module-exports mod-name)
+  (define elt-sort (make-symbol-sort car))
+  (let* ((mod (catch #t
+                (lambda () (resolve-interface mod-name))
+                (lambda args (resolve-module mod-name))))
+         (elts (hash-fold classify-module-object
+                          (list '() '() '())
+                          (module-obarray mod)))
+         (elts (map elt-sort elts))
+         (subs (map (lambda (m) (list (module-name m)))
+                    (submodules (resolve-module mod-name #f)))))
+    (list (cons "modules" subs)
+          (cons "procs" (car elts))
+          (cons "syntax" (cadr elts))
+          (cons "vars" (caddr elts)))))
+
+(define (classify-module-object name var elts)
+  (let ((obj (and (variable-bound? var)
+                  (variable-ref var))))
+    (cond ((or (not obj) (module? obj)) elts)
+          ((or (procedure? obj) (program? obj))
+           (list (cons (list name `("signature" . ,(obj-signature name obj)))
+                       (car elts))
+                 (cadr elts)
+                 (caddr elts)))
+          ((macro? obj)
+           (list (car elts)
+                 (cons (list name `("signature" . ,(obj-signature name obj)))
+                       (cadr elts))
+                 (caddr elts)))
+          (else (list (car elts)
+                      (cadr elts)
+                      (cons (list name) (caddr elts)))))))

elpa/geiser-20180626.440/scheme/guile/geiser/emacs.scm

@@ -0,0 +1,58 @@
+;;; emacs.scm -- procedures for emacs interaction: entry point
+
+;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sun Feb 08, 2009 18:39
+
+(define-module (geiser emacs)
+  #:use-module (ice-9 match)
+  #:use-module (system repl command)
+  #:use-module (system repl error-handling)
+  #:use-module (system repl server)
+  #:use-module (geiser evaluation)
+  #:use-module ((geiser modules) #:renamer (symbol-prefix-proc 'ge:))
+  #:use-module ((geiser completion) #:renamer (symbol-prefix-proc 'ge:))
+  #:use-module ((geiser xref) #:renamer (symbol-prefix-proc 'ge:))
+  #:use-module ((geiser doc) #:renamer (symbol-prefix-proc 'ge:)))
+
+(define this-module (resolve-module '(geiser emacs)))
+
+(define-meta-command ((geiser-no-values geiser) repl)
+  "geiser-no-values
+No-op command used internally by Geiser."
+  (values))
+
+(define-meta-command ((geiser-newline geiser) repl)
+  "geiser-newline
+Meta-command used by Geiser to emit a new line."
+  (newline))
+
+(define-meta-command ((geiser-eval geiser) repl (mod form args) . rest)
+  "geiser-eval module form args ()
+Meta-command used by Geiser to evaluate and compile code."
+  (if (null? args)
+      (call-with-error-handling
+       (lambda () (ge:compile form mod)))
+      (let ((proc (eval form this-module)))
+        (ge:eval `(,proc ,@args) mod))))
+
+(define-meta-command ((geiser-load-file geiser) repl file)
+  "geiser-load-file file
+Meta-command used by Geiser to load and compile files."
+  (call-with-error-handling
+   (lambda () (ge:compile-file file))))
+
+
+(define-meta-command ((geiser-start-server geiser) repl)
+  "geiser-start-server
+Meta-command used by Geiser to start a REPL server."
+  (let* ((sock (make-tcp-server-socket #:port 0))
+         (port (sockaddr:port (getsockname sock))))
+    (spawn-server sock)
+    (write (list 'port port))
+    (newline)))

elpa/geiser-20180626.440/scheme/guile/geiser/evaluation.scm

@@ -0,0 +1,144 @@
+;;; evaluation.scm -- evaluation, compilation and macro-expansion
+
+;; Copyright (C) 2009, 2010, 2011, 2013, 2015 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Mon Mar 02, 2009 02:46
+
+(cond-expand
+  (guile-2.2
+   (define-module (geiser evaluation)
+     #:export (ge:compile
+               ge:eval
+               ge:macroexpand
+               ge:compile-file
+               ge:load-file
+               ge:set-warnings
+               ge:add-to-load-path)
+     #:use-module (geiser modules)
+     #:use-module (srfi srfi-1)
+     #:use-module (language tree-il)
+     #:use-module (system base compile)
+     #:use-module (system base message)
+     #:use-module (system base pmatch)
+     #:use-module (system vm program)
+     #:use-module (ice-9 pretty-print)
+     #:use-module (system vm loader)))
+  (else
+   (define-module (geiser evaluation)
+     #:export (ge:compile
+               ge:eval
+               ge:macroexpand
+               ge:compile-file
+               ge:load-file
+               ge:set-warnings
+               ge:add-to-load-path)
+     #:use-module (geiser modules)
+     #:use-module (srfi srfi-1)
+     #:use-module (language tree-il)
+     #:use-module (system base compile)
+     #:use-module (system base message)
+     #:use-module (system base pmatch)
+     #:use-module (system vm program)
+     #:use-module (ice-9 pretty-print))))
+
+
+(define compile-opts '())
+(define compile-file-opts '())
+
+(define default-warnings '(arity-mismatch unbound-variable format))
+(define verbose-warnings `(unused-variable ,@default-warnings))
+
+(define (ge:set-warnings wl)
+  (let* ((warns (cond ((list? wl) wl)
+                      ((symbol? wl) (case wl
+                                      ((none nil null) '())
+                                      ((medium default) default-warnings)
+                                      ((high verbose) verbose-warnings)
+                                      (else '())))
+                      (else '())))
+         (fwarns (if (memq 'unused-variable warns)
+                     (cons 'unused-toplevel warns)
+                     warns)))
+    (set! compile-opts (list #:warnings warns))
+    (set! compile-file-opts (list #:warnings fwarns))))
+
+(ge:set-warnings 'none)
+
+(define (call-with-result thunk)
+  (letrec* ((result #f)
+            (output
+             (with-output-to-string
+               (lambda ()
+                 (with-fluids ((*current-warning-port* (current-output-port))
+                               (*current-warning-prefix* ""))
+                   (with-error-to-port (current-output-port)
+                     (lambda () (set! result
+                                  (map object->string (thunk))))))))))
+    (write `((result ,@result) (output . ,output)))
+    (newline)))
+
+(define (ge:compile form module)
+  (compile* form module compile-opts))
+
+(define (compile* form module-name opts)
+  (let* ((module (or (find-module module-name) (current-module)))
+         (ev (lambda ()
+               (call-with-values
+                   (lambda ()
+                     (let* ((to (cond-expand (guile-2.2 'bytecode)
+                                             (else 'objcode)))
+                            (cf (cond-expand (guile-2.2 load-thunk-from-memory)
+                                             (else make-program)))
+                            (o (compile form
+                                        #:to to
+                                        #:env module
+                                        #:opts opts))
+                            (thunk (cf o)))
+                       (start-stack 'geiser-evaluation-stack
+                                    (eval `(,thunk) module))))
+                 (lambda vs vs)))))
+    (call-with-result ev)))
+
+(define (ge:eval form module-name)
+  (let* ((module (or (find-module module-name) (current-module)))
+         (ev (lambda ()
+               (call-with-values
+                   (lambda () (eval form module))
+                 (lambda vs vs)))))
+    (call-with-result ev)))
+
+(define (ge:compile-file path)
+  (call-with-result
+   (lambda ()
+     (let ((cr (compile-file path
+                             #:canonicalization 'absolute
+                             #:opts compile-file-opts)))
+       (and cr
+            (list (object->string (save-module-excursion
+                                   (lambda () (load-compiled cr))))))))))
+
+(define ge:load-file ge:compile-file)
+
+(define (ge:macroexpand form . all)
+  (let ((all (and (not (null? all)) (car all))))
+    (with-output-to-string
+      (lambda ()
+        (pretty-print (tree-il->scheme (macroexpand form)))))))
+
+(define (add-to-list lst dir)
+  (and (not (member dir lst))))
+
+(define (ge:add-to-load-path dir)
+  (and (file-is-directory? dir)
+       (let ((in-lp (member dir %load-path))
+             (in-clp (member dir %load-compiled-path)))
+         (when (not in-lp)
+           (set! %load-path (cons dir %load-path)))
+         (when (not in-clp)
+           (set! %load-compiled-path (cons dir %load-compiled-path)))
+         (or in-lp in-clp))))

elpa/geiser-20180626.440/scheme/guile/geiser/modules.scm

@@ -0,0 +1,104 @@
+;;; modules.scm -- module metadata
+
+;; Copyright (C) 2009, 2010, 2011, 2018 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Mon Mar 02, 2009 02:00
+
+(define-module (geiser modules)
+  #:export (symbol-module
+            program-module
+            module-name?
+            module-path
+            find-module
+            all-modules
+            submodules
+            module-location)
+  #:use-module (geiser utils)
+  #:use-module (system vm program)
+  #:use-module (system vm debug)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 session)
+  #:use-module (srfi srfi-1))
+
+;; Return hash table mapping filename to list of modules defined in that
+;; file. H/t andy wingo.
+(define (fill-file->module-mapping! ret)
+  (define (record-module m)
+    (let ((f (module-filename m)))
+      (hash-set! ret f (cons m (hash-ref ret f '())))))
+  (define (visit-module m)
+    (record-module m)
+    (hash-for-each (lambda (k v) (visit-module v))
+                   (module-submodules m)))
+  (visit-module (resolve-module '() #f))
+  ret)
+
+(define file->modules (fill-file->module-mapping! (make-hash-table)))
+
+(define (program-file p)
+  (let ((src (program-source p 0)))
+    (and (pair? src) (cadr src))))
+
+(define (program-module p)
+  (let* ((f (program-file p))
+         (mods (or (hash-ref file->modules f)
+                   (hash-ref (fill-file->module-mapping! file->modules) f))))
+    (and (pair? mods) (not (null? mods)) (car mods))))
+
+(define (module-name? module-name)
+  (and (list? module-name)
+       (not (null? module-name))
+       (every symbol? module-name)))
+
+(define (symbol-module sym . all)
+  (and sym
+       (catch 'module-name
+         (lambda ()
+           (apropos-fold (lambda (module name var init)
+                           (if (eq? name sym)
+                               (throw 'module-name (module-name module))
+                               init))
+                         #f
+                         (regexp-quote (symbol->string sym))
+                         (if (or (null? all) (not (car all)))
+                             (apropos-fold-accessible (current-module))
+                             apropos-fold-all)))
+         (lambda (key . args)
+           (and (eq? key 'module-name) (car args))))))
+
+(define (module-location name)
+  (make-location (module-path name) #f))
+
+(define (find-module mod-name)
+  (and (module-name? mod-name)
+       (resolve-module mod-name #f #:ensure #f)))
+
+(define (module-path module-name)
+  (and (module-name? module-name)
+       (or ((@@ (ice-9 session) module-filename) module-name)
+           (module-filename (resolve-module module-name #f)))))
+
+(define (submodules mod)
+  (hash-map->list (lambda (k v) v) (module-submodules mod)))
+
+(define (root-modules)
+  (submodules (resolve-module '() #f)))
+
+(define (all-modules)
+  (define (maybe-name m)
+    (and (module-kind m) (format #f "~A" (module-name m))))
+  (let* ((guile (resolve-module '(guile)))
+         (roots (remove (lambda (m) (eq? m guile)) (root-modules)))
+         (children (append-map all-child-modules roots)))
+    (cons "(guile)" (filter-map maybe-name children))))
+
+(define* (all-child-modules mod #:optional (seen '()))
+  (let ((cs (filter (lambda (m) (not (member m seen))) (submodules mod))))
+    (fold (lambda (m all) (append (all-child-modules m all) all))
+          (list mod)
+          cs)))

elpa/geiser-20180626.440/scheme/guile/geiser/utils.scm

@@ -0,0 +1,52 @@
+;;; utils.scm -- utility functions
+
+;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Mon Mar 02, 2009 01:48
+
+(define-module (geiser utils)
+  #:export (make-location
+            symbol->object
+            pair->list
+            sort-symbols!
+            make-symbol-sort
+            gensym?)
+  #:use-module (ice-9 regex))
+
+(define (symbol->object sym)
+  (and (symbol? sym)
+       (module-defined? (current-module) sym)
+       (module-ref (current-module) sym)))
+
+(define (pair->list pair)
+  (let loop ((d pair) (s '()))
+    (cond ((null? d) (reverse! s))
+          ((symbol? d) (reverse! (cons d s)))
+          (else (loop (cdr d) (cons (car d) s))))))
+
+(define (make-location file line)
+  (list (cons "file" (if (string? file) file '()))
+        (cons "line" (if (number? line) (+ 1 line) '()))))
+
+(define (sort-symbols! syms)
+  (let ((cmp (lambda (l r)
+               (string<? (symbol->string l) (symbol->string r)))))
+    (sort! syms cmp)))
+
+(define (make-symbol-sort sel)
+  (let ((cmp (lambda (a b)
+               (string<? (symbol->string (sel a))
+                         (symbol->string (sel b))))))
+    (lambda (syms)
+      (sort! syms cmp))))
+
+(define (gensym? sym)
+  (and (symbol? sym) (gensym-name? (format #f "~A" sym))))
+
+(define (gensym-name? name)
+  (and (string-match "^#[{]" name) #t))

elpa/geiser-20180626.440/scheme/guile/geiser/xref.scm

@@ -0,0 +1,84 @@
+;;; xref.scm -- cross-referencing utilities
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Mon Mar 02, 2009 02:37
+
+(define-module (geiser xref)
+  #:export (symbol-location
+            generic-methods
+            callers
+            callees
+            find-file)
+  #:use-module (geiser utils)
+  #:use-module (geiser modules)
+  #:use-module (geiser doc)
+  #:use-module (oop goops)
+  #:use-module (system xref)
+  #:use-module (system vm program))
+
+(define (symbol-location sym)
+  (cond ((symbol-module sym) => module-location)
+        (else (let ((obj (symbol->object sym)))
+                (or (and (program? obj) (program-location obj))
+                    '())))))
+
+(define (generic-methods sym)
+  (let* ((gen (symbol->object sym))
+         (methods (if (is-a? gen <generic>)
+                      (generic-function-methods gen)
+                      '())))
+    (filter (lambda (x) (not (null? x)))
+            (map (lambda (m)
+                   (make-xref (method-procedure m) sym (symbol-module sym)))
+                 methods))))
+
+(define (make-xref proc name module)
+  (and proc
+       `(("location" . ,(or (program-location proc) (symbol-location name)))
+         ("signature" . ,(object-signature name proc))
+         ("module" . ,(or module '())))))
+
+(define (program-location p)
+  (cond ((not (program? p)) #f)
+        ((program-source p 0) =>
+         (lambda (s) (make-location (program-path p) (source:line s))))
+        ((program-path p) => (lambda (s) (make-location s #f)))
+        (else #f)))
+
+(define (program-path p)
+  (let* ((mod (program-module p))
+         (name (and (module? mod) (module-name mod))))
+    (and name (module-path name))))
+
+(define (procedure-xref proc . mod-name)
+  (let* ((proc-name (or (procedure-name proc) '<anonymous>))
+         (mod-name (if (null? mod-name)
+                       (symbol-module proc-name)
+                       (car mod-name))))
+    (make-xref proc proc-name mod-name)))
+
+(define (callers sym)
+  (let ((mod (symbol-module sym #t)))
+    (and mod
+         (apply append (map (lambda (procs)
+                              (map (lambda (proc)
+                                     (procedure-xref proc (car procs)))
+                                   (cdr procs)))
+                            (procedure-callers (cons mod sym)))))))
+
+(define (callees sym)
+  (let ((obj (symbol->object sym)))
+    (and obj
+         (map procedure-xref (procedure-callees obj)))))
+
+(define (find-file path)
+  (let loop ((dirs %load-path))
+    (if (null? dirs) #f
+        (let ((candidate (string-append (car dirs) "/" path)))
+          (if (file-exists? candidate) candidate (loop (cdr dirs)))))))

elpa/geiser-20180626.440/scheme/mit/geiser/compile.scm

@@ -0,0 +1,9 @@
+(declare (usual-integrations))
+
+(load-option 'CREF)
+
+(with-working-directory-pathname
+    (directory-pathname (current-load-pathname))
+  (lambda ()
+    (cf "emacs")
+    (cref/generate-constructors "geiser" 'ALL)))

elpa/geiser-20180626.440/scheme/mit/geiser/emacs.scm

@@ -0,0 +1,281 @@
+;;;; package: (runtime geiser)
+(declare (usual-integrations))
+
+(load-option 'format)
+
+(define (all-completions prefix environment)
+  (let (;; (prefix
+        ;;  (if (environment-lookup environment 'PARAM:PARSER-CANONICALIZE-SYMBOLS?)
+        ;;      (string-downcase prefix)
+        ;;      prefix))
+        (completions '()))
+    (for-each-interned-symbol
+     (lambda (symbol)
+       ;; was string-prefix?, now defaults to case-insensitive
+       ;; (MIT/GNU Scheme's default)
+       (if (and (string-prefix-ci? prefix (symbol-name symbol))
+                (environment-bound? environment symbol))
+           (set! completions (cons (symbol-name symbol) completions)))
+       unspecific))
+    completions))
+
+(define (operator-arglist symbol env)
+  (let ((type (environment-reference-type env symbol)))
+    (let ((ans (if (eq? type 'normal)
+                   (let ((binding (environment-lookup env symbol)))
+                     (if (and binding
+                              (procedure? binding))
+                         (cons symbol (read-from-string
+                                       (string-trim (with-output-to-string
+                                                      (lambda () (pa binding))))))
+                         #f))
+                   #f ;; macros
+                   )))
+      ans)))
+
+(define (geiser:operator-arglist symbol env)
+  (let* ((arglist (operator-arglist symbol env))
+         (operator symbol))
+    (if arglist
+        (let loop ((arglist (cdr arglist))
+                   (optionals? #f)
+                   (required '())
+                   (optional '()))
+          (cond ((null? arglist)
+                 `(,operator ("args" (("required" ,@(reverse required))
+                                      ("optional" ,@(reverse optional))
+                                      ("key")
+                                      ;; ("module" ,module)
+                                      ))))
+                ((symbol? arglist)
+                 (loop '()
+                       #t
+                       required
+                       (cons "..." (cons arglist optional))))
+                ((eq? (car arglist) #!optional)
+                 (loop (cdr arglist)
+                       #t
+                       required
+                       optional))
+                (else
+                 (loop
+                  (cdr arglist)
+                  optionals?
+                  (if optionals? required (cons (car arglist) required))
+                  (if optionals? (cons (car arglist) optional) optional)))))
+        '())))
+
+
+(define (read-from-string str)
+  (with-input-from-string str
+    read))
+
+(define (all-packages)
+  (let loop ((package (name->package '()))) ;;  system-global-package
+    (cons package
+          (append-map loop (package/children package)))))
+
+(define anonymous-package-prefix
+  "environment-")
+
+(define (env->pstring env)
+  (let ((package (environment->package env)))
+    (if package
+        (write-to-string (package/name package))
+        (string anonymous-package-prefix (object-hash env)))))
+
+(define geiser-repl (nearest-repl))
+
+(define (set-geiser-repl-prompt! env)
+  (set-repl/prompt! geiser-repl (format #f
+                                        "~s =>"
+                                        (package/name (environment->package env))))
+  env)
+
+(define geiser-env #f)
+
+(define (get-symbol-definition-location object)
+  (let ((file (cond ((and (entity? object)
+                          (procedure? object))
+                     (receive (a b)
+                         (compiled-entry/filename-and-index (entity-procedure object))
+                       b
+                       a))
+                    ((compiled-procedure? object)
+                     (receive (a b)
+                         (compiled-entry/filename-and-index object)
+                       b
+                       a))
+                    (else
+                     '()))))
+    (fix-mit-source-dir
+     (if (and (string? file)
+              (string-suffix? ".inf" file))
+         (string-append (substring file 0 (- (string-length file) 3)) "scm")
+         file))))
+
+(define (fix-mit-source-dir filename)
+  (let ((default-location "/usr/lib/mit-scheme-x86-64/"))
+    (if (and geiser:mit-scheme-source-directory
+             (not (string-null? geiser:mit-scheme-source-directory)))
+        (if (string-prefix? default-location filename)
+            (string-append geiser:mit-scheme-source-directory
+                           (substring filename
+                                      (string-length default-location)
+                                      (string-length filename)))
+            filename)
+        filename)))
+
+(define geiser:mit-scheme-source-directory #f)
+
+;;;; ***************************************************************************
+
+(define (geiser:eval module form . rest)
+  rest
+  (let* ((output (open-output-string))
+         (environment (package/environment (find-package (if module
+                                                             module
+                                                             '(user))
+                                                         #t)))
+         (result (with-output-to-port output
+                   (lambda ()
+                     (eval form environment)))))
+    (write `((result ,(write-to-string result))
+             (output . ,(get-output-string output))))))
+
+(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
+         (let ((details (map (lambda (id)
+                               (geiser:operator-arglist id (->environment '(user)))
+                               ) ids)))
+           details))))
+
+(define (geiser:module-completions prefix . rest)
+  rest
+  (filter (lambda (pstring)
+            (substring? prefix (write-to-string pstring)))
+          (map (lambda (package)
+                 (env->pstring (package/environment package)))
+               (all-packages))))
+
+(define (geiser:completions prefix . rest)
+  rest
+  (sort (all-completions prefix (->environment '(user)))
+        string<?))
+
+(define (geiser:ge environment)
+  (let ((env (package/environment (find-package environment #t))))
+    (set-geiser-repl-prompt! env)
+    (set! geiser-env env))
+  (ge environment))
+
+(define (geiser:load-file filename)
+  (load filename))
+
+(define (geiser:module-exports module)
+  (let* ((pkg (find-package module #t))
+         (children (map package/name (package/children pkg)))
+         (env (package/environment pkg)))
+    (let loop ((vars '())
+               (procs '())
+               (syntax '())
+               (bindings (environment-bindings env)))
+      (if (null? bindings)
+          `(("vars" . ,vars)
+            ("procs" . ,procs)
+            ("syntax" . ,syntax)
+            ("modules" . ,(map list children)))
+          (let* ((binding (car bindings))
+                 (name (car binding))
+                 (value (if (null? (cdr binding)) 'unassigned (cadr binding)))
+                 (ref-type (environment-reference-type env name)))
+            (cond ((eq? 'macro ref-type)
+                   (loop vars
+                         procs
+                         (cons `(,name ("signature")) syntax)
+                         (cdr bindings)))
+                  ((procedure? value)
+                   (loop vars
+                         (cons
+                          `(,name ("signature" . ,(geiser:operator-arglist name env)))
+                          procs)
+                         syntax
+                         (cdr bindings)))
+                  (else
+                   (loop (cons `(,name) vars)
+                         procs
+                         syntax
+                         (cdr bindings)))))))))
+
+(define (geiser:symbol-documentation symbol)
+  (if (environment-bound? geiser-env symbol)
+      (let ((ref-type (environment-reference-type geiser-env symbol))
+            (value (environment-safe-lookup geiser-env symbol)))
+        (case ref-type
+          ((macro)
+           `(("signature" ,symbol ("args"))
+             ("docstring" . "Macro")))
+          ((unassigned)
+           `(("signature" ,symbol ("args"))
+             ("docstring" . "Value: Unassigned~%")))
+          ((normal)
+           (if (procedure? value)
+               (let ((signature (geiser:operator-arglist symbol geiser-env)))
+                 `(("signature" . ,signature)
+                   ("docstring" . ,(format #f
+                                           "Procedure:~%~a~%"
+                                           (with-output-to-string (lambda () (pp value)))))))
+               `(("signature" ,symbol ("args"))
+                 ("docstring" . ,(format #f
+                                         "Value:~%~a~%"
+                                         (with-output-to-string (lambda () (pp value))))))
+               ))
+          (else
+           `(("signature" ,symbol ("args"))
+             ("docstring" . "Unknown thing...")))))
+      '()))
+
+(define (geiser:symbol-location symbol)
+  (if (environment-bound? geiser-env symbol)
+      (let ((ref-type (environment-reference-type geiser-env symbol))
+            (value (environment-safe-lookup geiser-env symbol)))
+        (if (eq? ref-type 'normal)
+            (let ((file (get-symbol-definition-location value)))
+              `(("name" . ,symbol)
+                ("file" . ,file)
+                ("line")))
+            '()))
+      `(("name" . ,symbol)
+        ("file")
+        ("line"))))
+
+(define (geiser:module-location symbol)
+  `(("name" . ,symbol)
+    ("file")
+    ("line")))
+
+
+(define (geiser:newline)
+  #f)
+
+(define (geiser:no-values)
+  #f)
+
+(define (geiser:set-mit-scheme-source-directory dir)
+  (set! geiser:mit-scheme-source-directory dir))
+
+(define (geiser:callers symbol)
+  symbol
+  #f)
+
+(define (geiser:callees symbol)
+  symbol
+  #f)
+
+(set-geiser-repl-prompt! (package/environment (find-package '(user))))

elpa/geiser-20180626.440/scheme/mit/geiser/geiser.pkg

@@ -0,0 +1,20 @@
+;; -*-Scheme-*-
+(define-package (runtime geiser)
+  (files "emacs")
+  (parent ())
+  (export ()
+          geiser:eval
+          geiser:autodoc
+          geiser:module-completions
+          geiser:completions
+          geiser:ge
+          geiser:load-file
+          geiser:module-exports
+          geiser:symbol-documentation
+          geiser:symbol-location
+          geiser:module-location
+          geiser:callers
+          geiser:callees
+          geiser:set-mit-scheme-source-directory
+          geiser:newline
+          geiser:no-values))

elpa/geiser-20180626.440/scheme/mit/geiser/load.scm

@@ -0,0 +1,11 @@
+(declare (usual-integrations))
+
+(with-working-directory-pathname
+    (directory-pathname (current-load-pathname))
+  (lambda ()
+    (load "compile.scm")
+    (load-package-set "geiser"
+                      `())))
+
+(add-subsystem-identification! "Geiser" '(0 1))
+

elpa/geiser-20180626.440/scheme/racket/geiser/autodoc.rkt

@@ -0,0 +1,315 @@
+;;; autodoc.rkt -- suport for autodoc echo
+
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sun May 03, 2009 14:45
+
+#lang racket
+
+(provide autodoc
+         symbol-documentation
+         module-exports
+         update-signature-cache
+         preload-help
+         get-help)
+
+(require racket/help
+         geiser/utils
+         geiser/modules
+         geiser/locations)
+
+(define loader-thread #f)
+
+(define (preload-help)
+  (set! loader-thread
+        (thread (lambda ()
+                  (with-output-to-string (lambda ()
+                                           (help meh-i-dont-exist)))))))
+
+(define here (current-namespace))
+
+(define (get-help symbol mod)
+  (when loader-thread
+    (thread-wait loader-thread)
+    (set! loader-thread #f))
+  (if (eq? symbol mod)
+      (get-mod-help mod)
+      (with-handlers ([exn? (lambda (_) (eval `(help ,symbol) here))])
+        (eval `(help ,symbol #:from ,(ensure-module-spec mod)) here))))
+
+(define (get-mod-help mod)
+  (let-values ([(ids syns) (module-identifiers mod)])
+    (let ([sym (cond [(not (null? syns)) (car syns)]
+                     [(not (null? ids)) (car ids)]
+                     [else #f])])
+      (and sym (get-help sym mod)))))
+
+(define (symbol-documentation sym)
+  (let* ([val (value sym (symbol-module sym))]
+         [sign (autodoc* sym)])
+    (and sign
+         (list (cons "signature" (autodoc* sym #f))
+               (cons "docstring" (docstring sym val sign))))))
+
+(define (docstring sym val sign)
+  (let* ([mod (assoc "module" (cdr sign))]
+         [mod (if mod (cdr mod) "<unknown>")]
+         [id (namespace-symbol->identifier sym)]
+         [desc (if (identifier? id) (format "~%~%~a" (describe id sym)) "")])
+    (if val
+        (format "A ~a in module ~a.~a~a~a"
+                (if (procedure? val) "procedure" "variable")
+                mod
+                (if (procedure? val)
+                    ""
+                    (format "~%~%Value:~%~%  ~a" val))
+                (if (has-contract? val)
+                    (format "~%~%Contract:~%~%  ~a"
+                            (contract-name (value-contract val)))
+                    "")
+                desc)
+        (format "An identifier in module ~a.~a" mod desc))))
+
+;; Lifted from Eli's interactive.rkt
+(define (describe id s)
+  (define b (identifier-binding id))
+  (cond
+   [(not b) (format "`~s' is a toplevel (or unbound) identifier." s)]
+   [(eq? b 'lexical) (format "`~s' is a lexical identifier." s)]
+   [(or (not (list? b)) (not (= 7 (length b))))
+    "*** internal error, racket changed ***"]
+   [else
+    (let-values ([(source-mod source-id
+                   nominal-source-mod nominal-source-id
+                   source-phase import-phase
+                   nominal-export-phase)
+                  (apply values b)])
+      (let ([aliased (not (eq? s source-id))]
+            [for-syn (eqv? source-phase 1)]
+            [amod (not (equal? source-mod nominal-source-mod))]
+            [aid (not (eq? s nominal-source-id))])
+        (if (or aliased for-syn amod aid)
+            (string-append
+             "Defined"
+             (if for-syn " for syntax" "")
+             (if aliased (format " as `~s' " source-id) "")
+             (if amod
+                 (format " in module ~a\nand required~a in module ~a"
+                         (module-path-index->name source-mod)
+                         (if (eqv? import-phase 1) "-for-syntax" "")
+                         (module-path-index->name nominal-source-mod))
+                 "")
+             (if aid
+                 (format ",\nwhere it is defined as `~s'" nominal-source-id)
+                 "")
+             ".")
+            "")))]))
+
+(define (value id mod)
+  (with-handlers ([exn? (const #f)])
+    (dynamic-require mod id (const #f))))
+
+(define (autodoc ids)
+  (map (lambda (id) (or (autodoc* id) (list id)))
+       (if (list? ids) ids '())))
+
+(define (autodoc* id (extra #t))
+  (define (val)
+    (with-handlers ([exn? (const "")])
+      (parameterize ([error-print-width 60])
+        (format "~.a" (namespace-variable-value id)))))
+  (and
+   (symbol? id)
+   (let* ([loc (symbol-location* id)]
+          [name (car loc)]
+          [path (cdr loc)]
+          [sgns (and path (find-signatures path name id))]
+          [value (if (and extra sgns (not (list? sgns)))
+                     (list (cons "value" (val)))
+                     '())]
+          [mod (if (and extra sgns path)
+                   (list (cons "module"
+                               (module-path-name->name path)))
+                   '())])
+     (and sgns
+          `(,id
+            ("name" . ,name)
+            ("args" ,@(if (list? sgns) (map format-signature sgns) '()))
+            ,@value
+            ,@mod)))))
+
+(define (format-signature sign)
+  (if (signature? sign)
+      `(("required" ,@(signature-required sign))
+        ("optional" ,@(signature-optional sign)
+         ,@(let ((rest (signature-rest sign)))
+             (if rest (list "...") '())))
+        ("key" ,@(signature-keys sign)))
+      '()))
+
+(define signatures (make-hash))
+
+(struct signature (required optional keys rest))
+
+(define (find-signatures path name local-name)
+  (let ([path (if (path? path) (path->string path) path)])
+    (hash-ref! (hash-ref! signatures
+                          path
+                          (lambda () (parse-signatures path)))
+               name
+               (lambda () (infer-signatures local-name)))))
+
+(define (parse-signatures path)
+  (let ([result (make-hasheq)])
+    (with-handlers ([exn? (lambda (e) result)])
+      (with-input-from-file path
+        (lambda ()
+          (parameterize ([read-accept-reader #t])
+            (let loop ([stx (read-syntax path)])
+              (cond [(eof-object? stx) void]
+                    [(syntax->datum stx) =>
+                     (lambda (datum)
+                       (parse-datum! datum result)
+                       (loop (read-syntax path)))]
+                    [else void]))))))
+    result))
+
+(define (parse-datum! datum store)
+  (with-handlers ([exn? (lambda (_) void)])
+    (match datum
+      [`(module ,name ,lang (#%module-begin . ,forms))
+       (for-each (lambda (f) (parse-datum! f store)) forms)]
+      [`(module ,name ,lang . ,forms)
+       (for-each (lambda (f) (parse-datum! f store)) forms)]
+      [`(define ((,name . ,formals) . ,_) . ,_)
+       (add-signature! name formals store)]
+      [`(define (,name . ,formals) . ,_)
+       (add-signature! name formals store)]
+      [`(define ,name (lambda ,formals . ,_))
+       (add-signature! name formals store)]
+      [`(define ,name (case-lambda ,clauses ...))
+       (for-each (lambda (c) (add-signature! name (car c) store))
+                 (reverse clauses))]
+      [`(,(or 'struct 'define-struct) ,name ,(? symbol? _)
+         ,(list formals ...) . ,_)
+       (add-signature! name formals store)]
+      [`(,(or 'struct 'define-struct) ,name ,(list formals ...) . ,_)
+       (add-signature! name formals store)]
+      [`(define-for-syntax (,name . ,formals) . ,_)
+       (add-signature! name formals store)]
+      [`(define-for-syntax ,name (lambda ,formals . ,_))
+       (add-signature! name formals store)]
+      [`(define-syntax-rule (,name . ,formals) . ,_)
+       (add-signature! name formals store)]
+      [`(define-syntax ,name (syntax-rules ,specials . ,clauses))
+       (for-each (lambda (c) (add-syntax-signature! name (cdar c) store))
+                 (reverse clauses))]
+      [`(define-syntax ,name (lambda ,_ (syntax-case ,_ . ,clauses)))
+       (for-each (lambda (c) (add-syntax-signature! name (cdar c) store))
+                 (reverse clauses))]
+      [`(define-type ,_ . ,cases)
+       (for-each (lambda (c) (add-signature! (car c) (cdr c) store)) cases)]
+      [_ void])))
+
+(define (add-signature! name formals store)
+  (when (symbol? name)
+    (hash-set! store
+               name
+               (cons (parse-formals formals)
+                     (hash-ref store name '())))))
+
+(define (add-syntax-signature! name formals store)
+  (when (symbol? name)
+    (hash-set! store
+               name
+               (cons (signature formals '() '() #f)
+                     (hash-ref store name '())))))
+
+(define (parse-formals formals)
+  (let loop ([formals formals] [req '()] [opt '()] [keys '()])
+    (cond [(null? formals)
+           (signature (reverse req) (reverse opt) (reverse keys) #f)]
+          [(symbol? formals)
+           (signature (reverse req) (reverse opt) (reverse keys) formals)]
+          [(pair? (car formals)) (loop (cdr formals)
+                                       req
+                                       (cons (car formals) opt)
+                                       keys)]
+          [(keyword? (car formals)) (let* ((kname (car formals))
+                                           (arg-id (cadr formals))
+                                           (name (if (pair? arg-id)
+                                                     (list kname
+                                                           (cadr arg-id))
+                                                     (list kname))))
+                                      (loop (cddr formals)
+                                            req
+                                            opt
+                                            (cons name keys)))]
+          [else (loop (cdr formals) (cons (car formals) req) opt keys)])))
+
+(define (infer-signatures name)
+  (with-handlers ([exn:fail:syntax? (const `(,(signature '(...) '() '() #f)))]
+                  [exn:fail:contract:variable? (const #f)])
+    (let ([v (namespace-variable-value name)])
+      (if (procedure? v)
+          (arity->signatures (procedure-arity v))
+          'variable))))
+
+(define (arity->signatures arity)
+  (define (args count) (build-list count (const '_)))
+  (define (arity->signature arity)
+    (cond [(number? arity)
+           (signature (args arity) '() '() #f)]
+          [(arity-at-least? arity)
+           (signature (args (arity-at-least-value arity)) '() '() 'rest)]))
+  (define (conseq? lst)
+    (cond [(< (length lst) 2) (number? (car lst))]
+          [(and (number? (car lst))
+                (number? (cadr lst))
+                (eqv? (+ 1 (car lst)) (cadr lst)))
+           (conseq? (cdr lst))]
+          [else #f]))
+  (cond [(and (list? arity) (conseq? arity))
+         (let ((mi (apply min arity))
+               (ma (apply max arity)))
+           (list (signature (args mi) (args (- ma mi)) '() #f)))]
+        [(list? arity) (map arity->signature arity)]
+        [else (list (arity->signature arity))]))
+
+(define (update-signature-cache path (form #f))
+  (when (and (string? path)
+             (or (not form)
+                 (and (list? form)
+                      (not (null? form))
+                      (memq (car form)
+                            '(define-syntax-rule struct
+                               define-syntax define set! define-struct)))))
+    (hash-remove! signatures path)))
+
+(define (module-exports mod)
+  (define (contracted id)
+    (let ([v (value id mod)])
+      (if (has-contract? v)
+          (list id (cons "info" (contract-name (value-contract v))))
+          (entry id))))
+  (define (entry id)
+    (let ((sign (eval `(,autodoc* ',id #f)
+                      (module-spec->namespace mod #f #f))))
+      (if sign (list id (cons "signature" sign)) (list id))))
+  (define (classify-ids ids)
+    (let loop ([ids ids] [procs '()] [vars '()])
+      (cond [(null? ids)
+             `(("procs" ,@(map entry (reverse procs)))
+               ("vars" ,@(map list (reverse vars))))]
+            [(procedure? (value (car ids) mod))
+             (loop (cdr ids) (cons (car ids) procs) vars)]
+            [else (loop (cdr ids) procs (cons (car ids) vars))])))
+  (let-values ([(ids syn) (module-identifiers mod)])
+    `(,@(classify-ids ids)
+      ("syntax" ,@(map contracted syn))
+      ("modules" ,@(map list (or (submodules mod) '()))))))

elpa/geiser-20180626.440/scheme/racket/geiser/completions.rkt

@@ -0,0 +1,29 @@
+;;; completions.rkt -- completion support
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sun Apr 26, 2009 19:02
+
+#lang racket
+
+(provide symbol-completions
+         module-completions)
+
+(require srfi/13 geiser/utils geiser/modules)
+
+(define (filter-prefix prefix lst sort?)
+  (filter (lambda (s) (string-prefix? prefix s))
+          (if sort? (sort lst string<?) lst)))
+
+(define (symbol-completions prefix)
+  (filter-prefix prefix
+                 (map symbol->string (namespace-mapped-symbols))
+                 #t))
+
+(define (module-completions prefix)
+  (filter-prefix prefix (module-list) #f))

elpa/geiser-20180626.440/scheme/racket/geiser/enter.rkt

@@ -0,0 +1,155 @@
+;;; enter.rkt -- custom module loaders
+
+;; Copyright (C) 2010, 2012, 2013, 2014 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Wed Mar 31, 2010 21:53
+
+#lang racket/base
+
+(require syntax/modcode
+         (for-syntax racket/base)
+         racket/path)
+
+(provide get-namespace visit-module module-loader)
+
+(struct mod (name load-path timestamp depends) #:transparent)
+
+(define (make-mod name path ts code)
+  (let ([deps (if code
+                  (apply append (map cdr (module-compiled-imports code)))
+                  null)])
+    (mod name (path->string path) ts deps)))
+
+(define loaded (make-hash))
+
+(define (mod->path mod)
+  (with-handlers ([exn? (lambda (_) #f)])
+    (let ([rp (module-path-index-resolve (module-path-index-join mod #f))])
+      (resolved-module-path-name rp))))
+
+(define (visit-module mod)
+  (dynamic-require mod #f)
+  (check-latest mod))
+
+(define (module-loader orig)
+  (make-loader orig #f))
+
+(define inhibit-eval (make-parameter #f))
+
+(define (get-namespace mod)
+  (let ([mod (cond [(symbol? mod) mod]
+                   [(string? mod) (find-module! (string->path mod) mod)]
+                   [(path? mod) (find-module! mod (path->string mod))]
+                   [else mod])])
+    (and mod
+         (with-handlers ([exn? (lambda (_) #f)])
+           (parameterize ([inhibit-eval #t])
+             (module->namespace mod))))))
+
+(define (find-module! path path-str)
+  (let ([m (or (hash-ref loaded path #f)
+               (let loop ([ps (remove path (resolve-paths path))]
+                          [seen '()])
+                 (cond [(null? ps) #f]
+                       [(hash-ref loaded (car ps) #f) =>
+                        (lambda (m)
+                          (add-paths! m (cdr ps))
+                          (add-paths! m (cons path seen))
+                          m)]
+                       [else (loop (cdr ps) (cons (car ps) seen))])))])
+    (list 'file (or (and m (mod-load-path m)) path-str))))
+
+(define (add-paths! m ps)
+  (for-each (lambda (p) (hash-set! loaded p m)) ps))
+
+(define (resolve-paths path)
+  (define (find root rest)
+    (let* ([alt-root (resolve-path root)]
+           [same? (equal? root alt-root)])
+      (cond [(null? rest) (cons root (if same? '() `(,alt-root)))]
+            [else (let* ([c (car rest)]
+                         [cs (cdr rest)]
+                         [rps (find (build-path root c) cs)])
+                    (if same?
+                        rps
+                        (append rps (find (build-path alt-root c) cs))))])))
+  (let ([cmps (explode-path path)])
+    (find (car cmps) (cdr cmps))))
+
+(define (notify re? path)
+  (when re? (fprintf (current-error-port) " [re-loading ~a]\n" path)))
+
+(define (module-name? name)
+  (and name (not (and (pair? name) (not (car name))))))
+
+(define (module-code re? name path)
+  (get-module-code path
+                   "compiled"
+                   (lambda (e)
+                     (parameterize ([compile-enforce-module-constants #f])
+                       (compile-syntax e)))
+                   (lambda (ext loader?) (load-extension ext) #f)
+                   #:notify (lambda (chosen) (notify re? chosen))))
+
+(define ((make-loader orig re?) path name)
+  (when (inhibit-eval)
+    (raise (make-exn:fail "namespace not found" (current-continuation-marks))))
+  (if (module-name? name)
+      ;; Module load:
+      (with-handlers ([(lambda (exn)
+                         (and (pair? name) (exn:get-module-code? exn)))
+                       ;; Load-handler protocol: quiet failure when a
+                       ;; submodule is not found
+                       (lambda (exn) (void))])
+        (let* ([code (module-code re? name path)]
+               [dir (or (current-load-relative-directory) (current-directory))]
+               [path (path->complete-path path dir)]
+               [path (normal-case-path (simplify-path path))])
+          (define-values (ts real-path) (get-timestamp path))
+          (add-paths! (make-mod name path ts code) (resolve-paths path))
+          (parameterize ([current-module-declare-source real-path])
+            (eval code))))
+      ;; Not a module:
+      (begin (notify re? path) (orig path name))))
+
+(define (get-timestamp path)
+  (let ([ts (file-or-directory-modify-seconds path #f (lambda () #f))])
+    (if ts
+        (values ts path)
+        (if (regexp-match? #rx#"[.]rkt$" (path->bytes path))
+            (let* ([alt-path (path-replace-suffix path #".ss")]
+                   [ts (file-or-directory-modify-seconds alt-path
+                                                         #f
+                                                         (lambda () #f))])
+              (if ts
+                  (values ts alt-path)
+                  (values -inf.0 path)))
+            (values -inf.0 path)))))
+
+(define (check-latest mod)
+  (define mpi (module-path-index-join mod #f))
+  (define done (make-hash))
+  (let loop ([mpi mpi])
+    (define rindex (module-path-index-resolve mpi))
+    (define rpath (resolved-module-path-name rindex))
+    (define path (if (pair? rpath) (car rpath) rpath))
+    (when (path? path)
+      (define npath (normal-case-path path))
+      (unless (hash-ref done npath #f)
+        (hash-set! done npath #t)
+        (define mod (hash-ref loaded rpath #f))
+        (when mod
+          (for-each loop (mod-depends mod))
+          (define-values (ts actual-path) (get-timestamp npath))
+          (when (> ts (mod-timestamp mod))
+            (define orig (current-load/use-compiled))
+            (parameterize ([current-load/use-compiled
+                            (make-loader orig #f)]
+                           [current-module-declare-name rindex]
+                           [current-module-declare-source actual-path])
+              ((make-loader orig #f) npath (mod-name mod)))))))))

elpa/geiser-20180626.440/scheme/racket/geiser/eval.rkt

@@ -0,0 +1,83 @@
+;;; eval.rkt -- evaluation
+
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sun Apr 26, 2009 00:44
+
+#lang racket
+
+(provide eval-in
+         load-file
+         macroexpand
+         add-to-load-path
+         make-repl-reader
+         call-with-result)
+
+(require geiser/enter geiser/modules geiser/images)
+(require errortrace/errortrace-lib)
+
+(define last-result (void))
+
+(define last-namespace (make-parameter (current-namespace)))
+
+(define (exn-key e)
+  (vector-ref (struct->vector e) 0))
+
+(define (set-last-error e)
+  (set! last-result `((error (key . ,(exn-key e)))))
+  (display (exn-message e))
+  (newline) (newline)
+  (parameterize ([error-context-display-depth 10])
+    (print-error-trace (current-output-port) e)))
+
+(define (write-value v)
+  (with-output-to-string
+    (lambda () (maybe-write-image v))))
+
+(define (set-last-result . vs)
+  (set! last-result `((result ,@(map write-value vs)))))
+
+(define (call-with-result thunk)
+  (set-last-result (void))
+  (let ([output
+         (with-output-to-string
+           (lambda ()
+             (parameterize ([current-error-port (current-output-port)])
+               (with-handlers ([exn? set-last-error])
+                 (call-with-values thunk set-last-result)))))])
+    (append last-result `(,(cons 'output output)))))
+
+(define (eval-in form spec lang . non-top)
+  (write (call-with-result
+          (lambda ()
+            (eval (if (null? non-top) (cons '#%top-interaction form) form)
+                  (module-spec->namespace spec lang)))))
+  (newline))
+
+(define (load-file file)
+  (load-module file (current-output-port) (last-namespace)))
+
+(define (macroexpand form . all)
+  (let ([all (and (not (null? all)) (car all))])
+    (with-output-to-string
+      (lambda ()
+        (pretty-print (syntax->datum ((if all expand expand-once) form)))))))
+
+(define (add-to-load-path p)
+  (when (string? p)
+    (let ([p (string->path p)]
+          [cps (current-library-collection-paths)])
+      (unless (member p cps)
+        (current-library-collection-paths
+         (cons p cps)))))
+  #t)
+
+(define (make-repl-reader reader)
+  (lambda ()
+    (last-namespace (current-namespace))
+    (reader)))

elpa/geiser-20180626.440/scheme/racket/geiser/images.rkt

@@ -0,0 +1,66 @@
+;;; images.rkt -- support for image handline
+
+;; Copyright (C) 2012, 2014 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Sun Sep 2, 2012 18:54
+
+
+#lang racket/base
+
+(require racket/file file/convertible racket/pretty)
+(provide image-cache
+         maybe-print-image
+         maybe-write-image
+         make-port-print-handler
+         make-pretty-print-size-hook
+         make-pretty-print-print-hook)
+
+(define image-cache
+  (let ([ensure-dir (lambda (dir)
+                      (if (path-string? dir)
+                          (begin (make-directory* dir)
+                                 (if (path? dir) (path->string dir) dir))
+                          (path->string (find-system-path 'temp-dir))))])
+    (make-parameter (ensure-dir #f) ensure-dir)))
+
+(define (save-tmpimage imgbytes)
+  ;; Save imgbytes to a new temporary file and return the filename
+  (define filename (make-temporary-file "geiser-img-~a.png" #f (image-cache)))
+  (with-output-to-file filename #:exists 'truncate
+                       (lambda () (display imgbytes)))
+  (format "#<Image: ~a>" filename))
+
+(define (maybe-save-image value)
+  (and (convertible? value)
+       ;; (The above could be problematic if a future version of racket
+       ;; suddenly decides it can "convert" strings to picts)
+       (save-tmpimage (convert value 'png-bytes))))
+
+(define (maybe-print-image value)
+  (cond [(maybe-save-image value) => (lambda (s) (printf "~a\n" s))]
+        [else (unless (void? value)
+                (pretty-print value))]))
+
+(define (maybe-write-image value)
+  (write (or (maybe-save-image value) value)))
+
+(define (make-port-print-handler ph)
+  (lambda (value port . rest)
+    (apply ph (or (maybe-save-image value) value) port rest)))
+
+(define (make-pretty-print-size-hook [orig (pretty-print-size-hook)])
+  (lambda (value display? port)
+    (if (convertible? value)
+        (pretty-print-columns)
+        (orig value display? port))))
+
+(define (make-pretty-print-print-hook [orig (pretty-print-print-hook)])
+  (lambda (value display? port)
+    (let [(img (maybe-save-image value))]
+      (if img (print img port) (orig value display? port)))))

elpa/geiser-20180626.440/scheme/racket/geiser/locations.rkt

@@ -0,0 +1,58 @@
+;;; locations.rkt -- locating symbols
+
+;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sun Apr 26, 2009 19:43
+
+#lang racket
+
+(provide symbol-location
+         symbol-location*
+         module-location
+         symbol-module
+         symbol-module-name)
+
+(require geiser/utils geiser/modules)
+
+(define (symbol-location* sym)
+  (let* ([id (namespace-symbol->identifier sym)]
+         [binding (and id (identifier-binding id))])
+    (if (list? binding)
+        (cons
+         (cadr binding)
+         (resolved-module-path-name
+          (module-path-index-resolve (car binding))))
+        (cons sym #f))))
+
+(define (switch-extension path)
+  (if (regexp-match? "\\.rkt$" path)
+      (regexp-replace "\\.rkt$" path ".ss")
+      (regexp-replace "\\.ss$" path ".rkt")))
+
+(define (make-location name path line)
+  (let* ([path (if (path? path) (path->string path) #f)]
+         [path (and path (if (file-exists? path) path (switch-extension path)))])
+    (list (cons "name" name)
+          (cons "file" (or path '()))
+          (cons "line" (or line '())))))
+
+(define (symbol-location sym)
+  (let* ([loc (symbol-location* sym)]
+         [name (car loc)]
+         [path (cdr loc)])
+    (if path
+        (make-location name path #f)
+        (module-location sym))))
+
+(define symbol-module (compose cdr symbol-location*))
+
+(define symbol-module-name
+  (compose module-path-name->name symbol-module))
+
+(define (module-location sym)
+  (make-location sym (module-spec->path-name sym) 1))

elpa/geiser-20180626.440/scheme/racket/geiser/main.rkt

@@ -0,0 +1,57 @@
+;;; main.rkt -- exported interface for emacs
+
+;; Copyright (C) 2010, 2011 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Wed Mar 31, 2010 21:14
+
+#lang racket/base
+
+(provide geiser:eval
+         geiser:compile
+         geiser:load-file
+         geiser:compile-file
+         geiser:macroexpand
+         geiser:completions
+         geiser:module-completions
+         geiser:symbol-location
+         geiser:module-location
+         geiser:module-exports
+         geiser:autodoc
+         geiser:symbol-documentation
+         geiser:help
+         geiser:no-values)
+
+(require geiser/eval
+         geiser/modules
+         geiser/completions
+         geiser/locations
+         geiser/autodoc)
+
+(define (geiser:eval lang)
+  (lambda (form spec)
+    (update-signature-cache spec form)
+    (eval-in form spec lang)))
+
+(define geiser:compile geiser:eval)
+
+(define (geiser:load-file file)
+  (update-signature-cache file)
+  (load-file file))
+
+(define geiser:compile-file geiser:load-file)
+(define geiser:add-to-load-path add-to-load-path)
+(define geiser:autodoc autodoc)
+(define geiser:help get-help)
+(define geiser:completions symbol-completions)
+(define geiser:module-completions module-completions)
+(define geiser:symbol-location symbol-location)
+(define geiser:module-location module-location)
+(define geiser:module-exports module-exports)
+(define geiser:macroexpand macroexpand)
+(define geiser:symbol-documentation symbol-documentation)
+(define (geiser:no-values) (values))

elpa/geiser-20180626.440/scheme/racket/geiser/modules.rkt

@@ -0,0 +1,227 @@
+;;; modules.rkt -- module metadata
+
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Wed May 06, 2009 02:35
+
+#lang racket
+
+(provide load-module
+         ensure-module-spec
+         module-spec->namespace
+	 namespace->module-name
+         namespace->module-path-name
+         module-path-name->name
+         module-spec->path-name
+         module-path-index->name
+         module-identifiers
+         module-list
+         submodules)
+
+(require srfi/13
+         syntax/modcode
+         syntax/modresolve
+         geiser/enter)
+
+(define (ensure-module-spec spec)
+  (cond [(symbol? spec) spec]
+        [(not (string? spec)) #f]
+        [else `(file ,spec)]))
+
+(define (module-spec->namespace spec (lang #f) (current #t))
+  (define (try-lang)
+    (and lang
+         (with-handlers ([exn? (const #f)])
+           (load-module lang #f (current-namespace))
+           (module->namespace lang))))
+  (or (get-namespace spec)
+      (try-lang)
+      (and current (current-namespace))))
+
+(define nowhere (open-output-nowhere))
+
+(define (load-module spec (port #f) (ns #f))
+  (parameterize ([current-error-port (or port nowhere)])
+    (visit-module (ensure-module-spec spec))
+    (when (namespace? ns)
+      (current-namespace ns))))
+
+(define (namespace->rmp ns)
+  (with-handlers ([exn? (const #f)])
+    (variable-reference->resolved-module-path
+     (eval '(#%variable-reference) (or ns (current-namespace))))))
+
+(define (namespace->module-path-name ns (p #f))
+  (let ([rmp (namespace->rmp ns)])
+    (or (and (resolved-module-path? rmp)
+             (resolved-module-path-name rmp))
+        p)))
+
+(define (module-spec->path-name spec)
+  (and (symbol? spec)
+       (or (get-path spec)
+           (register-path spec
+                          (namespace->module-path-name
+                           (module-spec->namespace spec #f #f))))))
+
+(define unknown-module-name "*unresolved module*")
+
+(define (unix-path->string path)
+  (regexp-replace* "\\\\" (path->string path) "/"))
+
+(define (path->name path)
+  (if (path-string? path)
+      (let* ([cpaths (map (compose unix-path->string path->directory-path)
+                          (current-library-collection-paths))]
+             [prefix-len (lambda (p)
+                           (let ((pl (string-length p)))
+                             (if (= pl (string-prefix-length p path))
+                                 pl
+                                 0)))]
+             [lens (map prefix-len cpaths)]
+             [real-path (substring path (apply max lens))])
+        (if (absolute-path? real-path)
+            (let-values ([(_ base __) (split-path path)])
+              (unix-path->string base))
+            (regexp-replace "\\.[^./]*$" real-path "")))
+      path))
+
+(define (module-path-name->name path)
+  (cond [(path? path) (module-path-name->name (unix-path->string path))]
+        ;; [(eq? path '#%kernel) "(kernel)"]
+        [(path-string? path) (path->name path)]
+        [(symbol? path) (symbol->string path)]
+        [(list? path) (string-join (map (compose path->name ~a) path) "/")]
+        [else (~a path)]))
+
+(define (module-path-index->name mpi)
+  (let ([rmp (module-path-index-resolve mpi)])
+    (if (resolved-module-path? rmp)
+        (module-path-name->name (resolved-module-path-name rmp))
+        unknown-module-name)))
+
+(define (namespace->module-name ns (p #f))
+  (module-path-name->name (namespace->module-path-name ns p)))
+
+(define (module-identifiers mod)
+  (define (extract-ids ls)
+    (append-map (lambda (idls)
+                  (map car (cdr idls)))
+                ls))
+  (let-values ([(reg syn)
+                (module-compiled-exports
+                 (get-module-code (resolve-module-path
+                                   (ensure-module-spec mod) #f)))])
+    (values (extract-ids reg) (extract-ids syn))))
+
+(define (skippable-dir? path)
+  (call-with-values (lambda () (split-path path))
+    (lambda (_ basename __)
+      (member (path->string basename) '(".svn" "compiled")))))
+
+(define path->symbol (compose string->symbol unix-path->string))
+
+(define (path->entry path)
+  (let ([ext (filename-extension path)])
+    (and ext
+         (or (bytes=? ext #"rkt") (bytes=? ext #"ss"))
+         (not (bytes=? (bytes-append #"main" ext) (path->bytes path)))
+         (let* ([path (unix-path->string path)]
+                [len (- (string-length path) (bytes-length ext) 1)])
+           (substring path 0 len)))))
+
+(define (ensure-path datum)
+  (if (string? datum)
+      (string->path datum)
+      datum))
+
+(define main-rkt (build-path "main.rkt"))
+(define main-ss (build-path "main.ss"))
+
+(define ((visit-module-path reg?) path kind acc)
+  (define (register e p)
+    (when reg?
+      (register-path (string->symbol e) (build-path (current-directory) p)))
+    (values (cons e acc) reg?))
+  (define (get-main path main)
+    (and (file-exists? main) (build-path path main)))
+  (define (find-main path)
+    (parameterize ([current-directory path])
+      (or (get-main path main-rkt) (get-main path main-ss))))
+  (case kind
+    [(file) (let ([entry (path->entry path)])
+              (if (not entry) acc (register entry path)))]
+    [(dir) (cond [(skippable-dir? path) (values acc #f)]
+                 [(find-main path) => (curry register (unix-path->string path))]
+                 [else (values acc reg?)])]
+    [else acc]))
+
+(define ((find-modules reg?) path acc)
+  (if (directory-exists? path)
+      (parameterize ([current-directory path])
+        (fold-files (visit-module-path reg?) acc))
+      acc))
+
+(define (take-while pred lst)
+  (let loop ([lst lst] [acc '()])
+    (cond [(null? lst) (reverse acc)]
+          [(pred (car lst)) (loop (cdr lst) (cons (car lst) acc))]
+          [else (reverse acc)])))
+
+(define (submodules mod)
+  (let* ([mod-name (if (symbol? mod) mod (get-mod mod))]
+         [mod-str (and (symbol? mod-name) (symbol->string mod-name))])
+    (if mod-str
+        (let ([ms (member mod-str (module-list))])
+          (and ms
+               (take-while (lambda (m) (string-prefix? mod-str m))
+                           (cdr ms))))
+        (find-submodules mod))))
+
+(define (find-submodules path)
+  (and (path-string? path)
+       (let-values ([(dir base ign) (split-path path)])
+         (and (or (equal? base main-rkt)
+                  (equal? base main-ss))
+              (map (lambda (m) (unix-path->string (build-path dir m)))
+                   (remove "main" ((find-modules #f) dir '())))))))
+
+(define (known-modules)
+  (sort (foldl (find-modules #t)
+               '()
+               (current-library-collection-paths))
+        string<?))
+
+(define registered (make-hash))
+(define registered-paths (make-hash))
+
+(define (get-path mod)
+  (hash-ref registered mod #f))
+
+(define (get-mod path)
+  (hash-ref registered-paths path #f))
+
+(define (register-path mod path)
+  (hash-set! registered mod path)
+  (hash-set! registered-paths path mod)
+  path)
+
+(define module-cache #f)
+
+(define (update-module-cache)
+  (when (not module-cache) (set! module-cache (known-modules))))
+
+(define (module-list)
+  (update-module-cache)
+  module-cache)
+
+(define (startup)
+ (thread update-module-cache)
+ (void))
+
+(startup)

elpa/geiser-20180626.440/scheme/racket/geiser/server.rkt

@@ -0,0 +1,16 @@
+;;; server.rkt -- REPL server
+
+;; Copyright (c) 2010 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sat Nov 06, 2010 15:15
+
+#lang racket/base
+
+(require geiser/user)
+(provide start-geiser)
+

elpa/geiser-20180626.440/scheme/racket/geiser/startup.rkt

@@ -0,0 +1,15 @@
+;;; startup.rkt -- entry point
+
+;; Copyright (C) 2009, 2010, 2013, 2014 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sat Apr 25, 2009 22:36
+
+;; (require errortrace)
+(require geiser/user)
+
+(init-geiser-repl)

elpa/geiser-20180626.440/scheme/racket/geiser/user.rkt

@@ -0,0 +1,172 @@
+;;; user.rkt -- global bindings visible to geiser users
+
+;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Wed Mar 31, 2010 22:24
+
+#lang racket
+
+(provide init-geiser-repl run-geiser-server start-geiser)
+
+(require (for-syntax racket/base)
+         mzlib/thread
+         racket/tcp
+         racket/help
+         geiser
+         geiser/autodoc
+         geiser/images
+         geiser/enter
+         geiser/eval
+         geiser/modules)
+
+(define top-namespace (current-namespace))
+(define last-entered (make-parameter ""))
+
+(define (do-enter mod name)
+  (visit-module mod)
+  (last-entered name)
+  (current-namespace (module->namespace mod)))
+
+(define (file-mod? mod)
+  (and (list? mod)
+       (= 2 (length mod))
+       (eq? 'file (car mod))
+       (path-string? (cadr mod))))
+
+(define (submod-path mod)
+  (and (list? mod)
+       (eq? 'submod (car mod))
+       (> (length mod) 1)
+       (let ([parent (cadr mod)])
+         (cond [(path-string? parent) `(submod (file ,parent) ,@(cddr mod))]
+               [(file-mod? parent) mod]
+               [(symbol? parent) mod]
+               [else #f]))))
+
+(define (module-error stx mod)
+  (raise-syntax-error #f "Invalid module path" stx mod))
+
+(define (enter! mod stx)
+  (cond [(not mod)
+         (current-namespace top-namespace)
+         (last-entered "")]
+        [(symbol? mod) (do-enter mod (symbol->string mod))]
+        [(path-string? mod) (do-enter `(file ,mod) mod)]
+        [(file-mod? mod) (do-enter mod (cadr mod))]
+        [(submod-path mod) => (lambda (m) (do-enter m m))]
+        [else (module-error stx mod)]))
+
+(define (geiser-eval)
+  (define geiser-main (module->namespace 'geiser))
+  (define (eval-here form) (eval form geiser-main))
+  (let* ([mod (read)]
+         [lang (read)]
+         [form (read)]
+         [res (cond [(equal? form '(unquote apply))
+                     (let* ([proc (eval-here (read))]
+                            [args (map eval-here (read))]
+                            [ev (lambda () (apply proc args))])
+                       (eval-in `(,ev) mod lang #t))]
+                    [else ((geiser:eval lang) form mod)])])
+    (datum->syntax #f (list 'quote res))))
+
+(define (geiser-load stx)
+  (let* ([mod (read)]
+         [res (call-with-result
+               (lambda ()
+                 (visit-module (cond [(file-mod? mod) mod]
+                                     [(path-string? mod) `(file ,mod)]
+                                     [(submod-path mod)]
+                                     [else (module-error stx mod)]))
+                 (void)))])
+    (datum->syntax stx (list 'quote res))))
+
+(define ((geiser-read prompt))
+  (prompt)
+  (flush-output (current-error-port))
+  (flush-output (current-output-port))
+  (let* ([in ((current-get-interaction-input-port))]
+	 [form ((current-read-interaction) (object-name in) in)])
+    (syntax-case form ()
+      [(uq cmd) (eq? 'unquote (syntax-e #'uq))
+       (case (syntax-e #'cmd)
+         [(start-geiser) (datum->syntax #f `(list 'port ,(start-geiser)))]
+         [(enter) (enter! (read) #'cmd)]
+         [(geiser-eval) (geiser-eval)]
+         [(geiser-load) (geiser-load #'cmd)]
+         [(geiser-no-values) (datum->syntax #f (void))]
+         [(add-to-load-path) (add-to-load-path (read))]
+         [(set-image-cache) (image-cache (read))]
+         [(help) (get-help (read) (read))]
+         [(image-cache) (image-cache)]
+         [(pwd) (~a (current-directory))]
+         [(cd) (current-directory (~a (read)))]
+         [else form])]
+      [_ form])))
+
+(define geiser-prompt
+  (lambda ()
+    (let ([m (namespace->module-name (current-namespace) (last-entered))])
+      (printf "racket@~a> " (regexp-replace* " " m "_")))))
+
+(define (geiser-prompt-read prompt)
+  (make-repl-reader (geiser-read prompt)))
+
+(define (geiser-loader) (module-loader (current-load/use-compiled)))
+
+(define (install-print-handler handler)
+  (let ([p (current-output-port)])
+    (handler p (make-port-print-handler (handler p)))))
+
+(define (install-print-handlers)
+  (for-each install-print-handler (list port-print-handler
+                                        port-write-handler
+                                        port-display-handler))
+  (pretty-print-print-hook (make-pretty-print-print-hook))
+  (pretty-print-size-hook (make-pretty-print-size-hook)))
+
+(define (init-geiser-repl)
+  (compile-enforce-module-constants #f)
+  (current-load/use-compiled (geiser-loader))
+  (preload-help)
+  (current-prompt-read (geiser-prompt-read geiser-prompt))
+  (current-print maybe-print-image)
+  (install-print-handlers))
+
+(define (run-geiser-repl in out enforce-module-constants)
+  (parameterize [(compile-enforce-module-constants enforce-module-constants)
+                 (current-input-port in)
+                 (current-output-port out)
+                 (current-error-port out)
+                 (current-load/use-compiled (geiser-loader))
+                 (current-prompt-read (geiser-prompt-read geiser-prompt))
+                 (current-print maybe-print-image)
+                 (pretty-print-print-hook (make-pretty-print-print-hook))
+                 (pretty-print-size-hook (make-pretty-print-size-hook))]
+    (install-print-handlers)
+    (preload-help)
+    (read-eval-print-loop)))
+
+(define server-channel (make-channel))
+
+(define (run-geiser-server port enforce-module-constants (hostname #f))
+  (run-server port
+              (lambda (in out)
+                (run-geiser-repl in out enforce-module-constants))
+              #f
+              void
+              (lambda (p _ __)
+                (let ([lsner (tcp-listen p 4 #f hostname)])
+                  (let-values ([(_ p __ ___) (tcp-addresses lsner #t)])
+                    (channel-put server-channel p)
+                    lsner)))))
+
+(define (start-geiser (port 0) (hostname #f) (enforce-module-constants #f))
+  (thread (lambda ()
+            (run-geiser-server port enforce-module-constants hostname)))
+  (channel-get server-channel))

elpa/geiser-20180626.440/scheme/racket/geiser/utils.rkt

@@ -0,0 +1,25 @@
+;;; utils.rkt -- generic utilities
+
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the Modified BSD License. You should
+;; have received a copy of the license along with this program. If
+;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;; Start date: Sun May 03, 2009 03:09
+
+#lang racket
+
+(provide pair->list
+         keyword->symbol
+         symbol->keyword)
+
+(define (pair->list pair)
+  (let loop ([d pair] [s '()])
+    (cond [(null? d) (reverse s)]
+          [(symbol? d) (reverse (cons d s))]
+          [else (loop (cdr d) (cons (car d) s))])))
+
+(define keyword->symbol (compose string->symbol keyword->string))
+(define (symbol->keyword sym) (string->keyword (format "~a" sym)))