#-------------------------------------------------------------------------------
 # -*- tcl -*- $Id: 6104,v 1.5 2004-02-27 07:00:37 jcw Exp $
 # tdg -- Tk DOM Glue 1.1
 #
 # PURPOSE:
 #
 #     Tk widgets glued to a DOM tree with a bit of snit glue.
 #     See: https://wiki.tcl-lang.org/6104
 #
 # AUTHOR:
 #
 #     Michael A. Cleverly ([email protected])
 #
 # HISTORY:
 #
 #     Version 1.0: Saturday, 28 December 2002
 #         * Initial release 
 #
 #     Version 1.1: Wednesday, 7 May 2003
 #         * Upgraded to snit 0.8 and Tk 8.4 (code simplified in the process)
 #         * Added spinbox
 #         * Added virtual event <<tdw::ValueChanged>>
 #
 #-------------------------------------------------------------------------------
 
 namespace eval ::tdg {
     package require Tcl 8.4
     package require Tk  8.4
     package require tdom 0.7.7
     package require snit 0.81
 }
 
 
 #-------------------------------------------------------------------------------
 # SPINBOX
 #
 ::snit::widgetadaptor ::tdg::spinbox {
     option -node ""
     option -attribute ""
     option -valuesvariable ""
     option -values ""
 
     constructor args {
         installhull [::spinbox $self] 
         $self configurelist $args
     }
 
     onconfigure -valuesvariable valuesvariable {
         trace remove variable $options(-valuesvariable) write \
             [mymethod ValuesUpdate]
         
         if {[string length $valuesvariable]} {
             trace add variable $valuesvariable write [mymethod ValuesUpdate]
             $self configure -values [set $valuesvariable]
         } 
 
         set options(-valuesvariable) $valuesvariable
     }
 
     onconfigure -node node {
         set options(-node) $node
         $hull set [$node tdwGetValue $options(-attribute)]
     }
 
     onconfigure -attribute attribute {
         set options(-attribute) $attribute
         if {$options(-node) != ""} {
             $hull set [$options(-node) tdwGetValue $attribute]
         }
     }
 
     method ValuesUpdate {name ndx op} {
         set before [$self get]
         $self configure -values [set $options(-valuesvariable)]
         if {[lsearch -exact [set $options(-valuesvariable)] $before] != -1} {
             $self set $before
         }
     }
 
     method WatchForChange {method arguments} {
         set before [$hull get]
         set result [eval $hull $method $arguments]
         set after  [$hull get]
 
         if {![string equal $before $after]} {
             if {$options(-node) != ""} {
                 $options(-node) tdwValueChanged $selected $options(-attribute)
             }
             event generate $win <<tdw::ValueChanged>>
         }
 
         return $result
     }
 
     onconfigure -values values {
         set options(-values) $values
         return [$self WatchForChange configure [list -values $values]]
     }
 
     method delete args {
         return [$self WatchForChange delete $args]
     }
 
     method insert args {
         return [$self WatchForChange insert $args]
     }
 
     method set args {
         return [$self WatchForChange set $args]
     }
 
     method invoke args {
         return [$self WatchForChange invoke $args]
     }
 
     delegate method * to hull
     delegate option * to hull 
 }
 

 #-------------------------------------------------------------------------------
 # CHECKBUTTON
 #
 ::snit::widgetadaptor ::tdg::checkbutton {
     option -node ""
     option -attribute ""
     option -variable ""
     variable selected
 
     constructor args {
         installhull [::checkbutton $self -variable ${selfns}::selected]
         trace add variable ${selfns}::selected write [mymethod SelectionUpdated]
         $self configurelist $args
     }
 
     onconfigure -node node {
         set options(-node) $node
         set selected [$node tdwGetValue $options(-attribute)]
     }
 
     onconfigure -attribute attribute {
         set options(-attribute) $attribute
         if {$options(-node) != ""} {
             set selected [$options(-node) tdwGetValue $attribute]
         }
     }
 
     onconfigure -variable variable {
         set options(-variable) $variable
         if {[info exists $variable]} {
             set selected [set $variable]
         } else {
             set $variable [set selected ""]
         }
     }
 
     method SelectionUpdated {var ndx op} {
         if {$options(-node) != ""} {
             $options(-node) tdwValueChanged $selected $optins(-attribute)
         }
 
         event generate $win <<tdw::ValueChanged>>
 
         if {[string length $options(-variable)]} {
             after 0 [list set $options(-variable) $selected]
         }
     }
 
     method get {} {
         return $selected
     }
 
     method getOpposite {} {
         if {[string is boolean -strict $selected]} {
             return [expr {![string is true -strict $selected]}]
         } else {
             return $selected
         }
     }
 
     method on? {} {
         return [string equal $selected [$hull cget -onvalue]]
     }
 
     method off? {} {
         return [string equal $selected [$hull cget -offvalue]]
     }
 
     delegate method * to hull
     delegate option * to hull
 }
 
 
 #-------------------------------------------------------------------------------
 # ENTRY
 #
 ::snit::widgetadaptor ::tdg::entry {
     option -node ""
     option -attribute ""
 
     constructor args {
         installhull [::entry $self] 
         $self configurelist $args
     }
 
     onconfigure -node node {
         set options(-node) $node
         $self delete 0 end
         $self insert 0 [$node tdwGetValue $options(-attribute)]
     }
 
     onconfigure -attribute attribute {
         set options(-attribute) $attribute
         if {$options(-node) != ""} {
             $self delete 0 end
             $self insert 0 [$options(-node) tdwGetValue $attribute]
         }
     }
 
     method WatchForChange {method arguments} {
         set before [$hull get]
         set result [eval $hull $method $arguments]
         set after  [$hull get]
 
         if {![string equal $before $after]} {
             if {$options(-node) != ""} {
                 $options(-node) tdwValueChanged $after $options(-attribute)
             }
             event generate $win <<tdw::ValueChanged>>
         }
 
         return $result
     }
 
     method insert args {
         return [$self WatchForChange insert $args]
     }
 
     method delete args {
         return [$self WatchForChange delete $args]
     }
 
     delegate method * to hull
     delegate option * to hull
 }
 
 
 #-------------------------------------------------------------------------------
 # TEXT
 #
 ::snit::widgetadaptor ::tdg::text {
     option -node ""
     option -attribute ""
 
     constructor args {
         installhull [::text $self] 
         $self configurelist $args
     }
 
     onconfigure -node node {
         set options(-node) $node
         $self delete 1.0 end
         $self insert 1.0 [$node tdwGetValue $options(-attribute)]
     }
 
     onconfigure -attribute attribute {
         set options(-attribute) $attribute
         if {$options(-node) != ""} {
             $self delete 1.0 end
             $self insert 1.0 [$options(-node) tdwGetValue $attribute]
         }
     }
 
     method WatchForChange {method arguments} {
         set before [$hull get 1.0 end-1c]
         set result [eval $hull $method $arguments]
         set after  [$hull get 1.0 end-1c]
 
         if {![string equal $before $after]} {
             if {$options(-node) != ""} {
                 $options(-node) tdwValueChanged $after $options(-attribute)
             }
             event generate $win <<tdw::ValueChanged>>
         }
 
         return $result
     }
 
     method delete args {
         return [$self WatchForChange delete $args]
     }
 
     method edit args {
         return [$self WatchForChange edit $args]
     }
 
     method insert args {
         return [$self WatchForChange insert $args]
     }
 
     delegate method * to hull
     delegate option * to hull
 }
 
 
 #-------------------------------------------------------------------------------
 # tdwValueChanged (tDOM helper method)
 #
 proc ::dom::domNode::tdwValueChanged {node value attribute} {
     if {[$node nodeType] != "ELEMENT_NODE"} {
         return [$node nodeValue $value]
     } 
 
     if {[string length $attribute]} {
         return [$node setAttribute $attribute $value]
     }
 
     set child [lindex [$node selectNodes text()] end]
     if {$child != ""} {
         return [$child nodeValue $value]
     } 
 
     $node appendFromList {#text {}}
     set child [$node lastChild]
     return [$child nodeValue $value]
 }
 
 
 #-------------------------------------------------------------------------------
 # tdwGetValue (tDOM helper method)
 #
 proc ::dom::domNode::tdwGetValue {node attribute} {
     if {[string length $attribute]} {
         if {[$node hasAttribute $attribute]} {
             return [$node getAttribute $attribute]
         } else return
     }
 
     if {[$node nodeType] != "ELEMENT_NODE"} {
         return [$node data]
     }
     
     set child [lindex [$node selectNodes text()] end]
     if {$child != ""} {
         return [$child data]
     } else return
 }
 
 
 package provide tdg 1.1