From a1995c491c10512a1006d3314e155b94734a18ea Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 15 Sep 2017 19:07:29 -0500 Subject: [PATCH 1/9] Nmakefile: Parallel! --- Nmakefile | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/Nmakefile b/Nmakefile index 81751fff1a..7e88440672 100644 --- a/Nmakefile +++ b/Nmakefile @@ -114,11 +114,12 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ vm\vm.obj \ vm\words.obj -.cpp.obj: - cl /EHsc $(CL_FLAGS) /Fo$@ /c $< +# batch mode has :: +.cpp.obj:: + cl /EHsc $(CL_FLAGS) /MP32 /Fovm/ /c $< -.c.obj: - cl $(CL_FLAGS) /Fo$@ /c $< +.c.obj:: + cl /EHsc $(CL_FLAGS) /MP32 /Fovm/ /c $< .asm.obj: ml $(ML_FLAGS) /Fo$@ /c $< From 5e67ded4a9ffd0eccaad7d72eda58f08cf3e6efe Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 15 Sep 2017 19:40:26 -0500 Subject: [PATCH 2/9] Nmakefile: Let cl decide how many threads to use. --- Nmakefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Nmakefile b/Nmakefile index 7e88440672..310358a60b 100644 --- a/Nmakefile +++ b/Nmakefile @@ -116,10 +116,10 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \ # batch mode has :: .cpp.obj:: - cl /EHsc $(CL_FLAGS) /MP32 /Fovm/ /c $< + cl /EHsc $(CL_FLAGS) /MP /Fovm/ /c $< .c.obj:: - cl /EHsc $(CL_FLAGS) /MP32 /Fovm/ /c $< + cl /EHsc $(CL_FLAGS) /MP /Fovm/ /c $< .asm.obj: ml $(ML_FLAGS) /Fo$@ /c $< From e50be2a1ca65e9d3b3c8116fd71f743ab59fcf65 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 15 Mar 2018 17:26:51 -0500 Subject: [PATCH 3/9] system: flush so we get the same behavior on windows and unix. Related to #1918. --- core/system/system.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/system/system.factor b/core/system/system.factor index 99628b2b69..a694d074ff 100644 --- a/core/system/system.factor +++ b/core/system/system.factor @@ -80,5 +80,5 @@ PRIVATE> : exit ( n -- * ) [ do-shutdown-hooks (exit) ] ignore-errors - [ "Unexpected error during shutdown!" print ] ignore-errors + [ "Unexpected error during shutdown!" print flush ] ignore-errors 255 (exit) ; From f164f47e4154ddd70405049dd5f4d3d66708c38a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Mar 2018 18:13:17 -0500 Subject: [PATCH 4/9] editors: Launch editors as child processes. Hopefully this is ok on other platforms. On Windows, VSCode gets launched as a child process, which kills the editor when Factor exits. This is not what we want. Add an overridable option to launch editors as child processes, which should get repated when Factor quits. The confusion comes from ``run-detached`` which itself just waits until the child process returns (as opposed to "detaching" a child process from the parent process, which is called +new-group+ or +new-session+ instead). --- basis/editors/editors.factor | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index fe21dfe4df..5efafdbb7e 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -25,10 +25,14 @@ M: f editor-command HOOK: editor-detached? editor-class ( -- ? ) M: object editor-detached? t ; +HOOK: editor-is-child? editor-class ( -- ? ) +M: object editor-is-child? f ; + : run-and-wait-for-editor ( command -- ) swap >>command editor-detached? >>detached + editor-is-child? [ +new-group+ >>group ] unless run-process 300 milliseconds sleep dup status>> { 0 f } member? From 63a21cbdd16dca6063599790c2b7ab8dcd27997e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Mar 2018 18:22:23 -0500 Subject: [PATCH 5/9] io.launcher.windows: Actually support +new-group+ and +new-session+. DETACHED_PROCESS doesn't do what we want. Also, the check for `windows?`` in a Windows vocabulary is quite suspect. --- basis/io/launcher/windows/windows.factor | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor index 89032eed79..4897aa07f0 100755 --- a/basis/io/launcher/windows/windows.factor +++ b/basis/io/launcher/windows/windows.factor @@ -108,7 +108,14 @@ TUPLE: CreateProcess-args : fill-dwCreateFlags ( process args -- process args ) 0 pick pass-environment? [ CREATE_UNICODE_ENVIRONMENT bitor ] when - pick detached>> os windows? and [ DETACHED_PROCESS bitor ] when + pick group>> [ + { + { +same-group+ [ ] } + { +new-session+ [ DETACHED_PROCESS bitor CREATE_NEW_PROCESS_GROUP bitor ] } + { +new-group+ [ DETACHED_PROCESS bitor CREATE_NEW_PROCESS_GROUP bitor ] } + [ drop ] + } case + ] when* pick lookup-priority [ bitor ] when* >>dwCreateFlags ; From de43042ecfaea750d2d8ccb3a3f9f063e09117f7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Mar 2018 18:22:57 -0500 Subject: [PATCH 6/9] editors.visual-studio-code: Fix command-line args url. --- basis/editors/visual-studio-code/visual-studio-code.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/editors/visual-studio-code/visual-studio-code.factor b/basis/editors/visual-studio-code/visual-studio-code.factor index 3b43d7443c..5b6998f373 100644 --- a/basis/editors/visual-studio-code/visual-studio-code.factor +++ b/basis/editors/visual-studio-code/visual-studio-code.factor @@ -6,7 +6,7 @@ make math.parser memoize namespaces sequences system tools.which ; IN: editors.visual-studio-code ! Command line arguments -! https://code.visualstudio.com/docs/editor/codebasics#_additional-command-line-arguments +! https://code.visualstudio.com/docs/editor/command-line SINGLETON: visual-studio-code visual-studio-code editor-class set-global From 1d1f827f9bc98fad27c707ed03dfaae5b29746b4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 16 Mar 2018 21:17:47 -0500 Subject: [PATCH 7/9] windows: Add some more win32 calls. --- basis/windows/types/types.factor | 7 ++ basis/windows/user32/user32.factor | 161 +++++++++++++++++++++++++---- 2 files changed, 147 insertions(+), 21 deletions(-) diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index 1b84607656..3b4b8c70c3 100644 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -128,6 +128,7 @@ TYPEDEF: DWORD LGRPID TYPEDEF: LONG_PTR LPARAM TYPEDEF: BOOL* LPBOOL TYPEDEF: BYTE* LPBYTE + TYPEDEF: { c-string utf16n } LPCWSTR ! TYPEDEF: WCHAR* LPWSTR @@ -192,6 +193,8 @@ TYPEDEF: LPVOID SC_LOCK TYPEDEF: HANDLE SERVICE_STATUS_HANDLE TYPEDEF: LONGLONG USN TYPEDEF: UINT_PTR WPARAM +TYPEDEF: DWORD ACCESS_MASK +TYPEDEF: ACCESS_MASK* PACCESS_MASK TYPEDEF: size_t socklen_t @@ -273,6 +276,7 @@ TYPEDEF: void* PAINTSTRUCT STRUCT: POINT { x LONG } { y LONG } ; +TYPEDEF: POINT* LPPOINT STRUCT: SIZE { cx LONG } @@ -403,3 +407,6 @@ STRUCT: TEXTMETRICW TYPEDEF: TEXTMETRICW* LPTEXTMETRIC TYPEDEF: ULONG PROPID + +CALLBACK: BOOL WNDENUMPROC ( HWND hWnd, LPARAM lParam ) +CALLBACK: LRESULT HOOKPROC ( int nCode, WPARAM wParam, LPARAM lParam ) diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index d3afdc95c1..f6ab76dfe4 100644 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -748,6 +748,45 @@ ALIAS: SPIF_SENDCHANGE SPIF_SENDWININICHANGE TYPEDEF: HANDLE HRAWINPUT : GET_RAWINPUT_CODE_WPARAM ( wParam -- n ) 0xff bitand ; inline +CONSTANT: LLMHF_INJECTED 1 +CONSTANT: LLMHF_LOWER_IL_INJECTED 2 + + +CONSTANT: WH_JOURNALRECORD 0 ! global +CONSTANT: WH_JOURNALPLAYBACK 1 ! global +CONSTANT: WH_KEYBOARD 2 ! thread/global +CONSTANT: WH_GETMESSAGE 3 ! thread/global +CONSTANT: WH_CALLWNDPROC 4 ! thread/global +CONSTANT: WH_CBT 5 ! thread/global +CONSTANT: WH_SYSMSGFILTER 6 ! global +CONSTANT: WH_MOUSE 7 ! thread/global +CONSTANT: WH_DEBUG 9 ! thread/global +CONSTANT: WH_SHELL 10 ! thread/global +CONSTANT: WH_FOREGROUNDIDLE 11 ! thread/global +CONSTANT: WH_CALLWNDPROCRET 12 ! thread/global +CONSTANT: WH_KEYBOARD_LL 13 ! global +CONSTANT: WH_MOUSE_LL 14 ! global +CONSTANT: WH_MSGFILTER -1 ! thread/global + + +STRUCT: KBDLLHOOKSTRUCT + { vkCode DWORD } + { scanCode DWORD } + { flags DWORD } + { time DWORD } + { dwExtraInfo ULONG_PTR } ; +TYPEDEF: KBDLLHOOKSTRUCT* PKBDLLHOOKSTRUCT +TYPEDEF: KBDLLHOOKSTRUCT* LPKBDLLHOOKSTRUCT + +STRUCT: MSLLHOOKSTRUCT + { pt POINT } + { mouseData DWORD } + { flags DWORD } + { time DWORD } + { dwExtraInfo ULONG_PTR } ; +TYPEDEF: MSLLHOOKSTRUCT* PMSLLHOOKSTRUCT +TYPEDEF: MSLLHOOKSTRUCT* LPMSLLHOOKSTRUCT + CONSTANT: RIM_INPUT 0 CONSTANT: RIM_INPUTSINK 1 @@ -1013,6 +1052,70 @@ STRUCT: CHANGEFILTERSTRUCT { ExtStatus DWORD } ; TYPEDEF: CHANGEFILTERSTRUCT* PCHANGEFILTERSTRUCT +CONSTANT: INPUT_MOUSE 0 +CONSTANT: INPUT_KEYBOARD 1 +CONSTANT: INPUT_HARDWARE 2 + +CONSTANT: XBUTTON1 1 +CONSTANT: XBUTTON2 2 + +CONSTANT: MOUSEEVENTF_ABSOLUTE 0x8000 +CONSTANT: MOUSEEVENTF_HWHEEL 0x01000 +CONSTANT: MOUSEEVENTF_MOVE 0x0001 +CONSTANT: MOUSEEVENTF_MOVE_NOCOALESCE 0x2000 +CONSTANT: MOUSEEVENTF_LEFTDOWN 0x0002 +CONSTANT: MOUSEEVENTF_LEFTUP 0x0004 +CONSTANT: MOUSEEVENTF_RIGHTDOWN 0x0008 +CONSTANT: MOUSEEVENTF_RIGHTUP 0x0010 +CONSTANT: MOUSEEVENTF_MIDDLEDOWN 0x0020 +CONSTANT: MOUSEEVENTF_MIDDLEUP 0x0040 +CONSTANT: MOUSEEVENTF_VIRTUALDESK 0x4000 +CONSTANT: MOUSEEVENTF_WHEEL 0x0800 +CONSTANT: MOUSEEVENTF_XDOWN 0x0080 +CONSTANT: MOUSEEVENTF_XUP 0x0100 + +STRUCT: MOUSEINPUT + { dx LONG } + { dy LONG } + { mouseData DWORD } + { dwFlags DWORD } + { time DWORD } + { dwExtraInfo ULONG_PTR } ; +TYPEDEF: MOUSEINPUT* PMOUSEINPUT + +CONSTANT: KEYEVENTF_EXTENDEDKEY 1 +CONSTANT: KEYEVENTF_KEYUP 2 +CONSTANT: KEYEVENTF_UNICODE 4 +CONSTANT: KEYEVENTF_SCANCODE 8 + + +STRUCT: KEYBDINPUT + { wVk WORD } + { wScan WORD } + { dwFlags DWORD } + { time DWORD } + { dwExtraInfo ULONG_PTR } ; +TYPEDEF: KEYBDINPUT* PKEYBDINPUT + +STRUCT: HARDWAREINPUT + { uMsg DWORD } + { wParamL WORD } + { wParamH WORD } ; +TYPEDEF: HARDWAREINPUT* PHARDWAREINPUT + + +UNION-STRUCT: ANYINPUT + { mi MOUSEINPUT } + { ki KEYBDINPUT } + { hi HARDWAREINPUT } ; + +STRUCT: INPUT + { type DWORD } + { input ANYINPUT } ; +TYPEDEF: INPUT* PINPUT +TYPEDEF: INPUT* LPINPUT + + CONSTANT: LR_DEFAULTCOLOR 0x00 CONSTANT: LR_MONOCHROME 0x01 CONSTANT: LR_COLOR 0x02 @@ -1192,6 +1295,8 @@ CONSTANT: SM_MEDIACENTER 87 CONSTANT: SM_CMETRICS 88 CONSTANT: SM_REMOTESESSION 0X1000 +CONSTANT: DF_ALLOWOTHERACCOUNTHOOK 1 + LIBRARY: user32 FUNCTION: HKL ActivateKeyboardLayout ( HKL hkl, UINT Flags ) @@ -1224,7 +1329,7 @@ FUNCTION: HDC BeginPaint ( HWND hwnd, LPPAINTSTRUCT lpPaint ) ! FUNCTION: CallMsgFilter ! FUNCTION: CallMsgFilterA ! FUNCTION: CallMsgFilterW -! FUNCTION: CallNextHookEx +FUNCTION: LRESULT CallNextHookEx ( HHOOK hhk, int nCode, WPARAM wParam, LPARAM lParam ) ! FUNCTION: CallWindowProcA ! FUNCTION: CallWindowProcW ! FUNCTION: CascadeChildWindows @@ -1291,7 +1396,8 @@ ALIAS: CreateAcceleratorTable CreateAcceleratorTableW ! FUNCTION: CreateCaret ! FUNCTION: CreateCursor ! FUNCTION: CreateDesktopA -! FUNCTION: CreateDesktopW +FUNCTION: HDESK CreateDesktopW ( LPCTSTR lpszDesktop, LPCTSTR lpszDevice, DEVMODE* pDevmode, DWORD dwFlags, ACCESS_MASK dwDesiredAccess, LPSECURITY_ATTRIBUTES lpsa ) +ALIAS: CreateDesktop CreateDesktopW ! FUNCTION: CreateDialogIndirectParamA ! FUNCTION: CreateDialogIndirectParamAorW ! FUNCTION: CreateDialogIndirectParamW @@ -1441,7 +1547,7 @@ FUNCTION: BOOL EndPaint ( HWND hWnd, PAINTSTRUCT* lpPaint ) FUNCTION: UINT EnumClipboardFormats ( UINT format ) ! FUNCTION: EnumDesktopsA ! FUNCTION: EnumDesktopsW -! FUNCTION: EnumDesktopWindows +FUNCTION: BOOL EnumDesktopWindows ( HDESK hDesktop, WNDENUMPROC lpFn, LPARAM lParam ) ! FUNCTION: EnumDisplayDevicesA ! FUNCTION: EnumDisplayDevicesW ! FUNCTION: BOOL EnumDisplayMonitors ( HDC hdc, LPCRECT lprcClip, MONITORENUMPROC lpfnEnum, LPARAM dwData ) @@ -1455,7 +1561,7 @@ ALIAS: EnumDisplaySettings EnumDisplaySettingsW ! FUNCTION: EnumPropsExW ! FUNCTION: EnumPropsW ! FUNCTION: EnumThreadWindows -! FUNCTION: EnumWindows +FUNCTION: BOOL EnumWindows ( WNDENUMPROC lpEnumFunc, LPARAM lParam ) ! FUNCTION: EnumWindowStationsA ! FUNCTION: EnumWindowStationsW ! FUNCTION: EqualRect @@ -1463,8 +1569,11 @@ ALIAS: EnumDisplaySettings EnumDisplaySettingsW ! FUNCTION: ExitWindowsEx FUNCTION: int FillRect ( HDC hDC, RECT* lprc, HBRUSH hbr ) FUNCTION: HWND FindWindowA ( c-string lpClassName, c-string lpWindowName ) +FUNCTION: HWND FindWindowW ( c-string lpClassName, c-string lpWindowName ) +ALIAS: FindWindow FindWindowW FUNCTION: HWND FindWindowExA ( HWND hwndParent, HWND childAfter, c-string lpClassName, c-string lpWindowName ) -! FUNCTION: FindWindowExW +FUNCTION: HWND FindWindowExW ( HWND hwndParent, HWND hwndChildAfter, c-string lpszClass, c-string lpszWindow ) +ALIAS: FindWindowEx FindWindowExW ! FUNCTION: FindWindowW ! FUNCTION: FlashWindow ! FUNCTION: FlashWindowEx @@ -1509,16 +1618,17 @@ FUNCTION: DWORD GetClipboardSequenceNumber ( ) ! FUNCTION: GetCursor ! FUNCTION: GetCursorFrameInfo ! FUNCTION: GetCursorInfo -! FUNCTION: GetCursorPos +FUNCTION: BOOL GetCursorPos ( LPPOINT lpPoint ) FUNCTION: HDC GetDC ( HWND hWnd ) FUNCTION: HDC GetDCEx ( HWND hWnd, HRGN hrgnClip, DWORD flags ) FUNCTION: HWND GetDesktopWindow ( ) ! FUNCTION: GetDialogBaseUnits ! FUNCTION: GetDlgCtrlID -! FUNCTION: GetDlgItem +FUNCTION: HWND GetDlgItem ( HWND hDlg, int nIDDlgItem ) ! FUNCTION: GetDlgItemInt ! FUNCTION: GetDlgItemTextA -! FUNCTION: GetDlgItemTextW +FUNCTION: UINT GetDlgItemTextW ( HWND hDlg, int nIDDlgItem, LPTSTR lpString, int nMaxCount ) +ALIAS: GetDlgItemText GetDlgItemTextW FUNCTION: uint GetDoubleClickTime ( ) FUNCTION: HWND GetFocus ( ) FUNCTION: HWND GetForegroundWindow ( ) @@ -1529,7 +1639,7 @@ FUNCTION: HWND GetForegroundWindow ( ) ! FUNCTION: GetInputState ! FUNCTION: GetInternalWindowPos ! FUNCTION: GetKBCodePage -! FUNCTION: GetKeyboardLayout +FUNCTION: HKL GetKeyboardLayout ( DWORD idThread ) ! FUNCTION: GetKeyboardLayoutList ! FUNCTION: GetKeyboardLayoutNameA ! FUNCTION: GetKeyboardLayoutNameW @@ -1560,7 +1670,7 @@ FUNCTION: SHORT GetKeyState ( int nVirtKey ) FUNCTION: BOOL GetMessageW ( LPMSG lpMsg, HWND hWnd, UINT wMsgFilterMin, UINT wMsgFilterMax ) ALIAS: GetMessage GetMessageW -! FUNCTION: GetMessageExtraInfo +FUNCTION: LPARAM GetMessageExtraInfo ( ) ! FUNCTION: GetMessagePos ! FUNCTION: GetMessageTime ! FUNCTION: GetMonitorInfoA @@ -1601,7 +1711,7 @@ FUNCTION: HMENU GetSystemMenu ( HWND hWnd, BOOL bRevert ) ! FUNCTION: GetTabbedTextExtentA ! FUNCTION: GetTabbedTextExtentW ! FUNCTION: GetTaskmanWindow -! FUNCTION: GetThreadDesktop +FUNCTION: HDESK GetThreadDesktop ( DWORD dwThreadId ) ! FUNCTION: GetTitleBarInfo @@ -1631,7 +1741,9 @@ ALIAS: GetWindowLongPtr GetWindowLongPtrW FUNCTION: BOOL GetWindowRect ( HWND hWnd, LPRECT lpRect ) ! FUNCTION: GetWindowRgn ! FUNCTION: GetWindowRgnBox -FUNCTION: int GetWindowTextA ( HWND hWnd, char* lpString, int nMaxCount ) +! FUNCTION: int GetWindowTextA ( HWND hWnd, char* lpString, int nMaxCount ) +FUNCTION: int GetWindowTextW ( HWND hWnd, LPTSTR lpString, int nMaxCount ) +ALIAS: GetWindowText GetWindowTextW ! FUNCTION: GetWindowTextLengthA ! FUNCTION: GetWindowTextLengthW ! FUNCTION: GetWindowTextW @@ -1737,7 +1849,7 @@ ALIAS: MapVirtualKey MapVirtualKeyW FUNCTION: UINT MapVirtualKeyExW ( UINT uCode, UINT uMapType, HKL dwhkl ) ALIAS: MapVirtualKeyEx MapVirtualKeyExW -! FUNCTION: MapWindowPoints +FUNCTION: int MapWindowPoints ( HWND hWndFrom, HWND hWndTo, LPPOINT lpPoints, UINT cPoints ) ! FUNCTION: MB_GetString ! FUNCTION: MBToWCSEx ! FUNCTION: MenuItemFromPoint @@ -1813,9 +1925,10 @@ FUNCTION: BOOL MoveWindow ( ! FUNCTION: OffsetRect FUNCTION: BOOL OpenClipboard ( HWND hWndNewOwner ) ! FUNCTION: OpenDesktopA -! FUNCTION: OpenDesktopW +FUNCTION: HDESK OpenDesktopW ( LPTSTR lpsazDesktop, DWORD dwFlags, BOOL fInherit, ACCESS_MASK dwDesiredAccess ) +ALIAS: OpenDesktop OpenDesktopW ! FUNCTION: OpenIcon -! FUNCTION: OpenInputDesktop +FUNCTION: HDESK OpenInputDesktop ( DWORD dwFlags, BOOL fInherit, ACCESS_MASK dwDesiredAccess ) ! FUNCTION: OpenWindowStationA ! FUNCTION: OpenWindowStationW ! FUNCTION: PackDDElParam @@ -1881,7 +1994,7 @@ FUNCTION: int ReleaseDC ( HWND hWnd, HDC hDC ) ! FUNCTION: ReplyMessage ! FUNCTION: ResolveDesktopForWOW ! FUNCTION: ReuseDDElParam -! FUNCTION: ScreenToClient +FUNCTION: BOOL ScreenToClient ( HWND hWnd, LPPOINT lpPoint ) ! FUNCTION: ScrollChildren ! FUNCTION: ScrollDC ! FUNCTION: ScrollWindow @@ -1890,7 +2003,7 @@ FUNCTION: int ReleaseDC ( HWND hWnd, HDC hDC ) ! FUNCTION: SendDlgItemMessageW ! FUNCTION: SendIMEMessageExA ! FUNCTION: SendIMEMessageExW -! FUNCTION: UINT SendInput ( UINT nInputs, LPINPUT pInputs, int cbSize ) +FUNCTION: UINT SendInput ( UINT nInputs, LPINPUT pInputs, int cbSize ) FUNCTION: LRESULT SendMessageW ( HWND hWnd, UINT msg, WPARAM wParam, LPARAM lParam ) ALIAS: SendMessage SendMessageW ! FUNCTION: SendMessageCallbackA @@ -1975,14 +2088,18 @@ FUNCTION: LONG_PTR SetWindowLongPtrW ( HWND hWnd, int nIndex, LONG_PTR dwNewLong ALIAS: SetWindowLongPtr SetWindowLongPtrW : HWND_BOTTOM ( -- alien ) 1 ; +: HWND_MESSAGE ( -- alien ) -3 ; : HWND_NOTOPMOST ( -- alien ) -2 ; CONSTANT: HWND_TOP f : HWND_TOPMOST ( -- alien ) -1 ; +: HWND_DESKTOP ( -- alien ) 0 ; +: HWND_BROADCAST ( -- alien ) 65535 ; ! FUNCTION: SetWindowRgn ! FUNCTION: SetWindowsHookA ! FUNCTION: SetWindowsHookExA -! FUNCTION: SetWindowsHookExW +FUNCTION: HHOOK SetWindowsHookExW ( int idHook, HOOKPROC lpfn, HINSTANCE hMod, DWORD dwThreadId ) +ALIAS: SetWindowsHookEx SetWindowsHookExW ! FUNCTION: SetWindowsHookW ! FUNCTION: SetWindowStationUser ! FUNCTION: SetWindowTextA @@ -2028,7 +2145,7 @@ ALIAS: TranslateAccelerator TranslateAcceleratorW FUNCTION: BOOL TranslateMessage ( MSG* lpMsg ) ! FUNCTION: UnhookWindowsHook -! FUNCTION: UnhookWindowsHookEx +FUNCTION: BOOL UnhookWindowsHookEx ( HHOOK hhk ) ! FUNCTION: UnhookWinEvent ! FUNCTION: UnionRect ! FUNCTION: UnloadKeyboardLayout @@ -2056,8 +2173,10 @@ FUNCTION: BOOL UpdateWindow ( HWND hWnd ) ! FUNCTION: ValidateRgn ! FUNCTION: VkKeyScanA ! FUNCTION: VkKeyScanExA -! FUNCTION: VkKeyScanExW -! FUNCTION: VkKeyScanW +FUNCTION: SHORT VkKeyScanExW ( TCHAR ch, HKL dwhkl ) +ALIAS: VkKeyScanEx VkKeyScanExW +FUNCTION: SHORT VkKeyScanW ( TCHAR ch ) +ALIAS: VkKeyScan VkKeyScanW ! FUNCTION: VRipOutput ! FUNCTION: VTagOutput ! FUNCTION: WaitForInputIdle From 123c5133f04fe1dafa2abd88b8e03b9eace0023d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 17 Mar 2018 18:15:30 -0500 Subject: [PATCH 8/9] windows.com.wrapper: Fix up docs example so it runs. --- basis/windows/com/wrapper/wrapper-docs.factor | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/basis/windows/com/wrapper/wrapper-docs.factor b/basis/windows/com/wrapper/wrapper-docs.factor index ea77f31c4d..154c7870bc 100644 --- a/basis/windows/com/wrapper/wrapper-docs.factor +++ b/basis/windows/com/wrapper/wrapper-docs.factor @@ -7,6 +7,7 @@ HELP: { $values { "implementations" "an assoc relating COM interface names to arrays of quotations implementing that interface" } { "wrapper" "a " { $link com-wrapper } " tuple" } } { $description "Constructs a " { $link com-wrapper } " tuple. Each key in the " { $snippet "implementations" } " assoc must be the name of an interface defined with " { $link POSTPONE: COM-INTERFACE: } ". The corresponding value must be an array of quotations implementing the methods of that interface in order, including those of its parent interfaces. The " { $snippet "IUnknown" } " methods (" { $link IUnknown::QueryInterface } ", " { $link IUnknown::AddRef } ", and " { $link IUnknown::Release } ") will be defined automatically and must not be specified in the array. These quotations should have stack effects mirroring those of the interface methods being implemented; for example, a method " { $snippet "void foobar ( int foo, int bar )" } " should be implemented with a quotation of effect " { $snippet "( this foo bar -- )" } ". The " { $snippet "this" } " parameter (that is, the leftmost parameter of any COM method) will be automatically converted from an alien pointer to the underlying Factor object before the quotation is invoked.\n\nThe resulting wrapper can be applied to a Factor object using the " { $link com-wrap } " word. The COM interface pointer returned by " { $snippet "com-wrap" } " can then be passed to C functions requiring a COM object as a parameter. The vtables constructed by " { $snippet "" } " are stored on the non-GC heap in order to be accessible to C functions; when the wrapper object and its vtables are no longer needed, the object's resources must be freed using " { $link dispose } ".\n\nExample:" } { $code " +<< COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc} HRESULT returnOK ( ) HRESULT returnError ( ) ; @@ -18,19 +19,21 @@ COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd} COM-INTERFACE: IUnrelated IUnknown {b06ac3f4-30e4-406b-a7cd-c29cead4552c} int xPlus ( int y ) int xMulAdd ( int mul, int add ) ; - +>> +<< { - { \"IInherited\" { + { IInherited { [ drop S_OK ] ! ISimple::returnOK [ drop E_FAIL ] ! ISimple::returnError [ x>> ] ! IInherited::getX [ >>x drop ] ! IInherited::setX } } - { \"IUnrelated\" { + { IUnrelated { [ [ x>> ] [ + ] bi* ] ! IUnrelated::xPlus [ [ x>> ] [ * ] [ + ] tri* ] ! IUnrealted::xMulAdd } } -} " } ; +} . ! In your code, set to a variable instead of printing +>>" } ; HELP: com-wrap { $values { "object" "The factor object to wrap" } { "wrapper" "A " { $link com-wrapper } " object" } { "wrapped-object" "A COM object referencing " { $snippet "object" } } } From dc52e28f2fcfda0d73beaf97f6f641473b574288 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 17 Mar 2018 18:34:23 -0500 Subject: [PATCH 9/9] windows.surface-dial: Add surface-dial COM interface. --- basis/windows/surface-dial/authors.txt | 1 + basis/windows/surface-dial/platforms.txt | 1 + .../windows/surface-dial/surface-dial.factor | 106 ++++++++++++++++++ 3 files changed, 108 insertions(+) create mode 100644 basis/windows/surface-dial/authors.txt create mode 100644 basis/windows/surface-dial/platforms.txt create mode 100644 basis/windows/surface-dial/surface-dial.factor diff --git a/basis/windows/surface-dial/authors.txt b/basis/windows/surface-dial/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/windows/surface-dial/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/windows/surface-dial/platforms.txt b/basis/windows/surface-dial/platforms.txt new file mode 100644 index 0000000000..d493d3459b --- /dev/null +++ b/basis/windows/surface-dial/platforms.txt @@ -0,0 +1 @@ +windows \ No newline at end of file diff --git a/basis/windows/surface-dial/surface-dial.factor b/basis/windows/surface-dial/surface-dial.factor new file mode 100644 index 0000000000..36ee5814e0 --- /dev/null +++ b/basis/windows/surface-dial/surface-dial.factor @@ -0,0 +1,106 @@ +! Copyright (C) 2018 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.data alien.syntax +classes.struct kernel multiline namespaces ui windows.com +windows.com.syntax windows.com.wrapper windows.ole32 +windows.types ; +IN: windows.surface-dial + +STRUCT: HSTRING__ + { unused int } ; +TYPEDEF: HSTRING__* HSTRING + +ENUM: TrustLevel + { BaseTrust 0 } + { PartialTrust 1 } + { FullTrust 2 } ; + +COM-INTERFACE: IInspectable IUnknown {AF86E2E0-B12D-4c6a-9C5A-D7AA65101E90} + HRESULT GetIids ( ULONG* iidCount, IID** iids ) + HRESULT GetRuntimeClassName ( HSTRING* className ) + HRESULT GetTrustLevel ( TrustLevel* trustLevel ) +; + +! IInspectable +COM-INTERFACE: IRadialControllerConfigurationInterop IInspectable {787cdaac-3186-476d-87e4-b9374a7b9970} + HRESULT GetForWindow ( HWND hwnd, REFIID riid, void** ppv ) +; + +COM-INTERFACE: IRadialControllerInterop IInspectable {1B0535C9-57AD-45C1-9D79-AD5C34360513} + HRESULT CreateForWindow ( HWND hwnd, REFIID riid, void** ppv ) +; + +<< +SYMBOL: +radial-controller-configuration-wrapper+ +SYMBOL: +radial-controller-wrapper+ +>> + +<< +{ + { + IRadialControllerConfigurationInterop + { + ! HRESULT GetIids ( this, ULONG* iidCount, IID** iids ) + [ 3drop S_OK ] + + ! HRESULT GetRuntimeClassName ( this, HSTRING* className ) + [ 2drop S_OK ] + + ! HRESULT GetTrustLevel ( this, TrustLevel* trustLevel ) + [ 2drop S_OK ] + + ! HRESULT GetForWindow ( this, HWND hwnd, REFIID riid, void** ppv ) + [ + 4drop S_OK + ] + } + } +} +radial-controller-configuration-wrapper+ set-global +>> + +<< +{ + { + IRadialControllerInterop + { + ! HRESULT GetIids ( this, ULONG* iidCount, IID** iids ) + [ 3drop S_OK ] + + ! HRESULT GetRuntimeClassName ( this, HSTRING* className ) + [ 2drop S_OK ] + + ! HRESULT GetTrustLevel ( this, TrustLevel* trustLevel ) + [ 2drop S_OK ] + + ! HRESULT CreateForWindow ( this, HWND hwnd, REFIID riid, void** ppv ) + [ + 4drop S_OK + ] + } + } +} +radial-controller-wrapper+ set-global +>> + +! Does nothing yet +TUPLE: surface-dial ; +C: surface-dial + +: make-radial-controller-configuration ( -- obj ) + +radial-controller-configuration-wrapper+ get com-wrap + IRadialControllerConfigurationInterop-iid com-query-interface [ + topmost-window handle>> hWnd>> + IRadialControllerConfigurationInterop-iid + { void* } [ + IRadialControllerConfigurationInterop::GetForWindow check-ole32-error + ] with-out-parameters + ] with-com-interface ; + +: make-radial-controller ( -- obj ) + +radial-controller-wrapper+ get com-wrap + IRadialControllerInterop-iid com-query-interface [ + topmost-window handle>> hWnd>> + IRadialControllerInterop-iid + { void* } [ + IRadialControllerInterop::CreateForWindow check-ole32-error + ] with-out-parameters + ] with-com-interface ;