Permalink
Browse files

Merge branch 'master' of git://factorcode.org/git/factor

  • Loading branch information...
2 parents 61097d8 + b0688f3 commit 01d74e81fa9cfde9ba44c0eb309673038d23e478 Slava Pestov committed May 12, 2009
@@ -0,0 +1,10 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types io.directories.unix kernel system unix ;
+IN: io.directories.unix.linux
+
+M: unix find-next-file ( DIR* -- byte-array )
+ "dirent" <c-object>
+ f <void*>
+ [ readdir64_r 0 = [ (io-error) ] unless ] 2keep
+ *void* [ drop f ] unless ;
@@ -0,0 +1 @@
+unportable
@@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings combinators
continuations destructors fry io io.backend io.backend.unix
io.directories io.encodings.binary io.encodings.utf8 io.files
io.pathnames io.files.types kernel math.bitwise sequences system
-unix unix.stat ;
+unix unix.stat vocabs.loader ;
IN: io.directories.unix
: touch-mode ( -- n )
@@ -34,7 +34,9 @@ M: unix copy-file ( from to -- )
[ opendir dup [ (io-error) ] unless ] dip
dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
-: find-next-file ( DIR* -- byte-array )
+HOOK: find-next-file os ( DIR* -- byte-array )
+
+M: unix find-next-file ( DIR* -- byte-array )
"dirent" <c-object>
f <void*>
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
@@ -54,12 +56,16 @@ M: unix copy-file ( from to -- )
} case ;
M: unix >directory-entry ( byte-array -- directory-entry )
- [ dirent-d_name utf8 alien>string ]
- [ dirent-d_type dirent-type>file-type ] bi directory-entry boa ;
+ {
+ [ dirent-d_name utf8 alien>string ]
+ [ dirent-d_type dirent-type>file-type ]
+ } cleave directory-entry boa ;
M: unix (directory-entries) ( path -- seq )
[
'[ _ find-next-file dup ]
[ >directory-entry ]
produce nip
] with-unix-directory ;
+
+os linux? [ "io.directories.unix.linux" require ] when
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman, Eduardo Cavazos.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel system sequences combinators
-vocabs.loader io.files.types ;
+vocabs.loader io.files.types math ;
IN: io.files.info
! File info
@@ -14,6 +14,9 @@ HOOK: link-info os ( path -- info )
: directory? ( file-info -- ? ) type>> +directory+ = ;
+: sparse-file? ( file-info -- ? )
+ [ size-on-disk>> ] [ size>> ] bi < ;
+
! File systems
HOOK: file-systems os ( -- array )
@@ -35,6 +35,6 @@ ERROR: bad-byte-array-length byte-array ;
heap-size struct-array boa ; inline
: malloc-struct-array ( length c-type -- struct-array )
- [ heap-size calloc ] 2keep <direct-struct-array> ;
+ [ heap-size calloc ] 2keep <direct-struct-array> ; inline
INSTANCE: struct-array sequence
@@ -97,4 +97,8 @@ M: quit-responder call-responder*
shake-and-bake
run-temp-image
] curry unit-test
-] each
+] each
+
+os windows? os macosx? or [
+ [ ] [ "tools.deploy.test.8" shake-and-bake run-temp-image ] unit-test
+] when
@@ -41,7 +41,7 @@ IN: tools.deploy.shaker
] when
strip-dictionary? [
{
- "compiler.units"
+ ! "compiler.units"
"vocabs"
"vocabs.cache"
"source-files.errors"
@@ -271,7 +271,7 @@ IN: tools.deploy.shaker
compiled-generic-crossref
compiler-impl
compiler.errors:compiler-errors
- definition-observers
+ ! definition-observers
interactive-vocabs
lexer-factory
print-use-hook
@@ -301,16 +301,16 @@ IN: tools.deploy.shaker
compiler.errors:compiler-errors
continuations:thread-error-hook
} %
+
+ deploy-ui? get [
+ "ui-error-hook" "ui.gadgets.worlds" lookup ,
+ ] when
] when
deploy-c-types? get [
"c-types" "alien.c-types" lookup ,
] unless
- deploy-ui? get [
- "ui-error-hook" "ui.gadgets.worlds" lookup ,
- ] when
-
"windows-messages" "windows.messages" lookup [ , ] when*
] { } make ;
@@ -443,6 +443,9 @@ SYMBOL: deploy-vocab
strip-debugger? [
"debugger" require
"inspector" require
+ deploy-ui? get [
+ "ui.debugger" require
+ ] when
] unless
deploy-vocab set
deploy-vocab get require
@@ -0,0 +1,21 @@
+USING: calendar game-input threads ui ui.gadgets.worlds kernel
+method-chains system ;
+IN: tools.deploy.test.8
+
+TUPLE: my-world < world ;
+
+BEFORE: my-world begin-world drop open-game-input ;
+
+AFTER: my-world end-world drop close-game-input ;
+
+: test-game-input ( -- )
+ [
+ f T{ world-attributes
+ { world-class my-world }
+ { title "Test" }
+ } open-window
+ 1 seconds sleep
+ 0 exit
+ ] with-ui ;
+
+MAIN: test-game-input
@@ -0,0 +1,14 @@
+USING: tools.deploy.config ;
+H{
+ { deploy-c-types? f }
+ { deploy-unicode? f }
+ { deploy-word-defs? f }
+ { deploy-name "tools.deploy.test.8" }
+ { "stop-after-last-window?" t }
+ { deploy-reflection 1 }
+ { deploy-ui? t }
+ { deploy-math? t }
+ { deploy-io 2 }
+ { deploy-word-props? f }
+ { deploy-threads? t }
+}
@@ -616,10 +616,8 @@ M: windows-ui-backend do-events
GetDoubleClickTime milliseconds double-click-timeout set-global ;
: cleanup-win32-ui ( -- )
- class-name-ptr [
- [ [ f UnregisterClass drop ] [ free ] bi ] when* f
- ] change-global
- msg-obj change-global [ [ free ] when* f ] ;
+ class-name-ptr [ [ [ f UnregisterClass drop ] [ free ] bi ] when* f ] change-global
+ msg-obj [ [ free ] when* f ] change-global ;
: get-dc ( world -- )
handle>> dup hWnd>> GetDC dup win32-error=0/f >>hDC drop ;
@@ -0,0 +1,19 @@
+! Copyright (C) 2006, 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors debugger io kernel namespaces prettyprint
+ui.gadgets.panes ui.gadgets.worlds ui ;
+IN: ui.debugger
+
+: <error-pane> ( error -- pane )
+ <pane> [ [ print-error ] with-pane ] keep ; inline
+
+: error-window ( error -- )
+ <error-pane> "Error" open-window ;
+
+[ error-window ] ui-error-hook set-global
+
+M: world-error error.
+ "An error occurred while drawing the world " write
+ dup world>> pprint-short "." print
+ "This world has been deactivated to prevent cascading errors." print
+ error>> error. ;
View
@@ -1,7 +1,7 @@
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays accessors definitions hashtables io kernel sequences
-strings words help math models namespaces quotations ui.gadgets
+strings words math models namespaces quotations ui.gadgets
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
ui.gadgets.labels ui.gadgets.menus ui.gadgets.worlds
ui.gadgets.status-bar ui.commands ui.operations ui.gestures ;
@@ -101,7 +101,7 @@ M: world layout*
[ call-next-method ]
[ dup layers>> [ as-big-as-possible ] with each ] bi ;
-M: world focusable-child* gadget-child ;
+M: world focusable-child* children>> [ t ] [ first ] if-empty ;
M: world children-on nip children>> ;
View
@@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays definitions kernel ui.commands
ui.gestures sequences strings math words generic namespaces
-hashtables help.markup quotations assocs fry linked-assocs ;
+hashtables quotations assocs fry linked-assocs ;
IN: ui.operations
SYMBOL: +keyboard+
View
@@ -8,7 +8,7 @@ ui.gadgets.buttons ui.gadgets.labels ui.gadgets.panes
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.tables
ui.gadgets.tracks ui.gadgets.scrollers ui.gadgets.panes
ui.gadgets.borders ui.gadgets.status-bar ui.tools.traceback
-ui.tools.inspector ui.tools.browser ;
+ui.tools.inspector ui.tools.browser ui.debugger ;
IN: ui.tools.debugger
TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
@@ -27,9 +27,6 @@ M: restart-renderer row-columns
t >>selection-required?
t >>single-click? ; inline
-: <error-pane> ( error -- pane )
- <pane> [ [ print-error ] with-pane ] keep ; inline
-
: <error-display> ( debugger -- gadget )
[ <filled-pile> ] dip
[ error>> <error-pane> add-gadget ]
@@ -72,12 +69,6 @@ M: object error-in-debugger? drop f ;
[ rethrow ] [ error-continuation get debugger-window ] if
] ui-error-hook set-global
-M: world-error error.
- "An error occurred while drawing the world " write
- dup world>> pprint-short "." print
- "This world has been deactivated to prevent cascading errors." print
- error>> error. ;
-
debugger "gestures" f {
{ T{ button-down } request-focus }
} define-command-map
@@ -1,6 +1,6 @@
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.syntax alien system ;
IN: unix
! Linux.
@@ -93,13 +93,20 @@ C-STRUCT: passwd
{ "char*" "pw_dir" }
{ "char*" "pw_shell" } ;
+! dirent64
C-STRUCT: dirent
- { "__ino_t" "d_ino" }
- { "__off_t" "d_off" }
+ { "ulonglong" "d_ino" }
+ { "longlong" "d_off" }
{ "ushort" "d_reclen" }
{ "uchar" "d_type" }
{ { "char" 256 } "d_name" } ;
+FUNCTION: int open64 ( char* path, int flags, int prot ) ;
+FUNCTION: dirent64* readdir64 ( DIR* dirp ) ;
+FUNCTION: int readdir64_r ( void* dirp, dirent* entry, dirent** result ) ;
+
+M: linux open-file [ open64 ] unix-system-call ;
+
CONSTANT: EPERM 1
CONSTANT: ENOENT 2
CONSTANT: ESRCH 3
@@ -1,29 +1,28 @@
-USING: kernel alien.syntax math ;
+USING: kernel alien.syntax math sequences unix
+alien.c-types arrays accessors combinators ;
IN: unix.stat
-! Ubuntu 8.04 32-bit
-
+! stat64
C-STRUCT: stat
- { "dev_t" "st_dev" }
- { "ushort" "__pad1" }
- { "ino_t" "st_ino" }
- { "mode_t" "st_mode" }
- { "nlink_t" "st_nlink" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "dev_t" "st_rdev" }
- { "ushort" "__pad2" }
- { "off_t" "st_size" }
- { "blksize_t" "st_blksize" }
- { "blkcnt_t" "st_blocks" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "ulong" "unused4" }
- { "ulong" "unused5" } ;
+ { "dev_t" "st_dev" }
+ { "ushort" "__pad1" }
+ { "__ino_t" "__st_ino" }
+ { "mode_t" "st_mode" }
+ { "nlink_t" "st_nlink" }
+ { "uid_t" "st_uid" }
+ { "gid_t" "st_gid" }
+ { "dev_t" "st_rdev" }
+ { { "ushort" 2 } "__pad2" }
+ { "off64_t" "st_size" }
+ { "blksize_t" "st_blksize" }
+ { "blkcnt64_t" "st_blocks" }
+ { "timespec" "st_atimespec" }
+ { "timespec" "st_mtimespec" }
+ { "timespec" "st_ctimespec" }
+ { "ulonglong" "st_ino" } ;
-FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ;
-FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
+FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
+FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;
-: stat ( pathname buf -- int ) [ 3 ] 2dip __xstat ;
-: lstat ( pathname buf -- int ) [ 3 ] 2dip __lxstat ;
+: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat64 ;
+: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat64 ;
Oops, something went wrong.

0 comments on commit 01d74e8

Please sign in to comment.