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

Add NORMALIZE-VCARD; ensure a vCard alist’s legal

This commit is contained in:
Jaidyn Ann 2024-02-23 21:30:16 -06:00
parent 69e5567986
commit a67c2251f0
1 changed files with 28 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
vcarded.scm
View File

@ -14,7 +14,7 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(module vcarded (module vcarded
(read-vcard write-vcard) (read-vcard write-vcard normalize-vcard)
(import (import
scheme scheme
@ -88,6 +88,33 @@
vcard-alist)) 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] ~ ;;; ~ vCard parsing [string→alist] ~