.

original commit: 262c0585d228f89bdb975a87fcc439680b002d63

collects/mred/mred-sig.ss

@@ -35,6 +35,7 @@
      clipboard<%>
      color%
      color-database<%>
+     combo-text-field%
      control-event%
      control<%>
      current-eventspace
@@ -173,7 +174,6 @@
      tab-snip%
      text%
      text-editor-load-handler
-     text-combo-field%
      text-field%
      the-brush-list
      the-clipboard

collects/mred/mred.ss

@@ -3467,7 +3467,11 @@
       [set-value (lambda (v) (without-callback
 			      (lambda () (send e insert v 0 (send e last-position)))))]
 
-      [set-label (lambda (str) (when l (send l set-label str)))])
+      [set-label (lambda (str) (when l (send l set-label str)))]
+      [get-canvas-width (lambda ()
+			  (let ([tw (box 0)])
+			    (send c get-size tw (box 0))
+			    (unbox tw)))])
     (override
       ;; These might be called before we are fully initialized
 
@@ -3519,6 +3523,8 @@
 			       '(hide-hscroll))
 			   '(hide-vscroll hide-hscroll))))])
     (sequence
+      (when l
+	(send l x-margin 0))
       (send c set-x-margin 2)
       (send c set-y-margin 2)
       (send e set-line-spacing 0)
@@ -4808,13 +4814,13 @@
 			 (check-container-ready cwho parent)))
 		     label parent callback ibeam))))))
 
-(define text-combo-field%
+(define combo-text-field%
   (class100*/kw text-field% () 
 		[(label choices parent callback [init-value ""] [style '()])
 		 control%-keywords]
     (inherit set-value popup-menu get-size focus get-editor)
     (sequence 
-      (check-text-field-args '(constructor text-combo-field)
+      (check-text-field-args '(constructor combo-text-field)
 			     label 
 			     #f choices
 			     parent callback init-value
@@ -4822,10 +4828,12 @@
     (override
       [on-subwindow-event (lambda (w e)
 			    (and (send e button-down?)
-				 (let-values ([(w h) (get-size)])
-				   (and ((send e get-x) . >= . (- w side-combo-width))
+				 (let-values ([(w h) (get-size)]
+					      [(cw) (send (mred->wx this) get-canvas-width)])
+				   (and ((send e get-x) . >= . (- cw side-combo-width))
 					(begin
-					  (popup-menu menu 0 h)
+					  (send menu set-width cw)
+					  (popup-menu menu (- w cw) h)
 					  #t)))))])
     (private-field
      [menu (new popup-menu%)])
@@ -5882,7 +5890,10 @@
 		    (lambda (i) 
 		      (when (is-a? i labelled-menu-item<%>)
 			(send i on-demand)))
-		    (send wx get-items)))])
+		    (send wx get-items)))]
+      [set-width (lambda (n)
+		   (check-range-integer '(method popup-menu% set-width) n)
+		   (send wx set-width n))])
     (private-field
       [wx #f])
     (sequence
@@ -8097,7 +8108,7 @@
 	 radio-box%
 	 slider%
 	 text-field%
-	 text-combo-field%
+	 combo-text-field%
 	 window<%>
 	 area<%>
 	 top-level-window<%>

collects/mred/private/kernel.ss

@@ -883,6 +883,7 @@
     copy-self)
   (define-class menu% object% #f
     select
+    set-width
     set-title
     set-label
     set-help-string

collects/tests/mred/item.ss

@@ -643,8 +643,6 @@
   
   (make-object text-field% #f ip2 void "start focus here")
 
-  (make-object text-combo-field% #f '("Hola" "Ni Hao") ip2 void "hello")
-
   (when prev-frame
     (add-disable "Previous Tester Frame" prev-frame ep2))
   
@@ -658,6 +656,9 @@
     (send ip2 set-control-font special-font))
   
   (let ()
+    (define co
+      (make-object combo-text-field% "Greet:" '("Hola" "Ni Hao") ip2 void "hello"))
+
     (define sh (make-object slider% 
 			    (if null-label? #f "H S&lid\uE9r") 0 10 ip2
 			    (lambda (s e)
@@ -706,6 +707,7 @@
     (make-object button% "OK" tab void)
     (make-object button% "Cancel" grp void)
 
+    (add-testers2 "Combo" co)
     (add-testers2 "Horiz Slider" sh)
     (add-testers2 "Vert Slider" sv)
     (add-testers2 "Horiz Gauge" gh)
@@ -716,6 +718,7 @@
     (add-testers2 "Tab" tab)
     (add-testers2 "Group" grp)
     
+    (add-change-label "Combo" co lp2 #f OTHER-LABEL)
     (add-change-label "Horiz Slider" sh lp2 #f OTHER-LABEL)
     (add-change-label "Vert Slider" sv lp2 #f OTHER-LABEL)
     (add-change-label "Horiz Gauge" gh lp2 #f OTHER-LABEL)
@@ -723,7 +726,8 @@
     (add-change-label "Text" txt lp2 #f OTHER-LABEL)
     (add-change-label "Group" grp lp2 #f OTHER-LABEL)
     
-    (let* ([items (list sh sv
+    (let* ([items (list co
+			sh sv
 			gh gv
 			; cmt cmi
 			txt