Entry widget for numeric data

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()}]}