From 8489d5cfb9852229ba4625a8e59a5b34c2881da6 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 5 Aug 2008 11:05:07 -0400
Subject: [PATCH 1/5] compiles except for language

---
 collects/drscheme/private/bitmap-message.ss   |  19 ++
 .../private/insert-large-letters-typed.ss     | 176 ++++++++++++++++++
 collects/drscheme/private/mred-typed.ss       | 103 ++++++++++
 collects/drscheme/private/prefs-contract.ss   |  16 ++
 4 files changed, 314 insertions(+)
 create mode 100644 collects/drscheme/private/bitmap-message.ss
 create mode 100644 collects/drscheme/private/insert-large-letters-typed.ss
 create mode 100644 collects/drscheme/private/mred-typed.ss
 create mode 100644 collects/drscheme/private/prefs-contract.ss

diff --git a/collects/drscheme/private/bitmap-message.ss b/collects/drscheme/private/bitmap-message.ss
new file mode 100644
index 0000000000..10ca5a9339
--- /dev/null
+++ b/collects/drscheme/private/bitmap-message.ss
@@ -0,0 +1,19 @@
+#lang scheme
+
+(require mred/mred)
+(provide bitmap-message%)
+
+(define bitmap-message%
+  (class canvas%
+    (inherit min-width min-height get-dc)
+    (define bm #f)
+    (define/override (on-paint)
+      (when bm
+        (let ([dc (get-dc)])
+          (send dc draw-bitmap bm 0 0))))
+    (define/public (set-bm b)
+      (set! bm b)
+      (min-width (send bm get-width))
+      (min-height (send bm get-height)))
+    (super-new (stretchable-width #f)
+               (stretchable-height #f))))
\ No newline at end of file
diff --git a/collects/drscheme/private/insert-large-letters-typed.ss b/collects/drscheme/private/insert-large-letters-typed.ss
new file mode 100644
index 0000000000..f33eca9fac
--- /dev/null
+++ b/collects/drscheme/private/insert-large-letters-typed.ss
@@ -0,0 +1,176 @@
+#lang typed-scheme
+
+(require "mred-typed.ss"
+         scheme/class
+         string-constants/string-constant)
+
+(provide insert-large-letters)
+
+(: insert-large-letters (String Char (Instance Scheme:Text%) Any -> Void))
+(define (insert-large-letters comment-prefix comment-character edit parent)
+  (let ([str (make-large-letters-dialog comment-prefix comment-character #f)])
+    (when (and str
+               (not (equal? str "")))
+      (render-large-letters comment-prefix comment-character (get-chosen-font) str edit)
+      (void))))
+
+(preferences:set-default 'drscheme:large-letters-font #f (λ: ([x : Any])
+                                                             (or (and (pair? x)
+                                                                      (string? (car x))
+                                                                      (let ([i (cdr x)])
+                                                                        (and (integer? x)
+                                                                             (<= 1 x 255))))
+                                                                 (not x))))
+
+(: get-default-font (-> (Instance Font%)))
+(define (get-default-font)
+  (send (send (editor:get-standard-style-list)
+              find-named-style
+              "Standard")
+        get-font))
+
+(: get-chosen-font (-> (Instance Font%)))
+(define (get-chosen-font)
+  (let ([pref-val (preferences:get 'drscheme:large-letters-font)])
+    (cond
+      [pref-val
+       (let ([candidate (send the-font-list find-or-create-font (cdr pref-val) (car pref-val) 'default 'normal 'normal)])
+         (if (equal? (send candidate get-face) (car pref-val))
+             candidate
+             (get-default-font)))]
+      [else
+       (get-default-font)])))
+
+(define columns-string "~a columns")
+
+;; make-large-letters-dialog : string char top-level-window<%> -> void
+(: make-large-letters-dialog (String Char Any -> (Option String)))
+(define (make-large-letters-dialog comment-prefix comment-character parent)
+  (define dlg (new dialog% 
+                   [parent parent] 
+                   [width 700]
+                   [label (string-constant large-semicolon-letters)]))  
+  (define info-bar (new horizontal-panel%
+                        [parent dlg]
+                        [stretchable-height #f]))
+  
+  (define count (new message% [label (format columns-string 1000)] [parent info-bar]))
+  (define pane1 (new horizontal-pane% (parent info-bar)))
+  (define dark-msg (new bitmap-message% [parent info-bar]))
+  (define pane2 (new horizontal-pane% (parent info-bar)))
+                                
+                                
+  (define txt (new scheme:text%))
+  (define ec (new editor-canvas% [parent dlg] [editor txt]))
+  (define button-panel (new horizontal-panel%
+                            [parent dlg]
+                            [stretchable-height #f]
+                            [alignment '(right center)]))
+  (define: ok? : Boolean #f)
+  (define-values (ok cancel)
+    (gui-utils:ok/cancel-buttons button-panel
+                                 (λ: ([x : Any] [y : Any]) (set! ok? #t) (send dlg show #f))
+                                 (λ: ([x : Any] [y : Any]) (send dlg show #f))))
+  (define: (update-txt [str : String]) : Any
+    (send txt begin-edit-sequence)
+    (send txt lock #f)
+    (send txt delete 0 (send txt last-position))
+    (let ([bm (render-large-letters comment-prefix comment-character (get-chosen-font) str txt)])
+      (send ec set-line-count (+ 1 (send txt last-paragraph)))
+      (send txt lock #t)
+      (send txt end-edit-sequence)
+      (send count set-label (format columns-string (get-max-line-width txt)))
+      (send dark-msg set-bm bm)))
+  
+  (define: text-field : (Instance Text-Field%) 
+    (new text-field% 
+         [parent dlg] 
+         [label (string-constant text-to-insert)]
+         [callback (λ: ([x : Any] [y : Any]) (update-txt (send text-field get-value)))]))
+  (define: font-choice : (Instance Choice%)
+    (new choice%
+         [label (string-constant fonts)]
+         [parent info-bar]
+         [choices (get-face-list)]
+         [callback
+          (λ: ([x : Any] [y : Any])
+            (let ([old (preferences:get 'drscheme:large-letters-font)])
+              (preferences:set 'drscheme:large-letters-font
+                               (cons (send font-choice get-string-selection)
+                                     (if old
+                                         (cdr old)
+                                         (send (get-default-font) get-point-size))))
+              (update-txt (send text-field get-value))))]))
+  
+  ;; CHANGE - get-face can return #f
+  (let ([face (send (get-chosen-font) get-face)])
+    (when face
+      (send font-choice set-string-selection face)))
+  
+  (send txt auto-wrap #f)
+  (update-txt " ")
+  (send text-field focus)
+  (send dlg show #t)
+  (and ok? (send text-field get-value)))
+
+(: get-max-line-width ((Instance Scheme:Text%) -> Number))
+(define (get-max-line-width txt)
+  (let loop ([i (+ (send txt last-paragraph) 1)]
+             [m #{0 :: Number}])
+    (cond
+      [(zero? i) m]
+      [else (loop (- i 1)
+                  (max m (- (send txt paragraph-end-position (- i 1))
+                            (send txt paragraph-start-position (- i 1)))))])))
+      
+
+(: render-large-letters (String Char (Instance Font%) String (Instance Scheme:Text%) -> (Instance Bitmap%)))
+(define (render-large-letters comment-prefix comment-character the-font str edit)
+  (define bdc (make-object bitmap-dc% (make-object bitmap% 1 1 #t)))
+  (define-values (tw raw-th td ta) (send bdc get-text-extent str the-font))
+  (define th (let-values ([(_1 h _2 _3) (send bdc get-text-extent "X" the-font)])
+               (max raw-th h)))
+  (define tmp-color (make-object color%))
+  
+  
+  (define bitmap
+    (make-object bitmap% 
+      (max 1 (inexact->exact tw))
+      (inexact->exact th)
+      #t))
+  
+  (define: (get-char [x : Number] [y : Number]) : Char
+    (send bdc get-pixel x y tmp-color)
+    (let ([red (send tmp-color red)])
+      (if (= red 0)
+          comment-character
+          #\space)))
+  
+  (define: (fetch-line [y : Number]) : String
+    (let: loop : String ([x : Number (send bitmap get-width)]
+                         [chars : (Listof Char) null])
+      (cond
+        [(zero? x) (apply string chars)]
+        [else (loop (- x 1) (cons (get-char (- x 1) y) chars))])))
+  
+  (send bdc set-bitmap bitmap)
+  (send bdc clear)
+  (send bdc set-font the-font)
+  (send bdc draw-text str 0 0)
+  
+  (send edit begin-edit-sequence)
+  (let ([start (send edit get-start-position)]
+        [end (send edit get-end-position)])
+    (send edit delete start end)
+    (send edit insert "\n" start start)
+    (let loop ([y (send bitmap get-height)])
+      (unless (zero? y)
+        (send edit insert (fetch-line (- y 1)) start start)
+        (send edit insert comment-prefix start start)
+        (send edit insert "\n" start start)
+        (loop (- y 1)))))
+  (send edit end-edit-sequence)
+  (send bdc set-bitmap #f)
+  bitmap)
+
+;(make-large-letters-dialog ";" #\; #f)
\ No newline at end of file
diff --git a/collects/drscheme/private/mred-typed.ss b/collects/drscheme/private/mred-typed.ss
new file mode 100644
index 0000000000..59ad9525ad
--- /dev/null
+++ b/collects/drscheme/private/mred-typed.ss
@@ -0,0 +1,103 @@
+#lang typed-scheme
+             
+;(require mred/mred)
+(provide (all-defined-out))
+
+(define-type-alias Bitmap% (Class (Number Number Boolean)
+                                  () 
+                                  ([get-width (-> Number)]
+                                   [get-height (-> Number)])))
+(define-type-alias Font-List% (Class () () ([find-or-create-font (Any * -> (Instance Font%))])))
+(define-type-alias Font% (Class () () ([get-face (-> (Option String))]
+                                       [get-point-size (-> Number)])))
+(define-type-alias Dialog% (Class () 
+                                  ([parent Any] [width Number] [label String]) 
+                                  ([show (Any -> Void)])))
+(define-type-alias Text-Field% (Class () 
+                                      ([parent Any] [callback Any] [label String])
+                                      ([get-value (-> String)]
+                                       [focus (-> String)])))
+(define-type-alias Horizontal-Panel% (Class ()
+                                            ([parent Any] 
+                                             [stretchable-height Any #t]
+                                             [alignment (List Symbol Symbol) #t])
+                                            ()))
+(define-type-alias Choice% (Class ()
+                                  ([parent Any] [label String] [choices List] [callback Any])
+                                  ([get-string-selection (-> (Option String))]
+                                   [set-string-selection (String -> Void)])))
+(define-type-alias Message% (Class ()
+                                   ([parent Any] [label String])
+                                   ([set-label ((U String (Instance Bitmap%)) -> Void)])))
+(define-type-alias Horizontal-Pane% (Class ()
+                                           ([parent Any])
+                                           ()))
+(define-type-alias Editor-Canvas% (Class ()
+                                         ([parent Any] [editor Any])
+                                         ([set-line-count (Number -> Void)])))
+(define-type-alias Bitmap-DC% (Class ((Instance Bitmap%))
+                                     ()
+                                     ([get-text-extent (String (Instance Font%) -> (values Number Number Number Number))]
+                                      [get-pixel (Number Number (Instance Color%) -> Boolean)]
+                                      [set-bitmap ((Option (Instance Bitmap%)) -> Void)]
+                                      [clear (-> Void)]
+                                      [set-font ((Instance Font%) -> Void)]
+                                      [draw-text (String Number Number -> Void)])))
+(define-type-alias Color% (Class () () ([red (-> Number)])))
+(define-type-alias Style-List% (Class () 
+                                      ()
+                                      ([find-named-style 
+                                        (String -> (Instance (Class ()
+                                                                    () 
+                                                                    ([get-font (-> (Instance Font%))]))))])))
+
+(define-type-alias Scheme:Text% (Class ()
+                                       ()
+                                       ([begin-edit-sequence (-> Void)]
+                                        [end-edit-sequence (-> Void)]
+                                        [lock (Boolean -> Void)]
+                                        [last-position (-> Number)]
+                                        [last-paragraph (-> Number)]
+                                        [delete (Number Number -> Void)]
+                                        [auto-wrap (Any -> Void)]
+                                        [paragraph-end-position (Number -> Number)]
+                                        [paragraph-start-position (Number -> Number)]
+                                        [get-start-position (-> Number)]
+                                        [get-end-position (-> Number)]
+                                        [insert (String Number Number -> Void)])))
+
+(require/typed mred/mred
+               [the-font-list (Instance Font-List%)]
+               [dialog% Dialog%]
+               [text-field% Text-Field%]
+               [horizontal-panel% Horizontal-Panel%]
+               [choice% Choice%]
+               [get-face-list (-> (Listof String))]
+               [message% Message%]
+               [horizontal-pane% Horizontal-Pane%]
+               [editor-canvas% Editor-Canvas%]
+               [bitmap-dc% Bitmap-DC%]
+               [bitmap% Bitmap%]
+               [color% Color%])
+
+(require/typed framework/framework
+               [preferences:set-default (Symbol Any Any -> Void)]
+               [preferences:set (Symbol Any -> Void)]
+               [editor:get-standard-style-list 
+                (-> (Instance Style-List%))]
+               [scheme:text% Scheme:Text%]
+               [gui-utils:ok/cancel-buttons (Any (Any Any -> Any) (Any Any -> Any) -> (values Any Any))])
+
+(require/typed "prefs-contract.ss"
+               [preferences:get-drscheme:large-letters-font (-> (Pair Symbol Number))])
+
+(require (only-in "prefs-contract.ss" preferences:get))
+(provide preferences:get preferences:get-drscheme:large-letters-font)
+
+(define-type-alias Bitmap-Message% (Class () 
+                                          ([parent Any])
+                                          ([set-bm ((Instance Bitmap%) -> Void)])))
+               
+
+(require/typed "bitmap-message.ss"
+               [bitmap-message% Bitmap-Message%])
\ No newline at end of file
diff --git a/collects/drscheme/private/prefs-contract.ss b/collects/drscheme/private/prefs-contract.ss
new file mode 100644
index 0000000000..cb648dd533
--- /dev/null
+++ b/collects/drscheme/private/prefs-contract.ss
@@ -0,0 +1,16 @@
+#lang scheme/base
+
+(require (for-syntax scheme/base)
+         framework/framework)
+
+(provide (rename-out [-preferences:get preferences:get])
+         preferences:get-drscheme:large-letters-font)
+
+(define (preferences:get-drscheme:large-letters-font)
+  (preferences:get 'drscheme:large-letters-font))
+
+(define-syntax (-preferences:get stx)
+  (syntax-case stx (quote)
+    [(_ (quote sym))
+     (with-syntax ([nm (datum->syntax stx (string->symbol (string-append "preferences:get" "-" (symbol->string (syntax-e #'sym)))))])
+       (syntax/loc stx (nm)))]))
\ No newline at end of file

From f0e5a33f462f2b6efe3f227ff3b24ab501325505 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 27 Aug 2008 15:22:23 -0400
Subject: [PATCH 2/5] merge in trunk to 11458

---
 collects/drscheme/acks.ss                     |   2 +
 collects/drscheme/drscheme.ss                 |   8 +-
 collects/drscheme/info.ss                     |   8 +-
 collects/drscheme/private/auto-language.ss    |   4 +-
 collects/drscheme/private/bindings-browser.ss |   5 +-
 collects/drscheme/private/debug.ss            |   4 +-
 collects/drscheme/private/drscheme-normal.ss  |   4 +-
 collects/drscheme/private/drsig.ss            |   6 +-
 collects/drscheme/private/eval.ss             |   4 +-
 collects/drscheme/private/first-line-text.ss  | 184 +++++++++++++++---
 collects/drscheme/private/font.ss             |   4 +-
 collects/drscheme/private/frame.ss            |  13 +-
 collects/drscheme/private/init.ss             |   1 -
 collects/drscheme/private/key.ss              |   4 +-
 collects/drscheme/private/label-frame-mred.ss |   4 +-
 .../private/language-configuration.ss         |   5 +-
 collects/drscheme/private/language.ss         |   6 +-
 collects/drscheme/private/link.ss             |   4 +-
 collects/drscheme/private/module-language.ss  | 147 +++++++-------
 .../drscheme/private/multi-file-search.ss     |   1 -
 collects/drscheme/private/number-snip.ss      |   4 +-
 collects/drscheme/private/rep.ss              |  18 +-
 collects/drscheme/private/stick-figures.ss    |   4 +-
 collects/drscheme/private/syncheck-debug.ss   |   5 +-
 collects/drscheme/private/text.ss             |   1 -
 collects/drscheme/private/time-keystrokes.ss  |  86 --------
 .../private/tool-contract-language.ss         |   5 +-
 collects/drscheme/private/tools.ss            |   1 -
 collects/drscheme/private/unit.ss             | 117 ++++++-----
 collects/drscheme/tool-lib.ss                 |   7 +-
 30 files changed, 370 insertions(+), 296 deletions(-)
 delete mode 100644 collects/drscheme/private/time-keystrokes.ss

diff --git a/collects/drscheme/acks.ss b/collects/drscheme/acks.ss
index fecf97b005..d0fa090ad0 100644
--- a/collects/drscheme/acks.ss
+++ b/collects/drscheme/acks.ss
@@ -35,12 +35,14 @@
      "Dave Gurnell, "
      "Bruce Hauman, "
      "Dave Herman, "
+     "Geoffrey S. Knauth, "
      "Mark Krentel, "
      "Shriram Krishnamurthi, "
      "Mario Latendresse, "
      "Guillaume Marceau, "
      "Jacob Matthews, "
      "Jay McCarthy, "
+     "Mike T. McHenry, "
      "Philippe Meunier, "
      "Scott Owens, "
      "Jamie Raymond, "
diff --git a/collects/drscheme/drscheme.ss b/collects/drscheme/drscheme.ss
index 38b97f8946..efe23d5d49 100644
--- a/collects/drscheme/drscheme.ss
+++ b/collects/drscheme/drscheme.ss
@@ -18,8 +18,8 @@
                                  [use-compiled-file-paths '()])
                     (values
                      (dynamic-require 'errortrace/zo-compile 'zo-compile)
-                     (dynamic-require 'mzlib/cm 'make-compilation-manager-load/use-compiled-handler)
-                     (dynamic-require 'mzlib/cm 'manager-trace-handler)))])
+                     (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
+                     (dynamic-require 'compiler/cm 'manager-trace-handler)))])
       (current-compile zo-compile)
       (use-compiled-file-paths (list (build-path "compiled" "errortrace")))
       (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
@@ -36,8 +36,8 @@
                    manager-trace-handler)
                   (parameterize ([current-namespace (make-namespace)])
                     (values
-                     (dynamic-require 'mzlib/cm 'make-compilation-manager-load/use-compiled-handler)
-                     (dynamic-require 'mzlib/cm 'manager-trace-handler)))])
+                     (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)
+                     (dynamic-require 'compiler/cm 'manager-trace-handler)))])
       (current-load/use-compiled (make-compilation-manager-load/use-compiled-handler))
       (when cm-trace?
         (printf "PLTDRCM: enabling CM tracing\n")
diff --git a/collects/drscheme/info.ss b/collects/drscheme/info.ss
index 9f6556b3cd..9786880b1f 100644
--- a/collects/drscheme/info.ss
+++ b/collects/drscheme/info.ss
@@ -1,6 +1,6 @@
 #lang setup/infotab
 
-(define tools (list "syncheck.ss" (list "time-keystrokes.ss" "private")))
-(define tool-names (list "Check Syntax" "Time Keystrokes"))
-(define mred-launcher-names     (list "DrScheme"))
-(define mred-launcher-libraries (list "drscheme.ss"))
+(define tools      '("syncheck.ss"))
+(define tool-names '("Check Syntax"))
+(define mred-launcher-names     '("DrScheme"))
+(define mred-launcher-libraries '("drscheme.ss"))
diff --git a/collects/drscheme/private/auto-language.ss b/collects/drscheme/private/auto-language.ss
index d0cc135c12..8a6b05d6d1 100644
--- a/collects/drscheme/private/auto-language.ss
+++ b/collects/drscheme/private/auto-language.ss
@@ -1,4 +1,4 @@
-(module auto-language mzscheme
+#lang mzscheme
   (require mred
            mzlib/class)
   
@@ -59,4 +59,4 @@
                  ;; If tp contains a snip, read-line fails.
                  (read-line tp))])
       (and (string? l1)
-           (regexp-match #rx"#lang .*$" l1)))))
+           (regexp-match #rx"#lang .*$" l1))))
diff --git a/collects/drscheme/private/bindings-browser.ss b/collects/drscheme/private/bindings-browser.ss
index b6f2599bef..5dffcb066b 100644
--- a/collects/drscheme/private/bindings-browser.ss
+++ b/collects/drscheme/private/bindings-browser.ss
@@ -1,3 +1,4 @@
+#lang mzscheme
 #|
 
 CODE COPIED (with permission ...) from syntax-browser.ss
@@ -7,7 +8,7 @@ Marshalling (and hence the 'read' method of the snipclass omitted for fast proto
                  
 |#
 
-(module bindings-browser mzscheme
+
   (require mzlib/pretty
            mzlib/list
            mzlib/class
@@ -288,7 +289,7 @@ Marshalling (and hence the 'read' method of the snipclass omitted for fast proto
                               (send text last-position)
                               (send text last-position))
                         (- end start))
-                      void)))
+                      void))
 
 ; one trivial test case:
 ;
diff --git a/collects/drscheme/private/debug.ss b/collects/drscheme/private/debug.ss
index 34275a5204..f6676ff770 100644
--- a/collects/drscheme/private/debug.ss
+++ b/collects/drscheme/private/debug.ss
@@ -1,3 +1,5 @@
+#lang scheme/base
+
 #|
 
 profile todo:
@@ -6,8 +8,6 @@ profile todo:
 
 |#
 
-#lang scheme/base
-
 (require scheme/unit
          errortrace/stacktrace
          scheme/class
diff --git a/collects/drscheme/private/drscheme-normal.ss b/collects/drscheme/private/drscheme-normal.ss
index 9ed389a095..842549dea4 100644
--- a/collects/drscheme/private/drscheme-normal.ss
+++ b/collects/drscheme/private/drscheme-normal.ss
@@ -1,5 +1,5 @@
+#lang mzscheme
 
-(module drscheme-normal mzscheme
   (require mred
            mzlib/class
            mzlib/cmdline
@@ -271,4 +271,4 @@
                        (parent f))])
           (send f show #t)))))
 
-  (dynamic-require 'drscheme/tool-lib #f))
+  (dynamic-require 'drscheme/tool-lib #f)
diff --git a/collects/drscheme/private/drsig.ss b/collects/drscheme/private/drsig.ss
index b4288d9d15..c34f5ad605 100644
--- a/collects/drscheme/private/drsig.ss
+++ b/collects/drscheme/private/drsig.ss
@@ -1,5 +1,4 @@
-
-(module drsig scheme/base
+#lang scheme/base
   (require scheme/unit)
   
   (provide drscheme:eval^
@@ -313,5 +312,4 @@
      (open (prefix drscheme:language: drscheme:language^))
      (open (prefix drscheme:help-desk: drscheme:help-desk^))
      (open (prefix drscheme:eval: drscheme:eval^))
-     (open (prefix drscheme:modes: drscheme:modes^)))))
-  
+     (open (prefix drscheme:modes: drscheme:modes^))))
diff --git a/collects/drscheme/private/eval.ss b/collects/drscheme/private/eval.ss
index d4bc45a968..af2546f8c2 100644
--- a/collects/drscheme/private/eval.ss
+++ b/collects/drscheme/private/eval.ss
@@ -1,5 +1,5 @@
+#lang mzscheme
 
-(module eval mzscheme
   (require mred
            mzlib/unit
            mzlib/port
@@ -218,4 +218,4 @@
           [else
            (let ([port (open-input-file filename)])
              (port-count-lines! port)
-             (values port filename))])))))
+             (values port filename))]))))
diff --git a/collects/drscheme/private/first-line-text.ss b/collects/drscheme/private/first-line-text.ss
index 06726d9d7c..613ee5f173 100644
--- a/collects/drscheme/private/first-line-text.ss
+++ b/collects/drscheme/private/first-line-text.ss
@@ -1,29 +1,104 @@
 #lang scheme/base
+
 (require scheme/gui/base
-         scheme/class)
+         scheme/class
+         framework)
 
-(provide first-line-text-mixin)
+(provide first-line-text-mixin
+         first-line-text-mixin<%>)
 
-(define (first-line-text-mixin text%)
-  (class text%
-    (inherit get-text paragraph-end-position get-admin invalidate-bitmap-cache position-location)
+(define first-line-text-mixin<%>
+  (interface ()
+    highlight-first-line))
+
+(define dark-color (make-object color% 50 0 50))
+(define dark-wob-color (make-object color% 220 150 220))
+
+(define first-line-text-mixin
+  (mixin ((class->interface text%)) (first-line-text-mixin<%>)
+    (inherit get-text paragraph-end-position get-admin invalidate-bitmap-cache position-location
+             scroll-to local-to-global get-dc)
     (define bx (box 0))
     (define by (box 0))
     (define bw (box 0))
-    (define fancy-first-line? #t)
     
-    (define/override (scroll-to snip localx localy width height refresh? [bias 'none])
-      (printf "~s\n" (list 'scroll-to snip localx localy width height refresh? bias))
-      (super scroll-to snip localx localy width height refresh? bias))
+    (define fancy-first-line? #f)
+    
+    (define first-line "")
+    (define end-of-first-line 0)
+    (define first-line-is-lang? #f)
+    
+    (define/private (show-first-line?)
+      (and fancy-first-line? first-line-is-lang?))
+    
+    (define/private (update-first-line)
+      (set! end-of-first-line (paragraph-end-position 0))
+      (set! first-line (get-text 0 end-of-first-line))
+      (set! first-line-is-lang? (is-lang-line? first-line)))
+    
+    (define/augment (after-insert start len)
+      (when (<= start end-of-first-line)
+        (update-first-line))
+      (inner (void) after-insert start len))
+    (define/augment (after-delete start len)
+      (when (<= start end-of-first-line)
+        (update-first-line))
+      (inner (void) after-delete start len))
+    
+    (define/private (fetch-first-line-height)
+      (let-values ([(_1 h _2 _3) (send (get-dc) get-text-extent first-line (get-font))])
+        h))
+    
+    (define/override (scroll-editor-to localx localy width height refresh? bias)
+      (let ([admin (get-admin)])
+        (cond
+          [(not admin)
+           #f]
+          [(show-first-line?)
+           (let ([h (fetch-first-line-height)])
+             (set-box! by localy)
+             (local-to-global #f by)
+             (cond
+               [(<= (unbox by) h)
+                ;; the max is relevant when we're already scrolled to the top.
+                (send admin scroll-to localx (max 0 (- localy h)) width height refresh? bias)]
+               [else
+                (send admin scroll-to localx localy width height refresh? bias)]))]
+          [else
+           (send admin scroll-to localx localy width height refresh? bias)])))
     
     (define/public (highlight-first-line on?)
-      (set! fancy-first-line? on?)
-      (invalidate-bitmap-cache)
-      (send (send this get-canvas) refresh))
+      (unless (equal? fancy-first-line? on?)
+        (set! fancy-first-line? on?)
+        (invalidate-bitmap-cache)
+        (let ([canvas (send this get-canvas)])
+          (when canvas
+            (send canvas refresh)))))
+    
+    (define/override (on-event event)
+      (cond
+        [(or (send event moving?)
+             (send event leaving?)
+             (send event entering?))
+         (super on-event event)]
+        [else
+         (let ([y (send event get-y)]
+               [h (fetch-first-line-height)]
+               [admin (get-admin)])
+           (unless admin (send admin get-view #f by #f #f #f))
+           (cond
+             [(and admin
+                   (< y h)
+                   (not (= (unbox by) 0)))
+              (send admin scroll-to (send event get-x) 0 0 0 #t)
+              (super on-event event)]
+             [else         
+              (super on-event event)]))]))
+    
     
     (define/override (on-paint before? dc left top right bottom dx dy draw-caret)
       (unless before?
-        (when fancy-first-line? 
+        (when (show-first-line?) 
           (let ([admin (get-admin)])
             (when admin
               (send admin get-view bx by bw #f #f)
@@ -33,7 +108,8 @@
                       [old-brush (send dc get-brush)]
                       [old-smoothing (send dc get-smoothing)]
                       [old-α (send dc get-alpha)]
-                      [old-font (send dc get-font)])
+                      [old-font (send dc get-font)]
+                      [old-text-foreground (send dc get-text-foreground)])
                   (send dc set-font (get-font))
                   (send dc set-smoothing 'aligned)
                   (let-values ([(tw th _1 _2) (send dc get-text-extent first-line)])
@@ -41,32 +117,49 @@
                           [line-left (+ (unbox bx) dx)]
                           [line-right (+ (unbox bx) dx (unbox bw))])
                       
-                      (send dc set-pen "black" 1 'solid)
+                      (if (preferences:get 'framework:white-on-black?)
+                          (send dc set-pen "white" 1 'solid)
+                          (send dc set-pen "black" 1 'solid))
                       (send dc draw-line line-left line-height line-right line-height)
                       
                       (when (eq? (send dc get-smoothing) 'aligned)
-                        (send dc set-pen "black" 1 'solid)
-                        (let loop ([i 10])
+                        (let ([start 3/10]
+                              [end 0]
+                              [steps 10])
+                        (send dc set-pen
+                              (if (preferences:get 'framework:white-on-black?)
+                                  dark-wob-color
+                                  dark-color) 
+                              1
+                              'solid)
+                        (let loop ([i steps])
                           (unless (zero? i)
-                            (let ([g (+ 200 (* i 5))])
-                              (send dc set-alpha (+ 1/5 (* i -1/50)))
+                            (let ([alpha-value (+ start (* (- end start) (/ i steps)))])
+                              (send dc set-alpha alpha-value)
                               (send dc draw-line 
                                     line-left
                                     (+ line-height i)
                                     line-right
-                                    (+ line-height i)))
-                            (loop (- i 1))))))
+                                    (+ line-height i))
+                              (loop (- i 1))))))))
                     
                     (send dc set-alpha 1)
                     (send dc set-pen "gray" 1 'transparent)
-                    (send dc set-brush "white" 'solid)
+                    (if (preferences:get 'framework:white-on-black?)
+                        (send dc set-brush "black" 'solid)
+                        (send dc set-brush "white" 'solid))
                     (send dc draw-rectangle 
                           (+ (unbox bx) dx)
                           (+ (unbox by) dy)
                           (unbox bw)
                           th)
+                    (send dc set-text-foreground
+                          (if (preferences:get 'framework:white-on-black?)
+                              (send the-color-database find-color "white")
+                              (send the-color-database find-color "black")))
                     (send dc draw-text first-line (+ (unbox bx) dx) (+ (unbox by) dy)))
                   
+                  (send dc set-text-foreground old-text-foreground)
                   (send dc set-font old-font)
                   (send dc set-pen old-pen)
                   (send dc set-brush old-brush)
@@ -83,11 +176,54 @@
     
     (super-new)))
 
+;; is-lang-line? : string -> boolean
+;; given the first line in the editor, this returns #t if it is a #lang line.
+(define (is-lang-line? l)
+  (let ([m (regexp-match #rx"^#(!|(lang ))([-+_/a-zA-Z0-9]+)(.|$)" l)])
+    (and m
+         (let ([lang-name (list-ref m 3)]
+               [last-char (list-ref m 4)])
+           (and (not (char=? #\/ (string-ref lang-name 0)))
+                (not (char=? #\/ (string-ref lang-name (- (string-length lang-name) 1))))
+                (or (string=? "" last-char)
+                    (char-whitespace? (string-ref last-char 0))))))))
+
+;; test cases for is-lang-line?
+#;
+(list (is-lang-line? "#lang x")
+      (is-lang-line? "#lang scheme")
+      (is-lang-line? "#lang scheme ")
+      (not (is-lang-line? "#lang schemeα"))
+      (not (is-lang-line? "#lang scheme/ "))
+      (not (is-lang-line? "#lang /scheme "))
+      (is-lang-line? "#lang sch/eme ")
+      (is-lang-line? "#lang r6rs")
+      (is-lang-line? "#!r6rs")
+      (is-lang-line? "#!r6rs ")
+      (not (is-lang-line? "#!/bin/sh")))
+
+#;
 (begin
   (define f (new frame% [label ""] [width 200] [height 200]))
-  (define t (new (first-line-text-mixin text%)))
+  ;(define t (new (editor:standard-style-list-mixin (first-line-text-mixin text%))))
+  (define t
+    (new
+     (scheme:text-mixin
+      (text:autocomplete-mixin
+       (color:text-mixin
+        (mode:host-text-mixin
+         (values ; text:delegate-mixin
+          (text:foreground-color-mixin
+           (first-line-text-mixin
+            text:info%)))))))))
+  (require scheme/runtime-path)
+  (define-runtime-path here  ".")
+  (send t load-file (build-path (build-path here 'up 'up "framework" "private" "text.ss")))
+  #;
   (send t insert (apply string-append (map (λ (x) (build-string 100 (λ (i) (if (= i 99) #\newline x))))
                                            (string->list "abcdefghijklnopqrstuvwxyz"))))
   (define c (new editor-canvas% [parent f] [editor t]))
-  (define b (new button% [callback (λ (c dc) (send t highlight-first-line #t))] [label "button"] [parent f]))
+  (define b (new button% [callback (λ (c dc) (send t highlight-first-line #t))] [label "on"] [parent f]))
+  (define b2 (new button% [callback (λ (c dc) (send t highlight-first-line #f))] [label "off"] [parent f]))
+  (send c focus)
   (send f show #t))
\ No newline at end of file
diff --git a/collects/drscheme/private/font.ss b/collects/drscheme/private/font.ss
index 6fe8d85e8d..aa2dc23a8d 100644
--- a/collects/drscheme/private/font.ss
+++ b/collects/drscheme/private/font.ss
@@ -1,4 +1,4 @@
-(module font mzscheme
+#lang mzscheme
   (require mzlib/unit
            mzlib/class
            "drsig.ss"
@@ -215,4 +215,4 @@
            (send options-panel stretchable-height #f)
            (send options-panel set-alignment 'center 'top)
            (send text lock #t)
-           main))))))
+           main)))))
diff --git a/collects/drscheme/private/frame.ss b/collects/drscheme/private/frame.ss
index 6ced740583..c1569033b5 100644
--- a/collects/drscheme/private/frame.ss
+++ b/collects/drscheme/private/frame.ss
@@ -1,4 +1,3 @@
-
 #lang scheme/unit
   (require string-constants
            mzlib/match
@@ -376,11 +375,21 @@
     (cond
       [cancel? (void)]
       [(from-web?)
-       (install-plt-from-url (send url-text-field get-value) parent)]
+       (install-plt-from-url (trim-whitespace (send url-text-field get-value)) parent)]
       [else 
        (parameterize ([error-display-handler drscheme:init:original-error-display-handler])
          (run-installer (string->path (send file-text-field get-value))))]))
   
+  ;; trim-whitespace: string -> string
+  ;; Trims the whitespace surrounding a string.
+  (define (trim-whitespace a-str)
+    (cond
+      [(regexp-match #px"^\\s*(.*[^\\s])\\s*$"
+                     a-str)
+       => second]
+      [else
+       a-str]))
+  
   ;; install-plt-from-url : string (union #f dialog%) -> void
   ;; downloads and installs a .plt file from the given url
   (define (install-plt-from-url s-url parent)
diff --git a/collects/drscheme/private/init.ss b/collects/drscheme/private/init.ss
index 8127337e68..ca87fd97c4 100644
--- a/collects/drscheme/private/init.ss
+++ b/collects/drscheme/private/init.ss
@@ -1,4 +1,3 @@
-
 #lang scheme/unit
   (require string-constants
            "drsig.ss"
diff --git a/collects/drscheme/private/key.ss b/collects/drscheme/private/key.ss
index 2aedf9a5c9..ccd52cc2d3 100644
--- a/collects/drscheme/private/key.ss
+++ b/collects/drscheme/private/key.ss
@@ -1,4 +1,4 @@
-(module key mzscheme
+#lang mzscheme
   (provide break-threads)
   (define super-cust (current-custodian))
   (define first-child (make-custodian))
@@ -16,4 +16,4 @@
                          (break-thread man))
                        (when (custodian? man)
                          (loop current-cust man)))
-                     (custodian-managed-list current-cust super-cust))))))))
+                     (custodian-managed-list current-cust super-cust)))))))
diff --git a/collects/drscheme/private/label-frame-mred.ss b/collects/drscheme/private/label-frame-mred.ss
index 1f890364f2..1ca3158cc0 100644
--- a/collects/drscheme/private/label-frame-mred.ss
+++ b/collects/drscheme/private/label-frame-mred.ss
@@ -1,4 +1,4 @@
-(module label-frame-mred mzscheme
+#lang mzscheme
   (require mred
            mzlib/class)
   (provide (all-from-except mred frame%)
@@ -25,4 +25,4 @@
       (super-instantiate ())
       (semaphore-wait label-sema)
       (hash-table-put! label-ht this (get-label))
-      (semaphore-post label-sema))))
+      (semaphore-post label-sema)))
diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss
index 21c1778b4f..21f89bac9e 100644
--- a/collects/drscheme/private/language-configuration.ss
+++ b/collects/drscheme/private/language-configuration.ss
@@ -1,5 +1,4 @@
-
-(module language-configuration mzscheme
+#lang mzscheme
   (require mzlib/unit
            mrlib/hierlist
            mzlib/class
@@ -1786,4 +1785,4 @@
     (define (find-parent-from-snip snip)
       (let* ([admin (send snip get-admin)]
              [ed (send admin get-editor)])
-        (find-parent-from-editor ed)))))
+        (find-parent-from-editor ed))))
diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss
index bd8be4fd07..9e5228a149 100644
--- a/collects/drscheme/private/language.ss
+++ b/collects/drscheme/private/language.ss
@@ -1,9 +1,9 @@
+#lang scheme/unit
 ;; 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)
 
-#lang scheme/unit
 (require "drsig.ss"
            string-constants
            mzlib/pconvert
@@ -42,6 +42,7 @@
       default-settings?
       
       front-end/complete-program
+      front-end/finished-complete-program
       front-end/interaction
       config-panel
       on-execute
@@ -480,6 +481,9 @@
       (inherit get-module get-transformer-module use-namespace-require/copy-from-setting?
                get-init-code use-mred-launcher get-reader)
       
+      (define/public (front-end/finished-complete-program settings) (void))
+      (define/public (module-based-language->language-mixin settings) (void))
+      
       (define/pubment (capability-value s) 
         (inner (get-capability-default s) capability-value s))
       
diff --git a/collects/drscheme/private/link.ss b/collects/drscheme/private/link.ss
index 18c9b2f0c3..cd839dc391 100644
--- a/collects/drscheme/private/link.ss
+++ b/collects/drscheme/private/link.ss
@@ -1,4 +1,4 @@
-(module link mzscheme
+#lang mzscheme
   (require "modes.ss"
            "font.ss"
            "eval.ss"
@@ -51,5 +51,5 @@
       (prefix drscheme:help-desk: drscheme:help-desk^)
       (prefix drscheme:eval: drscheme:eval^)
       (prefix drscheme:modes: drscheme:modes^))
-     drscheme-unit@)))
+     drscheme-unit@))
 
diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss
index a7915014cf..05ca935e4e 100644
--- a/collects/drscheme/private/module-language.ss
+++ b/collects/drscheme/private/module-language.ss
@@ -136,55 +136,27 @@
       (define/public (get-auto-text settings)
         (module-language-settings-auto-text settings))
       
-      ;; utility for the front-end methods: return a function that will return
+      ;; utility for the front-end method: return a function that will return
       ;; each of the given syntax values on each call, executing thunks when
-      ;; included; when done with the list, use the given getter thunk.
-      (define (expr-getter getter . exprs/thunks)
+      ;; included; when done with the list, send eof.
+      (define (expr-getter . exprs/thunks)
         (define (loop)
           (if (null? exprs/thunks)
-            (getter)
+            eof
             (let ([x (car exprs/thunks)])
               (set! exprs/thunks (cdr exprs/thunks))
               (if (procedure? x) (begin (x) (loop)) x))))
         loop)
       
       (inherit get-reader)
-      (define hopeless-repl (make-thread-cell #t))
+      (define repl-init-thunk (make-thread-cell #f))
       
-      (define/override (front-end/interaction port settings)
-        (let ([x (thread-cell-ref hopeless-repl)])
-          (cond
-            [(not x) (super front-end/interaction port settings)]
-            [(not (syntax? x)) (raise-hopeless-syntax-error)]
-            ;; this means that there was a problem getting into the
-            ;; module's namespace, and we have a language to try to require
-            [else
-             (let ([default-handler (uncaught-exception-handler)])
-               (expr-getter (super front-end/interaction port settings)
-                #`(current-module-declare-name #f)
-                (λ ()
-                  (uncaught-exception-handler
-                   (λ (e)
-                     (uncaught-exception-handler default-handler)
-                     (raise-hopeless-syntax-error "invalid language" x))))
-                #`(require #,x)
-                (λ ()
-                  (uncaught-exception-handler default-handler)
-                  (unless (memq '#%top-interaction (namespace-mapped-symbols))
-                    (raise-hopeless-syntax-error
-                     "invalid language (existing module, but no language bindings)"
-                     x)))))])))
-      
-      ;; This is used to setup the user environment.  There's a subtle hack
-      ;; here: instead of doing things like (namespace-require ...), construct
-      ;; and return a #'(require ...) syntax: this way when we're not going to
-      ;; run the code (eg, when it's used by the syntax checker or the macro
-      ;; debugger), it won't run.
       (define/override (front-end/complete-program port settings)
         (define (super-thunk) ((get-reader) (object-name port) port))
-        (define path (cond [(get-filename port)
-                            => (compose simplify-path cleanse-path)]
-                           [else #f]))
+        (define path
+          (cond [(get-filename port) => (compose simplify-path cleanse-path)]
+                [else #f]))
+        (define resolved-modpath (and path (make-resolved-module-path path)))
         (define-values (name lang module-expr)
           (let ([expr
                  ;; just reading the definitions might be a syntax error,
@@ -199,31 +171,50 @@
                  "there can only be one expression in the definitions window"
                  more)))
             (transform-module path expr)))
-        (define require-spec
-          (or path
-              ;; "clearing out" the module-name via datum->syntax ensures that
-              ;; check syntax doesn't think the original module name is being
-              ;; used in this require (so it doesn't get turned red)
-              (quasisyntax ''#,(datum->syntax #'here (syntax-e name)))))
-        ;; we have a language, so put it here, so front-end/interaction can
-        ;; require the language if we fail to go into the module -- most
-        ;; commonly due to a syntax error, in attempt to still provide a
-        ;; working repl
-        (thread-cell-set! hopeless-repl lang)
-        (expr-getter (λ () eof)
-         #`(current-module-declare-name
-            (and #,path (make-resolved-module-path '#,path)))
-         module-expr
-         #`(current-module-declare-name #f)
-         (if path
-           #`(#%app (#%app current-module-name-resolver)
-                    (#%app make-resolved-module-path #,path))
-           void)
-         ;; the prompt makes it continue after an error
-         #`(#%app call-with-continuation-prompt
-                  (λ () (#%app dynamic-require #,require-spec #f)))
-         #`(#%app current-namespace (#%app module->namespace #,require-spec))
-         (λ () (thread-cell-set! hopeless-repl #f))))
+        (define modspec (or path `',(syntax-e name)))
+        (define (check-interactive-language)
+          (unless (memq '#%top-interaction (namespace-mapped-symbols))
+            (raise-hopeless-exception
+             #f #f ; no error message, just a suffix
+             (format "~s does not support a REPL (no #%top-interaction)"
+                     (syntax->datum lang)))))
+        ;; We're about to send the module expression to drscheme now, the rest
+        ;; of the setup is done in `front-end/finished-complete-program' below,
+        ;; so use `repl-init-thunk' to store an appropriate continuation for
+        ;; this setup.  Once we send the expression, we'll be called again only
+        ;; if it was evaluated (or expanded) with no errors, so begin with a
+        ;; continuation that deals with an error, and if we're called again,
+        ;; change it to a continuation that initializes the repl for the
+        ;; module.  So the code is split among several thunks that follow.
+        (define (*pre)
+          (thread-cell-set! repl-init-thunk *error)
+          (current-module-declare-name resolved-modpath))
+        (define (*post)
+          (current-module-declare-name #f)
+          (when path ((current-module-name-resolver) resolved-modpath))
+          (thread-cell-set! repl-init-thunk *init))
+        (define (*error)
+          (current-module-declare-name #f)
+          ;; syntax error => try to require the language to get a working repl
+          (with-handlers ([void (λ (e)
+                                  (raise-hopeless-syntax-error
+                                   "invalid language specification"
+                                   lang))])
+            (namespace-require lang))
+          (check-interactive-language))
+        (define (*init)
+          (parameterize ([current-namespace (current-namespace)])
+            ;; the prompt makes it continue after an error
+            (call-with-continuation-prompt
+             (λ () (dynamic-require modspec #f))))
+          (current-namespace (module->namespace modspec))
+          (check-interactive-language))
+        ;; here's where they're all combined with the module expression
+        (expr-getter *pre module-expr *post))
+      
+      (define/override (front-end/finished-complete-program settings)
+        (cond [(thread-cell-ref repl-init-thunk)
+               => (λ (t) (thread-cell-set! repl-init-thunk #f) (t))]))
       
       ;; printer settings are just ignored here.
       (define/override (create-executable setting parent program-filename)
@@ -272,23 +263,31 @@
        [language-position (list "Module")]
        [language-numbers (list -32768)])))
   
-  (define (raise-hopeless-exception exn [prefix #f])
+  ;; can be called with #f to just kill the repl (in case we want to kill it
+  ;; but keep the highlighting of a previous error)
+  (define (raise-hopeless-exception exn [prefix #f] [suffix #f])
     (define rep (drscheme:rep:current-rep))
-    ;; if we don't have the drscheme rep, then we just raise the exception as
-    ;; normal.  (It can happen in some rare cases like having a single empty
-    ;; scheme box in the definitions.)
-    (unless rep (raise exn))
+    ;; Throw an error as usual if we don't have the drscheme rep, then we just
+    ;; raise the exception as normal.  (It can happen in some rare cases like
+    ;; having a single empty scheme box in the definitions.)
+    (unless rep (if exn (raise exn) (error "\nInteractions disabled")))
     (when prefix (fprintf (current-error-port) "Module Language: ~a\n" prefix))
-    ((error-display-handler) (exn-message exn) exn)
+    (when exn ((error-display-handler) (exn-message exn) exn))
+    ;; these are needed, otherwise the warning can appear before the output
+    (flush-output (current-output-port))
+    (flush-output (current-error-port))
     ;; do the rep-related work carefully -- using drscheme's eventspace, and
     ;; wait for it to finish before we continue.
-    (let ([s (make-semaphore 0)])
+    (let ([s (make-semaphore 0)]
+          [msg (string-append "\nInteractions disabled"
+                              (if suffix (string-append ": " suffix) "."))])
       (parameterize ([current-eventspace drscheme:init:system-eventspace])
         (queue-callback
          (λ ()
-           (send* rep (insert-warning "\nInteractions disabled.")
-                      (set-show-no-user-evaluation-message? #f)
-                      (highlight-errors/exn exn))
+           (send rep call-without-reset-highlighting
+             (λ ()
+               (send* rep (insert-warning msg)
+                          (set-show-no-user-evaluation-message? #f))))
            (semaphore-post s))))
       (semaphore-wait s))
     (custodian-shutdown-all (send rep get-user-custodian)))
@@ -476,7 +475,7 @@
        (update-buttons)]))
   
   ;; transform-module : (union #f path) syntax
-  ;;   -> (values syntax[name-of-module] syntax[module])
+  ;;   -> (values syntax[name-of-module] syntax[lang-of-module] syntax[module])
   ;; = User =
   (define (transform-module filename stx)
     (define-values (mod name lang body)
@@ -567,7 +566,7 @@
                            [filename-end (skip-to-whitespace filename-start)])
                       (and (not (= filename-start end-module))
                            (string-append (get-text filename-start filename-end)
-                                          ".scm")))))))
+                                          ".ss")))))))
       
       
       (define/private (matches start string)
diff --git a/collects/drscheme/private/multi-file-search.ss b/collects/drscheme/private/multi-file-search.ss
index cf40667d8f..f185e45972 100644
--- a/collects/drscheme/private/multi-file-search.ss
+++ b/collects/drscheme/private/multi-file-search.ss
@@ -1,4 +1,3 @@
-
 #lang scheme/unit
   (require framework
            mzlib/class
diff --git a/collects/drscheme/private/number-snip.ss b/collects/drscheme/private/number-snip.ss
index 0cb5347273..5426620d15 100644
--- a/collects/drscheme/private/number-snip.ss
+++ b/collects/drscheme/private/number-snip.ss
@@ -1,4 +1,4 @@
-(module number-snip mzscheme
+#lang mzscheme
   (require mred
            mzlib/class
            framework)
@@ -6,4 +6,4 @@
   (provide snip-class)
   (define snip-class (make-object number-snip:snip-class%))
   (send snip-class set-classname (format "~s" `(lib "number-snip.ss" "drscheme" "private")))
-  (send (get-the-snip-class-list) add snip-class))
+  (send (get-the-snip-class-list) add snip-class)
diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss
index b396636ed0..1b7dcf850e 100644
--- a/collects/drscheme/private/rep.ss
+++ b/collects/drscheme/private/rep.ss
@@ -665,7 +665,7 @@ TODO
                                                    (srcloc-position srcloc)
                                                    (srcloc-span srcloc))]
                                      [(port-name-matches? (srcloc-source srcloc))
-                                      (hash-set! ht (srcloc-source srcloc) definitions-text)
+                                      (hash-set! ht (srcloc-source srcloc) this)
                                       (make-srcloc this
                                                    (srcloc-line srcloc)
                                                    (srcloc-column srcloc)
@@ -733,8 +733,12 @@ TODO
             (when first-loc
               (send first-file set-caret-owner (get-focus-snip) 'global)))))
       
+      (define highlights-can-be-reset (make-parameter #t))
       (define/public (reset-highlighting)
-        (reset-error-ranges))
+        (when (highlights-can-be-reset) (reset-error-ranges)))
+      (define/public (call-without-reset-highlighting thunk)
+        (parameterize ([highlights-can-be-reset #f])
+          (thunk)))
       
       ;; remove-duplicate-error-arrows : (listof X) -> (listof X)
       ;; duplicate arrows point from and to the same place -- only
@@ -1099,6 +1103,16 @@ TODO
               (default-continuation-prompt-tag)
               (λ args (void)))
              
+             (when complete-program?
+               (call-with-continuation-prompt
+                (λ ()
+                  (call-with-break-parameterization
+                   user-break-parameterization
+                   (λ ()
+                     (send lang front-end/finished-complete-program settings))))
+                (default-continuation-prompt-tag)
+                (λ args (void))))
+             
              (set! in-evaluation? #f)
              (update-running #f)
              (cleanup)
diff --git a/collects/drscheme/private/stick-figures.ss b/collects/drscheme/private/stick-figures.ss
index 380e18e15a..49a404ed67 100644
--- a/collects/drscheme/private/stick-figures.ss
+++ b/collects/drscheme/private/stick-figures.ss
@@ -1,4 +1,4 @@
-(module stick-figures mzscheme
+#lang mzscheme
   (require mzlib/class
            mzlib/pretty
            mred)
@@ -338,4 +338,4 @@
     (send f show #t))
 
   #;(edit-points waiting-points/2)
-  #;(edit-points running-points))
+  #;(edit-points running-points)
diff --git a/collects/drscheme/private/syncheck-debug.ss b/collects/drscheme/private/syncheck-debug.ss
index 364702e84a..186ac31d36 100644
--- a/collects/drscheme/private/syncheck-debug.ss
+++ b/collects/drscheme/private/syncheck-debug.ss
@@ -1,4 +1,5 @@
-(module syncheck-debug mzscheme
+#lang mzscheme
+
   (require mzlib/pretty
            mzlib/list
            mzlib/class
@@ -161,4 +162,4 @@
                      (send text last-position)
                      (send text last-position))
                (loop))))))
-      out)))
+      out))
diff --git a/collects/drscheme/private/text.ss b/collects/drscheme/private/text.ss
index 196e591614..388f9cd8d4 100644
--- a/collects/drscheme/private/text.ss
+++ b/collects/drscheme/private/text.ss
@@ -1,4 +1,3 @@
-
 #lang scheme/unit
   (require mzlib/class
            "drsig.ss"
diff --git a/collects/drscheme/private/time-keystrokes.ss b/collects/drscheme/private/time-keystrokes.ss
deleted file mode 100644
index a2c0fd9a33..0000000000
--- a/collects/drscheme/private/time-keystrokes.ss
+++ /dev/null
@@ -1,86 +0,0 @@
-(module time-keystrokes mzscheme
-  
-  (require drscheme/tool
-           mzlib/list
-           mzlib/unit
-           mzlib/class
-           mzlib/etc
-           mred
-           framework)
-  
-  (provide tool@)
-  
-  (define short-str "(abc)")
-  (define chars-to-test (build-string
-                         400
-                         (λ (i) (string-ref short-str (modulo i (string-length short-str))))))
-  
-  (define tool@
-    (unit 
-      (import drscheme:tool^)
-      (export drscheme:tool-exports^)
-      
-      (define (phase1) (void))
-      (define (phase2) (void))
-      
-      (define (tool-mixin super%)
-        (class super%
-          (inherit get-button-panel)
-          (super-new)
-          (let ([button (new button%
-                             (label "Time Keystrokes")
-                             (parent (get-button-panel))
-                             (callback
-                              (lambda (button evt) 
-                                (time-keystrokes this))))])
-            (send (get-button-panel) change-children
-                  (lambda (l)
-                    (cons button (remq button l)))))))
-      
-      (define (time-keystrokes frame)
-        (let loop ([n 10])
-          (when (zero? n)
-            (error 'time-keystrokes "could not find drscheme frame"))
-          (let ([front-frame (get-top-level-focus-window)])
-            (unless (eq? front-frame frame)
-              (sleep 1/10)
-              (loop (- n 1)))))
-        (let ([win (send frame get-definitions-canvas)])
-          (send win focus)
-          (time (send-key-events win chars-to-test))))
-      
-      (define (send-key-events window chars)
-        (for-each (λ (char)
-                    (send-key-event window (new key-event% (key-code char))))
-                  (string->list chars)))
-      
-      
-      ;; copied from framework/test.ss
-      (define (send-key-event window event)
-        (let loop ([l (ancestor-list window #t)])
-          (cond [(null? l)
-                 (cond
-                   [(method-in-interface? 'on-char (object-interface window))
-                    (send window on-char event)]
-                   [(is-a? window text-field%)
-                    (send (send window get-editor) on-char event)]
-                   [else 
-                    (error
-                     'send-key-event
-                     "focused window is not a text-field% and does not have on-char: ~s" window)])]
-                [(send (car l) on-subwindow-char window event) #f]
-                [else (loop (cdr l))])))
-      
-      ;; copied from framework/test.ss
-      (define (ancestor-list window stop-at-top-level-window?)
-        (let loop ([w window] [l null])
-          (if (or (not w)
-                  (and stop-at-top-level-window?
-                       (is-a? w top-level-window<%>)))
-              l
-              (loop (send w get-parent) (cons w l)))))
-      
-      (when (getenv "PLTDRKEYS")
-        (printf "PLTDRKEYS: installing unit frame mixin\n")
-        (drscheme:get/extend:extend-unit-frame tool-mixin)))))
-
diff --git a/collects/drscheme/private/tool-contract-language.ss b/collects/drscheme/private/tool-contract-language.ss
index 7c8486c72b..7363d8fdd5 100644
--- a/collects/drscheme/private/tool-contract-language.ss
+++ b/collects/drscheme/private/tool-contract-language.ss
@@ -1,4 +1,5 @@
-(module tool-contract-language mzscheme
+#lang mzscheme
+
   (provide (rename -#%module-begin #%module-begin)
            (all-from-except mzscheme #%module-begin))
   
@@ -132,4 +133,4 @@
           (λ (str)
             (unless (string? (syntax-object->datum str))
               (raise-syntax-error 'tool-contract-language.ss "expected docs string" stx str)))
-          (apply append (map syntax->list (syntax->list (syntax ((strs ...) ...)))))))])))
+          (apply append (map syntax->list (syntax->list (syntax ((strs ...) ...)))))))]))
diff --git a/collects/drscheme/private/tools.ss b/collects/drscheme/private/tools.ss
index 5c02b1dc99..f500d88452 100644
--- a/collects/drscheme/private/tools.ss
+++ b/collects/drscheme/private/tools.ss
@@ -1,4 +1,3 @@
-
 #lang scheme/unit
 
 (require setup/getinfo
diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss
index 120090b690..7faef49b55 100644
--- a/collects/drscheme/private/unit.ss
+++ b/collects/drscheme/private/unit.ss
@@ -1,4 +1,4 @@
-
+#lang scheme/base
 #|
 
 closing:
@@ -11,7 +11,6 @@ module browser threading seems wrong.
 
 |#
 
-(module unit scheme/base
   (require scheme/contract
            scheme/unit
            scheme/class
@@ -27,6 +26,7 @@ module browser threading seems wrong.
            "drsig.ss"
            "auto-language.ss"
            "insert-large-letters.ss"
+           "first-line-text.ss"
            mrlib/switchable-button
            mrlib/cache-image-snip
 
@@ -202,7 +202,7 @@ module browser threading seems wrong.
     (define (find-symbol text pos)
       (send text split-snip pos)
       (send text split-snip (+ pos 1))
-      (let ([snip (send text find-snip pos 'after-or-none)])
+      (let ([snip (send text find-snip pos 'after)])
         (if (is-a? snip string-snip%)
             (let* ([before
                     (let loop ([i (- pos 1)]
@@ -428,18 +428,19 @@ module browser threading seems wrong.
     (define (make-definitions-text%)
       (let ([definitions-super%
               ((get-program-editor-mixin)
-               (drscheme:module-language:module-language-put-file-mixin
-                (scheme:text-mixin
-                 (color:text-mixin
-                  (drscheme:rep:drs-bindings-keymap-mixin
-                   (mode:host-text-mixin
-                    (text:delegate-mixin
-                     (text:foreground-color-mixin
-                      (drscheme:rep:drs-autocomplete-mixin
-                       (λ (x) x)
-                       text:info%)))))))))])
+               (first-line-text-mixin
+                (drscheme:module-language:module-language-put-file-mixin
+                 (scheme:text-mixin
+                  (color:text-mixin
+                   (drscheme:rep:drs-bindings-keymap-mixin
+                    (mode:host-text-mixin
+                     (text:delegate-mixin
+                      (text:foreground-color-mixin
+                       (drscheme:rep:drs-autocomplete-mixin
+                        (λ (x) x)
+                        text:info%))))))))))])
         (class* definitions-super% (definitions-text<%>)
-          (inherit get-top-level-window is-locked? lock while-unlocked)
+          (inherit get-top-level-window is-locked? lock while-unlocked highlight-first-line)
           
           (define interactions-text #f)
           (define/public (set-interactions-text it)
@@ -588,40 +589,42 @@ module browser threading seems wrong.
           
           
           (define/pubment (get-next-settings) next-settings)
-          (define/pubment set-next-settings
-            (lambda (_next-settings [update-prefs? #t])
-              (when (or (send (drscheme:language-configuration:language-settings-language _next-settings)
-                              get-reader-module)
-                        (send (drscheme:language-configuration:language-settings-language next-settings)
-                              get-reader-module))
-                (set-modified #t))
-              (set! next-settings _next-settings)
-              (change-mode-to-match)
-              
-              (let ([f (get-top-level-window)])
-                (when (and f
-                           (is-a? f -frame<%>))
-                  (send f language-changed)))
-              
-              (let ([lang (drscheme:language-configuration:language-settings-language next-settings)]
-                    [sets (drscheme:language-configuration:language-settings-settings next-settings)])
-                (preferences:set
-                 'drscheme:recent-language-names
-                 (limit-length
-                  (remove-duplicate-languages
-                   (cons (cons (send lang get-language-name)
-                               (send lang marshall-settings sets))
-                         (preferences:get 'drscheme:recent-language-names)))
-                  10)))
-              
-              (when update-prefs?
-                (preferences:set
-                 drscheme:language-configuration:settings-preferences-symbol
-                 next-settings))
-              
-              (remove-auto-text)
-              (insert-auto-text)
-              (after-set-next-settings _next-settings)))
+          (define/pubment (set-next-settings _next-settings [update-prefs? #t])
+            (when (or (send (drscheme:language-configuration:language-settings-language _next-settings)
+                            get-reader-module)
+                      (send (drscheme:language-configuration:language-settings-language next-settings)
+                            get-reader-module))
+              (set-modified #t))
+            (set! next-settings _next-settings)
+            (change-mode-to-match)
+            (let ([f (get-top-level-window)])
+              (when (and f
+                         (is-a? f -frame<%>))
+                (send f language-changed)))
+            
+            (highlight-first-line
+             (is-a? (drscheme:language-configuration:language-settings-language _next-settings)
+                    drscheme:module-language:module-language<%>))
+            
+            (let ([lang (drscheme:language-configuration:language-settings-language next-settings)]
+                  [sets (drscheme:language-configuration:language-settings-settings next-settings)])
+              (preferences:set
+               'drscheme:recent-language-names
+               (limit-length
+                (remove-duplicate-languages
+                 (cons (cons (send lang get-language-name)
+                             (send lang marshall-settings sets))
+                       (preferences:get 'drscheme:recent-language-names)))
+                10)))
+            
+            (when update-prefs?
+              (preferences:set
+               drscheme:language-configuration:settings-preferences-symbol
+               next-settings))
+            
+            (remove-auto-text)
+            (insert-auto-text)
+            (after-set-next-settings _next-settings))
           
           (define/pubment (after-set-next-settings s)
             (inner (void) after-set-next-settings s))
@@ -729,7 +732,7 @@ module browser threading seems wrong.
                         (/ (+ yl yr) 2)))))
 
           (define/public (still-untouched?)
-            (and (= (last-position) 0)
+            (and (or (= (last-position) 0) (not really-modified?))
                  (not (is-modified?))
                  (not (get-filename))))
           ;; inserts the auto-text if any, and executes the text if so
@@ -780,7 +783,9 @@ module browser threading seems wrong.
           
           ;; insert the default-text
           (queue-callback (lambda () (insert-auto-text)))
-          
+          (highlight-first-line
+           (is-a? (drscheme:language-configuration:language-settings-language next-settings)
+                  drscheme:module-language:module-language<%>))
           (inherit set-max-undo-history)
           (set-max-undo-history 'forever))))
     
@@ -3063,15 +3068,7 @@ module browser threading seems wrong.
         (define scheme-menu 'scheme-menu-not-yet-init)
         (define insert-menu 'insert-menu-not-yet-init)
         (define/public (get-insert-menu) insert-menu)
-        (define/public (get-special-menu) 
-          (define context (continuation-mark-set->context (current-continuation-marks)))
-          (fprintf (current-error-port) 
-                   "called get-special-menu: ~a\n"
-                   (if (and (pair? context)
-                            (pair? (cdr context)))
-                       (format "~s ~s" (car (cadr context)) (cdr (cadr context)))
-                       "<<unknown caller>>"))
-          insert-menu)
+        (define/public (get-special-menu) insert-menu)
         
         (define/public (choose-language-callback)
           (let ([new-settings (drscheme:language-configuration:language-dialog
@@ -3959,4 +3956,4 @@ module browser threading seems wrong.
         (send frame update-toolbar-visibility)
         (send frame show #t)
         (set! first-frame? #f)
-        frame))))
+        frame)))
\ No newline at end of file
diff --git a/collects/drscheme/tool-lib.ss b/collects/drscheme/tool-lib.ss
index 6225106e24..6176ef56d7 100644
--- a/collects/drscheme/tool-lib.ss
+++ b/collects/drscheme/tool-lib.ss
@@ -140,8 +140,11 @@ all of the names in the tools library, for use defining keybindings
      @scheme[#t].
      
      This function calls
-     @scheme[drscheme:language:language front-end/complete-program<%>]
-     to expand the program.
+     @method[drscheme:language:language<%> front-end/complete-program]
+     to expand the program. Unlike when the @onscreen{Run} is clicked,
+     however, it does not call 
+     @method[drscheme:language:language<%> front-end/finished-complete-program].
+     
      
      The first argument to @scheme[iter] is the expanded program
      (represented as syntax) or eof.

From 6772f37b6338cdd75a0fae7cb819ff276ce929ba Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 28 Aug 2008 15:42:05 -0400
Subject: [PATCH 3/5] enable typed version

---
 collects/drscheme/private/unit.ss | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss
index 7faef49b55..ca939822eb 100644
--- a/collects/drscheme/private/unit.ss
+++ b/collects/drscheme/private/unit.ss
@@ -25,7 +25,7 @@ module browser threading seems wrong.
            mrlib/include-bitmap
            "drsig.ss"
            "auto-language.ss"
-           "insert-large-letters.ss"
+           "insert-large-letters-typed.ss"
            "first-line-text.ss"
            mrlib/switchable-button
            mrlib/cache-image-snip

From fe7d985ca5cef4a407d1e471d8fca014f0195ef8 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 28 Aug 2008 16:19:40 -0400
Subject: [PATCH 4/5] Fix contract on pref.

Restore correct button order.

Fix typo.
---
 .../private/insert-large-letters-typed.ss     | 98 +++++++++++--------
 collects/drscheme/private/mred-typed.ss       |  2 +-
 2 files changed, 56 insertions(+), 44 deletions(-)

diff --git a/collects/drscheme/private/insert-large-letters-typed.ss b/collects/drscheme/private/insert-large-letters-typed.ss
index f33eca9fac..ace549029d 100644
--- a/collects/drscheme/private/insert-large-letters-typed.ss
+++ b/collects/drscheme/private/insert-large-letters-typed.ss
@@ -18,8 +18,8 @@
                                                              (or (and (pair? x)
                                                                       (string? (car x))
                                                                       (let ([i (cdr x)])
-                                                                        (and (integer? x)
-                                                                             (<= 1 x 255))))
+                                                                        (and (integer? i)
+                                                                             (<= 1 i 255))))
                                                                  (not x))))
 
 (: get-default-font (-> (Instance Font%)))
@@ -50,43 +50,15 @@
                    [parent parent] 
                    [width 700]
                    [label (string-constant large-semicolon-letters)]))  
-  (define info-bar (new horizontal-panel%
-                        [parent dlg]
-                        [stretchable-height #f]))
-  
-  (define count (new message% [label (format columns-string 1000)] [parent info-bar]))
-  (define pane1 (new horizontal-pane% (parent info-bar)))
-  (define dark-msg (new bitmap-message% [parent info-bar]))
-  (define pane2 (new horizontal-pane% (parent info-bar)))
-                                
-                                
-  (define txt (new scheme:text%))
-  (define ec (new editor-canvas% [parent dlg] [editor txt]))
-  (define button-panel (new horizontal-panel%
-                            [parent dlg]
-                            [stretchable-height #f]
-                            [alignment '(right center)]))
-  (define: ok? : Boolean #f)
-  (define-values (ok cancel)
-    (gui-utils:ok/cancel-buttons button-panel
-                                 (λ: ([x : Any] [y : Any]) (set! ok? #t) (send dlg show #f))
-                                 (λ: ([x : Any] [y : Any]) (send dlg show #f))))
-  (define: (update-txt [str : String]) : Any
-    (send txt begin-edit-sequence)
-    (send txt lock #f)
-    (send txt delete 0 (send txt last-position))
-    (let ([bm (render-large-letters comment-prefix comment-character (get-chosen-font) str txt)])
-      (send ec set-line-count (+ 1 (send txt last-paragraph)))
-      (send txt lock #t)
-      (send txt end-edit-sequence)
-      (send count set-label (format columns-string (get-max-line-width txt)))
-      (send dark-msg set-bm bm)))
-  
   (define: text-field : (Instance Text-Field%) 
     (new text-field% 
          [parent dlg] 
          [label (string-constant text-to-insert)]
          [callback (λ: ([x : Any] [y : Any]) (update-txt (send text-field get-value)))]))
+  (: info-bar (Instance Horizontal-Panel%))
+  (define info-bar (new horizontal-panel%
+                        [parent dlg]
+                        [stretchable-height #f]))
   (define: font-choice : (Instance Choice%)
     (new choice%
          [label (string-constant fonts)]
@@ -102,6 +74,46 @@
                                          (send (get-default-font) get-point-size))))
               (update-txt (send text-field get-value))))]))
   
+  (: count (Instance Message%))
+  (define count (new message% [label (format columns-string 1000)] [parent info-bar]))
+  (: pane1 (Instance Horizontal-Pane%))
+  (define pane1 (new horizontal-pane% (parent info-bar)))
+  (: dark-msg (Instance Bitmap-Message%))
+  (define dark-msg (new bitmap-message% [parent info-bar]))
+  (: pane2 (Instance Horizontal-Pane%))
+  (define pane2 (new horizontal-pane% (parent info-bar)))
+                                
+  (: txt (Instance Scheme:Text%))
+  (define txt (new scheme:text%))
+  (: ec (Instance Editor-Canvas%))
+  (define ec (new editor-canvas% [parent dlg] [editor txt]))
+  (: button-panel (Instance Horizontal-Panel%))
+  (define button-panel (new horizontal-panel%
+                            [parent dlg]
+                            [stretchable-height #f]
+                            [alignment '(right center)]))
+  (define: ok? : Boolean #f)
+  (: ok Any)
+  (: cancel Any)
+  (define-values (ok cancel)
+    (gui-utils:ok/cancel-buttons button-panel
+                                 (λ: ([x : Any] [y : Any]) (set! ok? #t) (send dlg show #f))
+                                 (λ: ([x : Any] [y : Any]) (send dlg show #f))))
+  (: update-txt (String -> Any))
+  (define (update-txt str)
+    (send txt begin-edit-sequence)
+    (send txt lock #f)
+    (send txt delete 0 (send txt last-position))
+    (let ([bm (render-large-letters comment-prefix comment-character (get-chosen-font) str txt)])
+      (send ec set-line-count (+ 1 (send txt last-paragraph)))
+      (send txt lock #t)
+      (send txt end-edit-sequence)
+      (send count set-label (format columns-string (get-max-line-width txt)))
+      (send dark-msg set-bm bm)))
+  
+  
+  
+  
   ;; CHANGE - get-face can return #f
   (let ([face (send (get-chosen-font) get-face)])
     (when face
@@ -132,21 +144,21 @@
                (max raw-th h)))
   (define tmp-color (make-object color%))
   
-  
+  (: get-char (Number Number -> Char))
+  (define (get-char x y)
+    (send bdc get-pixel x y tmp-color)
+    (let ([red (send tmp-color red)])
+      (if (= red 0)
+          comment-character
+          #\space)))  
   (define bitmap
     (make-object bitmap% 
       (max 1 (inexact->exact tw))
       (inexact->exact th)
       #t))
   
-  (define: (get-char [x : Number] [y : Number]) : Char
-    (send bdc get-pixel x y tmp-color)
-    (let ([red (send tmp-color red)])
-      (if (= red 0)
-          comment-character
-          #\space)))
-  
-  (define: (fetch-line [y : Number]) : String
+  (: fetch-line (Number -> String))
+  (define (fetch-line y)
     (let: loop : String ([x : Number (send bitmap get-width)]
                          [chars : (Listof Char) null])
       (cond
diff --git a/collects/drscheme/private/mred-typed.ss b/collects/drscheme/private/mred-typed.ss
index 59ad9525ad..5252df47ac 100644
--- a/collects/drscheme/private/mred-typed.ss
+++ b/collects/drscheme/private/mred-typed.ss
@@ -89,7 +89,7 @@
                [gui-utils:ok/cancel-buttons (Any (Any Any -> Any) (Any Any -> Any) -> (values Any Any))])
 
 (require/typed "prefs-contract.ss"
-               [preferences:get-drscheme:large-letters-font (-> (Pair Symbol Number))])
+               [preferences:get-drscheme:large-letters-font (-> (U #f (Pair String Number)))])
 
 (require (only-in "prefs-contract.ss" preferences:get))
 (provide preferences:get preferences:get-drscheme:large-letters-font)

From 7255a22178da42d7bee3bcf974fd03e76cc5812e Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 28 Aug 2008 17:11:40 -0400
Subject: [PATCH 5/5] merge to 11470

---
 collects/drscheme/private/rep.ss | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss
index 1b7dcf850e..cabd4c33a1 100644
--- a/collects/drscheme/private/rep.ss
+++ b/collects/drscheme/private/rep.ss
@@ -929,7 +929,7 @@ TODO
             (set-custodian-limit new-limit)
             (preferences:set 'drscheme:memory-limit new-limit))
           (set-insertion-point (last-position))
-          (insert-warning "\n[Interactions disabled]")))
+          (insert-warning "\nInteractions disabled")))
       
       (define/private (cleanup-interaction) ; =Kernel=, =Handler=
         (set! need-interaction-cleanup? #f)