From: John Benediktsson Date: Fri, 1 Sep 2023 17:10:37 +0000 (-0700) Subject: io.files: using some of the new file-exists combinators X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=589f0e83c82107ef260e60a61d3ff2b5a9c7add3 io.files: using some of the new file-exists combinators --- diff --git a/basis/command-line/command-line.factor b/basis/command-line/command-line.factor index 45bf17af53..4ec8815b20 100644 --- a/basis/command-line/command-line.factor +++ b/basis/command-line/command-line.factor @@ -46,9 +46,9 @@ SYMBOL: command-line : load-vocab-roots ( -- ) "user-init" get [ - "~/.factor-roots" dup file-exists? [ + "~/.factor-roots" [ utf8 file-lines harvest [ add-vocab-root ] each - ] [ drop ] if + ] when-file-exists "roots" get [ os windows? ";" ":" ? split [ add-vocab-root ] each diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor index 3c1a9a2cab..bf79ae98a4 100644 --- a/basis/globs/globs.factor +++ b/basis/globs/globs.factor @@ -123,11 +123,9 @@ DEFER: glob% :: glob-literal% ( root globs -- ) globs unclip :> ( remaining glob ) - root glob append-path dup file-exists? [ + root glob append-path [ remaining over file-info ?glob% - ] [ - drop - ] if ; + ] when-file-exists ; : glob% ( root globs -- ) dup ?first { diff --git a/basis/io/directories/directories.factor b/basis/io/directories/directories.factor index be5af4e064..5b30462c11 100644 --- a/basis/io/directories/directories.factor +++ b/basis/io/directories/directories.factor @@ -249,7 +249,7 @@ M: object copy-file ] [ delete-file ] if ; : ?delete-tree ( path -- ) - dup file-exists? [ delete-tree ] [ drop ] if ; + [ delete-tree ] when-file-exists ; DEFER: copy-trees-into diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index c18810c5c5..dc9eaea1ee 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -58,7 +58,7 @@ ERROR: vocab-must-not-exist string ; : scaffold-directory ( vocab-root vocab -- ) vocab-root/vocab>path - dup file-exists? [ directory-exists ] [ make-directories ] if ; + [ directory-exists ] [ make-directories ] if-file-exists ; : not-scaffolding ( path -- path ) "Not creating scaffolding for " write dup . ; @@ -67,7 +67,7 @@ ERROR: vocab-must-not-exist string ; "Creating scaffolding for " write dup . ; : scaffolding? ( path -- path ? ) - dup file-exists? [ not-scaffolding f ] [ scaffolding t ] if ; + [ not-scaffolding f ] [ scaffolding t ] if-file-exists ; : scaffold-copyright ( -- ) "! Copyright (C) " write now year>> number>string write diff --git a/basis/vocabs/metadata/metadata.factor b/basis/vocabs/metadata/metadata.factor index 169a9e8240..6ffbece58b 100644 --- a/basis/vocabs/metadata/metadata.factor +++ b/basis/vocabs/metadata/metadata.factor @@ -99,7 +99,7 @@ M: unsupported-platform summary drop "Current operating system not supported by this vocabulary" ; : file-exists?, ( path -- ) - [ dup file-exists? [ , ] [ drop ] if ] when* ; + [ [ , ] when-file-exists ] when* ; : vocab-metadata-files ( vocab -- paths ) [ diff --git a/basis/vocabs/refresh/monitor/monitor.factor b/basis/vocabs/refresh/monitor/monitor.factor index f063cc42f3..c73a525565 100644 --- a/basis/vocabs/refresh/monitor/monitor.factor +++ b/basis/vocabs/refresh/monitor/monitor.factor @@ -44,8 +44,7 @@ TR: convert-separators "/\\" ".." ; ] [ monitor-loop ] bi ; : (start-vocab-monitor) ( vocab-root -- ) - dup file-exists? - [ [ t monitor-loop ] with-monitors ] [ drop ] if ; + [ [ t monitor-loop ] with-monitors ] when-file-exists ; : start-vocab-monitor ( vocab-root -- ) [ diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 65d20d3f0e..40f5b6e813 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -239,6 +239,6 @@ SYMBOL: bootstrap-syntax parse-file call( -- ) ; : ?run-file ( path -- ) - dup file-exists? [ run-file ] [ drop ] if ; + [ run-file ] when-file-exists ; ERROR: version-control-merge-conflict ; diff --git a/extra/gemini/cli/cli.factor b/extra/gemini/cli/cli.factor index 798e633027..a914897b2f 100644 --- a/extra/gemini/cli/cli.factor +++ b/extra/gemini/cli/cli.factor @@ -123,14 +123,14 @@ CONSTANT: URL V{ } ] when* ; : gemini-less ( -- ) - "gemini.txt" temp-file dup file-exists? [ + "gemini.txt" temp-file [ utf8 [ "PAGER" os-env [ "less" ] unless* >>command input-stream get >>stdin try-process ] with-file-reader - ] [ drop ] if ; + ] when-file-exists ; : gemini-ls ( args -- ) [ PAGE ] [ "-l" = ] bi* print-links ; diff --git a/extra/gemini/server/server.factor b/extra/gemini/server/server.factor index fb7fed7bbd..d4fd4b5902 100644 --- a/extra/gemini/server/server.factor +++ b/extra/gemini/server/server.factor @@ -73,13 +73,13 @@ TUPLE: gemini-server < threaded-server ] with-directory-entries ; : send-directory ( server path -- ) - dup ".geminimap" append-path dup file-exists? [ + dup ".geminimap" append-path [ send-file 2drop ] [ drop dup ".geminihead" append-path - dup file-exists? [ send-file ] [ drop ] if + [ send-file ] when-file-exists list-directory - ] if ; + ] if-file-exists ; : read-gemini-path ( -- path ) readln utf8 decode "\r" ?tail drop >url path>> ; diff --git a/extra/gopher/cli/cli.factor b/extra/gopher/cli/cli.factor index c591c44665..be5480115a 100644 --- a/extra/gopher/cli/cli.factor +++ b/extra/gopher/cli/cli.factor @@ -121,14 +121,14 @@ CONSTANT: URL V{ } 1 stack-url [ gopher-get ] when* ; : gopher-less ( -- ) - "gopher.txt" temp-file dup file-exists? [ + "gopher.txt" temp-file [ utf8 [ "PAGER" os-env [ "less" ] unless* >>command input-stream get >>stdin try-process ] with-file-reader - ] [ drop ] if ; + ] when-file-exists ; : gopher-ls ( args -- ) [ PAGE ] [ "-l" = ] bi* print-links ; diff --git a/extra/gopher/server/server.factor b/extra/gopher/server/server.factor index 8607754b82..8acd27d635 100644 --- a/extra/gopher/server/server.factor +++ b/extra/gopher/server/server.factor @@ -83,13 +83,13 @@ TUPLE: gopher-server < threaded-server ] with-directory-entries ; : send-directory ( server path -- ) - dup ".gophermap" append-path dup file-exists? [ + dup ".gophermap" append-path [ send-file 2drop ] [ drop dup ".gopherhead" append-path - dup file-exists? [ send-file ] [ drop ] if + [ send-file ] when-file-exists list-directory - ] if ; + ] if-file-exists ; : read-gopher-path ( -- path ) readln dup [ "\t\r\n" member? ] find drop [ head ] when* diff --git a/extra/mason/cleanup/cleanup.factor b/extra/mason/cleanup/cleanup.factor index eb27b83ef9..e76ae76c19 100644 --- a/extra/mason/cleanup/cleanup.factor +++ b/extra/mason/cleanup/cleanup.factor @@ -5,9 +5,7 @@ mason.config mason.platform namespaces ; IN: mason.cleanup : compress ( filename -- ) - dup file-exists? [ - "bzip2" swap 2array short-running-process - ] [ drop ] if ; + [ "bzip2" swap 2array short-running-process ] when-file-exists ; : compress-image ( -- ) target-boot-image-name compress ; diff --git a/extra/tools/cat/cat.factor b/extra/tools/cat/cat.factor index 73d2b0fac1..c04d691744 100644 --- a/extra/tools/cat/cat.factor +++ b/extra/tools/cat/cat.factor @@ -12,9 +12,8 @@ IN: tools.cat '[ _ [ stream-write ] [ stream-flush ] bi ] each-stream-block ; : cat-file ( path -- ) - dup file-exists? [ - binary [ cat-stream ] with-file-reader - ] [ write ": not found" print flush ] if ; + [ binary [ cat-stream ] with-file-reader ] + [ write ": not found" print flush ] if-file-exists ; : cat-files ( paths -- ) [ dup "-" = [ drop cat-stream ] [ cat-file ] if flush ] each ;