From 0e6c74700d2eeb2142ff17ecdb0973806cf79b68 Mon Sep 17 00:00:00 2001 From: divoplade Date: Sat, 24 Oct 2020 00:35:01 +0200 Subject: [PATCH 2/2] Use the recursive mkdir function in file output procedures 2020-10-23 divoplade * module/ice-9/ports.scm (open-output-file): add a recursive keyword to try to recursively create the directory of the output file. * module/ice-9/ports.scm (call-with-output-file): same. * module/ice-9/ports.scm (with-output-to-file): same. * module/ice-9/ports.scm (with-error-to-file): same. * doc/ref/api-io.texi: document the new keyword argument for opening output files. * NEWS: indicate that the open output function can now create the filename directory if it does not exist. --- NEWS | 6 +++++- doc/ref/api-io.texi | 16 ++++++++++++---- module/ice-9/ports.scm | 28 ++++++++++++++++++---------- 3 files changed, 35 insertions(+), 15 deletions(-) diff --git a/NEWS b/NEWS index 765f3d2a3..f302f5fdc 100644 --- a/NEWS +++ b/NEWS @@ -19,7 +19,11 @@ many similar clauses whose first differentiator are constants. ** Additional optional argument in `mkdir' to create the directory recursively When the third argument to mkdir is true, the intermediate directories -are created. +are created. This behavior is included in open-output-file, +call-with-output-file, with-output-to-file and with-error-to-file by +adding a keyword argument +#:recursive which, when set to #t, creates the directories before trying +to open the file. * Incompatible changes diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index ecbd35585..7409e6699 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -1036,13 +1036,15 @@ for @code{open-file}. Equivalent to @rnindex open-output-file @deffn {Scheme Procedure} open-output-file filename @ - [#:encoding=#f] [#:binary=#f] + [#:encoding=#f] [#:binary=#f] [#:recursive=#f] Open @var{filename} for output. If @var{binary} is true, open the port in binary mode, otherwise use text mode. @var{encoding} specifies the character encoding as described above for @code{open-file}. Equivalent to @lisp +(when recursive + (mkdir (dirname @var{filename}) #o777 #t)) (open-file @var{filename} (if @var{binary} "wb" "w") #:encoding @var{encoding}) @@ -1052,7 +1054,7 @@ to @deffn {Scheme Procedure} call-with-input-file filename proc @ [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f] @deffnx {Scheme Procedure} call-with-output-file filename proc @ - [#:encoding=#f] [#:binary=#f] + [#:encoding=#f] [#:binary=#f] [#:recursive=#f] @rnindex call-with-input-file @rnindex call-with-output-file Open @var{filename} for input or output, and call @code{(@var{proc} @@ -1065,14 +1067,17 @@ When @var{proc} returns, the port is closed. If @var{proc} does not return (e.g.@: if it throws an error), then the port might not be closed automatically, though it will be garbage collected in the usual way if not otherwise referenced. + +If @var{recursive} is true, create @var{filename}'s directory and all +its parents. @end deffn @deffn {Scheme Procedure} with-input-from-file filename thunk @ [#:guess-encoding=#f] [#:encoding=#f] [#:binary=#f] @deffnx {Scheme Procedure} with-output-to-file filename thunk @ - [#:encoding=#f] [#:binary=#f] + [#:encoding=#f] [#:binary=#f] [#:recursive=#f] @deffnx {Scheme Procedure} with-error-to-file filename thunk @ - [#:encoding=#f] [#:binary=#f] + [#:encoding=#f] [#:binary=#f] [#:recursive=#f] @rnindex with-input-from-file @rnindex with-output-to-file Open @var{filename} and call @code{(@var{thunk})} with the new port @@ -1095,6 +1100,9 @@ exited via an exception or new continuation. This ensures it's still ready for use if @var{thunk} is re-entered by a captured continuation. Of course the port is always garbage collected and closed in the usual way when no longer referenced anywhere. + +If @var{recursive} is true, then @var{filename}'s directory and all its +parents are created. @end deffn @deffn {Scheme Procedure} port-mode port diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm index dbc7ef7a7..08ba0cff9 100644 --- a/module/ice-9/ports.scm +++ b/module/ice-9/ports.scm @@ -413,11 +413,15 @@ cannot be opened, an error is signalled." #:encoding encoding #:guess-encoding guess-encoding)) -(define* (open-output-file file #:key (binary #f) (encoding #f)) +(define* (open-output-file file #:key (binary #f) (encoding #f) (recursive #f)) "Takes a string naming an output file to be created and returns an output port capable of writing characters to a new file by that name. If the file cannot be opened, an error is signalled. If a -file with the given name already exists, the effect is unspecified." +file with the given name already exists, the effect is unspecified. +If @var{recursive} is true, recursively create the directory of +@var{file}." + (when recursive + (mkdir (dirname file) #o777 #t)) (open-file file (if binary "wb" "w") #:encoding encoding)) @@ -447,7 +451,7 @@ never again be used for a read or write operation." (close-input-port p) (apply values vals))))) -(define* (call-with-output-file file proc #:key (binary #f) (encoding #f)) +(define* (call-with-output-file file proc #:key (binary #f) (encoding #f) (recursive #f)) "PROC should be a procedure of one argument, and FILE should be a string naming a file. The behaviour is unspecified if the file already exists. These procedures call PROC @@ -457,8 +461,9 @@ signalled. If the procedure returns, then the port is closed automatically and the values yielded by the procedure are returned. If the procedure does not return, then the port will not be closed automatically unless it is possible to prove that the port will -never again be used for a read or write operation." - (let ((p (open-output-file file #:binary binary #:encoding encoding))) +never again be used for a read or write operation. When RECURSIVE is +true, create FILE's directory and all its parents." + (let ((p (open-output-file file #:binary binary #:encoding encoding #:recursive recursive))) (call-with-values (lambda () (proc p)) (lambda vals @@ -494,7 +499,7 @@ procedures, their behavior is implementation dependent." #:encoding encoding #:guess-encoding guess-encoding)) -(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f)) +(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f) (recursive #f)) "THUNK must be a procedure of no arguments, and FILE must be a string naming a file. The effect is unspecified if the file already exists. The file is opened for output, an output port connected to it is made @@ -503,13 +508,15 @@ and the THUNK is called with no arguments. When the THUNK returns, the port is closed and the previous default is restored. Returns the values yielded by THUNK. If an escape procedure is used to escape from the continuation of these -procedures, their behavior is implementation dependent." +procedures, their behavior is implementation dependent. When RECURSIVE +is true, the directory of FILE and all its parents are created." (call-with-output-file file (lambda (p) (with-output-to-port p thunk)) #:binary binary - #:encoding encoding)) + #:encoding encoding + #:recursive recursive)) -(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f)) +(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f) (recursive #f)) "THUNK must be a procedure of no arguments, and FILE must be a string naming a file. The effect is unspecified if the file already exists. The file is opened for output, an output port connected to it is made @@ -522,7 +529,8 @@ procedures, their behavior is implementation dependent." (call-with-output-file file (lambda (p) (with-error-to-port p thunk)) #:binary binary - #:encoding encoding)) + #:encoding encoding + #:recursive recursive)) (define (call-with-input-string string proc) "Calls the one-argument procedure @var{proc} with a newly created -- 2.28.0