diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm index e45bcc89..bde76488 100644 --- a/scm/mu-scm-test.scm +++ b/scm/mu-scm-test.scm @@ -121,10 +121,14 @@ ((index . 2) (content-type . "image/jpeg") (size . 21566) (filename . "custer.jpg"))) (map (lambda (part) (mime-part->alist part)) (mime-parts msg))) + (test-equal "mime-part-0" (filename (list-ref (mime-parts msg) 0))) + (test-equal "sittingbull.jpg" (filename (list-ref (mime-parts msg) 1))) + (test-equal "custer.jpg" (filename (list-ref (mime-parts msg) 2))) + (let* ((part (list-ref (mime-parts msg) 1)) (alist (mime-part->alist part)) (fname (format #f "~a/~a" tmpdir (assoc-ref alist 'filename)))) - (write-to-file part #:filename fname) + (write-to-file part #:path fname) (test-assert (access? fname R_OK)) ;; note, the 23881 is the _encoded_ size. (test-equal 17674 (stat:size (stat fname)))) diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index 197796ba..445921c6 100644 --- a/scm/mu-scm.scm +++ b/scm/mu-scm.scm @@ -28,6 +28,7 @@ mime-part->alist make-port + filename write-to-file ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Message @@ -159,27 +160,33 @@ If DECODE? is #t, decode the content (from e.g., base64); in that case, CONTENT-ONLY? is implied to be #t." (cc-mime-make-stream-port (slot-ref mime-part 'mimepart) content-only? decode?)) -(define* (make-output-file mime-part #:key (filename #f) (overwrite? #f)) +(define-method (filename (mime-part )) + "Determine the file-name for MIME-part. +Either the 'filename' field in the mime-part and if that does not exist, use +'mime-part-' with being the number of the mime-part." + (let ((alist (mime-part->alist mime-part))) + (or (assoc-ref alist 'filename) + (format #f "mime-part-~d" (assoc-ref alist 'index))))) + +(define* (make-output-file mime-part #:key (path #f) (overwrite? #f)) "Create a port for the file to write MIME-PART to. -FILENAME is the path to the file name. If not specified, use the 'filename' +PATH is file-name or path to the file name. If not specified, use the 'filename' field in the mime-part and if that does not exist, use 'mime-part-' with being the number of the mime-part. OVERWRITE? specifies whether existing files by the same name or overwritten. Otherwise, trying to overwrite an existing file raises an error." (let* ((alist (mime-part->alist mime-part)) - (filename (or filename - (assoc-ref alist 'filename) - (format #f "mime-part-~d" (assoc-ref alist 'index))))) - ;; we need an fd-based port since we want to support overwrite? - (open filename - (logior O_WRONLY O_CREAT O_TRUNC (if overwrite? O_EXCL 0)) #o644))) + (path (or path (filename mime-part)))) + ;; we need an fd-based port since we want to support overwrite? + (open path + (logior O_WRONLY O_CREAT O_TRUNC (if overwrite? O_EXCL 0)) #o644))) -(define* (write-to-file mime-part #:key (filename #f) (overwrite? #f)) +(define* (write-to-file mime-part #:key (path #f) (overwrite? #f)) "Write MIME-PART to a file. -FILENAME is the path to the file name. If not specified, use the 'filename' +PATH is the path/filename for the file. If not specified, use the 'filename' field in the mime-part and if that does not exist, use 'mime-part-' with being the number of the mime-part. @@ -187,7 +194,7 @@ OVERWRITE? specifies whether existing files by the same name or overwritten. Otherwise, trying to overwrite an existing file raises an error." (let* ((input (make-port mime-part)) (output (make-output-file mime-part - #:filename filename #:overwrite? overwrite?)) + #:path path #:overwrite? overwrite?)) (buf (make-bytevector 4096)) ;; just a guess... (bytes 0)) (while (not (eof-object? bytes)) ;; XXX do this in a more elegant way. diff --git a/scm/mu-scm.texi b/scm/mu-scm.texi index 19bd0aae..517cf82c 100644 --- a/scm/mu-scm.texi +++ b/scm/mu-scm.texi @@ -515,12 +515,20 @@ case, @code{content-only?} is implied to be #t. Write MIME-part to file. Use @code{filename} is the file/path to use for writing; if this is @code{#f}, -the name is taken from the @t{filename} property of the MIME-part alist. If that -does not exist, a generic name is chosen. +the name using the @code{filename} procedure. If @code{overwrite?} is true, overwrite existing files of the same name; otherwise, raise an error if the file already exists. + +@deffn {Scheme Procedure} filename mime-part +@end deffn +Determine a filename for the given MIME-part. + +This is either taken from the @t{filename} property of the MIME-part alist, or, +If that does not exist, a generic name. + + @subsection Contacts Message fields @t{To:}, @t{From:}, @t{Cc:} and @t{Bcc:} contain @emph{contacts}.