scsh-conservatory
/
scx
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixed x-error handling / warnings because it did return unspecific

This commit is contained in:
frese 2003-05-04 17:35:02 +00:00
parent ed62570d2e
commit aae4511c7b
1 changed files with 11 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
scheme/xlib/display.scm
View File

@ -29,24 +29,22 @@
(if (not (eq? queue (display:error-queue display))) (if (not (eq? queue (display:error-queue display)))
(let* ((next (next-x-error-queue queue)) (let* ((next (next-x-error-queue queue))
(error (x-error-queue:this next))) (error (x-error-queue:this next)))
(signal-x-warning error)) (signal-x-warning error)))
result)))) result)))
(thunk)) (thunk))
(error "first argument of an xlib-function must be a display object" (error "first argument of an xlib-function must be a display object"
name display))) name display)))
(define (call-critical thunk) (define (call-critical thunk)
(let ((old-enabled (set-enabled-interrupts! no-interrupts)) (let ((old-enabled (set-enabled-interrupts! no-interrupts)))
(result (call-with-current-continuation (with-handler
(lambda (return) (lambda (condition punt)
(cons #t
(with-handler (lambda (condition punt)
(return (cons #f condition)))
thunk))))))
(set-enabled-interrupts! old-enabled) (set-enabled-interrupts! old-enabled)
(if (car result) (punt))
(cdr result) (lambda ()
(signal-condition (cdr result))))) (let ((result (thunk)))
(set-enabled-interrupts! old-enabled)
result)))))
;; TODO: pixmap-formats (XListPixmapFormats) ;; TODO: pixmap-formats (XListPixmapFormats)
(define-record-type display :display (define-record-type display :display