;; Copyright © 2024 Jaidyn Ann ;; ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation, either version 3 of ;; the License, or (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . (import scheme (chicken base) (chicken condition) (chicken file) (chicken pathname) (chicken io) (chicken repl) (chicken process-context) (chicken string) (chicken time) (srfi 1) (srfi 18) (prefix getopt-long getopt:) (prefix nrepl nrepl:) (prefix uri-common uri:) (prefix vcarded vcard:) qt-light) (define qt-app #f) ;; The object. (define qt-win #f) ;; The object. ;; Start & run the application. (define (init) (let [(cli-args (parse-cli-args (command-line-arguments)))] ;; If --help, then print a usage message and quit. (if (alist-ref 'help cli-args) (cli-usage)) ;; Otherwise, let’s get our threads started! (let [(qt-thread (init-qt cli-args)) (nrepl-thread (init-nrepl cli-args)) (repl-thread (thread-start! repl))] ;; Wait for the QT program, even after stdin is closed off. (thread-join! qt-thread)))) ;; 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) ;; 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 last-free-arg (open-vcard-file qt-win last-free-arg)) qt-thread)) ;; Kick off our remote TCP-accessible REPL, if the user enabled it at cli. (define (init-nrepl cli-args) (if (alist-ref 'repl cli-args) (thread-start! (lambda () (nrepl:nrepl (string->number (alist-ref 'repl cli-args))))))) ;; Print a “usage” help message, telling the user how to run the program. (define (cli-usage) (print "usage: " (pathname-file (program-name)) " [-h] [--repl PORT] [VCF_FILE]") (print) (print (pathname-file (program-name)) " is a simple contacts program for managing") (print "vCard-format contacts.") (print) (print (getopt:usage cli-args-grammar)) (exit)) ;; Parse out command-line args into an alist. ;; '("dad" "-h" "--repl=12" "mm") → '(("dad" "mm") (help #t) (repl 12)) (define (parse-cli-args args) (handle-exceptions exn (and (print ((condition-property-accessor 'exn 'message) exn)) '((help . #t))) (getopt:getopt-long args cli-args-grammar))) ;; Definition of our command-line arguments, in getopt-long’s format. (define cli-args-grammar '((help "display this help message" (single-char #\h)) (repl "start a TCP-accesible REPL at the given port" (value #t)))) ;; Loop through QT’s processing, again and again. (define (qt-loop) (qt:run #t) (qt-loop)) ;; Create the application window. (define (create-window) (qt:widget (window-contents))) ;; Return the UI’s XML, read from “contacts.ui”. ;; We could generate this XML ourselves, and write a nice s-expr front-end, ;; maybe… `o` (define (window-contents) (call-with-input-file "contact.ui" (lambda (in-port) (read-string #f in-port)))) ;; Initialize the window. (define (init-window window) (window-callbacks window) (qt:show window)) ;; Connect callback functions to widgets’ signals. (define (window-callbacks window) (menubar-callbacks window)) ;; Connect callback functions to menubar items. (define (menubar-callbacks window) (let* [(menu-file-exit (qt:find window "actionQuit")) (menu-file-save (qt:find window "actionSave")) (menu-file-open (qt:find window "actionOpen"))] ;; We connect to https://doc.qt.io/qt-6/qaction.html#triggered (if menu-file-exit (qt:connect menu-file-exit "triggered()" (qt:receiver exit))) (if menu-file-save (qt:connect menu-file-save "triggered()" (qt:receiver (lambda () (qt:message "Saving is not implemented."))))) (if menu-file-open (qt:connect menu-file-open "triggered()" (qt:receiver (lambda () (open-vcard-file window (qt:get-open-filename "birdo" "/home/jaidyn/Contacts")))))))) ;; 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)))))) ;; Simply map vCard property-names to their corresponding name in the window’s ;; fields. (define property->formname-alist '((FN . "name") (ADR . "address") (TEL . "homePhone") (TEL . "workPhone") (EMAIL . "eMail") (URL . "url") (NICKNAME . "nickname"))) ;; Given a parsed vCard in vcarded’s alist format, populate the window’s fields. ;; Here’s the format: ;; ((PROPERTY (ATTRIBUTES) VALUE) ;; (FN () "A. Dmytryshyn") ;; (ADR ("TYPE=home") ("" "" "1234 Abc.", "", "", "", ""))) (define (populate-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))] (if lineEditWidget (set! (qt:property lineEditWidget "text") (last property))))) vcard-alist)) (init)