xml-8.1.tcl

Linux下的MSN聊天程序源码

# 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) 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 5915 2006-01-23 12:43:37Z tjikkun $

package require Tcl 8.1

package provide xmldefs 3.1

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
}