2006-05-15 00:03:55 -04:00
|
|
|
! Copyright (C) 2004, 2006 Slava Pestov.
|
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2005-06-19 17:50:35 -04:00
|
|
|
IN: io
|
2006-05-15 01:01:47 -04:00
|
|
|
USING: hashtables kernel math memory namespaces sequences
|
2006-10-31 15:48:34 -05:00
|
|
|
strings styles arrays ;
|
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
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: path+ ( str1 str2 -- str )
|
2006-12-10 14:59:32 -05:00
|
|
|
over "/" tail? [ append ] [ "/" swap 3append ] if ;
|
2005-09-01 16:37:32 -04:00
|
|
|
|
2006-10-31 00:52:02 -05:00
|
|
|
: exists? ( path -- ? ) stat >r 3drop r> >boolean ;
|
2005-09-01 16:37:32 -04:00
|
|
|
|
2006-10-31 00:52:02 -05:00
|
|
|
: directory? ( path -- ? ) stat 3drop ;
|
2005-09-01 16:37:32 -04:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: directory ( path -- seq )
|
2006-01-09 01:34:23 -05:00
|
|
|
(directory)
|
2006-11-17 02:13:14 -05:00
|
|
|
[ { "." ".." } member? not ] subset ;
|
2005-09-01 16:37:32 -04:00
|
|
|
|
2006-10-31 00:52:02 -05:00
|
|
|
: file-length ( path -- n ) stat 4array third ;
|
2005-09-01 16:37:32 -04:00
|
|
|
|
2006-10-31 00:52:02 -05:00
|
|
|
: file-modified ( path -- n ) stat >r 3drop r> ;
|
2006-09-06 18:48:46 -04:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: parent-dir ( path -- parent )
|
2006-03-27 22:20:42 -05:00
|
|
|
CHAR: / over last-index CHAR: \\ pick last-index max
|
2006-07-29 20:36:25 -04:00
|
|
|
dup -1 = [ 2drop "." ] [ head ] if ;
|
2006-03-27 22:20:42 -05:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: resource-path ( resource -- path )
|
2006-08-11 16:55:43 -04:00
|
|
|
\ resource-path get [ image parent-dir ] unless*
|
|
|
|
|
swap path+ ;
|
2005-06-19 18:53:58 -04:00
|
|
|
|
2006-09-29 23:03:27 -04:00
|
|
|
: ?resource-path ( path -- path )
|
|
|
|
|
"resource:" ?head [ resource-path ] when ;
|
2005-09-27 14:12:17 -04:00
|
|
|
|
2006-06-14 02:16:53 -04:00
|
|
|
TUPLE: pathname string ;
|
2006-06-14 01:47:28 -04:00
|
|
|
|
2006-12-19 21:10:53 -05:00
|
|
|
: write-pathname ( path -- ) dup <pathname> write-object ;
|
2006-09-29 20:45:24 -04:00
|
|
|
|
|
|
|
|
: home ( -- dir )
|
|
|
|
|
windows? "USERPROFILE" "HOME" ? os-env [ "." ] unless* ;
|