2005-02-08 22:02:44 -05:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2004-08-28 16:43:43 -04:00
|
|
|
IN: files
|
2005-02-08 22:02:44 -05:00
|
|
|
USING: kernel hashtables lists namespaces presentation stdio
|
2005-03-18 21:41:13 -05:00
|
|
|
streams strings unparser ;
|
2004-08-28 16:43:43 -04:00
|
|
|
|
2005-03-18 21:41:13 -05:00
|
|
|
! Words for accessing filesystem meta-data.
|
2004-11-25 21:51:47 -05:00
|
|
|
|
2005-03-18 21:41:13 -05:00
|
|
|
: exists? ( file -- ? ) stat >boolean ;
|
|
|
|
: directory? ( file -- ? ) stat dup [ car ] when ;
|
|
|
|
: directory ( dir -- list ) (directory) [ string> ] sort ;
|
|
|
|
: file-length ( file -- length ) stat dup [ cdr cdr car ] when ;
|
|
|
|
: file-extension ( filename -- extension )
|
|
|
|
"." split cdr dup [ last ] when ;
|
2004-11-25 21:51:47 -05:00
|
|
|
|
2005-03-18 21:41:13 -05:00
|
|
|
! Hyperlinked directory listings.
|
2004-11-25 21:51:47 -05:00
|
|
|
|
2004-10-30 23:18:55 -04:00
|
|
|
: file-actions ( -- list )
|
|
|
|
[
|
2005-01-13 19:49:47 -05:00
|
|
|
[[ "Push" "" ]]
|
|
|
|
[[ "Run file" "run-file" ]]
|
|
|
|
[[ "List directory" "directory." ]]
|
|
|
|
[[ "Change directory" "cd" ]]
|
2004-10-30 23:18:55 -04:00
|
|
|
] ;
|
|
|
|
|
2005-03-18 21:41:13 -05:00
|
|
|
: dir-icon "/library/icons/Folder.png" ;
|
|
|
|
: file-icon "/library/icons/File.png" ;
|
|
|
|
: file-icon. directory? dir-icon file-icon ? write-icon ;
|
2004-08-30 20:24:19 -04:00
|
|
|
|
|
|
|
: file-link. ( dir name -- )
|
2004-10-30 23:18:55 -04:00
|
|
|
tuck "/" swap cat3 dup "file-link" swons swap
|
2004-12-20 15:29:55 -05:00
|
|
|
unparse file-actions <actions> "actions" swons
|
2005-01-01 17:20:48 -05:00
|
|
|
2list write-attr ;
|
2004-08-30 20:24:19 -04:00
|
|
|
|
|
|
|
: file. ( dir name -- )
|
|
|
|
#! If "doc-root" set, create links relative to it.
|
|
|
|
2dup "/" swap cat3 file-icon. " " write file-link. terpri ;
|
|
|
|
|
|
|
|
: directory. ( dir -- )
|
|
|
|
#! If "doc-root" set, create links relative to it.
|
|
|
|
dup directory [
|
|
|
|
dup [ "." ".." ] contains? [
|
2005-01-01 17:20:48 -05:00
|
|
|
2drop
|
2004-08-30 20:24:19 -04:00
|
|
|
] [
|
2005-01-01 17:20:48 -05:00
|
|
|
file.
|
2004-08-30 20:24:19 -04:00
|
|
|
] ifte
|
2005-01-01 17:20:48 -05:00
|
|
|
] each-with ;
|