cleanup some uses of current-directory.
parent
e36727db23
commit
9c323e2884
|
@ -180,7 +180,7 @@ M: ftp-list handle-passive-command ( stream obj -- )
|
|||
drop
|
||||
start-directory [
|
||||
utf8 encode-output [
|
||||
current-directory get directory.
|
||||
"." directory.
|
||||
] with-string-writer string-lines
|
||||
harvest [ ftp-send ] each
|
||||
] with-output-stream finish-directory ;
|
||||
|
|
|
@ -198,7 +198,7 @@ $nl
|
|||
io.pathnames tools.files sequences kernel ;
|
||||
|
||||
command-line get [
|
||||
current-directory get directory.
|
||||
\".\". directory.
|
||||
] [
|
||||
dup length 1 = [ first directory. ] [
|
||||
[ [ nl write \":\" print ] [ directory. ] bi ] each
|
||||
|
|
|
@ -83,7 +83,7 @@ IN: io.launcher.unix
|
|||
[ setup-process-group ] [ 2drop 249 _exit ] recover
|
||||
[ setup-priority ] [ 2drop 250 _exit ] recover
|
||||
[ setup-redirection ] [ 2drop 251 _exit ] recover
|
||||
[ current-directory get absolute-path cd ] [ 2drop 252 _exit ] recover
|
||||
[ "." absolute-path cd ] [ 2drop 252 _exit ] recover
|
||||
[ setup-environment ] [ 2drop 253 _exit ] recover
|
||||
[ get-arguments exec-args-with-path ] [ 2drop 254 _exit ] recover
|
||||
255 _exit
|
||||
|
|
|
@ -60,14 +60,8 @@ ERROR: header-file-missing path ;
|
|||
drop
|
||||
] if* ;
|
||||
|
||||
:: read-local-include ( preprocessor-state path -- )
|
||||
current-directory get path append-path dup :> full-path
|
||||
dup exists? [
|
||||
[ preprocessor-state ] dip preprocess-file
|
||||
] [
|
||||
! full-path header-file-missing
|
||||
drop
|
||||
] if ;
|
||||
: read-local-include ( preprocessor-state path -- )
|
||||
dup exists? [ preprocess-file ] [ 2drop ] if ;
|
||||
|
||||
: skip-whitespace/comments ( sequence-parser -- sequence-parser )
|
||||
skip-whitespace
|
||||
|
|
|
@ -11,7 +11,7 @@ IN: file-monitor
|
|||
"%u %s\n" printf flush file-monitor-loop ;
|
||||
|
||||
: file-monitor-main ( -- )
|
||||
command-line get ?first current-directory get or
|
||||
command-line get ?first "." or
|
||||
dup "Monitoring %s\n" printf flush
|
||||
[ t [ file-monitor-loop ] with-monitor ] with-monitors ;
|
||||
|
||||
|
|
|
@ -28,8 +28,7 @@ IN: file-server
|
|||
|
||||
: file-server-main ( -- )
|
||||
[
|
||||
command-line get file-server-args
|
||||
current-directory get or
|
||||
command-line get file-server-args "." or
|
||||
<static>
|
||||
t >>allow-listings
|
||||
swap [ enable-cgi ] when
|
||||
|
|
|
@ -40,8 +40,7 @@ SYMBOLS: supported-layouts supported-formats ;
|
|||
! -O flag, so just look to see that there seems to be some sort
|
||||
! of output.
|
||||
: graphviz-output-appears-to-exist? ( base -- ? )
|
||||
current-directory get directory-files
|
||||
[ swap head? ] with count 1 = ;
|
||||
"." directory-files [ swap head? ] with count 1 = ;
|
||||
|
||||
: next! ( seq -- elt ) [ first ] [ 1 rotate! ] bi ;
|
||||
|
||||
|
|
|
@ -9,8 +9,7 @@ IN: mason.disk
|
|||
: sufficient-disk-space? ( -- ? )
|
||||
! We want at least 300Mb to be available before starting
|
||||
! a build.
|
||||
current-directory get file-system-info available-space>>
|
||||
gb > ;
|
||||
"." file-system-info available-space>> gb > ;
|
||||
|
||||
: check-disk-space ( -- )
|
||||
sufficient-disk-space? [
|
||||
|
|
|
@ -50,8 +50,7 @@ IN: spotlight
|
|||
PRIVATE>
|
||||
|
||||
: mdfind ( query -- results )
|
||||
current-directory get "/" or swap
|
||||
"mdfind -onlyin %s %s" sprintf run-process-output ;
|
||||
"mdfind -onlyin . %s" sprintf run-process-output ;
|
||||
|
||||
: mdfind. ( query -- )
|
||||
mdfind [ dup <pathname> write-object nl ] each ;
|
||||
|
|
|
@ -85,12 +85,9 @@ M: unknown-typeflag summary
|
|||
: read/write-blocks ( header path -- )
|
||||
binary [ read-data-blocks ] with-file-writer ;
|
||||
|
||||
: prepend-current-directory ( path -- path' )
|
||||
current-directory get prepend-path ;
|
||||
|
||||
! Normal file
|
||||
: typeflag-0 ( header -- )
|
||||
dup name>> prepend-current-directory read/write-blocks ;
|
||||
dup name>> read/write-blocks ;
|
||||
|
||||
TUPLE: hard-link linkname name ;
|
||||
C: <hard-link> hard-link
|
||||
|
@ -114,7 +111,7 @@ C: <symbolic-link> symbolic-link
|
|||
|
||||
! Directory
|
||||
: typeflag-5 ( header -- )
|
||||
name>> prepend-current-directory make-directories ;
|
||||
name>> make-directories ;
|
||||
|
||||
! FIFO
|
||||
: typeflag-6 ( header -- ) unknown-typeflag ;
|
||||
|
@ -158,7 +155,7 @@ C: <symbolic-link> symbolic-link
|
|||
;
|
||||
! [ read-data-blocks ] with-string-writer
|
||||
! [ zero? ] trim-tail filename set
|
||||
! filename get prepend-current-directory make-directories ;
|
||||
! filename get make-directories ;
|
||||
|
||||
! Multi volume continuation entry
|
||||
: typeflag-M ( header -- ) unknown-typeflag ;
|
||||
|
@ -211,12 +208,10 @@ C: <symbolic-link> symbolic-link
|
|||
GENERIC: do-link ( object -- )
|
||||
|
||||
M: hard-link do-link
|
||||
[ linkname>> ]
|
||||
[ name>> prepend-current-directory ] bi make-hard-link ;
|
||||
[ linkname>> ] [ name>> ] bi make-hard-link ;
|
||||
|
||||
M: symbolic-link do-link
|
||||
[ linkname>> ]
|
||||
[ name>> prepend-current-directory ] bi make-link ;
|
||||
[ linkname>> ] [ name>> ] bi make-link ;
|
||||
|
||||
! FIXME: linux tar calls unlinkat and makelinkat
|
||||
: make-links ( -- )
|
||||
|
|
|
@ -52,7 +52,7 @@ DEFER: write-tree
|
|||
|
||||
: run-tree ( -- )
|
||||
command-line get [
|
||||
current-directory get tree
|
||||
"." tree
|
||||
] [
|
||||
[ tree ] each
|
||||
] if-empty ;
|
||||
|
|
Loading…
Reference in New Issue