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

Support saving new contacts 

… also abstracts the “Save as…” menu callback into
its own function.
This commit is contained in:
Jaidyn Ann 2024-02-23 23:23:01 -06:00
parent 055ae38bf4
commit 496f4572e4
1 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
rolladecks.scm
View File

@ -40,7 +40,7 @@
(define *qt-app* #f) ;; The <qt-application> object. (define *qt-app* #f) ;; The <qt-application> object.
(define *qt-win* #f) ;; The <qt-window> object. (define *qt-win* #f) ;; The <qt-window> object.
(define *vcard-pathname* #f) ;; Path to current vCard file. (define *vcard-pathname* #f) ;; Path to current vCard file.
(define *vcard-alist* #f) ;; Parsed alist of current vCard file. (define *vcard-alist* '()) ;; Parsed alist of current vCard file.
;; Start & run the application. ;; Start & run the application.
@ -169,18 +169,16 @@
menu-file-save "triggered()" menu-file-save "triggered()"
(qt:receiver (qt:receiver
(lambda () (lambda ()
(save-vcard-file window))))) (if *vcard-pathname*
(save-vcard-file window)
(save-vcard-file-as window))))))
;; If they try to Save As…, set the current vcard-path, then save! ;; If they try to Save As…, set the current vcard-path, then save!
(when menu-file-save-as (when menu-file-save-as
(qt:connect (qt:connect
menu-file-save-as "triggered()" menu-file-save-as "triggered()"
(qt:receiver (qt:receiver
(lambda () (lambda ()
(let [(new-path (qt:get-save-filename "Save contact as…" (contacts-dir)))] (save-vcard-file-as window)))))
(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.
(when menu-file-new (when menu-file-new
@ -235,7 +233,7 @@
;; … if that didn’t work out, complain to the user! ;; … if that didn’t work out, complain to the user!
[(vcard) [(vcard)
(set! *vcard-pathname* #f) (set! *vcard-pathname* #f)
(set! *vcard-alist* #f) (set! *vcard-alist* '())
(set-window-title! window "New contact") (set-window-title! window "New contact")
(error-message "Parsing error" (error-message "Parsing error"
(string-join (string-join
@ -246,7 +244,7 @@
;; … complain harder, harder!! ;; … complain harder, harder!!
[exn (file) [exn (file)
(set! *vcard-pathname* #f) (set! *vcard-pathname* #f)
(set! *vcard-alist* #f) (set! *vcard-alist* '())
(set-window-title! window "New contact") (set-window-title! window "New contact")
(error-message "File error" (error-message "File error"
"Failed to open the file." "Failed to open the file."
@ -261,9 +259,9 @@
(begin (begin
(set! *vcard-alist* (populate-vcard-with-window window *vcard-alist*)) (set! *vcard-alist* (populate-vcard-with-window window *vcard-alist*))
(call-with-output-file *vcard-pathname* (call-with-output-file *vcard-pathname*
(lambda (in-port) (lambda (out-port)
(vcard:write-vcard *vcard-alist* (vcard:write-vcard *vcard-alist*
in-port)))) out-port))))
[exn () [exn ()
(error-message (error-message
"Export error" "Export error"
@ -271,6 +269,15 @@
exn)])))) exn)]))))
;; Save the window contents to a to-be-selected file-path in vCard format…
;; *if* the user saves them.
(define (save-vcard-file-as window)
(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))))
;; Simply map vCard property-names to their corresponding name in the window’s ;; Simply map vCard property-names to their corresponding name in the window’s
;; fields. ;; fields.
(define property->formname-alist (define property->formname-alist
@ -338,7 +345,7 @@
(qt:property widget "text")) (qt:property widget "text"))
vcard-alist))))) vcard-alist)))))
(map car formname-alist->property)) (map car formname-alist->property))
vcard-alist) (vcard:normalize-vcard vcard-alist))
;; Display an error-message dialogue, optionally exiting after the user ;; Display an error-message dialogue, optionally exiting after the user