Attachment "ipentry-variable.patch.txt" to
ticket [1422793fff]
added by
cmay
2006-02-03 01:20:33.
? 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]]
