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

add with-directory-entries and file-type>trailing

db4
Doug Coleman 2009-01-13 00:05:19 -06:00
parent 5909ca0bd8
commit 4a01649d15
3 changed files with 52 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/io/directories/directories-docs.factor
View File

@ -50,6 +50,10 @@ HELP: with-directory-files
{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
HELP: with-directory-entries
{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Calls the quotation with the directory entries on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
HELP: delete-file
{ $values { "path" "a pathname string" } }
{ $description "Deletes a file." }
@ -122,6 +126,7 @@ ARTICLE: "io.directories.listing" "Directory listing"
"Directory listing:"
{ $subsection directory-entries }
{ $subsection directory-files }
{ $subsection with-directory-entries }
{ $subsection with-directory-files } ;
ARTICLE: "io.directories.create" "Creating directories"

3
basis/io/directories/directories.factor
View File

@ -41,6 +41,9 @@ HOOK: (directory-entries) os ( path -- seq )
: directory-files ( path -- seq )
directory-entries [ name>> ] map ;
: with-directory-entries ( path quot -- )
'[ "" directory-entries @ ] with-directory ; inline
: with-directory-files ( path quot -- )
'[ "" directory-files @ ] with-directory ; inline

68
basis/io/files/info/unix/unix.factor
View File

@ -114,30 +114,6 @@ M: file-info file-mode? [ permissions>> ] dip mask? ;
PRIVATE>
: ch>file-type ( ch -- type )
{
{ CHAR: b [ +block-device+ ] }
{ CHAR: c [ +character-device+ ] }
{ CHAR: d [ +directory+ ] }
{ CHAR: l [ +symbolic-link+ ] }
{ CHAR: s [ +socket+ ] }
{ CHAR: p [ +fifo+ ] }
{ CHAR: - [ +regular-file+ ] }
[ drop +unknown+ ]
} case ;
: file-type>ch ( type -- string )
{
{ +block-device+ [ CHAR: b ] }
{ +character-device+ [ CHAR: c ] }
{ +directory+ [ CHAR: d ] }
{ +symbolic-link+ [ CHAR: l ] }
{ +socket+ [ CHAR: s ] }
{ +fifo+ [ CHAR: p ] }
{ +regular-file+ [ CHAR: - ] }
[ drop CHAR: - ]
} case ;
: UID OCT: 0004000 ; inline
: GID OCT: 0002000 ; inline
: STICKY OCT: 0001000 ; inline
@ -251,3 +227,47 @@ M: string set-file-group ( path string -- )
: file-group-name ( path -- string )
file-group-id group-name ;
: ch>file-type ( ch -- type )
{
{ CHAR: b [ +block-device+ ] }
{ CHAR: c [ +character-device+ ] }
{ CHAR: d [ +directory+ ] }
{ CHAR: l [ +symbolic-link+ ] }
{ CHAR: s [ +socket+ ] }
{ CHAR: p [ +fifo+ ] }
{ CHAR: - [ +regular-file+ ] }
[ drop +unknown+ ]
} case ;
: file-type>ch ( type -- ch )
{
{ +block-device+ [ CHAR: b ] }
{ +character-device+ [ CHAR: c ] }
{ +directory+ [ CHAR: d ] }
{ +symbolic-link+ [ CHAR: l ] }
{ +socket+ [ CHAR: s ] }
{ +fifo+ [ CHAR: p ] }
{ +regular-file+ [ CHAR: - ] }
[ drop CHAR: - ]
} case ;
<PRIVATE
: file-type>executable ( directory-entry -- string )
name>> any-execute? "*" "" ? ;
PRIVATE>
: file-type>trailing ( directory-entry -- string )
dup type>>
{
{ +directory+ [ drop "/" ] }
{ +symbolic-link+ [ drop "@" ] }
{ +fifo+ [ drop "|" ] }
{ +socket+ [ drop "=" ] }
{ +whiteout+ [ drop "%" ] }
{ +unknown+ [ file-type>executable ] }
{ +regular-file+ [ file-type>executable ] }
[ drop file-type>executable ]
} case ;