(module tool mzscheme
  (require (lib "framework.ss" "framework")
           (lib "tool.ss" "drscheme")
           (lib "match.ss")
           (lib "mred.ss" "mred")
           (lib "unitsig.ss")
           (lib "class.ss")
	   (lib "string-constant.ss" "string-constants")
           "compile.ss")

  (define tool@
    (unit/sig drscheme:tool-exports^
      (import drscheme:tool^)

      (define (phase1) (void))
      (define (phase2) 
        (drscheme:language-configuration:add-language
         (make-object ((drscheme:language:get-default-mixin) little-lang%))))

      (define little-lang%
        (class* object% (drscheme:language:language<%>)
          (define/public (first-opened) (void))
          (define/public (get-comment-character) (values "//" #\*))
          (define/public (default-settings) null)
          (define/public (default-settings? settings) #t)
          (define/public (marshall-settings s) null)
          (define/public (unmarshall-settings s) null)
          (define/public (config-panel parent)
            (case-lambda
              [() null]
              [(settings) (void)]))
          (define/public (front-end/complete-program port settings teachpack-cache)
            (lambda ()
              (if (eof-object? (peek-char-or-special port))
                  eof
                  (compile-expression (parse-expression port)))))
          (define/public (front-end/interaction port settings teachpack-cache)
            (lambda ()
              (if (eof-object? (peek-char-or-special port))
                  eof
                  (compile-expression (parse-expression port)))))
          (define/public (get-style-delta) #f)
          (define/public (get-language-position)
            (list (string-constant experimental-languages)
                  "A Little Language"))
          (define/public (order-manuals x)
            (values
             (list #"drscheme" #"tour" #"help")
             #f))
          (define/public (get-language-name) "LittleLanguage")
          (define/public (get-language-url) "http://www.google.com")
          (define/public (get-language-numbers) (list 1000 13))
          (define/public (get-teachpack-names) null)
          (define/public (on-execute settings run-in-user-thread)
            (dynamic-require '(lib "runtime.ss" "little-lang") #f)
            (let ([path ((current-module-name-resolver) '(lib "runtime.ss" "little-lang") #f #f)]
                  [n (current-namespace)])
              (run-in-user-thread
               (lambda ()
                 ;; TODO: how can we get the error to highlight the source for,
                 ;;       e.g., undefined reference errors?
                 (error-display-handler
                  (drscheme:debug:make-debug-error-display-handler (error-display-handler)))
                 (let ([previous-eval (drscheme:debug:make-debug-eval-handler (current-eval))])
                   (current-eval
                    (lambda (exp)
                      (previous-eval (if (syntax? exp)
                                         (namespace-syntax-introduce exp)
                                         exp)))))
                 (namespace-attach-module n path)
                 (namespace-require path)
                 ))))
          (define/public (render-value value settings port)
            (write value port))
          (define/public (render-value/format value settings port width)
            (write value port))
          (define/public (create-executable settings parent src-file teachpacks)
            (message-box "Unsupported"
                         "Sorry - executables are not supported"
                         parent))
          (define/public (get-one-line-summary) "An example language level")

          (super-make-object)))
      ))

  (provide tool@))
