Add Save as… menu

This commit is contained in:
Jaidyn Ann 2024-02-23 21:08:37 -06:00
parent f351339e24
commit 055ae38bf4

View File

@ -154,39 +154,49 @@
(define (menubar-callbacks window)
(let* [(menu-file-exit (qt:find window "actionQuit"))
(menu-file-save (qt:find window "actionSave"))
(menu-file-save-as (qt:find window "actionSaveAs"))
(menu-file-open (qt:find window "actionOpen"))
(menu-file-new (qt:find window "actionNew"))]
;; We connect to https://doc.qt.io/qt-6/qaction.html#triggered
;; Simply kill the program.
(if menu-file-exit
(when menu-file-exit
(qt:connect
menu-file-exit "triggered()"
(qt:receiver exit)))
;; If they try to Save, tell them its not supported.
(if menu-file-save
;; If they try to Save, save!
(when menu-file-save
(qt:connect
menu-file-save "triggered()"
(qt:receiver
(lambda ()
(save-vcard-file window)))))
;; If they try to Save As…, set the current vcard-path, then save!
(when menu-file-save-as
(qt:connect
menu-file-save-as "triggered()"
(qt:receiver
(lambda ()
(let [(new-path (qt:get-save-filename "Save contact as…" (contacts-dir)))]
(when (and (string? new-path) (not (string-null? new-path)))
(set! *vcard-pathname* new-path)
(save-vcard-file window)))
(save-vcard-file window)))))
;; If they want a new contact, create a new, blank, window.
;; That is, a new process.
(if menu-file-new
(when menu-file-new
(qt:connect
menu-file-new "triggered()"
(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
(when menu-file-open
(qt:connect
menu-file-open "triggered()"
(qt:receiver
(lambda ()
(let* [(contacts-dir (conc (get-environment-variable "HOME")
"/Contacts"))
(selected-file (qt:get-open-filename
(let* [(selected-file (qt:get-open-filename
"Select a contact file to open…"
contacts-dir))]
(contacts-dir)))]
(if (not (string-null? selected-file))
(if *vcard-pathname*
(create-new-window selected-file)
@ -345,6 +355,14 @@
(when exit-after-message? (exit))))
;; Guess the users contacts directory, as best we can.
(define (contacts-dir)
(let [(home (get-environment-variable "HOME"))]
(if home
(conc home "/Contacts")
"./")))
;; Set a QT windows title, suffixing with the program name (Contact).
(define (set-window-title! window title)
(set! (qt:property window "windowTitle")