;; This is SNOT, a means to tie emacs to mzscheme.

;; I wrote this because I wanted a way to interact with a bunch of
;; different languages inside a single mzscheme process. (The BROOD
;; project has a mix of scheme and forth.)

;; What i wanted was:

;; * an interactive REPL (language side prints) for each language
;; * synchronous remote evaluation (value returned to emacs)

;; In snot, both are implemented in parallel to allow (asynchronous)
;; interactive use and (synchronous) remote procedure calls to be used
;; at the same time. The REPL is always tied to the 'current'
;; language, maintained by the snot process.

;; The low level protol is very simple: scheme sends raw emacs
;; expressions, and emacs sends raw scheme expressions, prepended
;; with the channel name. Currently there are 2 channels: 'eval' is
;; the synchronous one, and 'message' the asynchronous one. Both are
;; handled differently from the emacs side.


(module snot scheme/base
  (require ;; (lib "list.ss")
           (lib "async-channel.ss")

           "util.ss"
           "emacs-channel.ss"  ;; communication
           "language.ss"       ;; language management
           "box.ss"            ;; sandboxed scheme
           )

;;  (provide (all-defined))
  
  (provide register-language
           mainloop

           eval/continue       ;; evaluate and pass to elisp continuation

           language-eval       ;; evaluate language expression
           language-rep        ;; read-eval-print for language
           language-complete

           ;; utilities
           make-completer
           pp
           box-module-file
           box-module-string
           box-toplevel
           box-mb
           box-sec
           box-load
           box-eval
           box-break
           debug
           initrc
           snot-load/cd

           ;; repl state
           next-language
           previous-language
           repls

           ;; emacs output
           emacs-printf
           emacs-send
           emacs-display
           emacs-display-image
           emacs-display-prompt
           emacs-message-printf
           emacs-limit-output
           
           )

  ;; TOOLS

  ;; In addition to the specified search path, look in the current
  ;; directories of box and toplevel.

  (define (snot-load/cd path [search '()])
    (define (cmd-paths)
      (list (language-eval 'box '(current-directory))
            (current-directory)))
    (define (load/false path)
      ;; (printf "trying: ~a\n" path)
      (and (file-exists? path) (load/cd path)))
    (define (file/dir path)
      (or (load/false path)
          (load/false (build-path path ".snot"))))
    (or (file/dir path)
        (and (not (absolute-path? path))
             (ormap
              (lambda (pre)
                (file/dir (build-path pre path)))
              (append search (cmd-paths))))
        (error 'file-not-found "~s" path)))



  ;; CONTROL

  ;; Update emacs' idea of prompt + display it in the output buffer.
  
  (define (emacs-display-prompt)
    (let ((p (language-prompt 'current)))
      (emacs-send `(snot-update-prompt ,p))
      (emacs-display p)))
  

  ;; The main evaluator. This returns one of:
  ;; - (values . <value list>)
  ;; - (error <error rep>)

  (define (eval/error expr)
    
    ;; Capture errors (no values returned).
    (with-handlers
        (((lambda (ex) #t) ;; catch all
          (lambda (ex)
            ;; format error
            `(error 
              ,(cond
                ((exn? ex) (exn-message ex))
                (else ex))))))
      
      ;; Capture multiple values.
      (call-with-values
          (lambda ()
            (eval expr))
        (lambda vals
          ;; Filter out voids and format the return message.
          `(values . ,(filter
                       (lambda (x) (not (void? x)))
                       vals))))))
  

  ;; Evaluate an expression, and return the result to the emacs
  ;; function (continuation).
  (define (eval/continue continue expr)
    (emacs-send
     `(,continue ',(eval/error expr))))
    

  (define (initrc)
    (let ((rc (expand-user-path "~/.snotrc")))
      (when (file-exists? rc)
        (printf "Loading ~a\n" rc)
        (load rc))))


  ;; EVALUATOR CHANNELS

  ;; These are just separate channels frome emacs -> snot. They
  ;; evaluate in the toplevel namespace. They are asynchronous to not
  ;; block the receiver/multiplexer thread.

  (define *emacs-channels* (make-hash))
  (define-struct emacs-channel (channel thread))

  
  ;; Create a body for an evaluator which reads from a channel.
  ;; Breaks will abort the current evaluation.
  
  (define (make-emacs-channel-thread channel)
    (thread
     (lambda ()
       (forever
        (with-handlers 
            ((exn:break?
              (lambda (ex)
                ;; printf "emacs-channel-thread: Ignoring break\n")
                (void))))
          (eval (async-channel-get channel)))))))
                       

         
  (define (make-booted-emacs-channel)
    (let* ((channel (make-async-channel))
           (thread  (make-emacs-channel-thread channel)))
      (make-emacs-channel channel thread)))
                          
  
  ;; Create a channel multiplexer from a list of channel names. Each
  ;; channel is linked to an evaluator thread.

  (define (start-emacs-channel name)
    (hash-set! *emacs-channels*
               name (make-booted-emacs-channel)))
  
  (define (emacs-channel-mux channel-name expr)
    (async-channel-put
     (emacs-channel-channel 
      (hash-ref *emacs-channels* channel-name))
     expr))

  (define (emacs-channel-break)
    (hash-map
     *emacs-channels*
     (lambda (name c)
       (break-thread (emacs-channel-thread c)))))
                    

  

  ;; The emacs -> snot message dispatcher. This reads expressions from
  ;; emacs, and dispatches them to the correct evaluator channel.
   
  (define (mainloop)

    ;; any error that gets here is fatal, and terminates the program.
    (with-handlers
        (((lambda (ex) #t)
          (lambda (ex)
            (printf "~s\n"
                    `(snot-display
                      ,(format "snot fatal error: ~a\n"
                               (exn-message ex)))))))

      (let
          ;; start I/O threads
          ((thread-to   (thread to-emacs))
           (thread-from (thread from-emacs)))
        
        ;; from here on, input is disabled, and output goes through
        ;; emacs-display.
        (parameterize
            ((current-input-port  (open-input-string "")) ;; disabled
             (current-output-port *log-emacs*)
             (current-error-port  *log-emacs*)
             (current-load-relative-directory (current-directory)))
          

          ;; Load initrc, with error messages to console.
          (initrc)
        
          ;; Make sure that 'load' and 'require' statements come from
          ;; current directory and enable a less strict security guard

          ;; for sandbox.
          (break-enabled #t)

          ;; Create the communication channels + evaluator threads.
          (for-each start-emacs-channel '(eval message))

          ;; Read expressions and dispatch them to the correct channel.
          
          (forever
           (with-handlers
               ((exn:break?
                 (lambda (ex)
                   (emacs-channel-break))))
             (apply emacs-channel-mux
                    (emacs-receive))))))))
             

  

  


  
  )