contact.scm

@@ -1,5 +1,3 @@
-#!/usr/bin/env -S csi -s
-
 ;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
 ;;
 ;; This program is free software: you can redistribute it and/or
@@ -37,10 +35,8 @@
         qt-light)
 
 
-(define *qt-app* #f) ;; The <qt-application> object.
+(define qt-app #f) ;; The <qt-application> object.
-(define *qt-win* #f) ;; The <qt-window> 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.
@@ -59,16 +55,15 @@
 
 ;; 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-app (qt:init))
-  (set! *qt-win* (create-window))
+  (set! qt-win (create-window))
-  (qt:char-encoding 'utf8)
+  (init-window qt-win)
-  (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)))]
-    (when (string? last-free-arg)
+    (if (and last-free-arg (string? last-free-arg) (file-exists? last-free-arg))
-      (open-vcard-file *qt-win* last-free-arg))
+       (open-vcard-file qt-win last-free-arg))
     qt-thread))
 
 
@@ -137,9 +132,7 @@
           (or (qt:theme-icon "person") (qt:theme-icon "contact-new")))]
     (if default-profile-pic
         (set! (qt:property (qt:find window "avatarLabel") "pixmap")
-          (qt:icon->pixmap default-profile-pic 100 100))))
+           (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))
@@ -168,17 +161,22 @@
          menu-file-save "triggered()"
          (qt:receiver
           (lambda ()
-            (call-with-output-file *vcard-pathname*
+            (qt:message "Saving is not implemented.")))))
-              (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 create-new-window)))
+         (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))))))
     ;; If they want to open a contact through the Open… dialogue, we should open
     ;; the contact in a new window.
     (if menu-file-open
@@ -190,78 +188,34 @@
                                        "/Contacts"))
                    (selected-file (qt:get-open-filename
                                    "Select a contact file to open…"
-                                   contacts-dir))]
+                                   contacts-dir))
+                   (program-args (append (cdr (argv)) (list selected-file)))]
               (if (not (string-null? selected-file))
-                  (if *vcard-pathname*
+                  (process-run
-                      (create-new-window selected-file)
+                    (executable-pathname)
-                      (open-vcard-file window selected-file))))))))))
+                    program-args)))))))))
-
-
-;; 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)))
 
 
 ;; Parse a vCard file and populate the window’s forms with its contents.
 (define (open-vcard-file window file)
-  (set! *vcard-pathname* file)
+  (if (and (file-exists? file)
-  (set-window-title! window (pathname-file file))
+           (file-readable? file))
-  (thread-start!
+      (thread-start! (lambda () (populate-with-vcard
-   (lambda ()
+                                 window
-     (condition-case
+                                 (with-input-from-file file
-         ;; Parse the vCard, then populate the window’s fields.
+                                   vcard:read-vcard))))))
-         (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 . "nameLineEdit")
+  '((FN . "name")
 ;;    (ADR . "address")
-    (TEL . "homePhoneLineEdit")
+    (TEL . "homePhone")
-    (TEL . "workPhoneLineEdit")
+    (TEL . "workPhone")
-    (EMAIL . "eMailLineEdit")
+    (EMAIL . "eMail")
-    (URL . "urlLineEdit")
+    (URL . "url")
-    (NICKNAME . "nicknameLineEdit")))
+    (NICKNAME . "nickname")))
-
-
-;; … 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.
@@ -269,10 +223,11 @@
 ;;    ((PROPERTY (ATTRIBUTES) VALUE)
 ;;     (FN () "A. Dmytryshyn")
 ;;     (ADR ("TYPE=home") ("" "" "1234 Abc.", "", "", "", "")))
-(define (populate-window-with-vcard window vcard-alist)
+(define (populate-with-vcard window vcard-alist)
   (map (lambda (property)
          (let* [(formname (alist-ref (car property) property->formname-alist))
-                (lineEditWidget (if formname (qt:find window formname) #f))]
+                (lineEditName (conc formname "LineEdit"))
+                (lineEditWidget (if formname (qt:find window lineEditName) #f))]
            (cond
             [lineEditWidget
              (set! (qt:property lineEditWidget "text")
@@ -285,41 +240,11 @@
             [(and (eq? (car property) 'PHOTO)
                   (list? (last property)))
              (let* [(avatar (qt:find window "avatarLabel"))
-                    (old-pixmap
+                    (old-pixmap (if avatar (qt:property avatar "pixmap")))
-                     (if avatar (qt:property avatar "pixmap")))
+                    [new-pixmap (if avatar (u8vector->pixmap (cadr (last property))))]]
-                    [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.