Add WRITE-VCARD function to complement READ-VCARD

vcarded.scm

@@ -14,7 +14,7 @@
 ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
 
 (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)
+  (define (read-vcard #!optional (port (current-input-port)) (ignored #t))
-    (let* [(first-element? (optional ignored #t))
+    (let* [(first-element? ignored)
-           (element (read-vcard-element first-element?))]
+           (element (read-vcard-element port first-element?))]
-      (if (not (eof-object? (peek-char)))
+      (if (not (eof-object? (peek-char port)))
-          (append (list element) (read-vcard #f))
+          (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?)
+  (define (read-vcard-element #!optional (port (current-input-port)) (first-element? #f))
-    (let* [(first-element? (optional first-element? #f))
+    (let* [(line (read-folded-line (if first-element? 100 #f) port))]
-           (line (read-folded-line (if first-element? 100 #f)))]
       (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)
+  (define (read-folded-line #!optional (limit 100) (port (current-input-port)))
-    (if (not (eof-object? (peek-char)))
+    (if (not (eof-object? (peek-char port)))
-      (let [(line (read-line (current-input-port) limit))]
+      (let [(line (read-line port limit))]
-        (if (or (eq? (peek-char) #\space)
+        (if (or (eq? (peek-char port) #\space)
-                (eq? (peek-char) #\tab))
+                (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)))))
+