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

rename left/right-trim to trim-left

db4
Doug Coleman 2008-09-05 17:12:30 -05:00
parent dc88d45762
commit 5ed87d4d34
1 changed files with 14 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
core/io/files/files.factor
View File

@ -47,11 +47,11 @@ HOOK: (file-appender) io-backend ( path -- stream )
: path-separator ( -- string ) os windows? "\\" "/" ? ; : path-separator ( -- string ) os windows? "\\" "/" ? ;
: right-trim-separators ( str -- newstr ) : trim-right-separators ( str -- newstr )
[ path-separator? ] right-trim ; [ path-separator? ] trim-right ;
: left-trim-separators ( str -- newstr ) : trim-left-separators ( str -- newstr )
[ path-separator? ] left-trim ; [ path-separator? ] trim-left ;
: last-path-separator ( path -- n ? ) : last-path-separator ( path -- n ? )
[ length 1- ] keep [ path-separator? ] find-last-from ; [ length 1- ] keep [ path-separator? ] find-last-from ;
@ -65,7 +65,7 @@ ERROR: no-parent-directory path ;
: parent-directory ( path -- parent ) : parent-directory ( path -- parent )
dup root-directory? [ dup root-directory? [
right-trim-separators trim-right-separators
dup last-path-separator [ dup last-path-separator [
1+ cut 1+ cut
] [ ] [
@ -92,7 +92,7 @@ ERROR: no-parent-directory path ;
: append-path-empty ( path1 path2 -- path' ) : append-path-empty ( path1 path2 -- path' )
{ {
{ [ dup head.? ] [ { [ dup head.? ] [
rest left-trim-separators append-path-empty rest trim-left-separators append-path-empty
] } ] }
{ [ dup head..? ] [ drop no-parent-directory ] } { [ dup head..? ] [ drop no-parent-directory ] }
[ nip ] [ nip ]
@ -121,19 +121,19 @@ PRIVATE>
{ {
{ [ over empty? ] [ append-path-empty ] } { [ over empty? ] [ append-path-empty ] }
{ [ dup empty? ] [ drop ] } { [ dup empty? ] [ drop ] }
{ [ over right-trim-separators "." = ] [ nip ] } { [ over trim-right-separators "." = ] [ nip ] }
{ [ dup absolute-path? ] [ nip ] } { [ dup absolute-path? ] [ nip ] }
{ [ dup head.? ] [ rest left-trim-separators append-path ] } { [ dup head.? ] [ rest trim-left-separators append-path ] }
{ [ dup head..? ] [ { [ dup head..? ] [
2 tail left-trim-separators 2 tail trim-left-separators
>r parent-directory r> append-path >r parent-directory r> append-path
] } ] }
{ [ over absolute-path? over first path-separator? and ] [ { [ over absolute-path? over first path-separator? and ] [
>r 2 head r> append >r 2 head r> append
] } ] }
[ [
>r right-trim-separators "/" r> >r trim-right-separators "/" r>
left-trim-separators 3append trim-left-separators 3append
] ]
} cond ; } cond ;
@ -142,7 +142,7 @@ PRIVATE>
: file-name ( path -- string ) : file-name ( path -- string )
dup root-directory? [ dup root-directory? [
right-trim-separators trim-right-separators
dup last-path-separator [ 1+ tail ] [ dup last-path-separator [ 1+ tail ] [
drop "resource:" ?head [ file-name ] when drop "resource:" ?head [ file-name ] when
] if ] if
@ -200,7 +200,7 @@ SYMBOL: current-directory
: (normalize-path) ( path -- path' ) : (normalize-path) ( path -- path' )
"resource:" ?head [ "resource:" ?head [
left-trim-separators resource-path trim-left-separators resource-path
(normalize-path) (normalize-path)
] [ ] [
current-directory get prepend-path current-directory get prepend-path
@ -219,7 +219,7 @@ M: object normalize-path ( path -- path' )
HOOK: make-directory io-backend ( path -- ) HOOK: make-directory io-backend ( path -- )
: make-directories ( path -- ) : make-directories ( path -- )
normalize-path right-trim-separators { normalize-path trim-right-separators {
{ [ dup "." = ] [ ] } { [ dup "." = ] [ ] }
{ [ dup root-directory? ] [ ] } { [ dup root-directory? ] [ ] }
{ [ dup empty? ] [ ] } { [ dup empty? ] [ ] }