home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / xuibuilder / ddom.tcl next >
Encoding:
Text File  |  2000-11-02  |  4.7 KB  |  183 lines
  1. # ddom.tcl 
  2. #
  3. # Different helper methods to make TclDOM API more user friendly
  4.  
  5.  
  6. # dom::getText --
  7. #   Returns the node contents if a text node or the contents of all the text
  8. # children if it is an element. 
  9. #
  10. # Example: getText on <foo>bar</foo> would return "bar"
  11.  
  12. proc ::dom::getText { token } {
  13.     switch [dom::node cget $token -nodeType]  {
  14.     element {
  15.         set result {}
  16.         foreach child [dom::children $token] {
  17.              append result [dom::node cget $child -nodeValue]
  18.         }
  19.         return  $result
  20.     } 
  21.     textNode {
  22.         return [dom::node cget $token -nodeValue]
  23.     } default {
  24.     }
  25.     }
  26. }
  27.  
  28.  
  29. # dom::getElements --
  30. #   Returns a list with all children of type element of a given node
  31.  
  32. proc ::dom::getElements { token } {
  33.     set result {}
  34.     foreach child [dom::children $token] {
  35.     if ![string compare [dom::node cget $child -nodeType] element] {
  36.         lappend result $child
  37.     }
  38.     }
  39.     return $result
  40. }
  41.  
  42.  
  43. # dom::getTagName --
  44. #   Helper function for getting the tag for a node of type element
  45.  
  46. proc ::dom::getTagName {token} {
  47.     switch [dom::node cget $token -nodeType] {
  48.     element {
  49.         return [dom::element cget $token -tagName ]
  50.     } default {
  51.         return /textnode
  52.     }
  53.     }
  54. }
  55.  
  56.  
  57. # dom::rp --
  58. #   Resolve path. Given a node and a path, return the node the path points to
  59. # Path are constructed:
  60. #   tagName<attr1="some value">/tagname2<5>  etc.
  61. #
  62. # Examples:
  63. #   Given the following document
  64. #
  65. #  <puppets>
  66. #    <puppet name="kermit"><color>green</color></puppet>
  67. #    <puppet name="cookie monster"><color>blue</color></puppet>
  68. #  </puppets>
  69. #
  70. # dom::rp $initialToken puppets/puppet<0>   
  71. # will return the first <puppet> element (kermit)
  72. # 
  73. # dom::rp $initialToken puppets/puppet<name="kermit">
  74. # will return the <puppet> element that has attribute name="kermit"(kermit)
  75. #
  76. # dom::rp $initialToken puppets/puppet<0>/color  
  77. # will return the text node that contains the "green" text
  78. #
  79. # TO-DO: more robust error checking
  80.  
  81. proc ::dom::rp {token path} {
  82.     set currentNode $token
  83.     regsub -all {(//*([^/<]+(<[^>]*>)?))} $path { \2} spath
  84.     foreach pathComponent $spath {
  85.     set result {}
  86.     set children [getElementsByTagName $currentNode \
  87.         [getTagFromPath $pathComponent]] 
  88.     set attrs [getAttrsFromPath $pathComponent]
  89.     if  {[lindex $attrs 0] == "</idx>"} {
  90.         set result [lindex $children [lindex $attrs 1]]
  91.     } else {
  92.         foreach ch $children {
  93.         if {[matchesAttrs $ch $attrs]} {
  94.             lappend result  $ch
  95.         }
  96.         }
  97.     }
  98.     switch [llength $result]  {
  99.         0 {
  100.         error "No such element $pathComponent while resolving $path"
  101.         } 1 { 
  102.             set currentNode $result
  103.         } 2 {
  104.         error "Too many elements match $pathComponent in $path"
  105.         }
  106.     }
  107.     }
  108.     return $currentNode
  109. }
  110.  
  111. # dom::matchesAttrs --
  112. #   Check that a certain node has ALL specified attributes
  113.  
  114. proc ::dom::matchesAttrs {node attrs} {
  115.     array set attr $attrs
  116.     foreach attribute [array names attr] {
  117.     if {$attr($attribute) != [getAttribute $node $attribute]} {
  118.         return 0
  119.     }
  120.     }
  121.     return 1
  122. }
  123.  
  124.  
  125. # dom::getTagFromPath --
  126. #  Given a path, return the tagname
  127. #
  128. # Example
  129. #   getAttrsFromPath foo<a="5",b="6">
  130. # returns 
  131. #   "foo"
  132.  
  133. proc ::dom::getTagFromPath {path} {
  134.     regexp {([^<]+)} $path tag
  135.     return $tag
  136. }
  137.  
  138. # dom::getAttrsFromPath --
  139. #  Given a path, return a list of attribute/value pairs
  140. #
  141. # Example
  142. #   getAttrsFromPath foo<a="5",b="6">
  143. # returns
  144. #   {a 5 b 6}
  145. #
  146. # TO-DO : Does we handle correctly attribute values with spaces?
  147.  
  148. proc ::dom::getAttrsFromPath {path} {
  149.     set attrs {}
  150.     regexp {([^<]+)<([^>]*)>} $path whole tag attrs
  151.     if [regexp {^[0-9]+$} $attrs idx ] {
  152.     return [list </idx> $idx]
  153.     }
  154.     regsub -all {([^=]+)(=("[^"]*"))?,?} $attrs {\1 \3 } list 
  155.     return $list 
  156. }
  157.  
  158. # Rename procedures so they are easier to type and we do not have to 
  159. # remember in which interface (node, element, document the node is defined)
  160.  
  161. foreach procedure { insertBefore  replaceChild  \
  162.     removeChild appendChild hasChildNodes \
  163.     clodeNode  children  parent 
  164. } {
  165.     proc dom::$procedure args "eval ::dom::node $procedure \$args"
  166. }
  167.  
  168. foreach procedure { getElementsByTagName createElement createDocumentFragment \
  169.     createTextNode createComment createCDATASection \
  170.     createProcessingInstruction createAttribute createEntity  \
  171.     createEntityReference  createDocTypeDecl cget configure} {
  172.     proc dom::$procedure args "eval ::dom::document $procedure \$args"
  173. }
  174.  
  175. foreach procedure { getAttribute setAttribute removeAttribute\
  176.     getAttributeNode setAttributeNode removeAttributeNode \
  177.         getElementsByTagName normalize 
  178. } {
  179.     proc dom::$procedure args "eval ::dom::element $procedure \$args"
  180. }
  181.  
  182.  
  183.