diff --git a/contact.scm b/contact.scm index 25c3c78..100d852 100755 --- a/contact.scm +++ b/contact.scm @@ -68,7 +68,7 @@ (let [(qt-thread (thread-start! qt-loop)) (last-free-arg (condition-case (last (car cli-args)) (var () #f)))] (when (string? last-free-arg) - (open-vcard-file *qt-win* last-free-arg)) + (open-vcard-file *qt-win* last-free-arg #t)) qt-thread)) @@ -211,7 +211,7 @@ ;; Parse a vCard file and populate the window’s forms with its contents. -(define (open-vcard-file window file) +(define (open-vcard-file window file . exit-on-fail?) (set! *vcard-pathname* file) (set-window-title! window (pathname-file file)) (thread-start! @@ -227,19 +227,20 @@ (set! *vcard-pathname* #f) (set! *vcard-alist* #f) (set-window-title! window "New contact") - (qt:message - (string-join (list "This file doesn’t seem to be a valid vCard file." - "Please make sure you selected the right file, and take a look at it manually.")) - title: "Parsing error" type: 'critical)] + (error-message "Parsing error" + (string-join + (list "This file doesn’t seem to be a valid vCard file." + "Please make sure you selected the right file, and take a look at it manually.") + "\n") + #f exit-on-fail?)] ;; … complain harder, harder!! [exn (file) (set! *vcard-pathname* #f) (set! *vcard-alist* #f) (set-window-title! window "New contact") - (qt:message - (string-join (list "Failed to open the file." - ((condition-property-accessor 'exn 'message) exn))) - title: "File error" type: 'critical)])))) + (error-message "File error" + "Failed to open the file." + exn exit-on-fail?)])))) ;; Save the window contents to the currently-selected file-path in vCard format. @@ -254,12 +255,10 @@ (vcard:write-vcard *vcard-alist* in-port)))) [exn () - (qt:message - (string-join (list "Failed to save the file:" - ((condition-property-accessor 'exn 'message) exn) - "Try saving to a another location with “File→Save as…”.") - "\n") - title: "Saving error")])))) + (error-message + "Export error" + "Failed to save the file.\nTry saving to another location with “File→Save as…”." + exn)])))) ;; Simply map vCard property-names to their corresponding name in the window’s @@ -332,6 +331,20 @@ vcard-alist) +;; Display an error-message dialogue, optionally exiting after the user +;; dismisses it. +(define (error-message title description #!optional (exn #f) (exit-after-message? #f)) + (let [(exn-message (if exn ((condition-property-accessor 'exn 'message) exn) + #f))] + (qt:message + (if exn-message + (string-concatenate (list description "\n“" exn-message "”")) + description) + title: title + type: 'critical) + (when exit-after-message? (exit)))) + + ;; Set a QT window’s title, suffixing with the program name (Contact). (define (set-window-title! window title) (set! (qt:property window "windowTitle")