improved the icon a little bit more (making it appear on more windows)

svn: r17380

original commit: 3272274f5328dda82f737b6b70796920bf719262

collects/framework/main.ss

@@ -645,6 +645,28 @@
   (frame)
   @{Removes empty menus in a frame.})
  
+ (parameter-doc
+  frame:current-icon
+  (parameter/c (or/c #f
+                     (is-a?/c bitmap%)
+                     (cons/c (is-a?/c bitmap%)
+                             (is-a?/c bitmap%))))
+  icon-spec
+  @{The value of this parameter is used by the initialization code of
+    @scheme[frame:basic-mixin].
+    @itemize[@item{If it is @scheme[#f], then its value is
+    ignored.}
+              @item{It it is a @scheme[bitmap%], then the @method[frame% set-icon] is called
+    with the bitmap, the result of invoking the @scheme[bitmap% get-loaded-mask] method,
+    and @scheme['both].}
+              @item{If it is a pair of bitmaps, then the @method[frame% set-icon]
+    method is invoked twice, once with each bitmap in the pair. The first bitmap
+    is passed (along with the result of its @scheme[bitmap% get-loaded-mask])
+    and @scheme['small], and then the second bitmap is passed
+    (also along with the result of its @scheme[bitmap% get-loaded-mask]) and @scheme['large].}]
+    
+    Defaults to @scheme[#f].})
+  
  (proc-doc/names
   group:get-the-frame-group
   (-> (is-a?/c group:%))

collects/framework/private/frame.ss

@@ -201,6 +201,16 @@
     
     (accept-drop-files #t)
     
+    (inherit set-icon)
+    (let ([icon (current-icon)])
+      (when icon
+        (if (pair? icon)
+            (let ([small (car icon)]
+                  [large (cdr icon)])
+              (set-icon small (send small get-loaded-mask) 'small)
+              (set-icon large (send large get-loaded-mask) 'large))
+            (set-icon icon (send icon get-loaded-mask) 'both))))
+    
     (let ([mb (make-object (get-menu-bar%) this)])
       (when (or (eq? (system-type) 'macos)
                 (eq? (system-type) 'macosx))
@@ -213,6 +223,8 @@
     (define/public (get-area-container) panel)
     (set! after-init? #t)))
 
+(define current-icon (make-parameter #f))
+
 (define size-pref<%>
   (interface (basic<%>)))
 

collects/framework/private/sig.ss

@@ -294,7 +294,8 @@
      text-info-mixin
      pasteboard-info-mixin))
   (define-signature frame^ extends frame-class^
-    (reorder-menus
+    (current-icon
+     reorder-menus
      remove-empty-menus
      add-snip-menu-items
      setup-size-pref))

collects/scribblings/framework/frame.scrbl

@@ -107,7 +107,7 @@
   object returned by
   @scheme[group:get-the-frame-group].
 
-  Do not give @scheme[panel%]s or @scheme[control<%>]s this frame as
+  Do not give @scheme[panel%] or @scheme[control<%>] objects this frame as
   parent. Instead, use the result of the
   @method[frame:basic<%> get-area-container]
   method.
@@ -118,6 +118,11 @@
   @method[frame:basic<%> get-menu-bar%]. It only passes the frame as an initialization argument.
   In addition, it creates the windows menu in the menu bar.
 
+  This mixin calls its @method[window<%> accept-drop-files] with @scheme[#t].
+  
+  It also calls its @method[frame% set-icon] method according to the current
+  value of @scheme[frame:current-icon].
+  
   See also
   @scheme[frame:reorder-menus].
   @defmethod*[#:mode override (((show (on? boolean?)) void))]{