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

Add Save as… menu

This commit is contained in:
Jaidyn Ann 2024-02-23 21:08:37 -06:00
parent f351339e24
commit 055ae38bf4
1 changed files with 47 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
rolladecks.scm
View File

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