.

original commit: d7b87ced74fe033b2ca0b763d61da503df5876ce

collects/tests/mred/item.ss

@@ -297,16 +297,26 @@
 		     cb icb 
 		     rb irb 
 		     ch
-		     txt)])
-    (cons (make-object popup-test-canvas% 
-		       items
-		     (list "label" "image label"
+		     txt)]
+	[names (list "label" "image label"
 		     "button" "image button"
 		     "list box"
 		     "checkbox" "image checkbox"
 		     "radio box" "image radiobox"
 		     "choice"
-			   "text")
+		     "text")])
+    (make-object choice%
+		 "Set Focus"
+		 (cons "..." names)
+		 lp
+		 (lambda (c e)
+		   (let ([v (send c get-selection)])
+		     (when (positive? v)
+		       (send (list-ref items (sub1 v)) focus)
+		       (send c set-selection 0)))))
+    (cons (make-object popup-test-canvas% 
+		       items
+		       names
 		       cp)
 	  items)))