rolladeck/contact.scm

;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
;;
;; 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 <https://www.gnu.org/licenses/>.

(import scheme
        (chicken base)
        (chicken file)
        (chicken io)
        (chicken repl)
        (chicken repl)
        (chicken string)
        (chicken time)
        srfi-1
        srfi-18
        nrepl
        qt-light
        (prefix uri-common uri:)
        (prefix vcarded vcard:))


(define qt-app #f) ;; The <qt-application> object.
(define qt-win #f) ;; The <qt-window> object.


;; Start & run the application.
(define (init)
  ;; 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 (thread-start! (lambda () (nrepl 1234))))]
    ;; … and also provide a local REPL.
    (repl)
    ;; Wait for the QT program, even after stdin is closed off.
    (thread-join! qt-thread)))


;; 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)