[Scsh-checkins] CVS: scx/scheme/xlib error.scm,NONE,1.1 extension.scm,NONE,1.1

[David Frese <frese@users.sourceforge.net>]

Update of /cvsroot/scsh/scx/scheme/xlib
In directory usw-pr-cvs1:/tmp/cvs-serv31055

Added Files:
        error.scm extension.scm 
Log Message:
new implementations.


--- NEW FILE ---
(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))))

--- NEW FILE ---
(define (list-extensions display)
  (vector->list (%list-extensions (display-Xdisplay display))))

(import-lambda-definition %list-extensions (Xdisplay)
  "scx_List_Extensions")

(define (query-extension display name)
  (let ((res (%query-extension (display-Xdisplay display)
                               (if (symbol? name)
                                   (string->symbol name)
                                   name))))
    (if res
        (vector->list res)
        res)))

(import-lambda-definition %query-extension (Xdisplay name)
  "scx_Query_Extension")