diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-09-06 01:47:23 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-09-06 01:47:23 +0200 |
commit | 0d1fc0278a8768cd498adc0505e8d5dcaf8dc942 (patch) | |
tree | 7f5086b7ac46641b7a8e308195d27dfbaf6ebba3 /module/c | |
parent | Add filter-stack. (diff) | |
download | calp-0d1fc0278a8768cd498adc0505e8d5dcaf8dc942.tar.gz calp-0d1fc0278a8768cd498adc0505e8d5dcaf8dc942.tar.xz |
Print vcomponents found on stack in final error handler.
Diffstat (limited to '')
-rw-r--r-- | module/calp/main.scm | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/module/calp/main.scm b/module/calp/main.scm index 39d8f625..407f7b81 100644 --- a/module/calp/main.scm +++ b/module/calp/main.scm @@ -10,6 +10,7 @@ :use-module ((calp util hooks) :select (shutdown-hook)) :use-module ((text markup) :select (sxml->ansi-text)) + :use-module ((calp util exceptions) :select (filter-stack)) :use-module (ice-9 getopt-long) :use-module (ice-9 regex) @@ -206,8 +207,19 @@ 'flat (string->symbol stprof))))) + + (define-public (main args) ((@ (calp util time) report-time!) "Program start") - (dynamic-wind (lambda () 'noop) - (lambda () (catch 'return (lambda () (wrapped-main args)) values)) - (lambda () (run-hook shutdown-hook)))) + (with-throw-handler #t + (lambda () + (dynamic-wind (lambda () 'noop) + (lambda () (catch 'return (lambda () (wrapped-main args)) values)) + (lambda () (run-hook shutdown-hook)))) + (lambda _ + ;; Finds any direct vcomponents (not in lists or similar) on the stack + ;; and prints them. + (map (lambda (it) + (with-output-to-port (current-error-port) + (lambda () ((@ (vcomponent describe) describe) it)))) + (filter-stack (@ (vcomponent) vcomponent?) (make-stack #t)))))) |