Actually save edited contacts to vCard files

… at least, modified vCard files. No support for
new files, nor error-handling.

contact.scm

@@ -40,6 +40,7 @@
 (define *qt-app* #f) ;; The <qt-application> object.
 (define *qt-win* #f) ;; The <qt-window> 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
+         ;; Parse the vCard, then populate the window’s fields.
-       window
+         (begin
-       (with-input-from-file file
+           (set! *vcard-alist*
-         vcard:read-vcard))
+             (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 . "homePhoneLineEdit")
-    (TEL . "workPhone")
+    (TEL . "workPhoneLineEdit")
-    (EMAIL . "eMail")
+    (EMAIL . "eMailLineEdit")
-    (URL . "url")
+    (URL . "urlLineEdit")
-    (NICKNAME . "nickname")))
+    (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 formname) #f))]
-                (lineEditWidget (if formname (qt:find window lineEditName) #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")