Overview
| Artifact ID: | 90937fa1489f84cc27d9bc9a511181a4b350c40e |
|---|---|
| Ticket: | 1422793fffffffffffffffffffffffffffffffff |
| Date: | 2006-02-03 01:20:33 |
| User: | cmay |
| Artifact Attached: | 0a3caaaebf0b50fc03d925e2090fd55894488370 |
| Filename: | ipentry-variable.patch.txt |
| Description: |
Content:
? 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]]