File: wcbEntry.tcl

package info (click to toggle)
tklib 0.6-1
  • links: PTS
  • area: main
  • in suites: jessie-kfreebsd
  • size: 16,012 kB
  • sloc: tcl: 65,204; sh: 6,870; ansic: 792; pascal: 359; makefile: 73; exp: 21; sed: 16
file content (339 lines) | stat: -rw-r--r-- 11,682 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
#==============================================================================
# Contains Wcb procedures for Tk or tile entry, BWidget Entry, Tk or tile
# spinbox, and tile combobox widgets.
#
# REMARK: Everything stated below for entry widgets is valid for tile entry and
#         BWidget Entry widgets, too.  Similarly, everything stated below for
#         spinbox widgets is valid for tile spinbox widgets, too.
#
# Copyright (c) 1999-2010  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 idx [$w index $idx]

    append newText [string range $oldText 0 [expr {$idx - 1}]] \
		   $str \
		   [string range $oldText $idx end]
    return $newText
}

#------------------------------------------------------------------------------
# wcb::postDeleteEntryText
#
# Returns the text that would be contained in the entry, spinbox, or tile
# combobox widget w after deleting the range of characters starting with the
# index given by from and stopping just before the one given by the first
# element of args (if any).
#------------------------------------------------------------------------------
proc wcb::postDeleteEntryText {w from args} {
    set first [$w index $from]

    if {[llength $args] == 0} {
	set last $first
    } else {
	set to [lindex $args 0]
	set last [expr {[$w index $to] - 1}]
    }

    return [string replace [$w get] $first $last]
}

#
# 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} {
	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]
    }
}