Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch rfe-fa7e485702
Excluding Merge-Ins
This is equivalent to a diff from
9649a254c8
to 2d9c2d10ac
2019-09-08
| | |
16:27 |
|
check-in: 121f091d01 user: oehhar tags: trunk
|
2019-09-06
| | |
13:03 |
|
Leaf
check-in: 2d9c2d10ac user: oehhar tags: rfe-fa7e485702
|
2019-09-03
| | |
13:10 |
|
check-in: 9649a254c8 user: csaba tags: trunk
|
13:09 |
|
check-in: a441f84d42 user: csaba tags: trunk
|
2017-04-04
| | |
07:26 |
|
check-in: 5634c2dfd1 user: oehhar tags: rfe-fa7e485702
|
| | |
Changes to modules/datefield/datefield.man.
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
|
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
|
-
+
-
+
+
-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
-
+
|
[comment {-*- tcl -*- doctools manpage}]
[manpage_begin datefield n 0.2]
[manpage_begin datefield n 0.3]
[see_also clock(n)]
[see_also entry(n)]
[keywords clock]
[keywords date]
[keywords dateentry]
[keywords entry]
[keywords widget]
[copyright {Keith Vetter <[email protected]>}]
[copyright {Keith Vetter <[email protected]>} and
{Thomas Wunderlich <[email protected]>}]
[moddesc {Tk datefield widget}]
[titledesc {Tk datefield widget}]
[category Widget]
[require Tk]
[require datefield [opt 0.2]]
[require datefield [opt 0.3]]
[description]
The [package datefield] package provides the datefield widget which
is an enhanced text entry widget for the purpose of date entry. Only
valid dates of the form MM/DD/YYYY can be entered.
is an enhanced text entry widget for the purpose of date entry. There
are three valid formats for the dates which can be entered:
[list_begin [enum]]
[enum] English form MM/DD/YYYY using [arg {-format "%m/%d/%Y"}] (default)
[enum] German form DD.MM.YYYY using [arg {-format "%d.%m.%Y"}]
[enum] ISO form YYYY-MM-DD using [arg {-format "%Y-%m-%d"}]
[list_end]
[para]
The datefield widget is, in fact, just an entry widget with
specialized bindings. This means all the command and options for an
entry widget apply equally here.
[section COMMANDS]
[list_begin definitions]
[call [cmd ::datefield::datefield] [arg widgetpath] [opt [arg options]]]
Creates and configures a date field widget.
[list_end]
[section OPTIONS]
[list_begin definitions]
[call [arg -format]]
One of "%m/%d/%Y" (English, default if option left), "%d.%m.%Y" (German),
or "%Y-%m-%d" (ISO).
[list_end]
[para]
See the [cmd entry] manual entry for details on all available options.
See the [cmd entry] manual entry for details on all remaining/available
options.
[section EXAMPLE]
[example {
package require datefield
wm title . "Datefield example"
proc DayOfWeek {args} {
set now [clock scan $::myDate]
set ::myDate2 [clock format $now -format %A]
}
trace variable myDate w DayOfWeek
::datefield::datefield .df -textvariable myDate
::datefield::datefield .df -textvariable myDate -format "%m/%d/%Y"
label .l1 -text "Enter a date:" -anchor e
label .l2 -text "That date is a:" -anchor e
label .l3 -textvariable myDate2 -relief sunken -width 12
grid .l1 .df -sticky ew
grid .l2 .l3 -sticky ew
focus .df
}]
[vset CATEGORY datefield]
[include ../../support/devel/doc/feedback.inc]
[manpage_end]
|
Changes to modules/datefield/datefield.tcl.
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
|
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
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
|
-
+
+
-
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
-
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
|
##+##########################################################################
#
# datefield.tcl
#
# Implements a datefield entry widget ala Iwidget::datefield
# by Keith Vetter ([email protected])
#
# Datefield creates an entry widget but with a special binding to KeyPress
# (based on Iwidget::datefield) to ensure that the current value is always
# a valid date. All normal entry commands and configurations still work.
#
# Usage:
# ::datefield::datefield .df -background yellow -textvariable myDate
# ::datefield::datefield .df -background yellow -textvariable myDate \
# -format "%Y-%m-%d"
# pack .df
#
# Bugs:
# o won't work if you programmatically put in an invalid date
# e.g. .df insert end "abc" will cause it to behave erratically
#
# Revisions:
# KPV Feb 07, 2002 - initial revision
# KPV Feb 07, 2002 - initial revision
# TW Mar 26, 2017 - support more keys and the mouse wheel
# - add option -format to support 3 date-styles:
# "%d.%m.%Y" (for German)
# "%m/%d/%Y" (for English, standard)
# "%Y-%m-%d" (for ISO)
#
##+##########################################################################
#############################################################################
package require Tk 8.0
package provide datefield 0.2
package provide datefield 0.3
namespace eval ::datefield {
namespace export datefield
# Have the widget use tile/ttk should it be available.
variable entry entry
if {![catch {
package require tile
}]} {
set entry ttk::entry
}
proc datefield {w args} {
variable entry
variable Format
variable Separator
set i [lsearch $args "-form*"]
if {$i == -1} { # Default English
set Format($w) "%m/%d/%Y"
} else {
set Format($w) [lindex [lreplace $args $i $i] $i]
switch -- $Format($w) {
"%d.%m.%Y" { # German
}
"%m/%d/%Y" { # English
}
"%Y-%m-%d" { # ISO
}
default { # Error
error "ERROR: Unknown value for option -format on datefield $w $args"
}
}
set args [lreplace $args $i $i]
set args [lreplace $args $i $i]
}
set Separator($w) [string range $Format($w) 2 2]
eval $entry $w -width 10 -justify center $args
if {([$w get] eq "") \
|| [catch {clock scan [$w get] -format $Format($w)} base]} {
$w delete 0 end
$w insert end [clock format [clock seconds] -format "%m/%d/%Y"]
$w insert end [clock format [clock seconds] -format $Format($w)]
$w icursor 0
bind $w <KeyPress> [list ::datefield::KeyPress $w %A %K %s]
}
$w icursor 0
bind $w <KeyPress> [list ::datefield::KeyPress $w %A %K %s]
bind $w <MouseWheel> [list ::datefield::MouseWheel $w %D]
bind $w <Button1-Motion> break
bind $w <Button2-Motion> break
bind $w <Double-Button> break
bind $w <Triple-Button> break
bind $w <2> break
return $w
return $w
}
proc Spin {w dir unit code} {
variable Format
set base [clock scan [$w get] -format $Format($w)]
set new [clock add $base $dir $unit]
set date [clock format $new -format $Format($w)]
set icursor [$w index insert]
$w delete 0 end
$w insert end $date
$w icursor $icursor
return $code
}
proc MouseWheel {w dir} {
$w selection clear
set Dir [expr {$dir / 120}]
return -code [Spin $w $Dir "day" continue]
}
# internal routine for all key presses in the datefield entry widget
proc KeyPress {w char sym state} {
variable Format
variable Separator
proc Move {w dir} {
variable Format
set icursor [$w index insert]
set icursor [$w index insert]
set icursor [expr {($icursor + 10 + $dir) % 10}]
if {$Format($w) ne "%Y-%m-%d"} { # English or German
if {($icursor == 2) || ($icursor == 5)} { # Don't land on a / or .
set icursor [expr {($icursor + 10 + $dir) % 10}]
}
} \
elseif {($icursor == 4) || ($icursor == 7)} { # ISO # Don't land on a -
set icursor [expr {($icursor + 10 + $dir) % 10}]
}
$w icursor $icursor
}
set icursor [$w index insert]
$w selection clear
# Handle some non-number characters first
if {$sym == "plus" || $sym == "Up" || \
$sym == "minus" || $sym == "Down"} {
set dir "1 day"
if {$sym == "minus" || $sym == "Down"} {
set dir "-1 day"
}
set base [clock scan [$w get]]
switch -exact -- $sym {
"Down" {return -code [Spin $w -1 "day" continue]}
"End" {$w icursor 9; return -code break}
"minus" {return -code [Spin $w -1 "day" break]}
"Next" {return -code [Spin $w -1 "month" continue]}
"plus" {return -code [Spin $w 1 "day" break]}
"Prior" {return -code [Spin $w 1 "month" continue]}
"Up" {return -code [Spin $w 1 "day" continue]}
"BackSpace" -
"Delete" -
"Left" {Move $w -1; return -code break}
"Right" {Move $w 1; return -code break}
"Tab" {
if {$Format($w) ne "%Y-%m-%d"} { # English or German
if {($state & 5) == 0} { # ->|
if {$icursor < 3} { # from 1st to 2nd
$w icursor 3
} \
elseif {$icursor < 6} { # from 2nd to 10th-year
$w icursor 8
if {[catch {set new [clock scan $dir -base $base]}] != 0} {
bell
return -code break
}
set date [clock format $new -format "%m/%d/%Y"]
if {[catch {clock scan $date}]} {
bell
return -code break
}
$w delete 0 end
$w insert end $date
$w icursor $icursor
return -code break
} else { # next widget
return -code continue
}
} \
elseif {$icursor > 4} { # |<-
$w icursor 3 ;# from year to 2nd
} \
elseif {$icursor > 1} { # from 2nd to 1st
$w icursor 0
} else { # previous widget
return -code continue
}
} \
elseif {($state & 5) == 0} { # ->| ISO
if {$icursor < 5} { # from year to month
$w icursor 5
} \
elseif {$icursor < 8} { # from month to day
$w icursor 8
} else { # next widget
return -code continue
}
} \
elseif {$icursor > 6} { # |<-
$w icursor 5 ;# from day to month
} \
elseif {$icursor > 2} { # from month to 10th-year
$w icursor 2
} else { # previous widget
return -code continue
}
return -code break
} elseif {$sym == "Right" || $sym == "Left" || $sym == "BackSpace" || \
$sym == "Delete"} {
set dir -1
if {$sym == "Right"} {set dir 1}
set icursor [expr {($icursor + 10 + $dir) % 10}]
if {$icursor == 2 || $icursor == 5} {;# Don't land on a slash
set icursor [expr {($icursor + 10 + $dir) % 10}]
}
$w icursor $icursor
return -code break
} elseif {($sym == "Control_L") || ($sym == "Shift_L") || \
($sym == "Control_R") || ($sym == "Shift_R")} {
return -code break
} elseif {$sym == "Tab" && $state == 0} {;# Tab key
if {$icursor < 3} {
$w icursor 3
} elseif {$icursor < 6} {
$w icursor 8
} else {
return -code continue
}
return -code break
}
}
if {$char eq ""} { # remaining special keys
return -code continue
}
if {! [regexp -- {[0-9]} $char]} { # Unknown character
bell
return -code break
}
if {$icursor >= 10} { # Can't add beyond end
bell
return -code break
}
switch -- $Separator($w) {
"." { # German
foreach {day month year} [split [$w get] $Separator($w)] break
if {$icursor < 2} { # DAY SECTION
set endday [lastDay $month $year]
foreach {d1 d2} [split $day ""] break
set cursor 3 ;# Where to leave the cursor
if {$icursor == 0} { # 1st digit of day
if {($char < 3) \
|| (($char == 3) && ($month ne "02"))} {
set day "$char$d2"
if {$day eq "00"} {set day "01"}
if {$day > $endday} {set day $endday}
set cursor 1
} else {
set day "0$char"
}
} else { # 2nd digit of day
set day "$d1$char"
if {($day > $endday) || ($day eq "00")} {
bell
return -code break
}
}
$w delete 0 2
$w insert 0 $day
$w icursor $cursor
return -code break
} elseif {$sym == "Tab" && ($state == 1 || $state == 4)} {
if {$icursor > 4} {
$w icursor 3
} elseif {$icursor > 1} {
$w icursor 0
} else {
return -code continue
}
return -code break
}
if {$icursor < 5} { # MONTH SECTION
foreach {m1 m2} [split $month ""] break
set cursor 6 ;# Where to leave the cursor
if {$icursor == 3} { # 1st digit of month
if {$char < 2} {
set month "$char$m2"
set cursor 4
} else {
set month "0$char"
}
if {$month > 12} {set month "10"}
if {$month eq "00"} {set month "01"}
} else { # 2nd digit of month
set month "$m1$char"
}
if {! [regexp {[0-9]} $char]} { ;# Unknown character
bell
return -code break
}
if {$icursor >= 10} { ;# Can't add beyond end
bell
return -code break
}
foreach {month day year} [split [$w get] "/"] break
# MONTH SECTION
if {$icursor < 2} {
foreach {m1 m2} [split $month ""] break
set cursor 3 ;# Where to leave the cursor
if {$icursor == 0} { ;# 1st digit of month
if {$char < 2} {
set month "$char$m2"
set cursor 1
} else {
set month "0$char"
}
if {$month > 12} {set month 10}
if {$month == "00"} {set month "01"}
} else { ;# 2nd digit of month
set month "$m1$char"
if {$month > 12} {set month "0$char"}
if {$month == "00"} {
bell
return -code break
}
}
$w delete 0 2
$w insert 0 $month
# Validate the day of the month
if {$day > [set endday [lastDay $month $year]]} {
$w delete 3 5
$w insert 3 $endday
}
$w icursor $cursor
if {$month > 12} {set month "0$char"}
if {$month eq "00"} {
bell
return -code break
}
}
$w delete 3 5
$w insert 3 $month
# Validate the day of the month
if {$day > [set endday [lastDay $month $year]]} {
$w delete 0 2
$w insert 0 $endday
}
$w icursor $cursor
return -code break
}
set y1 [string range $year 0 0]; # YEAR SECTION
if {$icursor < 7} { # 1st digit of year
if {($char ne "1") && ($char ne "2")} {
bell
return -code break
}
if {$char != $y1} { # Different century
set y 1999
if {$char eq "2"} {set y 2000}
$w delete 6 end
$w insert end $y
}
$w icursor 7
return -code break
}
$w delete $icursor
$w insert $icursor $char
if {[catch {clock scan [$w get] -format $Format($w)}] != 0} { # Validate the year
$w delete 6 end
$w insert end $year ;# Put back in the old year
$w icursor $icursor
bell
}
}
"/" { # English
foreach {month day year} [split [$w get] $Separator($w)] break
if {$icursor < 2} { # MONTH SECTION
foreach {m1 m2} [split $month ""] break
set cursor 3 ;# Where to leave the cursor
if {$icursor == 0} { # 1st digit of month
if {$char < 2} {
set month "$char$m2"
set cursor 1
} else {
set month "0$char"
}
if {$month > 12} {set month "10"}
if {$month eq "00"} {set month "01"}
} else { # 2nd digit of month
set month "$m1$char"
if {$month > 12} {set month "0$char"}
if {$month eq "00"} {
bell
return -code break
}
}
$w delete 0 2
$w insert 0 $month
# Validate the day of the month
if {$day > [set endday [lastDay $month $year]]} {
$w delete 3 5
$w insert 3 $endday
}
$w icursor $cursor
return -code break
}
return -code break
}
# DAY SECTION
if {$icursor < 5} { ;# DAY
set endday [lastDay $month $year]
foreach {d1 d2} [split $day ""] break
set cursor 6 ;# Where to leave the cursor
if {$icursor <= 3} { ;# 1st digit of day
if {$char < 3 || ($char == 3 && $month != "02")} {
set day "$char$d2"
if {$day == "00"} { set day "01" }
if {$day > $endday} {set day $endday}
set cursor 4
} else {
set day "0$char"
}
} else { ;# 2nd digit of day
set day "$d1$char"
if {$day > $endday || $day == "00"} {
bell
return -code break
}
}
$w delete 3 5
$w insert 3 $day
$w icursor $cursor
return -code break
}
if {$icursor < 5} { # DAY SECTION
set endday [lastDay $month $year]
foreach {d1 d2} [split $day ""] break
set cursor 6 ;# Where to leave the cursor
if {$icursor == 3} { # 1st digit of day
if {($char < 3) \
|| (($char == 3) && ($month ne "02"))} {
set day "$char$d2"
if {$day eq "00"} {set day "01"}
if {$day > $endday} {set day $endday}
set cursor 4
} else {
set day "0$char"
}
} else { # 2nd digit of day
set day "$d1$char"
if {($day > $endday) || ($day eq "00")} {
bell
return -code break
}
}
$w delete 3 5
$w insert 3 $day
$w icursor $cursor
return -code break
}
# YEAR SECTION
set y1 [string range $year 0 0]; # YEAR SECTION
set y1 [lindex [split $year ""] 0]
if {$icursor < 7} { ;# 1st digit of year
if {$char != "1" && $char != "2"} {
bell
return -code break
}
if {$char != $y1} { ;# Different century
set y 1999
if {$char == "2"} {set y 2000 }
$w delete 6 end
$w insert end $y
}
$w icursor 7
return -code break
}
$w delete $icursor
$w insert $icursor $char
if {[catch {clock scan [$w get]}] != 0} {;# Validate the year
$w delete 6 end
$w insert end $year ;# Put back in the old year
$w icursor $icursor
bell
return -code break
}
return -code break
}
# internal routine that returns the last valid day of a given month and year
if {$icursor < 7} { # 1st digit of year
if {($char ne "1") && ($char ne "2")} {
bell
return -code break
}
if {$char != $y1} { # Different century
set y 1999
if {$char eq "2"} {set y 2000}
$w delete 6 end
$w insert end $y
}
$w icursor 7
return -code break
}
$w delete $icursor
$w insert $icursor $char
if {[catch {clock scan [$w get] -format $Format($w)}] != 0} { # Validate the year
$w delete 6 end
$w insert end $year ;# Put back in the old year
$w icursor $icursor
bell
}
}
default { # ISO
foreach {year month day} [split [$w get] $Separator($w)] break
if {$icursor < 4} { # YEAR SECTION
set y1 [string range $year 0 0];
if {$icursor == 0} { # 1st digit of year
if {($char ne "1") && ($char ne "2")} {
bell
return -code break
}
if {$char != $y1} { # Different century
set y 1999
if {$char eq "2"} {set y 2000}
$w delete 0 4
$w insert 0 $y
}
$w icursor 1
return -code break
}
$w delete $icursor
$w insert $icursor $char
if {[catch {clock scan [$w get] -format $Format($w)}] != 0} { # Validate the year
$w delete 0 4
$w insert 0 $year ;# Put back in the old year
$w icursor $icursor
bell
}
if {$icursor == 3} { # last digit of year
$w icursor 5 ;# Don't land on a -
}
return -code break
}
if {$icursor < 7} { # MONTH SECTION
foreach {m1 m2} [split $month ""] break
set cursor 8 ;# Where to leave the cursor
if {$icursor == 5} { # 1st digit of month
if {$char < 2} {
set month "$char$m2"
set cursor 6
} else {
set month "0$char"
}
if {$month > 12} {set month "10"}
if {$month eq "00"} {set month "01"}
} else { # 2nd digit of month
set month "$m1$char"
if {$month > 12} {set month "0$char"}
if {$month eq "00"} {
bell
return -code break
}
}
$w delete 5 7
$w insert 5 $month
# Validate the day of the month
if {$day > [set endday [lastDay $month $year]]} {
$w delete 8 end
$w insert end $endday
}
$w icursor $cursor
return -code break
}
set endday [lastDay $month $year] ;# DAY SECTION
foreach {d1 d2} [split $day ""] break
set cursor 10 ;# Where to leave the cursor
if {$icursor == 8} { # 1st digit of day
if {($char < 3) \
|| (($char == 3) && ($month ne "02"))} {
set day "$char$d2"
if {$day eq "00"} {set day "01"}
if {$day > $endday} {set day $endday}
set cursor 9
} else {
set day "0$char"
}
} else { # 2nd digit of day
set day "$d1$char"
if {($day > $endday) || ($day eq "00")} {
bell
return -code break
}
}
$w delete 8 end
$w insert end $day
$w icursor $cursor
}
}
return -code break
}
# internal routine that returns the last valid day of a given month and year
proc lastDay {month year} {
set days [clock format [clock scan "+1 month -1 day" \
-base [clock scan "$month/01/$year"]] -format %d]
return [clock format [clock scan "+1 month -1 day" \
-base [clock scan "$month/01/$year"]] -format %d]
}
}
|
Changes to modules/datefield/pkgIndex.tcl.
1
|
1
|
-
+
|
package ifneeded datefield 0.2 [list source [file join $dir datefield.tcl]]
package ifneeded datefield 0.3 [list source [file join $dir datefield.tcl]]
|