From 19c53cad9e28e6480db918e4e28744176151e48f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 15 Dec 2021 03:58:05 -0600 Subject: [PATCH] windows: Add check-hresult function. --- basis/ui/backend/windows/windows.factor | 6 +++--- basis/windows/ole32/ole32.factor | 5 +++++ 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index d7804519ba..defb6cfd15 100644 --- 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 ac351a1f91..b4faa6da0d 100644 --- 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 long deref ; inline -- 2.34.1