Merge branch 'master' into microseconds

[factor.git] / basis / io / unix / files / files.factor

diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor
index fb8615c47b5338f05cac03ed4dde13dfbba22818..9fa1727e16c241dadd46f9b40e2e46a381dfdea5 100644 (file)
--- a/basis/io/unix/files/files.factor
+++ b/basis/io/unix/files/files.factor
@@ -6,7 +6,8 @@ math.bitwise byte-arrays alien combinators calendar
 io.encodings.binary accessors sequences strings system
 io.files.private destructors vocabs.loader calendar.unix
 unix.stat alien.c-types arrays unix.users unix.groups
-environment fry io.encodings.utf8 alien.strings unix.statfs ;
+environment fry io.encodings.utf8 alien.strings unix.statfs
+combinators.short-circuit ;
 IN: io.unix.files
 
 M: unix cwd ( -- path )
@@ -117,8 +118,8 @@ M: unix stat>file-info ( stat -- file-info )
         [ stat-st_blksize >>blocksize ]
     } cleave ;
 
-M: unix stat>type ( stat -- type )
-    stat-st_mode S_IFMT bitand {
+: n>file-type ( n -- type )
+    S_IFMT bitand {
         { S_IFREG [ +regular-file+ ] }
         { S_IFDIR [ +directory+ ] }
         { S_IFCHR [ +character-device+ ] }
@@ -129,6 +130,9 @@ M: unix stat>type ( stat -- type )
         [ drop +unknown+ ]
     } case ;
 
+M: unix stat>type ( stat -- type )
+    stat-st_mode n>file-type ;
+
 ! Linux has no extra fields in its stat struct
 os {
     { macosx  [ "io.unix.files.bsd" require ] }
@@ -150,7 +154,7 @@ os {
 
 M: unix >directory-entry ( byte-array -- directory-entry )
     [ dirent-d_name utf8 alien>string ]
-    [ dirent-d_type ] bi directory-entry boa ;
+    [ dirent-d_type dirent-type>file-type ] bi directory-entry boa ;
 
 M: unix (directory-entries) ( path -- seq )
     [
@@ -225,6 +229,15 @@ GENERIC: other-read? ( obj -- ? )
 GENERIC: other-write? ( obj -- ? )
 GENERIC: other-execute? ( obj -- ? )
 
+: any-read? ( obj -- ? )
+    { [ user-read? ] [ group-read? ] [ other-read? ] } 1|| ;
+
+: any-write? ( obj -- ? )
+    { [ user-write? ] [ group-write? ] [ other-write? ] } 1|| ;
+
+: any-execute? ( obj -- ? )
+    { [ user-execute? ] [ group-execute? ] [ other-execute? ] } 1|| ;
+
 M: integer uid? ( integer -- ? ) UID mask? ;
 M: integer gid? ( integer -- ? ) GID mask? ;
 M: integer sticky? ( integer -- ? ) STICKY mask? ;