(module language scheme/base

  (require "util.ss"
           scheme/control)
  
  (provide (all-defined-out))
  
  ;; LANGUAGE MANAGEMENT
  
  (define-struct language-properties
    (prompt            ;; prompt string
     eval              ;; expression evaluation
     rep               ;; one way read-eval-print (scheme prints value, returns void)
     complete))        ;; name space symbol completion

  (define *languages* (make-hash))

  (define *active-repls* '(image box box-macro))


  (define (register-language . def)
    (let ((name  (car def))
          (props (cdr def)))
      (hash-set! *languages*
                 name
                 (apply make-language-properties props))))
  
  ;; Languages are stored on a stack. The 'current' one is the top.
  (define (language name)
    (if (eq? name 'current)
        (language (car *active-repls*))
        (hash-ref *languages*
                  name
                  (lambda ()
                    (raise `(language-not-found ,name))))))
  
  (define (language-exists? name)
    (and (hash-ref *languages* name
                   (lambda () #f))
         #t))

  (define (language-list)
    (hash-map *languages*
              (lambda record (car record))))

  ;; The public interface consists of 'prompt', 'eval',
  ;; 'eval-repl' and 'complete'.

  (define (language-eval l expr)
    ((language-properties-eval (language l)) expr))

  ;; Repl is delimited by a prompt (lib "control.ss")
  (define (language-rep  l str)
    (with-error-print "" ;; "language-rep-error:\n"
                      ((language-properties-rep (language l)) str)))
  
  (define (language-complete l str) 
    ((language-properties-complete (language l)) str))


  (define (language-prompt name)
    (language-properties-prompt (language name)))
  

  
  (define (cycle-languages r)
    (define (maybe-reverse)
      (when r
        (set! *active-repls* (reverse *active-repls*))))
    (maybe-reverse)
    (set! *active-repls*
          `(,@(cdr *active-repls*)
            ,(car *active-repls*)))
    (maybe-reverse))

  (define (next-language) (cycle-languages #f))
  (define (previous-language) (cycle-languages #t))
  
  (define (repls lst)
    (let ((new '()))
      (for-each
       (lambda (l)
         (and (language l)
              (set! new (cons l new))))
       (reverse lst))
      (set! *active-repls* new)))
    

  
  ;; TOPLEVEL SCHEME LANGUAGE

  ;; This is just the toplevel eval. It doesn't feel entirely
  ;; comfortable that the emacs code (snot-eval e) and (snot-eval
  ;; `(snot-language-eval 'scheme ,e)) are the same, but it is the
  ;; easiest way to give a toplevel repl.


  (define image-complete
    (make-completer namespace-mapped-symbols))

  (define (image-eval expr)
    (eval expr))

  (define (image-repl str)
    (eval-repl eval str))

  (register-language 'image
                     "image> "
                     image-eval
                     image-repl
                     image-complete)
  


  
  
  )