331 lines
11 KiB
Tcl
331 lines
11 KiB
Tcl
#==============================================================================
|
|
# Contains Wcb procedures for Tk entry, tile entry, BWidget Entry, spinbox, and
|
|
# tile combobox widgets.
|
|
#
|
|
# REMARK: Everything stated below for entry widgets is valid for tile entry and
|
|
# BWidget Entry widgets, too.
|
|
#
|
|
# Copyright (c) 1999-2005 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
|
|
#==============================================================================
|
|
|
|
#
|
|
# Namespace initialization
|
|
# ========================
|
|
#
|
|
|
|
namespace eval wcb {
|
|
#
|
|
# Some regexp patterns:
|
|
#
|
|
if {$tk_version >= 8.1} {
|
|
variable alphaPat {^[[:alpha:]]*$}
|
|
variable digitPat {^[[:digit:]]*$}
|
|
variable alnumPat {^[[:alnum:]]*$}
|
|
} else {
|
|
variable alphaPat {^[A-Za-z]*$}
|
|
variable digitPat {^[0-9]*$}
|
|
variable alnumPat {^[A-Za-z0-9]*$}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Utility procedures for entry, spinbox, and tile combobox widgets
|
|
# ================================================================
|
|
#
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::changeEntryText
|
|
#
|
|
# Replaces the text of the entry, spinbox, or tile combobox widget w with the
|
|
# string str, by using the delete and insert operations. If one of these
|
|
# subcommands is canceled by some before-callback then the procedure keeps the
|
|
# original entry, spinbox, or tile combobox string and returns 0, otherwise it
|
|
# returns 1.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::changeEntryText {w str} {
|
|
set oldStr [$w get]
|
|
set oldPos [$w index insert]
|
|
|
|
$w delete 0 end
|
|
if {[canceled $w delete]} {
|
|
return 0
|
|
}
|
|
|
|
$w insert 0 $str
|
|
if {[canceled $w insert]} {
|
|
$w insert 0 $oldStr
|
|
set result 0
|
|
} else {
|
|
set result 1
|
|
}
|
|
$w icursor $oldPos
|
|
return $result
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::postInsertEntryLen
|
|
#
|
|
# Returns the length of the text that would be contained in the entry, spinbox,
|
|
# or tile combobox widget w after inserting the string str.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::postInsertEntryLen {w str} {
|
|
return [expr {[$w index end] + [string length $str]}]
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::postInsertEntryText
|
|
#
|
|
# Returns the text that would be contained in the entry, spinbox, or tile
|
|
# combobox widget w after inserting the string str before the character
|
|
# indicated by the index idx.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::postInsertEntryText {w idx str} {
|
|
set oldText [$w get]
|
|
set numIdx [$w index $idx]
|
|
|
|
append newText [string range $oldText 0 [expr {$numIdx - 1}]] \
|
|
$str \
|
|
[string range $oldText $numIdx end]
|
|
return $newText
|
|
}
|
|
|
|
#
|
|
# Simple before-insert callback routines for
|
|
# entry, spinbox, and tile combobox widgets
|
|
# ==========================================
|
|
#
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkStrForRegExp
|
|
#
|
|
# Checks whether the string str to be inserted into the entry, spinbox, or tile
|
|
# combobox widget w is matched by the regular expression exp; if not, it
|
|
# cancels the insert operation.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkStrForRegExp {exp w idx str} {
|
|
if {![regexp -- $exp $str]} {
|
|
cancel
|
|
}
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkStrForAlpha
|
|
#
|
|
# Checks whether the string str to be inserted into the entry, spinbox, or tile
|
|
# combobox widget w is alphabetic; if not, it cancels the insert operation.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkStrForAlpha {w idx str} {
|
|
variable alphaPat
|
|
checkStrForRegExp $alphaPat $w $idx $str
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkStrForNum
|
|
#
|
|
# Checks whether the string str to be inserted into the entry, spinbox, or tile
|
|
# combobox widget w is numeric; if not, it cancels the insert operation.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkStrForNum {w idx str} {
|
|
variable digitPat
|
|
checkStrForRegExp $digitPat $w $idx $str
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkStrForAlnum
|
|
#
|
|
# Checks whether the string str to be inserted into the entry, spinbox, or tile
|
|
# combobox widget w is alphanumeric; if not, it cancels the insert operation.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkStrForAlnum {w idx str} {
|
|
variable alnumPat
|
|
checkStrForRegExp $alnumPat $w $idx $str
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::convStrToUpper
|
|
#
|
|
# Replaces the string str to be inserted into the entry, spinbox, or tile
|
|
# combobox widget w with its uppercase equivalent.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::convStrToUpper {w idx str} {
|
|
replace 1 1 [string toupper $str]
|
|
return ""
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::convStrToLower
|
|
#
|
|
# Replaces the string str to be inserted into the entry, spinbox, or tile
|
|
# combobox widget w with its lowercase equivalent.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::convStrToLower {w idx str} {
|
|
replace 1 1 [string tolower $str]
|
|
return ""
|
|
}
|
|
|
|
#
|
|
# Further before-insert callback routines for
|
|
# entry, spinbox, and tile combobox widgets
|
|
# ===========================================
|
|
#
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkEntryForInt
|
|
#
|
|
# Checks whether the text contained in the entry, spinbox, or tile combobox
|
|
# widget w after inserting the string str before the character indicated by the
|
|
# index idx would represent (the starting part of) an integer number; if not,
|
|
# it cancels the insert operation.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkEntryForInt {w idx str} {
|
|
set newText [postInsertEntryText $w $idx $str]
|
|
if {![regexp {^[+-]?[0-9]*$} $newText]} {
|
|
cancel
|
|
}
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkEntryForUInt
|
|
#
|
|
# Checks whether the text contained in the entry, spinbox, or tile combobox
|
|
# widget w after inserting the string str before the character indicated by the
|
|
# index idx would represent (the starting part of) an unsigned integer no
|
|
# greater than max; if not, it cancels the insert operation. The value * for
|
|
# max means: no upper bound.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkEntryForUInt {max w idx str} {
|
|
set newText [postInsertEntryText $w $idx $str]
|
|
if {![regexp {^[0-9]*$} $newText]} {
|
|
cancel
|
|
} elseif {[string compare $max *] != 0} {
|
|
scan $newText "%d" val
|
|
if {$val > $max} {
|
|
cancel
|
|
}
|
|
}
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkEntryForReal
|
|
#
|
|
# Checks whether the text contained in the entry, spinbox, or tile combobox
|
|
# widget w after inserting the string str before the character indicated by the
|
|
# index idx would represent (the starting part of) a real number; if not, it
|
|
# cancels the insert operation.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkEntryForReal {w idx str} {
|
|
set newText [postInsertEntryText $w $idx $str]
|
|
if {![regexp {^[+-]?[0-9]*\.?[0-9]*([0-9]\.?[eE][+-]?[0-9]*)?$} $newText]} {
|
|
cancel
|
|
}
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkEntryForFixed
|
|
#
|
|
# Checks whether the text contained in the entry, spinbox, or tile combobox
|
|
# widget w after inserting the string str before the character indicated by the
|
|
# index idx would represent (the starting part of) a real number with at most
|
|
# cnt digits after the decimal point; if not, it cancels the insert operation.
|
|
# The value * for cnt means: unlimited number of digits after the decimal
|
|
# point.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkEntryForFixed {cnt w idx str} {
|
|
set pattern {^[+-]?[0-9]*\.?}
|
|
if {[string compare $cnt "*"] == 0} {
|
|
append pattern {[0-9]*$}
|
|
} else {
|
|
for {set n 0} {$n < $cnt} {incr n} {
|
|
append pattern {[0-9]?}
|
|
}
|
|
append pattern $
|
|
}
|
|
|
|
set newText [postInsertEntryText $w $idx $str]
|
|
if {![regexp $pattern $newText]} {
|
|
cancel
|
|
}
|
|
}
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::checkEntryLen
|
|
#
|
|
# Checks whether the length of the text contained in the entry, spinbox, or
|
|
# tile combobox widget w after inserting the string str would be greater than
|
|
# len; if yes, it cancels the insert operation.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::checkEntryLen {len w idx str} {
|
|
if {[postInsertEntryLen $w $str] >= $len} {
|
|
set ::campo $w
|
|
set ::tam $len
|
|
if {[postInsertEntryLen $w $str] > $::tam} {
|
|
cancel
|
|
} {
|
|
# danilo
|
|
regsub -all "::_" $::campo "" ::campo
|
|
if {[string range $::campo 0 3] != ".tbl"} {
|
|
event generate $::campo <Return>
|
|
}
|
|
}
|
|
}
|
|
# if {[postInsertEntryLen $w $str] > $len} {
|
|
# cancel
|
|
# }
|
|
}
|
|
|
|
#
|
|
# Private procedure
|
|
# =================
|
|
#
|
|
|
|
#------------------------------------------------------------------------------
|
|
# wcb::entryWidgetCmd
|
|
#
|
|
# Processes the Tcl command corresponding to an entry, spinbox, or tile
|
|
# combobox widget w with registered callbacks. In this procedure, the
|
|
# execution of the commands insert, delete, and icursor is preceded by calls to
|
|
# the corresponding before-callbacks and followed by calls to the corresponding
|
|
# after-callbacks, in the global scope.
|
|
#------------------------------------------------------------------------------
|
|
proc wcb::entryWidgetCmd {w argList} {
|
|
set orig [list ::_$w]
|
|
|
|
set argCount [llength $argList]
|
|
if {$argCount == 0} {
|
|
# Let Tk report the error
|
|
return [uplevel 2 $orig $argList]
|
|
}
|
|
|
|
set option [lindex $argList 0]
|
|
set opLen [string length $option]
|
|
set opArgs [lrange $argList 1 end]
|
|
|
|
if {[string first $option "insert"] == 0 && $opLen >= 3} {
|
|
if {$argCount == 3} {
|
|
return [wcb::processCmd $w insert insert $opArgs]
|
|
} else {
|
|
# Let Tk report the error
|
|
return [uplevel 2 $orig $argList]
|
|
}
|
|
|
|
} elseif {[string first $option "delete"] == 0} {
|
|
if {$argCount == 2 || $argCount == 3} {
|
|
return [wcb::processCmd $w delete delete $opArgs]
|
|
} else {
|
|
# Let Tk report the error
|
|
return [uplevel 2 $orig $argList]
|
|
}
|
|
|
|
} elseif {[string first $option "icursor"] == 0 && $opLen >= 2} {
|
|
if {$argCount == 2} {
|
|
return [wcb::processCmd $w motion icursor $opArgs]
|
|
} else {
|
|
# Let Tk report the error
|
|
return [uplevel 2 $orig $argList]
|
|
}
|
|
|
|
} else {
|
|
return [uplevel 2 $orig $argList]
|
|
}
|
|
}
|