| top | |
voav method xmlspace #node.new: {args} {
if {[llength $args]%2==1} {
error "odd number of initial properties"
}
set doc [oav get [oav] /command/]
$doc update @(unique) unique 0 {incr unique}
set var @$unique
$doc delegate $var [$doc $self.%name]
set idrc [catch {$doc $self.@(id)} idat]
foreach {p v} $args {
$doc put $var.$p $v
if {!$idrc && [string equal $p $idat]} {
$doc delegate -r #id.$v $var
}
}
$doc put $var.%n 0
$doc put $var.@(self) $var
return $var
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.clone: {} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
set argv {}
foreach {p v} [assoc filter [oav] $self.*] {
set p [lindex [split $p .] end]
if {[string match {[#@!<0-9]*} $p]} continue
lappend argv $p $v
}
eval [list $doc [$doc $self.%name].new:] $argv
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.node: {args} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
switch [llength $args] {
0 {return $self}
1 {return [$doc $self.[lindex $args 0]]}
2 {
setp {p v} $args
$doc put $self.$p $v
set idrc [catch {$doc $self.@(id)} idat]
if {!$idrc && [string equal $p $idat]} {
$doc delegate -r #id.$v $self
}
return $v
}
default {error {wrong number of arguments: $node.node: [property [value]]}}
}
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.delete: {} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
$doc $self.orphan:
set idrc [catch {$doc $self.@(id)} idat]
foreach {p v} [assoc filter [oav] $self.*] {
if {[string is integer -strict [lindex [split $p .] end]]} {
$doc $p.orphan:
}
if {!$idrc && [string equal $p $idat]} {
$doc delete #id.$v
}
$doc delete $p
}
$doc delete $self
return ""
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.parent: {} {
set doc [oav get [oav] /command/]
$doc $self.@(parent)
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.children: {} {
set doc [oav get [oav] /command/]
set list {}
set n [$doc $self.%n]
for {set i 0} {$i<$n} {incr i} {lappend list [$doc $self.$i.@(self)]}
return $list
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.children:: {list} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
set n [$doc $self.%n]
for {set i 0} {$i<$n} {incr i} {
$doc delete [$doc $self.$i.@(self)].@(parent)
$doc delete $self.$i
}
foreach p [$doc names {$self.[!#<]*}] {$doc delete $p}
$doc put $self.%n 0
eval [list $doc $self.adopt:] $list
return $self
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.children::: {listop args} {
set doc [oav get [oav] /command/]
$doc $self.children:: [eval [list $listop [$doc $self.children:]] $args]
return $self
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.orphan: {} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
set i [$doc $self.pos:]
if {$i>=0} {
set parent [$doc $self.@(parent)]
$doc $parent.children::: lreplace $i $i
}
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.adopt: {args} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
foreach child $args {
set child [$doc $child.@(self)]
$doc update $self.%n n {set i $n; incr n}
$doc delegate -r $self.$i $child
$doc delegate -r $self.[$doc $child.%name] $child
$doc put $child.@(parent) $self
}
$doc $self.%n
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.pos: {} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
if {[catch {$doc $self.@(parent)} parent]} {
return -1
}
set n [$doc $parent.%n]
for {set i 0} {$i<$n} {incr i} {
if {[string equal [$doc $parent.$i.@(self)] $self]} {return $i}
}
return -1
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.before: {args} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
set i [$doc $self.pos:]
if {$i<0} {error "not a child of any node"}
set parent [$doc $self.@(parent)]
if {[llength $args]>0} {
eval [list $doc $parent.children::: linsert $i] $args
} elseif {$i==0} {
error "first node"
} else {
return [$doc $parent.[expr {$i-1}].@(self)]
}
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.after: {args} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
set i [$doc $self.pos:]
if {$i<0} {error "not a child of any node"}
incr i
set parent [$doc $self.@(parent)]
if {[llength $args]>0} {
eval [list $doc $parent.children::: linsert $i] $args
} elseif {$i>=[$doc $parent.%n]} {
error "last node"
} else {
return [$doc $parent.$i.@(self)]
}
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.import: {parses} {
set doc [oav get [oav] /command/]
if {[string equal $self #node]} {
set self [$doc #document.new:]
} else {
set self [$doc $self.@(self)]
}
set doctype ""
set ps [list $self]
set xd 0
foreach parse $parses {
switch [assoc get $parse %what] {
attlist {
set parent [lindex $ps end]
set node [$doc !attlist.new:]
set tag <[assoc get $parse %element]>
set attr [assoc get $parse %attname]
set id [string equal [assoc get $parse %type] ID]
assoc get [oav] -exact est $tag
if {!$est} {
$doc delegate $tag #element
$doc put $tag.%name $tag
$doc method $tag.new: #node.new:
}
if {$id} {
$doc $tag.@(id) $attr
}
foreach {p v} $parse {
switch $p {
%element - %attname - %type - %assigned - %default -
%required - %display - %line - %col {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
}
element {
set parent [lindex $ps end]
set node [$doc !element.new:]
set tag <[assoc get $parse %name]>
assoc get [oav] -exact est $tag
if {!$est} {
$doc delegate $tag #element
$doc put $tag.%name $tag
$doc method $tag.new: #node.new:
}
foreach {p v} $parse {
switch $p {
%name {
$doc put $node.%element $v
}
%model - %display - %fsm - %line - %col {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
}
entityInternal - entityExternalUnparsed - entityExternalParsed {
set parent [lindex $ps end]
set node [$doc !entity.new:]
foreach {p v} $parse {
switch $p {
%what {$doc put $node.%kind $v}
%name {$doc put $node.%entity $v}
%value {$doc put $node.%data $v}
%system - %public - %notation - %base - %line - %col {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
}
parameterEntityInternal - parameterEntityExternal {
set parent [lindex $ps end]
set node [$doc !entity-parameter.new:]
foreach {p v} $parse {
switch $p {
%what {$doc put $node.%kind $v}
%name {$doc put $node.%entity $v}
%value {$doc put $node.%data $v}
%system - %public - %notation - %base - %line - %col {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
}
notation {
set parent [lindex $ps end]
set node [$doc !notation.new:]
foreach {p v} $parse {
switch $p {
%notation - %system - %public - %notation - %base - %line - %col {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
}
comment {
set parent [lindex $ps end]
set node [$doc #comment.new:]
foreach {p v} $parse {
switch $p {
%data - %line - %col {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
}
init {
if {![string length $doctype]} {
set doctype [$doc #doctype.new:]
}
foreach {p v} $parse {
switch $p {
%encoding {$doc put $doctype.%input $v}
%version {$doc put $doctype.%expat $v}
}
}
}
xml {
if {![string length $doctype]} {
set doctype [$doc #doctype.new:]
}
foreach {p v} $parse {
switch $p {
%encoding - %version - %line - %col - %standalone {
$doc put $doctype.$p $v
}
}
}
}
doctype-begin {
if {![string length $doctype]} {
set doctype [$doc #doctype.new:]
}
foreach {p v} $parse {
switch $p {
%name {$doc put $doctype.%doctype $v}
%system - %public - %internal - %line - %col {
$doc put $doctype.$p $v
}
}
}
lappend ps $doctype
}
doctype-end {
if {[llength $ps]>1} {
set ps [lrange $ps 0 end-1]
}
}
start {
set parent [lindex $ps end]
set node [$doc #element.new: [string map {. %2E} [assoc get $parse %name]]]
set defaulted {}
set attributes {}
set id ""
foreach {p v} $parse {
switch -glob $p {
%line - %col - %base {
$doc put $node.$p $v
}
%id {set id $v}
%defaulted {set defaulted $v}
%xmlns.* {
set pre [lindex [split $p .] end]:
set uri ~[string map {. %2E} $v]
$doc $node.namespace: $pre $uri
}
%* {;}
default {lappend attributes [string map {. %2E} $p] $v}
}
}
if {[string length $id]} {
vassoc get attributes -exact est $id id
if {$est} {$doc delegate -r #id.$id $node}
}
foreach a $defaulted {vassoc delete attributes $a}
foreach {p v} $attributes {
if {[string match *: $p]} {
set p [$doc $node.namespace: $p]
}
$doc put $node.$p $v
}
$doc $parent.adopt: $node
lappend ps $node
}
end {
if {[llength $ps]>1} {
set ps [lrange $ps 0 end-1]
}
}
pi {
set parent [lindex $ps end]
set node [$doc #pi.new:]
foreach {p v} $parse {
switch $p {
%data - %line - %col - %target {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
}
content {
set parent [lindex $ps end]
if {[string equal [$doc $parent.%name] #cdata]} {
$doc update $parent.%data s {
append s [assoc data $parse %data]
}
} else {
set node [$doc #text.new: %data ""]
foreach {p v} $parse {
switch $p {
%data - %line - %col - %entity {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
}
}
cdata-begin {
set parent [lindex $ps end]
set node [$doc #cdata.new: %data ""]
foreach {p v} $parse {
switch $p {
%line - %col {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
lappend ps $node
}
cdata-end {
if {[llength $ps]>1} {
set ps [lrange $ps 0 end-1]
}
}
entity-parser-begin {
set parent [lindex $ps end]
set node [$doc #external.new:]
foreach {p v} $parse {
switch $p {
%line - %col - %system - %public - %encoding - %base - %entity {
$doc put $node.$p $v
}
}
}
$doc $parent.adopt: $node
lappend ps $node
}
entity-parser-end {
if {[llength $ps]>1} {
set ps [lrange $ps 0 end-1]
}
}
}
}
if {[string length $doctype]} {
$doc $self.children::: linsert 0 $doctype
}
return $self
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.expat: {args} {
set doc [oav get [oav] /command/]
set begin create
set end end
while 1 {
switch -- [lindex $args 0] {
-tidy {set begin tidy; set args [lrange $args 1 end]}
-validate {set end validate; set args [lrange $args 1 end]}
-- {set args [lrange $args 1 end]; break}
default break
}
}
set args [setp uri $args]
set channel [uri open $uri]
switch $begin {
create {
set token [eval wyrm::expat::create $args]
}
tidy {
set token [eval wyrm::expat::tidy $channel $args]
set channel $token
}
}
wyrm::expat::resume $token [read $channel]
if {![wyrm::expat::syntax $token]} {set end end}
set root [$doc #node.import: [wyrm::expat::$end $token]]
catch {close $channel}
return $root
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.root: {} {
set doc [oav get [oav] /command/]
set p $self
while {[$doc $p.pos:]>=0} {set p [$doc $p.@(parent)]}
$doc $p.@(self)
}
voav method xmlspace #node.generateChildren: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set code ""
foreach child [$doc $self.children:] {
append code [$doc $child.generate: $entitymap]
}
return $code
}
voav method xmlspace #node.generate: {{entitymap {< < > > & & "\"" " ' '}}} abstract
voav method xmlspace !attlist.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
return " <!ATTLIST [$doc $self.%element] [doc $self.%attname] [doc $self.%display]>\n"
}
voav method xmlspace !element.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
return " <!ELEMENT [$doc $self.%element] [doc $self.%display]>\n"
}
voav method xmlspace #node.quoth: {string} {
if {[string first ' $string]<0} {
return "'$string'"
} else {
return "\"$string\""
}
}
voav method xmlspace !entity.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set entity [$doc $self.%entity]
set data [$doc $self.%data]
set public [$doc $self.%public]
set system [$doc $self.%system]
set notation [$doc $self.%notation]
set parameter [$doc $self.%parameter]
set code " <!ENTITY"
if {$parameter} {append code " %"}
append code " $entity"
if {[string length $public]} {
append code " PUBLIC [$doc #node.quoth: $public] [$doc #node.quoth: $system]"
} elseif {[string length $system]} {
append code " SYSTEM [$doc #node.quoth: $system]"
} else {
if {!$parameter} {
set root [$doc $self.root:]
set rootEntityMap [$doc $root.%entityMap]
lappend rootEntityMap "&$entity;" $data
$doc put $root.%entityMap $rootEntityMap
}
append code " '[string map $entitymap $data]'"
}
if {[string length $notation]} {
append code " NDATA [$doc #node.quoth: $notation]"
}
return $code>\n
}
voav method xmlspace !notation.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set notation [$doc $self.%notation]
set public [$doc $self.%public]
set system [$doc $self.%system]
set code " <!NOTATION $notation"
append code " $notation"
if {[string length $public]} {
append code " PUBLIC [$doc #node.quoth: $public]"
if {[string length $system]} {append code " [$doc #node.quoth: $system]"}
} else {
append code " SYSTEM [$doc #node.quoth: $system]"
}
return $code>\n
}
voav method xmlspace #comment.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
return <!--[string map {-- -} [$doc $self.%data]]-->
}
voav method xmlspace #doctype.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set doctype [$doc $self.%doctype]
set public [$doc $self.%public]
set system [$doc $self.%system]
set version [$doc $self.%version]
set encoding [$doc $self.%encoding]
set standalone [$doc $self.%standalone]
set code ""
if {[string length $version]} {
append code "<?xml version=[$doc #node.quoth: $version]"
if {[string length $encoding]} {
append code " encoding=[$doc #node.quoth: $encoding]"
}
if {$standalone} {
append code " standalone='yes'?>\n"
} else {
append code " standalone='no'?>\n"
}
}
if {[string length $doctype]} {
append code "<!DOCTYPE $doctype"
if {[string length $public]} {
append code " PUBLIC [$doc #node.quoth: $public] [$doc #node.quoth: $system]"
} elseif {[string length $system]} {
append code " SYSTEM [$doc #node.quoth: $system]"
}
if {[$doc $self.%n]} {
append code "\[\n[$doc $self.generateChildren: $entitymap]\]"
}
append code >\n
}
return $code
}
voav method xmlspace #document.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
$doc put $self.%entityMap {}
$doc $self.generateChildren:
}
voav method xmlspace #element.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set self [$doc $self.@(self)]
foreach name [concat [$doc $self.%name] [$doc names $self.\[-+_:a-zA-Z\]*]] {
set name [lindex [split $name .] end]
if {[string first ~ $name]>=0} {
set name [$doc $self.namespace: $name]
}
if {[regexp {^<?([^~]*)(~[^>]*)>?$} $name - tag uri]} {
for {set i [$doc @(unique)]} {1} {incr i} {
set ns qj$i:
if {![string match ~* [$doc $self.namespace: $ns]]} break
}
$doc $self.namespace: $ns $uri
}
}
set code [$doc $self.%name]
if {[string first ~ $code]>=0} {set code [$doc $self.namespace: $code]}
set code [string range $code 0 end-1]
set tag [string range $code 1 end]
foreach {p v} [$doc $self.%namespace] {
set v [string map {%2E .} $v]
if {[string length $p]>1} {
append code " xmlns:[string range $p 0 end-1]='[string map $entitymap [string range $v 1 end]]'"
} else {
append code " xmlns='[string map $entitymap [string range $v 1 end]]'"
}
}
foreach {p v} [$doc filter $self.\[-+_:a-zA-Z\]*] {
set p [lindex [split $p .] end]
if {[string first ~ $p]>=0} {set p [$doc $self.namespace: $p]}
append code " $p='[string map $entitymap $v]'"
}
set children [$doc $self.generateChildren: $entitymap]
if {[string length $children]} {
return $code>$children</$tag>
} else {
return "$code />"
}
}
voav method xmlspace #external.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
$doc $self.%entity
}
voav method xmlspace #pi.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set data [doc $self.%data]
if {[string length $data]} {set data " $data"}
return "<?[doc $self.%target]$data?>"
}
voav method xmlspace #text.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set data [$doc $self.%data]
set entity [$doc $self.%entity]
if {[string length $entity]} {
assoc get [$doc [$doc $self.root:].%entityMap] -exact est $entity entitydefinition
if {$est && [string equal $data $entitydefinition]} {
return $entity
}
}
foreach ch [split [string map $entitymap $data] {}] {
set code [scan $ch %c]
if {$code==9 || $code==10 || 32<=$code && $code<127} {
append string $ch
} else {
append string "&#$code;"
}
}
return $string
}
voav method xmlspace #cdata.generate: {{entitymap {< < > > & & "\"" " ' '}}} {
set doc [oav get [oav] /command/]
set left [format <!%cCDATA%c 91 91]
set right [format %c%c> 93 93]
set escape [format %c%c%c%c><!%cCDATA%c> 93 93 93 93 91 91]
return $left[string map [list $right $escape] [$doc $self.%data]]$right
}
| ^ |
| |
| |
| section top | |
voav method xmlspace #node.dump: title {
set dump ""; set first ""
set space [oav]
set doc [oav get $space /command/]
if {[string equal $self #node]} {
foreach name [assoc names $space -re {^@\d+$}] {
set N($name) 1
}
foreach {name child} [assoc filter $space -re {^@\d+[.]\d+$}] {
set N($child) 0
}
set starts {}
foreach name [lsort -dictionary [array names N]] {
if {$N($name)} {lappend starts $name}
}
} else {
set starts [list [$doc $self.@(self)]]
}
#foreach p [lsort -dictionary [assoc names $space]] {puts "$p: [assoc get $space $p]"}
foreach start $starts {
append dump "$first$title"; set first \n
set ps [list $start -1]
while {[llength $ps]} {
set d [string repeat . [expr {[llength $ps]-2}]]
set x [lindex $ps end-1]
set i [lindex $ps end]
if {$i==-1} {
lset ps end 0
append dump ": $x [$doc $x.%name]"
foreach property [lsort -dictionary [assoc names $space -re "^$x\[.\]\[^.0-9\]+$"]] {
set value [assoc get [oav] $property]
set property [lindex [split $property .] end]
if {[string equal $property %name]} continue
if {[string equal $property %n]} continue
if {[string equal $property @(self)]} continue
if {[string equal $property @(parent)]} continue
append dump "\n$d....$property: $value"
}
} elseif {$i<[assoc get $space $x.%n]} {
append dump "\n${d}..child $i"
lappend ps [$doc $x.$i.@(self)] -1
incr i
lset ps end-2 $i
} else {
set ps [lrange $ps 0 end-2]
}
}
}
return $dump
}
| ^ |
| |
