Exit after erroring out parsing cli-argument file
Also abstracts error-message display to an ERROR-MESSAGE procedure.
This commit is contained in:
parent
3baeacb82c
commit
1dcb30ea7e
45
contact.scm
45
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")
|
||||
|
|
Ŝarĝante…
Reference in New Issue