diff --git a/collects/framework/main.ss b/collects/framework/main.ss index db51e72f..f98deaef 100644 --- a/collects/framework/main.ss +++ b/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:%)) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 2d37a573..e6facf49 100644 --- a/collects/framework/private/frame.ss +++ b/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<%>))) diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index ea446f8f..48f83b6c 100644 --- a/collects/framework/private/sig.ss +++ b/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)) diff --git a/collects/scribblings/framework/frame.scrbl b/collects/scribblings/framework/frame.scrbl index 3ef45be6..aea24cfc 100644 --- a/collects/scribblings/framework/frame.scrbl +++ b/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))]{