Implement XML-STYLESHEET.

diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm
index df4521e55df09a0ac8f4e9eda92ab274662cbb21..c0b7eed76d834b1ba906db79a173d511ec28b819 100644 (file)
--- 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)))))
-
+\f
 (define (xml-attrs . items)
   (let ((flush
         (lambda (name attrs)

diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 97fa88c6eb5f36e2879e8561b68e3dba918cc8fe..4a50046bb7d1327e0a83ea2d7d2d9daa49ae0d21 100644 (file)
--- 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