From 58f6fd70b893d28e253a1d3dfb9c3d66f0a02ac5 Mon Sep 17 00:00:00 2001 From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com> Date: Sun, 18 Feb 2024 19:22:55 -0600 Subject: [PATCH] Add WRITE-VCARD function to complement READ-VCARD --- vcarded.scm | 60 ++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 41 insertions(+), 19 deletions(-) diff --git a/vcarded.scm b/vcarded.scm index 9a98c49..285cd45 100644 --- a/vcarded.scm +++ b/vcarded.scm @@ -14,7 +14,7 @@ ;; along with this program. If not, see . (module vcarded - (read-vcard) + (read-vcard write-vcard) (import scheme @@ -203,7 +203,7 @@ ;; Given a vCard property and its values (e.g., “VERSION” and “3.0”), ;; parse them into a list. - ;; “EMAIL;TYPE=home” "mom@dad.com” → '(EMAIL ("TYPE=home") "mom@dad.com") + ;; "EMAIL;TYPE=home" "mom@dad.com" → '(EMAIL ("TYPE=home") "mom@dad.com") (define (parse-vcard-property property elements) (append (list property) (list elements))) @@ -257,27 +257,28 @@ ;; Reader thunk. Read/parse an entire vCard into a “vCard alist.” + ;; vCard is read from an optional PORT, defaulting to (current-input-port). ;; Ignore the IGNORED parameter. - (define (read-vcard . ignored) - (let* [(first-element? (optional ignored #t)) - (element (read-vcard-element first-element?))] - (if (not (eof-object? (peek-char))) - (append (list element) (read-vcard #f)) + (define (read-vcard #!optional (port (current-input-port)) (ignored #t)) + (let* [(first-element? ignored) + (element (read-vcard-element port first-element?))] + (if (not (eof-object? (peek-char port))) + (append (list element) (read-vcard port #f)) (list element)))) + ;; Read a single unfolded line into a vCard “element” list. ;; The optional FIRST-ELEMENT? argument simply makes sure the next line is a ;; BEGIN:VCARD element (as the first element in any valid vCard file should ;; be. It is used internally by READ-VCARD. - (define (read-vcard-element . first-element?) - (let* [(first-element? (optional first-element? #f)) - (line (read-folded-line (if first-element? 100 #f)))] + (define (read-vcard-element #!optional (port (current-input-port)) (first-element? #f)) + (let* [(line (read-folded-line (if first-element? 100 #f) port))] (cond ;; Ignore blank lines, they’re not doing anyone any harm! [(or (string-null? line) (irregex-search "^[[:whitespace:]]+$" line)) - (read-vcard-element first-element?)] + (read-vcard-element port first-element?)] ;; If we’ve previously established this is a vCard stream we’re dealing ;; with, just go ahead and parse. If we haven’t established that, make ;; sure it’s a BEGIN:VCARD line first. @@ -296,16 +297,37 @@ '(vcard)))]))) - ;; Reader-thunk. Read a “logical” folded-line, where a line beginning with a ;; space is a continuation of the previous line — like with vcards. - (define (read-folded-line #!optional limit) - (if (not (eof-object? (peek-char))) - (let [(line (read-line (current-input-port) limit))] - (if (or (eq? (peek-char) #\space) - (eq? (peek-char) #\tab)) + (define (read-folded-line #!optional (limit 100) (port (current-input-port))) + (if (not (eof-object? (peek-char port))) + (let [(line (read-line port limit))] + (if (or (eq? (peek-char port) #\space) + (eq? (peek-char port) #\tab)) (string-concatenate (list line - (string-drop (read-folded-line) 1))) + (string-drop (read-folded-line limit port) 1))) line)) - ""))) + "")) + + + ;; Writes a vCard alist to the output port as a string. + ;; Defaults to (current-output-port). + (define (write-vcard vcard-alist #!optional (port (current-output-port))) + (for-each (lambda (element) + (write-string (serialize-vcard-element element) #f port) + (write-char #\return port) + (write-char #\newline port)) + vcard-alist)) + + + ;; Split a STRING into strings of a size of (at most) LENGTH signs. + ;; ("ÁPPLE" 2) → '("ÁP" "PL" "E") + (define (string-split-by-lengths string length) + (append (list (if (<= (string-length string) length) + string + (substring string 0 length))) + (if (<= (string-length string) length) + '() + (string-split-by-lengths (substring string length) length))))) +