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 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 <qt-application> object.
(define qt-win #f) ;; The <qt-window> 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)))))))]
      ;; Open the free-argument file.
      (if (condition-case (not (null? (last (car cli-args)))) (var () #f))
          (open-vcard-file qt-win (last (car 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] [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)