home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / tclxml2.0 / xml-8.1.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  3.6 KB  |  148 lines
  1. # xml.tcl --
  2. #
  3. #    This file provides generic XML services for all implementations.
  4. #    This file supports Tcl 8.1 regular expressions.
  5. #
  6. #    See tclparser.tcl for the Tcl implementation of a XML parser.
  7. #
  8. # Copyright (c) 1998-2000 Zveno Pty Ltd
  9. # http://www.zveno.com/
  10. # 
  11. # Zveno makes this software and all associated data and documentation
  12. # ('Software') available free of charge for any purpose.
  13. # Copies may be made of this Software but all of this notice must be included
  14. # on any copy.
  15. # 
  16. # The Software was developed for research purposes and Zveno does not warrant
  17. # that it is error free or fit for any purpose.  Zveno disclaims any
  18. # liability for all claims, expenses, losses, damages and costs any user may
  19. # incur as a result of using, copying or modifying the Software.
  20. #
  21. # Copyright (c) 1997 Australian National University (ANU).
  22. # 
  23. # ANU makes this software and all associated data and documentation
  24. # ('Software') available free of charge for any purpose. You may make copies
  25. # of the Software but you must include all of this notice on any copy.
  26. # 
  27. # The Software was developed for research purposes and ANU does not warrant
  28. # that it is error free or fit for any purpose.  ANU disclaims any
  29. # liability for all claims, expenses, losses, damages and costs any user may
  30. # incur as a result of using, copying or modifying the Software.
  31. #
  32. # $Id: xml-8.1.tcl,v 1.9 2000/12/28 22:45:26 balls Exp $
  33.  
  34. package require Tcl 8.1
  35.  
  36. package provide xmldefs 2.0
  37.  
  38. package require sgml 1.8
  39.  
  40. namespace eval xml {
  41.  
  42.     namespace export qnamesplit
  43.  
  44.     # Convenience routine
  45.     proc cl x {
  46.     return "\[$x\]"
  47.     }
  48.  
  49.     # Define various regular expressions
  50.  
  51.     # Characters
  52.     variable Char $::sgml::Char
  53.  
  54.     # white space
  55.     variable Wsp " \t\r\n"
  56.     variable allWsp [cl $Wsp]*
  57.     variable noWsp [cl ^$Wsp]
  58.  
  59.     # Various XML names and tokens
  60.  
  61.     variable NameChar $::sgml::NameChar
  62.     variable Name $::sgml::Name
  63.     variable Names $::sgml::Names
  64.     variable Nmtoken $::sgml::Nmtoken
  65.     variable Nmtokens $::sgml::Nmtokens
  66.  
  67.     # XML Namespaces names
  68.  
  69.     # NCName ::= Name - ':'
  70.     variable NCName $::sgml::Name
  71.     regsub -all : $NCName {} NCName
  72.     variable QName (${NCName}:)?$NCName        ;# (Prefix ':')? LocalPart
  73.  
  74.     # table of predefined entities
  75.  
  76.     variable EntityPredef
  77.     array set EntityPredef {
  78.     lt <   gt >   amp &   quot \"   apos '
  79.     }
  80.  
  81.     # Expressions for pulling things apart
  82.     variable tokExpr <(/?)([::xml::cl ^$::xml::Wsp>/]+)([::xml::cl $::xml::Wsp]*[::xml::cl ^>]*)>
  83.     variable substExpr "\}\n{\\2} {\\1} {\\3} \{"
  84.  
  85. }
  86.  
  87. ###
  88. ###    Exported procedures
  89. ###
  90.  
  91. # xml::qnamesplit --
  92. #
  93. #    Split a QName into its constituent parts:
  94. #    the XML Namespace prefix and the Local-name
  95. #
  96. # Arguments:
  97. #    qname    XML Qualified Name (see XML Namespaces [6])
  98. #
  99. # Results:
  100. #    Returns prefix and local-name as a Tcl list.
  101. #    Error condition returned if the prefix or local-name
  102. #    are not valid NCNames (XML Name)
  103.  
  104. proc xml::qnamesplit qname {
  105.     variable NCName
  106.     variable Name
  107.  
  108.     set prefix {}
  109.     set localname $qname
  110.     if {[regexp : $qname]} {
  111.     if {![regexp ^($NCName)?:($NCName)\$ $qname discard prefix localname]} {
  112.         return -code error "name \"$qname\" is not a valid QName"
  113.     }
  114.     } elseif {![regexp ^$Name\$ $qname]} {
  115.     return -code error "name \"$qname\" is not a valid Name"
  116.     }
  117.  
  118.     return [list $prefix $localname]
  119. }
  120.  
  121. ###
  122. ###    General utility procedures
  123. ###
  124.  
  125. # xml::noop --
  126. #
  127. # A do-nothing proc
  128.  
  129. proc xml::noop args {}
  130.  
  131. ### Following procedures are based on html_library
  132.  
  133. # xml::zapWhite --
  134. #
  135. #    Convert multiple white space into a single space.
  136. #
  137. # Arguments:
  138. #    data    plain text
  139. #
  140. # Results:
  141. #    As above
  142.  
  143. proc xml::zapWhite data {
  144.     regsub -all "\[ \t\r\n\]+" $data { } data
  145.     return $data
  146. }
  147.  
  148.