steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge commit 'erg/master'

release
Slava Pestov 2007-12-09 22:48:47 -05:00
parent 40e84bd79d 537963ce24
commit 17331c674a
25 changed files with 411 additions and 251 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
core/io/files/files.factor
View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
IN: io.files IN: io.files
USING: io.backend io.files.private io hashtables kernel math USING: io.backend io.files.private io hashtables kernel math
memory namespaces sequences strings arrays definitions system memory namespaces sequences strings assocs arrays definitions
combinators splitting ; system combinators splitting ;
HOOK: <file-reader> io-backend ( path -- stream ) HOOK: <file-reader> io-backend ( path -- stream )
@ -140,3 +140,20 @@ HOOK: binary-roots io-backend ( -- seq )
: find-binary ( str -- path/f ) : find-binary ( str -- path/f )
binary-roots swap find-file ; binary-roots swap find-file ;
<PRIVATE
: append-path ( path files -- paths )
[ path+ ] curry* map ;
: get-paths ( dir -- paths )
dup directory keys append-path ;
: (walk-dir) ( path -- )
dup directory? [
get-paths dup % [ (walk-dir) ] each
] [
drop
] if ;
PRIVATE>
: walk-dir ( path -- seq ) [ (walk-dir) ] { } make ;

3
extra/combinators/lib/lib.factor
View File

@ -70,9 +70,6 @@ MACRO: napply ( n -- )
MACRO: nfirst ( n -- ) MACRO: nfirst ( n -- )
[ [ swap nth ] curry [ keep ] curry ] map concat [ drop ] compose ; [ [ swap nth ] curry [ keep ] curry ] map concat [ drop ] compose ;
: seq>stack ( seq -- )
dup length nfirst ; inline
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: sigma ( seq quot -- n ) [ rot slip + ] curry 0 swap reduce ; : sigma ( seq quot -- n ) [ rot slip + ] curry 0 swap reduce ;

11
extra/editors/editpadpro/editpadpro.factor
View File

