Tk Library Source Code

Changes On Branch rfe-fa7e485702
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki
Hide Diff Patch Unified Diff

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
datefield with additional "-format" option to support Dates for German and ISO including MouseWheel-binding. Ticket [fa7e485702] check-in: 121f091d01 user: oehhar tags: trunk
2019-09-06
13:03
merge trunk Leaf check-in: 2d9c2d10ac user: oehhar tags: rfe-fa7e485702
2019-09-03
13:10
* doc/scrollutil.html Slightly extended. check-in: 9649a254c8 user: csaba tags: trunk
13:09
* doc/scrollutil.html Slightly extended. check-in: a441f84d42 user: csaba tags: trunk
2017-04-04
07:26
datefield with additional "-format" option to support Dates for German and ISO including MouseWheel-binding. Ticket [fa7e485702] 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

[comment {-*- tcl -*- doctools manpage}]
[manpage_begin datefield n 0.2]
[see_also clock(n)]
[see_also entry(n)]
[keywords clock]
[keywords date]
[keywords dateentry]
[keywords entry]
[keywords widget]
[copyright {Keith Vetter <[email protected]>}]

[moddesc {Tk datefield widget}]
[titledesc {Tk datefield widget}]
[category Widget]
[require Tk]
[require datefield [opt 0.2]]
[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.




[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]











See the [cmd entry] manual entry for details on all 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
 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]


|







|
>




|



|
>
>
|
>
>
>


















>
>
>
>
>
>
>
>
>
>
|
>












|












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.3]
[see_also clock(n)]
[see_also entry(n)]
[keywords clock]
[keywords date]
[keywords dateentry]
[keywords entry]
[keywords widget]
[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.3]]
[description]

The [package datefield] package provides the datefield widget which
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 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 -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

##+##########################################################################
#
# 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

#  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





#
##+##########################################################################
#############################################################################

package require Tk 8.0
package provide datefield 0.2

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























	eval $entry $w -width 10 -justify center $args



	$w insert end [clock format [clock seconds] -format "%m/%d/%Y"]
	$w icursor 0


	bind $w <KeyPress> [list ::datefield::KeyPress $w %A %K %s]

	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
    }







    # internal routine for all key presses in the datefield entry widget
    proc KeyPress {w char sym state} {






	set icursor [$w index insert]














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

	    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
	}

	# 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


















































    proc lastDay {month year} {
	set days [clock format [clock scan "+1 month -1 day" \
		-base [clock scan "$month/01/$year"]] -format %d]
    }
}













|
>







|
>
>
>
>
>





|















>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
|
<
|
>
|
>





>
|
>
>
>
>
>
>
>
>
>
>
>
|

>
>
>
>
>
>



>
>
>
>
>
>
|
>
>
>
>
|
>
>
>
>
>
>
>
>
>

|
>
>
|
>
>
>
>
>
|
>
>
>
>
>
|
|
|
>
|
<
|
|
|
|
|
>
>
>
>
|
|
|
>
>
>
|
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
|
<
>
>
>
>
>
>
|
|
>
|
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
>
>
>
|
>
|
>
>
>
|
<
>
|
>
|
|
>
>
|
|
|
|
>
>
>
|
<
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|
|
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
|
<
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|
|



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 \
#   -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
# 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.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 $Format($w)]

	}
	$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
    }

    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 [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
	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

			} 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

	    }
	}
	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

		}
		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 {$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
		}

		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
		}

		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
		}
	    }
	    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} {
	return [clock format [clock scan "+1 month -1 day" \
	 -base [clock scan "$month/01/$year"]] -format %d]
    }
}

Changes to modules/datefield/pkgIndex.tcl. 

1

package ifneeded datefield 0.2 [list source [file join $dir datefield.tcl]]

|

1

package ifneeded datefield 0.3 [list source [file join $dir datefield.tcl]]

This page was generated in about 0.022s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19