(define-record-type x-error :x-error
  (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-enumerated-type error-code :error-code
  error-code? error-codes error-code-name error-code-index
  (success bad-request bad-value bad-window bad-pixmap bad-atom
   bad-cursor bad-font bad-match bad-drawable bad-access bad-alloc
   bad-color bad-gc bad-id-choice bad-name bad-length bad-implementation))

(define (integer->error-code i)
  (if (< i (vector-length error-codes))
      (vector-ref error-codes i)
      ;; there can be larger numbers - extension errors
      i))

(define internal-x-error-handler
  (lambda (infos)
    (let ((display (make-display (vector-ref infos 0) #f))
	  (ser-num (vector-ref infos 1))
	  (error-code (integer->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)))
      (set-next-x-error! *most-recent-x-error*
			 (make-x-error display ser-num error-code major-opcode
				       minor-opcode res-id error-string))
      (advance-most-recent-x-error!))))

(define-exported-binding "internal-x-error-handler" internal-x-error-handler)

;;; Fatal errors are handled by an ordinary handler
(define *x-fatal-error-handler* #f)

(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*
      (let ((old-hander *x-fatal-error-handler*))
	(set! *x-fatal-error-handler* (car args))
	old-hander)))