From 91d28e0dd2934ebb34a37a663068e84d7f723b20 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 26 Jan 2006 05:44:33 +0000
Subject: [PATCH] Implement XML-STYLESHEET.

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

diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm
index df4521e55..c0b7eed76 100644
--- a/v7/src/xml/xml-struct.scm
+++ b/v7/src/xml/xml-struct.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: xml-struct.scm,v 1.49 2005/12/19 04:00:37 cph Exp $
+$Id: xml-struct.scm,v 1.50 2006/01/26 05:44:33 cph Exp $
 
-Copyright 2001,2002,2003,2004,2005 Massachusetts Institute of Technology
+Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -466,6 +466,21 @@ USA.
 	  (if (char-whitespace? (wide-string-ref ws (fix:- n 1))) "" " "))
 	 " "))))
 
+(define (xml-stylesheet . items)
+  (make-xml-processing-instructions
+   'xml-stylesheet
+   (call-with-output-string
+     (lambda (port)
+       (for-each (lambda (attr)
+		   (write-char #\space port)
+		   (write-string (xml-name-string (xml-attribute-name attr))
+				 port)
+		   (write-char #\= port)
+		   (write-char #\" port)
+		   (write-string (xml-attribute-value attr) port)
+		   (write-char #\" port))
+		 (apply xml-attrs items))))))
+
 (define (standard-xml-element-constructor qname iri empty?)
   (let ((name (make-xml-name qname iri)))
     (if empty?
@@ -481,7 +496,7 @@ USA.
     (lambda (object)
       (and (xml-element? object)
 	   (xml-name=? (xml-element-name object) name)))))
-
+
 (define (xml-attrs . items)
   (let ((flush
 	 (lambda (name attrs)
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 97fa88c6e..4a50046bb 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.59 2005/12/19 04:00:32 cph Exp $
+$Id: xml.pkg,v 1.60 2006/01/26 05:44:25 cph Exp $
 
-Copyright 2001,2002,2003,2004,2005 Massachusetts Institute of Technology
+Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -254,6 +254,7 @@ USA.
 	  xml-processing-instructions-name
 	  xml-processing-instructions-text
 	  xml-processing-instructions?
+	  xml-stylesheet
 	  xml-unparsed-!entity-id
 	  xml-unparsed-!entity-name
 	  xml-unparsed-!entity-notation
-- 
2.25.1