diff --git a/collects/drscheme/private/auto-language.ss b/collects/drscheme/private/auto-language.ss
index 624a899c62..a79458ea2f 100644
--- a/collects/drscheme/private/auto-language.ss
+++ b/collects/drscheme/private/auto-language.ss
@@ -25,7 +25,12 @@
                      (when (equal? lang-spec spec-in-file)
                        (set! found-language? lang)
                        (set! settings (send lang metadata->settings str))
-                       (send text delete 0 (send text paragraph-start-position lines)))))))))
+                       (let ([locked? (send text is-locked?)])
+                         (when locked? (send text lock #f))
+                         (printf "before ~s\n" (send text get-text 0 (send text last-position)))
+                         (send text delete 0 (send text paragraph-start-position lines))
+                         (printf "after ~s\n" (send text get-text 0 (send text last-position)))
+                         (when locked? (send text lock #t))))))))))
          all-languages)
         
         ;; check to see if it looks like the module language.
diff --git a/collects/drscheme/private/stick-figures.ss b/collects/drscheme/private/stick-figures.ss
index 91d23e94ae..30111b5e44 100644
--- a/collects/drscheme/private/stick-figures.ss
+++ b/collects/drscheme/private/stick-figures.ss
@@ -3,15 +3,48 @@
            (lib "pretty.ss")
            (lib "mred.ss" "mred"))
   
-  (provide running-canvas%
-           get-running-bitmap)
-  
   (define head-size 40)
-  (define running-factor 1/2)
+  (define small-bitmap-factor 1/2)
   (define small-factor 1/5)
   (define line-size 2)
   
   (define waiting-points
+    '((head 47 2)
+      (neck 46 15)
+      (shoulders 38 42)
+      (left-shoulder 18 39)
+      (right-shoulder 65 42)
+      (left-elbow 8 74)
+      (right-elbow 68 76)
+      (left-hand 24 79)
+      (right-hand 56 83)
+      (waist 37 87)
+      (left-knee 23 117)
+      (right-knee 57 117)
+      (left-ankle 21 149)
+      (right-ankle 59 148)
+      (left-toe 3 148)
+      (right-toe 79 145)))
+  
+  (define waiting-points/2
+    '((head 47 2)
+      (neck 46 15)
+      (shoulders 38 42)
+      (left-shoulder 18 39)
+      (right-shoulder 65 42)
+      (left-elbow 8 74)
+      (right-elbow 68 76)
+      (left-hand 24 79)
+      (right-hand 56 83)
+      (waist 37 87)
+      (left-knee 23 117)
+      (right-knee 57 117)
+      (left-ankle 21 149)
+      (right-ankle 59 148)
+      (left-toe 3 148)
+      (right-toe 79 132)))
+  
+  (define waiting-points/old
     '((head 55 0)
       (neck 43 18)
       (shoulders 37 33)
@@ -29,7 +62,7 @@
       (left-toe 0 154)
       (right-toe 83 146)))
   
-  (define waiting-points/2
+  (define waiting-points/2/old
     '((head 55 0)
       (neck 43 18)
       (shoulders 37 33)
@@ -65,58 +98,6 @@
       (left-toe 14 146)
       (right-toe 109 132)))
   
