? ipentry-variable.patch.txt
Index: ipentry.man
===================================================================
RCS file: /cvsroot/tcllib/tklib/modules/ipentry/ipentry.man,v
retrieving revision 1.4
diff -u -r1.4 ipentry.man
--- ipentry.man	16 Mar 2005 05:59:20 -0000	1.4
+++ ipentry.man	2 Feb 2006 18:18:46 -0000
@@ -1,9 +1,9 @@
 [comment {-*- tcl -*- doctools manpage}]
-[manpage_begin ipentry n 0.1]
+[manpage_begin ipentry n 0.2]
 [moddesc   {An IP address entry widget}]
 [titledesc {An IP address entry widget}]
 [require Tcl 8.4]
-[require ipentry [opt 0.1]]
+[require ipentry [opt 0.2]]
 [description]
 
 This package provides a widget for the entering of a IP address.  It
@@ -63,6 +63,10 @@
 
 [list_begin tkoption]
 
+[tkoption_def -textvariable textvariable Variable]
+
+The name of a variable which holds the value of the IP address.  The value must be a string of the form NNN.NNN.NNN.NNN or it will be modified to represent a valid IP address.
+
 [tkoption_def -state state State]
 
 Specifies one of three states for the entry: [const normal],
Index: ipentry.tcl
===================================================================
RCS file: /cvsroot/tcllib/tklib/modules/ipentry/ipentry.tcl,v
retrieving revision 1.9
diff -u -r1.9 ipentry.tcl
--- ipentry.tcl	1 Jun 2005 02:37:51 -0000	1.9
+++ ipentry.tcl	2 Feb 2006 18:18:46 -0000
@@ -10,7 +10,7 @@
 # RCS: @(#) $Id: ipentry.tcl,v 1.9 2005/06/01 02:37:51 andreas_kupries Exp $
 
 package require Tk
-package provide ipentry 0.1
+package provide ipentry 0.2
 
 namespace eval ::ipentry {
     namespace export ipentry
@@ -43,7 +43,8 @@
     destroy $w.d4
     rename ::$w ::ipentry::_$w
     interp alias {} ::$w {} ::ipentry::widgetCommand $w
-    bind $w <Destroy> [list rename ::$w {}]
+    namespace eval _tvns$w {variable textvarname}
+    bind $w <Destroy> [list ::ipentry::destroyWidget $w]
     #bind $w <FocusIn> [list focus $w.0]
     if {[llength $args] > 0} {
         eval [list $w configure] $args
@@ -196,10 +197,19 @@
 }
 
 proc ::ipentry::cget {w cmd} {
-    switch -exact -- [lindex $args 0] {
+    switch -exact -- $cmd {
         -bd     -
         -relief {
-            return [::ipentry::_$w cget [lindex $args 0]]
+            return [::ipentry::_$w cget $cmd]
+        }
+        -textvariable {
+            namespace eval _tvns$w {
+                if { [info exists textvarname] } {
+                    return $textvarname
+                } else {
+                    return {}
+                }
+            }
         }
         default {
             return [$w.0 cget $cmd]
@@ -265,6 +275,26 @@
                 foreach x {0 1 2 3} { $w.$x configure $cmd [lindex $args 1] }
                 set args [lrange $args 2 end]
             }
+            -textvariable {
+                namespace eval _tvns$w {
+                    if { [info exists textvarname] } {
+                        set _w [join [lrange [split [namespace current] .] 1 end] .]
+                        trace remove variable $textvarname \
+                            [list array read write unset] \
+                            [list ::ipentry::traceVar .$_w]
+                    }
+                }
+                set _tvns[set w]::textvarname [lindex $args 1]
+                upvar #0 [lindex $args 1] var
+                if { [info exists var] && [isValid $var] } {
+                    $w insert [split $var .]
+                } else {
+                    set var {}
+                }
+                trace add variable var [list array read write unset] \
+                    [list ::ipentry::traceVar $w]
+                set args [lrange $args 2 end]
+            }
             default {
                 error "unknown option \"[lindex $args 0]\""
             }
@@ -272,6 +302,64 @@
     }
 }
 
+proc ::ipentry::destroyWidget {w} {
+    upvar #0 [$w cget -textvariable] var
+    trace remove variable var [list array read write unset] \
+        [list ::ipentry::traceVar $w]
+    namespace forget _tvns$w
+    rename $w {}
+}
+
+proc ::ipentry::traceVar {w varname key op} {
+    upvar #0 $varname var
+
+    if { $op == "write" } {
+        if { $key != "" } {
+            $w insert [split $var($key) .]
+        } else {
+            $w insert [split $var .]
+        }
+    }
+
+    if { $op == "unset" } {
+        if { $key != "" } {
+            trace add variable var($key) [list array read write unset] \
+                [list ::ipentry::traceVar $w]
+        } else {
+            trace add variable var [list array read write unset] \
+                [list ::ipentry::traceVar $w]
+        }
+    }
+
+    set val [join [$w get] .]
+    if { ![isValid $val] } {
+        set val {}
+    }
+    if { $key != "" } {
+        set var($key) $val
+    } else {
+        set var $val
+    }
+
+}
+
+proc ::ipentry::isValid {val} {
+    set lval [split [join $val] {. }]
+    set valid 1
+    if { [llength $lval] != 4 } {
+        set valid 0
+    } else {
+        foreach n $lval {
+            if { $n == "" || ![string is integer -strict $n]
+              || $n > 255 || $n < 0 } {
+                set valid 0
+                break
+            }
+        }
+    }
+    return $valid
+}
+
 proc ::ipentry::widgetCommand {w cmd args} {
     switch -exact -- $cmd {
         get {
@@ -290,8 +378,8 @@
                         error "cannot insert non-numeric arguments"
                     }
                     if {$n > 255} { set n 255 }
-                    if {$n < 0}   { set n 0 }
-                    if {$x == 0 && $n < 1} { set n 1 }
+                    if {$n <= 0}  { set n 0 }
+                    #if {$x == 0 && $n < 1} { set n 1 }
                 }
                 $w.$x delete 0 end
                 $w.$x insert 0 $n
Index: pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcllib/tklib/modules/ipentry/pkgIndex.tcl,v
retrieving revision 1.2
diff -u -r1.2 pkgIndex.tcl
--- pkgIndex.tcl	28 Jul 2003 06:50:59 -0000	1.2
+++ pkgIndex.tcl	2 Feb 2006 18:18:46 -0000
@@ -9,5 +9,5 @@
 # full path name of this file's directory.
 
 if { ![package vsatisfies [package provide Tcl] 8.4] } { return }
-package ifneeded ipentry 0.1 [list source [file join $dir ipentry.tcl]]
+package ifneeded ipentry 0.2 [list source [file join $dir ipentry.tcl]]