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

Error handling similar to sigevents

This commit is contained in:
mainzelm 2001-12-19 21:37:16 +00:00
parent 625a7c2fc2
commit 20fc229b08
3 changed files with 62 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
scheme/xlib/error.scm
View File

@ -1,26 +1,57 @@
(define *x-error-handler* #f) (define-record-type x-error :x-error
(define *x-fatal-error-handler* #f) (really-make-x-error display ser-num code major-opcode minor-opcode res-id text next)
x-error?
(display x-error-display)
(ser-num x-error-ser-num)
(code x-error-code)
(major-opcode x-error-major-opcode)
(minor-opcode x-error-minor-opcode)
(res-id x-error-res-id)
(text x-error-text)
(next really-next-x-error really-set-next-x-error!))
(define (make-x-error display ser-num code major-opcode minor-opcode res-id text)
(really-make-x-error display ser-num code major-opcode
minor-opcode res-id text (make-placeholder)))
(define (next-x-error x-error)
(placeholder-value (really-next-x-error x-error)))
(define (set-next-x-error! x-error next-x-error)
(placeholder-set! (really-next-x-error x-error) next-x-error))
(define empty-x-error (make-x-error #f #f #f #f #f #f #f))
(define (empty-x-error? obj)
(eq? obj empty-x-error))
(define *most-recent-x-error* empty-x-error)
(define (most-recent-x-error)
*most-recent-x-error*)
(define (advance-most-recent-x-error!)
(set! *most-recent-x-error*
(next-x-error *most-recent-x-error*)))
(define internal-x-error-handler (define internal-x-error-handler
(lambda (infos) (lambda (infos)
(if *x-error-handler* (let ((display (make-display (vector-ref infos 0) #f))
(let ((display (make-display (vector-ref infos 0) #f)) (ser-num (vector-ref infos 1))
(ser-num (vector-ref infos 1)) (error-code (vector-ref infos 2))
(error-code (vector-ref infos 2)) (major-opcode (vector-ref infos 3))
(major-opcode (vector-ref infos 3)) (minor-opcode (vector-ref infos 4))
(minor-opcode (vector-ref infos 4)) (res-id (vector-ref infos 5))
(res-id (vector-ref infos 5)) (error-string (vector-ref infos 6)))
(error-string (vector-ref infos 6))) (set-next-x-error! *most-recent-x-error*
(*x-error-handler* display ser-num error-code major-opcode (make-x-error display ser-num error-code major-opcode
minor-opcode res-id error-string)) minor-opcode res-id error-string))
#f))) (advance-most-recent-x-error!))))
(define-exported-binding "internal-x-error-handler" internal-x-error-handler) (define-exported-binding "internal-x-error-handler" internal-x-error-handler)
(define (x-error-handler . args) ;;; Fatal errors are handled by an ordinary handler
(if (null? args) (define *x-fatal-error-handler* #f)
*x-error-handler*
(set! *x-error-handler* (car args))))
(define internal-x-fatal-error-handler (define internal-x-fatal-error-handler
(lambda (Xdisplay) (lambda (Xdisplay)
@ -34,4 +65,6 @@
(define (x-fatal-error-handler . args) (define (x-fatal-error-handler . args)
(if (null? args) (if (null? args)
*x-fatal-error-handler* *x-fatal-error-handler*
(set! *x-fatal-error-handler* (car args)))) (let ((old-hander *x-fatal-error-handler*))
(set! *x-fatal-error-handler* (car args))
old-hander)))

10
scheme/xlib/xlib-interfaces.scm
View File

@ -409,7 +409,15 @@
refresh-keyboard-mapping)) refresh-keyboard-mapping))
(define-interface xlib-error-interface (define-interface xlib-error-interface
(export x-error-handler (export x-error-display
x-error-ser-num
x-error-code
x-error-major-opcode
x-error-minor-opcode
x-error-res-id
x-error-text
most-recent-x-error
next-x-error
x-fatal-error-handler)) x-fatal-error-handler))
(define-interface xlib-extension-interface (define-interface xlib-extension-interface

2
scheme/xlib/xlib-packages.scm
View File

@ -137,6 +137,8 @@
(define-structure xlib-error xlib-error-interface (define-structure xlib-error xlib-error-interface
(open scheme (open scheme
external-calls external-calls
placeholders
define-record-types
xlib-types) xlib-types)
(files error)) (files error))