windows: Add check-hresult function.

diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor
index d7804519ba30c83597f306ea866ec986f33d9bdc..defb6cfd15f800918ae80796d63f04fdb063c7fd 100644 (file)
--- a/basis/ui/backend/windows/windows.factor
+++ b/basis/ui/backend/windows/windows.factor
@@ -10,8 +10,8 @@ specialized-arrays strings threads ui ui.backend ui.clipboards
 ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
 ui.gestures ui.pixel-formats ui.private windows.dwmapi
 windows.errors windows.gdi32 windows.kernel32 windows.messages
-windows.offscreen windows.opengl32 windows.shell32 windows.types
-windows.user32 ;
+windows.offscreen windows.ole32 windows.opengl32 windows.shell32
+windows.types windows.user32 ;
 FROM: unicode => upper-surrogate? under-surrogate? ;
 SPECIALIZED-ARRAY: POINT
 QUALIFIED-WITH: alien.c-types c
@@ -512,7 +512,7 @@ SYMBOL: nc-buttons
 : ?make-glass ( world hwnd -- )
     over window-controls>> textured-background swap member-eq? [
         composition-enabled? [
-            full-window-margins DwmExtendFrameIntoClientArea drop
+            full-window-margins DwmExtendFrameIntoClientArea check-hresult
             T{ rgba f 0.0 0.0 0.0 0.0 }
         ] [ drop system-background-color ] if >>background-color
         drop

diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor
index ac351a1f91fc9457bb36f8879e15e2208d97a3f1..b4faa6da0d2e7de5c97e0924a96b3e2ecef2384a 100644 (file)
--- a/basis/windows/ole32/ole32.factor
+++ b/basis/windows/ole32/ole32.factor
@@ -36,6 +36,11 @@ CONSTANT: DRAGDROP_S_DROP 0x00040100
 CONSTANT: DRAGDROP_S_CANCEL 0x00040101
 CONSTANT: DRAGDROP_S_USEDEFAULTCURSORS 0x00040102
 
+ERROR: hresult-error n ;
+
+: check-hresult ( n -- )
+    dup S_OK = [ drop ] [ hresult-error ] if ;
+
 <<
 : >long ( integer -- long )
     long <ref> long deref ; inline