@ -1,8 +1,15 @@
USING: definitions kernel parser words sequences math.parser USING: definitions kernel parser words sequences math.parser
namespaces editors io.launcher ; namespaces editors io.launcher windows.shell32 io.files
io.paths strings ;
IN: editors.editpadpro IN: editors.editpadpro
: editpadpro-path
\ editpadpro-path get-global [
program-files "JGsoft" path+ walk-dir
[ >lower "editpadpro.exe" tail? ] find nip
] unless* ;
: editpadpro ( file line -- ) : editpadpro ( file line -- )
[ "editpadpro.exe /l" % # " \"" % % "\"" % ] "" make run-process ; [ editpadpro-path % " /l" % # " \"" % % "\"" % ] "" make run-detached ;
[ editpadpro ] edit-hook set-global [ editpadpro ] edit-hook set-global

13
extra/editors/editplus/editplus.factor Normal file → Executable file
View File

@ -1,12 +1,15 @@
USING: editors io.launcher math.parser namespaces ; USING: editors io.files io.launcher kernel math.parser
namespaces sequences windows.shell32 ;
IN: editors.editplus IN: editors.editplus
: editplus-path ( -- path )
\ editplus-path get-global [
program-files "\\EditPlus 2\\editplus.exe" append
] unless* ;
: editplus ( file line -- ) : editplus ( file line -- )
[ [
\ editplus get-global % " -cursor " % # " " % % editplus-path % " -cursor " % # " " % %
] "" make run-detached ; ] "" make run-detached ;
! Put in your .factor-boot-rc
! "c:\\Program Files\\EditPlus\\editplus.exe" \ editplus set-global
[ editplus ] edit-hook set-global [ editplus ] edit-hook set-global

10
extra/editors/emeditor/emeditor.factor Normal file → Executable file
View File

@ -1,9 +1,15 @@
USING: editors io.launcher kernel math.parser namespaces ; USING: editors hardware-info.windows io.files io.launcher
kernel math.parser namespaces sequences windows.shell32 ;
IN: editors.emeditor IN: editors.emeditor
: emeditor-path ( -- path )
\ emeditor-path get-global [
program-files "\\EmEditor\\EmEditor.exe" path+
] unless* ;
: emeditor ( file line -- ) : emeditor ( file line -- )
[ [
\ emeditor get-global % " /l " % # emeditor-path % " /l " % #
" " % "\"" % % "\"" % " " % "\"" % % "\"" %
] "" make run-detached ; ] "" make run-detached ;

14
extra/editors/gvim/gvim.factor
View File

@ -1,10 +1,18 @@
USING: kernel math math.parser namespaces editors.vim ; USING: io.backend io.files kernel math math.parser
namespaces editors.vim sequences system ;
IN: editors.gvim IN: editors.gvim
TUPLE: gvim ; TUPLE: gvim ;
HOOK: gvim-path io-backend ( -- path )
M: gvim vim-command ( file line -- string ) M: gvim vim-command ( file line -- string )
[ "\"" % vim-path get % "\" \"" % swap % "\" +" % # ] "" make ; [ "\"" % gvim-path % "\" \"" % swap % "\" +" % # ] "" make ;
t vim-detach set-global ! don't block the ui
T{ gvim } vim-editor set-global T{ gvim } vim-editor set-global
"gvim" vim-path set-global
USE-IF: unix? editors.gvim.unix
USE-IF: windows? editors.gvim.windows

7
extra/editors/gvim/unix/unix.factor Normal file
View File

@ -0,0 +1,7 @@
USING: editors.gvim io.unix.backend kernel namespaces ;
IN: editors.gvim.unix
M: unix-io gvim-path
\ gvim-path get-global [
"gvim"
] unless* ;

8
extra/editors/gvim/windows/windows.factor Normal file
View File

@ -0,0 +1,8 @@
USING: editors.gvim io.files io.windows kernel namespaces
sequences windows.shell32 ;
IN: editors.gvim.windows
M: windows-io gvim-path
\ gvim-path get-global [
program-files walk-dir [ "gvim.exe" tail? ] find nip
] unless* ;

14
extra/editors/notepadpp/notepadpp.factor
View File

@ -1,13 +1,15 @@
USING: editors io.launcher math.parser namespaces ; USING: editors io.files io.launcher kernel math.parser
namespaces windows.shell32 ;
IN: editors.notepadpp IN: editors.notepadpp
: notepadpp-path
\ notepadpp-path get-global [
program-files "notepad++\\notepad++.exe" path+
] unless* ;
: notepadpp ( file line -- ) : notepadpp ( file line -- )
[ [
\ notepadpp get-global % " -n" % # " " % % notepadpp-path % " -n" % # " " % %
] "" make run-detached ; ] "" make run-detached ;
! Put in your .factor-boot-rc
! "c:\\Program Files\\notepad++\\notepad++.exe" \ notepadpp set-global
! "k:\\Program Files (x86)\\notepad++\\notepad++.exe" \ notepadpp set-global
[ notepadpp ] edit-hook set-global [ notepadpp ] edit-hook set-global

10
extra/editors/ted-notepad/ted-notepad.factor
View File

@ -1,9 +1,15 @@
USING: editors io.launcher kernel math.parser namespaces ; USING: editors io.files io.launcher kernel math.parser
namespaces sequences windows.shell32 ;
IN: editors.ted-notepad IN: editors.ted-notepad
: ted-notepad-path
\ ted-notepad-path get-global [
program-files "\\TED Notepad\\TedNPad.exe" path+
] unless* ;
: ted-notepad ( file line -- ) : ted-notepad ( file line -- )
[ [
\ ted-notepad get-global % " /l" % # ted-notepad-path % " /l" % #
" " % % " " % %
] "" make run-detached ; ] "" make run-detached ;

13
extra/editors/ultraedit/ultraedit.factor
View File

@ -1,12 +1,17 @@
USING: editors io.launcher kernel math.parser namespaces ; USING: editors io.files io.launcher kernel math.parser
namespaces sequences windows.shell32 ;
IN: editors.ultraedit IN: editors.ultraedit
: ultraedit-path ( -- path )
\ ultraedit-path get-global [
program-files
"\\IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" path+
] unless* ;
: ultraedit ( file line -- ) : ultraedit ( file line -- )
[ [
\ ultraedit get-global % " " % swap % "/" % # "/1" % ultraedit-path % " " % swap % "/" % # "/1" %
] "" make run-detached ; ] "" make run-detached ;
! Put the path in your .factor-boot-rc
! "K:\\Program Files (x86)\\IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" \ ultraedit set-global
[ ultraedit ] edit-hook set-global [ ultraedit ] edit-hook set-global

10
extra/editors/wordpad/wordpad.factor
View File

@ -2,12 +2,14 @@ USING: editors hardware-info.windows io.launcher kernel
math.parser namespaces sequences windows.shell32 ; math.parser namespaces sequences windows.shell32 ;
IN: editors.wordpad IN: editors.wordpad
: wordpad-path ( -- path )
\ wordpad-path get [
program-files "\\Windows NT\\Accessories\\wordpad.exe" append
] unless* ;
: wordpad ( file line -- ) : wordpad ( file line -- )
[ [
\ wordpad get-global % drop " " % "\"" % % "\"" % wordpad-path % drop " " % "\"" % % "\"" %
] "" make run-detached ; ] "" make run-detached ;
program-files "\\Windows NT\\Accessories\\wordpad.exe" append
\ wordpad set-global
[ wordpad ] edit-hook set-global [ wordpad ] edit-hook set-global

16
extra/id3/id3.factor
View File

@ -2,7 +2,9 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
! !
USING: arrays combinators io io.binary io.files io.utf16 kernel math math.parser namespaces sequences splitting strings assocs ; USING: arrays combinators io io.binary io.files io.paths
io.utf16 kernel math math.parser namespaces sequences
splitting strings assocs ;
IN: id3 IN: id3
@ -121,18 +123,6 @@ C: <extended-header> extended-header
: id3v2 ( filename -- tag/f ) : id3v2 ( filename -- tag/f )
<file-reader> [ read-tag ] with-stream ; <file-reader> [ read-tag ] with-stream ;
: append-path ( path files -- paths )
[ path+ ] curry* map ;
: get-paths ( dir -- paths )
dup directory keys append-path ;
: (walk-dir) ( path -- )
dup directory? [ get-paths dup % [ (walk-dir) ] each ] [ drop ] if ;
: walk-dir ( path -- seq )
[ (walk-dir) ] { } make ;
: file? ( path -- ? ) : file? ( path -- ? )
stat 3drop not ; stat 3drop not ;

24
extra/io/paths/paths.factor Normal file
View File

@ -0,0 +1,24 @@
USING: assocs io.files kernel namespaces sequences ;
IN: io.paths
: find-file ( seq str -- path/f )
[
[ path+ exists? ] curry find nip
] keep over [ path+ ] [ drop ] if ;
<PRIVATE
: append-path ( path files -- paths )
[ path+ ] curry* map ;
: get-paths ( dir -- paths )
dup directory keys append-path ;
: (walk-dir) ( path -- )
dup directory? [
get-paths dup % [ (walk-dir) ] each
] [
drop
] if ;
PRIVATE>
: walk-dir ( path -- seq ) [ (walk-dir) ] { } make ;

18
extra/io/unix/files/files.factor
View File

@ -38,21 +38,3 @@ M: unix-io make-directory ( path -- )
M: unix-io delete-directory ( path -- ) M: unix-io delete-directory ( path -- )
rmdir io-error ; rmdir io-error ;
M: unix-io binary-roots ( -- seq )
{
"/bin" "/sbin"
"/usr/bin" "/usr/sbin"
"/usr/local/bin" "/usr/local/sbin"
"/opt/local/bin" "/opt/local/sbin"
"~/bin"
} ;
M: unix-io library-roots ( -- seq )
{
"/lib"
"/usr/lib"
"/usr/local/lib"
"/opt/local/lib"
"/lib64"
} ;

5
extra/io/windows/nt/backend/backend.factor
View File

@ -27,7 +27,7 @@ M: windows-nt-io normalize-pathname ( string -- string )
{ [ dup ".\\" head? ] [ { [ dup ".\\" head? ] [
>r unicode-prefix cwd r> 1 tail 3append >r unicode-prefix cwd r> 1 tail 3append
] } ] }
! c:\\ ! c:\\foo
{ [ dup 1 tail ":" head? ] [ >r unicode-prefix r> append ] } { [ dup 1 tail ":" head? ] [ >r unicode-prefix r> append ] }
! \\\\?\\c:\\foo ! \\\\?\\c:\\foo
{ [ dup unicode-prefix head? ] [ ] } { [ dup unicode-prefix head? ] [ ] }
@ -38,7 +38,8 @@ M: windows-nt-io normalize-pathname ( string -- string )
dup first CHAR: \\ = [ CHAR: \\ , ] unless % dup first CHAR: \\ = [ CHAR: \\ , ] unless %
] "" make ] "" make
] } ] }
} cond [ "/\\." member? ] right-trim ; } cond [ "/\\." member? ] right-trim
dup peek CHAR: : = [ "\\" append ] when ;
SYMBOL: io-hash SYMBOL: io-hash

