]> gitweb.factorcode.org Git - factor.git/commitdiff
io.files: using some of the new file-exists combinators
authorJohn Benediktsson <mrjbq7@gmail.com>
Fri, 1 Sep 2023 17:10:37 +0000 (10:10 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Fri, 1 Sep 2023 17:14:00 +0000 (10:14 -0700)
13 files changed:
basis/command-line/command-line.factor
basis/globs/globs.factor
basis/io/directories/directories.factor
basis/tools/scaffold/scaffold.factor
basis/vocabs/metadata/metadata.factor
basis/vocabs/refresh/monitor/monitor.factor
core/parser/parser.factor
extra/gemini/cli/cli.factor
extra/gemini/server/server.factor
extra/gopher/cli/cli.factor
extra/gopher/server/server.factor
extra/mason/cleanup/cleanup.factor
extra/tools/cat/cat.factor

index 45bf17af533fa5f1e0291ca4cca9f05faf05d761..4ec8815b20d5cdfcb2345a76f955785ca441f93a 100644 (file)
@@ -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
index 3c1a9a2cab6b6f7545afe63fd3b631dace00a5d4..bf79ae98a47890c3710d7e6fc607f8fdd2091c3c 100644 (file)
@@ -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 {
index be5af4e064a6a0926ab6cab7fcc34da74c6d5b13..5b30462c112f5f34458ccbb0b747574a37dfad65 100644 (file)
@@ -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
 
index c18810c5c5681121f9d0c219edcf3d710bd8b0d5..dc9eaea1eecc269bcb0c2a803a645d2cc03028b2 100644 (file)
@@ -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 <pathname> . ;
@@ -67,7 +67,7 @@ ERROR: vocab-must-not-exist string ;
     "Creating scaffolding for " write dup <pathname> . ;
 
 : 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
index 169a9e82404ffa896d5a9297183c04a08a0aa9a2..6ffbece58be589118e3a62accfaac6164362dcb5 100644 (file)
@@ -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 )
     [
index f063cc42f396617fe81d097c2a7ec558e7a2c2d7..c73a525565fe34f909b20a43f7cf679715afead2 100644 (file)
@@ -44,8 +44,7 @@ TR: convert-separators "/\\" ".." ;
     ] [ monitor-loop ] bi ;
 
 : (start-vocab-monitor) ( vocab-root -- )
-    dup file-exists?
-    [ [ t <monitor> monitor-loop ] with-monitors ] [ drop ] if ;
+    [ [ t <monitor> monitor-loop ] with-monitors ] when-file-exists ;
 
 : start-vocab-monitor ( vocab-root -- )
     [
index 65d20d3f0eb39df14ba87022082b1a72dc2bf463..40f5b6e813d219ac57793784f5d4fd48c18b02be 100644 (file)
@@ -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 ;
index 798e63302778828b38d87d15d4424a473bf06a8e..a914897b2f5d921e382fb8ab021c104b9f8496cc 100644 (file)
@@ -123,14 +123,14 @@ CONSTANT: URL V{ }
     ] when* ;
 
 : gemini-less ( -- )
-    "gemini.txt" temp-file dup file-exists? [
+    "gemini.txt" temp-file [
         utf8 [
             <process>
                 "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 ;
index fb7fed7bbd0498fa1ae158498c119efeb8906031..d4fd4b590284c40fb309d14504e03de673ad939c 100644 (file)
@@ -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>> ;
index c591c4466590113b9f9f470da5eb2844dd5f8478..be5480115a17210c27f7bf8e31dbc0ab7d799ea8 100644 (file)
@@ -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 [
             <process>
                 "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 ;
index 8607754b82ab130383d63eb065f0072e5f44bbd2..8acd27d635ff60aff8de3af3baf0dd087e9f24fa 100644 (file)
@@ -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*
index eb27b83ef97f447019cc791dbad8027df7155324..e76ae76c193e7211c03474a7bc5b31ac80a5e350 100644 (file)
@@ -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 ;
index 73d2b0fac1a935e4e5a6d4f92f44629d71f5259a..c04d6917440b85a68692d00fea74758378e1e10b 100644 (file)
@@ -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 ;