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: 1. Copy works on actual values of the entry (not displayed value) 2. replaced -format option by more general -formatcommand 3. Renamed widget to more compact and easy to type name "numentry" 4. Add support for combobox 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 } } ====== <<categories>>Tk