10
extra/io/windows/windows.factor
View File

@ -11,16 +11,6 @@ TUPLE: windows-nt-io ;
TUPLE: windows-ce-io ; TUPLE: windows-ce-io ;
UNION: windows-io windows-nt-io windows-ce-io ; UNION: windows-io windows-nt-io windows-ce-io ;
M: windows-io library-roots ( -- seq )
[
windows ,
] { } make ;
M: windows-io binary-roots ( -- seq )
[
windows ,
] { } make ;
M: windows-io destruct-handle CloseHandle drop ; M: windows-io destruct-handle CloseHandle drop ;
M: windows-io destruct-socket closesocket drop ; M: windows-io destruct-socket closesocket drop ;

2
extra/shuffle/shuffle.factor
View File

@ -29,4 +29,6 @@ MACRO: ntuck ( n -- ) 2 + [ dup , -nrot ] bake ;
: 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline : 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline
: 4drop ( a b c d -- ) 3drop drop ; inline
: tuckd ( x y z -- z x y z ) 2 ntuck ; inline : tuckd ( x y z -- z x y z ) 2 ntuck ; inline

10
extra/ui/tools/tools.factor
View File

@ -67,11 +67,11 @@ M: workspace model-changed
: com-profiler profiler-gadget select-tool ; : com-profiler profiler-gadget select-tool ;
workspace "tool-switching" f { workspace "tool-switching" f {
{ T{ key-down f { C+ } "1" } com-listener } { T{ key-down f { A+ } "1" } com-listener }
{ T{ key-down f { C+ } "2" } com-browser } { T{ key-down f { A+ } "2" } com-browser }
{ T{ key-down f { C+ } "3" } com-inspector } { T{ key-down f { A+ } "3" } com-inspector }
{ T{ key-down f { C+ } "4" } com-walker } { T{ key-down f { A+ } "4" } com-walker }
{ T{ key-down f { C+ } "5" } com-profiler } { T{ key-down f { A+ } "5" } com-profiler }
} define-command-map } define-command-map
\ workspace-window \ workspace-window

10
extra/ui/windows/windows.factor
View File

