diff --git a/contact.scm b/contact.scm index 194a32b..786c02c 100644 --- a/contact.scm +++ b/contact.scm @@ -15,14 +15,17 @@ (import scheme (chicken base) + (chicken condition) (chicken file) + (chicken pathname) (chicken io) (chicken repl) - (chicken repl) + (chicken process-context) (chicken string) (chicken time) srfi-1 srfi-18 + (prefix getopt-long getopt:) nrepl qt-light (prefix uri-common uri:) @@ -35,19 +38,56 @@ ;; 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 [(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 (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))) + (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. @@ -145,4 +185,7 @@ vcard-alist)) + + + (init)