Attachment "clock.patch" to
ticket [1361927fff]
added by
msofer
2005-11-20 21:27:21.
Index: library/clock.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/clock.tcl,v
retrieving revision 1.20
diff -u -r1.20 clock.tcl
--- library/clock.tcl 4 Nov 2005 20:13:30 -0000 1.20
+++ library/clock.tcl 20 Nov 2005 14:23:51 -0000
@@ -638,13 +638,11 @@
#
#----------------------------------------------------------------------
-proc ::tcl::clock::format { args } {
-
- set format {}
+proc ::tcl::clock::format { {clockval {}} args } {
# Check the count of args
- if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
+ if { ($clockval eq {}) || [llength $args] % 2 } {
return -code error \
-errorcode [list CLOCK wrongNumArgs] \
"wrong \# args: should be\
@@ -653,9 +651,36 @@
?-locale LOCALE? ?-timezone ZONE?\""
}
+ set procName formatproc'$args'
+ if { [info procs $procName] eq {} } {
+ set status [catch {
+ MakeFormatProc $procName $args
+ } result opts]
+ } else {
+ set status 0
+ }
+
+ if {!$status} {
+ set status [catch {
+ $procName $clockval
+ } result opts]
+ }
+
+ if { $status == 1 } {
+ if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
+ return -code error $result
+ } else {
+ return -options $opts $result
+ }
+ } else {
+ return $result
+ }
+}
+
+proc ::tcl::clock::MakeFormatProc {procName argList} {
+
# Set defaults
- set clockval [lindex $args 0]
set format {%a %b %d %H:%M:%S %z %Y}
set gmt 0
set locale C
@@ -663,7 +688,7 @@
# Pick up command line options.
- foreach { flag value } [lreplace $args 0 0] {
+ foreach { flag value } $argList {
set saw($flag) {}
switch -exact -- $flag {
-format {
@@ -694,10 +719,6 @@
-errorcode [list CLOCK gmtWithTimezone] \
"cannot use -gmt and -timezone in same call"
}
- if { [catch { expr { wide($clockval) } } result] } {
- return -code error \
- "expected integer but got \"$clockval\""
- }
if { ![string is boolean $gmt] } {
return -code error \
"expected boolean value but got \"$gmt\""
@@ -707,6 +728,26 @@
}
}
+ set procBody [string map [list @TMZ@ $timezone] {
+ if { [catch { expr { wide($clockval) } } result] } {
+ return -code error \
+ "expected integer but got \"$clockval\""
+ }
+
+ # Convert the given time to local time.
+
+ set date [dict create seconds $clockval]
+ set date [ConvertUTCToLocal $date[set date {}] @TMZ@]
+
+ # Extract the fields of the date.
+
+ set date [GetJulianDay $date[set date {}]]
+ set date [GetGregorianEraYearDay $date[set date {}]]
+ set date [GetMonthDay $date[set date {}]]
+ set date [GetYearWeekDay $date[set date {}]]
+ set localSeconds [dict get $date localSeconds]
+ }]
+
EnterLocale $locale oldLocale
# Change locale if a fresh locale has been given on the command line.
@@ -717,143 +758,141 @@
set format [LocalizeFormat $locale $format]
- # Convert the given time to local time.
-
- set date [dict create seconds $clockval]
- set date [ConvertUTCToLocal $date[set date {}] $timezone]
-
- # Extract the fields of the date.
-
- set date [GetJulianDay $date[set date {}]]
- set date [GetGregorianEraYearDay $date[set date {}]]
- set date [GetMonthDay $date[set date {}]]
- set date [GetYearWeekDay $date[set date {}]]
-
- # Format the result
-
+ # Prepare the format string and arguments to [format]
+
set state {}
- set retval {}
+ set formatString {}
+ set formatArgs {}
+
foreach char [split $format {}] {
switch -exact -- $state {
{} {
if { [string equal % $char] } {
set state percent
} else {
- append retval $char
+ append formatString $char
}
}
percent { # Character following a '%' character
set state {}
switch -exact -- $char {
% { # A literal character, '%'
- append retval %
+ append formatString %%
}
a { # Day of week, abbreviated
- set dow [expr { [dict get $date dayOfWeek] % 7 }]
- append retval \
- [lindex [mc DAYS_OF_WEEK_ABBREV] $dow]
+ append formatString %s
+ set smap [list @DOW@ \{[mc DAYS_OF_WEEK_ABBREV]\}]
+ append formatArgs [string map $smap \
+ { [lindex @DOW@ [expr {[dict get $date dayOfWeek]%7}]] }]
}
A { # Day of week, spelt out.
- set dow [expr { [dict get $date dayOfWeek] % 7 }]
- append retval [lindex [mc DAYS_OF_WEEK_FULL] $dow]
+ append formatString %s
+ set smap [list @DOW@ \{[mc DAYS_OF_WEEK_FULL]\}]
+ append formatArgs [string map $smap \
+ { [lindex @DOW@ [expr {[dict get $date dayOfWeek]%7}]] }]
}
b - h { # Name of month, abbreviated.
- set month [expr { [dict get $date month] - 1 }]
- append retval [lindex [mc MONTHS_ABBREV] $month]
+ append formatString %s
+ set smap [list @MTH@ \{[mc MONTHS_ABBREV]\}]
+ append formatArgs [string map $smap\
+ { [lindex @MTH@ [expr {[dict get $date month]-1}]] }]
}
B { # Name of month, spelt out
- set month [expr { [dict get $date month] - 1 }]
- append retval [lindex [mc MONTHS_FULL] $month]
+ append formatString %s
+ set smap [list @MTH@ \{[mc MONTHS_FULL]\}]
+ append formatArgs [string map $smap\
+ { [lindex @MTH@ [expr {[dict get $date month]-1}]] }]
}
C { # Century number
- set cent [expr { [dict get $date year] / 100 }]
- append retval [::format %02d $cent]
+ append formatString %02d
+ append formatArgs { [
+ expr { [dict get $date year]/100 }
+ ] }
}
d { # Day of month, with leading zero
- append retval [::format %02d \
- [dict get $date dayOfMonth]]
+ append formatString %02d
+ append formatArgs { [dict get $date dayOfMonth] }
}
e { # Day of month, without leading zero
- append retval [::format %2d \
- [dict get $date dayOfMonth]]
+ append formatString %2d
+ append formatArgs { [dict get $date dayOfMonth] }
}
E { # Format group in a locale-dependent
# alternative era
set state percentE
- if { ![dict exists $date localeEra] } {
- set date [GetLocaleEra $date[set date {}]]
+ if {![info exists percentEUsed]} {
+ set percentEUsed 1
+ append procBody [string map [list @LOC@ $locale] {
+ EnterLocale @LOC@ oldLocale
+ set date [GetLocaleEra $date[set date {}]]
+ mclocale $oldLocale
+ }]
}
}
g { # Two-digit year relative to ISO8601
# week number
- set year \
- [expr { [dict get $date iso8601Year] % 100 }]
- append retval [::format %02d $year]
+ append formatString %02d
+ append formatArgs { \
+ [expr { [dict get $date iso8601Year] % 100 }] }
}
G { # Four-digit year relative to ISO8601
# week number
- append retval [::format %04d \
- [dict get $date iso8601Year]]
+ append formatString %04d
+ append formatArgs { [dict get $date iso8601Year] }
}
H { # Hour in the 24-hour day, leading zero
- append retval \
- [::format %02d \
- [expr { [dict get $date localSeconds]
- / 3600
- % 24 }]]
+ append formatString %02d
+ append formatArgs { \
+ [expr { $localSeconds / 3600 % 24 }] }
}
I { # Hour AM/PM, with leading zero
- set hour12 \
- [expr { ( ( ( [dict get $date localSeconds]
- % 86400 )
- + 86400
- - 3600 )
- / 3600 )
- % 12 + 1 }]
- append retval [::format %02d $hour12]
+ append formatString %02d
+ append formatArgs { \
+ [expr { ( ( ( $localSeconds
+ % 86400 )
+ + 86400
+ - 3600 )
+ / 3600 )
+ % 12 + 1 }] }
}
j { # Day of year (001-366)
- append retval [::format %03d \
- [dict get $date dayOfYear]]
+ append formatString %03d
+ append formatArgs { [dict get $date dayOfYear] }
}
J { # Julian Day Number
- append retval [::format %07ld \
- [dict get $date julianDay]]
+ append formatString %07ld
+ append formatArgs { [dict get $date julianDay] }
}
k { # Hour (0-23), no leading zero
- append retval \
- [::format %2d \
- [expr { [dict get $date localSeconds]
- / 3600
- % 24 }]]
+ append formatString %2d
+ append formatArgs { \
+ [expr { $localSeconds / 3600 % 24 }] }
}
l { # Hour (12-11), no leading zero
- set hour12 \
- [expr { ( ( ( [dict get $date localSeconds]
- % 86400 )
- + 86400
- - 3600 )
- / 3600 )
- % 12 + 1 }]
- append retval [::format %2d $hour12]
+ append formatString %2d
+ append formatArgs { \
+ [expr { ( ( ( $localSeconds
+ % 86400 )
+ + 86400
+ - 3600 )
+ / 3600 )
+ % 12 + 1 }] }
}
m { # Month number, leading zero
- append retval [::format %02d \
- [dict get $date month]]
+ append formatString %02d
+ append formatArgs { [dict get $date month] }
}
M { # Minute of the hour, leading zero
- append retval \
- [::format %02d \
- [expr { [dict get $date localSeconds]
- / 60
- % 60 }]]
+ append formatString %02d
+ append formatArgs { \
+ [expr { $localSeconds / 60 % 60 }] }
}
n { # A literal newline
- append retval \n
+ append formatString \n
}
N { # Month number, no leading zero
- append retval [::format %2d \
- [dict get $date month]]
+ append formatString %2d
+ append formatArgs { [dict get $date month] }
}
O { # A format group in the locale's
# alternative numerals
@@ -861,97 +900,105 @@
}
p { # Localized 'AM' or 'PM' indicator
# converted to uppercase
- set tod [expr { [dict get $date localSeconds]
- % 86400 }]
- if { $tod >= ( 86400 / 2 ) } {
- append retval [string toupper [mc PM]]
- } else {
- append retval [string toupper [mc AM]]
- }
+ append formatString %s
+ set smap [list \
+ @PM@ [string toupper [mc PM]] \
+ @AM@ [string toupper [mc AM]]]
+ append formatArgs [string map $smap { \
+ [set tod [expr { $localSeconds % 86400 }];\
+ expr {($tod >= ( 86400 / 2 ))?
+ "@PM@" : "@AM@" }] }]
}
P { # Localized 'AM' or 'PM' indicator
- set tod [expr { [dict get $date localSeconds]
- % 86400 }]
- if { $tod >= ( 86400 / 2 ) } {
- append retval [mc PM]
- } else {
- append retval [mc AM]
- }
+ append formatString %s
+ set smap [list @PM@ [mc PM] @AM@ [mc AM]]
+ append formatArgs [string map $smap { \
+ [set tod [expr { $localSeconds % 86400 }];\
+ expr {($tod >= ( 86400 / 2 ))?
+ "@PM@" : "@AM@" }] }]
}
Q { # Hi, Jeff!
- append retval [FormatStarDate $date]
+ append formatString %s
+ append formatArgs { [FormatStarDate $date] }
}
s { # Seconds from the Posix Epoch
- append retval $clockval
+ append formatString %s
+ append formatArgs { $clockval }
}
S { # Second of the minute, with
# leading zero
- append retval \
- [::format %02d \
- [expr { [dict get $date localSeconds]
- % 60 }]]
+ append formatString %02d
+ append formatArgs { [expr { $localSeconds % 60}] }
}
t { # A literal tab character
- append retval \t
+ append formatString \t
}
u { # Day of the week (1-Monday, 7-Sunday)
- append retval [dict get $date dayOfWeek]
+ append formatString %s
+ append formatArgs { [dict get $date dayOfWeek] }
}
U { # Week of the year (00-53). The
# first Sunday of the year is the
# first day of week 01
- set dow [dict get $date dayOfWeek]
- if { $dow == 7 } {
- set dow 0
- }
- incr dow
- set weekNumber \
- [expr { ( [dict get $date dayOfYear]
- - $dow + 7 )
- / 7 }]
- append retval [::format %02d $weekNumber]
+ append formatString %02d
+ append formatArgs { [
+ set dow [dict get $date dayOfWeek]
+ if { $dow == 7 } {
+ set dow 0
+ }
+ incr dow
+ expr { ( [dict get $date dayOfYear]
+ - $dow + 7 ) / 7 }
+ ] }
}
V { # The ISO8601 week number
- append retval [::format %02d \
- [dict get $date iso8601Week]]
+ append formatString %02d
+ append formatArgs { [dict get $date iso8601Week] }
}
w { # Day of the week (0-Sunday,
# 6-Saturday)
- append retval \
- [expr { [dict get $date dayOfWeek] % 7 }]
+ append formatString %s
+ append formatArgs { [
+ expr { [dict get $date dayOfWeek] % 7 }
+ ] }
}
W { # Week of the year (00-53). The first
# Monday of the year is the first day
# of week 01.
- set weekNumber \
- [expr { ( [dict get $date dayOfYear]
- - [dict get $date dayOfWeek]
- + 7 )
- / 7 }]
- append retval [::format %02d $weekNumber]
+ append formatString %02d
+ append formatArgs { [
+ expr { ( [dict get $date dayOfYear]
+ - [dict get $date dayOfWeek]
+ + 7 )
+ / 7 }
+ ] }
}
y { # The two-digit year of the century
- append retval \
- [::format %02d \
- [expr { [dict get $date year] % 100 }]]
+ append formatString %02d
+ append formatArgs { [
+ expr { [dict get $date year] % 100 }
+ ] }
}
Y { # The four-digit year
- append retval [::format %04d \
- [dict get $date year]]
+ append formatString %04d
+ append formatArgs { [dict get $date year] }
}
z { # The time zone as hours and minutes
# east (+) or west (-) of Greenwich
- append retval [FormatNumericTimeZone \
- [dict get $date tzOffset]]
+ append formatString %s
+ append formatArgs { [
+ FormatNumericTimeZone [dict get $date tzOffset]
+ ] }
}
Z { # The name of the time zone
- append retval [dict get $date tzName]
+ append formatString %s
+ append formatArgs { [dict get $date tzName] }
}
% { # A literal percent character
- append retval %
+ append formatArgs %%
}
default { # An unknown escape sequence
- append retval % $char
+ append formatString %%$char
}
}
}
@@ -959,18 +1006,20 @@
set state {}
switch -exact -- $char {
C { # Locale-dependent era
- append retval [dict get $date localeEra]
+ append formatString %s
+ append formatArgs { [dict get $date localeEra] }
}
y { # Locale-dependent year of the era
- set y [dict get $date localeYear]
- if { $y >= 0 && $y < 100 } {
- append retval [lindex [mc LOCALE_NUMERALS] $y]
- } else {
- append retval $y
- }
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ set y [dict get $date localeYear]
+ expr {($y >= 0 && $y < 100) ?
+ [lindex @LN@ $y] : $y }
+ ] }]
}
default { # Unknown format group
- append retval %E $char
+ append formatString %%E$char
}
}
}
@@ -979,68 +1028,89 @@
switch -exact -- $char {
d - e { # Day of the month in alternative
# numerals
- append retval [lindex \
- [mc LOCALE_NUMERALS] \
- [dict get $date dayOfMonth]]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ lindex @LN@ [dict get $date dayOfMonth]
+ ] }]
}
H - k { # Hour of the day in alternative
# numerals
- set hour [expr { [dict get $date localSeconds]
- / 3600
- % 24 }]
- append retval [lindex [mc LOCALE_NUMERALS] $hour]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ set hour [expr { $localSeconds / 3600 % 24 }]
+ lindex @LN@ $hour
+ ] }]
}
I - l { # Hour (12-11) AM/PM in alternative
# numerals
- set hour12 \
- [expr { ( ( ( [dict get $date localSeconds]
- % 86400 )
- + 86400
- - 3600 )
- / 3600 )
- % 12 + 1 }]
- append retval [lindex [mc LOCALE_NUMERALS] $hour12]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ set hour12 [expr {
+ ( ( ( $localSeconds
+ % 86400 )
+ + 86400
+ - 3600 )
+ / 3600 )
+ % 12 + 1 }]
+ lindex @LN@ $hour12
+ ] }]
}
m { # Month number in alternative numerals
- append retval [lindex \
- [mc LOCALE_NUMERALS] \
- [dict get $date month]]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ lindex @LN@ [dict get $date month]
+ ] }]
}
M { # Minute of the hour in alternative
# numerals
- set minute [expr { [dict get $date localSeconds]
- / 60
- % 60 }]
- append retval [lindex [mc LOCALE_NUMERALS] $minute]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ set minute [expr { $localSeconds
+ / 60
+ % 60 }]
+ lindex @LN@ $minute
+ ] }]
}
S { # Second of the minute in alternative
# numerals
- set second [expr { [dict get $date localSeconds]
- % 60 }]
- append retval [lindex [mc LOCALE_NUMERALS] $second]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ set second [expr { $localSeconds% 60 }]
+ lindex @LN@ $second
+ ] }]
}
u { # Day of the week (Monday=1,Sunday=7)
# in alternative numerals
- append retval [lindex \
- [mc LOCALE_NUMERALS] \
- [dict get $date dayOfWeek]]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ lindex @LN@ [dict get $date dayOfWeek]
+ ] }]
}
w { # Day of the week (Sunday=0,Saturday=6)
# in alternative numerals
- append retval \
- [lindex \
- [mc LOCALE_NUMERALS] \
- [expr { [dict get $date dayOfWeek] % 7 }]]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ lindex @LN@ [expr {[dict get $date dayOfWeek]%7}]
+ ] }]
}
y { # Year of the century in alternative
# numerals
- append retval \
- [lindex \
- [mc LOCALE_NUMERALS] \
- [expr { [dict get $date year] % 100 }]]
+ append formatString %s
+ set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+ append formatArgs [string map $smap { [
+ lindex @LN@ [expr { [dict get $date year] % 100 }]
+ ] }]
}
default { # Unknown format group
- append retval %O $char
+ append formatString %%O$char
}
}
}
@@ -1051,18 +1121,16 @@
switch -exact -- $state {
percent {
- append retval %
+ append formatString %%
}
percentE {
- append retval %E
+ append formatString %%E
}
percentO {
- append retval %O
+ append formatString %%O
}
}
- set retval
-
} result opts]
# Restore the locale
@@ -1078,7 +1146,8 @@
return -options $opts $result
}
} else {
- return $result
+ append procBody "::format \"$formatString\" $formatArgs\n"
+ proc $procName clockval $procBody
}
}
