Exit after erroring out parsing cli-argument file

Also abstracts error-message display to an
ERROR-MESSAGE procedure.

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))
 
 
@@ -168,11 +168,7 @@
          menu-file-save "triggered()"
          (qt:receiver
           (lambda ()
-            (call-with-output-file *vcard-pathname*
-              (lambda (in-port)
-               (vcard:write-vcard
-                 (populate-vcard-with-window window *vcard-alist*)
-                 in-port)))))))
+            (save-vcard-file window)))))
     ;; If they want a new contact, create a new, blank, window.
     ;; That is, a new process.
     (if menu-file-new
@@ -215,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!
@@ -231,19 +227,38 @@
        (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.
+(define (save-vcard-file window)
+  (thread-start!
+   (lambda ()
+     (condition-case
+         (begin
+           (set! *vcard-alist* (populate-vcard-with-window window *vcard-alist*))
+           (call-with-output-file *vcard-pathname*
+             (lambda (in-port)
+               (vcard:write-vcard *vcard-alist*
+                                  in-port))))
+       [exn ()
+            (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
@@ -316,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")