diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss
index ad80b19f4e..7a15377660 100644
--- a/collects/drscheme/private/unit.ss
+++ b/collects/drscheme/private/unit.ss
@@ -47,6 +47,8 @@ module browser threading seems wrong.
   (define show-lib-paths (string-constant module-browser-show-lib-paths/short))
   (define show-planet-paths (string-constant module-browser-show-planet-paths/short))
   (define refresh (string-constant module-browser-refresh))
+
+  (define define-button-long-label "(define ...)")
   
   (define-unit unit@
     (import [prefix help-desk: drscheme:help-desk^]
@@ -1018,7 +1020,7 @@ module browser threading seems wrong.
                           (send item check #t))
                         (loop (cdr defns)))))))))
         
-        (super-new (label "(define ...)")
+        (super-new (label define-button-long-label)
                    [string-constant-untitled (string-constant untitled)]
                    [string-constant-no-full-name-since-not-saved 
                     (string-constant no-full-name-since-not-saved)])))
@@ -1901,9 +1903,16 @@ module browser threading seems wrong.
                         (append (remq top-outer-panel l) (list top-outer-panel)))))
             (send top-outer-panel change-children (λ (l) (list top-panel)))
             (send transcript-parent-panel change-children (λ (l) (list transcript-panel)))
+            #;
             (if vertical? 
                 (send top-panel change-children (λ (x) (remq name-panel x)))
                 (send top-panel change-children (λ (x) (cons name-panel (remq name-panel x)))))
+            (send func-defs-canvas set-message #f (if vertical? "δ" define-button-long-label))
+            (send name-message set-short-title vertical?)
+            (send name-panel set-orientation (not vertical?))
+            (if vertical?
+                (send name-panel set-alignment 'right 'top)
+                (send name-panel set-alignment 'left 'center))
             (end-container-sequence)))
         
         (define toolbar-buttons '())
diff --git a/collects/mrlib/name-message.ss b/collects/mrlib/name-message.ss
index a960572ece..823e123984 100644
--- a/collects/mrlib/name-message.ss
+++ b/collects/mrlib/name-message.ss
@@ -7,8 +7,8 @@
 
 (provide/contract
  [get-left-side-padding (-> number?)]
- (pad-xywh (number? number? (>=/c 0) (>=/c 0) . -> . (values number? number? (>=/c 0) (>=/c 0))))
- (draw-button-label
+ [pad-xywh (number? number? (>=/c 0) (>=/c 0) . -> . (values number? number? (>=/c 0) (>=/c 0)))]
+ [draw-button-label
   (->d ([dc (is-a?/c dc<%>)]
         [label (or/c false/c string?)]
         [x number?]
@@ -20,12 +20,12 @@
         [button-label-font (is-a?/c font%)]
         [bkg-color (or/c false/c (is-a?/c color%) string?)])
        ()
-       [result void?]))
+       [result void?])]
  
- (calc-button-min-sizes
+ [calc-button-min-sizes
   (->* ((is-a?/c dc<%>) string? (is-a?/c font%))
        ()
-       (values number? number?))))
+       (values number? number?))])
 
 (provide name-message%)
 
@@ -37,6 +37,8 @@
     (inherit popup-menu get-dc get-size get-client-size min-width min-height
              stretchable-width stretchable-height
              get-top-level-window refresh)
