From d825e09dac796ed69d083feb6a033b68b66de499 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-25 divoplade * module/ice-9/ports.scm (open-output-file): add a mkdir 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 | 75 ++++++++++++++++++++++-------------------- 3 files changed, 57 insertions(+), 40 deletions(-) diff --git a/NEWS b/NEWS index 94a3f3154..09e06a7ba 100644 --- a/NEWS +++ b/NEWS @@ -19,7 +19,11 @@ many similar clauses whose first differentiator are constants. ** New function mkdir-recursive This function will try and create the directory and parent directories, -up to a directory that can be opened or the root. +up to a directory that can be opened or the root. 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 `#:mkdir' 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..dabceb646 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] [#:mkdir=#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 @var{mkdir} + (mkdir-recursive (dirname @var{filename}))) (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] [#:mkdir=#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{mkdir} 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] [#:mkdir=#f] @deffnx {Scheme Procedure} with-error-to-file filename thunk @ - [#:encoding=#f] [#:binary=#f] + [#:encoding=#f] [#:binary=#f] [#:mkdir=#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{mkdir} 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 d85e48107..78a31619e 100644 --- a/module/ice-9/ports.scm +++ b/module/ice-9/ports.scm @@ -425,11 +425,14 @@ directory, or up to the root." #t (mkdir-recursive (dirname name)))))) -(define* (open-output-file file #:key (binary #f) (encoding #f)) +(define* (open-output-file file #:key (binary #f) (encoding #f) (mkdir #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." +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. If @var{mkdir} is +true, recursively create the directory of @var{file}." + (when mkdir + (mkdir-p (dirname file))) (open-file file (if binary "wb" "w") #:encoding encoding)) @@ -459,18 +462,18 @@ 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) (mkdir #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 -with one argument: the port obtained by opening the named file for -input or output. If the file cannot be opened, an error is -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))) +string naming a file. The behaviour is unspecified if the file already +exists. These procedures call PROC with one argument: the port obtained +by opening the named file for input or output. If the file cannot be +opened, an error is 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. When MKDIR is true, +create FILE's directory and all its parents." + (let ((p (open-output-file file #:binary binary #:encoding encoding #:mkdir mkdir))) (call-with-values (lambda () (proc p)) (lambda vals @@ -506,35 +509,37 @@ procedures, their behavior is implementation dependent." #:encoding encoding #:guess-encoding guess-encoding)) -(define* (with-output-to-file file thunk #:key (binary #f) (encoding #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. +(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #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 -the default value returned by `current-output-port', -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." +the default value returned by `current-output-port', 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. When +MKDIR 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 + #:mkdir mkdir)) -(define* (with-error-to-file file thunk #:key (binary #f) (encoding #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. +(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f) (mkdir #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 -the default value returned by `current-error-port', -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." +the default value returned by `current-error-port', 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. When +MKDIR is true, the directory of FILE and all its parents are created." (call-with-output-file file (lambda (p) (with-error-to-port p thunk)) #:binary binary - #:encoding encoding)) + #:encoding encoding + #:mkdir mkdir)) (define (call-with-input-string string proc) "Calls the one-argument procedure @var{proc} with a newly created -- 2.28.0