diff --git a/src/packages.scm b/src/packages.scm index 27deb4a..11e98ed 100644 --- a/src/packages.scm +++ b/src/packages.scm @@ -39,7 +39,7 @@ with-prevent-events) (open scheme i/o list-lib define-record-types finite-types enum-sets threads locks placeholders rendezvous rendezvous-channels - signals handle scsh + signals handle scsh inspect-exception rx-syntax field-reader-package xlib) (files utils)) diff --git a/src/utils.scm b/src/utils.scm index 5c59ed5..f7d173e 100644 --- a/src/utils.scm +++ b/src/utils.scm @@ -40,9 +40,9 @@ (fun (if (null? fun) id (car fun)))) (let ((sp (make-sync-point))) (spawn (lambda () - (with-handler - (lambda (condition punt) - (mdisplay "condition in " id ":") + (with-fatal-and-capturing-error-handler + (lambda (condition continuation punt) + (display-continuation continuation) (punt)) (lambda () (let ((res (fun (lambda () (sync-point-release sp))))) @@ -341,9 +341,13 @@ (define (delete-window dpy window time) (let* ((protocols (get-wm-protocols dpy window)) (wm-delete-window (intern-atom dpy "WM_DELETE_WINDOW" #f))) - (if (member wm-delete-window protocols) - (send-protocol-message dpy window wm-delete-window time) - (destroy-window dpy window)))) + (if protocols + (if (member wm-delete-window protocols) + (send-protocol-message dpy window wm-delete-window time) + (destroy-window dpy window)) + (begin + (warn "get-wm-protocols #f" dpy window) + (destroy-window dpy window))))) (define (move-resize-window* dpy window rect) (move-resize-window dpy window