@ -210,6 +210,9 @@ SYMBOL: hWnd
hWnd get window-focus send-gesture hWnd get window-focus send-gesture
drop ; drop ;
: handle-wm-syscommand ( hWnd uMsg wParam lParam -- n )
dup alpha? [ 4drop 0 ] [ DefWindowProc ] if ;
: cleanup-window ( handle -- ) : cleanup-window ( handle -- )
dup win-title [ free ] when* dup win-title [ free ] when*
dup win-hRC wglDeleteContext win32-error=0/f dup win-hRC wglDeleteContext win32-error=0/f
@ -295,17 +298,17 @@ M: windows-ui-backend (close-window)
: handle-wm-cancelmode ( hWnd uMsg wParam lParam -- ) : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
#! message sent if windows needs application to stop dragging #! message sent if windows needs application to stop dragging
3drop drop release-capture ; 4drop release-capture ;
: handle-wm-mouseleave ( hWnd uMsg wParam lParam -- ) : handle-wm-mouseleave ( hWnd uMsg wParam lParam -- )
#! message sent if mouse leaves main application #! message sent if mouse leaves main application
3drop drop forget-rollover ; 4drop forget-rollover ;
! return 0 if you handle the message, else just let DefWindowProc return its val ! return 0 if you handle the message, else just let DefWindowProc return its val
: ui-wndproc ( -- object ) : ui-wndproc ( -- object )
"uint" { "void*" "uint" "long" "long" } "stdcall" [ "uint" { "void*" "uint" "long" "long" } "stdcall" [
[ [
pick pick ! global [ dup windows-message-name . ] bind
{ {
{ [ dup WM_CLOSE = ] [ drop handle-wm-close 0 ] } { [ dup WM_CLOSE = ] [ drop handle-wm-close 0 ] }
{ [ dup WM_PAINT = ] { [ dup WM_PAINT = ]
@ -320,6 +323,7 @@ M: windows-ui-backend (close-window)
{ [ dup WM_KEYUP = over WM_SYSKEYUP = or ] { [ dup WM_KEYUP = over WM_SYSKEYUP = or ]
[ drop 4dup handle-wm-keyup DefWindowProc ] } [ drop 4dup handle-wm-keyup DefWindowProc ] }
{ [ dup WM_SYSCOMMAND = ] [ drop handle-wm-syscommand ] }
{ [ dup WM_SETFOCUS = ] [ drop handle-wm-set-focus 0 ] } { [ dup WM_SETFOCUS = ] [ drop handle-wm-set-focus 0 ] }
{ [ dup WM_KILLFOCUS = ] [ drop handle-wm-kill-focus 0 ] } { [ dup WM_KILLFOCUS = ] [ drop handle-wm-kill-focus 0 ] }

4
extra/windows/messages/messages.factor
View File

@ -13,7 +13,7 @@ SYMBOL: windows-messages
word [ word-name ] keep execute maybe-create-windows-messages word [ word-name ] keep execute maybe-create-windows-messages
windows-messages get set-at ; parsing windows-messages get set-at ; parsing
: get-windows-message-name ( n -- name ) : windows-message-name ( n -- name )
windows-messages get at* [ drop "unknown message" ] unless ; windows-messages get at* [ drop "unknown message" ] unless ;
: WM_NULL HEX: 0000 ; inline add-windows-message : WM_NULL HEX: 0000 ; inline add-windows-message
@ -107,6 +107,8 @@ SYMBOL: windows-messages
: WM_NCXBUTTONDOWN HEX: 00AB ; inline add-windows-message : WM_NCXBUTTONDOWN HEX: 00AB ; inline add-windows-message
: WM_NCXBUTTONUP HEX: 00AC ; inline add-windows-message : WM_NCXBUTTONUP HEX: 00AC ; inline add-windows-message
: WM_NCXBUTTONDBLCLK HEX: 00AD ; inline add-windows-message : WM_NCXBUTTONDBLCLK HEX: 00AD ; inline add-windows-message
: WM_NCUAHDRAWCAPTION HEX: 00AE ; inline add-windows-message ! undocumented
: WM_NCUAHDRAWFRAME HEX: 00AF ; inline add-windows-message ! undocumented
: WM_INPUT HEX: 00FF ; inline add-windows-message : WM_INPUT HEX: 00FF ; inline add-windows-message
: WM_KEYFIRST HEX: 0100 ; inline add-windows-message : WM_KEYFIRST HEX: 0100 ; inline add-windows-message
: WM_KEYDOWN HEX: 0100 ; inline add-windows-message : WM_KEYDOWN HEX: 0100 ; inline add-windows-message

6
extra/windows/types/types.factor
View File

@ -333,4 +333,8 @@ C-STRUCT: LVFINDINFO
{ "POINT" "pt" } { "POINT" "pt" }
{ "uint" "vkDirection" } ; { "uint" "vkDirection" } ;
C-STRUCT: ACCEL
{ "BYTE" "fVirt" }
{ "WORD" "key" }
{ "WORD" "cmd" } ;
TYPEDEF: ACCEL* LPACCEL

361
extra/windows/user32/user32.factor
View File

@ -5,43 +5,43 @@ windows.types shuffle ;
IN: windows.user32 IN: windows.user32
! HKL for ActivateKeyboardLayout ! HKL for ActivateKeyboardLayout
: HKL_PREV 0 ; : HKL_PREV 0 ; inline
: HKL_NEXT 1 ; : HKL_NEXT 1 ; inline
: CW_USEDEFAULT HEX: 80000000 ; : CW_USEDEFAULT HEX: 80000000 ; inline
: WS_OVERLAPPED HEX: 00000000 ; : WS_OVERLAPPED HEX: 00000000 ; inline
: WS_POPUP HEX: 80000000 ; : WS_POPUP HEX: 80000000 ; inline
: WS_CHILD HEX: 40000000 ; : WS_CHILD HEX: 40000000 ; inline
: WS_MINIMIZE HEX: 20000000 ; : WS_MINIMIZE HEX: 20000000 ; inline
: WS_VISIBLE HEX: 10000000 ; : WS_VISIBLE HEX: 10000000 ; inline
: WS_DISABLED HEX: 08000000 ; : WS_DISABLED HEX: 08000000 ; inline
: WS_CLIPSIBLINGS HEX: 04000000 ; : WS_CLIPSIBLINGS HEX: 04000000 ; inline
: WS_CLIPCHILDREN HEX: 02000000 ; : WS_CLIPCHILDREN HEX: 02000000 ; inline
: WS_MAXIMIZE HEX: 01000000 ; : WS_MAXIMIZE HEX: 01000000 ; inline
: WS_CAPTION HEX: 00C00000 ; ! /* WS_BORDER | WS_DLGFRAME */ : WS_CAPTION HEX: 00C00000 ; inline
: WS_BORDER HEX: 00800000 ; : WS_BORDER HEX: 00800000 ; inline
: WS_DLGFRAME HEX: 00400000 ; : WS_DLGFRAME HEX: 00400000 ; inline
: WS_VSCROLL HEX: 00200000 ; : WS_VSCROLL HEX: 00200000 ; inline
: WS_HSCROLL HEX: 00100000 ; : WS_HSCROLL HEX: 00100000 ; inline
: WS_SYSMENU HEX: 00080000 ; : WS_SYSMENU HEX: 00080000 ; inline
: WS_THICKFRAME HEX: 00040000 ; : WS_THICKFRAME HEX: 00040000 ; inline
: WS_GROUP HEX: 00020000 ; : WS_GROUP HEX: 00020000 ; inline
: WS_TABSTOP HEX: 00010000 ; : WS_TABSTOP HEX: 00010000 ; inline
: WS_MINIMIZEBOX HEX: 00020000 ; : WS_MINIMIZEBOX HEX: 00020000 ; inline
: WS_MAXIMIZEBOX HEX: 00010000 ; : WS_MAXIMIZEBOX HEX: 00010000 ; inline
! Common window styles ! Common window styles
: WS_OVERLAPPEDWINDOW WS_OVERLAPPED WS_CAPTION WS_SYSMENU WS_THICKFRAME WS_MINIMIZEBOX WS_MAXIMIZEBOX bitor bitor bitor bitor bitor ; : WS_OVERLAPPEDWINDOW WS_OVERLAPPED WS_CAPTION WS_SYSMENU WS_THICKFRAME WS_MINIMIZEBOX WS_MAXIMIZEBOX bitor bitor bitor bitor bitor ; foldable inline
: WS_POPUPWINDOW WS_POPUP WS_BORDER WS_SYSMENU bitor bitor ; : WS_POPUPWINDOW WS_POPUP WS_BORDER WS_SYSMENU bitor bitor ; foldable inline
: WS_CHILDWINDOW WS_CHILD ; : WS_CHILDWINDOW WS_CHILD ; inline
: WS_TILED WS_OVERLAPPED ; : WS_TILED WS_OVERLAPPED ; inline
: WS_ICONIC WS_MINIMIZE ; : WS_ICONIC WS_MINIMIZE ; inline
: WS_SIZEBOX WS_THICKFRAME ; : WS_SIZEBOX WS_THICKFRAME ; inline
: WS_TILEDWINDOW WS_OVERLAPPEDWINDOW ; : WS_TILEDWINDOW WS_OVERLAPPEDWINDOW ; inline
! Extended window styles ! Extended window styles
@ -65,72 +65,74 @@ IN: windows.user32
: WS_EX_CONTROLPARENT HEX: 00010000 ; inline : WS_EX_CONTROLPARENT HEX: 00010000 ; inline
: WS_EX_STATICEDGE HEX: 00020000 ; inline : WS_EX_STATICEDGE HEX: 00020000 ; inline
: WS_EX_APPWINDOW HEX: 00040000 ; inline : WS_EX_APPWINDOW HEX: 00040000 ; inline
: WS_EX_OVERLAPPEDWINDOW WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; inline : WS_EX_OVERLAPPEDWINDOW ( -- n )
: WS_EX_PALETTEWINDOW WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable inline
WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW bitor WS_EX_TOPMOST bitor ; inline : WS_EX_PALETTEWINDOW ( -- n )
WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW bitor
WS_EX_TOPMOST bitor ; foldable inline
: CS_VREDRAW HEX: 0001 ; : CS_VREDRAW HEX: 0001 ; inline
: CS_HREDRAW HEX: 0002 ; : CS_HREDRAW HEX: 0002 ; inline
: CS_DBLCLKS HEX: 0008 ; : CS_DBLCLKS HEX: 0008 ; inline
: CS_OWNDC HEX: 0020 ; : CS_OWNDC HEX: 0020 ; inline
: CS_CLASSDC HEX: 0040 ; : CS_CLASSDC HEX: 0040 ; inline
: CS_PARENTDC HEX: 0080 ; : CS_PARENTDC HEX: 0080 ; inline
: CS_NOCLOSE HEX: 0200 ; : CS_NOCLOSE HEX: 0200 ; inline
: CS_SAVEBITS HEX: 0800 ; : CS_SAVEBITS HEX: 0800 ; inline
: CS_BYTEALIGNCLIENT HEX: 1000 ; : CS_BYTEALIGNCLIENT HEX: 1000 ; inline
: CS_BYTEALIGNWINDOW HEX: 2000 ; : CS_BYTEALIGNWINDOW HEX: 2000 ; inline
: CS_GLOBALCLASS HEX: 4000 ; : CS_GLOBALCLASS HEX: 4000 ; inline
: COLOR_SCROLLBAR 0 ; : COLOR_SCROLLBAR 0 ; inline
: COLOR_BACKGROUND 1 ; : COLOR_BACKGROUND 1 ; inline
: COLOR_ACTIVECAPTION 2 ; : COLOR_ACTIVECAPTION 2 ; inline
: COLOR_INACTIVECAPTION 3 ; : COLOR_INACTIVECAPTION 3 ; inline
: COLOR_MENU 4 ; : COLOR_MENU 4 ; inline
: COLOR_WINDOW 5 ; : COLOR_WINDOW 5 ; inline
: COLOR_WINDOWFRAME 6 ; : COLOR_WINDOWFRAME 6 ; inline
: COLOR_MENUTEXT 7 ; : COLOR_MENUTEXT 7 ; inline
: COLOR_WINDOWTEXT 8 ; : COLOR_WINDOWTEXT 8 ; inline
: COLOR_CAPTIONTEXT 9 ; : COLOR_CAPTIONTEXT 9 ; inline
: COLOR_ACTIVEBORDER 10 ; : COLOR_ACTIVEBORDER 10 ; inline
: COLOR_INACTIVEBORDER 11 ; : COLOR_INACTIVEBORDER 11 ; inline
: COLOR_APPWORKSPACE 12 ; : COLOR_APPWORKSPACE 12 ; inline
: COLOR_HIGHLIGHT 13 ; : COLOR_HIGHLIGHT 13 ; inline
: COLOR_HIGHLIGHTTEXT 14 ; : COLOR_HIGHLIGHTTEXT 14 ; inline
: COLOR_BTNFACE 15 ; : COLOR_BTNFACE 15 ; inline
: COLOR_BTNSHADOW 16 ; : COLOR_BTNSHADOW 16 ; inline
: COLOR_GRAYTEXT 17 ; : COLOR_GRAYTEXT 17 ; inline
: COLOR_BTNTEXT 18 ; : COLOR_BTNTEXT 18 ; inline
: COLOR_INACTIVECAPTIONTEXT 19 ; : COLOR_INACTIVECAPTIONTEXT 19 ; inline
: COLOR_BTNHIGHLIGHT 20 ; : COLOR_BTNHIGHLIGHT 20 ; inline
: IDI_APPLICATION 32512 ; : IDI_APPLICATION 32512 ; inline
: IDI_HAND 32513 ; : IDI_HAND 32513 ; inline
: IDI_QUESTION 32514 ; : IDI_QUESTION 32514 ; inline
: IDI_EXCLAMATION 32515 ; : IDI_EXCLAMATION 32515 ; inline
: IDI_ASTERISK 32516 ; : IDI_ASTERISK 32516 ; inline
: IDI_WINLOGO 32517 ; : IDI_WINLOGO 32517 ; inline
! ShowWindow() Commands ! ShowWindow() Commands
: SW_HIDE 0 ; : SW_HIDE 0 ; inline
: SW_SHOWNORMAL 1 ; : SW_SHOWNORMAL 1 ; inline
: SW_NORMAL 1 ; : SW_NORMAL 1 ; inline
: SW_SHOWMINIMIZED 2 ; : SW_SHOWMINIMIZED 2 ; inline
: SW_SHOWMAXIMIZED 3 ; : SW_SHOWMAXIMIZED 3 ; inline
: SW_MAXIMIZE 3 ; : SW_MAXIMIZE 3 ; inline
: SW_SHOWNOACTIVATE 4 ; : SW_SHOWNOACTIVATE 4 ; inline
: SW_SHOW 5 ; : SW_SHOW 5 ; inline
: SW_MINIMIZE 6 ; : SW_MINIMIZE 6 ; inline
: SW_SHOWMINNOACTIVE 7 ; : SW_SHOWMINNOACTIVE 7 ; inline
: SW_SHOWNA 8 ; : SW_SHOWNA 8 ; inline
: SW_RESTORE 9 ; : SW_RESTORE 9 ; inline
: SW_SHOWDEFAULT 10 ; : SW_SHOWDEFAULT 10 ; inline
: SW_FORCEMINIMIZE 11 ; : SW_FORCEMINIMIZE 11 ; inline
: SW_MAX 11 ; : SW_MAX 11 ; inline
! PeekMessage ! PeekMessage
: PM_NOREMOVE 0 ; : PM_NOREMOVE 0 ; inline
: PM_REMOVE 1 ; : PM_REMOVE 1 ; inline
: PM_NOYIELD 2 ; : PM_NOYIELD 2 ; inline
! : PM_QS_INPUT (QS_INPUT << 16) ; ! : PM_QS_INPUT (QS_INPUT << 16) ;
! : PM_QS_POSTMESSAGE ((QS_POSTMESSAGE | QS_HOTKEY | QS_TIMER) << 16) ; ! : PM_QS_POSTMESSAGE ((QS_POSTMESSAGE | QS_HOTKEY | QS_TIMER) << 16) ;
! : PM_QS_PAINT (QS_PAINT << 16) ; ! : PM_QS_PAINT (QS_PAINT << 16) ;
@ -140,22 +142,22 @@ IN: windows.user32
! !
! Standard Cursor IDs ! Standard Cursor IDs
! !
: IDC_ARROW 32512 ; : IDC_ARROW 32512 ; inline
: IDC_IBEAM 32513 ; : IDC_IBEAM 32513 ; inline
: IDC_WAIT 32514 ; : IDC_WAIT 32514 ; inline
: IDC_CROSS 32515 ; : IDC_CROSS 32515 ; inline
: IDC_UPARROW 32516 ; : IDC_UPARROW 32516 ; inline
: IDC_SIZE 32640 ; ! OBSOLETE: use IDC_SIZEALL : IDC_SIZE 32640 ; inline ! OBSOLETE: use IDC_SIZEALL
: IDC_ICON 32641 ; ! OBSOLETE: use IDC_ARROW : IDC_ICON 32641 ; inline ! OBSOLETE: use IDC_ARROW
: IDC_SIZENWSE 32642 ; : IDC_SIZENWSE 32642 ; inline
: IDC_SIZENESW 32643 ; : IDC_SIZENESW 32643 ; inline
: IDC_SIZEWE 32644 ; : IDC_SIZEWE 32644 ; inline
: IDC_SIZENS 32645 ; : IDC_SIZENS 32645 ; inline
: IDC_SIZEALL 32646 ; : IDC_SIZEALL 32646 ; inline
: IDC_NO 32648 ; ! not in win3.1 : IDC_NO 32648 ; inline ! not in win3.1
: IDC_HAND 32649 ; : IDC_HAND 32649 ; inline
: IDC_APPSTARTING 32650 ; ! not in win3.1 : IDC_APPSTARTING 32650 ; inline ! not in win3.1
: IDC_HELP 32651 ; : IDC_HELP 32651 ; inline
! Predefined Clipboard Formats ! Predefined Clipboard Formats
: CF_TEXT 1 ; inline : CF_TEXT 1 ; inline
@ -244,9 +246,43 @@ IN: windows.user32
: VK_DELETE HEX: 2E ; inline : VK_DELETE HEX: 2E ; inline
: VK_HELP HEX: 2F ; inline : VK_HELP HEX: 2F ; inline
! VK_0 - VK_9 are the same as ASCII '0' - '9' (0x30 - 0x39) : VK_0 CHAR: 0 ; inline
! 0x40 : unassigned : VK_1 CHAR: 1 ; inline
! VK_A - VK_Z are the same as ASCII 'A' - 'Z' (0x41 - 0x5A) : VK_2 CHAR: 2 ; inline
: VK_3 CHAR: 3 ; inline
: VK_4 CHAR: 4 ; inline
: VK_5 CHAR: 5 ; inline
: VK_6 CHAR: 6 ; inline
: VK_7 CHAR: 7 ; inline
: VK_8 CHAR: 8 ; inline
: VK_9 CHAR: 9 ; inline
: VK_A CHAR: A ; inline
: VK_B CHAR: B ; inline
: VK_C CHAR: C ; inline
: VK_D CHAR: D ; inline
: VK_E CHAR: E ; inline
: VK_F CHAR: F ; inline
: VK_G CHAR: G ; inline
: VK_H CHAR: H ; inline
: VK_I CHAR: I ; inline
: VK_J CHAR: J ; inline
: VK_K CHAR: K ; inline
: VK_L CHAR: L ; inline
: VK_M CHAR: M ; inline
: VK_N CHAR: N ; inline
: VK_O CHAR: O ; inline
: VK_P CHAR: P ; inline
: VK_Q CHAR: Q ; inline
: VK_R CHAR: R ; inline
: VK_S CHAR: S ; inline
: VK_T CHAR: T ; inline
: VK_U CHAR: U ; inline
: VK_V CHAR: V ; inline
: VK_W CHAR: W ; inline
: VK_X CHAR: X ; inline
: VK_Y CHAR: Y ; inline
: VK_Z CHAR: Z ; inline
: VK_LWIN HEX: 5B ; inline : VK_LWIN HEX: 5B ; inline
: VK_RWIN HEX: 5C ; inline : VK_RWIN HEX: 5C ; inline
@ -417,47 +453,59 @@ IN: windows.user32
! Some fields are not defined for win64 ! Some fields are not defined for win64
! Window field offsets for GetWindowLong() ! Window field offsets for GetWindowLong()
: GWL_WNDPROC -4 ; : GWL_WNDPROC -4 ; inline
: GWL_HINSTANCE -6 ; : GWL_HINSTANCE -6 ; inline
: GWL_HWNDPARENT -8 ; : GWL_HWNDPARENT -8 ; inline
: GWL_USERDATA -21 ; : GWL_USERDATA -21 ; inline
: GWL_ID -12 ; : GWL_ID -12 ; inline
: GWL_STYLE -16 ; : GWL_STYLE -16 ; inline
: GWL_EXSTYLE -20 ; : GWL_EXSTYLE -20 ; inline
: GWLP_WNDPROC -4 ; : GWLP_WNDPROC -4 ; inline
: GWLP_HINSTANCE -6 ; : GWLP_HINSTANCE -6 ; inline
: GWLP_HWNDPARENT -8 ; : GWLP_HWNDPARENT -8 ; inline
: GWLP_USERDATA -21 ; : GWLP_USERDATA -21 ; inline
: GWLP_ID -12 ; : GWLP_ID -12 ; inline
! Class field offsets for GetClassLong() ! Class field offsets for GetClassLong()
: GCL_MENUNAME -8 ; : GCL_MENUNAME -8 ; inline
: GCL_HBRBACKGROUND -10 ; : GCL_HBRBACKGROUND -10 ; inline
: GCL_HCURSOR -12 ; : GCL_HCURSOR -12 ; inline
: GCL_HICON -14 ; : GCL_HICON -14 ; inline
: GCL_HMODULE -16 ; : GCL_HMODULE -16 ; inline
: GCL_WNDPROC -24 ; : GCL_WNDPROC -24 ; inline
: GCL_HICONSM -34 ; : GCL_HICONSM -34 ; inline
: GCL_CBWNDEXTRA -18 ; : GCL_CBWNDEXTRA -18 ; inline
: GCL_CBCLSEXTRA -20 ; : GCL_CBCLSEXTRA -20 ; inline
: GCL_STYLE -26 ; : GCL_STYLE -26 ; inline
: GCW_ATOM -32 ; : GCW_ATOM -32 ; inline
: GCLP_MENUNAME -8 ; : GCLP_MENUNAME -8 ; inline
: GCLP_HBRBACKGROUND -10 ; : GCLP_HBRBACKGROUND -10 ; inline
: GCLP_HCURSOR -12 ; : GCLP_HCURSOR -12 ; inline
: GCLP_HICON -14 ; : GCLP_HICON -14 ; inline
: GCLP_HMODULE -16 ; : GCLP_HMODULE -16 ; inline
: GCLP_WNDPROC -24 ; : GCLP_WNDPROC -24 ; inline
: GCLP_HICONSM -34 ; : GCLP_HICONSM -34 ; inline
: MB_ICONASTERISK HEX: 00000040 ; : MB_ICONASTERISK HEX: 00000040 ; inline
: MB_ICONEXCLAMATION HEX: 00000030 ; : MB_ICONEXCLAMATION HEX: 00000030 ; inline
: MB_ICONHAND HEX: 00000010 ; : MB_ICONHAND HEX: 00000010 ; inline
: MB_ICONQUESTION HEX: 00000020 ; : MB_ICONQUESTION HEX: 00000020 ; inline
: MB_OK HEX: 00000000 ; : MB_OK HEX: 00000000 ; inline
: FVIRTKEY TRUE ; inline
: FNOINVERT 2 ; inline
: FSHIFT 4 ; inline
: FCONTROL 8 ; inline
: FALT 16 ; inline
: MAPVK_VK_TO_VSC 0 ; inline
: MAPVK_VSC_TO_VK 1 ; inline
: MAPVK_VK_TO_CHAR 2 ; inline
: MAPVK_VSC_TO_VK_EX 3 ; inline
: MAPVK_VK_TO_VSC_EX 3 ; inline
: TME_HOVER 1 ; inline : TME_HOVER 1 ; inline
: TME_LEAVE 2 ; inline : TME_LEAVE 2 ; inline
@ -549,13 +597,15 @@ FUNCTION: BOOL CloseClipboard ( ) ;
! FUNCTION: CloseWindow ! FUNCTION: CloseWindow
! FUNCTION: CloseWindowStation ! FUNCTION: CloseWindowStation
! FUNCTION: CopyAcceleratorTableA ! FUNCTION: CopyAcceleratorTableA
! FUNCTION: CopyAcceleratorTableW FUNCTION: int CopyAcceleratorTableW ( HACCEL hAccelSrc, LPACCEL lpAccelDst, int cAccelEntries ) ;
: CopyAcceleratorTable CopyAcceleratorTableW ; inline
! FUNCTION: CopyIcon ! FUNCTION: CopyIcon
! FUNCTION: CopyImage ! FUNCTION: CopyImage
! FUNCTION: CopyRect ! FUNCTION: CopyRect
! FUNCTION: CountClipboardFormats ! FUNCTION: CountClipboardFormats
! FUNCTION: CreateAcceleratorTableA ! FUNCTION: CreateAcceleratorTableA
! FUNCTION: CreateAcceleratorTableW FUNCTION: HACCEL CreateAcceleratorTableW ( LPACCEL lpaccl, int cEntries ) ;
: CreateAcceleratorTable CreateAcceleratorTableW ; inline
! FUNCTION: CreateCaret ! FUNCTION: CreateCaret
! FUNCTION: CreateCursor ! FUNCTION: CreateCursor
! FUNCTION: CreateDesktopA ! FUNCTION: CreateDesktopA
@ -643,7 +693,7 @@ FUNCTION: LRESULT DefWindowProcW ( HWND hWnd, UINT Msg, WPARAM wParam, LPARAM lP
: DefWindowProc DefWindowProcW ; inline : DefWindowProc DefWindowProcW ; inline
! FUNCTION: DeleteMenu ! FUNCTION: DeleteMenu
! FUNCTION: DeregisterShellHookWindow ! FUNCTION: DeregisterShellHookWindow
! FUNCTION: DestroyAcceleratorTable FUNCTION: BOOL DestroyAcceleratorTable ( HACCEL hAccel ) ;
! FUNCTION: DestroyCaret ! FUNCTION: DestroyCaret
! FUNCTION: DestroyCursor ! FUNCTION: DestroyCursor
! FUNCTION: DestroyIcon ! FUNCTION: DestroyIcon
@ -953,7 +1003,7 @@ FUNCTION: BOOL IsZoomed ( HWND hWnd ) ;
! FUNCTION: KillSystemTimer ! FUNCTION: KillSystemTimer
! FUNCTION: KillTimer ! FUNCTION: KillTimer
! FUNCTION: LoadAcceleratorsA ! FUNCTION: LoadAcceleratorsA
! FUNCTION: LoadAcceleratorsW FUNCTION: HACCEL LoadAcceleratorsW ( HINSTANCE hInstance, LPCTSTR lpTableName ) ;
! FUNCTION: LoadBitmapA ! FUNCTION: LoadBitmapA
! FUNCTION: LoadBitmapW ! FUNCTION: LoadBitmapW
! FUNCTION: LoadCursorFromFileA ! FUNCTION: LoadCursorFromFileA
@ -988,10 +1038,13 @@ FUNCTION: HICON LoadIconW ( HINSTANCE hInstance, LPCTSTR lpIconName ) ;
! FUNCTION: LookupIconIdFromDirectory ! FUNCTION: LookupIconIdFromDirectory
! FUNCTION: LookupIconIdFromDirectoryEx ! FUNCTION: LookupIconIdFromDirectoryEx
! FUNCTION: MapDialogRect ! FUNCTION: MapDialogRect
! FUNCTION: MapVirtualKeyA
! FUNCTION: MapVirtualKeyExA FUNCTION: UINT MapVirtualKeyW ( UINT uCode, UINT uMapType ) ;
! FUNCTION: MapVirtualKeyExW : MapVirtualKey MapVirtualKeyW ; inline
! FUNCTION: MapVirtualKeyW
FUNCTION: UINT MapVirtualKeyExW ( UINT uCode, UINT uMapType, HKL dwhkl ) ;
: MapVirtualKeyEx MapVirtualKeyExW ; inline
! FUNCTION: MapWindowPoints ! FUNCTION: MapWindowPoints
! FUNCTION: MB_GetString ! FUNCTION: MB_GetString
! FUNCTION: MBToWCSEx ! FUNCTION: MBToWCSEx
@ -1050,7 +1103,6 @@ FUNCTION: int MessageBoxExW (
! FUNCTION: mouse_event ! FUNCTION: mouse_event
FUNCTION: BOOL MoveWindow ( FUNCTION: BOOL MoveWindow (
HWND hWnd, HWND hWnd,
int X, int X,
@ -1059,7 +1111,6 @@ FUNCTION: BOOL MoveWindow (
int nHeight, int nHeight,
BOOL bRepaint ) ; BOOL bRepaint ) ;
! FUNCTION: MsgWaitForMultipleObjects ! FUNCTION: MsgWaitForMultipleObjects
! FUNCTION: MsgWaitForMultipleObjectsEx ! FUNCTION: MsgWaitForMultipleObjectsEx
! FUNCTION: NotifyWinEvent ! FUNCTION: NotifyWinEvent
@ -1264,7 +1315,9 @@ FUNCTION: BOOL TrackMouseEvent ( LPTRACKMOUSEEVENT lpEventTrack ) ;
! FUNCTION: TrackPopupMenuEx ! FUNCTION: TrackPopupMenuEx
! FUNCTION: TranslateAccelerator ! FUNCTION: TranslateAccelerator
! FUNCTION: TranslateAcceleratorA ! FUNCTION: TranslateAcceleratorA
! FUNCTION: TranslateAcceleratorW FUNCTION: int TranslateAcceleratorW ( HWND hWnd, HACCEL hAccTable, LPMSG lpMsg ) ;
: TranslateAccelerator TranslateAcceleratorW ; inline
! FUNCTION: TranslateMDISysAccel ! FUNCTION: TranslateMDISysAccel
FUNCTION: BOOL TranslateMessage ( MSG* lpMsg ) ; FUNCTION: BOOL TranslateMessage ( MSG* lpMsg ) ;

3
vm/os-unix.c
View File

@ -219,6 +219,9 @@ static void sigaction_safe(int signum, const struct sigaction *act, struct sigac
ret = sigaction(signum, act, oldact); ret = sigaction(signum, act, oldact);
} }
while(ret == -1 && errno == EINTR); while(ret == -1 && errno == EINTR);
if(ret == -1)
fatal_error("sigaction failed", 0);
} }
void unix_init_signals(void) void unix_init_signals(void)

59
vm/os-windows.c
View File

@ -98,21 +98,22 @@ const F_CHAR *vm_executable_path(void)
return safe_strdup(full_path); return safe_strdup(full_path);
} }
DEFINE_PRIMITIVE(stat) void stat_not_found(void)
{ {
dpush(F);
dpush(F);
dpush(F);
dpush(F);
}
void find_file_stat(F_CHAR *path)
{
// FindFirstFile is the only call that can stat c:\pagefile.sys
WIN32_FIND_DATA st; WIN32_FIND_DATA st;
HANDLE h; HANDLE h;
F_CHAR *path = unbox_u16_string(); if(INVALID_HANDLE_VALUE == (h = FindFirstFile(path, &st)))
if(INVALID_HANDLE_VALUE == (h = FindFirstFile( stat_not_found();
path,
&st)))
{
dpush(F);
dpush(F);
dpush(F);
dpush(F);
}
else else
{ {
box_boolean(st.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY); box_boolean(st.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
@ -129,6 +130,42 @@ DEFINE_PRIMITIVE(stat)
} }
} }
DEFINE_PRIMITIVE(stat)
{
HANDLE h;
BY_HANDLE_FILE_INFORMATION bhfi;
F_CHAR *path = unbox_u16_string();
//wprintf(L"path = %s\n", path);
h = CreateFileW(path,
GENERIC_READ,
FILE_SHARE_READ,
NULL,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS,
NULL);
if(h == INVALID_HANDLE_VALUE)
{
find_file_stat(path);
return;
}
if(!GetFileInformationByHandle(h, &bhfi))
stat_not_found();
else {
box_boolean(bhfi.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
dpush(tag_fixnum(0));
box_unsigned_8(
(u64)bhfi.nFileSizeLow | (u64)bhfi.nFileSizeHigh << 32);
u64 lo = bhfi.ftLastWriteTime.dwLowDateTime;
u64 hi = bhfi.ftLastWriteTime.dwHighDateTime;
u64 modTime = (hi << 32) + lo;
box_unsigned_8((modTime - EPOCH_OFFSET) / 10000000);
}
CloseHandle(h);
}
DEFINE_PRIMITIVE(read_dir) DEFINE_PRIMITIVE(read_dir)
{ {
HANDLE dir; HANDLE dir;