#|

TODO
- should a GC should happen on each execution? (or perhaps better, each kill?)
- front-end methods have new signature


|#
; =Kernel= means in DrScheme's thread and parameterization
; 
; =User= means the user's thread and parameterization
; 
; =Handler= means in the handler thread of some eventspace; it must
;  be combined with either =Kernel= or =User=

;; WARNING: printf is rebound in this module to always use the 
;;          original stdin/stdout of drscheme, instead of the 
;;          user's io ports, to aid any debugging printouts.
;;          (esp. useful when debugging the users's io)
(module rep mzscheme
  (require (lib "unitsig.ss")
           (lib "class.ss")
           (lib "file.ss")
           (lib "pretty.ss")
           (lib "etc.ss")
           (lib "list.ss")
           (lib "port.ss")
           "drsig.ss"
           (lib "string-constant.ss" "string-constants")
	   (lib "mred.ss" "mred")
           (lib "framework.ss" "framework")
	   (lib "external.ss" "browser")
           (lib "default-lexer.ss" "syntax-color"))
  
  (provide rep@)
  
  (define rep@
    (unit/sig drscheme:rep^
      (import (drscheme:init : drscheme:init^)
              (drscheme:language-configuration : drscheme:language-configuration/internal^)
	      (drscheme:language : drscheme:language^)
              (drscheme:app : drscheme:app^)
              (drscheme:frame : drscheme:frame^)
              (drscheme:unit : drscheme:unit^)
              (drscheme:text : drscheme:text^)
              (drscheme:help-desk : drscheme:help-desk^)
              (drscheme:teachpack : drscheme:teachpack^)
              (drscheme:debug : drscheme:debug^)
              [drscheme:eval : drscheme:eval^])
      
      (rename [-text% text%]
              [-text<%> text<%>])

      (define -text<%>
        (interface ((class->interface text%)
                    text:ports<%>
                    editor:file<%>
                    scheme:text<%>
                    color:text<%>
                    text:ports<%>)
          reset-highlighting
          highlight-errors
          highlight-errors/exn
          
          get-user-custodian
          get-user-eventspace
          get-user-thread
          get-user-namespace
          get-user-teachpack-cache
          set-user-teachpack-cache

          get-definitions-text
          
          kill-evaluation
          
          display-results
          
          run-in-evaluation-thread
          after-many-evals
          
          shutdown
          
          get-error-ranges
          reset-error-ranges
          
          reset-console
          
          copy-prev-previous-expr
          copy-next-previous-expr
          copy-previous-expr
          
          
          initialize-console
          
          reset-pretty-print-width
          
          get-prompt
          insert-prompt
          get-context))
      
      (define context<%>
        (interface ()
          ensure-rep-shown   ;; (interactions-text -> void)
	  ;; make the rep visible in the frame

          needs-execution   ;; (-> boolean)
	  ;; ask if things have changed that would mean the repl is out
	  ;; of sync with the program being executed in it.
          
          enable-evaluation  ;; (-> void)
	  ;; make the context enable all methods of evaluation
	  ;; (disable buttons, menus, etc)

          disable-evaluation ;; (-> void)
	  ;; make the context enable all methods of evaluation
	  ;; (disable buttons, menus, etc)
          
          set-breakables ;; (union thread #f) (union custodian #f) -> void
          ;; the context might initiate breaks or kills to
          ;; the thread passed to this function

          get-breakables ;; -> (values (union thread #f) (union custodian #f))
          ;; returns the last values passed to set-breakables.

          reset-offer-kill ;; (-> void)
          ;; the next time the break button is pushed, it will only
          ;; break. (if the break button is clicked twice without
          ;; this method being called in between, it will offer to
          ;; kill the user's program)

          update-running        ;; (boolean -> void)
	  ;; a callback to indicate that the repl may have changed its running state
          ;; use the repls' get-in-evaluation? method to find out what the current state is.
          
          clear-annotations  ;; (-> void)
	  ;; clear any error highlighting context
          
          get-directory      ;; (-> (union #f string[existing directory]))
	  ;; returns the directory that should be the default for
	  ;; the `current-directory' and `current-load-relative-directory'
	  ;; parameters in the repl.
	  ))
      
      (define sized-snip<%>
	(interface ((class->interface snip%))
	  ;; get-character-width : -> number
	  ;; returns the number of characters wide the snip is,
	  ;; for use in pretty printing the snip.
	  get-character-width))

      ;; current-language-settings : (parameter language-setting)
      ;; set to the current language and its setting on the user's thread.
      (define current-language-settings (make-parameter #f))
      
      ;; current-rep : (parameter (union #f (instanceof rep:text%)))
      ;; the repl that controls the evaluation in this thread.
      (define current-rep (make-parameter #f))

      ;; a port that accepts values for printing in the repl
      (define current-value-port (make-parameter #f))

      ;; an error escape continuation that the user program can't
      ;; change; DrScheme sets it, we use a parameter instead of an
      ;; object field so that there's no non-weak pointer to the
      ;; continuation from DrScheme.
      (define current-error-escape-k (make-parameter void))
            
      ;; drscheme-error-display-handler : (string (union #f exn) -> void
      ;; =User=
      ;; the timing is a little tricky here. 
      ;; the file icon must appear before the error message in the text, so that happens first.
      ;; the highlight must be set after the error message, because inserting into the text resets
      ;;     the highlighting.
      (define (drscheme-error-display-handler msg exn)
        (let ([src-locs (if (exn:srclocs? exn)
                            ((exn:srclocs-accessor exn) exn)
                            '())])
          (for-each drscheme:debug:display-srcloc-in-error src-locs)
          (display msg (current-error-port))
          (when (exn:fail:syntax? exn)
            (drscheme:debug:show-syntax-error-context (current-error-port) exn))
          (newline (current-error-port))
          (flush-output (current-error-port))
          (let ([rep (current-rep)])
            (when (and (is-a? rep -text<%>)
                       (eq? (current-error-port) (send rep get-err-port)))
              (parameterize ([current-eventspace drscheme:init:system-eventspace])
                (queue-callback
                 (λ ()
                   (send rep highlight-errors/exn exn))))))))
      
      ;; drscheme-error-value->string-handler : TST number -> string
      (define (drscheme-error-value->string-handler x n)
        (let ([port (open-output-string)])
          
          ;; using a string port here means no snips allowed,
          ;; even though this string may eventually end up
          ;; displayed in a place where snips are allowed.
          (print x port)
          
          (let* ([long-string (get-output-string port)])
            (close-output-port port)
            (if (<= (string-length long-string) n)
                long-string
                (let ([short-string (substring long-string 0 n)]
                      [trim 3])
                  (unless (n . <= . trim)
                    (let loop ([i trim])
                      (unless (i . <= . 0)
                        (string-set! short-string (- n i) #\.)
                        (loop (sub1 i)))))
                  short-string)))))

      (define drs-bindings-keymap (make-object keymap:aug-keymap%))
      
      (send drs-bindings-keymap add-function
            "search-help-desk"
            (λ (obj evt)
              (cond
                [(is-a? obj text%)
                 (let* ([start (send obj get-start-position)]
                        [end (send obj get-end-position)]
                        [str (if (= start end)
                                 (drscheme:unit:find-symbol obj start)
                                 (send obj get-text start end))])
                   (if (equal? "" str)
                       (drscheme:help-desk:help-desk)
                       (let ([language (let ([canvas (send obj get-canvas)])
                                         (and canvas
                                              (let ([tlw (send canvas get-top-level-window)])
                                                (and (is-a? tlw drscheme:unit:frame<%>)
                                                     (send (send tlw get-definitions-text)
                                                           get-next-settings)))))])
                         (drscheme:help-desk:help-desk str #f 'keyword+index 'contains language))))]
                [else                   
                 (drscheme:help-desk:help-desk)])))
      (let ([with-drs-frame
             (λ (obj f)
               (when (is-a? obj editor<%>)
                 (let ([canvas (send obj get-canvas)])
                   (when canvas
                     (let ([frame (send canvas get-top-level-window)])
                       (when (is-a? frame drscheme:unit:frame%)
                         (f frame)))))))])
      
        (send drs-bindings-keymap add-function
              "execute"
              (λ (obj evt)
                (with-drs-frame
                 obj
                 (λ (frame)
                   (send frame execute-callback)))))
        
        (send drs-bindings-keymap add-function
              "toggle-focus-between-definitions-and-interactions"
              (λ (obj evt)
                (with-drs-frame 
                 obj
                 (λ (frame)
                   (cond
                     [(send (send frame get-definitions-canvas) has-focus?)
                      (send (send frame get-interactions-canvas) focus)]
                     [else
                      (send (send frame get-definitions-canvas) focus)])))))
        (send drs-bindings-keymap add-function
              "next-tab"
              (λ (obj evt)
                (with-drs-frame 
                 obj
                 (λ (frame) (send frame next-tab)))))
        (send drs-bindings-keymap add-function
              "prev-tab"
              (λ (obj evt)
                (with-drs-frame 
                 obj
                 (λ (frame) (send frame prev-tab))))))
      
      (send drs-bindings-keymap map-function "c:x;o" "toggle-focus-between-definitions-and-interactions")
      (send drs-bindings-keymap map-function "c:tab" "toggle-focus-between-definitions-and-interactions")
      (send drs-bindings-keymap map-function "c:shift:tab" "toggle-focus-between-definitions-and-interactions")
      (send drs-bindings-keymap map-function "f5" "execute")
      (send drs-bindings-keymap map-function "f1" "search-help-desk")
      (send drs-bindings-keymap map-function "c:tab" "next-tab")
      (send drs-bindings-keymap map-function "c:s:tab" "prev-tab")
      (send drs-bindings-keymap map-function "d:s:right" "next-tab")
      (send drs-bindings-keymap map-function "d:s:left" "prev-tab")
      (send drs-bindings-keymap map-function "c:pagedown" "next-tab")
      (send drs-bindings-keymap map-function "c:pageup" "prev-tab")
      
      (define (get-drs-bindings-keymap) drs-bindings-keymap)

      ;; drs-bindings-keymap-mixin :
      ;;   ((implements editor:keymap<%>) -> (implements editor:keymap<%>))
      ;;   for any x that is an instance of the resulting class,
      ;;     (is-a? (send (send x get-canvas) get-top-level-frame) drscheme:unit:frame%)
      (define drs-bindings-keymap-mixin
	(mixin (editor:keymap<%>) (editor:keymap<%>)
	  (define/override (get-keymaps)
	    (cons drs-bindings-keymap (super get-keymaps)))
	  (super-instantiate ())))
      
      ;; Max length of output queue (user's thread blocks if the
      ;; queue is full):
      (define output-limit-size 2000)
      
      (define (printf . args) (apply fprintf drscheme:init:original-output-port args))
      
      (define setup-scheme-interaction-mode-keymap
        (λ (keymap)
          (send keymap add-function "put-previous-sexp"
                (λ (text event) 
                  (send text copy-prev-previous-expr)))
          (send keymap add-function "put-next-sexp"
                (λ (text event) 
                  (send text copy-next-previous-expr)))
          
          (keymap:send-map-function-meta keymap "p" "put-previous-sexp")
          (keymap:send-map-function-meta keymap "n" "put-next-sexp")))
      
      (define scheme-interaction-mode-keymap (make-object keymap:aug-keymap%))
      (setup-scheme-interaction-mode-keymap scheme-interaction-mode-keymap)
      
      (define drs-font-delta (make-object style-delta% 'change-family 'decorative))
      
      (define output-delta (make-object style-delta%)) ; used to be 'change-weight 'bold
      (define result-delta (make-object style-delta%)) ; used to be 'change-weight 'bold
      (define error-delta (make-object style-delta%
                            'change-style
                            'slant))
      (send error-delta set-delta-foreground (make-object color% 255 0 0))
      (send result-delta set-delta-foreground (make-object color% 0 0 175))
      (send output-delta set-delta-foreground (make-object color% 150 0 150))
      
      (define error-text-style-delta (make-object style-delta%))
      (send error-text-style-delta set-delta-foreground (make-object color% 200 0 0))

      (define grey-delta (make-object style-delta%))
      (send grey-delta set-delta-foreground "GREY")
      
      (define welcome-delta (make-object style-delta% 'change-family 'decorative))
      (define click-delta (gui-utils:get-clickback-delta))
      (define red-delta (make-object style-delta%))
      (define dark-green-delta (make-object style-delta%))
      (send* red-delta
        (copy welcome-delta)
        (set-delta-foreground "RED"))  
      (send* dark-green-delta
        (copy welcome-delta)
        (set-delta-foreground "dark green"))
      (define warning-style-delta (make-object style-delta% 'change-bold))
      (send* warning-style-delta
        (set-delta-foreground "BLACK")
        (set-delta-background "YELLOW"))
      
      ;; is-default-settings? : language-settings -> boolean
      ;; determines if the settings in `language-settings'
      ;; correspond to the default settings of the language.
      (define (is-default-settings? language-settings)
        (send (drscheme:language-configuration:language-settings-language language-settings)
              default-settings?
              (drscheme:language-configuration:language-settings-settings language-settings)))

      (define (extract-language-name language-settings)
        (send (drscheme:language-configuration:language-settings-language language-settings)
              get-language-name))
      (define (extract-language-style-delta language-settings)
        (send (drscheme:language-configuration:language-settings-language language-settings)
              get-style-delta))
      (define (extract-language-url language-settings)
        (send (drscheme:language-configuration:language-settings-language language-settings)
              get-language-url))

      (define-struct sexp (left right prompt))
      
      (define console-max-save-previous-exprs 30)
      (let* ([list-of? (λ (p?)
                         (λ (l)
                           (and (list? l)
                                (andmap p? l))))]
             [snip/string? (λ (s) (or (is-a? s snip%) (string? s)))]
             [list-of-snip/strings? (list-of? snip/string?)]
             [list-of-lists-of-snip/strings? (list-of? list-of-snip/strings?)])
        (preferences:set-default
         'drscheme:console-previous-exprs
         null
         list-of-lists-of-snip/strings?))
      (let ([marshall 
             (λ (lls)
               (map (λ (ls)
                      (map (λ (s)
                             (cond
                               [(is-a? s string-snip%)
                                (send s get-text 0 (send s get-count))]
                               [(string? s) s]
                               [else "'non-string-snip"]))
                           ls))
                    lls))]
            [unmarshall (λ (x) x)])
        (preferences:set-un/marshall
         'drscheme:console-previous-exprs
         marshall unmarshall))
      
      (define error-color (make-object color% "PINK"))
      (define color? ((get-display-depth) . > . 8))
            
      ;; instances of this interface provide a context for a rep:text%
      ;; its connection to its graphical environment (ie frame) for
      ;; error display and status infromation is all mediated
      ;; through an instance of this interface.
            
      (define file-icon
        (let ([bitmap
               (make-object bitmap%
                 (build-path (collection-path "icons") "file.gif"))])
          (if (send bitmap ok?)
              (make-object image-snip% bitmap)
              (make-object string-snip% "[open file]"))))
      (define docs-icon
        (let ([bitmap
               (make-object bitmap%
                 (build-path (collection-path "icons") "book.gif"))])
          (if (send bitmap ok?)
              (make-object image-snip% bitmap)
              (make-object string-snip% "[open file]"))))
      (define mf-icon 
        (let ([bitmap
               (make-object bitmap%
                 (build-path (collection-path "icons") "mf.gif"))])
          (if (send bitmap ok?)
              (make-object image-snip% bitmap)
              (make-object string-snip% "[mf]"))))
      (define bug-icon 
        (let ([bitmap
               (make-object bitmap%
                 (build-path (collection-path "icons") "bug09.gif"))])
          (if (send bitmap ok?)
              (make-object image-snip% bitmap)
              (make-object string-snip% "[err]"))))
      
      (define (no-user-evaluation-message frame)
        (message-box
         (string-constant evaluation-terminated)
         (format (string-constant evaluation-terminated-explanation))
         frame))
      
      ;; insert/delta : (instanceof text%) (union snip string) (listof style-delta%) *-> (values number number)
      ;; inserts the string/stnip into the text at the end and changes the
      ;; style of the newly inserted text based on the style deltas.
      (define (insert/delta text s . deltas)
        (let ([before (send text last-position)])
          (send text insert s before before #f)
          (let ([after (send text last-position)])
            (for-each (λ (delta)
                        (when (is-a? delta style-delta%)
                          (send text change-style delta before after)))
                      deltas)
            (values before after))))

      (define text-mixin
        (mixin ((class->interface text%)
                text:ports<%>
                editor:file<%>
                scheme:text<%>
                color:text<%>
                text:ports<%>)
          (-text<%>)
          (init-field context)
          (inherit auto-wrap
                   begin-edit-sequence
                   change-style
                   clear-box-input-port
                   clear-undos
                   clear-input-port
                   clear-output-ports
                   delete
                   delete/io
                   end-edit-sequence
                   erase
                   find-snip
                   find-string
                   freeze-colorer
                   get-active-canvas
                   get-admin
                   get-can-close-parent
                   get-canvases
                   get-character
                   get-end-position
                   get-err-port
                   get-extent
                   get-focus-snip
                   get-in-port
                   get-in-box-port
                   get-insertion-point
                   get-out-port
                   get-snip-position
                   get-start-position
                   get-style-list
                   get-text
                   get-top-level-window
                   get-unread-start-point
                   get-value-port
                   in-edit-sequence?
                   insert
                   insert-before
                   insert-between
                   invalidate-bitmap-cache
                   is-frozen?
                   is-locked?
                   last-position
                   line-location
                   lock
                   paragraph-start-position
                   position-line
                   position-paragraph
                   release-snip
                   reset-input-box
                   reset-region
                   run-after-edit-sequence
                   scroll-to-position
                   send-eof-to-in-port 
                   set-allow-edits
                   set-caret-owner
                   set-clickback
                   set-insertion-point
                   set-position
                   set-styles-sticky
                   set-unread-start-point
                   split-snip
                   thaw-colorer)
    
          (define definitions-text 'not-yet-set-definitions-text)
          (define/public (set-definitions-text dt) (set! definitions-text dt))
          (define/public (get-definitions-text) definitions-text)
          
          (unless (is-a? context context<%>)
            (error 'drscheme:rep:text% 
                   "expected an object that implements drscheme:rep:context<%> as initialization argument, got: ~e"
                   context))
          
          (define/public (get-context) context)
          
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          ;;;					       ;;;
          ;;;            User -> Kernel                ;;;
          ;;;					       ;;;
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          
          ;; =User= (probably doesn't matter)
          (define/private queue-system-callback
            (opt-lambda (ut thunk [always? #f])
              (parameterize ([current-eventspace drscheme:init:system-eventspace])
                (queue-callback 
                 (λ ()
                   (when (or always? (eq? ut (get-user-thread)))
                     (thunk)))
                 #f))))
          
          ;; =User=
          (define/private queue-system-callback/sync
            (λ (ut thunk)
              (let ([s (make-semaphore 0)])
                (queue-system-callback 
                 ut 
                 (λ ()
                   (when (eq? ut (get-user-thread))
                     (thunk))
                   (semaphore-post s))
                 #t)
                (semaphore-wait s))))
          
          ;; display-results : (listof TST) -> void
          ;; prints each element of anss that is not void as values in the REPL.
          (define/public (display-results anss) ; =User=, =Handler=, =Breaks=
            (display-results/void (filter (λ (x) (not (void? x))) anss)))
          
          ;; display-results : (listof TST) -> void
          ;; prints each element of anss that is not void as values in the REPL.
          (define/public (display-results/void anss) ; =User=, =Handler=, =Breaks=
            (for-each 
             (λ (v)
               (let* ([ls (current-language-settings)]
                      [lang (drscheme:language-configuration:language-settings-language ls)]
                      [settings (drscheme:language-configuration:language-settings-settings ls)])
                 (send lang render-value/format
                       v
                       settings
                       (get-value-port)
                       (get-repl-char-width))))
             anss))

        ;; get-repl-char-width : -> (and/c exact? integer?)
        ;; returns the width of the repl in characters, or 80 if the
        ;; answer cannot be found.
        (define/private (get-repl-char-width)
          (let ([admin (get-admin)]
                [standard (send (get-style-list) find-named-style "Standard")])
            (if (and admin standard)
                (let ([bw (box 0)])
                  (send admin get-view #f #f bw #f)
                  (let* ([dc (send admin get-dc)]
                         [standard-font (send standard get-font)]
                         [old-font (send dc get-font)])
                    (send dc set-font standard-font)
                    (let* ([char-width (send dc get-char-width)]
                           [answer (inexact->exact (floor (/ (unbox bw) char-width)))])
                      (send dc set-font old-font)
                      answer)))
                80)))
          
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          ;;;                                            ;;;
          ;;;            Error Highlighting              ;;;
          ;;;                                            ;;;
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          
          ;; error-ranges : (union false? (cons (list file number number) (listof (list file number number))))
          (define error-ranges #f)
          ;; error-arrows : (union #f (listof (cons editor<%> number)))
          (define error-arrows #f)
          (define/public (get-error-ranges) error-ranges)
          (define internal-reset-callback void)
          (define internal-reset-error-arrows-callback void)
          (define/public (reset-error-ranges) 
            (internal-reset-callback)
            (internal-reset-error-arrows-callback))

          ;; highlight-error : file number number -> void
          (define/public (highlight-error file start end)
            (highlight-errors (list (make-srcloc file #f #f start (- end start))) #f))
          
          ;; highlight-errors/exn : exn -> void
          ;; highlights all of the errors associated with the exn (incl. arrows)
          (define/public (highlight-errors/exn exn)
            (let ([locs (cond
                          [(exn:srclocs? exn)
                           ((exn:srclocs-accessor exn) exn)]
                          [else '()])])
              (highlight-errors locs #f)))
          
          ;; =Kernel= =handler=
          ;; highlight-errors :    (listof srcloc)
          ;;                       (union #f (listof (list (is-a?/c text:basic<%>) number number)))
          ;;                    -> (void)
          (define/public (highlight-errors raw-locs error-arrows)
            (let ([locs (filter (λ (loc) (and (is-a? (srcloc-source loc) text:basic<%>)
                                              (number? (srcloc-position loc))
                                              (number? (srcloc-span loc))))
                                raw-locs)])
              (reset-highlighting)
              
              (set! error-ranges locs)
              
              (for-each (λ (loc) (send (srcloc-source loc) begin-edit-sequence)) locs)
              
              (when color?
                (let ([resets
                       (map (λ (loc)
                              (let* ([file (srcloc-source loc)]
                                     [start (- (srcloc-position loc) 1)]
                                     [span (srcloc-span loc)]
                                     [finish (+ start span)])
                                (send file highlight-range start finish error-color #f #f 'high)))
                            locs)])
                  
                  (when (and definitions-text error-arrows)
                    (let ([filtered-arrows
                           (remove-duplicate-error-arrows
                            (filter
                             (λ (arr)
                               (embedded-in? (car arr) definitions-text))
                             error-arrows))])
                      (send definitions-text set-error-arrows filtered-arrows)))
                  
                  (set! internal-reset-callback
                        (λ ()
                          (set! error-ranges #f)
                          (when definitions-text
                            (send definitions-text set-error-arrows #f))
                          (set! internal-reset-callback void)
                          (for-each (λ (x) (x)) resets)))))
              
              (let* ([first-loc (and (pair? locs) (car locs))]
                     [first-file (and first-loc (srcloc-source first-loc))]
                     [first-start (and first-loc (- (srcloc-position first-loc) 1))]
                     [first-span (and first-loc (srcloc-span first-loc))])
                
                (when first-loc
                  (let ([first-finish (+ first-start first-span)])
                    (when (eq? first-file definitions-text) ;; only move set the cursor in the defs window
                      (send first-file set-position first-start first-start))
                    (send first-file scroll-to-position first-start #f first-finish)))
                
                (for-each (λ (loc) (send (srcloc-source loc) end-edit-sequence)) locs)
                
                (when first-loc
                  (send first-file set-caret-owner (get-focus-snip) 'global)))))
          
          (define/public (reset-highlighting)
            (reset-error-ranges))
          
          ;; remove-duplicate-error-arrows : (listof X) -> (listof X)
          ;; duplicate arrows point from and to the same place -- only
          ;; need one arrow for each pair of locations they point to.
          (define/private (remove-duplicate-error-arrows error-arrows)
            (let ([ht (make-hash-table 'equal)])
              (let loop ([arrs error-arrows]
                         [n 0])
                (unless (null? arrs)
                  (hash-table-put! ht (car arrs) n)
                  (loop (cdr arrs) (+ n 1))))
              (let* ([unsorted (hash-table-map ht list)]
                     [sorted (quicksort unsorted (λ (x y) (<= (cadr x) (cadr y))))]
                     [arrs (map car sorted)])
                arrs)))
                    
          (define/private (embedded-in? txt-inner txt-outer)
            (let loop ([txt-inner txt-inner])
              (cond
                [(eq? txt-inner txt-outer) #t]
                [else (let ([admin (send txt-inner get-admin)])
                        (and (is-a? admin editor-snip-editor-admin<%>)
                             (loop (send (send (send admin get-snip) get-admin) get-editor))))])))
                    
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          ;;
          ;;  specialization
          ;;
          
          (define/override (after-io-insertion)
            (super after-io-insertion)
            (let ([canvas (get-active-canvas)])
              (when canvas
                (let ([frame (send canvas get-top-level-window)])
                  (let ([tab (send definitions-text get-tab)])
                    (when (eq? (send frame get-current-tab) tab)
                      (send context ensure-rep-shown this)))))))
          
          (define/augment (after-insert start len)
            (inner (void) after-insert start len)
            (cond
              [(in-edit-sequence?) 
               (set! had-an-insert (cons (cons start len) had-an-insert))]
              [else (update-after-insert)]))
          
          ;; private field
          (define had-an-insert '())
          
          (define/augment (after-edit-sequence)
            (inner (void) after-edit-sequence)
            (let ([to-clean had-an-insert])
              (set! had-an-insert '())
              (for-each
               (lambda (pr)
                 (update-after-insert (car pr) (cdr pr)))
               to-clean)))
          
          (define/private (update-after-insert start len)
            (unless inserting-prompt?
              (reset-highlighting))
            (when (and prompt-position (< start prompt-position))
              
              ;; trim extra space, according to preferences
              #;
              (let* ([start (get-repl-header-end)]
                     [end (get-insertion-point)]
                     [space (- end start)]
                     [pref (preferences:get 'drscheme:repl-buffer-size)])
                (when (car pref)
                  (let ([max-space (* 1000 (cdr pref))])
                    (when (space . > . max-space)
                      (let ([to-delete-end (+ start (- space max-space))])
                        (delete/io start to-delete-end))))))
              (set! prompt-position (get-unread-start-point))
              (reset-region prompt-position 'end)))
          
          (define/augment after-delete
            (lambda (x y)
              (unless inserting-prompt?
                (reset-highlighting))
              (inner (void) after-delete x y)))
          
          (define/override get-keymaps
            (λ ()
              (cons scheme-interaction-mode-keymap (super get-keymaps))))
          
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          ;;;                                            ;;;
          ;;;                Evaluation                  ;;;
          ;;;                                            ;;;
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          
          (define/public (eval-busy?)
            (not (and (get-user-thread)
                      (thread-running? (get-user-thread)))))
          
          (field (user-language-settings #f)
                 (user-teachpack-cache (preferences:get 'drscheme:teachpacks))
                 (user-custodian #f)
                 (user-eventspace-box (make-weak-box #f))
                 (user-namespace-box (make-weak-box #f))
                 (user-thread-box (make-weak-box #f))
                 (user-break-parameterization #f))

          (define/public (get-user-language-settings) user-language-settings)
          (define/public (get-user-custodian) user-custodian)
          (define/public (get-user-teachpack-cache) user-teachpack-cache)
          (define/public (set-user-teachpack-cache tpc) (set! user-teachpack-cache tpc))
          (define/public (get-user-eventspace) (weak-box-value user-eventspace-box))
          (define/public (get-user-thread) (weak-box-value user-thread-box))
          (define/public (get-user-namespace) (weak-box-value user-namespace-box))
          (define/public (get-user-break-parameterization) user-break-parameterization)
          
          (field (in-evaluation? #f) ; a heursitic for making the Break button send a break
                 (should-collect-garbage? #f)
                 (ask-about-kill? #f))
          (define/public (get-in-evaluation?) in-evaluation?)
          
          (define/private (insert-warning message)
            (begin-edit-sequence)
            (let ([start (get-insertion-point)])
              (insert-before message)
              (let ([end (get-insertion-point)])
                (change-style warning-style-delta start end)))
            (insert-before "\n")
            (end-edit-sequence))
          
          (field (already-warned? #f))
          
          (define/private (cleanup)
            (set! in-evaluation? #f)
            (update-running #f)
            (unless (and (get-user-thread) (thread-running? (get-user-thread)))
              (lock #t)
              (unless shutting-down?
                (no-user-evaluation-message
                 (let ([canvas (get-active-canvas)])
                   (and canvas
                        (send canvas get-top-level-window)))))))
          (field (need-interaction-cleanup? #f))
          
          (define/private (cleanup-interaction) ; =Kernel=, =Handler=
            (set! need-interaction-cleanup? #f)
            (begin-edit-sequence)
            (set-caret-owner #f 'display)
            (cleanup)
            (end-edit-sequence)
            (send context set-breakables #f #f)
            (send context enable-evaluation))
          
          (inherit backward-containing-sexp)
          
          (define/augment (submit-to-port? key) 
            (and prompt-position
                 (only-whitespace-after-insertion-point)
                 (submit-predicate this prompt-position)))
          
          (define/private (only-whitespace-after-insertion-point)
            (let ([start (get-start-position)]
                  [end (get-end-position)])
              (and (= start end)
                   (let loop ([pos start])
                     (cond
                       [(= pos (last-position)) #t]
                       [else (and (char-whitespace? (get-character pos))
                                  (loop (+ pos 1)))])))))
          
          (define/augment (on-submit)
            (inner (void) on-submit)
            ;; the -2 drops the last newline from history (why -2 and not -1?!)
            (save-interaction-in-history prompt-position (- (last-position) 2))
            (freeze-colorer)
            
            (let ([needs-execution (send context needs-execution)])
              (when (if (preferences:get 'drscheme:execute-warning-once)
                        (and (not already-warned?)
                             needs-execution)
                        needs-execution)
                (set! already-warned? #t)
                (insert-warning needs-execution)))
            
            ;; lets us know we are done with this one interaction
            ;; (since there may be multiple expressions at the prompt)
            (send-eof-to-in-port)
            
            (set! prompt-position #f)
            (evaluate-from-port
             (get-in-port) 
             #f
             (λ ()
               ;; clear out the eof object if it wasn't consumed
               (clear-input-port))))
          
          ;; prompt-position : (union #f integer)
          ;; the position just after the last prompt
          (field (prompt-position #f))
          (define inserting-prompt? #f)
          (define/public (get-prompt) "> ")
          (define/public (insert-prompt)
            (set! inserting-prompt? #t)
            (begin-edit-sequence)
            (reset-input-box)
            (let* ([pmt (get-prompt)]
                   [prompt-space (string-length pmt)])
              
              ;; insert the prompt, possibly inserting a newline first
              (let* ([usp (get-unread-start-point)]
                     [usp-para (position-paragraph usp)]
                     [usp-para-start (paragraph-start-position usp-para)])
                (unless (equal? usp usp-para-start)
                  (insert-between "\n")
                  (set! prompt-space (+ prompt-space 1)))
                (insert-between pmt))
              
              (let ([sp (get-unread-start-point)])
                (set! prompt-position sp)
                (reset-region sp 'end)
                (when (is-frozen?) (thaw-colorer))))
            (end-edit-sequence)
            (set! inserting-prompt? #f))
          
          (field [submit-predicate (λ (text prompt-position) #t)])
          (define/public (set-submit-predicate p)
            (set! submit-predicate p))
          
          ;; record this on an ivar in the class so that
          ;; continuation jumps into old calls to evaluate-from-port
          ;; continue to evaluate from the correct port.
          (define get-sexp/syntax/eof #f)
          (define/public (evaluate-from-port port complete-program? cleanup) ; =Kernel=, =Handler=
              (send context disable-evaluation)
              (send context reset-offer-kill)
              (send context set-breakables (get-user-thread) (get-user-custodian))
              (reset-pretty-print-width)
              (when should-collect-garbage?
                (set! should-collect-garbage? #f)
                (collect-garbage))
              (set! in-evaluation? #t)
              (update-running #t)
              (set! need-interaction-cleanup? #t)
              
            (run-in-evaluation-thread
             (λ () ; =User=, =Handler=, =No-Breaks=
               (let* ([settings (current-language-settings)]
                      [lang (drscheme:language-configuration:language-settings-language settings)]
                      [settings (drscheme:language-configuration:language-settings-settings settings)])
                 (set! get-sexp/syntax/eof 
                       (if complete-program?
                           (send lang front-end/complete-program port settings user-teachpack-cache)
                           (send lang front-end/interaction port settings user-teachpack-cache)))
                 
                 ; Evaluate the user's expression. We're careful to turn on
                 ;   breaks as we go in and turn them off as we go out.
                 ;   (Actually, we adjust breaks however the user wanted it.)
                 ; A continuation hop might take us out of this instance of
                 ;   evaluation and into another one, which is fine.
                 
                 (let/ec k
                   (let ([saved-error-escape-k (current-error-escape-k)]
                         [cleanup? #f])
                     (dynamic-wind
                      (λ ()
                        (set! cleanup? #f)
                        (current-error-escape-k (λ () 
                                                  (set! cleanup? #t)
                                                  (k (void)))))
                      (λ () 
                        (let loop ()
                          (let ([sexp/syntax/eof (get-sexp/syntax/eof)])
                            (unless (eof-object? sexp/syntax/eof)
                              (call-with-break-parameterization
                               (get-user-break-parameterization)
                               (λ ()
                                 (call-with-values
                                  (λ ()
                                    (eval-syntax sexp/syntax/eof))
                                  (λ x (display-results x)))))
                              (loop))))
                        (set! cleanup? #t))
                      (λ () 
                        (current-error-escape-k saved-error-escape-k)
                        (when cleanup?
                          (set! in-evaluation? #f)
                          (update-running #f)
                          (cleanup)
                          (flush-output (get-value-port))
                          (queue-system-callback/sync
                           (get-user-thread)
                           (λ () ; =Kernel=, =Handler= 
                             (after-many-evals)
                             (cleanup-interaction)
                             (insert-prompt))))))))))))
          
          (define/pubment (after-many-evals) (inner (void) after-many-evals))
          
          (define/private shutdown-user-custodian ; =Kernel=, =Handler=
            ; Use this procedure to shutdown when in the middle of other cleanup
            ;  operations, such as when the user clicks "Execute".
            ; Don't use it to kill a thread where other, external cleanup
            ;  actions must occur (e.g., the exit handler for the user's
            ;  thread). In that case, shut down user-custodian directly.
            (λ ()
              (when user-custodian
                (custodian-shutdown-all user-custodian))
	      (set! user-custodian #f)
              (set! user-thread-box (make-weak-box #f))))
          
          (define/public (kill-evaluation) ; =Kernel=, =Handler=
            (when user-custodian
              (custodian-shutdown-all user-custodian))
	    (set! user-custodian #f))
          
          (field (user-break-enabled #t))
          
          (field (eval-thread-thunks null)
                 (eval-thread-state-sema 'not-yet-state-sema)
                 (eval-thread-queue-sema 'not-yet-thread-sema)
                 
                 (cleanup-sucessful 'not-yet-cleanup-sucessful)
                 (cleanup-semaphore 'not-yet-cleanup-semaphore)
                 (thread-grace 'not-yet-thread-grace)
                 (thread-killed 'not-yet-thread-killed))
          (define/private (initialize-killed-thread) ; =Kernel=
            (when (thread? thread-killed)
              (kill-thread thread-killed))
            (set! thread-killed
                  (thread
                   (λ () ; =Kernel=
                     (let ([ut (get-user-thread)])
                       (thread-wait ut)
                       (queue-system-callback
                        ut
                        (λ () ; =Kernel=, =Handler=
                          (if need-interaction-cleanup?
                              (cleanup-interaction)
                              (cleanup)))))))))
          
          (define/private protect-user-evaluation ; =User=, =Handler=, =No-Breaks=
            (λ (thunk cleanup)
              
              ;; We only run cleanup if thunk finishes normally or tries to
              ;; error-escape. Otherwise, it must be a continuation jump
              ;; into a different call to protect-user-evaluation.
              
              ;; `thunk' is responsible for ensuring that breaks are off when
              ;; it returns or jumps out.
              
              (set! in-evaluation? #t)
              (update-running #t)
              
              (let/ec k
                (let ([saved-error-escape-k (current-error-escape-k)]
                      [cleanup? #f])
                  (dynamic-wind
                   (λ ()
                     (set! cleanup? #f)
                     (current-error-escape-k (λ () 
					       (set! cleanup? #t)
					       (k (void)))))
		  (λ () 
                     (thunk) 
                     ; Breaks must be off!
                     (set! cleanup? #t))
                   (λ () 
                     (current-error-escape-k saved-error-escape-k)
                     (when cleanup?
                       (set! in-evaluation? #f)
                       (update-running #f)
                       (cleanup))))))))
          
          (define/public (run-in-evaluation-thread thunk) ; =Kernel=
            (semaphore-wait eval-thread-state-sema)
            (set! eval-thread-thunks (append eval-thread-thunks (list thunk)))
            (semaphore-post eval-thread-state-sema)
            (semaphore-post eval-thread-queue-sema))
          
          (define/private (init-evaluation-thread) ; =Kernel=
            (set! user-language-settings (send definitions-text get-next-settings))
            
            (set! user-custodian (make-custodian))
            ; (custodian-limit-memory user-custodian 10000000 user-custodian)
            (set! user-eventspace-box (make-weak-box
                                       (parameterize ([current-custodian user-custodian])
                                         (make-eventspace))))
            (set! user-break-parameterization (parameterize-break 
                                               #t 
                                               (current-break-parameterization)))
            (set! user-break-enabled #t)
            (set! eval-thread-thunks null)
            (set! eval-thread-state-sema (make-semaphore 1))
            (set! eval-thread-queue-sema (make-semaphore 0))
            
            (let* ([init-thread-complete (make-semaphore 0)]
                   [goahead (make-semaphore)])
              
              ; setup standard parameters
              (let ([snip-classes
                     ; the snip-classes in the DrScheme eventspace's snip-class-list
                     (drscheme:eval:get-snip-classes)])
                (queue-user/wait
                 (λ () ; =User=, =No-Breaks=
                   ; No user code has been evaluated yet, so we're in the clear...
                   (break-enabled #f)
                   (set! user-thread-box (make-weak-box (current-thread)))
                   (initialize-parameters snip-classes))))
              
              ;; disable breaks until an evaluation actually occurs
              (send context set-breakables #f #f)
              
              ;; initialize the language
              (send (drscheme:language-configuration:language-settings-language user-language-settings)
                    on-execute
                    (drscheme:language-configuration:language-settings-settings user-language-settings)
                    (let ([run-on-user-thread (lambda (t) (queue-user/wait t))])
                      run-on-user-thread))
              
              ;; installs the teachpacks
              ;; must happen after language is initialized.
              (queue-user/wait
               (λ () ; =User=, =No-Breaks=
                 (drscheme:teachpack:install-teachpacks 
                  user-teachpack-cache)))
              
              (parameterize ([current-eventspace (get-user-eventspace)])
                (queue-callback
                 (λ ()
                   (let ([drscheme-error-escape-handler
                          (λ ()
                            ((current-error-escape-k)))])
                     (error-escape-handler drscheme-error-escape-handler))
                   
                   (set! in-evaluation? #f)
                   (update-running #f)
                   (send context set-breakables #f #f)
                   
                   ;; let init-thread procedure return,
                   ;; now that parameters are set
                   (semaphore-post init-thread-complete)
                   
                   ; We're about to start running user code.
                   
                   ; Pause to let killed-thread get initialized
                   (semaphore-wait goahead)
                   
                   (let loop () ; =User=, =Handler=, =No-Breaks=
                     ; Wait for something to do
                     (unless (semaphore-try-wait? eval-thread-queue-sema)
                       ; User event callbacks run here; we turn on
                       ;  breaks in the dispatch handler.
                       (yield eval-thread-queue-sema))
                     ; About to eval something
                     (semaphore-wait eval-thread-state-sema)
                     (let ([thunk (car eval-thread-thunks)])
                       (set! eval-thread-thunks (cdr eval-thread-thunks))
                       (semaphore-post eval-thread-state-sema)
                       ; This thunk evals the user's expressions with appropriate
                       ;   protections.
                       (thunk))
                     (loop)))))
              (semaphore-wait init-thread-complete)
              ; Start killed-thread
              (initialize-killed-thread)
              ; Let user expressions go...
              (semaphore-post goahead)))
          
          (define/private (queue-user/wait thnk)
            (let ([wait (make-semaphore 0)])
              (parameterize ([current-eventspace (get-user-eventspace)])
                (queue-callback
                 (λ ()
                   (thnk)
                   (semaphore-post wait))))
              (semaphore-wait wait)))
          
          (field (shutting-down? #f))

          (define/override (allow-close-with-no-filename?) #t)
          (define/augment (can-close?)
            (and (cond
                   [in-evaluation?
                    (equal? (message-box/custom
                             (string-constant drscheme)
                             (string-constant program-is-still-running)
                             (string-constant close-anyway)
                             (string-constant cancel)
                             #f
                             (or (get-top-level-window) (get-can-close-parent))
                             '(default=1 caution)
                             2)
                            1)]
                   [(let ([user-eventspace (get-user-eventspace)])
                      (and user-eventspace
                           (parameterize ([current-eventspace user-eventspace])
                             (not (null? (get-top-level-windows))))))
                    (equal? (message-box/custom
                             (string-constant drscheme)
                             (string-constant program-has-open-windows)
                             (string-constant close-anyway)
                             (string-constant cancel)
                             #f
                             (or (get-top-level-window) (get-can-close-parent))
                             '(default=1 caution)
                             2)
                            1)]
                   [else #t])
                 (inner #t can-close?)))
          
          (define/augment (on-close)
            (shutdown)
            (preferences:set 'drscheme:console-previous-exprs 
                             (trim-previous-exprs
                              (append 
                               (preferences:get 'drscheme:console-previous-exprs)
                               local-previous-exprs)))
            (inner (void) on-close))
          
          (define/public (shutdown) ; =Kernel=, =Handler=
            (set! shutting-down? #t)
            (when (thread? thread-killed)
              (kill-thread thread-killed)
              (set! thread-killed #f))
            (shutdown-user-custodian))
          
          (define/private update-running ; =User=, =Handler=, =No-Breaks=
            (λ (bool)
              (queue-system-callback
               (get-user-thread)
               (λ ()
                 (send context update-running bool)))))
          
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          ;;;                                          ;;;
          ;;;                Execution                 ;;;
          ;;;                                          ;;;
          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
          
          ;; initialize-paramters : (listof snip-class%) -> void
          (define/private initialize-parameters ; =User=
            (λ (snip-classes)
              
              (current-language-settings user-language-settings)
              (error-value->string-handler drscheme-error-value->string-handler)
              (error-print-source-location #f)
              (error-display-handler drscheme-error-display-handler)
              (current-load-relative-directory #f)
              (current-custodian user-custodian)
              (current-load text-editor-load-handler)
              
              (drscheme:eval:set-basic-parameters snip-classes)
              (current-rep this)
              (let ([dir (or (send context get-directory)
                           drscheme:init:first-dir)])
                (current-directory dir)
                (current-load-relative-directory dir))
              
              (set! user-namespace-box (make-weak-box (current-namespace)))
              
              (current-output-port (get-out-port))
              (current-error-port (get-err-port))
              (current-value-port (get-value-port))
              (current-input-port (get-in-box-port))
              (break-enabled #t)
              (let* ([primitive-dispatch-handler (event-dispatch-handler)])
                (event-dispatch-handler
                 (rec drscheme-event-dispatch-handler ; <= a name for #<...> printout
                   (λ (eventspace) ; =User=, =Handler=
                     ; Breaking is enabled if the user turned on breaks and
                     ;  is in a `yield'. If we get a break, that's ok, because
                     ;  the kernel never queues an event in the user's eventspace.
                     (cond
                       [(eq? eventspace (get-user-eventspace))
                        ; =User=, =Handler=, =No-Breaks=
                        
                        (let* ([ub? (eq? user-break-enabled 'user)]
                               [break-ok? (if ub?
                                              (break-enabled)
                                              user-break-enabled)])
                          (break-enabled #f)
                          
                          ; We must distinguish between "top-level" events and
                          ;  those within `yield' in the user's program.
                          
                          (cond
                            [(not in-evaluation?)
                             (send context reset-offer-kill)
                             (send context set-breakables (get-user-thread) (get-user-custodian))
                             
                             (protect-user-evaluation
                              ; Run the dispatch:
                              (λ () ; =User=, =Handler=, =No-Breaks=
                                ; This procedure is responsible for adjusting breaks to
                                ;  match the user's expectations:
                                (dynamic-wind
                                 (λ () 
                                   (break-enabled break-ok?)
                                   (unless ub?
                                     (set! user-break-enabled 'user)))
                                   (λ ()
                                     (primitive-dispatch-handler eventspace))
                                   (λ ()
                                     (unless ub?
                                       (set! user-break-enabled (break-enabled)))
                                     (break-enabled #f))))
                              ; Cleanup after dispatch
                              (λ ()
                                ;; in principle, the line below might cause
                                ;; a "race conditions" in the GUI. That is, there might
                                ;; be many little events that the user won't quite
                                ;; be able to break.
                                (send context set-breakables #f #f)))
                             
                             ; Restore break:
                             (when ub?
                               (break-enabled break-ok?))]
                            [else
                             ; Nested dispatch; don't adjust interface, and restore break:
                             (break-enabled break-ok?)
                             (primitive-dispatch-handler eventspace)]))]
                       [else 
                        ; =User=, =Non-Handler=, =No-Breaks=
                        (primitive-dispatch-handler eventspace)])))))))
          
          (define/public (new-empty-console)
            (queue-user/wait
             (λ () ; =User=, =No-Breaks=
               (send (drscheme:language-configuration:language-settings-language user-language-settings)
                     first-opened))))
            
          (define/public (reset-console)
            (when (thread? thread-killed)
              (kill-thread thread-killed))
            (send context clear-annotations)
            (drscheme:debug:hide-backtrace-window)
            (shutdown-user-custodian)
            (clear-input-port)
            (clear-box-input-port)
            (clear-output-ports)
            (set-allow-edits #t)
            (set! should-collect-garbage? #t)
            
            ;; in case the last evaluation thread was killed, clean up some state.
            (lock #f)
            (set! in-evaluation? #f)
            (update-running #f)
            
            ;; clear out repl first before doing any work.
            (begin-edit-sequence)
            (freeze-colorer)
            (reset-input-box)
            (delete (paragraph-start-position 1) (last-position))
            (end-edit-sequence)
            
            ;; must init-evaluation-thread before determining
            ;; the language's name, since this updates user-language-settings
            (init-evaluation-thread)
            
            (begin-edit-sequence)
            (set-position (last-position) (last-position))
            
            (set! setting-up-repl? #t)
            (insert/delta this (string-append (string-constant language) ": ") welcome-delta)
            (let-values (((before after)
                          (insert/delta
                           this
                           (extract-language-name user-language-settings)
                           dark-green-delta
                           (extract-language-style-delta user-language-settings)))
                         ((url) (extract-language-url user-language-settings)))
              (when url
                (set-clickback before after (λ args (send-url url))
                               click-delta)))
            (unless (is-default-settings? user-language-settings)
              (insert/delta this (string-append " " (string-constant custom)) dark-green-delta))
            (insert/delta this (format ".~n") welcome-delta)
            
            (for-each
             (λ (fn)
               (insert/delta this
                             (string-append (string-constant teachpack) ": ")
                             welcome-delta)
               (insert/delta this fn dark-green-delta)
               (insert/delta this (format ".~n") welcome-delta))
             (map path->string 
                  (drscheme:teachpack:teachpack-cache-filenames 
                   user-teachpack-cache)))
            (set! setting-up-repl? #f)
            
            (set! already-warned? #f)
            (reset-region (last-position) (last-position))
            (set-unread-start-point (last-position))
            (set-insertion-point (last-position))
            (set-allow-edits #f)
            (set! repl-header-end #f)
            (end-edit-sequence))
          
          (define/public (initialize-console)
            (begin-edit-sequence)
            (freeze-colorer)
            (set! setting-up-repl? #t)
            (insert/delta this (string-append (string-constant welcome-to) " ") welcome-delta)
            (let-values ([(before after)
                          (insert/delta this (string-constant drscheme) click-delta drs-font-delta)])
              (insert/delta this (format (string-append ", " (string-constant version) " ~a.~n") (version:version))
                            welcome-delta)
              (set-clickback before after 
                             (λ args (drscheme:app:about-drscheme))
                             click-delta))
            (set! setting-up-repl? #f)
            (thaw-colorer)
            (send context disable-evaluation)
            (reset-console)

            (queue-user/wait
             (λ () ; =User=, =No-Breaks=
               (send (drscheme:language-configuration:language-settings-language user-language-settings)
                     first-opened)))

            (insert-prompt)
            (send context enable-evaluation)
            (end-edit-sequence)
            (clear-undos))
          
          ;; avoid calling paragraph-start-position very often.
          (define repl-header-end #f)
          (define/private (get-repl-header-end)
            (if repl-header-end
                repl-header-end
                (begin (set! repl-header-end (paragraph-start-position 2))
                       repl-header-end)))
                    
          (define setting-up-repl? #f)
          (define/augment (can-change-style? start len)
            (and (inner #t can-change-style? start len)
                 (or setting-up-repl?
                     (start . >= . (get-repl-header-end)))))
          
          (define/private (last-str l)
            (if (null? (cdr l))
                (car l)
                (last-str (cdr l))))
          
          (field (previous-expr-pos -1))
          
          (define/public (copy-previous-expr)
            (when prompt-position
              (let ([snip/strings (list-ref (get-previous-exprs) previous-expr-pos)])
                (begin-edit-sequence)
                (delete prompt-position (last-position) #f)
                (for-each (λ (snip/string)
                            (insert (if (is-a? snip/string snip%)
                                        (send snip/string copy)
                                        snip/string)
                                    prompt-position))
                          snip/strings)
                (set-position (last-position))
                (end-edit-sequence))))
          
          (define/public copy-next-previous-expr
            (λ ()
              (let ([previous-exprs (get-previous-exprs)])
                (unless (null? previous-exprs)
                  (set! previous-expr-pos
                        (if (< (add1 previous-expr-pos) (length previous-exprs))
                            (add1 previous-expr-pos)
                            0))
                  (copy-previous-expr)))))
          (define/public copy-prev-previous-expr
            (λ ()
              (let ([previous-exprs (get-previous-exprs)])
                (unless (null? previous-exprs)
                  (set! previous-expr-pos
                        (if (previous-expr-pos . <= . 0)
                            (sub1 (length previous-exprs))
                            (sub1 previous-expr-pos)))
                  (copy-previous-expr)))))
          
          ;; private fields
          (define global-previous-exprs (preferences:get 'drscheme:console-previous-exprs))
          (define local-previous-exprs null)
          (define/private (get-previous-exprs)
            (append global-previous-exprs local-previous-exprs))
          (define/private (add-to-previous-exprs snips)
            (let* ([new-previous-exprs 
                    (let* ([trimmed-previous-exprs (trim-previous-exprs local-previous-exprs)])
                      (let loop ([l trimmed-previous-exprs])
                        (if (null? l)
                            (list snips)
                            (cons (car l) (loop (cdr l))))))])
              (set! local-previous-exprs new-previous-exprs)))
          
          (define/private (trim-previous-exprs lst)
            (if ((length lst). >= .  console-max-save-previous-exprs)
                (cdr lst)
                lst))
          
          (define/private (save-interaction-in-history start end)
            (split-snip start)
            (split-snip end)
            (let ([snips
                   (let loop ([snip (find-snip start 'after-or-none)]
                              [snips null])
                     (cond
                       [(not snip) snips]
                       [((get-snip-position snip) . <= . end)
                        (loop (send snip next)
                              (cons (send snip copy) snips))]
                       [else snips]))])
              (set! previous-expr-pos -1)
              (add-to-previous-exprs snips)))
          
          (define/public (reset-pretty-print-width)
            (let* ([standard (send (get-style-list) find-named-style "Standard")])
              (when standard
                (let* ([admin (get-admin)]
                       [width
                        (let ([bw (box 0)]
                              [b2 (box 0)])
                          (send admin get-view b2 b2 bw b2)
                          (unbox bw))]
                       [dc (send admin get-dc)]
                       [new-font (send standard get-font)]
                       [old-font (send dc get-font)])
                  (send dc set-font new-font)
                  (let* ([char-width (send dc get-char-width)]
                         [min-columns 50]
                         [new-columns (max min-columns 
                                           (floor (/ width char-width)))])
                    (send dc set-font old-font)
                    (pretty-print-columns new-columns))))))
          
          (super-new)
          (auto-wrap #t)
          (set-styles-sticky #f)))
      
      (define input-delta (make-object style-delta%))
      (send input-delta set-delta-foreground (make-object color% 0 150 0))

      ;; insert-error-in-text : (is-a?/c text%)
      ;;                        (union #f (is-a?/c drscheme:rep:text<%>))
      ;;                        string?
      ;;                        exn?
      ;;                        (union false? (and/c string? directory-exists?))
      ;;                        ->
      ;;                        void?
      (define (insert-error-in-text text interactions-text msg exn user-dir)
        (insert-error-in-text/highlight-errors
         text
         (λ (l) (send interactions-text highlight-errors l))
         msg
         exn
         user-dir))
      
      ;; insert-error-in-text/highlight-errors : (is-a?/c text%)
      ;;                                         ((listof (list text% number number)) -> void)
      ;;                                         string?
      ;;                                         exn?
      ;;                                         (union false? (and/c string? directory-exists?))
      ;;                                         ->
      ;;                                         void?
      (define (insert-error-in-text/highlight-errors text highlight-errors msg exn user-dir)
        (let ([locked? (send text is-locked?)]
              [insert-file-name/icon
               ;; insert-file-name/icon : string number number number number -> void
               (λ (source-name start span row col)
                 (let ([range-spec
                        (cond
                          [(and row col)
                           (format ":~a:~a" row col)]
                          [start
                           (format "::~a" start)]
                          [else ""])])
                   (cond
                     [(file-exists? source-name)
                      (let* ([normalized-name (normalize-path source-name)]
                             [short-name (if user-dir
                                             (find-relative-path user-dir normalized-name)
                                             source-name)])
                        (let-values ([(icon-start icon-end) (insert/delta text (send file-icon copy))]
                                     [(space-start space-end) (insert/delta text " ")]
                                     [(name-start name-end) (insert/delta text short-name)]
                                     [(range-start range-end) (insert/delta text range-spec)]
                                     [(colon-start colon-ent) (insert/delta text ": ")])
                          (when (number? start)
                            (send text set-clickback icon-start range-end
                                  (λ (_1 _2 _3)
                                    (open-file-and-highlight normalized-name
                                                             (- start 1) 
                                                             (if span
                                                                 (+ start -1 span)
                                                                 start)))))))]
                     [else
                      (insert/delta text source-name)
                      (insert/delta text range-spec)
                      (insert/delta text ": ")])))])
          (send text begin-edit-sequence)
          (send text lock #f)
          (cond
            [(exn:fail:syntax? exn)
             (for-each
              (λ (expr)
                (let ([src (and (syntax? expr) (syntax-source expr))]
                      [pos (and (syntax? expr) (syntax-position expr))]
                      [span (and (syntax? expr) (syntax-span expr))]
                      [col (and (syntax? expr) (syntax-column expr))]
                      [line (and (syntax? expr) (syntax-line expr))])
                  (when (and (string? src)
                             (number? pos)
                             (number? span)
                             (number? line)
                             (number? col))
                    (insert-file-name/icon src pos span line col))
                  (insert/delta text (format "~a" (exn-message exn)) error-delta)
                  (when (syntax? expr)
                    (insert/delta text " in: ")
                    (insert/delta text (format "~s" (syntax-object->datum expr)) error-text-style-delta))
                  (insert/delta text "\n")
                  (when (and (is-a? src text:basic%)
                             (number? pos)
                             (number? span))
                    (highlight-errors (list (list src (- pos 1) (+ pos -1 span)))))))
              (exn:fail:syntax-exprs exn))]
            [(exn:fail:read? exn)
             '(let ([src (exn:read-source exn)]
                    [pos (exn:read-position exn)]
                    [span (exn:read-span exn)]
                    [line (exn:read-line exn)]
                    [col (exn:read-column exn)])
                (when (and (string? src)
                           (number? pos)
                           (number? span)
                           (number? line)
                           (number? col))
                  (insert-file-name/icon src pos span line col))
                (insert/delta text (format "~a" (exn-message exn)) error-delta)
                (insert/delta text "\n")
                (when (and (is-a? src text:basic%)
                           (number? pos)
                           (number? span))
                  (highlight-errors (list (list src (- pos 1) (+ pos -1 span))))))]
            [(exn? exn)
             (insert/delta text (format "~a" (exn-message exn)) error-delta)
             (insert/delta text "\n")]
            [else
             (insert/delta text "uncaught exception: " error-delta)
             (insert/delta text (format "~s" exn) error-delta)
             (insert/delta text "\n")])
          (send text lock locked?)
          (send text end-edit-sequence)))


      ;; open-file-and-highlight : string (union number #f) (union number #f)
      ;; =Kernel, =Handler=
      ;; opens the file named by filename. If position is #f,
      ;; doesn't highlight anything. If position is a number and other-position
      ;; is #f, highlights the range from position to the end of sexp.
      ;; if other-position is a number, highlights from position to 
      ;; other position.
      (define (open-file-and-highlight filename position other-position)
        (let ([file (handler:edit-file filename)])
          (when (and (is-a? file drscheme:unit:frame%)
                     position)
            (if other-position
                (send (send file get-interactions-text)
                      highlight-error
                      (send file get-definitions-text)
                      position
                      other-position)
                (send (send file get-interactions-text)
                      highlight-error/forward-sexp
                      (send file get-definitions-text)
                      position)))))
      

                           
      (define -text% 
        (drs-bindings-keymap-mixin
         (text-mixin 
          (text:ports-mixin
           (scheme:text-mixin
            (color:text-mixin
             (text:info-mixin
              (editor:info-mixin
               (text:searching-mixin
                (text:nbsp->space-mixin
                 (mode:host-text-mixin
                  (text:foreground-color-mixin
                   text:clever-file-format%)))))))))))))))
