38 lines
1.1 KiB
Scheme
38 lines
1.1 KiB
Scheme
(define *x-error-handler* #f)
|
|
(define *x-fatal-error-handler* #f)
|
|
|
|
(define internal-x-error-handler
|
|
(lambda (infos)
|
|
(if *x-error-handler*
|
|
(let ((display (make-display (vector-ref infos 0) #f))
|
|
(ser-num (vector-ref infos 1))
|
|
(error-code (vector-ref infos 2))
|
|
(major-opcode (vector-ref infos 3))
|
|
(minor-opcode (vector-ref infos 4))
|
|
(res-id (vector-ref infos 5))
|
|
(error-string (vector-ref infos 6)))
|
|
(*x-error-handler* display ser-num error-code major-opcode
|
|
minor-opcode res-id error-string))
|
|
#f)))
|
|
|
|
(define-exported-binding "internal-x-error-handler" internal-x-error-handler)
|
|
|
|
(define (x-error-handler . args)
|
|
(if (null? args)
|
|
*x-error-handler*
|
|
(set! *x-error-handler* (car args))))
|
|
|
|
(define internal-x-fatal-error-handler
|
|
(lambda (Xdisplay)
|
|
(if *x-fatal-error-handler*
|
|
(*x-fatal-error-handler* (make-display Xdisplay #f))
|
|
#f)))
|
|
|
|
(define-exported-binding "internal-x-fatal-error-handler"
|
|
internal-x-fatal-error-handler)
|
|
|
|
(define (x-fatal-error-handler . args)
|
|
(if (null? args)
|
|
*x-fatal-error-handler*
|
|
(set! *x-fatal-error-handler* (car args))))
|