Support saving new contacts
… also abstracts the “Save as…” menu callback into its own function.
This commit is contained in:
parent
055ae38bf4
commit
496f4572e4
|
@ -40,7 +40,7 @@
|
|||
(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.
|
||||
(define *vcard-alist* #f) ;; Parsed alist of current vCard file.
|
||||
(define *vcard-alist* '()) ;; Parsed alist of current vCard file.
|
||||
|
||||
|
||||
;; Start & run the application.
|
||||
|
@ -169,18 +169,16 @@
|
|||
menu-file-save "triggered()"
|
||||
(qt:receiver
|
||||
(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!
|
||||
(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)))))
|
||||
(save-vcard-file-as window)))))
|
||||
;; If they want a new contact, create a new, blank, window.
|
||||
;; That is, a new process.
|
||||
(when menu-file-new
|
||||
|
@ -235,7 +233,7 @@
|
|||
;; … if that didn’t work out, complain to the user!
|
||||
[(vcard)
|
||||
(set! *vcard-pathname* #f)
|
||||
(set! *vcard-alist* #f)
|
||||
(set! *vcard-alist* '())
|
||||
(set-window-title! window "New contact")
|
||||
(error-message "Parsing error"
|
||||
(string-join
|
||||
|
@ -246,7 +244,7 @@
|
|||
;; … complain harder, harder!!
|
||||
[exn (file)
|
||||
(set! *vcard-pathname* #f)
|
||||
(set! *vcard-alist* #f)
|
||||
(set! *vcard-alist* '())
|
||||
(set-window-title! window "New contact")
|
||||
(error-message "File error"
|
||||
"Failed to open the file."
|
||||
|
@ -261,9 +259,9 @@
|
|||
(begin
|
||||
(set! *vcard-alist* (populate-vcard-with-window window *vcard-alist*))
|
||||
(call-with-output-file *vcard-pathname*
|
||||
(lambda (in-port)
|
||||
(lambda (out-port)
|
||||
(vcard:write-vcard *vcard-alist*
|
||||
in-port))))
|
||||
out-port))))
|
||||
[exn ()
|
||||
(error-message
|
||||
"Export error"
|
||||
|
@ -271,6 +269,15 @@
|
|||
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
|
||||
;; fields.
|
||||
(define property->formname-alist
|
||||
|
@ -338,7 +345,7 @@
|
|||
(qt:property widget "text"))
|
||||
vcard-alist)))))
|
||||
(map car formname-alist->property))
|
||||
vcard-alist)
|
||||
(vcard:normalize-vcard vcard-alist))
|
||||
|
||||
|
||||
;; Display an error-message dialogue, optionally exiting after the user
|
||||
|
|
Ŝarĝante…
Reference in New Issue