From a67c2251f0c6e295e06aeaf4ffc77a5b76786132 Mon Sep 17 00:00:00 2001 From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com> Date: Fri, 23 Feb 2024 21:30:16 -0600 Subject: [PATCH] =?UTF-8?q?Add=20NORMALIZE-VCARD;=20ensure=20a=20vCard=20a?= =?UTF-8?q?list=E2=80=99s=20legal?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- vcarded.scm | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) 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] ~