...

original commit: e1879c7dbe7d73929f8edc03bfb79dff754c5bcb

collects/framework/frame.ss

@@ -338,9 +338,11 @@
 			  (send (get-canvas) set-editor e))
 			e))])
       (sequence
-	(let ([icon (icon:get)])
-	  (when (send icon ok?)
-	    (set-icon icon)))
+	(let ([icon (icon:get)]
+              [mask (icon:get-mask)])
+	  (when (and (send icon ok?)
+                     (send mask ok?))
+	    (set-icon icon mask)))
 	(do-label)
 	(cond
 	 [(and file-name (file-exists? file-name))

collects/framework/frameworks.ss

@@ -203,7 +203,8 @@
 
 (define-signature framework:icon^
   (get
-
+   get-mask
+   
    get-paren-highlight-bitmap
    get-autowrap-bitmap
 

collects/framework/icon.ss

@@ -36,17 +36,20 @@
   (define get-autowrap-bitmap (load-icon "return.xbm" 'xbm))
   (define get-paren-highlight-bitmap (load-icon "paren.xbm" 'xbm))
   
-  (define get
+  (define (make-get/mask filename type)
     (let ([icon #f]
-	  [p (build-path icon-path "mred.xbm")])
+	  [p (build-path icon-path filename)])
       (unless (file-exists? p)
 	(fprintf (current-error-port) "WARNING: couldn't find ~a~n" p))
       (lambda ()
 	(or icon
 	    (begin
-	      (set! icon (make-object bitmap% p 'xbm))
+	      (set! icon (make-object bitmap% p type))
 	      icon)))))
   
+  (define get (make-get/mask "plt16x16.bmp" 'bmp))
+  (define get-mask (make-get/mask "dot16x16.xbm" 'xbm))
+  
   (define gc-on-bitmap #f)
 
   (define (fetch)