[Michael A. Cleverly] -- It seemed useful to be able to glue various Tk
widgets to a [tDOM] DOM tree.   Using [Snit's Not Incr Tcl] made it 
quite simple.  The widgets start with the current value from the 
DOM tree, and when they're edited, the DOM tree is updated.

----


 # tdg -- Tk DOM Glue 1.0
 # ======================
 #
 # Use snit to hook up Tk widgets to feed into a tDOM DOM tree.
 #
 # @author Michael A. Cleverly (michael@cleverly.com)
 # @creation-date: Saturday, 28 December 2002
 #
 
 package require Tk   8.3
 package require tdom 0.7.5
 package require snit 0.72
 
 namespace eval ::tdg {}
 
 ::snit::widget ::tdg::text {
     # Options the text widget doesn't have by default
     option -node ""
     option -attribute ""
 
 
     # Configure a new value for -node, populating the text widget if possible
     onconfigure -node node {
         set options(-node) $node
 
         if {[string length $node] != 0} {
             switch -- [$node nodeType] {
                 TEXT_NODE                   -
                 COMMENT_NODE                -
                 PROCESSING_INSTRUCTION_NODE {
                     [component hull] delete 1.0 end
                     [component hull] insert 1.0 [$node nodeValue]
                 }
 
                 ELEMENT_NODE {
                     if {[string length $options(-attribute)]} {
                         [component hull] delete 1.0 end
                         [component hull] insert 1.0 \
                             [$node getAttribute $options(-attribute) ""]
                     }
                 }
             }
         }
     }
 
 
     # Configure a new value for -attribute, populating the text widget 
     # if possible
     onconfigure -attribute attribute {
         set options(-attribute) $attribute
          
         if {[string length $options(-node)] && [string length $attribute]} {
             if {[$options(-node) nodeType] == "ELEMENT_NODE"} {
                 [component hull] delete 1.0 end
                 [component hull] insert 1.0 \
                     [$options(-node) getAttribute $attribute ""]
             }
         }
     }
 
 
     # Create the text widget
     constructor args {
         component hull is [::text $self] 
          
         # Apply any options passed at creation time.
         $self configurelist $args
     }
      
 
     # Helper proc to keep the DOM tree synchronized with the contents
     # of the text widget.
     proc synchronize {hull node attribute} {
         if {[string length $node] == 0} then return
 
         switch -- [$node nodeType] {
             TEXT_NODE                   -
             COMMENT_NODE                -
             PROCESSING_INSTRUCTION_NODE {
                 $node nodeValue [$hull get 1.0 end-1c]
             }
 
             ELEMENT_NODE {
                 if {[string length $attribute]} {
                     $node setAttribute $attribute [$hull get 1.0 end-1c]
                 }
             }
         }
     }
 
 
     # Override the insert method to keep the DOM tree in-synch with additions
     method insert args {
         eval [list [component hull]] insert $args
         synchronize [component hull] $options(-node) $options(-attribute)
     }
 
     # Override the delete method to keep the DOM tree in-synch with deletions
     method delete args {
         eval [list [component hull]] delete $args
         synchronize [component hull] $options(-node) $options(-attribute)
     }
 
 
     # Pass all other methods and options to the real text widget, so
     # that the remaining behavior is as expected.
     delegate method * to hull
     delegate option * to hull
 }
 
 
 ::snit::widget ::tdg::entry {
     # Options the entry widget doesn't have by default
     option -node ""
     option -attribute ""
 
 
     # Configure a new value for -node, populating the entry widget if possible
     onconfigure -node node {
         set options(-node) $node
 
         if {[string length $node] != 0} {
             switch -- [$node nodeType] {
                 TEXT_NODE                   -
                 COMMENT_NODE                -
                 PROCESSING_INSTRUCTION_NODE {
                     [component hull] delete 0 end
                     [component hull] insert 0 [$node nodeValue]
                 }
 
                 ELEMENT_NODE {
                     if {[string length $options(-attribute)]} {
                         [component hull] delete 0 end
                         [component hull] insert 0 \
                             [$node getAttribute $options(-attribute) ""]
                     }
                 }
             }
         }
     }
 
 
     # Configure a new value for -attribute, populating the entry widget 
     # if possible
     onconfigure -attribute attribute {
         set options(-attribute) $attribute
          
         if {[string length $options(-node)] && [string length $attribute]} {
             if {[$options(-node) nodeType] == "ELEMENT_NODE"} {
                 [component hull] delete 0 end
                 [component hull] insert 0 \
                     [$options(-node) getAttribute $attribute ""]
             }
         }
     }
 
 
     # Create the entry widget
     constructor args {
         component hull is [::entry $self] 
          
         # Apply any options passed at creation time.
         $self configurelist $args
     }
      
 
     # Helper proc to keep the DOM tree synchronized with the contents
     # of the entry widget.
     proc synchronize {hull node attribute} {
         if {[string length $node] == 0} then return
 
         switch -- [$node nodeType] {
             TEXT_NODE                   -
             COMMENT_NODE                -
             PROCESSING_INSTRUCTION_NODE {
                 $node nodeValue [$hull get]
             }
 
             ELEMENT_NODE {
                 if {[string length $attribute]} {
                     $node setAttribute $attribute [$hull get] 
                 }
             }
         }
     }
 
 
     # Override the insert method to keep the DOM tree in-synch with additions
     method insert args {
         eval [list [component hull]] insert $args
         synchronize [component hull] $options(-node) $options(-attribute)
     }
 
     # Override the delete method to keep the DOM tree in-synch with deletions
     method delete args {
         eval [list [component hull]] delete $args
         synchronize [component hull] $options(-node) $options(-attribute)
     }
 
 
     # Pass all other methods and options to the real entry widget, so
     # that the remaining behavior is as expected.
     delegate method * to hull
     delegate option * to hull
 }
 
 
 ::snit::widget ::tdg::radiobutton {
     # Options the radiobutton widget doesn't have by default
     option -node ""
     option -attribute ""
 
     # And one that it does that we need to have our own onconfigure for
     option -value "" 
 
 
     # Configure a new value for -node, setting the radiobutton's -variable
     # if possible/applicable.
     onconfigure -node node {
         set options(-node) $node
         set buttonValue [[component hull] cget -value]
         upvar #0 [[component hull] cget -variable] variable
 
         if {[string length $node] != 0} {
             switch -- [$node nodeType] {
                 TEXT_NODE                   -
                 COMMENT_NODE                -
                 PROCESSING_INSTRUCTION_NODE {
                     if {[string equal [$node nodeValue] $buttonValue]} {
                         set variable $buttonValue
                     }
                 }
 
                 ELEMENT_NODE {
                     set attrValue [$node getAttribute $options(-attribute) ""]
                     if {[string equal $attrValue $buttonValue]} {
                         set variable $buttonValue
                     }
                 }
             }
         }
     }
 
     # Configure a new value for -attribute, populating the radiobutton widget 
     # if possible/applicable.
     onconfigure -attribute attribute {
         set options(-attribute) $attribute
          
         if {[string length $options(-node)] && [string length $attribute]} {
             if {[$options(-node) nodeType] == "ELEMENT_NODE"} {
                 set buttonValue [[component hull] cget -value]
                 set attrValue [$options(-node) getAttribute $attribute ""]
                 upvar #0 [[component hull] cget -variable] variable
 
                 if {[string equal $attrValue $buttonValue]} {
                     set variable $buttonValue
                 }
             }
         }
     }
 
 
     # Helper procedure to maybe select the radiobutton if 
     # the DOM value equals the button value.
     proc maybe {self action node attribute} {
         if {[string length $node] == 0} then return
 
         switch -- [$node nodeType] {
             TEXT_NODE                   -
             COMMENT_NODE                -
             PROCESSING_INSTRUCTION_NODE {
                 set domValue [$node nodeValue]
             }
 
             ELEMENT_NODE {
                 if {[string length $attribute] == 0} then return
               
                 set domValue [$node getAttribute $attribute ""]
             }
 
             default {
                 return
             }
         }
 
         set buttonValue [$self cget -value]
         if {[string equal $buttonValue $domValue]} {
             $self $action
         } 
     }
 
 
     # If the value changes, and it matches what's in the DOM tree, then
     # we want this radio button to be the selected one.
     onconfigure -value value {
         set options(-value) $value
         [component hull] configure -value $value
         maybe $self select $options(-node) $options(-attribute)
     }
 
 
     # Create the entry widget
     constructor args {
         component hull is [::radiobutton $self] 
 
         # We need this set before -node (& possibly -attribute)
         set options(-value) [from args -value]
         $self configure -value $options(-value)
          
         # Apply any options passed at creation time.
         $self configurelist $args
         maybe $self select $options(-node) $options(-attribute)
     }
      
 
     # Helper proc to keep the DOM tree synchronized with the selected
     # radiobutton.
     proc synchronize {node attribute value} {
         if {[string length $node] == 0} then return
 
         switch -- [$node nodeType] {
             TEXT_NODE                   -
             COMMENT_NODE                -
             PROCESSING_INSTRUCTION_NODE {
                 $node nodeValue $value
             }
 
             ELEMENT_NODE {
                 if {[string length $attribute]} {
                     $node setAttribute $attribute $value
                 }
             }
         }
     }
 
 
     # Override the insert method to keep the DOM tree in-synch with additions
     method select args {
         eval [list [component hull]] select $args
         synchronize $options(-node) $options(-attribute) \
             [[component hull] cget -value]
     }
 
     method invoke args {
         eval [list [component hull]] invoke $args
         synchronize $options(-node) $options(-attribute) \
             [[component hull] cget -value]
     }
 
     method deselet args {
         eval [list [component hull]] deselect $args
         synchronize $options(-node) $options(-attribute) ""
     }
 
     # Pass all other methods and options to the real entry widget, so
     # that the remaining behavior is as expected.
     delegate method * to hull
     delegate option * to hull
 }
 
 
 package provide tdg 1.0