Actually save edited contacts to vCard files

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

contact.scm

@@ -1,3 +1,5 @@
+#!/usr/bin/env -S csi -s
+
 ;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
 ;;
 ;; This program is free software: you can redistribute it and/or
@@ -35,8 +37,10 @@
         qt-light)
 
 
-(define qt-app #f) ;; The <qt-application> object.
-(define qt-win #f) ;; The <qt-window> object.
+(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.
@@ -55,15 +59,16 @@
 
 ;; Set up some global variables (for easier live REPL use), prepare the QT app.
 (define (init-qt cli-args)
-  (set! qt-app (qt:init))
-  (set! qt-win (create-window))
-  (init-window qt-win)
+  (set! *qt-app* (qt:init))
+  (set! *qt-win* (create-window))
+  (qt:char-encoding 'utf8)
+  (init-window *qt-win*)
   ;; Kick off the QT thread, then open the cli free-arg vCard file, if provided.
   ;; That is, like `$ contact freeArgFile.vcf`.
   (let [(qt-thread (thread-start! qt-loop))
         (last-free-arg (condition-case (last (car cli-args)) (var () #f)))]
-    (if (and last-free-arg (string? last-free-arg) (file-exists? last-free-arg))
-       (open-vcard-file qt-win last-free-arg))
+    (when (string? last-free-arg)
+      (open-vcard-file *qt-win* last-free-arg))
     qt-thread))
 
 
@@ -133,6 +138,8 @@
     (if default-profile-pic
         (set! (qt:property (qt:find window "avatarLabel") "pixmap")
           (qt:icon->pixmap default-profile-pic 100 100))))
+  ;; Set the window’s title.
+  (set-window-title! window "New contact")
   ;; Now prepare callbacks and show the window.
   (window-callbacks window)
   (qt:show window))
@@ -161,22 +168,17 @@
          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
         (qt:connect
          menu-file-new "triggered()"
-         (qt:receiver
-          (lambda ()
-            (let [(program-args
-                   ;; If we opened a pre-existing contact (last arg is a file),
-                   ;; remove that argument.
-                   (drop-right (cdr (argv))
-                               (if (file-exists? (last (argv)))
-                                   1
-                                   0)))]
-              (process-run (executable-pathname) program-args))))))
+         (qt:receiver create-new-window)))
     ;; If they want to open a contact through the Open… dialogue, we should open
     ;; the contact in a new window.
     (if menu-file-open
@@ -188,34 +190,78 @@
                                        "/Contacts"))
                    (selected-file (qt:get-open-filename
                                    "Select a contact file to open…"
-                                   contacts-dir))
-                   (program-args (append (cdr (argv)) (list selected-file)))]
+                                   contacts-dir))]
               (if (not (string-null? selected-file))
+                  (if *vcard-pathname*
+                      (create-new-window selected-file)
+                      (open-vcard-file window selected-file))))))))))
+
+
+;; Executes a new instance of the program; optionally, with a contact-file’s
+;; pathname as a new argument.
+;; Functionally, opens a new contacts window.
+(define (create-new-window . pathname)
+  (let* [(pathname (optional pathname #f))
+         (clean-cli-args
+          (drop-right (cdr (argv))
+                      (length (command-line-arguments))))
+         (program-args
+          (if pathname
+              (append clean-cli-args (list pathname))
+              clean-cli-args))]
     (process-run
      (executable-pathname)
-                    program-args)))))))))
+     program-args)))
 
 
 ;; Parse a vCard file and populate the window’s forms with its contents.
 (define (open-vcard-file window file)
-  (if (and (file-exists? file)
-           (file-readable? file))
-      (thread-start! (lambda () (populate-with-vcard
-                                 window
-                                 (with-input-from-file file
-                                   vcard:read-vcard))))))
+  (set! *vcard-pathname* file)
+  (set-window-title! window (pathname-file file))
+  (thread-start!
+   (lambda ()
+     (condition-case
+         ;; 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."
+                               ((condition-property-accessor 'exn 'message) exn)))
+            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.
@@ -223,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")
@@ -240,11 +285,41 @@
             [(and (eq? (car property) 'PHOTO)
                   (list? (last property)))
              (let* [(avatar (qt:find window "avatarLabel"))
-                    (old-pixmap (if avatar (qt:property avatar "pixmap")))
-                    [new-pixmap (if avatar (u8vector->pixmap (cadr (last property))))]]
+                    (old-pixmap
+                     (if avatar (qt:property avatar "pixmap")))
+                    [new-pixmap
+                     (if avatar (u8vector->pixmap (cadr (last property))))]]
                (when avatar
                  (set! (qt:property avatar "pixmap") new-pixmap)))])))
-       vcard-alist))
+       vcard-alist)
+  (when (alist-ref 'FN vcard-alist)
+    (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")
+    (string-concatenate (list title " - Contact"))))
 
 
 ;; Given a image bytevector (u8vector), create a corresponding pixmap.