library/xml/sgml.tcl

0 # sgml.tcl --
33 # $Id: sgml.tcl,v 1.4 2006/09/27 08:12:40 neumann Exp $
35 package provide sgml 1.6
37 namespace eval sgml {
54     variable name [cl a-zA-Z_][cl -a-zA-Z0-9._]*
75 # sgml::tokenise --
80 #	sgml		text to tokenize
92 proc sgml::tokenise {sgml elemExpr elemSub args} {
108     if {[regexp {<!DOCTYPE[^[<]+\[([^]]+)\]} $sgml discard dtd]} {
109 	regsub {(<!DOCTYPE[^[<]+)(\[[^]]+\])} $sgml {\1\&xml:intdtd;} sgml
113     regsub -all {([{}\\])} $sgml {\\\1} sgml
120 	    regsub -all $elemExpr $unused$sgml $elemSub sgml
123 	    regsub -all $elemExpr $sgml $elemSub sgml
125 	set sgml "{} {} {} {} \{$sgml\}"
130 	if {[regexp {^([^<]*)(<[^>]*$)} [lindex $sgml end] x text unused]} {
131 	    set sgml [lreplace $sgml end end $text]
139 	regsub -all $elemExpr $sgml $elemSub sgml
140 	set sgml "{} {} {} {} \{$sgml\}"
143     return $sgml
147 # sgml::parseEvent --
160 #	sgml		Instance data, as a Tcl list.
190 proc sgml::parseEvent {sgml args} {
194     variable name
238     foreach {tag close empty param text} $sgml {
431 			regexp ^[cl $Wsp]*($name)(.*) $param x state(doc_name) param
458 			    if {[regexp -nocase ^[cl $Wsp]+NDATA[cl $Wsp]+($name)(.*) $param x notation param]} {
573 # sgml::ParseEvent:ElementOpen --
578 #	tag	Element name
590 proc sgml::ParseEvent:ElementOpen {tag attr opts args} {
622 # sgml::ParseEvent:ElementClose --
627 #	tag	Element name
638 proc sgml::ParseEvent:ElementClose {tag opts args} {
664 # sgml::Normalize --
666 #	Perform name normalization if required
669 #	name	name to normalize
675 proc sgml::Normalize {name req} {
677 	return [string toupper $name]
679 	return $name
683 # sgml::Entity --
691 #	entities	name of array containing entity definitions.
697 proc sgml::Entity {opts entityrefcmd pcdatacmd entities ref} {
711 	    if {[catch {format %c [scan [string range $ref 2 end] %x tmp; set tmp]} char]} {
714 	    uplevel #0 $pcdatacmd [list $char]
721 	    if {[catch {format %c [scan [string range $ref 1 end] %d tmp; set tmp]} char]} {
724 	    uplevel #0 $pcdatacmd [list $char]
788 # sgml::parseDTD --
801 proc sgml::parseDTD {dtd args} {
829 # sgml::DTD:ELEMENT --
834 #	indexed by the element name.  The content model is parsed into the
853 proc sgml::DTD:ELEMENT {id value} {
884 # sgml::CModelParse --
899 proc sgml::CModelParse {state value} {
911 # sgml::CModelMakeSyntaxTree --
936 proc sgml::CModelMakeSyntaxTree {state spec} {
939     variable name
948     regsub -all [format {(%s)[%s]*(\?|\*|\+)?[%s]*(,|\|)?} $name $Wsp $Wsp] $spec [format {%sCModelSTname %s {\1} {\2} {\3}} \n $state] spec
959 # sgml::CModelSTname --
961 #	Processes a name in a content model spec.
965 #	name	name specified
972 proc sgml::CModelSTname {state name rep cs args} {
977     CModelSTcp $state $name $rep $cs
980 # sgml::CModelSTcp --
986 #	name	name specified
993 proc sgml::CModelSTcp {state cp rep cs} {
1032 # sgml::CModelSTcsSet --
1043 proc sgml::CModelSTcsSet {state cs} {
1055 # sgml::CModelSTcpAdd --
1067 proc sgml::CModelSTcpAdd {state cp rep} {
1079 # sgml::CModelSTopenParen --
1089 proc sgml::CModelSTopenParen {state args} {
1100 # sgml::CModelSTcloseParen --
1112 proc sgml::CModelSTcloseParen {state rep cs args} {
1125 # sgml::CModelMakeTransitionTable --
1140 proc sgml::CModelMakeTransitionTable {state st} {
1151 	    set nullable [nullable leaf $rep $name]
1154 	    set var(pos:$var(number)) $name
1221 # sgml::followpos --
1233 #	followpos functions for each leaf node, in name/value format
1235 proc sgml::followpos {state st firstpos lastpos} {
1277 # sgml::TraverseDepth1st --
1291 proc sgml::TraverseDepth1st {state t leaf nonTerm} {
1317 	    set name [lindex [lindex $t 1] 0]
1325 # sgml::firstpos --
1337 proc sgml::firstpos {cs firstpos nullable} {
1359 # sgml::lastpos --
1372 proc sgml::lastpos {cs lastpos nullable} {
1394 # sgml::makeSet --
1404 proc sgml::makeSet s {
1413 # sgml::nullable --
1420 #	name		leaf node: symbol for this node, nonterm node: choice or seq node
1426 proc sgml::nullable {nodeType rep name {subtree {}}} {
1442 	    switch -- $name {
1463 namespace eval sgml {
1478 # sgml::DTD:ATTLIST --
1489 proc sgml::DTD:ATTLIST {id value} {
1511 # sgml::DTDAttribute --
1516 #	name	attribute name
1521 proc sgml::DTDAttribute {name type default {value {}}} {
1524     set al($name) [list $default $value]
1527 # sgml::DTD:ENTITY --
1538 proc sgml::DTD:ENTITY {id value} {
1556 	switch -glob [regexp $param_entity_exp $value x name scheme data],[string compare {} $scheme] {
1570 # sgml::DTD:NOTATION --
1572 proc sgml::DTD:NOTATION {id value} {
1584 # sgml::noop --
1594 proc sgml::noop args {
1598 # sgml::identity --
1608 proc sgml::identity a {
1612 # sgml::Error --
1622 proc sgml::Error args {
1628 # sgml::zapWhite --
1638 proc sgml::zapWhite data {
1643 proc sgml::Boolean value {
1649 proc sgml::dbgputs {where text} {