From: John Benediktsson Date: Sat, 19 Mar 2016 00:04:05 +0000 (-0700) Subject: cleanup some uses of current-directory. X-Git-Tag: unmaintained~1479 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=9c323e28841725b4afb776195adb3029ce5ec263 cleanup some uses of current-directory. --- diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index 63ceec6d76..5d10a125ff 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -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 ; diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor index e243e0b9eb..3352f3e9bf 100644 --- a/basis/help/cookbook/cookbook.factor +++ b/basis/help/cookbook/cookbook.factor @@ -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 diff --git a/basis/io/launcher/unix/unix.factor b/basis/io/launcher/unix/unix.factor index cccb91ab1b..89d161c6f8 100644 --- a/basis/io/launcher/unix/unix.factor +++ b/basis/io/launcher/unix/unix.factor @@ -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 diff --git a/extra/c/preprocessor/preprocessor.factor b/extra/c/preprocessor/preprocessor.factor index 55e11edde5..0ccdf462b1 100644 --- a/extra/c/preprocessor/preprocessor.factor +++ b/extra/c/preprocessor/preprocessor.factor @@ -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 diff --git a/extra/file-monitor/file-monitor.factor b/extra/file-monitor/file-monitor.factor index cacabcd678..eebf1a7fed 100644 --- a/extra/file-monitor/file-monitor.factor +++ b/extra/file-monitor/file-monitor.factor @@ -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 ; diff --git a/extra/file-server/file-server.factor b/extra/file-server/file-server.factor index e9da5a61ee..dd71793e2a 100644 --- a/extra/file-server/file-server.factor +++ b/extra/file-server/file-server.factor @@ -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 t >>allow-listings swap [ enable-cgi ] when diff --git a/extra/graphviz/graphviz-tests.factor b/extra/graphviz/graphviz-tests.factor index 032cbf1a4b..4cd58c1260 100644 --- a/extra/graphviz/graphviz-tests.factor +++ b/extra/graphviz/graphviz-tests.factor @@ -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 ; diff --git a/extra/mason/disk/disk.factor b/extra/mason/disk/disk.factor index 816ee3ea68..214b8f13fe 100644 --- a/extra/mason/disk/disk.factor +++ b/extra/mason/disk/disk.factor @@ -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? [ diff --git a/extra/spotlight/spotlight.factor b/extra/spotlight/spotlight.factor index a6a7a671af..b368b7ed3e 100644 --- a/extra/spotlight/spotlight.factor +++ b/extra/spotlight/spotlight.factor @@ -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 write-object nl ] each ; diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 1417c07eed..4e9faf1ac5 100644 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -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 @@ -114,7 +111,7 @@ C: 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 ; ! [ 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 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 ( -- ) diff --git a/extra/tools/tree/tree.factor b/extra/tools/tree/tree.factor index b94af10b66..3e87b80f9a 100644 --- a/extra/tools/tree/tree.factor +++ b/extra/tools/tree/tree.factor @@ -52,7 +52,7 @@ DEFER: write-tree : run-tree ( -- ) command-line get [ - current-directory get tree + "." tree ] [ [ tree ] each ] if-empty ;