#lang scheme
  (require (lib "unit.ss")
           (lib "class.ss")
           (lib "mred.ss" "mred")
           (lib "etc.ss")
           (lib "list.ss")
           (lib "port.ss")
           (lib "tool.ss" "drscheme")
           (lib "string-constant.ss" "string-constants")
           (lib "string.ss")
           drscheme/private/language-configuration
           drscheme/private/unit
           framework
;           "mytest-connection.ss"
           )
  
  (provide tool@)
  
;  (provide (all-from-out "mytest-connection.ss"))
    
  (define tool@
    (unit 
      (import drscheme:tool^)
      (export drscheme:tool-exports^)
      
      (define mytest-languages-head "MyTest Interface")
      
      (define language-name-plt-elk "PLT Elk Mix Mode")
      
      (define mytest-plt-elk-language%
        (class* object% (drscheme:language:simple-module-based-language<%>)
          (define/public (get-language-numbers)
            '(-800 1))
          (define/public (get-language-position)
            (list mytest-languages-head language-name-plt-elk))
          (define/public (get-module)
            '(lib "mytest-plt-elk.ss" "mytest"))
          (define/public (get-one-line-summary)
            "To establish a connection to mytest start mytest first.")
          (define/public (get-language-url) #f)
          (define/public (get-reader)
            (lambda (name port)
              (let ([v (read-syntax name port)])
                (if (eof-object? v)
                    v
                    (namespace-syntax-introduce v)))))
          (super-instantiate ())))
      
      
      (define (make-mytest-plt-elk-language base)
        (class (drscheme:language:module-based-language->language-mixin
                (drscheme:language:simple-module-based-language->module-based-language-mixin
                 base))
          (inherit get-language-position)
          (define/override (get-language-name)
            language-name-plt-elk)
;          (define/augment (capability-value key)
;            (cond
;              [(eq? key 'drscheme:autocomplete-words)
;               (drscheme:language-configuration/internal:get-all-manual-keywords)]
;              [else (drscheme:language:get-capability-default key)]))  
          (define (debugger:supported?) #t)
          (super-instantiate ())))
      
      
      (define (mytest-unit-frame-mixin super%)
        (class super%
          
          (inherit get-definitions-text
                   get-interactions-text
                   get-current-tab
                   get-top-level-window
                   get-eventspace
                   get-definitions-canvas
                   get-interactions-canvas
                   get-execute-button
                   )
          
          (define/override (execute-callback)
            (when (send (get-execute-button) is-enabled?)
              (let ((lang-name (send (drscheme:language-configuration:language-settings-language
                                      (send (get-definitions-text) get-next-settings))
                                     get-language-name))
                    )

                (if (eq? lang-name language-name-plt-elk)
                    (begin
                      (send (get-definitions-text) just-executed)
                      (send (get-interactions-canvas) focus)
                      (send (get-interactions-text) reset-console)
                      (send (get-interactions-text) clear-undos)
                      
                      ;determining start and end of a selection in definitions text
                      (let* ([start-0 (send (get-definitions-text) get-start-position)]
                             [end-0 (send (get-definitions-text) get-end-position)]
                             [start start-0]
                             [end end-0]
                             )
                        ;if there is no selection, all definition text will be evaluated
                        (cond [(eq? start end)
                               (set! start 0)
                               (set! end 'end)
                               ]
                              )
                        
                        (let ([def-text (new text%)]
                              [prog-text ""]
                              )
                          (cond [(eq? lang-name language-name-plt-elk)
                                 ;for plt-elk mix-mode, definitions text is taken as it is
                                 (cond [(eq? end 'end)(set! end 'eof)])
                                 (set! prog-text (send (get-definitions-text) get-text start end))
                                 ]
                                )
                          
                          ;wrap program text with DDE connection commands
                          ;for inspection changed to print commands
                          (send def-text insert "(printf \"mytest-connect~n\")" 0 'same)
                          (send def-text insert prog-text (send def-text get-end-position) 'same)
                          (send def-text insert "(printf \"mytest-disconnect~n\")" (send def-text get-end-position) 'same)
                          
                          ;following let* is original from execute-callback besides 
                          ;text-port definition and def-text
                          (let* ([text-port (open-input-text-editor def-text 0 'end)]
                                 [line (send def-text position-paragraph start)]
                                 [column (- start (send def-text paragraph-start-position line))]
                                 [relocated-port (relocate-input-port text-port 
                                                                      (+ line 1)
                                                                      column
                                                                      (+ start 1))])
                            (port-count-lines! relocated-port)
                            (send (get-interactions-text) evaluate-from-port
                                  relocated-port
                                  #t
                                  (λ ()
                                    (send (get-interactions-text) clear-undos))))
                          )
                        ;give focus to definitions canvas to show the selection again
                        (send (get-definitions-canvas) focus)
                        ;show the selection again, which was removed
                        (send (get-definitions-text) set-position start-0 end-0 #f #t 'default)
                        ;give focus back to interaction window to have standard behaviour
                        (send (get-interactions-canvas) focus)
                        )
                      )
                    ;for all other languages use standard execute-callback procedure
                    (super execute-callback)
                    )
                )
              )
            )
          (super-new)
          )
        )
      
      (define (phase1) (void))
      (define (phase2)
        (let((lang-plt-elk ((drscheme:language:get-default-mixin) 
                            (make-mytest-plt-elk-language mytest-plt-elk-language%)))
             )
          (drscheme:language-configuration:add-language 
           (make-object lang-plt-elk))
          )
        (drscheme:get/extend:extend-unit-frame mytest-unit-frame-mixin)
        )
      )
    )