From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 23 Feb 2004 20:56:21 +0000 (+0000)
Subject: Eliminate PARSE-XML-DOCUMENT.  Merge STRING->XML and SUBSTRING->XML.
X-Git-Tag: 20090517-FFI~1679
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5c7ce4f26d3ef4ae5fa3ae386f276ffcc337a8b0;p=mit-scheme.git

Eliminate PARSE-XML-DOCUMENT.  Merge STRING->XML and SUBSTRING->XML.
Force input coding to UTF-8 (for now).  Force input line ending to
XML-1.0.
---

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index 6083b8792..753953c98 100644
--- a/v7/src/xml/xml-parser.scm
+++ b/v7/src/xml/xml-parser.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml-parser.scm,v 1.55 2004/02/18 19:52:06 cph Exp $
+$Id: xml-parser.scm,v 1.56 2004/02/23 20:56:21 cph Exp $
 
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
@@ -79,22 +79,26 @@ USA.
       (read-xml port (if (default-object? pi-handlers) '() pi-handlers)))))
 
 (define (read-xml port #!optional pi-handlers)
-  (parse-xml-document (input-port->parser-buffer port)
-		      (if (default-object? pi-handlers) '() pi-handlers)))
-
-(define (string->xml string #!optional pi-handlers)
-  (parse-xml-document (string->parser-buffer string)
-		      (if (default-object? pi-handlers) '() pi-handlers)))
-
-(define (substring->xml string start end #!optional pi-handlers)
-  (parse-xml-document (substring->parser-buffer string start end)
-		      (if (default-object? pi-handlers) '() pi-handlers)))
+  (let ((operation (port/operation port 'SET-CODING)))
+    (if operation
+	(operation port 'UTF-8)))
+  (let ((operation (port/operation port 'SET-LINE-ENDING)))
+    (if operation
+	(operation port 'XML-1.0)))
+  (parse-xml (input-port->parser-buffer port)
+	     (if (default-object? pi-handlers) '() pi-handlers)))
+
+(define (string->xml string #!optional start end pi-handlers)
+  (parse-xml (string->parser-buffer string
+				    (if (default-object? start) #f start)
+				    (if (default-object? end) #f end))
+	     (if (default-object? pi-handlers) '() pi-handlers)))
 
 ;;;; Top level
 
-(define (parse-xml-document buffer #!optional pi-handlers) ;[1,22]
+(define (parse-xml buffer #!optional pi-handlers) ;[1,22]
   (if (not (parser-buffer? buffer))
-      (error:wrong-type-argument buffer "parser buffer" 'PARSE-XML-DOCUMENT))
+      (error:wrong-type-argument buffer "parser buffer" 'PARSE-XML))
   (let ((pi-handlers (if (default-object? pi-handlers) '() pi-handlers)))
     (if (not (list-of-type? pi-handlers
 	       (lambda (entry)
@@ -104,8 +108,7 @@ USA.
 		      (procedure? (cadr entry))
 		      (procedure-arity-valid? (cadr entry) 1)
 		      (null? (cddr entry))))))
-	(error:wrong-type-argument pi-handlers "handler alist"
-				   'PARSE-XML-DOCUMENT))
+	(error:wrong-type-argument pi-handlers "handler alist" 'PARSE-XML))
     (let ((one-value (lambda (v) (and v (vector-ref v 0)))))
       (fluid-let ((*general-entities* (predefined-entities))
 		  (*standalone?*)
@@ -365,8 +368,6 @@ USA.
 	    (must-match?
 	     (let ((p (get-parser-buffer-pointer buffer))
 		   (c (peek-parser-buffer-char buffer)))
-	       ;; Not quite right -- we should be getting the next
-	       ;; UTF-8 character, but this gets the next byte.
 	       (if c
 		   (perror p "Illegal character" c)
 		   (perror p "Unexpected EOF"))))
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index b54d47e6a..aee58e433 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.36 2003/12/29 05:08:15 uid67408 Exp $
+$Id: xml.pkg,v 1.37 2004/02/23 20:56:05 cph Exp $
 
-Copyright 2001,2002,2003 Massachusetts Institute of Technology
+Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -272,11 +272,9 @@ USA.
   (export ()
 	  alphabet:xml-char
 	  char-set:xml-whitespace
-	  parse-xml-document
 	  read-xml
 	  read-xml-file
-	  string->xml
-	  substring->xml)
+	  string->xml)
   (export (runtime xml)
 	  alphabet:name-initial
 	  alphabet:name-subsequent))