jadedctrl/ chicken-vcarded
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

Add WRITE-VCARD function to complement READ-VCARD

This commit is contained in:
Jaidyn Ann 2024-02-18 19:22:55 -06:00
parent dabda67b33
commit 58f6fd70b8
1 changed files with 41 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
vcarded.scm
View File

@ -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)
(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)))))