From 8725f0c793e2eee15de89f345a2a274d17957cef Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 9 Nov 2004 17:08:32 +0000
Subject: [PATCH] .

original commit: 443387f1fa83ad6e7a609a67150464f855023f50
---
 collects/mred/mred-sig.ss   |  2 +-
 collects/mred/mred.ss       | 50 +++++++++++++++++++++++--------------
 collects/tests/mred/item.ss |  2 +-
 3 files changed, 33 insertions(+), 21 deletions(-)

diff --git a/collects/mred/mred-sig.ss b/collects/mred/mred-sig.ss
index 98866ad6..c7bb4f5d 100644
--- a/collects/mred/mred-sig.ss
+++ b/collects/mred/mred-sig.ss
@@ -35,7 +35,7 @@
      clipboard<%>
      color%
      color-database<%>
-     combo-text-field%
+     combo-field%
      control-event%
      control<%>
      current-eventspace
diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss
index 7456cc87..fdae9c04 100644
--- a/collects/mred/mred.ss
+++ b/collects/mred/mred.ss
@@ -4771,9 +4771,12 @@
   (check-container-parent cwho parent)
   (check-callback cwho callback)
   (check-string cwho init-value)
-  (check-style cwho req-styles (cons combo-flag
-				     '(hscroll password vertical-label horizontal-label deleted))
-	       style))
+  (check-style cwho 
+	       req-styles 
+	       (append
+		(if choices? null '(hscroll password))
+		'(vertical-label horizontal-label deleted))
+	       (remq combo-flag style)))
 
 (define text-field%
   (class100*/kw basic-control% () 
@@ -4814,36 +4817,45 @@
 			 (check-container-ready cwho parent)))
 		     label parent callback ibeam))))))
 
-(define combo-text-field%
+(define combo-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 combo-text-field)
+      (check-text-field-args '(constructor combo-field)
 			     label 
 			     #f choices
 			     parent callback init-value
 			     style #f))
+    (public
+      [on-popup (lambda (e)
+		  (let-values ([(w h) (get-size)]
+			       [(cw) (send (mred->wx this) get-canvas-width)])
+		    (send menu set-min-width cw)
+		    (popup-menu menu (- w cw) h)))]
+      [get-menu (lambda () menu)]
+      [append (lambda (item)
+		(check-label-string '(method combo-field% append) item)
+		(make-object menu-item% item menu 
+			     (lambda (i e)
+			       (focus)
+			       (set-value item)
+			       (let ([e (get-editor)])
+				 (send e set-position 0 (send e last-position))))))])
     (override
       [on-subwindow-event (lambda (w e)
 			    (and (send e button-down?)
-				 (let-values ([(w h) (get-size)]
-					      [(cw) (send (mred->wx this) get-canvas-width)])
+				 (let-values ([(cw) (send (mred->wx this) get-canvas-width)])
 				   (and ((send e get-x) . >= . (- cw side-combo-width))
 					(begin
-					  (send menu set-width cw)
-					  (popup-menu menu (- w cw) h)
+					  (on-popup e)
 					  #t)))))])
     (private-field
      [menu (new popup-menu%)])
     (sequence
-      (for-each (lambda (item) (make-object menu-item% item menu 
-					    (lambda (i e)
-					      (focus)
-					      (set-value item)
-					      (let ([e (get-editor)])
-						(send e set-position 0 (send e last-position))))))
+      (for-each (lambda (item) 
+		  (append item))
 		choices)
       (super-init label parent callback init-value (list* combo-flag 'single style)))))
 
@@ -5891,9 +5903,9 @@
 		      (when (is-a? i labelled-menu-item<%>)
 			(send i on-demand)))
 		    (send wx get-items)))]
-      [set-width (lambda (n)
-		   (check-range-integer '(method popup-menu% set-width) n)
-		   (send wx set-width n))])
+      [set-min-width (lambda (n)
+		       (check-range-integer '(method popup-menu% set-min-width) n)
+		       (send wx set-width n))])
     (private-field
       [wx #f])
     (sequence
@@ -8108,7 +8120,7 @@
 	 radio-box%
 	 slider%
 	 text-field%
-	 combo-text-field%
+	 combo-field%
 	 window<%>
 	 area<%>
 	 top-level-window<%>
diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss
index aaa71e29..d2829c04 100644
--- a/collects/tests/mred/item.ss
+++ b/collects/tests/mred/item.ss
@@ -657,7 +657,7 @@
   
   (let ()
     (define co
-      (make-object combo-text-field% "Greet:" '("Hola" "Ni Hao") ip2 void "hello"))
+      (make-object combo-field% "Greet:" '("Hola" "Ni Hao") ip2 void "hello"))
 
     (define sh (make-object slider% 
 			    (if null-label? #f "H S&lid\uE9r") 0 10 ip2