diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | library/clock.tcl | 773 |
2 files changed, 449 insertions, 328 deletions
@@ -1,7 +1,9 @@ 2005-12-01 Kevin B. Kenny <kennykb@acm.org> * library/clock.tcl: Continued rationalizing the code, eliminating - numerous redundant [mc] calls. + numerous redundant [mc] calls. Added another time boost by + precompiling a [::format] command to do the bulk of the work + of [clock format]. 2005-12-01 Donal K. Fellows <donal.k.fellows@manchester.ac.uk> diff --git a/library/clock.tcl b/library/clock.tcl index 3b3aa6d..c24a589 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: clock.tcl,v 1.24 2005/12/01 20:50:37 kennykb Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.25 2005/12/01 22:38:05 kennykb Exp $ # #---------------------------------------------------------------------- @@ -673,7 +673,7 @@ proc ::tcl::clock::format { args } { set format {%a %b %d %H:%M:%S %z %Y} set gmt 0 set locale C - set timezone [GetSystemTimeZone] + set timezone {} # Pick up command line options. @@ -708,11 +708,11 @@ proc ::tcl::clock::format { args } { -errorcode [list CLOCK gmtWithTimezone] \ "cannot use -gmt and -timezone in same call" } - if { [catch { expr { wide($clockval) } } result] } { + if { ![string is wide -strict $clockval] } { return -code error \ "expected integer but got \"$clockval\"" } - if { ![string is boolean $gmt] } { + if { ![string is boolean -strict $gmt] } { return -code error \ "expected boolean value but got \"$gmt\"" } else { @@ -721,387 +721,500 @@ proc ::tcl::clock::format { args } { } } + # Get the data for time changes in the given zone + + if {$timezone eq ""} { + set timezone [GetSystemTimeZone] + } + if {[catch {SetupTimeZone $timezone} retval opts]} { + dict unset opts -errorinfo + return -options $opts $retval + } + + # Extract the fields of the date. + + set date [GetDateFields $clockval \ + $TZData($timezone) \ + [mc GREGORIAN_CHANGE_DATE]] + + # Format the result + + set formatter [ParseClockFormatFormat $format $locale] + return [$formatter $date $TZData($timezone)] + +} + +#---------------------------------------------------------------------- +# +# ParseClockFormatFormat -- +# +# Builds and caches a procedure that formats a time value. +# +# Parameters: +# format -- Format string to use +# locale -- Locale in which the format string is to be interpreted +# +# Results: +# Returns the name of the newly-built procedure. +# +#---------------------------------------------------------------------- + +proc ::tcl::clock::ParseClockFormatFormat {format locale} { + + set procName [namespace current]::formatproc'$format'$locale + if {[info procs $procName] != {}} { + return $procName + } + + # Map away the locale-dependent composite format groups + EnterLocale $locale oldLocale # Change locale if a fresh locale has been given on the command line. set status [catch { - # Map away the locale-dependent composite format groups + ParseClockFormatFormat2 $format $locale $procName + + } result opts] - set format [LocalizeFormat $locale $format] + # Restore the locale - # Convert the given time to local time. - - # Get the data for time changes in the given zone - - if {[catch {SetupTimeZone $timezone} retval opts]} { - dict unset opts -errorinfo - return -options $opts $retval + if { [info exists oldLocale] } { + mclocale $oldLocale + } + + # Return either the error or the proc name + + if { $status == 1 } { + if { [lindex [dict get $opts -errorcode] 0] eq {clock} } { + return -code error $result + } else { + return -options $opts $result } + } else { + return $result + } - # Extract the fields of the date. +} - set date [GetDateFields $clockval \ - $TZData($timezone) \ - [mc GREGORIAN_CHANGE_DATE]] - - # Format the result +proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} { - # TO BE: - # set formatter [ParseClockFormatFormat $format $locale] - # $formatter $date $TZData($timezone) $changeover + set didLocaleEra 0 + set didLocaleNumerals 0 + set preFormatCode {} + set formatString {} + set substituents {} + set state {} - set state {} - set retval {} - foreach char [split $format {}] { - switch -exact -- $state { - {} { - if { [string equal % $char] } { - set state percent - } else { - append retval $char - } + set format [LocalizeFormat $locale $format] + + foreach char [split $format {}] { + switch -exact -- $state { + {} { + if { [string equal % $char] } { + set state percent + } else { + append formatString $char } - percent { # Character following a '%' character - set state {} - switch -exact -- $char { - % { # A literal character, '%' - append retval % - } - a { # Day of week, abbreviated - set dow [expr { [dict get $date dayOfWeek] % 7 }] - append retval \ - [lindex [mc DAYS_OF_WEEK_ABBREV] $dow] - } - A { # Day of week, spelt out. - set dow [expr { [dict get $date dayOfWeek] % 7 }] - append retval [lindex [mc DAYS_OF_WEEK_FULL] $dow] - } - b - h { # Name of month, abbreviated. - set month [expr { [dict get $date month] - 1 }] - append retval [lindex [mc MONTHS_ABBREV] $month] - } - B { # Name of month, spelt out - set month [expr { [dict get $date month] - 1 }] - append retval [lindex [mc MONTHS_FULL] $month] - } - C { # Century number - set cent [expr { [dict get $date year] / 100 }] - append retval [::format %02d $cent] - } - d { # Day of month, with leading zero - append retval [::format %02d \ - [dict get $date dayOfMonth]] - } - e { # Day of month, without leading zero - append retval [::format %2d \ - [dict get $date dayOfMonth]] - } - E { # Format group in a locale-dependent + } + percent { # Character following a '%' character + set state {} + switch -exact -- $char { + % { # A literal character, '%' + append formatString %% + } + a { # Day of week, abbreviated + append formatString %s + append substituents \ + [string map \ + [list @DAYS_OF_WEEK_ABBREV@ \ + [list [mc DAYS_OF_WEEK_ABBREV]]] \ + { [lindex @DAYS_OF_WEEK_ABBREV@ \ + [expr {[dict get $date dayOfWeek] \ + % 7}]]}] + } + A { # Day of week, spelt out. + append formatString %s + append substituents \ + [string map \ + [list @DAYS_OF_WEEK_FULL@ \ + [list [mc DAYS_OF_WEEK_FULL]]] \ + { [lindex @DAYS_OF_WEEK_FULL@ \ + [expr {[dict get $date dayOfWeek] \ + % 7}]]}] + } + b - h { # Name of month, abbreviated. + append formatString %s + append substituents \ + [string map \ + [list @MONTHS_ABBREV@ \ + [list [mc MONTHS_ABBREV]]] \ + { [lindex @MONTHS_ABBREV@ \ + [expr {[dict get $date month]-1}]]}] + } + B { # Name of month, spelt out + append formatString %s + append substituents \ + [string map \ + [list @MONTHS_FULL@ \ + [list [mc MONTHS_FULL]]] \ + { [lindex @MONTHS_FULL@ \ + [expr {[dict get $date month]-1}]]}] + } + C { # Century number + append formatString %02d + append substituents \ + { [expr {[dict get $date year] / 100}]} + } + d { # Day of month, with leading zero + append formatString %02d + append substituents { [dict get $date dayOfMonth]} + } + e { # Day of month, without leading zero + append formatString %2d + append substituents { [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 {}]] - } + set state percentE + if {!$didLocaleEra} { + append preFormatCode \ + [string map \ + [list @LOCALE_ERAS@ \ + [list [mc LOCALE_ERAS]]] \ + { + set date [GetLocaleEra \ + $date[set date {}] \ + @LOCALE_ERAS@]}] + set didLocaleEra 1 } - g { # Two-digit year relative to ISO8601 - # week number - set year \ - [expr { [dict get $date iso8601Year] % 100 }] - append retval [::format %02d $year] + if {!$didLocaleNumerals} { + append preFormatCode \ + [list set localeNumerals \ + [mc LOCALE_NUMERALS]] \n + set didLocaleNumerals 1 } - G { # Four-digit year relative to ISO8601 + } + g { # Two-digit year relative to ISO8601 # week number - append retval [::format %04d \ - [dict get $date iso8601Year]] - } - H { # Hour in the 24-hour day, leading zero - append retval \ - [::format %02d \ - [expr { [dict get $date 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] - } - j { # Day of year (001-366) - append retval [::format %03d \ - [dict get $date dayOfYear]] - } - J { # Julian Day Number - append retval [::format %07ld \ - [dict get $date julianDay]] - } - k { # Hour (0-23), no leading zero - append retval \ - [::format %2d \ - [expr { [dict get $date 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] - } - m { # Month number, leading zero - append retval [::format %02d \ - [dict get $date month]] - } - M { # Minute of the hour, leading zero - append retval \ - [::format %02d \ - [expr { [dict get $date localSeconds] - / 60 - % 60 }]] - } - n { # A literal newline - append retval \n - } - N { # Month number, no leading zero - append retval [::format %2d \ - [dict get $date month]] - } - O { # A format group in the locale's + append formatString %02d + append substituents \ + { [expr { [dict get $date iso8601Year] % 100 }]} + } + G { # Four-digit year relative to ISO8601 + # week number + append formatString %02d + append substituents { [dict get $date iso8601Year]} + } + H { # Hour in the 24-hour day, leading zero + append formatString %02d + append substituents \ + { [expr { [dict get $date localSeconds] \ + / 3600 % 24}]} + } + I { # Hour AM/PM, with leading zero + append formatString %02d + append substituents \ + { [expr { ( ( ( [dict get $date localSeconds] \ + % 86400 ) \ + + 86400 \ + - 3600 ) \ + / 3600 ) \ + % 12 + 1 }] } + } + j { # Day of year (001-366) + append formatString %03d + append substituents { [dict get $date dayOfYear]} + } + J { # Julian Day Number + append formatString %07ld + append substituents { [dict get $date julianDay]} + } + k { # Hour (0-23), no leading zero + append formatString %2d + append substituents \ + { [expr { [dict get $date localSeconds] + / 3600 + % 24 }]} + } + l { # Hour (12-11), no leading zero + append formatString %2d + append substituents \ + { [expr { ( ( ( [dict get $date localSeconds] + % 86400 ) + + 86400 + - 3600 ) + / 3600 ) + % 12 + 1 }]} + } + m { # Month number, leading zero + append formatString %02d + append substituents { [dict get $date month]} + } + M { # Minute of the hour, leading zero + append formatString %02d + append substituents \ + { [expr { [dict get $date localSeconds] + / 60 + % 60 }]} + } + n { # A literal newline + append formatString \n + } + N { # Month number, no leading zero + append formatString %2d + append substituents { [dict get $date month]} + } + O { # A format group in the locale's # alternative numerals - set state percentO + set state percentO + if {!$didLocaleNumerals} { + append preFormatCode \ + [list set localeNumerals \ + [mc LOCALE_NUMERALS]] \n + set didLocaleNumerals 1 } - p { # Localized 'AM' or 'PM' indicator + } + 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]] - } - } - 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] - } - } - Q { # Hi, Jeff! - append retval [FormatStarDate $date] - } - s { # Seconds from the Posix Epoch - append retval $clockval - } - S { # Second of the minute, with - # leading zero - append retval \ - [::format %02d \ - [expr { [dict get $date localSeconds] - % 60 }]] - } - t { # A literal tab character - append retval \t - } - u { # Day of the week (1-Monday, 7-Sunday) - append retval [dict get $date dayOfWeek] - } - U { # Week of the year (00-53). The + append formatString %s + append preFormatCode \ + [list set AM [string toupper [mc AM]]] \n \ + [list set PM [string toupper [mc PM]]] \n + append substituents \ + { [expr {(([dict get $date localSeconds] + % 86400) < 43200) ? + $AM : $PM}]} + } + P { # Localized 'AM' or 'PM' indicator + append formatString %s + append preFormatCode \ + [list set am [mc AM]] \n \ + [list set pm [mc PM]] \n + append substituents \ + { [expr {(([dict get $date localSeconds] + % 86400) < 43200) ? + $am : $pm}]} + + } + Q { # Hi, Jeff! + append formatString %s + append substituents { [FormatStarDate $date]} + } + s { # Seconds from the Posix Epoch + append formatString %s + append substituents { [dict get $date seconds]} + } + S { # Second of the minute, with + # leading zero + append formatString %02d + append substituents \ + { [expr { [dict get $date localSeconds] + % 60 }]} + } + t { # A literal tab character + append formatString \t + } + u { # Day of the week (1-Monday, 7-Sunday) + append formatString %1d + append substituents { [dict get $date dayOfWeek]} + } + U { # Week of the year (00-53). The # first Sunday of the year is the # first day of week 01 + append formatString %02d + append preFormatCode { set dow [dict get $date dayOfWeek] if { $dow == 7 } { set dow 0 } incr dow - set weekNumber \ + set UweekNumber \ [expr { ( [dict get $date dayOfYear] - $dow + 7 ) / 7 }] - append retval [::format %02d $weekNumber] } - V { # The ISO8601 week number - append retval [::format %02d \ - [dict get $date iso8601Week]] - } - w { # Day of the week (0-Sunday, + append substituents { $UweekNumber} + } + V { # The ISO8601 week number + append formatString %02d + append substituents { [dict get $date iso8601Week]} + } + w { # Day of the week (0-Sunday, # 6-Saturday) - append retval \ - [expr { [dict get $date dayOfWeek] % 7 }] - } - W { # Week of the year (00-53). The first + append formatString %1d + append substituents \ + { [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 \ + append preFormatCode { + set WweekNumber \ [expr { ( [dict get $date dayOfYear] - [dict get $date dayOfWeek] + 7 ) / 7 }] - append retval [::format %02d $weekNumber] - } - y { # The two-digit year of the century - append retval \ - [::format %02d \ - [expr { [dict get $date year] % 100 }]] } - Y { # The four-digit year - append retval [::format %04d \ - [dict get $date year]] - } - z { # The time zone as hours and minutes + append formatString %02d + append substituents { $Wweeknumber} + } + y { # The two-digit year of the century + append formatString %02d + append substituents \ + { [expr { [dict get $date year] % 100 }]} + } + Y { # The four-digit year + append formatString %04d + append substituents { [dict get $date year]} + } + z { # The time zone as hours and minutes # east (+) or west (-) of Greenwich - append retval [FormatNumericTimeZone \ - [dict get $date tzOffset]] - } - Z { # The name of the time zone - append retval [dict get $date tzName] - } - % { # A literal percent character - append retval % - } - default { # An unknown escape sequence - append retval % $char - } + append formatString %s + append substituents { [FormatNumericTimeZone \ + [dict get $date tzOffset]]} + } + Z { # The name of the time zone + append formatString %s + append substituents { [dict get $date tzName]} + } + % { # A literal percent character + append formatString %% + } + default { # An unknown escape sequence + append formatString %% $char } } - percentE { # Character following %E - set state {} - switch -exact -- $char { - C { # Locale-dependent era - append retval [dict get $date localeEra] - } - y { # Locale-dependent year of the era + } + percentE { # Character following %E + set state {} + switch -exact -- $char { + C { # Locale-dependent era + append formatString %s + append substituents { [dict get $date localeEra]} + } + y { # Locale-dependent year of the era + append preFormatCode { set y [dict get $date localeYear] if { $y >= 0 && $y < 100 } { - append retval [lindex [mc LOCALE_NUMERALS] $y] + set Eyear [lindex $localeNumerals $y] } else { - append retval $y + set Eyear $y } } - default { # Unknown format group - append retval %E $char - } + append formatString %s + append substituents { $Eyear} + } + default { # Unknown %E format group + append formatString %%E $char } } - percentO { # Character following %O - set state {} - switch -exact -- $char { - d - e { # Day of the month in alternative - # numerals - append retval [lindex \ - [mc LOCALE_NUMERALS] \ - [dict get $date dayOfMonth]] - } - H - k { # Hour of the day in alternative + } + percentO { # Character following %O + set state {} + switch -exact -- $char { + d - e { # Day of the month in alternative + # numerals + append formatString %s + append substituents \ + { [lindex $localeNumerals \ + [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] - } - I - l { # Hour (12-11) AM/PM in alternative + append formatString %s + append substituents \ + { [lindex $localeNumerals \ + [expr { [dict get $date localSeconds] + / 3600 + % 24 }]]} + } + 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] - } - m { # Month number in alternative numerals - append retval [lindex \ - [mc LOCALE_NUMERALS] \ - [dict get $date month]] - } - M { # Minute of the hour in alternative + append formatString %s + append substituents \ + { [lindex $localeNumerals \ + [expr { ( ( ( [dict get $date localSeconds] + % 86400 ) + + 86400 + - 3600 ) + / 3600 ) + % 12 + 1 }]]} + } + m { # Month number in alternative numerals + append formatString %s + append substituents \ + { [lindex $localeNumerals [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] - } - S { # Second of the minute in alternative + append formatString %s + append substituents \ + { [lindex $localeNumerals \ + [expr { [dict get $date localSeconds] + / 60 + % 60 }]]} + } + S { # Second of the minute in alternative # numerals - set second [expr { [dict get $date localSeconds] - % 60 }] - append retval [lindex [mc LOCALE_NUMERALS] $second] - } - u { # Day of the week (Monday=1,Sunday=7) + append formatString %s + append substituents \ + { [lindex $localeNumerals \ + [expr { [dict get $date localSeconds] + % 60 }]]} + } + 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 + append substituents \ + { [lindex $localeNumerals \ + [dict get $date dayOfWeek]]} } - w { # Day of the week (Sunday=0,Saturday=6) + w { # Day of the week (Sunday=0,Saturday=6) # in alternative numerals - append retval \ - [lindex \ - [mc LOCALE_NUMERALS] \ - [expr { [dict get $date dayOfWeek] % 7 }]] - } - y { # Year of the century in alternative + append formatString %s + append substituents \ + { [lindex $localeNumerals \ + [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 }]] - } - default { # Unknown format group - append retval %O $char - } + append formatString %s + append substituents \ + { [lindex $localeNumerals \ + [expr { [dict get $date year] % 100 }]]} + } + default { # Unknown format group + append formatString %%O $char } } } } + } - # Clean up any improperly terminated groups - - switch -exact -- $state { - percent { - append retval % - } - percentE { - append retval %E - } - percentO { - append retval %O - } + # Clean up any improperly terminated groups + + switch -exact -- $state { + percent { + append formatString %% } - - set retval - - } result opts] - - # Restore the locale - - if { [info exists oldLocale] } { - mclocale $oldLocale - } - - if { $status == 1 } { - if { [lindex [dict get $opts -errorcode] 0] eq {clock} } { - return -code error $result - } else { - return -options $opts $result + percentE { + append retval %%E + } + percentO { + append retval %%O } - } else { - return $result } + proc $procName {date changeover} " + $preFormatCode + return \[::format [list $formatString] $substituents\] + " + + # puts [list $procName [info args $procName] [info body $procName]] + + return $procName } #---------------------------------------------------------------------- @@ -1443,13 +1556,6 @@ proc ::tcl::clock::FreeScan { string base timezone locale } { proc ::tcl::clock::ParseClockScanFormat {formatString locale} { - variable DateParseActions - variable TimeParseActions - - # Condense whitespace - - regsub -all {[[:space:]]+} $formatString { } formatString - # Check whether the format has been parsed previously, and return # the existing recognizer if it has. @@ -1458,8 +1564,17 @@ proc ::tcl::clock::ParseClockScanFormat {formatString locale} { return $procName } + variable DateParseActions + variable TimeParseActions + + # Localize the %x, %X, etc. groups + set formatString [LocalizeFormat $locale $formatString] + # Condense whitespace + + regsub -all {[[:space:]]+} $formatString { } formatString + # Walk through the groups of the format string. In this loop, we # accumulate: # - a regular expression that matches the string, @@ -3877,6 +3992,8 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } { # date - Dictionary that must contain the keys, 'localSeconds', # whose value is expressed as the appropriate local time; # and 'year', whose value is the Gregorian year. +# etable - Value of the LOCALE_ERAS key in the message catalogue +# for the target locale. # # Results: # Returns the dictionary, augmented with the keys, 'localeEra' @@ -3884,9 +4001,8 @@ proc ::tcl::clock::DeterminePosixDSTTime { z bound y } { # #---------------------------------------------------------------------- -proc ::tcl::clock::GetLocaleEra { date } { +proc ::tcl::clock::GetLocaleEra { date etable } { - set etable [mc LOCALE_ERAS] set index [BSearch $etable [dict get $date localSeconds]] if { $index < 0 } { dict set date localeEra \ @@ -4493,6 +4609,9 @@ proc ::tcl::clock::ClearCaches {} { foreach p [info procs [namespace current]::scanproc'*] { rename $p {} } + foreach p [info procs [namespace current]::formatproc'*] { + rename $p {} + } set LocaleNumeralCache {} set McLoaded {} |