From bb7816727e6143c8a1d0ff0d03df59e96dfbfe4d Mon Sep 17 00:00:00 2001 From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com> Date: Thu, 22 Feb 2024 12:25:01 -0600 Subject: [PATCH] Actually save edited contacts to vCard files MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit … at least, modified vCard files. No support for new files, nor error-handling. --- contact.scm | 65 ++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 49 insertions(+), 16 deletions(-) diff --git a/contact.scm b/contact.scm index 65cab24..d43f3d6 100755 --- a/contact.scm +++ b/contact.scm @@ -40,6 +40,7 @@ (define *qt-app* #f) ;; The object. (define *qt-win* #f) ;; The object. (define *vcard-pathname* #f) ;; Path to current vCard file. +(define *vcard-alist* #f) ;; Parsed alist of current vCard file. ;; Start & run the application. @@ -167,7 +168,11 @@ menu-file-save "triggered()" (qt:receiver (lambda () - (qt:message "Saving is not implemented."))))) + (call-with-output-file *vcard-pathname* + (lambda (in-port) + (vcard:write-vcard + (populate-vcard-with-window window *vcard-alist*) + in-port))))))) ;; If they want a new contact, create a new, blank, window. ;; That is, a new process. (if menu-file-new @@ -216,19 +221,24 @@ (thread-start! (lambda () (condition-case - (populate-with-vcard - window - (with-input-from-file file - vcard:read-vcard)) + ;; Parse the vCard, then populate the window’s fields. + (begin + (set! *vcard-alist* + (with-input-from-file file vcard:read-vcard)) + (populate-window-with-vcard window *vcard-alist*)) + ;; … if that didn’t work out, complain to the user! [(vcard) (set! *vcard-pathname* #f) + (set! *vcard-alist* #f) (set-window-title! window "New contact") (qt:message (string-join (list "This file doesn’t seem to be a valid vCard file." "Please make sure you selected the right file, and take a look at it manually.")) title: "Parsing error" type: 'critical)] + ;; … complain harder, harder!! [exn (file) (set! *vcard-pathname* #f) + (set! *vcard-alist* #f) (set-window-title! window "New contact") (qt:message (string-join (list "Failed to open the file." @@ -236,18 +246,22 @@ title: "File error" type: 'critical)])))) - - ;; Simply map vCard property-names to their corresponding name in the window’s ;; fields. (define property->formname-alist - '((FN . "name") + '((FN . "nameLineEdit") ;; (ADR . "address") - (TEL . "homePhone") - (TEL . "workPhone") - (EMAIL . "eMail") - (URL . "url") - (NICKNAME . "nickname"))) + (TEL . "homePhoneLineEdit") + (TEL . "workPhoneLineEdit") + (EMAIL . "eMailLineEdit") + (URL . "urlLineEdit") + (NICKNAME . "nicknameLineEdit"))) + + +;; … and likewise, map window fields’ names to vCard properties. +(define formname-alist->property + (map (lambda (a) (cons (cdr a) (car a))) + property->formname-alist)) ;; Given a parsed vCard in vcarded’s alist format, populate the window’s fields. @@ -255,11 +269,10 @@ ;; ((PROPERTY (ATTRIBUTES) VALUE) ;; (FN () "A. Dmytryshyn") ;; (ADR ("TYPE=home") ("" "" "1234 Abc.", "", "", "", ""))) -(define (populate-with-vcard window vcard-alist) +(define (populate-window-with-vcard window vcard-alist) (map (lambda (property) (let* [(formname (alist-ref (car property) property->formname-alist)) - (lineEditName (conc formname "LineEdit")) - (lineEditWidget (if formname (qt:find window lineEditName) #f))] + (lineEditWidget (if formname (qt:find window formname) #f))] (cond [lineEditWidget (set! (qt:property lineEditWidget "text") @@ -283,6 +296,26 @@ (set-window-title! window (last (alist-ref 'FN vcard-alist))))) +;; Given a Contacts QT window, take its vCard lineEdit widgets and populate a +;; vcarded-style alist with their values. +;; Returns a vCard according the window’s textbox values. +(define (populate-vcard-with-window window vcard-alist) + (for-each + (lambda (lineEditName) + (let* [(widget (if lineEditName (qt:find window lineEditName) #f)) + (widget-value (if widget (qt:property widget "text") #f)) + (property-sym (alist-ref lineEditName formname-alist->property equal?)) + (property-value (alist-ref property-sym vcard-alist))] + (when (and widget (not (string-null? widget-value))) + (set! vcard-alist + (alist-update property-sym + (list (if (list? property-value) (car property-value) '()) + (qt:property widget "text")) + vcard-alist))))) + (map car formname-alist->property)) + vcard-alist) + + ;; Set a QT window’s title, suffixing with the program name (Contact). (define (set-window-title! window title) (set! (qt:property window "windowTitle")