+  
+    (define short-title? #f)
     
     (define hidden? #f)
     (define/public (set-hidden? d?) 
@@ -57,6 +59,11 @@
     (init-field [label string-constant-untitled]
                 [font small-control-font])
     
+    (define/private (get-label)
+      (if short-title?
+          "/"
+          label))
+    
     (define full-name-window #f)
     
     (define mouse-grabbed? #f)
@@ -84,6 +91,12 @@
           (update-min-sizes)
           (refresh))))
     
+    (define/public (set-short-title st?) 
+      (set! short-title? st?)
+      (set! to-draw-message #f)
+      (update-min-sizes)
+      (refresh))
+    
     (define/public (fill-popup menu reset)
       (if (and paths (not (null? paths)))
           (let loop ([paths (cdr (reverse paths))])
@@ -139,7 +152,7 @@
     
     (inherit get-parent)
     (define/private (update-min-sizes)
-      (let-values ([(w h) (calc-button-min-sizes (get-dc) label font)])
+      (let-values ([(w h) (calc-button-min-sizes (get-dc) (get-label) font)])
         (cond
           [allow-to-shrink
            (cond
@@ -178,20 +191,21 @@
     
     (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))])))])))))
+      (let ([label (get-label)])
+        (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)
@@ -200,7 +214,8 @@
     (super-new [style '(transparent no-focus)])
     (update-min-sizes)
     (stretchable-width #f)
-    (stretchable-height #f)))
+    (stretchable-height #f)
+    (send (get-dc) set-smoothing 'aligned)))
 
 (define (get-left-side-padding) (+ button-label-inset circle-spacer))
 (define button-label-inset 1)
@@ -211,7 +226,6 @@
 (define triangle-color (make-object color% 50 50 50))
 
 (define border-inset 1)
-(define triangle-space 0)
 (define circle-spacer 4)
 (define rrect-spacer 3)
 
@@ -240,16 +254,15 @@
                   (+ 2 triangle-height))
              button-label-inset)]
          [ans-w
-          (max
-           (+ ans-h ans-h)
-           (+ circle-spacer
-              button-label-inset
-              1 ;; becuase "(define ...)" has the wrong size under windows
-              (max 0 (inexact->exact (ceiling tw)))
-              triangle-space
-              triangle-width
-              circle-spacer 
-              button-label-inset))])
+          (+ border-inset 
+             circle-spacer
+             button-label-inset
+             (if (eq? (system-type) 'windows) 1 0)  ;; becuase "(define ...)" has the wrong size under windows
+             (max 0 (inexact->exact (ceiling tw)))
+             button-label-inset
+             triangle-width
+             circle-spacer 
+             border-inset)])
     (values 
      (- tx (quotient (- ans-w tw) 2))
      (- ty (quotient (- ans-h th) 2))
@@ -264,8 +277,8 @@
           w)
         0))
   
-  (define w (+ border-inset circle-spacer button-label-inset label-width triangle-width circle-spacer border-inset))
-  
+  (define w (+ border-inset circle-spacer button-label-inset label-width button-label-inset triangle-width circle-spacer border-inset))
+
   (when bkg-color
     (send dc set-pen bkg-color 1 'solid)
     (send dc set-brush bkg-color 'solid)
@@ -281,12 +294,9 @@
          (send dc set-pen (send the-pen-list find-or-create-pen color 1 'solid))
          (send dc set-brush (send the-brush-list find-or-create-brush color 'solid))
          
-         (let ([old-smooth (send dc get-smoothing)])
-           (send dc set-smoothing 'aligned)
-           (send dc draw-ellipse (+ dx border-inset) (+ dy border-inset) xh xh)
-           (send dc draw-ellipse (+ dx (- w xh)) (+ dy border-inset) xh xh)
-           (send dc set-smoothing old-smooth))
-         
+         (send dc draw-ellipse (+ dx border-inset) (+ dy border-inset) xh xh)
+         (send dc draw-ellipse (+ dx (- w xh)) (+ dy border-inset) xh xh)
+
          (send dc set-pen (send the-pen-list find-or-create-pen "black" 1 'transparent))
          (send dc draw-rectangle (+ dx (quotient xh 2)) (+ dy border-inset) (- w xh) xh)
          (send dc set-pen (send the-pen-list find-or-create-pen color 1 'solid))
@@ -310,14 +320,14 @@
     (send dc set-font button-label-font)
     (let-values ([(tw th _1 _2) (send dc get-text-extent label)])
       (send dc draw-text label
-            (+ dx (+ circle-spacer button-label-inset))
+            (+ dx (+ border-inset circle-spacer button-label-inset))
             (+ dy (- (/ h 2) (/ th 2)))
             #t)))
   
   (send dc set-pen (send the-pen-list find-or-create-pen 
                          (if grabbed? grabbed-fg-color triangle-color)
                          1 'solid))
-  (let ([x (- w triangle-width circle-spacer)]
+  (let ([x (- w triangle-width circle-spacer border-inset)]
         [y (- (/ h 2) (/ triangle-height 2))])
     (let loop ([x-off 0][off-y 5])
       (unless (= 5 x-off)
diff --git a/collects/mrlib/scribblings/name-message.scrbl b/collects/mrlib/scribblings/name-message.scrbl
index 9f7c790ccf..120bb31d24 100644
--- a/collects/mrlib/scribblings/name-message.scrbl
+++ b/collects/mrlib/scribblings/name-message.scrbl
@@ -50,7 +50,7 @@ makes it respond to mouse movements again.}
 
 
 @defmethod[(set-message [file-name? any/c]
-                        [msg path-string?])
+                        [msg (if filename? path-string? string?)])
            void?]{
 
 Sets the label for the control.
@@ -63,7 +63,15 @@ If @scheme[file-name?] is @scheme[#f], @scheme[msg] is treated as a
 label string. Clicking on the name-message control pops up a dialog
 saying that there is no file name until the file is saved.}
 
-
+@defmethod[(set-short-title [short-title? boolean?]) void?]{
+  Sets the @scheme[short-title?] flag. The flag defaults to @scheme[#f].
+  
+  If the flag is @scheme[#t], then
+  the label for the control is simply the string @scheme["/"]. Otherwise,
+  the label is determined by
+  the @method[name-message% set-message].
+}
+                 
 @defmethod[(get-background-color) (or/c false/c (is-a/c color%) string?)]{
 
 The result of this method is used for the background color