;; 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:) nrepl qt-light (prefix uri-common uri:) (prefix vcarded vcard:)) (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 (alist-ref 'help cli-args) (cli-usage)) ;; Set up some global state, prepare the QT app. (set! qt-app (qt:init)) (set! qt-win (create-window)) (init-window qt-win) (let ;; Start QT loop. [(qt-thread (thread-start! qt-loop)) ;; Kick off the remote-REPL… (nrepl-thread (if (alist-ref 'repl cli-args) (thread-start! (lambda () (nrepl (string->number (alist-ref 'repl cli-args)))))))] ;; … and also provide a local REPL. (repl) ;; Wait for the QT program, even after stdin is closed off. (thread-join! qt-thread)))) ;; 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]") (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) (print 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)