diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-20 22:19:58 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-20 22:19:58 +0200 |
commit | 32ad0e39349b3f379987b0ef8f0320f62cddbf4a (patch) | |
tree | b07c44e7894207aa5d4268220d3909bcf9af9960 /module/vcalendar | |
parent | Add '=' case to mod! (diff) | |
download | calp-32ad0e39349b3f379987b0ef8f0320f62cddbf4a.tar.gz calp-32ad0e39349b3f379987b0ef8f0320f62cddbf4a.tar.xz |
Update parse-recurrence-rule to use new catch-multiple.
Diffstat (limited to 'module/vcalendar')
-rw-r--r-- | module/vcalendar/recurrence/parse.scm | 29 |
1 files changed, 18 insertions, 11 deletions
diff --git a/module/vcalendar/recurrence/parse.scm b/module/vcalendar/recurrence/parse.scm index 983c12b1..50d0e0a8 100644 --- a/module/vcalendar/recurrence/parse.scm +++ b/module/vcalendar/recurrence/parse.scm @@ -11,19 +11,26 @@ #:use-module (ice-9 curried-definitions) #:export (parse-recurrence-rule)) + +(define (printerr fmt . args) + (apply format (current-error-port) + fmt args)) + (define (parse-recurrence-rule str) - "Takes a RECUR value (string), and returuns a <recur-rule> object" - (catch #t + (catch-multiple (lambda () (%build-recur-rules str)) - (lambda (err cont obj key val . rest) - (let ((fmt (case err - ((unfulfilled-constraint) - "ERR ~a [~a] doesn't fulfill constraint of type [~a], ignoring~%") - ((invalid-value) - "ERR ~a [~a] for key [~a], ignoring.~%") - (else "~a ~a ~a")))) - (format (current-error-port) fmt err val key)) - (cont #f)))) + + [unfulfilled-constraint + (cont obj key val . rest) + (printerr "ERR ~a [~a] doesn't fulfill constraint of type [~a], ignoring~%" + err val key) + (cont #f)] + + [invalid-value + (cont obj key val . rest) + (printerr "ERR ~a [~a] for key [~a], ignoring.~%" + err val key) + (cont #f)])) (eval-when (expand) (define ((handle-case stx obj) key val proc) |