From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 4 Nov 1995 01:35:01 +0000 (+0000)
Subject: Add primitives to support loading and setting of icons.
X-Git-Tag: 20090517-FFI~5781
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=155e2b7ec2c46484625d08b3664a8d961c2cc4c4;p=mit-scheme.git

Add primitives to support loading and setting of icons.
---

diff --git a/v7/src/microcode/os2pm.c b/v7/src/microcode/os2pm.c
index 00d77f608..090a813a4 100644
--- a/v7/src/microcode/os2pm.c
+++ b/v7/src/microcode/os2pm.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: os2pm.c,v 1.22 1995/11/04 00:08:27 cph Exp $
+$Id: os2pm.c,v 1.23 1995/11/04 01:34:55 cph Exp $
 
 Copyright (c) 1994-95 Massachusetts Institute of Technology
 
@@ -2372,7 +2372,7 @@ unparse_font_spec (PSZ name, LONG size, USHORT selection)
   return (result);
 }
 
-/* Pointers */
+/* Pointers and Icons */
 
 static HPOINTER
 query_system_pointer (qid_t qid, HWND desktop, LONG id, BOOL copyp)
@@ -2385,3 +2385,17 @@ set_pointer (qid_t qid, HWND desktop, HPOINTER pointer)
 {
   return (WinSetPointer (desktop, pointer));
 }
+
+static HPOINTER
+window_load_pointer (window_t * window, HMODULE module, ULONG id)
+{
+  return (WinLoadPointer ((WINDOW_FRAME (window)), module, id));
+}
+
+static BOOL
+window_set_icon (window_t * window, HPOINTER icon)
+{
+  return (LONGFROMMR (WinSendMsg ((WINDOW_FRAME (window)), WM_SETICON,
+				  (MPFROMLONG (icon)),
+				  (MPFROMLONG (0)))));
+}
diff --git a/v7/src/microcode/os2pm.scm b/v7/src/microcode/os2pm.scm
index ecad819ad..a21969d0c 100644
--- a/v7/src/microcode/os2pm.scm
+++ b/v7/src/microcode/os2pm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2pm.scm,v 1.3 1995/11/04 00:08:40 cph Exp $
+$Id: os2pm.scm,v 1.4 1995/11/04 01:35:01 cph Exp $
 
 Copyright (c) 1995 Massachusetts Institute of Technology
 
@@ -1067,4 +1067,12 @@ MIT in each case. */
   (value ("BOOL" successp))
   (arguments qid ("HWND" desktop) ("HPOINTER" pointer)))
 
+(define-pm-procedure window_load_pointer
+  (value ("HPOINTER" pointer))
+  (arguments window ("HMODULE" module) (ulong id)))
+
+(define-pm-procedure window_set_icon
+  (value ("BOOL" successp))
+  (arguments window ("HPOINTER" icon)))
+
 (write-all-files)
\ No newline at end of file