diff --git a/contact.scm b/contact.scm old mode 100644 new mode 100755 index 7c3abd1..4ce57dc --- a/contact.scm +++ b/contact.scm @@ -35,8 +35,9 @@ qt-light) -(define qt-app #f) ;; The object. -(define qt-win #f) ;; The object. +(define *qt-app* #f) ;; The object. +(define *qt-win* #f) ;; The object. +(define *vcard-pathname* #f) ;; Path to current vCard file. ;; Start & run the application. @@ -53,17 +54,21 @@ (thread-join! qt-thread)))) +(define (last-free-arg cli-args) + (condition-case (last (car cli-args)) (var () #f))) + + ;; 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) + (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 (and last-free-arg (string? last-free-arg) (file-exists? last-free-arg)) - (open-vcard-file qt-win last-free-arg)) + (last-arg (last-free-arg cli-args))] + (when (and (string? last-arg) (file-exists? last-arg)) + (open-vcard-file *qt-win* last-arg)) qt-thread)) @@ -167,16 +172,7 @@ (if menu-file-new (qt:connect menu-file-new "triggered()" - (qt:receiver - (lambda () - (let [(program-args - ;; If we opened a pre-existing contact (last arg is a file), - ;; remove that argument. - (drop-right (cdr (argv)) - (if (file-exists? (last (argv))) - 1 - 0)))] - (process-run (executable-pathname) program-args)))))) + (qt:receiver create-new-window))) ;; If they want to open a contact through the Open… dialogue, we should open ;; the contact in a new window. (if menu-file-open @@ -188,22 +184,39 @@ "/Contacts")) (selected-file (qt:get-open-filename "Select a contact file to open…" - contacts-dir)) - (program-args (append (cdr (argv)) (list selected-file)))] + contacts-dir))] (if (not (string-null? selected-file)) - (process-run - (executable-pathname) - program-args))))))))) + (if *vcard-pathname* + (create-new-window selected-file) + (open-vcard-file window selected-file)))))))))) + + +;; Executes a new instance of the program; optionally, with a contact-file’s +;; pathname as a new argument. +;; Functionally, opens a new contacts window. +(define (create-new-window . pathname) + (let* [(pathname (optional pathname #f)) + (clean-cli-args + (drop-right (cdr (argv)) + (length (command-line-arguments)))) + (program-args + (if pathname + (append clean-cli-args (list pathname)) + clean-cli-args))] + (process-run + (executable-pathname) + program-args))) ;; 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)))))) + (when (and (file-exists? file) + (file-readable? file)) + (set! *vcard-pathname* 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 @@ -240,8 +253,10 @@ [(and (eq? (car property) 'PHOTO) (list? (last property))) (let* [(avatar (qt:find window "avatarLabel")) - (old-pixmap (if avatar (qt:property avatar "pixmap"))) - [new-pixmap (if avatar (u8vector->pixmap (cadr (last property))))]] + (old-pixmap + (if avatar (qt:property avatar "pixmap"))) + [new-pixmap + (if avatar (u8vector->pixmap (cadr (last property))))]] (when avatar (set! (qt:property avatar "pixmap") new-pixmap)))]))) vcard-alist))