In scientific software, often an entry widget is needed to enter real numbers, which sometimes are updated from the program. The entry widget below provides convenient validation for real numbers with optional maximum and minimum allowed values. The value of the associated -variable is displayed in this entry rounded by a format string (standard is %.6g, rounded to 6 decimal places), but kept internally at full precision unless a new value is entered. A value close to zero can also be truncated using the -epsilon option.
# Copyright (c) 2012 Christian Gollwitzer, Bundesanstalt für Materialforschung und -prüfung (BAM)
#
# Permission is hereby granted, free of charge, to any person obtaining a copy of
# this software and associated documentation files (the "Software"), to deal in
# the Software without restriction, including without limitation the rights to
# use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
# of the Software, and to permit persons to whom the Software is furnished to do
# so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
package require snit
snit::widgetadaptor numeric_entry {
# ttk::entry which displays nicely rounded values, but uses
# internal full precision until the user edits the values
option -format -default "%.6g"
option -epsilon -default 0
option -default -default {}
option -min -default {}
option -max -default {}
option -strict -default false
option -variable -default {} -configuremethod SetVar
delegate option * to hull except -validate except -validatecommand except -invalidcommand except -textvariable
delegate method * to hull
variable displayvar
variable loopescape
variable modified
constructor {args} {
installhull using ttk::entry -validate all -validatecommand [mymethod validator %d %S %s %P %V] -textvariable [myvar displayvar]
set loopescape false
set modified false
# move the -variable option to the end of the list
if {[dict exists $args -variable]} {
set thevar [dict get $args -variable]
dict unset args -variable
dict set args -variable $thevar
}
$self configurelist $args
}
destructor {
$self untrace
}
method untrace {} {
if {$options(-variable)!= {}} {
upvar #0 $options(-variable) v
trace remove variable v write [mymethod SetVal]
set options(-variable) {}
}
}
method SetVar {option varname} {
$self untrace
if {$varname != {} } {
upvar #0 $varname v
if {![info exists v]} {
set v $options(-default)
}
trace add variable v write [mymethod SetVal]
set options(-variable) $varname
$self SetVal
}
}
method SetVal {args} {
# the linked variable has been set
# reset modified flag and format number
if {$loopescape} {
set loopescape false
return
}
set modified false
$self FormatVal
}
method FormatVal {} {
upvar #0 $options(-variable) thevar
if {$thevar=={}} {
set displayvar {}
return
}
if {abs($thevar)<$options(-epsilon)} {
set displayvar 0
} else {
set displayvar [format $options(-format) $thevar]
}
}
method validator {mode key oldx newx event} {
upvar #0 $options(-variable) thevar
# check the new value for anything looking remotely like exponential notation
# replace comma with decimal point
regsub , $newx . newx
switch $mode {
1 {
# inserting
if { [regexp {^\s*[+-]?\d*(\.\d*)?([eE][+-]?\d*)?\s*$} $newx] } {
# loopescape stops SetVar from updating displayvar
set loopescape true
set thevar $newx
set modified true
event generate $win <<ModifiedInsert>> -when head
return true
} else {
return false
}
}
0 {
# delete
# accept in any case: Don't annoy user to reject anything
set loopescape true
set thevar $newx
set modified true
event generate $win <<ModifiedDelete>> -when head
return true
}
-1 {
# revalidation
# if there is no modification, just accept
if {!$modified} {
return true
} else {
# whether we need to change the value inside here
set valuechanged false
if {![string is double $newx]} {
# try to make a double from this corrupted string
if {[scan $newx %f temp]} {
set newx $temp
set valuechanged true
} else {
# can't convert to double in any reasonable fashion
set newx $options(-default)
set valuechanged true
}
}
# check again with -strict, to disallow empty input
if {$options(-strict) && ![string is double -strict $newx]} {
set newx $options(-default)
set valuechanged true
}
# check for min and max values
if {!$valuechanged && [string is double -strict $options(-min)] && $newx<$options(-min)} {
set newx $options(-min)
set valuechanged true
}
if {!$valuechanged && [string is double -strict $options(-max)] && $newx>$options(-max)} {
set newx $options(-max)
set valuechanged true
}
# newx is determined, now set the linked variable
# inhibit trace
set loopescape true
set thevar $newx
if {$valuechanged} {
# the value has been changed by the validator
# reformat the display
$self FormatVal
}
if {$valuechanged || ($event=="focusout" && $modified)} {
event generate $win <<Modified>> -when head
}
return true
}
}
default {
error "Unknown validation condition $mode"
}
}
}
method IsModified {} {
return $modified
}
method ResetModified {} {
set modified false
}
}
arjen - 2016-11-13 11:18:15
Here is an almost but not quite trivial demonstration for this widget:
pack [numeric_entry .enumber -variable number]
pack [entry .eplain -textvariable number]
set number 1.23456789
after 2000 {set number [expr {rand()}]}Alexandru - 2020-04-25 19:04:51
I modified your original code:
Currently there is a flow in the logic when using combobox. When selecting a value from the list, the number is not formatted.
# Copyright (c) 2012 Christian Gollwitzer, Bundesanstalt für Materialforschung und -prüfung (BAM)
#
# Permission is hereby granted, free of charge, to any person obtaining a copy of
# this software and associated documentation files (the "Software"), to deal in
# the Software without restriction, including without limitation the rights to
# use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
# of the Software, and to permit persons to whom the Software is furnished to do
# so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
package provide numentry 1.0
package require snit
namespace eval ::numentry {}
proc ::numentry::myformat {val} {
if {![string is double -strict $val]} {
return $val
}
return [expr {round($val*10000.0)/10.0}]e-3
}
proc ::numentry::test {} {
set ::numentry::number 0.1234
pack [ttk::entry .enumber]
pack [ttk::combobox .cbnumber -values {0.1234 0.5678}]
numentry .enumber -variable ::numentry::number -formatcmd ::numentry::myformat
numentry .cbnumber -variable ::numentry::number -formatcmd ::numentry::myformat
console show
}
snit::widgetadaptor numentry {
# ttk::entry which displays nicely rounded values, but uses
# internal full precision until the user edits the values
option -formatcmd -default ""
option -epsilon -default 0
option -default -default {}
option -min -default {}
option -max -default {}
option -strict -default false
option -variable -default {} -configuremethod SetVar
delegate option * to hull except -validate except -validatecommand except -invalidcommand except -textvariable
delegate method * to hull
variable displayvar
variable loopescape
variable modified
constructor {args} {
installhull $win
$hull configure -validate all -validatecommand [mymethod validator %d %S %s %P %V] -textvariable [myvar displayvar]
# installhull using ttk::entry -validate all -validatecommand [mymethod validator %d %S %s %P %V] -textvariable [myvar displayvar]
set loopescape false
set modified false
# move the -variable option to the end of the list
if {[dict exists $args -variable]} {
set thevar [dict get $args -variable]
dict unset args -variable
dict set args -variable $thevar
}
$self configurelist $args
# bind $win <<Copy>> "$self CopyVal\; break"
bind $self <<Copy>> [mymethod CopyVal]
}
destructor {
$self untrace
}
method untrace {} {
if {$options(-variable)!= {}} {
upvar #0 $options(-variable) v
trace remove variable v write [mymethod SetVal]
set options(-variable) {}
}
}
method SetVar {option varname} {
$self untrace
if {$varname != {} } {
upvar #0 $varname v
if {![info exists v]} {
set v $options(-default)
}
trace add variable v write [mymethod SetVal]
set options(-variable) $varname
$self SetVal
}
}
method SetVal {args} {
# the linked variable has been set
# reset modified flag and format number
if {$loopescape} {
set loopescape false
return
}
set modified false
$self FormatVal
}
method CopyVal {args} {
upvar #0 $options(-variable) thevar
if {![catch {tk::EntryGetSelection $win} tk::Priv(data)]} {
clipboard clear -displayof $win
clipboard append -displayof $win $thevar
unset tk::Priv(data)
}
return -code break
}
method FormatVal {} {
upvar #0 $options(-variable) thevar
if {$options(-formatcmd)==""} {
set displayvar $thevar
return
}
if {$thevar=={}} {
set displayvar {}
return
}
if {abs($thevar)<$options(-epsilon)} {
set displayvar 0
} else {
set displayvar [{*}$options(-formatcmd) $thevar]
}
}
method validator {mode key oldx newx event} {
upvar #0 $options(-variable) thevar
# check the new value for anything looking remotely like exponential notation
# replace comma with decimal point
regsub , $newx . newx
# # Accept anything
# set loopescape true
# set thevar $newx
# set modified true
# event generate $win <<ModifiedDelete>> -when head
# return true
switch $mode {
1 {
# inserting
if { [regexp {^\s*[+-]?\d*(\.\d*)?([eE][+-]?\d*)?\s*$} $newx] } {
# loopescape stops SetVar from updating displayvar
set loopescape true
set thevar $newx
set modified true
event generate $win <<ModifiedInsert>> -when head
return true
} else {
return false
}
}
0 {
# delete
# accept in any case: Don't annoy user to reject anything
set loopescape true
set thevar $newx
set modified true
event generate $win <<ModifiedDelete>> -when head
return true
}
-1 {
# revalidation
# if there is no modification, just accept
if {!$modified} {
return true
} else {
# whether we need to change the value inside here
set valuechanged false
if {![string is double $newx]} {
# try to make a double from this corrupted string
if {[scan $newx %f temp]} {
set newx $temp
set valuechanged true
} else {
# can't convert to double in any reasonable fashion
set newx $options(-default)
set valuechanged true
}
}
# check again with -strict, to disallow empty input
if {$options(-strict) && ![string is double -strict $newx]} {
set newx $options(-default)
set valuechanged true
}
# check for min and max values
if {!$valuechanged && [string is double -strict $options(-min)] && $newx<$options(-min)} {
set newx $options(-min)
set valuechanged true
}
if {!$valuechanged && [string is double -strict $options(-max)] && $newx>$options(-max)} {
set newx $options(-max)
set valuechanged true
}
# newx is determined, now set the linked variable
# inhibit trace
set loopescape true
set thevar $newx
if {$valuechanged} {
# the value has been changed by the validator
# reformat the display
$self FormatVal
}
if {$valuechanged || ($event=="focusout" && $modified)} {
event generate $win <<Modified>> -when head
}
return true
}
}
default {
error "Unknown validation condition $mode"
}
}
}
method IsModified {} {
return $modified
}
method ResetModified {} {
set modified false
}
}