-  (define running-canvas%
-    (class canvas%
-      (inherit get-dc refresh get-client-size)
-      (define/public (set-running r?) 
-        (unless (eq? r? is-running?)
-          (set! is-running? r?)
-          (refresh)))
-      (define is-running? #f)
-      (define toggle? #t)
-      (define timer #f)
-      (define inside? #f)
-      
-      (define/override (on-event evt)
-        (let-values ([(w h) (get-client-size)])
-          (let ([new-inside?
-                 (and (<= 0 (send evt get-x) w)
-                      (<= 0 (send evt get-y) h))]
-                [old-inside? inside?])
-            (set! inside? new-inside?)
-            (cond
-              [(and new-inside? (not old-inside?))
-               (unless is-running?
-                 (set! timer
-                       (new timer%
-                            [notify-callback 
-                             (λ ()
-                               (set! toggle? (not toggle?))
-                               (refresh))]
-                            [interval 200])))]
-              [(and (not new-inside?) old-inside? timer)
-               (send timer stop)
-               (set! timer #f)]))))
-      
-      (define-values (w h running-dx running-dy waiting-dx waiting-dy)
-        (get-size-parameters))
-      
-      (define/override (on-paint) 
-        (if is-running?
-            (draw-callback (get-dc) small-factor #f 
-                           running-points
-                           running-dx running-dy line-size)
-            (draw-callback (get-dc) small-factor #f
-                           (if toggle? waiting-points waiting-points/2)
-                           waiting-dx waiting-dy line-size)))
-      
-      (super-new [stretchable-width #f]
-                 [stretchable-height #f]
-                 [style '(transparent)])
-      (inherit min-width min-height)
-      (min-width w)
-      (min-height h)))
-  
   (define (get-size-parameters)
     (let-values ([(min-rx min-ry) (get-max/min-x/y min running-points)]
                  [(max-rx max-ry) (get-max/min-x/y max running-points)]
@@ -134,59 +115,44 @@
              [waiting-dy (+ 1 (- (/ h 2) (/ waiting-h 2)))])
         (values w h running-dx running-dy waiting-dx waiting-dy))))
   
-  (define running-bitmap #f)
-  (define (get-running-bitmap)
-    (unless running-bitmap
-      (let-values ([(min-rx min-ry) (get-max/min-x/y min running-points)]
-                   [(max-rx max-ry) (get-max/min-x/y max running-points)])
-        (let* ([margin 2]
-               [bw (+ margin margin (ceiling (* small-factor (- max-rx min-rx))))]
-               [bh (+ margin margin (ceiling (* small-factor (- max-ry min-ry))))]
-               [w (ceiling (* bw running-factor))] 
-               [h (ceiling (* bh running-factor))]
-               [bm-big (make-object bitmap% bw bh)]
-               [bm-solid (make-object bitmap% w h)]
-               [bm-small (make-object bitmap% w h)]
-               [bdc-big (make-object bitmap-dc% bm-big)]
-               [bdc-solid (make-object bitmap-dc% bm-solid)]
-               [bdc-small (make-object bitmap-dc% bm-small)]
-               [green (make-object color% 30 100 30)])
-          (send bdc-big clear)
-          (draw-callback bdc-big small-factor #f running-points
-                         (+ margin (- (* small-factor min-rx)))
-                         (+ margin (- (* small-factor min-ry)))
-                         3)
-          
-          (send bdc-small clear)
-          (send bdc-small set-scale running-factor running-factor)
-          (send bdc-small draw-bitmap bm-big 0 0)
-          (send bdc-small set-scale 1 1)
-          
-          (send bdc-solid set-brush green 'solid)
-          (send bdc-solid set-pen green 1 'solid)
-          (send bdc-solid draw-rectangle 0 0 w h)
-          
-          (send bdc-solid set-bitmap #f)
-          (send bdc-small set-bitmap #f)
-          (send bdc-big set-bitmap #f)
-          
-          (send bm-solid set-loaded-mask bm-small)
-          (set! running-bitmap bm-solid))))
-    running-bitmap)
-  
-  (define (test-running-canvas)
-    (let* ([f (new frame% [label ""])]
-           [c (new running-canvas% [parent f])])
-      (new button% [parent f]
-           [label "on"]
-           [callback
-            (λ (x y) (send c set-running #t))])
-      (new button% [parent f]
-           [label "off"]
-           [callback
-            (λ (x y) (send c set-running #f))])
-      (send f show #t)))
+  (define (get-bitmap points green)
+    (let-values ([(min-rx min-ry) (get-max/min-x/y min points)]
+                 [(max-rx max-ry) (get-max/min-x/y max points)])
+      (let* ([margin 2]
+             [bw (+ margin margin (ceiling (* small-factor (- max-rx min-rx))))]
+             [bh (+ margin margin (ceiling (* small-factor (- max-ry min-ry))))]
+             [w (ceiling (* bw small-bitmap-factor))] 
+             [h (ceiling (* bh small-bitmap-factor))]
+             [bm-big (make-object bitmap% bw bh)]
+             [bm-solid (make-object bitmap% w h)]
+             [bm-small (make-object bitmap% w h)]
+             [bdc-big (make-object bitmap-dc% bm-big)]
+             [bdc-solid (make-object bitmap-dc% bm-solid)]
+             [bdc-small (make-object bitmap-dc% bm-small)])
+        (send bdc-big clear)
+        (draw-callback bdc-big small-factor #f points
+                       (+ margin (- (* small-factor min-rx)))
+                       (+ margin #;(- (* small-factor min-ry)))
+                       3)
+        
+        (send bdc-small clear)
+        (send bdc-small set-scale small-bitmap-factor small-bitmap-factor)
+        (send bdc-small draw-bitmap bm-big 0 0)
+        (send bdc-small set-scale 1 1)
+        
+        (send bdc-solid set-brush green 'solid)
+        (send bdc-solid set-pen green 1 'solid)
+        (send bdc-solid draw-rectangle 0 0 w h)
+        
+        (send bdc-solid set-bitmap #f)
+        (send bdc-small set-bitmap #f)
+        (send bdc-big set-bitmap #f)
+        
+        (send bm-solid set-loaded-mask bm-small)
+        bm-solid)))
   
+  (define (get-running-bitmap) (get-bitmap running-points (make-object color% 30 100 30)))
+  (define (get-waiting-bitmap) (get-bitmap waiting-points (make-object color% 30 100 30)))
   
   (define (normalize points)
     (let-values ([(min-x min-y) (get-max/min-x/y min points)])
@@ -258,7 +224,7 @@
               (+ dy (* factor (list-ref to-p 2)))))))
   
   ;; Use this thunk to edit the points.
-  ;; Click the 'show' button to print out the pionts and then
+  ;; Click the 'show' button to print out the points and then
   ;; copy and paste them back into this file.
   (define (edit-points points)
     (define c%
@@ -325,6 +291,7 @@
                              (draw-callback dc small-factor #f waiting-points 30 0 line-size)
                              (draw-callback dc small-factor #f points 30 50 line-size)
                              (draw-callback dc small-factor #f points 0 50 line-size))]))
+    (define cbitmap (new message% [label (get-bitmap points (send the-color-database find-color "black"))] [parent cp]))
     (define bp (new horizontal-panel% [parent f] [stretchable-height #f]))
     (new button%
          [parent bp]
@@ -339,30 +306,36 @@
           (λ (x y)
             (set! show-dots? (not show-dots?))
             (send cbig refresh))])
+    (new button%
+         [parent bp]
+         [label "Bitmap"]
+         [callback
+          (λ (x y)
+            (send cbitmap set-label (get-bitmap points (send the-color-database find-color "black"))))])
     (send f show #t))
   
-  #;
   (let ()
     (define f (new frame% [label ""]))
-    (define m (new message% [label (get-running-bitmap)] [parent f]))
+    (define hp (new horizontal-panel% [parent f]))
+    (define left-column (new vertical-panel% [parent hp]))
+    (define right-column (new vertical-panel% [parent hp]))
+    (define green-rb (get-running-bitmap))
+    (define black (send the-color-database find-color "black"))
+    (define rb (get-bitmap running-points black))
+    (define wb (get-bitmap waiting-points black))
+    (define wb2 (get-bitmap waiting-points/2 black))
+    (define rm (new message% [label rb] [parent left-column]))
+    (define grm (new message% [label green-rb] [parent right-column]))
+    (new message% [label wb] [parent left-column])
+    (new message% [label wb2] [parent left-column])
+    (new message% [label wb2] [parent right-column])
+    (new message% [label wb] [parent right-column])
     (new grow-box-spacer-pane% [parent f])
-    (send (get-running-bitmap) save-file (build-path (collection-path "icons") "run.png") 'png)
+    (send green-rb save-file (build-path (collection-path "icons") "run.png") 'png)
+    (send rb save-file (build-path (collection-path "icons") "b-run.png") 'png)
+    (send wb save-file (build-path (collection-path "icons") "b-wait.png") 'png)
+    (send wb2 save-file (build-path (collection-path "icons") "b-wait2.png") 'png)
     (send f show #t))
-  
-  #;
-  (let ()
-    (define f (new frame% [label ""]))
-    (define c (new running-canvas% [parent f]))
-    (new button%
-         [label "Run"]
-         [parent f]
-         [callback (λ (x y) (send c set-running #t))])
-    (new button%
-         [label "Wait"]
-         [parent f]
-         [callback (λ (x y) (send c set-running #f))])
-    (send c set-running #t)
-    (send f show #t))
-  
-  #;(edit-points waiting-points)
+
+  #;(edit-points waiting-points/2)
   #;(edit-points running-points))
diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss
index 56369419ed..d010a5fe07 100644
--- a/collects/drscheme/private/unit.ss
+++ b/collects/drscheme/private/unit.ss
@@ -23,8 +23,7 @@ module browser threading seems wrong.
            (lib "framework.ss" "framework")
            (lib "name-message.ss" "mrlib")
            (lib "bitmap-label.ss" "mrlib")
-           
-           "stick-figures.ss"
+           (lib "include-bitmap.ss" "mrlib")
            "drsig.ss"
            "auto-language.ss"
            
@@ -395,7 +394,7 @@ module browser threading seems wrong.
                        (λ (x) x)
                        text:info%)))))))))])
         (class* definitions-super% (definitions-text<%>)
-          (inherit get-top-level-window)
+          (inherit get-top-level-window is-locked? lock)
           
           (define interactions-text #f)
           (define/public (set-interactions-text it)
@@ -471,8 +470,11 @@ module browser threading seems wrong.
                 (let ([metadata (send lang get-metadata (filename->modname filename) settings)])
                   (begin-edit-sequence)
                   (begin-metadata-changes)
-                  (set! save-file-metadata metadata)
-                  (insert metadata 0 0)))))
+                  (let ([locked? (is-locked?)])
+                    (when locked? (lock #f))
+                    (set! save-file-metadata metadata)
+                    (insert metadata 0 0)
+                    (when locked? (lock #t)))))))
           (define/private (filename->modname filename)
             (let-values ([(base name dir) (split-path filename)])
               (string->symbol (regexp-replace #rx"\\.[^.]*$"
@@ -489,8 +491,11 @@ module browser threading seems wrong.
                     (let-values ([(creator type) (file-creator-and-type filename)])
                       (file-creator-and-type filename #"DrSc" type))))))
             (when save-file-metadata
-              (let ([modified? (is-modified?)])
+              (let ([modified? (is-modified?)]
+                    [locked? (is-locked?)])
+                (when locked? (lock #f))
                 (delete 0 (string-length save-file-metadata))
+                (when locked? (lock #t))
                 (set! save-file-metadata #f)
                 ;; restore modification status to where it was before the metadata is removed
                 (set-modified modified?)
@@ -3364,17 +3369,15 @@ module browser threading seems wrong.
         
         (define language-message
           (let* ([info-panel (get-info-panel)]
-                 [vp (new vertical-panel% 
-                          [parent info-panel]
-                          [alignment '(left center)]
-                          [stretchable-width #t]
-                          [stretchable-height #f])]
-                 [l-m-label (new language-label-message% [parent vp] [frame this])]
-                 [language-message (new language-message% [parent vp])])
+                 [p (new vertical-panel% 
+                         [parent info-panel]
+                         [alignment '(left center)])]
+                 [language-message (new language-label-message% [parent p] [frame this])])
             (send info-panel change-children 
                   (λ (l)
-                    (list* vp
-                           (remq* (list vp) l))))
+                    (list* p
+                           (remq* (list p)
+                                  l))))
             language-message))
         
         (update-save-message)
@@ -3401,6 +3404,66 @@ module browser threading seems wrong.
         (set! newest-frame this)
         (send definitions-canvas focus)))
     
+    (define running-bitmap (include-bitmap (lib "b-run.png" "icons")))
+    (define waiting-bitmap (include-bitmap (lib "b-wait.png" "icons")))
+    (define waiting2-bitmap (include-bitmap (lib "b-wait2.png" "icons")))
+    (define running/waiting-bitmaps (list running-bitmap waiting-bitmap waiting2-bitmap))
+    (define running-canvas%
+      (class canvas%
+        (inherit get-dc refresh get-client-size)
+        (define/public (set-running r?) 
+          (unless (eq? r? is-running?)
+            (set! is-running? r?)
+            (refresh)))
+        (define is-running? #f)
+        (define toggle? #t)
+        (define timer #f)
+        (define inside? #f)
+        
+        (define/override (on-event evt)
+          (let-values ([(w h) (get-client-size)])
+            (let ([new-inside?
+                   (and (<= 0 (send evt get-x) w)
+                        (<= 0 (send evt get-y) h))]
+                  [old-inside? inside?])
+              (set! inside? new-inside?)
+              (cond
+                [(and new-inside? (not old-inside?))
+                 (unless is-running?
+                   (set! timer
+                         (new timer%
+                              [notify-callback 
+                               (λ ()
+                                 (set! toggle? (not toggle?))
+                                 (refresh))]
+                              [interval 200])))]
+                [(and (not new-inside?) old-inside? timer)
+                 (send timer stop)
+                 (set! timer #f)]))))
+        
+        (define/override (on-paint) 
+          (let ([dc (get-dc)]
+                [bm 
+                 (if is-running?
+                     running-bitmap
+                     (if toggle?
+                         waiting-bitmap
+                         waiting2-bitmap))])
+            (let-values ([(cw ch) (get-client-size)])
+              (send dc draw-bitmap bm 
+                    (- (/ cw 2) (/ (send bm get-width) 2))
+                    (- (/ ch 2) (/ (send bm get-height) 2))
+                    'solid
+                    (send the-color-database find-color "black")
+                    (send bm get-loaded-mask)))))
+        
+        (super-new [stretchable-width #f]
+                   [stretchable-height #f]
+                   [style '(transparent)])
+        (inherit min-width min-height)
+        (min-width (apply max (map (λ (x) (send x get-width)) running/waiting-bitmaps)))
+        (min-height (apply max (map (λ (x) (send x get-height)) running/waiting-bitmaps)))))
+    
     ;; get-mbytes : top-level-window -> (union #f  ;; cancel
     ;;                                         integer[>=100] ;; a limit
     ;;                                         #t) ;; no limit
@@ -3530,86 +3593,21 @@ module browser threading seems wrong.
                 (loop (cdr l))
                 (cons (car l) (loop (cdr l))))]))))
     
-    (define programming-language-label (string-constant programming-language-label))
-    (define second-line-indent 6)
-    (define language-message%
-      (class canvas%
-        (inherit get-dc get-client-size refresh)
-        (define message "")
-        (define to-draw-message #f)
-        (define/public (set-lang l)
-          (unless (equal? l message)
-            (set! message l)
-            (compute-new-string)
-            (refresh)))
-        
-        (define yellow? #f)
-        
-        (define/public (set-yellow/lang y? l)
-          (unless (and (equal? y? yellow?)
-                       (equal? l message))
-            (set! yellow? y?)
-            (set! message l)
-            (compute-new-string)
-            (refresh)))
-        
-        (define/override (on-size w h)
-          (compute-new-string)
-          (refresh))
-        
-        (define/private (compute-new-string)
-          (let-values ([(cw ch) (get-client-size)])
-            (let ([width-to-use (- cw (get-left-side-padding))])
-              (let loop ([c (string-length message)])
-                (cond
-                  [(= c 0) (set! to-draw-message "")]
-                  [else 
-                   (let ([candidate (if (= c (string-length message))
-                                        message
-                                        (string-append (substring message 0 c) "..."))])
-                     (let-values ([(tw th _1 _2) (send (get-dc) get-text-extent candidate small-control-font)])
-                       (cond
-                         [(tw . <= . width-to-use) (set! to-draw-message candidate)]
-                         [else
-                          (loop (- c 1))])))])))))
-        
-        (define/public (set-yellow y?)
-          (unless (equal? y? yellow?)
-            (set! yellow? y?)
-            (refresh)))
-        
-        (define last-time-width 0)
-        (define last-time-string "")
-        
-        (define/override (on-paint)
-          (unless to-draw-message
-            (compute-new-string))
-          (let ([dc (get-dc)])
-            (send dc set-font small-control-font)
-            (let*-values ([(tw th _1 _2) (send dc get-text-extent to-draw-message)]
-                          [(w h) (values (+ tw (get-left-side-padding)) th)])
-              (send dc set-pen (get-panel-background) 1 'transparent)
-              (send dc set-brush (get-panel-background) 'transparent)
-              (send dc draw-rectangle 0 0 w h)
-              (when yellow?
-                (send dc set-pen "black" 1 'transparent)
-                (send dc set-brush "yellow" 'solid)
-                (send dc draw-rectangle (get-left-side-padding) 0 tw th))
-              (send dc draw-text to-draw-message (get-left-side-padding) 0))))
-        
-        (super-new [style '(transparent)])
-        (inherit stretchable-width stretchable-height)
-        (stretchable-width #t)
-        (stretchable-height #f)
-        
-        (inherit min-height)
-        (let ([dc (get-dc)])
-          (let-values ([(w2 h2 _3 _4) (send dc get-text-extent "x" small-control-font)])
-            (min-height (inexact->exact (floor h2)))))))
-    
     (define language-label-message%
       (class name-message%
         (init-field frame)
+        (inherit refresh)
+        
+        (inherit set-message)
+        (define yellow? #f)
+        (define/override (get-background-color) (and yellow? "yellow"))
+        (define/public (set-yellow y?) 
+          (set! yellow? y?)
+          (refresh))
+        (define/public (set-yellow/lang y? lang) 
+          (set-message #f lang)
+          (set-yellow y?))
+        
         (define/override (fill-popup menu reset)
           (let ([added-one? #f])
             (send (new menu-item%
@@ -3658,8 +3656,11 @@ module browser threading seems wrong.
                 (λ (x y)
                   (send frame choose-language-callback))]))
         
-        (super-new [label programming-language-label]
-                   [font tiny-control-font])))
+        (super-new [label ""]
+                   [font small-control-font])
+                
+        (inherit set-allow-shrinking)
+        (set-allow-shrinking 100)))
     
     (define -frame% (frame-mixin super-frame%))
     
diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss
index d19023cf70..3fd0da0548 100644
--- a/collects/framework/private/frame.ss
+++ b/collects/framework/private/frame.ss
@@ -254,10 +254,7 @@
       (super-new)
       (send (group:get-the-frame-group) insert-frame this)))
   
-  (define locked-message-line1 (string-constant read-only-line1))
-  (define locked-message-line2 (string-constant read-only-line2))
-  (define unlocked-message-line1 (string-constant read/write-line1))
-  (define unlocked-message-line2 (string-constant read/write-line2))
+  (define locked-message (string-constant read-only))
   
   (define lock-canvas%
     (class canvas%
@@ -272,38 +269,26 @@
       (define/override (on-paint)
         (let* ([dc (get-dc)]
                [draw
-                (λ (str1 str2 bg-color bg-style line-color line-style)
+                (λ (str bg-color bg-style line-color line-style)
                   (send dc set-font small-control-font)
                   (let-values ([(w h) (get-client-size)]
-                               [(tw1 th1 _1 _2) (send dc get-text-extent str1)]
-                               [(tw2 th2 _3 _4) (send dc get-text-extent str2)])
+                               [(tw th _1 _2) (send dc get-text-extent str)])
                     (send dc set-pen (send the-pen-list find-or-create-pen line-color 1 line-style))
                     (send dc set-brush (send the-brush-list find-or-create-brush bg-color bg-style))
                     (send dc draw-rectangle 0 0 w h)
-                    (cond
-                      [(string=? str2 "")
-                       (send dc draw-text str1
-                             (- (/ w 2) (/ tw1 2))
-                             (- (* h 1/2) (/ th1 2)))]
-                      [else
-                       (send dc draw-text str1
-                             (- (/ w 2) (/ tw1 2))
-                             (- (* h 1/2) th1))
-                       (send dc draw-text str2
-                             (- (/ w 2) (/ tw2 2))
-                             (* h 1/2))])))])
+                    (send dc draw-text str
+                          (- (/ w 2) (/ tw 2))
+                          (- (/ h 2) (/ th 2)))))])
           (when locked?
-            (draw locked-message-line1 locked-message-line2
-                  "yellow" 'solid "black" 'solid))))
+            (draw locked-message "yellow" 'solid "black" 'solid))))
       
       (inherit get-parent min-width min-height stretchable-width stretchable-height)
       (define/private (setup-sizes)
         (let ([dc (get-dc)])
           (if locked?
-              (let-values ([(wl1 hl1 _1 _2) (send dc get-text-extent locked-message-line1)]
-                           [(wl2 hl2 _3 _4) (send dc get-text-extent locked-message-line2)])
-                (min-width (inexact->exact (floor (+ 2 (max (+ wl1 2) (+ wl2 2))))))
-                (min-height (inexact->exact (floor (+ 2 hl1 hl2)))))
+              (let-values ([(w h _1 _2) (send dc get-text-extent locked-message)])
+                (min-width (inexact->exact (floor (+ w 4))))
+                (min-height (inexact->exact (floor (+ h 2)))))
               (begin
                 (min-width 0)
                 (min-height 0)))))
@@ -315,58 +300,6 @@
       (stretchable-width #f)
       (stretchable-height #t)))
   
-  #;
-  (define lock-canvas%
-    (class canvas%
-      (field [locked? #f])
-      (inherit refresh)
-      (define/public (set-locked l)
-        (set! locked? l)
-        (refresh))
-      (inherit get-client-size get-dc)
-      (define/override (on-paint)
-        (let* ([dc (get-dc)]
-               [draw
-                (λ (str1 str2 bg-color bg-style line-color line-style)
-                  (send dc set-font small-control-font)
-                  (let-values ([(w h) (get-client-size)]
-                               [(tw1 th1 _1 _2) (send dc get-text-extent str1)]
-                               [(tw2 th2 _3 _4) (send dc get-text-extent str2)])
-                    (send dc set-pen (send the-pen-list find-or-create-pen line-color 1 line-style))
-                    (send dc set-brush (send the-brush-list find-or-create-brush bg-color bg-style))
-                    (send dc draw-rectangle 0 0 w h)
-                    (cond
-                      [(string=? str2 "")
-                       (send dc draw-text str1
-                             (- (/ w 2) (/ tw1 2))
-                             (- (* h 1/2) (/ th1 2)))]
-                      [else
-                       (send dc draw-text str1
-                             (- (/ w 2) (/ tw1 2))
-                             (- (* h 1/2) th1))
-                       (send dc draw-text str2
-                             (- (/ w 2) (/ tw2 2))
-                             (* h 1/2))])))])
-          (if locked?
-              (draw locked-message-line1 locked-message-line2
-                    "yellow" 'solid "black" 'solid)
-              (draw unlocked-message-line1 unlocked-message-line2
-                    (get-panel-background) 'transparent (get-panel-background) 'transparent))))
-      (inherit get-parent min-width min-height stretchable-width stretchable-height)
-      
-      (super-new [style '(transparent)])
-      
-      (let ([dc (get-dc)])
-        (send dc set-font small-control-font)
-        (let-values ([(wl1 hl1 _1 _2) (send dc get-text-extent locked-message-line1)]
-                     [(wl2 hl2 _3 _4) (send dc get-text-extent locked-message-line2)]
-                     [(wu1 hu1 _5 _6) (send dc get-text-extent unlocked-message-line1)]
-                     [(wu2 hu2 _7 _8) (send dc get-text-extent unlocked-message-line2)])
-          (stretchable-width #f)
-          (stretchable-height #t)
-          (min-width (inexact->exact (floor (+ 2 (max (+ wl1 2) (+ wl2 2) wu1 wu2)))))
-          (min-height (inexact->exact (floor (+ 2 hu1 hu2))))))))
-  
   (define status-line<%>
     (interface (basic<%>)
       open-status-line
@@ -987,34 +920,26 @@
       (define-values (anchor-message
                       overwrite-message 
                       macro-recording-message)
-        (let* ([text-info-messages-parent
-                (new vertical-panel% 
-                     [parent (get-info-panel)]
-                     [stretchable-width #f])]
-               [anchor-message
+        (let* ([anchor-message
                 (new message%
                      [font small-control-font]
                      [label (string-constant auto-extend-selection)]
-                     [parent text-info-messages-parent])]
-               [hp (new horizontal-panel% 
-                        [alignment '(left center)]
-                        [parent text-info-messages-parent]
-                        [stretchable-height #f])]
+                     [parent (get-info-panel)])]
                [overwrite-message 
                 (new message%
                      [font small-control-font]
                      [label (string-constant overwrite)]
-                     [parent hp])]
+                     [parent (get-info-panel)])]
                [macro-recording-message
                 (new message%
                      [label "c-x;("]
                      [font small-control-font]
-                     [parent hp])])
+                     [parent (get-info-panel)])]
+               [msgs (list anchor-message
+                           overwrite-message
+                           macro-recording-message)])
           (send (get-info-panel) change-children
-                (λ (l)
-                  (cons
-                   text-info-messages-parent
-                   (remq text-info-messages-parent l))))
+                (λ (l) (append msgs (remq* msgs l))))
           (values anchor-message
                   overwrite-message 
                   macro-recording-message)))
diff --git a/collects/framework/private/icon.ss b/collects/framework/private/icon.ss
index e9fb159dfb..718f8e5fce 100644
--- a/collects/framework/private/icon.ss
+++ b/collects/framework/private/icon.ss
@@ -44,8 +44,8 @@
   (define get-up/down-cursor (make-get-cursor "up-down-cursor.xbm" "up-down-mask.xbm" 'size-n/s))
   (define get-left/right-cursor (make-get-cursor "left-right-cursor.xbm" "left-right-mask.xbm" 'size-e/w))
   
-  (define mrf-on-bitmap (delay (include-bitmap (lib "mrf.jpg" "icons"))))
-  (define gc-on-bitmap (delay (include-bitmap (lib "recycle.gif" "icons"))))
+  (define mrf-on-bitmap (delay (include-bitmap (lib "mrf.png" "icons"))))
+  (define gc-on-bitmap (delay (include-bitmap (lib "recycle.png" "icons"))))
   
   (define (make-off-bitmap onb)
     (let* ([bitmap (make-object bitmap%
diff --git a/collects/icons/b-run.png b/collects/icons/b-run.png
new file mode 100644
index 0000000000..7d2f35aea9
Binary files /dev/null and b/collects/icons/b-run.png differ
diff --git a/collects/icons/b-wait.png b/collects/icons/b-wait.png
new file mode 100644
index 0000000000..54018fa117
Binary files /dev/null and b/collects/icons/b-wait.png differ
diff --git a/collects/icons/b-wait2.png b/collects/icons/b-wait2.png
new file mode 100644
index 0000000000..e65f72a00c
Binary files /dev/null and b/collects/icons/b-wait2.png differ
diff --git a/collects/icons/mrf.jpg b/collects/icons/mrf.jpg
deleted file mode 100644
index 460e305556..0000000000
Binary files a/collects/icons/mrf.jpg and /dev/null differ
diff --git a/collects/icons/mrf.png b/collects/icons/mrf.png
new file mode 100644
index 0000000000..58d03af45e
Binary files /dev/null and b/collects/icons/mrf.png differ
diff --git a/collects/icons/recycle.gif b/collects/icons/recycle.gif
deleted file mode 100644
index 403673fd7a..0000000000
Binary files a/collects/icons/recycle.gif and /dev/null differ
diff --git a/collects/icons/recycle.png b/collects/icons/recycle.png
new file mode 100644
index 0000000000..04842731ba
Binary files /dev/null and b/collects/icons/recycle.png differ
diff --git a/collects/icons/run.png b/collects/icons/run.png
index 841f1ba542..875a07872c 100644
Binary files a/collects/icons/run.png and b/collects/icons/run.png differ
diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss
index b8eaa9ecc6..3ab8d0fec8 100644
--- a/collects/lang/htdp-langs.ss
+++ b/collects/lang/htdp-langs.ss
@@ -524,8 +524,7 @@
                                           `(,#'module #%htdp ,language-module 
                                                       ,@(map (λ (x) 
                                                                `(require ,x))
-                                                             (htdp-lang-settings-teachpacks settings))
-                                                      1))))])
+                                                             (htdp-lang-settings-teachpacks settings))))))])
                        (let ([body-exps 
                               (let loop ()
                                 (let ([result (reader (object-name port) port)])
@@ -555,8 +554,7 @@
                       (dynamic-wind
                        void
                        (lambda () 
-                         (dynamic-require ''#%htdp #f)
-                         #;(eval #'(dynamic-require '#%htdp)))  ;; work around a bug in dynamic-require
+                         (dynamic-require ''#%htdp #f))  ;; work around a bug in dynamic-require
                        (lambda () 
                          (unless done-already?
                            (set! done-already? #t)
diff --git a/collects/mrlib/name-message.ss b/collects/mrlib/name-message.ss
index 2752a2e4a0..36e02b0d40 100644
--- a/collects/mrlib/name-message.ss
+++ b/collects/mrlib/name-message.ss
@@ -24,7 +24,8 @@
           [h (and/c number? (min-h w))]
           [mouse-over? boolean?]
           [grabbed? boolean?]
-          [button-label-font (is-a?/c font%)])
+          [button-label-font (is-a?/c font%)]
+          [bkg-color (or/c false/c (is-a?/c color%) string?)])
          void?))
 
    (calc-button-min-sizes
@@ -44,6 +45,13 @@
         (unless (eq? hidden? d?)
           (set! hidden? d?)
           (refresh)))
+    
+      (define allow-to-shrink #f)
+      (define/public (set-allow-shrinking w) 
+        (unless (eq? w allow-to-shrink)
+          (set! allow-to-shrink w)
+          (set! to-draw-message #f)
+          (update-min-sizes)))
       
       (define paths #f)
       
@@ -75,6 +83,7 @@
                            [else (string-constant untitled)])])
           (unless (equal? label new-label)
             (set! label new-label)
+            (set! to-draw-message #f)
             (update-min-sizes)
             (refresh))))
 
@@ -134,13 +143,25 @@
       (inherit get-parent)
       (define/private (update-min-sizes)
         (let-values ([(w h) (calc-button-min-sizes (get-dc) label font)])
-          (min-width w)
+          (cond
+            [allow-to-shrink
+             (cond
+               [(< w allow-to-shrink)
+                (stretchable-width #f)
+                (min-width w)]
+               [else
+                (stretchable-width #t)
+                (min-width allow-to-shrink)])]
+            [else
+             (min-width w)])
           (min-height h)
           (send (get-parent) reflow-container)))
       
       (define/override (on-paint)
 	(when paint-sema
-	  (semaphore-post paint-sema))
+          (semaphore-post paint-sema))
+        (unless to-draw-message
+          (compute-new-string))
         (let ([dc (get-dc)])
           (let-values ([(w h) (get-client-size)])
             (cond
@@ -154,7 +175,30 @@
                  (send dc set-brush brush))]
               [else
                (when (and (> w 5) (> h 5))
-                 (draw-button-label dc label 0 0 w h mouse-over? mouse-grabbed? font))]))))
+                 (draw-button-label dc to-draw-message 0 0 w h mouse-over? mouse-grabbed? font (get-background-color)))]))))
+      
+      (define/public (get-background-color) #f)
+      
+      (define to-draw-message #f)
+      (define/private (compute-new-string)
+        (let-values ([(cw ch) (get-client-size)])
+          (let ([width-to-use (- cw (get-left-side-padding) triangle-width circle-spacer)])
+            (let loop ([c (string-length label)])
+              (cond
+                [(= c 0) (set! to-draw-message "")]
+                [else 
+                 (let ([candidate (if (= c (string-length label))
+                                      label
+                                      (string-append (substring label 0 c) "..."))])
+                   (let-values ([(tw th _1 _2) (send (get-dc) get-text-extent candidate small-control-font)])
+                     (cond
+                       [(tw . <= . width-to-use) (set! to-draw-message candidate)]
+                       [else
+                        (loop (- c 1))])))])))))
+      
+      (define/override (on-size w h)
+        (compute-new-string)
+        (refresh))
       
       (super-new [style '(transparent no-focus)])
       (update-min-sizes)
@@ -215,7 +259,13 @@
        ans-w
        ans-h)))
   
-  (define (draw-button-label dc label dx dy w h mouse-over? grabbed? button-label-font)
+  (define (draw-button-label dc label dx dy w h mouse-over? grabbed? button-label-font bkg-color)
+    
+    (when bkg-color
+      (send dc set-pen bkg-color 1 'solid)
+      (send dc set-brush bkg-color 'solid)
+      (send dc draw-rectangle dx dy w h))
+    
     (when (or mouse-over? grabbed?)
       (let ([color (if grabbed?
 		       mouse-grabbed-color
diff --git a/collects/string-constants/danish-string-constants.ss b/collects/string-constants/danish-string-constants.ss
index 264ea4fd3d..34c8484534 100644
--- a/collects/string-constants/danish-string-constants.ss
+++ b/collects/string-constants/danish-string-constants.ss
@@ -196,10 +196,7 @@ please adhere to these guidelines:
   
   ;;; info bar at botttom of drscheme frame
   (collect-button-label "GC")
-  (read-only-line1 "Skrivebeskyttet")
-  (read-only-line2 "")
-  (read/write-line1 "Læs/")
-  (read/write-line2 "Skriv")
+  (read-only "Skrivebeskyttet")
   (auto-extend-selection "Auto-udvid")
   (overwrite "Overskriv")
   (running "kører")
diff --git a/collects/string-constants/dutch-string-constants.ss b/collects/string-constants/dutch-string-constants.ss
index 4c489f3482..cc83ba061a 100644
--- a/collects/string-constants/dutch-string-constants.ss
+++ b/collects/string-constants/dutch-string-constants.ss
@@ -81,10 +81,7 @@
  
  ;;; info bar at botttom of drscheme frame
  (collect-button-label "GC")
- (read-only-line1 "Alleen")
-  (read-only-line2 "lezen")
- (read/write-line1 "Lezen/")
-  (read/write-line2 "Schrijven")
+ (read-only "Alleen lezen")
  (auto-extend-selection "Auto-extend") ; <**> -- when does this appear?
  (overwrite "Vervang")
  (running "Bezig")
diff --git a/collects/string-constants/english-string-constants.ss b/collects/string-constants/english-string-constants.ss
index 780f987254..c50106b916 100644
--- a/collects/string-constants/english-string-constants.ss
+++ b/collects/string-constants/english-string-constants.ss
@@ -196,10 +196,7 @@ please adhere to these guidelines:
 
  ;;; info bar at botttom of drscheme frame
  (collect-button-label "GC")
-  (read-only-line1 "Read")
-  (read-only-line2 "only")
-  (read/write-line1 "Read/")
-  (read/write-line2 "Write")
+  (read-only "Read only")
  (auto-extend-selection "Auto-extend")
  (overwrite "Overwrite")
  (running "running")
@@ -958,9 +955,7 @@ please adhere to these guidelines:
  (use-repeating-decimals "Repeating decimals")
  (decimal-notation-for-rationals "Use decimal notation for rationals")
 
-  ; used in the bottom left of the drscheme frame as the label
-  ; above the programming language's name
-  (programming-language-label "Programming language:")
+  ; used in the bottom left of the drscheme frame 
   ; used the popup menu from the just above; greyed out and only
   ; visible when some languages are in the history
   (recent-languages "Recent languages:")
diff --git a/collects/string-constants/french-string-constants.ss b/collects/string-constants/french-string-constants.ss
index c89d9e0ee1..811ce355d5 100644
--- a/collects/string-constants/french-string-constants.ss
+++ b/collects/string-constants/french-string-constants.ss
@@ -196,10 +196,7 @@
 
   ;;; info bar at botttom of drscheme frame
   (collect-button-label "Ramassage") ; de miettes
-  (read-only-line1 "Lecture")
-  (read-only-line2 "seulement")
-  (read/write-line1 "Lecture/")
-  (read/write-line2 "écriture")
+  (read-only "Lecture seulement")
   (auto-extend-selection "Autosélection") ; "Sélection auto-étendable" ?
   (overwrite "Correction") ; vs Insertion ? surimpression ?
   (running "en cours")
@@ -959,8 +956,6 @@
   (decimal-notation-for-rationals "Utiliser la notation décimale pour les nombres rationnels")
 
   ; used in the bottom left of the drscheme frame as the label
-  ; above the programming language's name
-  (programming-language-label "Langage de programmation :")
   ; used the popup menu from the just above; greyed out and only
   ; visible when some languages are in the history
   (recent-languages "Langages récents :")
diff --git a/collects/string-constants/german-string-constants.ss b/collects/string-constants/german-string-constants.ss
index 727ea0cd31..a299c7d4fc 100644
--- a/collects/string-constants/german-string-constants.ss
+++ b/collects/string-constants/german-string-constants.ss
@@ -98,10 +98,7 @@
 
  ;;; info bar at botttom of drscheme frame
  (collect-button-label "GC")
- (read-only-line1 "Lese-")
- (read-only-line2 "Modus")
- (read/write-line1 "Schreib-")
- (read/write-line2 "Modus")
+ (read-only "Lese Modus")
  (auto-extend-selection "Automatisch erweitern")
  (overwrite "Überschreiben")
  (running "Programm läuft")
@@ -854,7 +851,6 @@
 
  ;; used in the bottom left of the drscheme frame as the label
  ;; above the programming language's name
- (programming-language-label "Programmiersprache:")
  ;; used the popup menu from the just above; greyed out and only
  ;; visible when some languages are in the history
  (recent-languages "Kürzlich verwendete Sprachen:")
diff --git a/collects/string-constants/portuguese-string-constants.ss b/collects/string-constants/portuguese-string-constants.ss
index 8b0734e83f..060e2b946d 100644
--- a/collects/string-constants/portuguese-string-constants.ss
+++ b/collects/string-constants/portuguese-string-constants.ss
@@ -196,10 +196,7 @@ please adhere to these guidelines:
 
  ;;; info bar at botttom of drscheme frame
  (collect-button-label "GC")
- (read-only-line1 "Apenas")
- (read-only-line2 "Leitura")
- (read/write-line1 "Leitura/")
- (read/write-line2 "Escrita")
+ (read-only "Apenas Leitura")
  (auto-extend-selection "Auto-Extensível")
  (overwrite "Reescrever")
  (running "a executar")
diff --git a/collects/string-constants/simplified-chinese-string-constants.ss b/collects/string-constants/simplified-chinese-string-constants.ss
index ed7ee6f3ec..1f48c6a361 100644
--- a/collects/string-constants/simplified-chinese-string-constants.ss
+++ b/collects/string-constants/simplified-chinese-string-constants.ss
@@ -123,10 +123,7 @@
   
   ;;; info bar at botttom of drscheme frame
   (collect-button-label "垃圾回收")
-  (read-only-line1 "只")
-  (read-only-line2 "读")
-  (read/write-line1 "读/")
-  (read/write-line2 "写")
+  (read-only "只读")
   (auto-extend-selection "自动扩展")
   (overwrite "覆盖")
   (running "运行中")
@@ -886,7 +883,6 @@
   
   ; used in the bottom left of the drscheme frame as the label
   ; above the programming language's name
-  (programming-language-label "编程语言：")
   ; used the popup menu from the just above; greyed out and only
   ; visible when some languages are in the history
   (recent-languages "最近使用的语言：")
diff --git a/collects/string-constants/spanish-string-constants.ss b/collects/string-constants/spanish-string-constants.ss
index c1fb74b6bc..e6db0bd06a 100644
--- a/collects/string-constants/spanish-string-constants.ss
+++ b/collects/string-constants/spanish-string-constants.ss
@@ -104,10 +104,7 @@
  
  ;;; info bar at botttom of drscheme frame
  (collect-button-label "Recolectar")
- (read-only-line1 "Sólo")
- (read-only-line2 "lectura")
- (read/write-line1 "Lectura/")
- (read/write-line2 "Escritura")
+ (read-only "Sólo lectura")
  (auto-extend-selection "Selección Auto-Extendida")
  (overwrite "Sobreescribir")
  (running "ejecutando")
diff --git a/collects/string-constants/traditional-chinese-string-constants.ss b/collects/string-constants/traditional-chinese-string-constants.ss
index 4c725eaa6e..50ecc3886a 100644
--- a/collects/string-constants/traditional-chinese-string-constants.ss
+++ b/collects/string-constants/traditional-chinese-string-constants.ss
@@ -122,10 +122,7 @@
   
   ;;; info bar at botttom of drscheme frame
   (collect-button-label "垃圾回收")
-  (read-only-line1 "只")
-  (read-only-line2 "讀")
-  (read/write-line1 "讀/")
-  (read/write-line2 "寫")
+  (read-only "只讀")
   (auto-extend-selection "自動擴展")
   (overwrite "覆蓋")
   (running "運行中")
@@ -885,7 +882,6 @@
   
   ; used in the bottom left of the drscheme frame as the label
   ; above the programming language's name
-  (programming-language-label "程式語言：")
   ; used the popup menu from the just above; greyed out and only
   ; visible when some languages are in the history
   (recent-languages "最近使用的語言：")