summaryrefslogtreecommitdiff
path: root/scm
diff options
context:
space:
mode:
authorDirk-Jan C. Binnema <djcb@djcbsoftware.nl>2025-07-08 19:04:31 +0300
committerDirk-Jan C. Binnema <djcb@djcbsoftware.nl>2025-07-12 09:35:37 +0300
commit7b4aea432ec37951d518ab9434fb7b4b983d202d (patch)
treec4dcb5f177833e4c92a0b6b9579efee5e0bf0f3c /scm
parent5fdb13fd7273e9431001c68ad873ed54209b9ab9 (diff)
mu-scm: add filename procedure for mime-part
Diffstat (limited to 'scm')
-rw-r--r--scm/mu-scm-test.scm6
-rw-r--r--scm/mu-scm.scm31
-rw-r--r--scm/mu-scm.texi12
3 files changed, 34 insertions, 15 deletions
diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm
index e45bcc8..bde7648 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 197796b..445921c 100644
--- a/scm/mu-scm.scm
+++ b/scm/mu-scm.scm
@@ -28,6 +28,7 @@
<mime-part>
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 <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-<index>' with <index> 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-<index>' with
<index> 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)))
-
-(define* (write-to-file mime-part #:key (filename #f) (overwrite? #f))
+ (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 (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-<index>' with
<index> 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 19bd0aa..517cf82 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}.