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 eb9a325c97410175d40a4ba62ea9677317d6bb37..5716cb5f205f231131cf5187595ed00432c61a1f 100644 (file)
--- 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))
 \f
+(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 e80b8d29748d7f4d48abdc1100f179da9aa7c5d0..07151ef70042795e32d7f111c475cdbe0ba6aae2 100644 (file)
--- 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=?