From 35f690aa788df48a1cf7530c4e7b08b696c3ccbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 4 May 2020 16:25:56 +0200 Subject: Allow program to throw 'return to exit gracefully. --- module/main.scm | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/module/main.scm b/module/main.scm index 82caf00d..cd5f547e 100755 --- a/module/main.scm +++ b/module/main.scm @@ -99,24 +99,24 @@ ;; ((@ (util config) print-configuration-documentation)) (with-throw-handler #t (lambda () (dynamic-wind (lambda () 'noop) - (lambda () (wrapped-main args)) + (lambda () (catch 'return (lambda () (wrapped-main args)) values)) (lambda () (run-hook shutdown-hook)) )) (lambda (err . args) (define stack (make-stack #t)) - (format - (current-error-port) - "bindings = (~a)~%" - (with-output-to-string - (lambda () - (let loop ((frame (stack-ref stack 0))) - (when frame - (format #t "~{~a~^ ~}" (map binding-name (frame-bindings frame))) - (let ((event (and=> (frame-lookup-binding frame 'event) - binding-ref))) - (when event - (format (current-error-port) "event = ~a~%" event) - ((@ (vcomponent output) serialize-vcomponent) - event (current-error-port)))) - - (loop (frame-previous frame)))))))))) + (with-output-to-port (current-error-port) + (lambda () + (format #t "bindings = ") + (let loop ((frame (stack-ref stack 0))) + (when frame + (format #t "~{~a~^ ~}" (map binding-name (frame-bindings frame))) + (let ((event (and=> (frame-lookup-binding frame 'event) + binding-ref))) + (when event + (format (current-error-port) "event = ~a~%" event) + ((@ (vcomponent output) serialize-vcomponent) + event (current-error-port)))) + + (loop (frame-previous frame)))) + (format #t "~%") + ))))) -- cgit v1.2.3