From 83432eb098f63fd0dc0dda083bf92a59cecbe9c6 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 14 Jul 2001 11:43:50 +0000
Subject: [PATCH] Export type descriptors for each of the XML data structure
 types.

---
 v7/src/xml/xml-struct.scm | 23 +++++++++++++++++++----
 v7/src/xml/xml.pkg        | 17 ++++++++++++++++-
 2 files changed, 35 insertions(+), 5 deletions(-)

diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm
index da44e0bc0..a1dc1b79b 100644
--- a/v7/src/xml/xml-struct.scm
+++ b/v7/src/xml/xml-struct.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: xml-struct.scm,v 1.3 2001/07/10 05:30:31 cph Exp $
+;;; $Id: xml-struct.scm,v 1.4 2001/07/14 11:43:50 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -23,7 +23,8 @@
 
 (declare (usual-integrations))
 
-(define-structure xml-document
+(define-structure (xml-document
+		   (type-descriptor xml-document-rtd))
   declaration
   misc-1
   dtd
@@ -31,12 +32,14 @@
   root
   misc-3)
 
-(define-structure xml-declaration
+(define-structure (xml-declaration
+		   (type-descriptor xml-declaration-rtd))
   version
   encoding
   standalone)
 
 (define-structure (xml-element
+		   (type-descriptor xml-element-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-ELEMENT
 		      (lambda (element port)
@@ -47,6 +50,7 @@
   contents)
 
 (define-structure (xml-processing-instructions
+		   (type-descriptor xml-processing-instructions-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-PROCESSING-INSTRUCTIONS
 		      (lambda (element port)
@@ -56,10 +60,12 @@
   name
   text)
 
-(define-structure xml-uninterpreted
+(define-structure (xml-uninterpreted
+		   (type-descriptor xml-uninterpreted-rtd))
   text)
 
 (define-structure (xml-entity-reference
+		   (type-descriptor xml-entity-reference-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-ENTITY-REFERENCE
 		      (lambda (reference port)
@@ -68,6 +74,7 @@
   name)
 
 (define-structure (xml-parameter-entity-reference
+		   (type-descriptor xml-parameter-entity-reference-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-PARAMETER-ENTITY-REFERENCE
 		      (lambda (reference port)
@@ -87,6 +94,7 @@
   (make-string-hash-table))
 
 (define-structure (xml-dtd
+		   (type-descriptor xml-dtd-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-DTD
 		      (lambda (dtd port)
@@ -97,6 +105,7 @@
   internal)
 
 (define-structure (xml-external-id
+		   (type-descriptor xml-external-id-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-EXTERNAL-ID
 		      (lambda (dtd port)
@@ -108,6 +117,7 @@
   uri)
 
 (define-structure (xml-!element
+		   (type-descriptor xml-!element-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-!ELEMENT
 		      (lambda (element port)
@@ -117,6 +127,7 @@
   content-type)
 
 (define-structure (xml-!attlist
+		   (type-descriptor xml-!attlist-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-!ATTLIST
 		      (lambda (element port)
@@ -126,6 +137,7 @@
   definitions)
 
 (define-structure (xml-!entity
+		   (type-descriptor xml-!entity-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-!ENTITY
 		      (lambda (element port)
@@ -135,6 +147,7 @@
   value)
 
 (define-structure (xml-unparsed-!entity
+		   (type-descriptor xml-unparsed-!entity-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-UNPARSED-!ENTITY
 		      (lambda (element port)
@@ -145,6 +158,7 @@
   notation)
 
 (define-structure (xml-parameter-!entity
+		   (type-descriptor xml-parameter-!entity-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-PARAMETER-!ENTITY
 		      (lambda (element port)
@@ -154,6 +168,7 @@
   value)
 
 (define-structure (xml-!notation
+		   (type-descriptor xml-!notation-rtd)
 		   (print-procedure
 		    (standard-unparser-method 'XML-!NOTATION
 		      (lambda (element port)
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 495a768b6..780a0b6cf 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: xml.pkg,v 1.3 2001/07/12 03:20:53 cph Exp $
+;;; $Id: xml.pkg,v 1.4 2001/07/14 11:43:47 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
@@ -83,17 +83,22 @@
 	  set-xml-unparsed-!entity-notation!
 	  xml-!attlist-definitions
 	  xml-!attlist-name
+	  xml-!attlist-rtd
 	  xml-!attlist?
 	  xml-!element-content-type
 	  xml-!element-name
+	  xml-!element-rtd
 	  xml-!element?
 	  xml-!entity-name
+	  xml-!entity-rtd
 	  xml-!entity-value
 	  xml-!entity?
 	  xml-!notation-id
 	  xml-!notation-name
+	  xml-!notation-rtd
 	  xml-!notation?
 	  xml-declaration-encoding
+	  xml-declaration-rtd
 	  xml-declaration-standalone
 	  xml-declaration-version
 	  xml-declaration?
@@ -103,33 +108,43 @@
 	  xml-document-misc-2
 	  xml-document-misc-3
 	  xml-document-root
+	  xml-document-rtd
 	  xml-document?
 	  xml-dtd-external
 	  xml-dtd-internal
 	  xml-dtd-root
+	  xml-dtd-rtd
 	  xml-dtd?
 	  xml-element-attributes
 	  xml-element-contents
 	  xml-element-name
+	  xml-element-rtd
 	  xml-element?
 	  xml-entity-reference-name
+	  xml-entity-reference-rtd
 	  xml-entity-reference?
 	  xml-external-id-id
+	  xml-external-id-rtd
 	  xml-external-id-uri
 	  xml-external-id?
 	  xml-intern
 	  xml-parameter-!entity-name
+	  xml-parameter-!entity-rtd
 	  xml-parameter-!entity-value
 	  xml-parameter-!entity?
+	  xml-parameter-entity-reference-rtd
 	  xml-parameter-entity-reference?
 	  xml-processing-instructions-name
+	  xml-processing-instructions-rtd
 	  xml-processing-instructions-text
 	  xml-processing-instructions?
+	  xml-uninterpreted-rtd
 	  xml-uninterpreted-text
 	  xml-uninterpreted?
 	  xml-unparsed-!entity-id
 	  xml-unparsed-!entity-name
 	  xml-unparsed-!entity-notation
+	  xml-unparsed-!entity-rtd
 	  xml-unparsed-!entity?))
 
 (define-package (runtime xml parser)
-- 
2.25.1