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

Exit after erroring out parsing cli-argument file 

Also abstracts error-message display to an
ERROR-MESSAGE procedure.
This commit is contained in:
Jaidyn Ann 2024-02-22 14:59:01 -06:00
parent 3baeacb82c
commit 1dcb30ea7e
1 changed files with 29 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
contact.scm
View File

@ -68,7 +68,7 @@
(let [(qt-thread (thread-start! qt-loop)) (let [(qt-thread (thread-start! qt-loop))
(last-free-arg (condition-case (last (car cli-args)) (var () #f)))] (last-free-arg (condition-case (last (car cli-args)) (var () #f)))]
(when (string? last-free-arg) (when (string? last-free-arg)
(open-vcard-file *qt-win* last-free-arg)) (open-vcard-file *qt-win* last-free-arg #t))
qt-thread)) qt-thread))
@ -211,7 +211,7 @@
;; Parse a vCard file and populate the window’s forms with its contents. ;; 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! *vcard-pathname* file)
(set-window-title! window (pathname-file file)) (set-window-title! window (pathname-file file))
(thread-start! (thread-start!
@ -227,19 +227,20 @@
(set! *vcard-pathname* #f) (set! *vcard-pathname* #f)
(set! *vcard-alist* #f) (set! *vcard-alist* #f)
(set-window-title! window "New contact") (set-window-title! window "New contact")
(qt:message (error-message "Parsing error"
(string-join (list "This file doesn’t seem to be a valid vCard file." (string-join
"Please make sure you selected the right file, and take a look at it manually.")) (list "This file doesn’t seem to be a valid vCard file."
title: "Parsing error" type: 'critical)] "Please make sure you selected the right file, and take a look at it manually.")
"\n")
#f exit-on-fail?)]
;; … 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* #f)
(set-window-title! window "New contact") (set-window-title! window "New contact")
(qt:message (error-message "File error"
(string-join (list "Failed to open the file." "Failed to open the file."
((condition-property-accessor 'exn 'message) exn))) exn exit-on-fail?)]))))
title: "File error" type: 'critical)]))))
;; Save the window contents to the currently-selected file-path in vCard format. ;; Save the window contents to the currently-selected file-path in vCard format.
@ -254,12 +255,10 @@
(vcard:write-vcard *vcard-alist* (vcard:write-vcard *vcard-alist*
in-port)))) in-port))))
[exn () [exn ()
(qt:message (error-message
(string-join (list "Failed to save the file:" "Export error"
((condition-property-accessor 'exn 'message) exn) "Failed to save the file.\nTry saving to another location with “File→Save as…”."
"Try saving to a another location with “File→Save as…”.") exn)]))))
"\n")
title: "Saving error")]))))
;; 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
@ -332,6 +331,20 @@
vcard-alist) 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). ;; Set a QT window’s title, suffixing with the program name (Contact).
(define (set-window-title! window title) (define (set-window-title! window title)
(set! (qt:property window "windowTitle") (set! (qt:property window "windowTitle")