jadedctrl/ rolladeck
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Actions Packages Projects Eldonoj Wiki Activity

Fix New…/Open… window-creation/substition 

Window-creation code has now been refactored.
Open…-ing a new vCard will, in a blank window,
populate said window; otherwise, a new one is
made.
This commit is contained in:
Jaidyn Ann 2024-02-12 22:46:37 -06:00
parent 205576d973
commit bf718e72c4
1 changed files with 46 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
contact.scm Normal file → Executable file
View File

@ -35,8 +35,9 @@
qt-light)
(define qt-app #f) ;; The <qt-application> object.
(define qt-win #f) ;; The <qt-window> object.
(define *qt-app* #f) ;; The <qt-application> object.
(define *qt-win* #f) ;; The <qt-window> 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,18 +184,35 @@
"/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))
(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)))))))))
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)
(when (and (file-exists? file)
(file-readable? file))
(set! *vcard-pathname* file)
(thread-start! (lambda () (populate-with-vcard
window
(with-input-from-file file
@ -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))