This procedure is defined in the server but not documented via ad_proc or proc_doc and may be intended as a private interface.
The procedure is defined as:
proc dom::node {method token args} {
variable nodeOptionsRO
variable nodeOptionsRW
GetHandle node $token node
set result {}
switch -glob -- $method {
cg* {
# cget
# Some read-only configuration options are computed
if {[llength $args] != 1} {
return -code error "too many arguments"
}
if {[regexp [format {^-(%s)$} $nodeOptionsRO] [lindex $args 0] discard option]} {
switch -- $option {
childNodes {
# How are we going to handle documentElement?
set result $node(node:childNodes)
}
firstChild {
upvar #0 $node(node:childNodes) children
switch -- $node(node:nodeType) {
documentFragment {
set result [lindex $children 0]
catch {set result $node(document:documentElement)}
}
default {
set result [lindex $children 0]
}
}
}
lastChild {
upvar #0 $node(node:childNodes) children
switch -- $node(node:nodeType) {
documentFragment {
set result [lindex $children end]
catch {set result $node(document:documentElement)}
}
default {
set result [lindex $children end]
}
}
}
previousSibling {
# BUG: must take documentElement into account
# Find the parent node
GetHandle node $node(node:parentNode) parent
upvar #0 $parent(node:childNodes) children
set idx [lsearch $children $token]
if {$idx >= 0} {
set sib [lindex $children [incr idx -1]]
if {[llength $sib]} {
set result $sib
} else {
set result {}
}
} else {
set result {}
}
}
nextSibling {
# BUG: must take documentElement into account
# Find the parent node
GetHandle node $node(node:parentNode) parent
upvar #0 $parent(node:childNodes) children
set idx [lsearch $children $token]
if {$idx >= 0} {
set sib [lindex $children [incr idx]]
if {[llength $sib]} {
set result $sib
} else {
set result {}
}
} else {
set result {}
}
}
attributes {
if {$node(node:nodeType) ne "element" } {
set result {}
} else {
set result $node(element:attributeList)
}
}
default {
return [GetField node(node:$option)]
}
}
} elseif {[regexp [format {^-(%s)$} $nodeOptionsRW] [lindex $args 0] discard option]} {
return [GetField node(node:$option)]
} else {
return -code error "unknown option \"[lindex $args 0]\""
}
}
co* {
# configure
if {[llength $args] == 1} {
return [document cget $token [lindex $args 0]]
} elseif {[llength $args] % 2} {
return -code error "no value specified for option \"[lindex $args end]\""
} else {
foreach {option value} $args {
if {[regexp [format {^-(%s)$} $nodeOptionsRW] $option discard opt]} {
set node(node:$opt) $value
} elseif {[regexp [format {^-(%s)$} $nodeOptionsRO] $option discard opt]} {
return -code error "attribute \"$option\" is read-only"
} else {
return -code error "unknown option \"$option\""
}
}
}
}
in* {
# insertBefore
# Previous and next sibling relationships are OK,
# because they are dynamically determined
if {[llength $args] < 1 || [llength $args] > 2} {
return -code error "wrong number of arguments"
}
GetHandle node [lindex $args 0] newChild
if {$newChild(docArray) ne $node(docArray) } {
return -code error "new node must be in the same document"
}
switch [llength $args] {
1 {
# Append as the last node
if {[string length $newChild(node:parentNode)]} {
node removeChild $newChild(node:parentNode) [lindex $args 0]
}
lappend $node(node:childNodes) [lindex $args 0]
set newChild(node:parentNode) $token
}
2 {
GetHandle node [lindex $args 1] refChild
if {$refChild(docArray) ne $newChild(docArray) } {
return -code error "nodes must be in the same document"
}
set idx [lsearch [set $node(node:childNodes)] [lindex $args 1]]
if {$idx < 0} {
return -code error "no such reference child"
} else {
# Remove from previous parent
if {[string length $newChild(node:parentNode)]} {
node removeChild $newChild(node:parentNode) [lindex $args 0]
}
# Insert into new node
set $node(node:childNodes) [linsert [set $node(node:childNodes)] $idx [lindex $args 0]]
set newChild(node:parentNode) $token
}
}
}
PutHandle [lindex $args 0] newChild
}
rep* {
# replaceChild
if {[llength $args] != 2} {
return -code error "wrong number of arguments"
}
GetHandle node [lindex $args 0] newChild
GetHandle node [lindex $args 1] oldChild
# Find where to insert new child
set idx [lsearch [set $node(node:childNodes)] [lindex $args 1]]
if {$idx < 0} {
return -code error "no such old child"
}
# Remove new child from current parent
if {[string length $newChild(node:parentNode)]} {
node removeChild $newChild(node:parentNode) [lindex $args 0]
}
#set $node(node:childNodes) #[lreplace [set $node(node:childNodes)] $idx $idx [lindex $args 0]]
lset $node(node:childNodes) $idx [lindex $args 0]
set newChild(node:parentNode) $token
# Update old child to reflect lack of parentage
set oldChild(node:parentNode) {}
PutHandle [lindex $args 1] oldChild
PutHandle [lindex $args 0] newChild
set result [lindex $args 0]
}
rem* {
# removeChild
if {[llength $args] != 1} {
return -code error "wrong number of arguments"
}
array set oldChild [set [lindex $args 0]]
if {$oldChild(docArray) != $node(docArray)} {
return -code error "node \"[lindex $args 0]\" is not a child"
}
# Remove the child from the parent
upvar #0 $node(node:childNodes) myChildren
if {[set idx [lsearch $myChildren [lindex $args 0]]] < 0} {
return -code error "node \"[lindex $args 0]\" is not a child"
}
set myChildren [lreplace $myChildren $idx $idx]
# Update the child to reflect lack of parentage
set oldChild(node:parentNode) {}
set [lindex $args 0] [array get oldChild]
set result [lindex $args 0]
}
ap* {
# appendChild
if {[llength $args] != 1} {
return -code error "wrong number of arguments"
}
# Add to new parent
node insertBefore $token [lindex $args 0]
}
hasChildNodes {
set result [Min 1 [llength [set $node(node:childNodes)]]]
}
cl* {
# cloneNode
set deep 0
switch [llength $args] {
0 {
}
1 {
set deep [Boolean [lindex $args 0]]
}
default {
return -code error "too many arguments"
}
}
switch -- $node(node:nodeType) {
element {
set result [CreateElement {} $node(node:nodeName) [array get $node(element:attributeList)] -docarray $node(docArray)]
if {$deep} {
foreach child [set $node(node:childNodes)] {
node appendChild $result [node cloneNode $child]
}
}
}
textNode {
set result [CreateTextNode {} $node(node:nodeValue) -docarray $node(docArray)]
}
document -
documentFragment -
default {
set result [CreateGeneric {} node:nodeType $node(node:nodeType) -docarray $node(docArray)]
if {$deep} {
foreach child [set $node(node:childNodes)] {
node appendChild $result [node cloneNode $child]
}
}
}
}
}
ch* {
# children -- non-standard method
# If this is a textNode, then catch the error
set result {}
catch {set result [set $node(node:childNodes)]}
}
pa* {
# parent -- non-standard method
return $node(node:parentNode)
}
default {
return -code error "unknown method \"$method\""
}
}
PutHandle $token node
return $result
}
