From fd66d0396bbd534d4f034af7e4bdf73f12ea4647 Mon Sep 17 00:00:00 2001
From: frese <frese>
Date: Wed, 29 Aug 2001 14:44:15 +0000
Subject: [PATCH] new implementations.

---
 scheme/xlib/error.scm     | 37 +++++++++++++++++++++++++++++++++++++
 scheme/xlib/extension.scm | 17 +++++++++++++++++
 2 files changed, 54 insertions(+)
 create mode 100644 scheme/xlib/error.scm
 create mode 100644 scheme/xlib/extension.scm

diff --git a/scheme/xlib/error.scm b/scheme/xlib/error.scm
new file mode 100644
index 0000000..a867f53
--- /dev/null
+++ b/scheme/xlib/error.scm
@@ -0,0 +1,37 @@
+(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))))
diff --git a/scheme/xlib/extension.scm b/scheme/xlib/extension.scm
new file mode 100644
index 0000000..8c4308d
--- /dev/null
+++ b/scheme/xlib/extension.scm
@@ -0,0 +1,17 @@
+(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")