diff --git a/vcarded.scm b/vcarded.scm index 417c834..753c0a9 100644 --- a/vcarded.scm +++ b/vcarded.scm @@ -14,7 +14,7 @@ ;; along with this program. If not, see . (module vcarded - (read-vcard write-vcard) + (read-vcard write-vcard normalize-vcard) (import scheme @@ -88,6 +88,33 @@ vcard-alist)) + ;; Returns a “normalized” version of the given VCARD-ALIST. + ;; Will make sure that required properties (“BEGIN” and “END”) are included, + ;; and optionally update the PRODID and VERSION properties. + (define (normalize-vcard vcard-alist #!optional + (update-prod-id? #t) (update-version? #t)) + (let ([empty-alist? (or (null? vcard-alist) + (eq? (length vcard-alist) 1))]) + (when update-version? + (set! vcard-alist + (alist-update 'VERSION (list '() "4.0") vcard-alist))) + (when update-prod-id? + (set! vcard-alist + (alist-update 'PRODID (list '() ".//jadedctrl//chicken-vcarded") vcard-alist))) + (when (or empty-alist? + (not (eq? (caar vcard-alist) 'BEGIN))) + (set! vcard-alist + (append '((BEGIN () "VCARD")) + (remove (lambda (a) (eq? (car a) 'BEGIN)) + vcard-alist)))) + (when (or empty-alist? + (not (eq? (car (last vcard-alist)) 'END))) + (set! vcard-alist + (append + (remove (lambda (a) (eq? (car a) 'END)) vcard-alist) + '((END () "VCARD"))))) + vcard-alist)) + ;;; ~ vCard parsing [string→alist] ~