diff options
Diffstat (limited to 'tclxml/tclxml-tcl/xml-8.1.tcl')
-rwxr-xr-x | tclxml/tclxml-tcl/xml-8.1.tcl | 135 |
1 files changed, 135 insertions, 0 deletions
diff --git a/tclxml/tclxml-tcl/xml-8.1.tcl b/tclxml/tclxml-tcl/xml-8.1.tcl new file mode 100755 index 0000000..5ec410b --- /dev/null +++ b/tclxml/tclxml-tcl/xml-8.1.tcl @@ -0,0 +1,135 @@ +# xml.tcl -- +# +# This file provides generic XML services for all implementations. +# This file supports Tcl 8.1 regular expressions. +# +# See tclparser.tcl for the Tcl implementation of a XML parser. +# +# Copyright (c) 2005 by Explain. +# http://www.explain.com.au/ +# Copyright (c) 1998-2004 Zveno Pty Ltd +# http://www.zveno.com/ +# +# See the file "LICENSE" in this distribution for information on usage and +# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# $Id: xml-8.1.tcl,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $ + +package require Tcl 8.1 + +package provide xmldefs 3.2 + +package require sgml 1.8 + +namespace eval xml { + + namespace export qnamesplit + + # Convenience routine + proc cl x { + return "\[$x\]" + } + + # Define various regular expressions + + # Characters + variable Char $::sgml::Char + + # white space + variable Wsp " \t\r\n" + variable allWsp [cl $Wsp]* + variable noWsp [cl ^$Wsp] + + # Various XML names and tokens + + variable NameChar $::sgml::NameChar + variable Name $::sgml::Name + variable Names $::sgml::Names + variable Nmtoken $::sgml::Nmtoken + variable Nmtokens $::sgml::Nmtokens + + # XML Namespaces names + + # NCName ::= Name - ':' + variable NCName $::sgml::Name + regsub -all : $NCName {} NCName + variable QName (${NCName}:)?$NCName ;# (Prefix ':')? LocalPart + + # The definition of the Namespace URI for XML Namespaces themselves. + # The prefix 'xml' is automatically bound to this URI. + variable xmlnsNS http://www.w3.org/XML/1998/namespace + + # table of predefined entities + + variable EntityPredef + array set EntityPredef { + lt < gt > amp & quot \" apos ' + } + + # Expressions for pulling things apart + variable tokExpr <(/?)([::xml::cl ^$::xml::Wsp>/]+)([::xml::cl $::xml::Wsp]*[::xml::cl ^>]*)> + variable substExpr "\}\n{\\2} {\\1} {\\3} \{" + +} + +### +### Exported procedures +### + +# xml::qnamesplit -- +# +# Split a QName into its constituent parts: +# the XML Namespace prefix and the Local-name +# +# Arguments: +# qname XML Qualified Name (see XML Namespaces [6]) +# +# Results: +# Returns prefix and local-name as a Tcl list. +# Error condition returned if the prefix or local-name +# are not valid NCNames (XML Name) + +proc xml::qnamesplit qname { + variable NCName + variable Name + + set prefix {} + set localname $qname + if {[regexp : $qname]} { + if {![regexp ^($NCName)?:($NCName)\$ $qname discard prefix localname]} { + return -code error "name \"$qname\" is not a valid QName" + } + } elseif {![regexp ^$Name\$ $qname]} { + return -code error "name \"$qname\" is not a valid Name" + } + + return [list $prefix $localname] +} + +### +### General utility procedures +### + +# xml::noop -- +# +# A do-nothing proc + +proc xml::noop args {} + +### Following procedures are based on html_library + +# xml::zapWhite -- +# +# Convert multiple white space into a single space. +# +# Arguments: +# data plain text +# +# Results: +# As above + +proc xml::zapWhite data { + regsub -all "\[ \t\r\n\]+" $data { } data + return $data +} + |