win32: get default frame icon from application

Also, clean up icon- and cursor-loading code

collects/mred/private/wx/win32/const.rkt

@@ -623,4 +623,3 @@
 (define CBN_DROPDOWN        7)
 (define CBN_CLOSEUP         8)
 (define CBN_SELENDCANCEL    10)
-

collects/mred/private/wx/win32/cursor.rkt

@@ -5,6 +5,7 @@
          "types.rkt"
          "const.rkt"
          "wndclass.rkt"
+	 "icons.rkt"
          "../common/cursor-draw.rkt"
           "../../syntax.rkt")
 
@@ -13,25 +14,6 @@
               get-arrow-cursor
               get-wait-cursor))
 
-(define (MAKEINTRESOURCE v) v)
-
-(define IDC_ARROW           (MAKEINTRESOURCE 32512))
-(define IDC_IBEAM           (MAKEINTRESOURCE 32513))
-(define IDC_WAIT            (MAKEINTRESOURCE 32514))
-(define IDC_APPSTARTING     (MAKEINTRESOURCE 32650))
-(define IDC_CROSS           (MAKEINTRESOURCE 32515))
-(define IDC_UPARROW         (MAKEINTRESOURCE 32516))
-(define IDC_SIZENWSE        (MAKEINTRESOURCE 32642))
-(define IDC_SIZENESW        (MAKEINTRESOURCE 32643))
-(define IDC_SIZEWE          (MAKEINTRESOURCE 32644))
-(define IDC_SIZENS          (MAKEINTRESOURCE 32645))
-(define IDC_SIZEALL         (MAKEINTRESOURCE 32646))
-(define IDC_NO              (MAKEINTRESOURCE 32648))
-(define IDC_HAND            (MAKEINTRESOURCE 32649))
-(define IDC_HELP            (MAKEINTRESOURCE 32651))
-
-(define-user32 LoadCursorW (_wfun _HINSTANCE _LONG -> _HCURSOR))
-
 (define-user32 CreateCursor (_wfun _HINSTANCE
                                    _int ; x
                                    _int ; y

collects/mred/private/wx/win32/icons.rkt

@@ -1,13 +1,34 @@
 #lang racket/base
-(require ffi/unsafe)
+(require ffi/unsafe
+	 "types.rkt"
+	 "utils.rkt")
 
-(provide IDC_ARROW IDC_CROSS
+(provide (protect-out (all-defined-out)))
-	 IDI_APPLICATION IDI_HAND IDI_QUESTION IDI_WINLOGO)
+
+(define-user32 LoadCursorW (_wfun _HINSTANCE _intptr -> _HCURSOR))
+(define-user32 LoadIconW (_wfun _HINSTANCE _intptr -> _HICON))
+
+(define (MAKEINTRESOURCE n) n)
 
-(define (MAKEINTRESOURCE n) (ptr-add #f n))
-(define IDC_ARROW           (MAKEINTRESOURCE 32512))
-(define IDC_CROSS           (MAKEINTRESOURCE 32515))
 (define IDI_APPLICATION     (MAKEINTRESOURCE 32512))
 (define IDI_HAND            (MAKEINTRESOURCE 32513))
 (define IDI_QUESTION        (MAKEINTRESOURCE 32514))
+(define IDI_EXCLAMATION     (MAKEINTRESOURCE 32515))
 (define IDI_WINLOGO         (MAKEINTRESOURCE 32517))
+(define IDI_WARNING         IDI_EXCLAMATION)
+(define IDI_ERROR           IDI_HAND)
+
+(define IDC_ARROW           (MAKEINTRESOURCE 32512))
+(define IDC_CROSS           (MAKEINTRESOURCE 32515))
+(define IDC_HAND            (MAKEINTRESOURCE 32649))
+(define IDC_IBEAM           (MAKEINTRESOURCE 32513))
+(define IDC_WAIT            (MAKEINTRESOURCE 32514))
+(define IDC_APPSTARTING     (MAKEINTRESOURCE 32650))
+(define IDC_UPARROW         (MAKEINTRESOURCE 32516))
+(define IDC_SIZENWSE        (MAKEINTRESOURCE 32642))
+(define IDC_SIZENESW        (MAKEINTRESOURCE 32643))
+(define IDC_SIZEWE          (MAKEINTRESOURCE 32644))
+(define IDC_SIZENS          (MAKEINTRESOURCE 32645))
+(define IDC_SIZEALL         (MAKEINTRESOURCE 32646))
+(define IDC_NO              (MAKEINTRESOURCE 32648))
+(define IDC_HELP            (MAKEINTRESOURCE 32651))

collects/mred/private/wx/win32/message.rkt

@@ -11,7 +11,8 @@
 	 "window.rkt"
 	 "wndclass.rkt"
          "hbitmap.rkt"
-         "types.rkt")
+         "types.rkt"
+	 "icons.rkt")
 
 (provide
  (protect-out message%))
@@ -23,39 +24,8 @@
 (define SS_BITMAP #x0000000E)
 (define SS_ICON #x00000003)
 
-(define IDI_APPLICATION     32512)
-(define IDI_HAND            32513)
-(define IDI_QUESTION        32514)
-(define IDI_EXCLAMATION     32515)
-(define IDI_WARNING         IDI_EXCLAMATION)
-(define IDI_ERROR           IDI_HAND)
-
 (define IMAGE_ICON 1)
 
-(define-user32 LoadIconW (_wfun _HINSTANCE _LONG -> _HICON))
-(define-kernel32 GetModuleFileNameW (_wfun _pointer _pointer _DWORD -> _DWORD))
-
-(define-shell32 ExtractIconW (_wfun _HINSTANCE _string/utf-16 _UINT -> (r : _HICON)
-                                    -> (or r (failed 'ExtractIconW))))
-                                           
-(define ERROR_INSUFFICIENT_BUFFER 122)
-
-(define app-icon
-  (delay
-    (let ()
-      (let ([path
-             (let loop ([size 1024])
-               (let ([p (make-bytes (* (ctype-sizeof _WCHAR) 1024))])
-                 (let ([r (GetModuleFileNameW #f p size)])
-                   (cond
-                    [(and (or (zero? r) (= r size))
-                          (= (GetLastError) ERROR_INSUFFICIENT_BUFFER))
-                     (loop (* size 2))]
-                    [(zero? r) (failed 'GetModuleFileNameW)]
-                    [else (cast p _gcpointer _string/utf-16)]))))])
-        (if path
-            (ExtractIconW hInstance path 0)
-            (LoadIconW #f IDI_APPLICATION))))))
 (define warning-icon
   (delay
     (LoadIconW #f IDI_WARNING)))
@@ -108,10 +78,10 @@
 
     (when (symbol? label)
       (SendMessageW (get-hwnd) STM_SETIMAGE IMAGE_ICON
-                    (cast (force (case label
+                    (cast (case label
-                                   [(caution) warning-icon]
+			    [(caution) (force warning-icon)]
-                                   [(stop) error-icon]
+			    [(stop) (force error-icon)]
-                                   [else app-icon]))
+			    [else app-icon])
                           _HICON _LPARAM)))
     
     (set-control-font font)

collects/mred/private/wx/win32/wndclass.rkt

@@ -22,7 +22,8 @@
               CreateDialogIndirectParamW dialog-proc
               clean-up-destroyed
               MessageBoxW
-              _WndProc))
+              _WndProc
+	      app-icon))
 
 ;; ----------------------------------------
 ;; We use the "user data" field of an HWND to
@@ -226,8 +227,6 @@
 
 (define-user32 RegisterClassW (_wfun _WNDCLASS-pointer -> _ATOM))
 (define-kernel32 GetModuleHandleW (_wfun _pointer -> _HINSTANCE))
-(define-user32 LoadCursorW (_wfun _HINSTANCE _pointer -> _HCURSOR))
-(define-user32 LoadIconW (_wfun _HINSTANCE _string/utf-16 -> _HICON))
 
 (define-user32 GetClassInfoW (_wfun _HINSTANCE _string/utf-16 (i : (_ptr o _WNDCLASS)) -> (r : _BOOL)
                                     -> (if r i (failed 'GetClassInfoW))))
@@ -243,13 +242,33 @@
 (define background-hbrush (let ([p (ptr-add #f (+ COLOR_BTNFACE 1))])
                             (cpointer-push-tag! p 'HBRUSH)
                             p))
- 
+
+(define-kernel32 GetModuleFileNameW (_wfun _pointer _pointer _DWORD -> _DWORD))
+(define ERROR_INSUFFICIENT_BUFFER 122)
+(define-shell32 ExtractIconW (_wfun _HINSTANCE _string/utf-16 _UINT -> (r : _HICON)
+                                    -> (or r (failed 'ExtractIconW))))
+
+(define app-icon
+  (let ([path
+	 (let loop ([size 1024])
+	   (let ([p (make-bytes (* (ctype-sizeof _WCHAR) 1024))])
+	     (let ([r (GetModuleFileNameW #f p size)])
+	       (cond
+		[(and (or (zero? r) (= r size))
+		      (= (GetLastError) ERROR_INSUFFICIENT_BUFFER))
+		 (loop (* size 2))]
+		[(zero? r) (failed 'GetModuleFileNameW)]
+		[else (cast p _gcpointer _string/utf-16)]))))])
+    (if path
+	(ExtractIconW hInstance path 0)
+	(LoadIconW #f IDI_APPLICATION))))
+
 (void (RegisterClassW (make-WNDCLASS CS_OWNDC
 				     wind-proc-ptr
 				     0
                                      0
 				     hInstance
-				     (LoadIconW hInstance "WXSTD_FRAME")
+				     app-icon
                                      #f
                                      background-hbrush
 				     #f ; menu

src/worksp/gracket/gracket.rc

@@ -1,14 +1,8 @@
-
 /////////////////////////////////////////////////////////////////////////////
 //
 // Icon
 //
 
-// Icon with lowest ID value placed first to ensure application icon
-// remains consistent on all systems.
-WXSTD_FRAME             ICON    DISCARDABLE     "gracket.ico"
-WXSTD_MDICHILDFRAME     ICON    DISCARDABLE     "gracket.ico"
-WXSTD_MDIPARENTFRAME    ICON    DISCARDABLE     "gracket.ico"
 APPLICATION             ICON    DISCARDABLE     "gracket.ico"
 
 /////////////////////////////////////////////////////////////////////////////

src/worksp/racket/racket.rc

@@ -1,28 +1,10 @@
-//Microsoft Developer Studio generated resource script.
-
-//
-
-#include "resource.h"
-
-
-
 /////////////////////////////////////////////////////////////////////////////
-
 //
-
 // Icon
-
 //
 
-
-
-// Icon with lowest ID value placed first to ensure application icon
-
-// remains consistent on all systems.
-
 APPLICATION             ICON    DISCARDABLE     "racket.ico"
 
-
 /////////////////////////////////////////////////////////////////////////////
 //
 // Version

src/worksp/racket/resource.h

@@ -1,16 +0,0 @@
-//{{NO_DEPENDENCIES}}
-// Microsoft Developer Studio generated include file.
-// Used by racket.rc
-//
-#define APPLICATION                     101
-
-// Next default values for new objects
-//
-#ifdef APSTUDIO_INVOKED
-#ifndef APSTUDIO_READONLY_SYMBOLS
-#define _APS_NEXT_RESOURCE_VALUE        102
-#define _APS_NEXT_COMMAND_VALUE         40001
-#define _APS_NEXT_CONTROL_VALUE         1000
-#define _APS_NEXT_SYMED_VALUE           101
-#endif
-#endif