diff options
Diffstat (limited to 'module/calp')
| -rw-r--r-- | module/calp/entry-points/convert.scm | 4 | ||||
| -rw-r--r-- | module/calp/entry-points/html.scm | 2 | ||||
| -rw-r--r-- | module/calp/html/components.scm | 5 | ||||
| -rw-r--r-- | module/calp/html/util.scm | 1 | ||||
| -rw-r--r-- | module/calp/html/view/calendar.scm | 4 | ||||
| -rw-r--r-- | module/calp/main.scm | 12 | ||||
| -rw-r--r-- | module/calp/repl.scm | 5 | ||||
| -rw-r--r-- | module/calp/util/config.scm | 19 |
8 files changed, 37 insertions, 15 deletions
diff --git a/module/calp/entry-points/convert.scm b/module/calp/entry-points/convert.scm index 3f602b07..1ce33d9c 100644 --- a/module/calp/entry-points/convert.scm +++ b/module/calp/entry-points/convert.scm @@ -68,7 +68,7 @@ (@ (vcomponent formats xcal parse) sxcal->vcomponent) ;; TODO strip *TOP* xml->sxml)] - [else (error "")] + [else (scm-error 'misc-error "convert-main" "Unexpected parser type: ~a" (list from) #f)] )) (define writer @@ -85,7 +85,7 @@ (sxml->xml ((@ (vcomponent formats xcal output) vcomponent->sxcal) component) port))] - [else (error "")])) + [else (scm-error 'misc-error "convert-main" "Unexpected writer type: ~a" (list to) #f)])) (call-with-output-file outfile diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm index 61489a85..37b0285b 100644 --- a/module/calp/entry-points/html.scm +++ b/module/calp/entry-points/html.scm @@ -173,7 +173,7 @@ pre-start: (start-of-week start) post-end: (end-of-week (end-of-month start)))] [else - (error "Unknown html style: ~a" style)]) + (scm-error 'misc-error "html-main" "Unknown html style: ~a" (list style) #f)]) ((@ (calp util time) report-time!) "all done") ) diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm index 2f8c85ec..37d50697 100644 --- a/module/calp/html/components.scm +++ b/module/calp/html/components.scm @@ -57,7 +57,10 @@ allow-other-keys: rest: args) (when (and onclick href) - (error "Only give one of onclick, href and submit.")) + (scm-error 'wrong-type-arg "btn" + "href, onclick, and submit mutually exclusive. href = ~s, onclick = ~s, submit = ~s." + (list href onclick submit) + #f)) (let ((body #f)) `(,(cond [href 'a] diff --git a/module/calp/html/util.scm b/module/calp/html/util.scm index 75137d4e..54c92e92 100644 --- a/module/calp/html/util.scm +++ b/module/calp/html/util.scm @@ -17,6 +17,7 @@ ;; Returns a color with good contrast to the given background color. ;; https://stackoverflow.com/questions/1855884/determine-font-color-based-on-background-color/1855903#1855903 (define-public (calculate-fg-color c) + ;; TODO what errors can actually appear here? (catch #t (lambda () (define (str->num c n) (string->number (substring/shared c n (+ n 2)) 16)) diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm index 670ad9b6..5a8e977e 100644 --- a/module/calp/html/view/calendar.scm +++ b/module/calp/html/view/calendar.scm @@ -74,10 +74,10 @@ ,display))) (unless next-start - (error 'html-generate "Next-start needs to be a procedure")) + (scm-error 'misc-error "html-generate" "Next-start needs to be a procedure" #f #f)) (unless prev-start - (error 'html-generate "Prev-start needs to be a procedure")) + (scm-error 'misc-error "html-generate" "Prev-start needs to be a procedure" #f #f)) (xhtml-doc (@ (lang sv)) diff --git a/module/calp/main.scm b/module/calp/main.scm index 18b8b731..607b9f1b 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -120,8 +120,11 @@ (cond [altconfig (if (file-exists? altconfig) altconfig - (throw 'option-error - "Configuration file ~a missing" altconfig))] + (scm-error 'misc-error + "wrapped-main" + "Configuration file ~a missing" + (list altconfig) + #f))] ;; altconfig could be placed in the list below. But I want to raise an error ;; if an explicitly given config is missing. [(find file-exists? @@ -213,7 +216,10 @@ (when (option-ref opts 'update-zoneinfo #f) (let* ((locations (list "/usr/libexec/calp/tzget" (path-append (xdg-data-home) "tzget"))) (filename (or (find file-exists? locations) - (error "tzget not installed, please put it in one of ~a" locations))) + (scm-error 'missing-helper "wrapped-main" + "tzget not installed, please put it in one of ~a" + (list locations) + (list "tzget" locations)))) (pipe (open-input-pipe filename))) ;; (define path (read-line pipe)) diff --git a/module/calp/repl.scm b/module/calp/repl.scm index e25c2649..47c35a40 100644 --- a/module/calp/repl.scm +++ b/module/calp/repl.scm @@ -21,8 +21,9 @@ [else 'UNIX]) [(UNIX) (add-hook! shutdown-hook (lambda () (catch 'system-error (lambda () (delete-file address)) - (lambda (err proc fmt . args) - (warning "Failed to unlink ~a" address args) + (lambda (err proc fmt args data) + (warning (format #f "Failed to unlink ~a: ~?" + address fmt args)) err)))) (make-unix-domain-server-socket path: address)] [(IPv4) (apply (case-lambda diff --git a/module/calp/util/config.scm b/module/calp/util/config.scm index e1417d86..4862bbda 100644 --- a/module/calp/util/config.scm +++ b/module/calp/util/config.scm @@ -39,7 +39,11 @@ (for (key value) in (group kwargs 2) (aif (hashq-ref config-properties key) (set! (it name) value) - (error "Missing config protperty slot " key))) + (scm-error 'configuration-error + "define-config" + "No configuration slot named ~s, when defining ~s" + (list key name) + #f))) (set-config! name (get-config name default-value))) (define-syntax define-config @@ -52,7 +56,12 @@ (define-public (set-config! name value) (hashq-set! config-values name (aif (pre name) - (or (it value) (error "Pre crashed for" name)) + (or (it value) + (scm-error 'configuration-error + "set-config!" + "Pre-property failed when setting ~s to ~s" + (list name value) + #f)) value)) (awhen (post name) (it value))) @@ -63,8 +72,10 @@ (if (eq? default %uniq) (let ((v (hashq-ref config-values key %uniq))) (when (eq? v %uniq) - ;; TODO throw descript error - (error "Missing config" key)) + (scm-error 'configuration-error + "get-config" + "No configuration item named ~s" + (list key) #f)) v) (hashq-ref config-values key default))) |