From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 17 Sep 2003 03:20:45 +0000 (+0000)
Subject: New procedure XML-NAME-SIMPLE.  Change printed representation of
X-Git-Tag: 20090517-FFI~1808
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0e1ec6eb63ecd7cc8a83f11da043edd92972ae5d;p=mit-scheme.git

New procedure XML-NAME-SIMPLE.  Change printed representation of
elements to show the simple name.
---

diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm
index eb9a325c9..5716cb5f2 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.23 2003/09/11 18:38:21 cph Exp $
+$Id: xml-struct.scm,v 1.24 2003/09/17 03:20:45 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -114,10 +114,13 @@ USA.
 (define universal-names
   (make-eq-hash-table))
 
+(define (xml-name-simple name)
+  (cond ((xml-nmtoken? name) name)
+	((combo-name? name) (combo-name-simple name))
+	(else (error:not-xml-name name 'XML-NAME-simple))))
+
 (define (xml-name-string name)
-  (cond ((xml-nmtoken? name) (symbol-name name))
-	((combo-name? name) (symbol-name (combo-name-simple name)))
-	(else (error:not-xml-name name 'XML-NAME-STRING))))
+  (symbol-name (xml-name-simple name)))
 
 (define (xml-name-uri name)
   (cond ((xml-nmtoken? name) #f)
@@ -577,16 +580,20 @@ USA.
 			  PORT))))))
 	 (ill-formed-syntax form)))))
 
-(define-xml-printer element xml-element-name)
 (define-xml-printer processing-instructions xml-processing-instructions-name)
 (define-xml-printer dtd xml-dtd-root)
-(define-xml-printer external-id
-  (lambda (dtd)
-    (or (xml-external-id-id dtd)
-	(xml-external-id-uri dtd))))
 (define-xml-printer !element xml-!element-name)
 (define-xml-printer !attlist xml-!attlist-name)
 (define-xml-printer !entity xml-!entity-name)
 (define-xml-printer unparsed-!entity xml-unparsed-!entity-name)
 (define-xml-printer parameter-!entity xml-parameter-!entity-name)
-(define-xml-printer !notation xml-!notation-name)
\ No newline at end of file
+(define-xml-printer !notation xml-!notation-name)
+
+(define-xml-printer element
+  (lambda (elt)
+    (xml-name-simple (xml-element-name elt))))
+
+(define-xml-printer external-id
+  (lambda (dtd)
+    (or (xml-external-id-id dtd)
+	(xml-external-id-uri dtd))))
\ No newline at end of file
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index e80b8d297..07151ef70 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.24 2003/08/20 17:23:47 cph Exp $
+$Id: xml.pkg,v 1.25 2003/09/17 03:20:41 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -152,6 +152,7 @@ USA.
 	  xml-name-hash
 	  xml-name-local
 	  xml-name-prefix
+	  xml-name-simple
 	  xml-name-string
 	  xml-name-uri
 	  xml-name=?