Mercurial > repos > rliterman > csp2

annotate CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tcl8.6/clock.tcl @ 69:33d812a61356

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 2e9511a184a1ca667c7be0c6321a36dc4e3d116d
author jpayne
date Tue, 18 Mar 2025 17:55:14 -0400
parents
children
rev   line source
jpayne@69 1 #----------------------------------------------------------------------
jpayne@69 2 #
jpayne@69 3 # clock.tcl --
jpayne@69 4 #
jpayne@69 5 # This file implements the portions of the [clock] ensemble that are
jpayne@69 6 # coded in Tcl. Refer to the users' manual to see the description of
jpayne@69 7 # the [clock] command and its subcommands.
jpayne@69 8 #
jpayne@69 9 #
jpayne@69 10 #----------------------------------------------------------------------
jpayne@69 11 #
jpayne@69 12 # Copyright (c) 2004-2007 Kevin B. Kenny
jpayne@69 13 # See the file "license.terms" for information on usage and redistribution
jpayne@69 14 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
jpayne@69 15 #
jpayne@69 16 #----------------------------------------------------------------------
jpayne@69 17
jpayne@69 18 # We must have message catalogs that support the root locale, and we need
jpayne@69 19 # access to the Registry on Windows systems.
jpayne@69 20
jpayne@69 21 uplevel \#0 {
jpayne@69 22 package require msgcat 1.6
jpayne@69 23 if { $::tcl_platform(platform) eq {windows} } {
jpayne@69 24 if { [catch { package require registry 1.1 }] } {
jpayne@69 25 namespace eval ::tcl::clock [list variable NoRegistry {}]
jpayne@69 26 }
jpayne@69 27 }
jpayne@69 28 }
jpayne@69 29
jpayne@69 30 # Put the library directory into the namespace for the ensemble so that the
jpayne@69 31 # library code can find message catalogs and time zone definition files.
jpayne@69 32
jpayne@69 33 namespace eval ::tcl::clock \
jpayne@69 34 [list variable LibDir [file dirname [info script]]]
jpayne@69 35
jpayne@69 36 #----------------------------------------------------------------------
jpayne@69 37 #
jpayne@69 38 # clock --
jpayne@69 39 #
jpayne@69 40 # Manipulate times.
jpayne@69 41 #
jpayne@69 42 # The 'clock' command manipulates time. Refer to the user documentation for
jpayne@69 43 # the available subcommands and what they do.
jpayne@69 44 #
jpayne@69 45 #----------------------------------------------------------------------
jpayne@69 46
jpayne@69 47 namespace eval ::tcl::clock {
jpayne@69 48
jpayne@69 49 # Export the subcommands
jpayne@69 50
jpayne@69 51 namespace export format
jpayne@69 52 namespace export clicks
jpayne@69 53 namespace export microseconds
jpayne@69 54 namespace export milliseconds
jpayne@69 55 namespace export scan
jpayne@69 56 namespace export seconds
jpayne@69 57 namespace export add
jpayne@69 58
jpayne@69 59 # Import the message catalog commands that we use.
jpayne@69 60
jpayne@69 61 namespace import ::msgcat::mcload
jpayne@69 62 namespace import ::msgcat::mclocale
jpayne@69 63 namespace import ::msgcat::mc
jpayne@69 64 namespace import ::msgcat::mcpackagelocale
jpayne@69 65
jpayne@69 66 }
jpayne@69 67
jpayne@69 68 #----------------------------------------------------------------------
jpayne@69 69 #
jpayne@69 70 # ::tcl::clock::Initialize --
jpayne@69 71 #
jpayne@69 72 # Finish initializing the 'clock' subsystem
jpayne@69 73 #
jpayne@69 74 # Results:
jpayne@69 75 # None.
jpayne@69 76 #
jpayne@69 77 # Side effects:
jpayne@69 78 # Namespace variable in the 'clock' subsystem are initialized.
jpayne@69 79 #
jpayne@69 80 # The '::tcl::clock::Initialize' procedure initializes the namespace variables
jpayne@69 81 # and root locale message catalog for the 'clock' subsystem. It is broken
jpayne@69 82 # into a procedure rather than simply evaluated as a script so that it will be
jpayne@69 83 # able to use local variables, avoiding the dangers of 'creative writing' as
jpayne@69 84 # in Bug 1185933.
jpayne@69 85 #
jpayne@69 86 #----------------------------------------------------------------------
jpayne@69 87
jpayne@69 88 proc ::tcl::clock::Initialize {} {
jpayne@69 89
jpayne@69 90 rename ::tcl::clock::Initialize {}
jpayne@69 91
jpayne@69 92 variable LibDir
jpayne@69 93
jpayne@69 94 # Define the Greenwich time zone
jpayne@69 95
jpayne@69 96 proc InitTZData {} {
jpayne@69 97 variable TZData
jpayne@69 98 array unset TZData
jpayne@69 99 set TZData(:Etc/GMT) {
jpayne@69 100 {-9223372036854775808 0 0 GMT}
jpayne@69 101 }
jpayne@69 102 set TZData(:GMT) $TZData(:Etc/GMT)
jpayne@69 103 set TZData(:Etc/UTC) {
jpayne@69 104 {-9223372036854775808 0 0 UTC}
jpayne@69 105 }
jpayne@69 106 set TZData(:UTC) $TZData(:Etc/UTC)
jpayne@69 107 set TZData(:localtime) {}
jpayne@69 108 }
jpayne@69 109 InitTZData
jpayne@69 110
jpayne@69 111 mcpackagelocale set {}
jpayne@69 112 ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs]
jpayne@69 113 ::msgcat::mcpackageconfig set unknowncmd ""
jpayne@69 114 ::msgcat::mcpackageconfig set changecmd ChangeCurrentLocale
jpayne@69 115
jpayne@69 116 # Define the message catalog for the root locale.
jpayne@69 117
jpayne@69 118 ::msgcat::mcmset {} {
jpayne@69 119 AM {am}
jpayne@69 120 BCE {B.C.E.}
jpayne@69 121 CE {C.E.}
jpayne@69 122 DATE_FORMAT {%m/%d/%Y}
jpayne@69 123 DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y}
jpayne@69 124 DAYS_OF_WEEK_ABBREV {
jpayne@69 125 Sun Mon Tue Wed Thu Fri Sat
jpayne@69 126 }
jpayne@69 127 DAYS_OF_WEEK_FULL {
jpayne@69 128 Sunday Monday Tuesday Wednesday Thursday Friday Saturday
jpayne@69 129 }
jpayne@69 130 GREGORIAN_CHANGE_DATE 2299161
jpayne@69 131 LOCALE_DATE_FORMAT {%m/%d/%Y}
jpayne@69 132 LOCALE_DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y}
jpayne@69 133 LOCALE_ERAS {}
jpayne@69 134 LOCALE_NUMERALS {
jpayne@69 135 00 01 02 03 04 05 06 07 08 09
jpayne@69 136 10 11 12 13 14 15 16 17 18 19
jpayne@69 137 20 21 22 23 24 25 26 27 28 29
jpayne@69 138 30 31 32 33 34 35 36 37 38 39
jpayne@69 139 40 41 42 43 44 45 46 47 48 49
jpayne@69 140 50 51 52 53 54 55 56 57 58 59
jpayne@69 141 60 61 62 63 64 65 66 67 68 69
jpayne@69 142 70 71 72 73 74 75 76 77 78 79
jpayne@69 143 80 81 82 83 84 85 86 87 88 89
jpayne@69 144 90 91 92 93 94 95 96 97 98 99
jpayne@69 145 }
jpayne@69 146 LOCALE_TIME_FORMAT {%H:%M:%S}
jpayne@69 147 LOCALE_YEAR_FORMAT {%EC%Ey}
jpayne@69 148 MONTHS_ABBREV {
jpayne@69 149 Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
jpayne@69 150 }
jpayne@69 151 MONTHS_FULL {
jpayne@69 152 January February March
jpayne@69 153 April May June
jpayne@69 154 July August September
jpayne@69 155 October November December
jpayne@69 156 }
jpayne@69 157 PM {pm}
jpayne@69 158 TIME_FORMAT {%H:%M:%S}
jpayne@69 159 TIME_FORMAT_12 {%I:%M:%S %P}
jpayne@69 160 TIME_FORMAT_24 {%H:%M}
jpayne@69 161 TIME_FORMAT_24_SECS {%H:%M:%S}
jpayne@69 162 }
jpayne@69 163
jpayne@69 164 # Define a few Gregorian change dates for other locales. In most cases
jpayne@69 165 # the change date follows a language, because a nation's colonies changed
jpayne@69 166 # at the same time as the nation itself. In many cases, different
jpayne@69 167 # national boundaries existed; the dominating rule is to follow the
jpayne@69 168 # nation's capital.
jpayne@69 169
jpayne@69 170 # Italy, Spain, Portugal, Poland
jpayne@69 171
jpayne@69 172 ::msgcat::mcset it GREGORIAN_CHANGE_DATE 2299161
jpayne@69 173 ::msgcat::mcset es GREGORIAN_CHANGE_DATE 2299161
jpayne@69 174 ::msgcat::mcset pt GREGORIAN_CHANGE_DATE 2299161
jpayne@69 175 ::msgcat::mcset pl GREGORIAN_CHANGE_DATE 2299161
jpayne@69 176
jpayne@69 177 # France, Austria
jpayne@69 178
jpayne@69 179 ::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227
jpayne@69 180
jpayne@69 181 # For Belgium, we follow Southern Netherlands; Liege Diocese changed
jpayne@69 182 # several weeks later.
jpayne@69 183
jpayne@69 184 ::msgcat::mcset fr_BE GREGORIAN_CHANGE_DATE 2299238
jpayne@69 185 ::msgcat::mcset nl_BE GREGORIAN_CHANGE_DATE 2299238
jpayne@69 186
jpayne@69 187 # Austria
jpayne@69 188
jpayne@69 189 ::msgcat::mcset de_AT GREGORIAN_CHANGE_DATE 2299527
jpayne@69 190
jpayne@69 191 # Hungary
jpayne@69 192
jpayne@69 193 ::msgcat::mcset hu GREGORIAN_CHANGE_DATE 2301004
jpayne@69 194
jpayne@69 195 # Germany, Norway, Denmark (Catholic Germany changed earlier)
jpayne@69 196
jpayne@69 197 ::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
jpayne@69 198 ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
jpayne@69 199 ::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032
jpayne@69 200 ::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032
jpayne@69 201 ::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032
jpayne@69 202
jpayne@69 203 # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed at
jpayne@69 204 # various times)
jpayne@69 205
jpayne@69 206 ::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165
jpayne@69 207
jpayne@69 208 # Protestant Switzerland (Catholic cantons changed earlier)
jpayne@69 209
jpayne@69 210 ::msgcat::mcset fr_CH GREGORIAN_CHANGE_DATE 2361342
jpayne@69 211 ::msgcat::mcset it_CH GREGORIAN_CHANGE_DATE 2361342
jpayne@69 212 ::msgcat::mcset de_CH GREGORIAN_CHANGE_DATE 2361342
jpayne@69 213
jpayne@69 214 # English speaking countries
jpayne@69 215
jpayne@69 216 ::msgcat::mcset en GREGORIAN_CHANGE_DATE 2361222
jpayne@69 217
jpayne@69 218 # Sweden (had several changes onto and off of the Gregorian calendar)
jpayne@69 219
jpayne@69 220 ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390
jpayne@69 221
jpayne@69 222 # Russia
jpayne@69 223
jpayne@69 224 ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639
jpayne@69 225
jpayne@69 226 # Romania (Transylvania changed earler - perhaps de_RO should show the
jpayne@69 227 # earlier date?)
jpayne@69 228
jpayne@69 229 ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063
jpayne@69 230
jpayne@69 231 # Greece
jpayne@69 232
jpayne@69 233 ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480
jpayne@69 234
jpayne@69 235 #------------------------------------------------------------------
jpayne@69 236 #
jpayne@69 237 # CONSTANTS
jpayne@69 238 #
jpayne@69 239 #------------------------------------------------------------------
jpayne@69 240
jpayne@69 241 # Paths at which binary time zone data for the Olson libraries are known
jpayne@69 242 # to reside on various operating systems
jpayne@69 243
jpayne@69 244 variable ZoneinfoPaths {}
jpayne@69 245 foreach path {
jpayne@69 246 /usr/share/zoneinfo
jpayne@69 247 /usr/share/lib/zoneinfo
jpayne@69 248 /usr/lib/zoneinfo
jpayne@69 249 /usr/local/etc/zoneinfo
jpayne@69 250 } {
jpayne@69 251 if { [file isdirectory $path] } {
jpayne@69 252 lappend ZoneinfoPaths $path
jpayne@69 253 }
jpayne@69 254 }
jpayne@69 255
jpayne@69 256 # Define the directories for time zone data and message catalogs.
jpayne@69 257
jpayne@69 258 variable DataDir [file join $LibDir tzdata]
jpayne@69 259
jpayne@69 260 # Number of days in the months, in common years and leap years.
jpayne@69 261
jpayne@69 262 variable DaysInRomanMonthInCommonYear \
jpayne@69 263 { 31 28 31 30 31 30 31 31 30 31 30 31 }
jpayne@69 264 variable DaysInRomanMonthInLeapYear \
jpayne@69 265 { 31 29 31 30 31 30 31 31 30 31 30 31 }
jpayne@69 266 variable DaysInPriorMonthsInCommonYear [list 0]
jpayne@69 267 variable DaysInPriorMonthsInLeapYear [list 0]
jpayne@69 268 set i 0
jpayne@69 269 foreach j $DaysInRomanMonthInCommonYear {
jpayne@69 270 lappend DaysInPriorMonthsInCommonYear [incr i $j]
jpayne@69 271 }
jpayne@69 272 set i 0
jpayne@69 273 foreach j $DaysInRomanMonthInLeapYear {
jpayne@69 274 lappend DaysInPriorMonthsInLeapYear [incr i $j]
jpayne@69 275 }
jpayne@69 276
jpayne@69 277 # Another epoch (Hi, Jeff!)
jpayne@69 278
jpayne@69 279 variable Roddenberry 1946
jpayne@69 280
jpayne@69 281 # Integer ranges
jpayne@69 282
jpayne@69 283 variable MINWIDE -9223372036854775808
jpayne@69 284 variable MAXWIDE 9223372036854775807
jpayne@69 285
jpayne@69 286 # Day before Leap Day
jpayne@69 287
jpayne@69 288 variable FEB_28 58
jpayne@69 289
jpayne@69 290 # Translation table to map Windows TZI onto cities, so that the Olson
jpayne@69 291 # rules can apply. In some cases the mapping is ambiguous, so it's wise
jpayne@69 292 # to specify $::env(TCL_TZ) rather than simply depending on the system
jpayne@69 293 # time zone.
jpayne@69 294
jpayne@69 295 # The keys are long lists of values obtained from the time zone
jpayne@69 296 # information in the Registry. In order, the list elements are:
jpayne@69 297 # Bias StandardBias DaylightBias
jpayne@69 298 # StandardDate.wYear StandardDate.wMonth StandardDate.wDayOfWeek
jpayne@69 299 # StandardDate.wDay StandardDate.wHour StandardDate.wMinute
jpayne@69 300 # StandardDate.wSecond StandardDate.wMilliseconds
jpayne@69 301 # DaylightDate.wYear DaylightDate.wMonth DaylightDate.wDayOfWeek
jpayne@69 302 # DaylightDate.wDay DaylightDate.wHour DaylightDate.wMinute
jpayne@69 303 # DaylightDate.wSecond DaylightDate.wMilliseconds
jpayne@69 304 # The values are the names of time zones where those rules apply. There
jpayne@69 305 # is considerable ambiguity in certain zones; an attempt has been made to
jpayne@69 306 # make a reasonable guess, but this table needs to be taken with a grain
jpayne@69 307 # of salt.
jpayne@69 308
jpayne@69 309 variable WinZoneInfo [dict create {*}{
jpayne@69 310 {-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Kwajalein
jpayne@69 311 {-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Midway
jpayne@69 312 {-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Honolulu
jpayne@69 313 {-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
jpayne@69 314 {-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
jpayne@69 315 {-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana
jpayne@69 316 {-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver
jpayne@69 317 {-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua
jpayne@69 318 {-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Phoenix
jpayne@69 319 {-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Regina
jpayne@69 320 {-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago
jpayne@69 321 {-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City
jpayne@69 322 {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York
jpayne@69 323 {-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Indianapolis
jpayne@69 324 {-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Caracas
jpayne@69 325 {-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999}
jpayne@69 326 :America/Santiago
jpayne@69 327 {-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus
jpayne@69 328 {-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax
jpayne@69 329 {-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns
jpayne@69 330 {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
jpayne@69 331 {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
jpayne@69 332 {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires
jpayne@69 333 {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
jpayne@69 334 {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
jpayne@69 335 {-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha
jpayne@69 336 {-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores
jpayne@69 337 {-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Atlantic/Cape_Verde
jpayne@69 338 {0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :UTC
jpayne@69 339 {0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0} :Europe/London
jpayne@69 340 {3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Kinshasa
jpayne@69 341 {3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :CET
jpayne@69 342 {7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Harare
jpayne@69 343 {7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0}
jpayne@69 344 :Africa/Cairo
jpayne@69 345 {7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0} :Europe/Helsinki
jpayne@69 346 {7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0} :Asia/Jerusalem
jpayne@69 347 {7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0} :Europe/Bucharest
jpayne@69 348 {7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Athens
jpayne@69 349 {7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0} :Asia/Amman
jpayne@69 350 {7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0}
jpayne@69 351 :Asia/Beirut
jpayne@69 352 {7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0} :Africa/Windhoek
jpayne@69 353 {10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Riyadh
jpayne@69 354 {10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0} :Asia/Baghdad
jpayne@69 355 {10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Moscow
jpayne@69 356 {12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0} :Asia/Tehran
jpayne@69 357 {14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0} :Asia/Baku
jpayne@69 358 {14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Muscat
jpayne@69 359 {14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Tbilisi
jpayne@69 360 {16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Kabul
jpayne@69 361 {18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Karachi
jpayne@69 362 {18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yekaterinburg
jpayne@69 363 {19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Calcutta
jpayne@69 364 {20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Katmandu
jpayne@69 365 {21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Dhaka
jpayne@69 366 {21600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Novosibirsk
jpayne@69 367 {23400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Rangoon
jpayne@69 368 {25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Bangkok
jpayne@69 369 {25200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Krasnoyarsk
jpayne@69 370 {28800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Chongqing
jpayne@69 371 {28800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Irkutsk
jpayne@69 372 {32400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Tokyo
jpayne@69 373 {32400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yakutsk
jpayne@69 374 {34200 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Adelaide
jpayne@69 375 {34200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Darwin
jpayne@69 376 {36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Brisbane
jpayne@69 377 {36000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Vladivostok
jpayne@69 378 {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 1 2 0 0 0} :Australia/Hobart
jpayne@69 379 {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Sydney
jpayne@69 380 {39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Noumea
jpayne@69 381 {43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0} :Pacific/Auckland
jpayne@69 382 {43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Fiji
jpayne@69 383 {46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu
jpayne@69 384 }]
jpayne@69 385
jpayne@69 386 # Groups of fields that specify the date, priorities, and code bursts that
jpayne@69 387 # determine Julian Day Number given those groups. The code in [clock
jpayne@69 388 # scan] will choose the highest priority (lowest numbered) set of fields
jpayne@69 389 # that determines the date.
jpayne@69 390
jpayne@69 391 variable DateParseActions {
jpayne@69 392
jpayne@69 393 { seconds } 0 {}
jpayne@69 394
jpayne@69 395 { julianDay } 1 {}
jpayne@69 396
jpayne@69 397 { era century yearOfCentury month dayOfMonth } 2 {
jpayne@69 398 dict set date year [expr { 100 * [dict get $date century]
jpayne@69 399 + [dict get $date yearOfCentury] }]
jpayne@69 400 set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
jpayne@69 401 $changeover]
jpayne@69 402 }
jpayne@69 403 { era century yearOfCentury dayOfYear } 2 {
jpayne@69 404 dict set date year [expr { 100 * [dict get $date century]
jpayne@69 405 + [dict get $date yearOfCentury] }]
jpayne@69 406 set date [GetJulianDayFromEraYearDay $date[set date {}] \
jpayne@69 407 $changeover]
jpayne@69 408 }
jpayne@69 409
jpayne@69 410 { century yearOfCentury month dayOfMonth } 3 {
jpayne@69 411 dict set date era CE
jpayne@69 412 dict set date year [expr { 100 * [dict get $date century]
jpayne@69 413 + [dict get $date yearOfCentury] }]
jpayne@69 414 set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
jpayne@69 415 $changeover]
jpayne@69 416 }
jpayne@69 417 { century yearOfCentury dayOfYear } 3 {
jpayne@69 418 dict set date era CE
jpayne@69 419 dict set date year [expr { 100 * [dict get $date century]
jpayne@69 420 + [dict get $date yearOfCentury] }]
jpayne@69 421 set date [GetJulianDayFromEraYearDay $date[set date {}] \
jpayne@69 422 $changeover]
jpayne@69 423 }
jpayne@69 424 { iso8601Century iso8601YearOfCentury iso8601Week dayOfWeek } 3 {
jpayne@69 425 dict set date era CE
jpayne@69 426 dict set date iso8601Year \
jpayne@69 427 [expr { 100 * [dict get $date iso8601Century]
jpayne@69 428 + [dict get $date iso8601YearOfCentury] }]
jpayne@69 429 set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
jpayne@69 430 $changeover]
jpayne@69 431 }
jpayne@69 432
jpayne@69 433 { yearOfCentury month dayOfMonth } 4 {
jpayne@69 434 set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
jpayne@69 435 dict set date era CE
jpayne@69 436 set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
jpayne@69 437 $changeover]
jpayne@69 438 }
jpayne@69 439 { yearOfCentury dayOfYear } 4 {
jpayne@69 440 set date [InterpretTwoDigitYear $date[set date {}] $baseTime]
jpayne@69 441 dict set date era CE
jpayne@69 442 set date [GetJulianDayFromEraYearDay $date[set date {}] \
jpayne@69 443 $changeover]
jpayne@69 444 }
jpayne@69 445 { iso8601YearOfCentury iso8601Week dayOfWeek } 4 {
jpayne@69 446 set date [InterpretTwoDigitYear \
jpayne@69 447 $date[set date {}] $baseTime \
jpayne@69 448 iso8601YearOfCentury iso8601Year]
jpayne@69 449 dict set date era CE
jpayne@69 450 set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
jpayne@69 451 $changeover]
jpayne@69 452 }
jpayne@69 453
jpayne@69 454 { month dayOfMonth } 5 {
jpayne@69 455 set date [AssignBaseYear $date[set date {}] \
jpayne@69 456 $baseTime $timeZone $changeover]
jpayne@69 457 set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
jpayne@69 458 $changeover]
jpayne@69 459 }
jpayne@69 460 { dayOfYear } 5 {
jpayne@69 461 set date [AssignBaseYear $date[set date {}] \
jpayne@69 462 $baseTime $timeZone $changeover]
jpayne@69 463 set date [GetJulianDayFromEraYearDay $date[set date {}] \
jpayne@69 464 $changeover]
jpayne@69 465 }
jpayne@69 466 { iso8601Week dayOfWeek } 5 {
jpayne@69 467 set date [AssignBaseIso8601Year $date[set date {}] \
jpayne@69 468 $baseTime $timeZone $changeover]
jpayne@69 469 set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
jpayne@69 470 $changeover]
jpayne@69 471 }
jpayne@69 472
jpayne@69 473 { dayOfMonth } 6 {
jpayne@69 474 set date [AssignBaseMonth $date[set date {}] \
jpayne@69 475 $baseTime $timeZone $changeover]
jpayne@69 476 set date [GetJulianDayFromEraYearMonthDay $date[set date {}] \
jpayne@69 477 $changeover]
jpayne@69 478 }
jpayne@69 479
jpayne@69 480 { dayOfWeek } 7 {
jpayne@69 481 set date [AssignBaseWeek $date[set date {}] \
jpayne@69 482 $baseTime $timeZone $changeover]
jpayne@69 483 set date [GetJulianDayFromEraYearWeekDay $date[set date {}] \
jpayne@69 484 $changeover]
jpayne@69 485 }
jpayne@69 486
jpayne@69 487 {} 8 {
jpayne@69 488 set date [AssignBaseJulianDay $date[set date {}] \
jpayne@69 489 $baseTime $timeZone $changeover]
jpayne@69 490 }
jpayne@69 491 }
jpayne@69 492
jpayne@69 493 # Groups of fields that specify time of day, priorities, and code that
jpayne@69 494 # processes them
jpayne@69 495
jpayne@69 496 variable TimeParseActions {
jpayne@69 497
jpayne@69 498 seconds 1 {}
jpayne@69 499
jpayne@69 500 { hourAMPM minute second amPmIndicator } 2 {
jpayne@69 501 dict set date secondOfDay [InterpretHMSP $date]
jpayne@69 502 }
jpayne@69 503 { hour minute second } 2 {
jpayne@69 504 dict set date secondOfDay [InterpretHMS $date]
jpayne@69 505 }
jpayne@69 506
jpayne@69 507 { hourAMPM minute amPmIndicator } 3 {
jpayne@69 508 dict set date second 0
jpayne@69 509 dict set date secondOfDay [InterpretHMSP $date]
jpayne@69 510 }
jpayne@69 511 { hour minute } 3 {
jpayne@69 512 dict set date second 0
jpayne@69 513 dict set date secondOfDay [InterpretHMS $date]
jpayne@69 514 }
jpayne@69 515
jpayne@69 516 { hourAMPM amPmIndicator } 4 {
jpayne@69 517 dict set date minute 0
jpayne@69 518 dict set date second 0
jpayne@69 519 dict set date secondOfDay [InterpretHMSP $date]
jpayne@69 520 }
jpayne@69 521 { hour } 4 {
jpayne@69 522 dict set date minute 0
jpayne@69 523 dict set date second 0
jpayne@69 524 dict set date secondOfDay [InterpretHMS $date]
jpayne@69 525 }
jpayne@69 526
jpayne@69 527 { } 5 {
jpayne@69 528 dict set date secondOfDay 0
jpayne@69 529 }
jpayne@69 530 }
jpayne@69 531
jpayne@69 532 # Legacy time zones, used primarily for parsing RFC822 dates.
jpayne@69 533
jpayne@69 534 variable LegacyTimeZone [dict create \
jpayne@69 535 gmt +0000 \
jpayne@69 536 ut +0000 \
jpayne@69 537 utc +0000 \
jpayne@69 538 bst +0100 \
jpayne@69 539 wet +0000 \
jpayne@69 540 wat -0100 \
jpayne@69 541 at -0200 \
jpayne@69 542 nft -0330 \
jpayne@69 543 nst -0330 \
jpayne@69 544 ndt -0230 \
jpayne@69 545 ast -0400 \
jpayne@69 546 adt -0300 \
jpayne@69 547 est -0500 \
jpayne@69 548 edt -0400 \
jpayne@69 549 cst -0600 \
jpayne@69 550 cdt -0500 \
jpayne@69 551 mst -0700 \
jpayne@69 552 mdt -0600 \
jpayne@69 553 pst -0800 \
jpayne@69 554 pdt -0700 \
jpayne@69 555 yst -0900 \
jpayne@69 556 ydt -0800 \
jpayne@69 557 hst -1000 \
jpayne@69 558 hdt -0900 \
jpayne@69 559 cat -1000 \
jpayne@69 560 ahst -1000 \
jpayne@69 561 nt -1100 \
jpayne@69 562 idlw -1200 \
jpayne@69 563 cet +0100 \
jpayne@69 564 cest +0200 \
jpayne@69 565 met +0100 \
jpayne@69 566 mewt +0100 \
jpayne@69 567 mest +0200 \
jpayne@69 568 swt +0100 \
jpayne@69 569 sst +0200 \
jpayne@69 570 fwt +0100 \
jpayne@69 571 fst +0200 \
jpayne@69 572 eet +0200 \
jpayne@69 573 eest +0300 \
jpayne@69 574 bt +0300 \
jpayne@69 575 it +0330 \
jpayne@69 576 zp4 +0400 \
jpayne@69 577 zp5 +0500 \
jpayne@69 578 ist +0530 \
jpayne@69 579 zp6 +0600 \
jpayne@69 580 wast +0700 \
jpayne@69 581 wadt +0800 \
jpayne@69 582 jt +0730 \
jpayne@69 583 cct +0800 \
jpayne@69 584 jst +0900 \
jpayne@69 585 kst +0900 \
jpayne@69 586 cast +0930 \
jpayne@69 587 jdt +1000 \
jpayne@69 588 kdt +1000 \
jpayne@69 589 cadt +1030 \
jpayne@69 590 east +1000 \
jpayne@69 591 eadt +1030 \
jpayne@69 592 gst +1000 \
jpayne@69 593 nzt +1200 \
jpayne@69 594 nzst +1200 \
jpayne@69 595 nzdt +1300 \
jpayne@69 596 idle +1200 \
jpayne@69 597 a +0100 \
jpayne@69 598 b +0200 \
jpayne@69 599 c +0300 \
jpayne@69 600 d +0400 \
jpayne@69 601 e +0500 \
jpayne@69 602 f +0600 \
jpayne@69 603 g +0700 \
jpayne@69 604 h +0800 \
jpayne@69 605 i +0900 \
jpayne@69 606 k +1000 \
jpayne@69 607 l +1100 \
jpayne@69 608 m +1200 \
jpayne@69 609 n -0100 \
jpayne@69 610 o -0200 \
jpayne@69 611 p -0300 \
jpayne@69 612 q -0400 \
jpayne@69 613 r -0500 \
jpayne@69 614 s -0600 \
jpayne@69 615 t -0700 \
jpayne@69 616 u -0800 \
jpayne@69 617 v -0900 \
jpayne@69 618 w -1000 \
jpayne@69 619 x -1100 \
jpayne@69 620 y -1200 \
jpayne@69 621 z +0000 \
jpayne@69 622 ]
jpayne@69 623
jpayne@69 624 # Caches
jpayne@69 625
jpayne@69 626 variable LocaleNumeralCache {}; # Dictionary whose keys are locale
jpayne@69 627 # names and whose values are pairs
jpayne@69 628 # comprising regexes matching numerals
jpayne@69 629 # in the given locales and dictionaries
jpayne@69 630 # mapping the numerals to their numeric
jpayne@69 631 # values.
jpayne@69 632 # variable CachedSystemTimeZone; # If 'CachedSystemTimeZone' exists,
jpayne@69 633 # it contains the value of the
jpayne@69 634 # system time zone, as determined from
jpayne@69 635 # the environment.
jpayne@69 636 variable TimeZoneBad {}; # Dictionary whose keys are time zone
jpayne@69 637 # names and whose values are 1 if
jpayne@69 638 # the time zone is unknown and 0
jpayne@69 639 # if it is known.
jpayne@69 640 variable TZData; # Array whose keys are time zone names
jpayne@69 641 # and whose values are lists of quads
jpayne@69 642 # comprising start time, UTC offset,
jpayne@69 643 # Daylight Saving Time indicator, and
jpayne@69 644 # time zone abbreviation.
jpayne@69 645 variable FormatProc; # Array mapping format group
jpayne@69 646 # and locale to the name of a procedure
jpayne@69 647 # that renders the given format
jpayne@69 648 }
jpayne@69 649 ::tcl::clock::Initialize
jpayne@69 650
jpayne@69 651 #----------------------------------------------------------------------
jpayne@69 652 #
jpayne@69 653 # clock format --
jpayne@69 654 #
jpayne@69 655 # Formats a count of seconds since the Posix Epoch as a time of day.
jpayne@69 656 #
jpayne@69 657 # The 'clock format' command formats times of day for output. Refer to the
jpayne@69 658 # user documentation to see what it does.
jpayne@69 659 #
jpayne@69 660 #----------------------------------------------------------------------
jpayne@69 661
jpayne@69 662 proc ::tcl::clock::format { args } {
jpayne@69 663
jpayne@69 664 variable FormatProc
jpayne@69 665 variable TZData
jpayne@69 666
jpayne@69 667 lassign [ParseFormatArgs {*}$args] format locale timezone
jpayne@69 668 set locale [string tolower $locale]
jpayne@69 669 set clockval [lindex $args 0]
jpayne@69 670
jpayne@69 671 # Get the data for time changes in the given zone
jpayne@69 672
jpayne@69 673 if {$timezone eq ""} {
jpayne@69 674 set timezone [GetSystemTimeZone]
jpayne@69 675 }
jpayne@69 676 if {![info exists TZData($timezone)]} {
jpayne@69 677 if {[catch {SetupTimeZone $timezone} retval opts]} {
jpayne@69 678 dict unset opts -errorinfo
jpayne@69 679 return -options $opts $retval
jpayne@69 680 }
jpayne@69 681 }
jpayne@69 682
jpayne@69 683 # Build a procedure to format the result. Cache the built procedure's name
jpayne@69 684 # in the 'FormatProc' array to avoid losing its internal representation,
jpayne@69 685 # which contains the name resolution.
jpayne@69 686
jpayne@69 687 set procName formatproc'$format'$locale
jpayne@69 688 set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
jpayne@69 689 if {[info exists FormatProc($procName)]} {
jpayne@69 690 set procName $FormatProc($procName)
jpayne@69 691 } else {
jpayne@69 692 set FormatProc($procName) \
jpayne@69 693 [ParseClockFormatFormat $procName $format $locale]
jpayne@69 694 }
jpayne@69 695
jpayne@69 696 return [$procName $clockval $timezone]
jpayne@69 697
jpayne@69 698 }
jpayne@69 699
jpayne@69 700 #----------------------------------------------------------------------
jpayne@69 701 #
jpayne@69 702 # ParseClockFormatFormat --
jpayne@69 703 #
jpayne@69 704 # Builds and caches a procedure that formats a time value.
jpayne@69 705 #
jpayne@69 706 # Parameters:
jpayne@69 707 # format -- Format string to use
jpayne@69 708 # locale -- Locale in which the format string is to be interpreted
jpayne@69 709 #
jpayne@69 710 # Results:
jpayne@69 711 # Returns the name of the newly-built procedure.
jpayne@69 712 #
jpayne@69 713 #----------------------------------------------------------------------
jpayne@69 714
jpayne@69 715 proc ::tcl::clock::ParseClockFormatFormat {procName format locale} {
jpayne@69 716
jpayne@69 717 if {[namespace which $procName] ne {}} {
jpayne@69 718 return $procName
jpayne@69 719 }
jpayne@69 720
jpayne@69 721 # Map away the locale-dependent composite format groups
jpayne@69 722
jpayne@69 723 EnterLocale $locale
jpayne@69 724
jpayne@69 725 # Change locale if a fresh locale has been given on the command line.
jpayne@69 726
jpayne@69 727 try {
jpayne@69 728 return [ParseClockFormatFormat2 $format $locale $procName]
jpayne@69 729 } trap CLOCK {result opts} {
jpayne@69 730 dict unset opts -errorinfo
jpayne@69 731 return -options $opts $result
jpayne@69 732 }
jpayne@69 733 }
jpayne@69 734
jpayne@69 735 proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {
jpayne@69 736 set didLocaleEra 0
jpayne@69 737 set didLocaleNumerals 0
jpayne@69 738 set preFormatCode \
jpayne@69 739 [string map [list @GREGORIAN_CHANGE_DATE@ \
jpayne@69 740 [mc GREGORIAN_CHANGE_DATE]] \
jpayne@69 741 {
jpayne@69 742 variable TZData
jpayne@69 743 set date [GetDateFields $clockval \
jpayne@69 744 $TZData($timezone) \
jpayne@69 745 @GREGORIAN_CHANGE_DATE@]
jpayne@69 746 }]
jpayne@69 747 set formatString {}
jpayne@69 748 set substituents {}
jpayne@69 749 set state {}
jpayne@69 750
jpayne@69 751 set format [LocalizeFormat $locale $format]
jpayne@69 752
jpayne@69 753 foreach char [split $format {}] {
jpayne@69 754 switch -exact -- $state {
jpayne@69 755 {} {
jpayne@69 756 if { [string equal % $char] } {
jpayne@69 757 set state percent
jpayne@69 758 } else {
jpayne@69 759 append formatString $char
jpayne@69 760 }
jpayne@69 761 }
jpayne@69 762 percent { # Character following a '%' character
jpayne@69 763 set state {}
jpayne@69 764 switch -exact -- $char {
jpayne@69 765 % { # A literal character, '%'
jpayne@69 766 append formatString %%
jpayne@69 767 }
jpayne@69 768 a { # Day of week, abbreviated
jpayne@69 769 append formatString %s
jpayne@69 770 append substituents \
jpayne@69 771 [string map \
jpayne@69 772 [list @DAYS_OF_WEEK_ABBREV@ \
jpayne@69 773 [list [mc DAYS_OF_WEEK_ABBREV]]] \
jpayne@69 774 { [lindex @DAYS_OF_WEEK_ABBREV@ \
jpayne@69 775 [expr {[dict get $date dayOfWeek] \
jpayne@69 776 % 7}]]}]
jpayne@69 777 }
jpayne@69 778 A { # Day of week, spelt out.
jpayne@69 779 append formatString %s
jpayne@69 780 append substituents \
jpayne@69 781 [string map \
jpayne@69 782 [list @DAYS_OF_WEEK_FULL@ \
jpayne@69 783 [list [mc DAYS_OF_WEEK_FULL]]] \
jpayne@69 784 { [lindex @DAYS_OF_WEEK_FULL@ \
jpayne@69 785 [expr {[dict get $date dayOfWeek] \
jpayne@69 786 % 7}]]}]
jpayne@69 787 }
jpayne@69 788 b - h { # Name of month, abbreviated.
jpayne@69 789 append formatString %s
jpayne@69 790 append substituents \
jpayne@69 791 [string map \
jpayne@69 792 [list @MONTHS_ABBREV@ \
jpayne@69 793 [list [mc MONTHS_ABBREV]]] \
jpayne@69 794 { [lindex @MONTHS_ABBREV@ \
jpayne@69 795 [expr {[dict get $date month]-1}]]}]
jpayne@69 796 }
jpayne@69 797 B { # Name of month, spelt out
jpayne@69 798 append formatString %s
jpayne@69 799 append substituents \
jpayne@69 800 [string map \
jpayne@69 801 [list @MONTHS_FULL@ \
jpayne@69 802 [list [mc MONTHS_FULL]]] \
jpayne@69 803 { [lindex @MONTHS_FULL@ \
jpayne@69 804 [expr {[dict get $date month]-1}]]}]
jpayne@69 805 }
jpayne@69 806 C { # Century number
jpayne@69 807 append formatString %02d
jpayne@69 808 append substituents \
jpayne@69 809 { [expr {[dict get $date year] / 100}]}
jpayne@69 810 }
jpayne@69 811 d { # Day of month, with leading zero
jpayne@69 812 append formatString %02d
jpayne@69 813 append substituents { [dict get $date dayOfMonth]}
jpayne@69 814 }
jpayne@69 815 e { # Day of month, without leading zero
jpayne@69 816 append formatString %2d
jpayne@69 817 append substituents { [dict get $date dayOfMonth]}
jpayne@69 818 }
jpayne@69 819 E { # Format group in a locale-dependent
jpayne@69 820 # alternative era
jpayne@69 821 set state percentE
jpayne@69 822 if {!$didLocaleEra} {
jpayne@69 823 append preFormatCode \
jpayne@69 824 [string map \
jpayne@69 825 [list @LOCALE_ERAS@ \
jpayne@69 826 [list [mc LOCALE_ERAS]]] \
jpayne@69 827 {
jpayne@69 828 set date [GetLocaleEra \
jpayne@69 829 $date[set date {}] \
jpayne@69 830 @LOCALE_ERAS@]}] \n
jpayne@69 831 set didLocaleEra 1
jpayne@69 832 }
jpayne@69 833 if {!$didLocaleNumerals} {
jpayne@69 834 append preFormatCode \
jpayne@69 835 [list set localeNumerals \
jpayne@69 836 [mc LOCALE_NUMERALS]] \n
jpayne@69 837 set didLocaleNumerals 1
jpayne@69 838 }
jpayne@69 839 }
jpayne@69 840 g { # Two-digit year relative to ISO8601
jpayne@69 841 # week number
jpayne@69 842 append formatString %02d
jpayne@69 843 append substituents \
jpayne@69 844 { [expr { [dict get $date iso8601Year] % 100 }]}
jpayne@69 845 }
jpayne@69 846 G { # Four-digit year relative to ISO8601
jpayne@69 847 # week number
jpayne@69 848 append formatString %02d
jpayne@69 849 append substituents { [dict get $date iso8601Year]}
jpayne@69 850 }
jpayne@69 851 H { # Hour in the 24-hour day, leading zero
jpayne@69 852 append formatString %02d
jpayne@69 853 append substituents \
jpayne@69 854 { [expr { [dict get $date localSeconds] \
jpayne@69 855 / 3600 % 24}]}
jpayne@69 856 }
jpayne@69 857 I { # Hour AM/PM, with leading zero
jpayne@69 858 append formatString %02d
jpayne@69 859 append substituents \
jpayne@69 860 { [expr { ( ( ( [dict get $date localSeconds] \
jpayne@69 861 % 86400 ) \
jpayne@69 862 + 86400 \
jpayne@69 863 - 3600 ) \
jpayne@69 864 / 3600 ) \
jpayne@69 865 % 12 + 1 }] }
jpayne@69 866 }
jpayne@69 867 j { # Day of year (001-366)
jpayne@69 868 append formatString %03d
jpayne@69 869 append substituents { [dict get $date dayOfYear]}
jpayne@69 870 }
jpayne@69 871 J { # Julian Day Number
jpayne@69 872 append formatString %07ld
jpayne@69 873 append substituents { [dict get $date julianDay]}
jpayne@69 874 }
jpayne@69 875 k { # Hour (0-23), no leading zero
jpayne@69 876 append formatString %2d
jpayne@69 877 append substituents \
jpayne@69 878 { [expr { [dict get $date localSeconds]
jpayne@69 879 / 3600
jpayne@69 880 % 24 }]}
jpayne@69 881 }
jpayne@69 882 l { # Hour (12-11), no leading zero
jpayne@69 883 append formatString %2d
jpayne@69 884 append substituents \
jpayne@69 885 { [expr { ( ( ( [dict get $date localSeconds]
jpayne@69 886 % 86400 )
jpayne@69 887 + 86400
jpayne@69 888 - 3600 )
jpayne@69 889 / 3600 )
jpayne@69 890 % 12 + 1 }]}
jpayne@69 891 }
jpayne@69 892 m { # Month number, leading zero
jpayne@69 893 append formatString %02d
jpayne@69 894 append substituents { [dict get $date month]}
jpayne@69 895 }
jpayne@69 896 M { # Minute of the hour, leading zero
jpayne@69 897 append formatString %02d
jpayne@69 898 append substituents \
jpayne@69 899 { [expr { [dict get $date localSeconds]
jpayne@69 900 / 60
jpayne@69 901 % 60 }]}
jpayne@69 902 }
jpayne@69 903 n { # A literal newline
jpayne@69 904 append formatString \n
jpayne@69 905 }
jpayne@69 906 N { # Month number, no leading zero
jpayne@69 907 append formatString %2d
jpayne@69 908 append substituents { [dict get $date month]}
jpayne@69 909 }
jpayne@69 910 O { # A format group in the locale's
jpayne@69 911 # alternative numerals
jpayne@69 912 set state percentO
jpayne@69 913 if {!$didLocaleNumerals} {
jpayne@69 914 append preFormatCode \
jpayne@69 915 [list set localeNumerals \
jpayne@69 916 [mc LOCALE_NUMERALS]] \n
jpayne@69 917 set didLocaleNumerals 1
jpayne@69 918 }
jpayne@69 919 }
jpayne@69 920 p { # Localized 'AM' or 'PM' indicator
jpayne@69 921 # converted to uppercase
jpayne@69 922 append formatString %s
jpayne@69 923 append preFormatCode \
jpayne@69 924 [list set AM [string toupper [mc AM]]] \n \
jpayne@69 925 [list set PM [string toupper [mc PM]]] \n
jpayne@69 926 append substituents \
jpayne@69 927 { [expr {(([dict get $date localSeconds]
jpayne@69 928 % 86400) < 43200) ?
jpayne@69 929 $AM : $PM}]}
jpayne@69 930 }
jpayne@69 931 P { # Localized 'AM' or 'PM' indicator
jpayne@69 932 append formatString %s
jpayne@69 933 append preFormatCode \
jpayne@69 934 [list set am [mc AM]] \n \
jpayne@69 935 [list set pm [mc PM]] \n
jpayne@69 936 append substituents \
jpayne@69 937 { [expr {(([dict get $date localSeconds]
jpayne@69 938 % 86400) < 43200) ?
jpayne@69 939 $am : $pm}]}
jpayne@69 940
jpayne@69 941 }
jpayne@69 942 Q { # Hi, Jeff!
jpayne@69 943 append formatString %s
jpayne@69 944 append substituents { [FormatStarDate $date]}
jpayne@69 945 }
jpayne@69 946 s { # Seconds from the Posix Epoch
jpayne@69 947 append formatString %s
jpayne@69 948 append substituents { [dict get $date seconds]}
jpayne@69 949 }
jpayne@69 950 S { # Second of the minute, with
jpayne@69 951 # leading zero
jpayne@69 952 append formatString %02d
jpayne@69 953 append substituents \
jpayne@69 954 { [expr { [dict get $date localSeconds]
jpayne@69 955 % 60 }]}
jpayne@69 956 }
jpayne@69 957 t { # A literal tab character
jpayne@69 958 append formatString \t
jpayne@69 959 }
jpayne@69 960 u { # Day of the week (1-Monday, 7-Sunday)
jpayne@69 961 append formatString %1d
jpayne@69 962 append substituents { [dict get $date dayOfWeek]}
jpayne@69 963 }
jpayne@69 964 U { # Week of the year (00-53). The
jpayne@69 965 # first Sunday of the year is the
jpayne@69 966 # first day of week 01
jpayne@69 967 append formatString %02d
jpayne@69 968 append preFormatCode {
jpayne@69 969 set dow [dict get $date dayOfWeek]
jpayne@69 970 if { $dow == 7 } {
jpayne@69 971 set dow 0
jpayne@69 972 }
jpayne@69 973 incr dow
jpayne@69 974 set UweekNumber \
jpayne@69 975 [expr { ( [dict get $date dayOfYear]
jpayne@69 976 - $dow + 7 )
jpayne@69 977 / 7 }]
jpayne@69 978 }
jpayne@69 979 append substituents { $UweekNumber}
jpayne@69 980 }
jpayne@69 981 V { # The ISO8601 week number
jpayne@69 982 append formatString %02d
jpayne@69 983 append substituents { [dict get $date iso8601Week]}
jpayne@69 984 }
jpayne@69 985 w { # Day of the week (0-Sunday,
jpayne@69 986 # 6-Saturday)
jpayne@69 987 append formatString %1d
jpayne@69 988 append substituents \
jpayne@69 989 { [expr { [dict get $date dayOfWeek] % 7 }]}
jpayne@69 990 }
jpayne@69 991 W { # Week of the year (00-53). The first
jpayne@69 992 # Monday of the year is the first day
jpayne@69 993 # of week 01.
jpayne@69 994 append preFormatCode {
jpayne@69 995 set WweekNumber \
jpayne@69 996 [expr { ( [dict get $date dayOfYear]
jpayne@69 997 - [dict get $date dayOfWeek]
jpayne@69 998 + 7 )
jpayne@69 999 / 7 }]
jpayne@69 1000 }
jpayne@69 1001 append formatString %02d
jpayne@69 1002 append substituents { $WweekNumber}
jpayne@69 1003 }
jpayne@69 1004 y { # The two-digit year of the century
jpayne@69 1005 append formatString %02d
jpayne@69 1006 append substituents \
jpayne@69 1007 { [expr { [dict get $date year] % 100 }]}
jpayne@69 1008 }
jpayne@69 1009 Y { # The four-digit year
jpayne@69 1010 append formatString %04d
jpayne@69 1011 append substituents { [dict get $date year]}
jpayne@69 1012 }
jpayne@69 1013 z { # The time zone as hours and minutes
jpayne@69 1014 # east (+) or west (-) of Greenwich
jpayne@69 1015 append formatString %s
jpayne@69 1016 append substituents { [FormatNumericTimeZone \
jpayne@69 1017 [dict get $date tzOffset]]}
jpayne@69 1018 }
jpayne@69 1019 Z { # The name of the time zone
jpayne@69 1020 append formatString %s
jpayne@69 1021 append substituents { [dict get $date tzName]}
jpayne@69 1022 }
jpayne@69 1023 % { # A literal percent character
jpayne@69 1024 append formatString %%
jpayne@69 1025 }
jpayne@69 1026 default { # An unknown escape sequence
jpayne@69 1027 append formatString %% $char
jpayne@69 1028 }
jpayne@69 1029 }
jpayne@69 1030 }
jpayne@69 1031 percentE { # Character following %E
jpayne@69 1032 set state {}
jpayne@69 1033 switch -exact -- $char {
jpayne@69 1034 E {
jpayne@69 1035 append formatString %s
jpayne@69 1036 append substituents { } \
jpayne@69 1037 [string map \
jpayne@69 1038 [list @BCE@ [list [mc BCE]] \
jpayne@69 1039 @CE@ [list [mc CE]]] \
jpayne@69 1040 {[dict get {BCE @BCE@ CE @CE@} \
jpayne@69 1041 [dict get $date era]]}]
jpayne@69 1042 }
jpayne@69 1043 C { # Locale-dependent era
jpayne@69 1044 append formatString %s
jpayne@69 1045 append substituents { [dict get $date localeEra]}
jpayne@69 1046 }
jpayne@69 1047 y { # Locale-dependent year of the era
jpayne@69 1048 append preFormatCode {
jpayne@69 1049 set y [dict get $date localeYear]
jpayne@69 1050 if { $y >= 0 && $y < 100 } {
jpayne@69 1051 set Eyear [lindex $localeNumerals $y]
jpayne@69 1052 } else {
jpayne@69 1053 set Eyear $y
jpayne@69 1054 }
jpayne@69 1055 }
jpayne@69 1056 append formatString %s
jpayne@69 1057 append substituents { $Eyear}
jpayne@69 1058 }
jpayne@69 1059 default { # Unknown %E format group
jpayne@69 1060 append formatString %%E $char
jpayne@69 1061 }
jpayne@69 1062 }
jpayne@69 1063 }
jpayne@69 1064 percentO { # Character following %O
jpayne@69 1065 set state {}
jpayne@69 1066 switch -exact -- $char {
jpayne@69 1067 d - e { # Day of the month in alternative
jpayne@69 1068 # numerals
jpayne@69 1069 append formatString %s
jpayne@69 1070 append substituents \
jpayne@69 1071 { [lindex $localeNumerals \
jpayne@69 1072 [dict get $date dayOfMonth]]}
jpayne@69 1073 }
jpayne@69 1074 H - k { # Hour of the day in alternative
jpayne@69 1075 # numerals
jpayne@69 1076 append formatString %s
jpayne@69 1077 append substituents \
jpayne@69 1078 { [lindex $localeNumerals \
jpayne@69 1079 [expr { [dict get $date localSeconds]
jpayne@69 1080 / 3600
jpayne@69 1081 % 24 }]]}
jpayne@69 1082 }
jpayne@69 1083 I - l { # Hour (12-11) AM/PM in alternative
jpayne@69 1084 # numerals
jpayne@69 1085 append formatString %s
jpayne@69 1086 append substituents \
jpayne@69 1087 { [lindex $localeNumerals \
jpayne@69 1088 [expr { ( ( ( [dict get $date localSeconds]
jpayne@69 1089 % 86400 )
jpayne@69 1090 + 86400
jpayne@69 1091 - 3600 )
jpayne@69 1092 / 3600 )
jpayne@69 1093 % 12 + 1 }]]}
jpayne@69 1094 }
jpayne@69 1095 m { # Month number in alternative numerals
jpayne@69 1096 append formatString %s
jpayne@69 1097 append substituents \
jpayne@69 1098 { [lindex $localeNumerals [dict get $date month]]}
jpayne@69 1099 }
jpayne@69 1100 M { # Minute of the hour in alternative
jpayne@69 1101 # numerals
jpayne@69 1102 append formatString %s
jpayne@69 1103 append substituents \
jpayne@69 1104 { [lindex $localeNumerals \
jpayne@69 1105 [expr { [dict get $date localSeconds]
jpayne@69 1106 / 60
jpayne@69 1107 % 60 }]]}
jpayne@69 1108 }
jpayne@69 1109 S { # Second of the minute in alternative
jpayne@69 1110 # numerals
jpayne@69 1111 append formatString %s
jpayne@69 1112 append substituents \
jpayne@69 1113 { [lindex $localeNumerals \
jpayne@69 1114 [expr { [dict get $date localSeconds]
jpayne@69 1115 % 60 }]]}
jpayne@69 1116 }
jpayne@69 1117 u { # Day of the week (Monday=1,Sunday=7)
jpayne@69 1118 # in alternative numerals
jpayne@69 1119 append formatString %s
jpayne@69 1120 append substituents \
jpayne@69 1121 { [lindex $localeNumerals \
jpayne@69 1122 [dict get $date dayOfWeek]]}
jpayne@69 1123 }
jpayne@69 1124 w { # Day of the week (Sunday=0,Saturday=6)
jpayne@69 1125 # in alternative numerals
jpayne@69 1126 append formatString %s
jpayne@69 1127 append substituents \
jpayne@69 1128 { [lindex $localeNumerals \
jpayne@69 1129 [expr { [dict get $date dayOfWeek] % 7 }]]}
jpayne@69 1130 }
jpayne@69 1131 y { # Year of the century in alternative
jpayne@69 1132 # numerals
jpayne@69 1133 append formatString %s
jpayne@69 1134 append substituents \
jpayne@69 1135 { [lindex $localeNumerals \
jpayne@69 1136 [expr { [dict get $date year] % 100 }]]}
jpayne@69 1137 }
jpayne@69 1138 default { # Unknown format group
jpayne@69 1139 append formatString %%O $char
jpayne@69 1140 }
jpayne@69 1141 }
jpayne@69 1142 }
jpayne@69 1143 }
jpayne@69 1144 }
jpayne@69 1145
jpayne@69 1146 # Clean up any improperly terminated groups
jpayne@69 1147
jpayne@69 1148 switch -exact -- $state {
jpayne@69 1149 percent {
jpayne@69 1150 append formatString %%
jpayne@69 1151 }
jpayne@69 1152 percentE {
jpayne@69 1153 append retval %%E
jpayne@69 1154 }
jpayne@69 1155 percentO {
jpayne@69 1156 append retval %%O
jpayne@69 1157 }
jpayne@69 1158 }
jpayne@69 1159
jpayne@69 1160 proc $procName {clockval timezone} "
jpayne@69 1161 $preFormatCode
jpayne@69 1162 return \[::format [list $formatString] $substituents\]
jpayne@69 1163 "
jpayne@69 1164
jpayne@69 1165 # puts [list $procName [info args $procName] [info body $procName]]
jpayne@69 1166
jpayne@69 1167 return $procName
jpayne@69 1168 }
jpayne@69 1169
jpayne@69 1170 #----------------------------------------------------------------------
jpayne@69 1171 #
jpayne@69 1172 # clock scan --
jpayne@69 1173 #
jpayne@69 1174 # Inputs a count of seconds since the Posix Epoch as a time of day.
jpayne@69 1175 #
jpayne@69 1176 # The 'clock format' command scans times of day on input. Refer to the user
jpayne@69 1177 # documentation to see what it does.
jpayne@69 1178 #
jpayne@69 1179 #----------------------------------------------------------------------
jpayne@69 1180
jpayne@69 1181 proc ::tcl::clock::scan { args } {
jpayne@69 1182
jpayne@69 1183 set format {}
jpayne@69 1184
jpayne@69 1185 # Check the count of args
jpayne@69 1186
jpayne@69 1187 if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
jpayne@69 1188 set cmdName "clock scan"
jpayne@69 1189 return -code error \
jpayne@69 1190 -errorcode [list CLOCK wrongNumArgs] \
jpayne@69 1191 "wrong \# args: should be\
jpayne@69 1192 \"$cmdName string\
jpayne@69 1193 ?-base seconds?\
jpayne@69 1194 ?-format string? ?-gmt boolean?\
jpayne@69 1195 ?-locale LOCALE? ?-timezone ZONE?\""
jpayne@69 1196 }
jpayne@69 1197
jpayne@69 1198 # Set defaults
jpayne@69 1199
jpayne@69 1200 set base [clock seconds]
jpayne@69 1201 set string [lindex $args 0]
jpayne@69 1202 set format {}
jpayne@69 1203 set gmt 0
jpayne@69 1204 set locale c
jpayne@69 1205 set timezone [GetSystemTimeZone]
jpayne@69 1206
jpayne@69 1207 # Pick up command line options.
jpayne@69 1208
jpayne@69 1209 foreach { flag value } [lreplace $args 0 0] {
jpayne@69 1210 set saw($flag) {}
jpayne@69 1211 switch -exact -- $flag {
jpayne@69 1212 -b - -ba - -bas - -base {
jpayne@69 1213 set base $value
jpayne@69 1214 }
jpayne@69 1215 -f - -fo - -for - -form - -forma - -format {
jpayne@69 1216 set format $value
jpayne@69 1217 }
jpayne@69 1218 -g - -gm - -gmt {
jpayne@69 1219 set gmt $value
jpayne@69 1220 }
jpayne@69 1221 -l - -lo - -loc - -loca - -local - -locale {
jpayne@69 1222 set locale [string tolower $value]
jpayne@69 1223 }
jpayne@69 1224 -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
jpayne@69 1225 set timezone $value
jpayne@69 1226 }
jpayne@69 1227 default {
jpayne@69 1228 return -code error \
jpayne@69 1229 -errorcode [list CLOCK badOption $flag] \
jpayne@69 1230 "bad option \"$flag\",\
jpayne@69 1231 must be -base, -format, -gmt, -locale or -timezone"
jpayne@69 1232 }
jpayne@69 1233 }
jpayne@69 1234 }
jpayne@69 1235
jpayne@69 1236 # Check options for validity
jpayne@69 1237
jpayne@69 1238 if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
jpayne@69 1239 return -code error \
jpayne@69 1240 -errorcode [list CLOCK gmtWithTimezone] \
jpayne@69 1241 "cannot use -gmt and -timezone in same call"
jpayne@69 1242 }
jpayne@69 1243 if { [catch { expr { wide($base) } } result] } {
jpayne@69 1244 return -code error "expected integer but got \"$base\""
jpayne@69 1245 }
jpayne@69 1246 if { ![string is boolean -strict $gmt] } {
jpayne@69 1247 return -code error "expected boolean value but got \"$gmt\""
jpayne@69 1248 } elseif { $gmt } {
jpayne@69 1249 set timezone :GMT
jpayne@69 1250 }
jpayne@69 1251
jpayne@69 1252 if { ![info exists saw(-format)] } {
jpayne@69 1253 # Perhaps someday we'll localize the legacy code. Right now, it's not
jpayne@69 1254 # localized.
jpayne@69 1255 if { [info exists saw(-locale)] } {
jpayne@69 1256 return -code error \
jpayne@69 1257 -errorcode [list CLOCK flagWithLegacyFormat] \
jpayne@69 1258 "legacy \[clock scan\] does not support -locale"
jpayne@69 1259
jpayne@69 1260 }
jpayne@69 1261 return [FreeScan $string $base $timezone $locale]
jpayne@69 1262 }
jpayne@69 1263
jpayne@69 1264 # Change locale if a fresh locale has been given on the command line.
jpayne@69 1265
jpayne@69 1266 EnterLocale $locale
jpayne@69 1267
jpayne@69 1268 try {
jpayne@69 1269 # Map away the locale-dependent composite format groups
jpayne@69 1270
jpayne@69 1271 set scanner [ParseClockScanFormat $format $locale]
jpayne@69 1272 return [$scanner $string $base $timezone]
jpayne@69 1273 } trap CLOCK {result opts} {
jpayne@69 1274 # Conceal location of generation of expected errors
jpayne@69 1275 dict unset opts -errorinfo
jpayne@69 1276 return -options $opts $result
jpayne@69 1277 }
jpayne@69 1278 }
jpayne@69 1279
jpayne@69 1280 #----------------------------------------------------------------------
jpayne@69 1281 #
jpayne@69 1282 # FreeScan --
jpayne@69 1283 #
jpayne@69 1284 # Scans a time in free format
jpayne@69 1285 #
jpayne@69 1286 # Parameters:
jpayne@69 1287 # string - String containing the time to scan
jpayne@69 1288 # base - Base time, expressed in seconds from the Epoch
jpayne@69 1289 # timezone - Default time zone in which the time will be expressed
jpayne@69 1290 # locale - (Unused) Name of the locale where the time will be scanned.
jpayne@69 1291 #
jpayne@69 1292 # Results:
jpayne@69 1293 # Returns the date and time extracted from the string in seconds from
jpayne@69 1294 # the epoch
jpayne@69 1295 #
jpayne@69 1296 #----------------------------------------------------------------------
jpayne@69 1297
jpayne@69 1298 proc ::tcl::clock::FreeScan { string base timezone locale } {
jpayne@69 1299
jpayne@69 1300 variable TZData
jpayne@69 1301
jpayne@69 1302 # Get the data for time changes in the given zone
jpayne@69 1303
jpayne@69 1304 try {
jpayne@69 1305 SetupTimeZone $timezone
jpayne@69 1306 } on error {retval opts} {
jpayne@69 1307 dict unset opts -errorinfo
jpayne@69 1308 return -options $opts $retval
jpayne@69 1309 }
jpayne@69 1310
jpayne@69 1311 # Extract year, month and day from the base time for the parser to use as
jpayne@69 1312 # defaults
jpayne@69 1313
jpayne@69 1314 set date [GetDateFields $base $TZData($timezone) 2361222]
jpayne@69 1315 dict set date secondOfDay [expr {
jpayne@69 1316 [dict get $date localSeconds] % 86400
jpayne@69 1317 }]
jpayne@69 1318
jpayne@69 1319 # Parse the date. The parser will return a list comprising date, time,
jpayne@69 1320 # time zone, relative month/day/seconds, relative weekday, ordinal month.
jpayne@69 1321
jpayne@69 1322 try {
jpayne@69 1323 set scanned [Oldscan $string \
jpayne@69 1324 [dict get $date year] \
jpayne@69 1325 [dict get $date month] \
jpayne@69 1326 [dict get $date dayOfMonth]]
jpayne@69 1327 lassign $scanned \
jpayne@69 1328 parseDate parseTime parseZone parseRel \
jpayne@69 1329 parseWeekday parseOrdinalMonth
jpayne@69 1330 } on error message {
jpayne@69 1331 return -code error \
jpayne@69 1332 "unable to convert date-time string \"$string\": $message"
jpayne@69 1333 }
jpayne@69 1334
jpayne@69 1335 # If the caller supplied a date in the string, update the 'date' dict with
jpayne@69 1336 # the value. If the caller didn't specify a time with the date, default to
jpayne@69 1337 # midnight.
jpayne@69 1338
jpayne@69 1339 if { [llength $parseDate] > 0 } {
jpayne@69 1340 lassign $parseDate y m d
jpayne@69 1341 if { $y < 100 } {
jpayne@69 1342 if { $y >= 39 } {
jpayne@69 1343 incr y 1900
jpayne@69 1344 } else {
jpayne@69 1345 incr y 2000
jpayne@69 1346 }
jpayne@69 1347 }
jpayne@69 1348 dict set date era CE
jpayne@69 1349 dict set date year $y
jpayne@69 1350 dict set date month $m
jpayne@69 1351 dict set date dayOfMonth $d
jpayne@69 1352 if { $parseTime eq {} } {
jpayne@69 1353 set parseTime 0
jpayne@69 1354 }
jpayne@69 1355 }
jpayne@69 1356
jpayne@69 1357 # If the caller supplied a time zone in the string, it comes back as a
jpayne@69 1358 # two-element list; the first element is the number of minutes east of
jpayne@69 1359 # Greenwich, and the second is a Daylight Saving Time indicator (1 == yes,
jpayne@69 1360 # 0 == no, -1 == unknown). We make it into a time zone indicator of
jpayne@69 1361 # +-hhmm.
jpayne@69 1362
jpayne@69 1363 if { [llength $parseZone] > 0 } {
jpayne@69 1364 lassign $parseZone minEast dstFlag
jpayne@69 1365 set timezone [FormatNumericTimeZone \
jpayne@69 1366 [expr { 60 * $minEast + 3600 * $dstFlag }]]
jpayne@69 1367 SetupTimeZone $timezone
jpayne@69 1368 }
jpayne@69 1369 dict set date tzName $timezone
jpayne@69 1370
jpayne@69 1371 # Assemble date, time, zone into seconds-from-epoch
jpayne@69 1372
jpayne@69 1373 set date [GetJulianDayFromEraYearMonthDay $date[set date {}] 2361222]
jpayne@69 1374 if { $parseTime ne {} } {
jpayne@69 1375 dict set date secondOfDay $parseTime
jpayne@69 1376 } elseif { [llength $parseWeekday] != 0
jpayne@69 1377 || [llength $parseOrdinalMonth] != 0
jpayne@69 1378 || ( [llength $parseRel] != 0
jpayne@69 1379 && ( [lindex $parseRel 0] != 0
jpayne@69 1380 || [lindex $parseRel 1] != 0 ) ) } {
jpayne@69 1381 dict set date secondOfDay 0
jpayne@69 1382 }
jpayne@69 1383
jpayne@69 1384 dict set date localSeconds [expr {
jpayne@69 1385 -210866803200
jpayne@69 1386 + ( 86400 * wide([dict get $date julianDay]) )
jpayne@69 1387 + [dict get $date secondOfDay]
jpayne@69 1388 }]
jpayne@69 1389 dict set date tzName $timezone
jpayne@69 1390 set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222]
jpayne@69 1391 set seconds [dict get $date seconds]
jpayne@69 1392
jpayne@69 1393 # Do relative times
jpayne@69 1394
jpayne@69 1395 if { [llength $parseRel] > 0 } {
jpayne@69 1396 lassign $parseRel relMonth relDay relSecond
jpayne@69 1397 set seconds [add $seconds \
jpayne@69 1398 $relMonth months $relDay days $relSecond seconds \
jpayne@69 1399 -timezone $timezone -locale $locale]
jpayne@69 1400 }
jpayne@69 1401
jpayne@69 1402 # Do relative weekday
jpayne@69 1403
jpayne@69 1404 if { [llength $parseWeekday] > 0 } {
jpayne@69 1405 lassign $parseWeekday dayOrdinal dayOfWeek
jpayne@69 1406 set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
jpayne@69 1407 dict set date2 era CE
jpayne@69 1408 set jdwkday [WeekdayOnOrBefore $dayOfWeek [expr {
jpayne@69 1409 [dict get $date2 julianDay] + 6
jpayne@69 1410 }]]
jpayne@69 1411 incr jdwkday [expr { 7 * $dayOrdinal }]
jpayne@69 1412 if { $dayOrdinal > 0 } {
jpayne@69 1413 incr jdwkday -7
jpayne@69 1414 }
jpayne@69 1415 dict set date2 secondOfDay \
jpayne@69 1416 [expr { [dict get $date2 localSeconds] % 86400 }]
jpayne@69 1417 dict set date2 julianDay $jdwkday
jpayne@69 1418 dict set date2 localSeconds [expr {
jpayne@69 1419 -210866803200
jpayne@69 1420 + ( 86400 * wide([dict get $date2 julianDay]) )
jpayne@69 1421 + [dict get $date secondOfDay]
jpayne@69 1422 }]
jpayne@69 1423 dict set date2 tzName $timezone
jpayne@69 1424 set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
jpayne@69 1425 2361222]
jpayne@69 1426 set seconds [dict get $date2 seconds]
jpayne@69 1427
jpayne@69 1428 }
jpayne@69 1429
jpayne@69 1430 # Do relative month
jpayne@69 1431
jpayne@69 1432 if { [llength $parseOrdinalMonth] > 0 } {
jpayne@69 1433 lassign $parseOrdinalMonth monthOrdinal monthNumber
jpayne@69 1434 if { $monthOrdinal > 0 } {
jpayne@69 1435 set monthDiff [expr { $monthNumber - [dict get $date month] }]
jpayne@69 1436 if { $monthDiff <= 0 } {
jpayne@69 1437 incr monthDiff 12
jpayne@69 1438 }
jpayne@69 1439 incr monthOrdinal -1
jpayne@69 1440 } else {
jpayne@69 1441 set monthDiff [expr { [dict get $date month] - $monthNumber }]
jpayne@69 1442 if { $monthDiff >= 0 } {
jpayne@69 1443 incr monthDiff -12
jpayne@69 1444 }
jpayne@69 1445 incr monthOrdinal
jpayne@69 1446 }
jpayne@69 1447 set seconds [add $seconds $monthOrdinal years $monthDiff months \
jpayne@69 1448 -timezone $timezone -locale $locale]
jpayne@69 1449 }
jpayne@69 1450
jpayne@69 1451 return $seconds
jpayne@69 1452 }
jpayne@69 1453
jpayne@69 1454
jpayne@69 1455 #----------------------------------------------------------------------
jpayne@69 1456 #
jpayne@69 1457 # ParseClockScanFormat --
jpayne@69 1458 #
jpayne@69 1459 # Parses a format string given to [clock scan -format]
jpayne@69 1460 #
jpayne@69 1461 # Parameters:
jpayne@69 1462 # formatString - The format being parsed
jpayne@69 1463 # locale - The current locale
jpayne@69 1464 #
jpayne@69 1465 # Results:
jpayne@69 1466 # Constructs and returns a procedure that accepts the string being
jpayne@69 1467 # scanned, the base time, and the time zone. The procedure will either
jpayne@69 1468 # return the scanned time or else throw an error that should be rethrown
jpayne@69 1469 # to the caller of [clock scan]
jpayne@69 1470 #
jpayne@69 1471 # Side effects:
jpayne@69 1472 # The given procedure is defined in the ::tcl::clock namespace. Scan
jpayne@69 1473 # procedures are not deleted once installed.
jpayne@69 1474 #
jpayne@69 1475 # Why do we parse dates by defining a procedure to parse them? The reason is
jpayne@69 1476 # that by doing so, we have one convenient place to cache all the information:
jpayne@69 1477 # the regular expressions that match the patterns (which will be compiled),
jpayne@69 1478 # the code that assembles the date information, everything lands in one place.
jpayne@69 1479 # In this way, when a given format is reused at run time, all the information
jpayne@69 1480 # of how to apply it is available in a single place.
jpayne@69 1481 #
jpayne@69 1482 #----------------------------------------------------------------------
jpayne@69 1483
jpayne@69 1484 proc ::tcl::clock::ParseClockScanFormat {formatString locale} {
jpayne@69 1485 # Check whether the format has been parsed previously, and return the
jpayne@69 1486 # existing recognizer if it has.
jpayne@69 1487
jpayne@69 1488 set procName scanproc'$formatString'$locale
jpayne@69 1489 set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
jpayne@69 1490 if { [namespace which $procName] != {} } {
jpayne@69 1491 return $procName
jpayne@69 1492 }
jpayne@69 1493
jpayne@69 1494 variable DateParseActions
jpayne@69 1495 variable TimeParseActions
jpayne@69 1496
jpayne@69 1497 # Localize the %x, %X, etc. groups
jpayne@69 1498
jpayne@69 1499 set formatString [LocalizeFormat $locale $formatString]
jpayne@69 1500
jpayne@69 1501 # Condense whitespace
jpayne@69 1502
jpayne@69 1503 regsub -all {[[:space:]]+} $formatString { } formatString
jpayne@69 1504
jpayne@69 1505 # Walk through the groups of the format string. In this loop, we
jpayne@69 1506 # accumulate:
jpayne@69 1507 # - a regular expression that matches the string,
jpayne@69 1508 # - the count of capturing brackets in the regexp
jpayne@69 1509 # - a set of code that post-processes the fields captured by the regexp,
jpayne@69 1510 # - a dictionary whose keys are the names of fields that are present
jpayne@69 1511 # in the format string.
jpayne@69 1512
jpayne@69 1513 set re {^[[:space:]]*}
jpayne@69 1514 set captureCount 0
jpayne@69 1515 set postcode {}
jpayne@69 1516 set fieldSet [dict create]
jpayne@69 1517 set fieldCount 0
jpayne@69 1518 set postSep {}
jpayne@69 1519 set state {}
jpayne@69 1520
jpayne@69 1521 foreach c [split $formatString {}] {
jpayne@69 1522 switch -exact -- $state {
jpayne@69 1523 {} {
jpayne@69 1524 if { $c eq "%" } {
jpayne@69 1525 set state %
jpayne@69 1526 } elseif { $c eq " " } {
jpayne@69 1527 append re {[[:space:]]+}
jpayne@69 1528 } else {
jpayne@69 1529 if { ! [string is alnum $c] } {
jpayne@69 1530 append re "\\"
jpayne@69 1531 }
jpayne@69 1532 append re $c
jpayne@69 1533 }
jpayne@69 1534 }
jpayne@69 1535 % {
jpayne@69 1536 set state {}
jpayne@69 1537 switch -exact -- $c {
jpayne@69 1538 % {
jpayne@69 1539 append re %
jpayne@69 1540 }
jpayne@69 1541 { } {
jpayne@69 1542 append re "\[\[:space:\]\]*"
jpayne@69 1543 }
jpayne@69 1544 a - A { # Day of week, in words
jpayne@69 1545 set l {}
jpayne@69 1546 foreach \
jpayne@69 1547 i {7 1 2 3 4 5 6} \
jpayne@69 1548 abr [mc DAYS_OF_WEEK_ABBREV] \
jpayne@69 1549 full [mc DAYS_OF_WEEK_FULL] {
jpayne@69 1550 dict set l [string tolower $abr] $i
jpayne@69 1551 dict set l [string tolower $full] $i
jpayne@69 1552 incr i
jpayne@69 1553 }
jpayne@69 1554 lassign [UniquePrefixRegexp $l] regex lookup
jpayne@69 1555 append re ( $regex )
jpayne@69 1556 dict set fieldSet dayOfWeek [incr fieldCount]
jpayne@69 1557 append postcode "dict set date dayOfWeek \[" \
jpayne@69 1558 "dict get " [list $lookup] " " \
jpayne@69 1559 \[ {string tolower $field} [incr captureCount] \] \
jpayne@69 1560 "\]\n"
jpayne@69 1561 }
jpayne@69 1562 b - B - h { # Name of month
jpayne@69 1563 set i 0
jpayne@69 1564 set l {}
jpayne@69 1565 foreach \
jpayne@69 1566 abr [mc MONTHS_ABBREV] \
jpayne@69 1567 full [mc MONTHS_FULL] {
jpayne@69 1568 incr i
jpayne@69 1569 dict set l [string tolower $abr] $i
jpayne@69 1570 dict set l [string tolower $full] $i
jpayne@69 1571 }
jpayne@69 1572 lassign [UniquePrefixRegexp $l] regex lookup
jpayne@69 1573 append re ( $regex )
jpayne@69 1574 dict set fieldSet month [incr fieldCount]
jpayne@69 1575 append postcode "dict set date month \[" \
jpayne@69 1576 "dict get " [list $lookup] \
jpayne@69 1577 " " \[ {string tolower $field} \
jpayne@69 1578 [incr captureCount] \] \
jpayne@69 1579 "\]\n"
jpayne@69 1580 }
jpayne@69 1581 C { # Gregorian century
jpayne@69 1582 append re \\s*(\\d\\d?)
jpayne@69 1583 dict set fieldSet century [incr fieldCount]
jpayne@69 1584 append postcode "dict set date century \[" \
jpayne@69 1585 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1586 "\]\n"
jpayne@69 1587 }
jpayne@69 1588 d - e { # Day of month
jpayne@69 1589 append re \\s*(\\d\\d?)
jpayne@69 1590 dict set fieldSet dayOfMonth [incr fieldCount]
jpayne@69 1591 append postcode "dict set date dayOfMonth \[" \
jpayne@69 1592 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1593 "\]\n"
jpayne@69 1594 }
jpayne@69 1595 E { # Prefix for locale-specific codes
jpayne@69 1596 set state %E
jpayne@69 1597 }
jpayne@69 1598 g { # ISO8601 2-digit year
jpayne@69 1599 append re \\s*(\\d\\d)
jpayne@69 1600 dict set fieldSet iso8601YearOfCentury \
jpayne@69 1601 [incr fieldCount]
jpayne@69 1602 append postcode \
jpayne@69 1603 "dict set date iso8601YearOfCentury \[" \
jpayne@69 1604 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1605 "\]\n"
jpayne@69 1606 }
jpayne@69 1607 G { # ISO8601 4-digit year
jpayne@69 1608 append re \\s*(\\d\\d)(\\d\\d)
jpayne@69 1609 dict set fieldSet iso8601Century [incr fieldCount]
jpayne@69 1610 dict set fieldSet iso8601YearOfCentury \
jpayne@69 1611 [incr fieldCount]
jpayne@69 1612 append postcode \
jpayne@69 1613 "dict set date iso8601Century \[" \
jpayne@69 1614 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1615 "\]\n" \
jpayne@69 1616 "dict set date iso8601YearOfCentury \[" \
jpayne@69 1617 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1618 "\]\n"
jpayne@69 1619 }
jpayne@69 1620 H - k { # Hour of day
jpayne@69 1621 append re \\s*(\\d\\d?)
jpayne@69 1622 dict set fieldSet hour [incr fieldCount]
jpayne@69 1623 append postcode "dict set date hour \[" \
jpayne@69 1624 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1625 "\]\n"
jpayne@69 1626 }
jpayne@69 1627 I - l { # Hour, AM/PM
jpayne@69 1628 append re \\s*(\\d\\d?)
jpayne@69 1629 dict set fieldSet hourAMPM [incr fieldCount]
jpayne@69 1630 append postcode "dict set date hourAMPM \[" \
jpayne@69 1631 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1632 "\]\n"
jpayne@69 1633 }
jpayne@69 1634 j { # Day of year
jpayne@69 1635 append re \\s*(\\d\\d?\\d?)
jpayne@69 1636 dict set fieldSet dayOfYear [incr fieldCount]
jpayne@69 1637 append postcode "dict set date dayOfYear \[" \
jpayne@69 1638 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1639 "\]\n"
jpayne@69 1640 }
jpayne@69 1641 J { # Julian Day Number
jpayne@69 1642 append re \\s*(\\d+)
jpayne@69 1643 dict set fieldSet julianDay [incr fieldCount]
jpayne@69 1644 append postcode "dict set date julianDay \[" \
jpayne@69 1645 "::scan \$field" [incr captureCount] " %ld" \
jpayne@69 1646 "\]\n"
jpayne@69 1647 }
jpayne@69 1648 m - N { # Month number
jpayne@69 1649 append re \\s*(\\d\\d?)
jpayne@69 1650 dict set fieldSet month [incr fieldCount]
jpayne@69 1651 append postcode "dict set date month \[" \
jpayne@69 1652 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1653 "\]\n"
jpayne@69 1654 }
jpayne@69 1655 M { # Minute
jpayne@69 1656 append re \\s*(\\d\\d?)
jpayne@69 1657 dict set fieldSet minute [incr fieldCount]
jpayne@69 1658 append postcode "dict set date minute \[" \
jpayne@69 1659 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1660 "\]\n"
jpayne@69 1661 }
jpayne@69 1662 n { # Literal newline
jpayne@69 1663 append re \\n
jpayne@69 1664 }
jpayne@69 1665 O { # Prefix for locale numerics
jpayne@69 1666 set state %O
jpayne@69 1667 }
jpayne@69 1668 p - P { # AM/PM indicator
jpayne@69 1669 set l [list [string tolower [mc AM]] 0 \
jpayne@69 1670 [string tolower [mc PM]] 1]
jpayne@69 1671 lassign [UniquePrefixRegexp $l] regex lookup
jpayne@69 1672 append re ( $regex )
jpayne@69 1673 dict set fieldSet amPmIndicator [incr fieldCount]
jpayne@69 1674 append postcode "dict set date amPmIndicator \[" \
jpayne@69 1675 "dict get " [list $lookup] " \[string tolower " \
jpayne@69 1676 "\$field" \
jpayne@69 1677 [incr captureCount] \
jpayne@69 1678 "\]\]\n"
jpayne@69 1679 }
jpayne@69 1680 Q { # Hi, Jeff!
jpayne@69 1681 append re {Stardate\s+([-+]?\d+)(\d\d\d)[.](\d)}
jpayne@69 1682 incr captureCount
jpayne@69 1683 dict set fieldSet seconds [incr fieldCount]
jpayne@69 1684 append postcode {dict set date seconds } \[ \
jpayne@69 1685 {ParseStarDate $field} [incr captureCount] \
jpayne@69 1686 { $field} [incr captureCount] \
jpayne@69 1687 { $field} [incr captureCount] \
jpayne@69 1688 \] \n
jpayne@69 1689 }
jpayne@69 1690 s { # Seconds from Posix Epoch
jpayne@69 1691 # This next case is insanely difficult, because it's
jpayne@69 1692 # problematic to determine whether the field is
jpayne@69 1693 # actually within the range of a wide integer.
jpayne@69 1694 append re {\s*([-+]?\d+)}
jpayne@69 1695 dict set fieldSet seconds [incr fieldCount]
jpayne@69 1696 append postcode {dict set date seconds } \[ \
jpayne@69 1697 {ScanWide $field} [incr captureCount] \] \n
jpayne@69 1698 }
jpayne@69 1699 S { # Second
jpayne@69 1700 append re \\s*(\\d\\d?)
jpayne@69 1701 dict set fieldSet second [incr fieldCount]
jpayne@69 1702 append postcode "dict set date second \[" \
jpayne@69 1703 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1704 "\]\n"
jpayne@69 1705 }
jpayne@69 1706 t { # Literal tab character
jpayne@69 1707 append re \\t
jpayne@69 1708 }
jpayne@69 1709 u - w { # Day number within week, 0 or 7 == Sun
jpayne@69 1710 # 1=Mon, 6=Sat
jpayne@69 1711 append re \\s*(\\d)
jpayne@69 1712 dict set fieldSet dayOfWeek [incr fieldCount]
jpayne@69 1713 append postcode {::scan $field} [incr captureCount] \
jpayne@69 1714 { %d dow} \n \
jpayne@69 1715 {
jpayne@69 1716 if { $dow == 0 } {
jpayne@69 1717 set dow 7
jpayne@69 1718 } elseif { $dow > 7 } {
jpayne@69 1719 return -code error \
jpayne@69 1720 -errorcode [list CLOCK badDayOfWeek] \
jpayne@69 1721 "day of week is greater than 7"
jpayne@69 1722 }
jpayne@69 1723 dict set date dayOfWeek $dow
jpayne@69 1724 }
jpayne@69 1725 }
jpayne@69 1726 U { # Week of year. The first Sunday of
jpayne@69 1727 # the year is the first day of week
jpayne@69 1728 # 01. No scan rule uses this group.
jpayne@69 1729 append re \\s*\\d\\d?
jpayne@69 1730 }
jpayne@69 1731 V { # Week of ISO8601 year
jpayne@69 1732
jpayne@69 1733 append re \\s*(\\d\\d?)
jpayne@69 1734 dict set fieldSet iso8601Week [incr fieldCount]
jpayne@69 1735 append postcode "dict set date iso8601Week \[" \
jpayne@69 1736 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1737 "\]\n"
jpayne@69 1738 }
jpayne@69 1739 W { # Week of the year (00-53). The first
jpayne@69 1740 # Monday of the year is the first day
jpayne@69 1741 # of week 01. No scan rule uses this
jpayne@69 1742 # group.
jpayne@69 1743 append re \\s*\\d\\d?
jpayne@69 1744 }
jpayne@69 1745 y { # Two-digit Gregorian year
jpayne@69 1746 append re \\s*(\\d\\d?)
jpayne@69 1747 dict set fieldSet yearOfCentury [incr fieldCount]
jpayne@69 1748 append postcode "dict set date yearOfCentury \[" \
jpayne@69 1749 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1750 "\]\n"
jpayne@69 1751 }
jpayne@69 1752 Y { # 4-digit Gregorian year
jpayne@69 1753 append re \\s*(\\d\\d)(\\d\\d)
jpayne@69 1754 dict set fieldSet century [incr fieldCount]
jpayne@69 1755 dict set fieldSet yearOfCentury [incr fieldCount]
jpayne@69 1756 append postcode \
jpayne@69 1757 "dict set date century \[" \
jpayne@69 1758 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1759 "\]\n" \
jpayne@69 1760 "dict set date yearOfCentury \[" \
jpayne@69 1761 "::scan \$field" [incr captureCount] " %d" \
jpayne@69 1762 "\]\n"
jpayne@69 1763 }
jpayne@69 1764 z - Z { # Time zone name
jpayne@69 1765 append re {(?:([-+]\d\d(?::?\d\d(?::?\d\d)?)?)|([[:alnum:]]{1,4}))}
jpayne@69 1766 dict set fieldSet tzName [incr fieldCount]
jpayne@69 1767 append postcode \
jpayne@69 1768 {if } \{ { $field} [incr captureCount] \
jpayne@69 1769 { ne "" } \} { } \{ \n \
jpayne@69 1770 {dict set date tzName $field} \
jpayne@69 1771 $captureCount \n \
jpayne@69 1772 \} { else } \{ \n \
jpayne@69 1773 {dict set date tzName } \[ \
jpayne@69 1774 {ConvertLegacyTimeZone $field} \
jpayne@69 1775 [incr captureCount] \] \n \
jpayne@69 1776 \} \n \
jpayne@69 1777 }
jpayne@69 1778 % { # Literal percent character
jpayne@69 1779 append re %
jpayne@69 1780 }
jpayne@69 1781 default {
jpayne@69 1782 append re %
jpayne@69 1783 if { ! [string is alnum $c] } {
jpayne@69 1784 append re \\
jpayne@69 1785 }
jpayne@69 1786 append re $c
jpayne@69 1787 }
jpayne@69 1788 }
jpayne@69 1789 }
jpayne@69 1790 %E {
jpayne@69 1791 switch -exact -- $c {
jpayne@69 1792 C { # Locale-dependent era
jpayne@69 1793 set d {}
jpayne@69 1794 foreach triple [mc LOCALE_ERAS] {
jpayne@69 1795 lassign $triple t symbol year
jpayne@69 1796 dict set d [string tolower $symbol] $year
jpayne@69 1797 }
jpayne@69 1798 lassign [UniquePrefixRegexp $d] regex lookup
jpayne@69 1799 append re (?: $regex )
jpayne@69 1800 }
jpayne@69 1801 E {
jpayne@69 1802 set l {}
jpayne@69 1803 dict set l [string tolower [mc BCE]] BCE
jpayne@69 1804 dict set l [string tolower [mc CE]] CE
jpayne@69 1805 dict set l b.c.e. BCE
jpayne@69 1806 dict set l c.e. CE
jpayne@69 1807 dict set l b.c. BCE
jpayne@69 1808 dict set l a.d. CE
jpayne@69 1809 lassign [UniquePrefixRegexp $l] regex lookup
jpayne@69 1810 append re ( $regex )
jpayne@69 1811 dict set fieldSet era [incr fieldCount]
jpayne@69 1812 append postcode "dict set date era \["\
jpayne@69 1813 "dict get " [list $lookup] \
jpayne@69 1814 { } \[ {string tolower $field} \
jpayne@69 1815 [incr captureCount] \] \
jpayne@69 1816 "\]\n"
jpayne@69 1817 }
jpayne@69 1818 y { # Locale-dependent year of the era
jpayne@69 1819 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1820 append re $regex
jpayne@69 1821 incr captureCount
jpayne@69 1822 }
jpayne@69 1823 default {
jpayne@69 1824 append re %E
jpayne@69 1825 if { ! [string is alnum $c] } {
jpayne@69 1826 append re \\
jpayne@69 1827 }
jpayne@69 1828 append re $c
jpayne@69 1829 }
jpayne@69 1830 }
jpayne@69 1831 set state {}
jpayne@69 1832 }
jpayne@69 1833 %O {
jpayne@69 1834 switch -exact -- $c {
jpayne@69 1835 d - e {
jpayne@69 1836 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1837 append re $regex
jpayne@69 1838 dict set fieldSet dayOfMonth [incr fieldCount]
jpayne@69 1839 append postcode "dict set date dayOfMonth \[" \
jpayne@69 1840 "dict get " [list $lookup] " \$field" \
jpayne@69 1841 [incr captureCount] \
jpayne@69 1842 "\]\n"
jpayne@69 1843 }
jpayne@69 1844 H - k {
jpayne@69 1845 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1846 append re $regex
jpayne@69 1847 dict set fieldSet hour [incr fieldCount]
jpayne@69 1848 append postcode "dict set date hour \[" \
jpayne@69 1849 "dict get " [list $lookup] " \$field" \
jpayne@69 1850 [incr captureCount] \
jpayne@69 1851 "\]\n"
jpayne@69 1852 }
jpayne@69 1853 I - l {
jpayne@69 1854 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1855 append re $regex
jpayne@69 1856 dict set fieldSet hourAMPM [incr fieldCount]
jpayne@69 1857 append postcode "dict set date hourAMPM \[" \
jpayne@69 1858 "dict get " [list $lookup] " \$field" \
jpayne@69 1859 [incr captureCount] \
jpayne@69 1860 "\]\n"
jpayne@69 1861 }
jpayne@69 1862 m {
jpayne@69 1863 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1864 append re $regex
jpayne@69 1865 dict set fieldSet month [incr fieldCount]
jpayne@69 1866 append postcode "dict set date month \[" \
jpayne@69 1867 "dict get " [list $lookup] " \$field" \
jpayne@69 1868 [incr captureCount] \
jpayne@69 1869 "\]\n"
jpayne@69 1870 }
jpayne@69 1871 M {
jpayne@69 1872 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1873 append re $regex
jpayne@69 1874 dict set fieldSet minute [incr fieldCount]
jpayne@69 1875 append postcode "dict set date minute \[" \
jpayne@69 1876 "dict get " [list $lookup] " \$field" \
jpayne@69 1877 [incr captureCount] \
jpayne@69 1878 "\]\n"
jpayne@69 1879 }
jpayne@69 1880 S {
jpayne@69 1881 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1882 append re $regex
jpayne@69 1883 dict set fieldSet second [incr fieldCount]
jpayne@69 1884 append postcode "dict set date second \[" \
jpayne@69 1885 "dict get " [list $lookup] " \$field" \
jpayne@69 1886 [incr captureCount] \
jpayne@69 1887 "\]\n"
jpayne@69 1888 }
jpayne@69 1889 u - w {
jpayne@69 1890 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1891 append re $regex
jpayne@69 1892 dict set fieldSet dayOfWeek [incr fieldCount]
jpayne@69 1893 append postcode "set dow \[dict get " [list $lookup] \
jpayne@69 1894 { $field} [incr captureCount] \] \n \
jpayne@69 1895 {
jpayne@69 1896 if { $dow == 0 } {
jpayne@69 1897 set dow 7
jpayne@69 1898 } elseif { $dow > 7 } {
jpayne@69 1899 return -code error \
jpayne@69 1900 -errorcode [list CLOCK badDayOfWeek] \
jpayne@69 1901 "day of week is greater than 7"
jpayne@69 1902 }
jpayne@69 1903 dict set date dayOfWeek $dow
jpayne@69 1904 }
jpayne@69 1905 }
jpayne@69 1906 y {
jpayne@69 1907 lassign [LocaleNumeralMatcher $locale] regex lookup
jpayne@69 1908 append re $regex
jpayne@69 1909 dict set fieldSet yearOfCentury [incr fieldCount]
jpayne@69 1910 append postcode {dict set date yearOfCentury } \[ \
jpayne@69 1911 {dict get } [list $lookup] { $field} \
jpayne@69 1912 [incr captureCount] \] \n
jpayne@69 1913 }
jpayne@69 1914 default {
jpayne@69 1915 append re %O
jpayne@69 1916 if { ! [string is alnum $c] } {
jpayne@69 1917 append re \\
jpayne@69 1918 }
jpayne@69 1919 append re $c
jpayne@69 1920 }
jpayne@69 1921 }
jpayne@69 1922 set state {}
jpayne@69 1923 }
jpayne@69 1924 }
jpayne@69 1925 }
jpayne@69 1926
jpayne@69 1927 # Clean up any unfinished format groups
jpayne@69 1928
jpayne@69 1929 append re $state \\s*\$
jpayne@69 1930
jpayne@69 1931 # Build the procedure
jpayne@69 1932
jpayne@69 1933 set procBody {}
jpayne@69 1934 append procBody "variable ::tcl::clock::TZData" \n
jpayne@69 1935 append procBody "if \{ !\[ regexp -nocase [list $re] \$string ->"
jpayne@69 1936 for { set i 1 } { $i <= $captureCount } { incr i } {
jpayne@69 1937 append procBody " " field $i
jpayne@69 1938 }
jpayne@69 1939 append procBody "\] \} \{" \n
jpayne@69 1940 append procBody {
jpayne@69 1941 return -code error -errorcode [list CLOCK badInputString] \
jpayne@69 1942 {input string does not match supplied format}
jpayne@69 1943 }
jpayne@69 1944 append procBody \}\n
jpayne@69 1945 append procBody "set date \[dict create\]" \n
jpayne@69 1946 append procBody {dict set date tzName $timeZone} \n
jpayne@69 1947 append procBody $postcode
jpayne@69 1948 append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n
jpayne@69 1949
jpayne@69 1950 # Set up the time zone before doing anything with a default base date
jpayne@69 1951 # that might need a timezone to interpret it.
jpayne@69 1952
jpayne@69 1953 if { ![dict exists $fieldSet seconds]
jpayne@69 1954 && ![dict exists $fieldSet starDate] } {
jpayne@69 1955 if { [dict exists $fieldSet tzName] } {
jpayne@69 1956 append procBody {
jpayne@69 1957 set timeZone [dict get $date tzName]
jpayne@69 1958 }
jpayne@69 1959 }
jpayne@69 1960 append procBody {
jpayne@69 1961 ::tcl::clock::SetupTimeZone $timeZone
jpayne@69 1962 }
jpayne@69 1963 }
jpayne@69 1964
jpayne@69 1965 # Add code that gets Julian Day Number from the fields.
jpayne@69 1966
jpayne@69 1967 append procBody [MakeParseCodeFromFields $fieldSet $DateParseActions]
jpayne@69 1968
jpayne@69 1969 # Get time of day
jpayne@69 1970
jpayne@69 1971 append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]
jpayne@69 1972
jpayne@69 1973 # Assemble seconds from the Julian day and second of the day.
jpayne@69 1974 # Convert to local time unless epoch seconds or stardate are
jpayne@69 1975 # being processed - they're always absolute
jpayne@69 1976
jpayne@69 1977 if { ![dict exists $fieldSet seconds]
jpayne@69 1978 && ![dict exists $fieldSet starDate] } {
jpayne@69 1979 append procBody {
jpayne@69 1980 if { [dict get $date julianDay] > 5373484 } {
jpayne@69 1981 return -code error -errorcode [list CLOCK dateTooLarge] \
jpayne@69 1982 "requested date too large to represent"
jpayne@69 1983 }
jpayne@69 1984 dict set date localSeconds [expr {
jpayne@69 1985 -210866803200
jpayne@69 1986 + ( 86400 * wide([dict get $date julianDay]) )
jpayne@69 1987 + [dict get $date secondOfDay]
jpayne@69 1988 }]
jpayne@69 1989 }
jpayne@69 1990
jpayne@69 1991 # Finally, convert the date to local time
jpayne@69 1992
jpayne@69 1993 append procBody {
jpayne@69 1994 set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
jpayne@69 1995 $TZData($timeZone) $changeover]
jpayne@69 1996 }
jpayne@69 1997 }
jpayne@69 1998
jpayne@69 1999 # Return result
jpayne@69 2000
jpayne@69 2001 append procBody {return [dict get $date seconds]} \n
jpayne@69 2002
jpayne@69 2003 proc $procName { string baseTime timeZone } $procBody
jpayne@69 2004
jpayne@69 2005 # puts [list proc $procName [list string baseTime timeZone] $procBody]
jpayne@69 2006
jpayne@69 2007 return $procName
jpayne@69 2008 }
jpayne@69 2009
jpayne@69 2010 #----------------------------------------------------------------------
jpayne@69 2011 #
jpayne@69 2012 # LocaleNumeralMatcher --
jpayne@69 2013 #
jpayne@69 2014 # Composes a regexp that captures the numerals in the given locale, and
jpayne@69 2015 # a dictionary to map them to conventional numerals.
jpayne@69 2016 #
jpayne@69 2017 # Parameters:
jpayne@69 2018 # locale - Name of the current locale
jpayne@69 2019 #
jpayne@69 2020 # Results:
jpayne@69 2021 # Returns a two-element list comprising the regexp and the dictionary.
jpayne@69 2022 #
jpayne@69 2023 # Side effects:
jpayne@69 2024 # Caches the result.
jpayne@69 2025 #
jpayne@69 2026 #----------------------------------------------------------------------
jpayne@69 2027
jpayne@69 2028 proc ::tcl::clock::LocaleNumeralMatcher {l} {
jpayne@69 2029 variable LocaleNumeralCache
jpayne@69 2030
jpayne@69 2031 if { ![dict exists $LocaleNumeralCache $l] } {
jpayne@69 2032 set d {}
jpayne@69 2033 set i 0
jpayne@69 2034 set sep \(
jpayne@69 2035 foreach n [mc LOCALE_NUMERALS] {
jpayne@69 2036 dict set d $n $i
jpayne@69 2037 regsub -all {[^[:alnum:]]} $n \\\\& subex
jpayne@69 2038 append re $sep $subex
jpayne@69 2039 set sep |
jpayne@69 2040 incr i
jpayne@69 2041 }
jpayne@69 2042 append re \)
jpayne@69 2043 dict set LocaleNumeralCache $l [list $re $d]
jpayne@69 2044 }
jpayne@69 2045 return [dict get $LocaleNumeralCache $l]
jpayne@69 2046 }
jpayne@69 2047
jpayne@69 2048
jpayne@69 2049
jpayne@69 2050 #----------------------------------------------------------------------
jpayne@69 2051 #
jpayne@69 2052 # UniquePrefixRegexp --
jpayne@69 2053 #
jpayne@69 2054 # Composes a regexp that performs unique-prefix matching. The RE
jpayne@69 2055 # matches one of a supplied set of strings, or any unique prefix
jpayne@69 2056 # thereof.
jpayne@69 2057 #
jpayne@69 2058 # Parameters:
jpayne@69 2059 # data - List of alternating match-strings and values.
jpayne@69 2060 # Match-strings with distinct values are considered
jpayne@69 2061 # distinct.
jpayne@69 2062 #
jpayne@69 2063 # Results:
jpayne@69 2064 # Returns a two-element list. The first is a regexp that matches any
jpayne@69 2065 # unique prefix of any of the strings. The second is a dictionary whose
jpayne@69 2066 # keys are match values from the regexp and whose values are the
jpayne@69 2067 # corresponding values from 'data'.
jpayne@69 2068 #
jpayne@69 2069 # Side effects:
jpayne@69 2070 # None.
jpayne@69 2071 #
jpayne@69 2072 #----------------------------------------------------------------------
jpayne@69 2073
jpayne@69 2074 proc ::tcl::clock::UniquePrefixRegexp { data } {
jpayne@69 2075 # The 'successors' dictionary will contain, for each string that is a
jpayne@69 2076 # prefix of any key, all characters that may follow that prefix. The
jpayne@69 2077 # 'prefixMapping' dictionary will have keys that are prefixes of keys and
jpayne@69 2078 # values that correspond to the keys.
jpayne@69 2079
jpayne@69 2080 set prefixMapping [dict create]
jpayne@69 2081 set successors [dict create {} {}]
jpayne@69 2082
jpayne@69 2083 # Walk the key-value pairs
jpayne@69 2084
jpayne@69 2085 foreach { key value } $data {
jpayne@69 2086 # Construct all prefixes of the key;
jpayne@69 2087
jpayne@69 2088 set prefix {}
jpayne@69 2089 foreach char [split $key {}] {
jpayne@69 2090 set oldPrefix $prefix
jpayne@69 2091 dict set successors $oldPrefix $char {}
jpayne@69 2092 append prefix $char
jpayne@69 2093
jpayne@69 2094 # Put the prefixes in the 'prefixMapping' and 'successors'
jpayne@69 2095 # dictionaries
jpayne@69 2096
jpayne@69 2097 dict lappend prefixMapping $prefix $value
jpayne@69 2098 if { ![dict exists $successors $prefix] } {
jpayne@69 2099 dict set successors $prefix {}
jpayne@69 2100 }
jpayne@69 2101 }
jpayne@69 2102 }
jpayne@69 2103
jpayne@69 2104 # Identify those prefixes that designate unique values, and those that are
jpayne@69 2105 # the full keys
jpayne@69 2106
jpayne@69 2107 set uniquePrefixMapping {}
jpayne@69 2108 dict for { key valueList } $prefixMapping {
jpayne@69 2109 if { [llength $valueList] == 1 } {
jpayne@69 2110 dict set uniquePrefixMapping $key [lindex $valueList 0]
jpayne@69 2111 }
jpayne@69 2112 }
jpayne@69 2113 foreach { key value } $data {
jpayne@69 2114 dict set uniquePrefixMapping $key $value
jpayne@69 2115 }
jpayne@69 2116
jpayne@69 2117 # Construct the re.
jpayne@69 2118
jpayne@69 2119 return [list \
jpayne@69 2120 [MakeUniquePrefixRegexp $successors $uniquePrefixMapping {}] \
jpayne@69 2121 $uniquePrefixMapping]
jpayne@69 2122 }
jpayne@69 2123
jpayne@69 2124 #----------------------------------------------------------------------
jpayne@69 2125 #
jpayne@69 2126 # MakeUniquePrefixRegexp --
jpayne@69 2127 #
jpayne@69 2128 # Service procedure for 'UniquePrefixRegexp' that constructs a regular
jpayne@69 2129 # expresison that matches the unique prefixes.
jpayne@69 2130 #
jpayne@69 2131 # Parameters:
jpayne@69 2132 # successors - Dictionary whose keys are all prefixes
jpayne@69 2133 # of keys passed to 'UniquePrefixRegexp' and whose
jpayne@69 2134 # values are dictionaries whose keys are the characters
jpayne@69 2135 # that may follow those prefixes.
jpayne@69 2136 # uniquePrefixMapping - Dictionary whose keys are the unique
jpayne@69 2137 # prefixes and whose values are not examined.
jpayne@69 2138 # prefixString - Current prefix being processed.
jpayne@69 2139 #
jpayne@69 2140 # Results:
jpayne@69 2141 # Returns a constructed regular expression that matches the set of
jpayne@69 2142 # unique prefixes beginning with the 'prefixString'.
jpayne@69 2143 #
jpayne@69 2144 # Side effects:
jpayne@69 2145 # None.
jpayne@69 2146 #
jpayne@69 2147 #----------------------------------------------------------------------
jpayne@69 2148
jpayne@69 2149 proc ::tcl::clock::MakeUniquePrefixRegexp { successors
jpayne@69 2150 uniquePrefixMapping
jpayne@69 2151 prefixString } {
jpayne@69 2152
jpayne@69 2153 # Get the characters that may follow the current prefix string
jpayne@69 2154
jpayne@69 2155 set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
jpayne@69 2156 if { [llength $schars] == 0 } {
jpayne@69 2157 return {}
jpayne@69 2158 }
jpayne@69 2159
jpayne@69 2160 # If there is more than one successor character, or if the current prefix
jpayne@69 2161 # is a unique prefix, surround the generated re with non-capturing
jpayne@69 2162 # parentheses.
jpayne@69 2163
jpayne@69 2164 set re {}
jpayne@69 2165 if {
jpayne@69 2166 [dict exists $uniquePrefixMapping $prefixString]
jpayne@69 2167 || [llength $schars] > 1
jpayne@69 2168 } then {
jpayne@69 2169 append re "(?:"
jpayne@69 2170 }
jpayne@69 2171
jpayne@69 2172 # Generate a regexp that matches the successors.
jpayne@69 2173
jpayne@69 2174 set sep ""
jpayne@69 2175 foreach { c } $schars {
jpayne@69 2176 set nextPrefix $prefixString$c
jpayne@69 2177 regsub -all {[^[:alnum:]]} $c \\\\& rechar
jpayne@69 2178 append re $sep $rechar \
jpayne@69 2179 [MakeUniquePrefixRegexp \
jpayne@69 2180 $successors $uniquePrefixMapping $nextPrefix]
jpayne@69 2181 set sep |
jpayne@69 2182 }
jpayne@69 2183
jpayne@69 2184 # If the current prefix is a unique prefix, make all following text
jpayne@69 2185 # optional. Otherwise, if there is more than one successor character,
jpayne@69 2186 # close the non-capturing parentheses.
jpayne@69 2187
jpayne@69 2188 if { [dict exists $uniquePrefixMapping $prefixString] } {
jpayne@69 2189 append re ")?"
jpayne@69 2190 } elseif { [llength $schars] > 1 } {
jpayne@69 2191 append re ")"
jpayne@69 2192 }
jpayne@69 2193
jpayne@69 2194 return $re
jpayne@69 2195 }
jpayne@69 2196
jpayne@69 2197 #----------------------------------------------------------------------
jpayne@69 2198 #
jpayne@69 2199 # MakeParseCodeFromFields --
jpayne@69 2200 #
jpayne@69 2201 # Composes Tcl code to extract the Julian Day Number from a dictionary
jpayne@69 2202 # containing date fields.
jpayne@69 2203 #
jpayne@69 2204 # Parameters:
jpayne@69 2205 # dateFields -- Dictionary whose keys are fields of the date,
jpayne@69 2206 # and whose values are the rightmost positions
jpayne@69 2207 # at which those fields appear.
jpayne@69 2208 # parseActions -- List of triples: field set, priority, and
jpayne@69 2209 # code to emit. Smaller priorities are better, and
jpayne@69 2210 # the list must be in ascending order by priority
jpayne@69 2211 #
jpayne@69 2212 # Results:
jpayne@69 2213 # Returns a burst of code that extracts the day number from the given
jpayne@69 2214 # date.
jpayne@69 2215 #
jpayne@69 2216 # Side effects:
jpayne@69 2217 # None.
jpayne@69 2218 #
jpayne@69 2219 #----------------------------------------------------------------------
jpayne@69 2220
jpayne@69 2221 proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {
jpayne@69 2222
jpayne@69 2223 set currPrio 999
jpayne@69 2224 set currFieldPos [list]
jpayne@69 2225 set currCodeBurst {
jpayne@69 2226 error "in ::tcl::clock::MakeParseCodeFromFields: can't happen"
jpayne@69 2227 }
jpayne@69 2228
jpayne@69 2229 foreach { fieldSet prio parseAction } $parseActions {
jpayne@69 2230 # If we've found an answer that's better than any that follow, quit
jpayne@69 2231 # now.
jpayne@69 2232
jpayne@69 2233 if { $prio > $currPrio } {
jpayne@69 2234 break
jpayne@69 2235 }
jpayne@69 2236
jpayne@69 2237 # Accumulate the field positions that are used in the current field
jpayne@69 2238 # grouping.
jpayne@69 2239
jpayne@69 2240 set fieldPos [list]
jpayne@69 2241 set ok true
jpayne@69 2242 foreach field $fieldSet {
jpayne@69 2243 if { ! [dict exists $dateFields $field] } {
jpayne@69 2244 set ok 0
jpayne@69 2245 break
jpayne@69 2246 }
jpayne@69 2247 lappend fieldPos [dict get $dateFields $field]
jpayne@69 2248 }
jpayne@69 2249
jpayne@69 2250 # Quit if we don't have a complete set of fields
jpayne@69 2251 if { !$ok } {
jpayne@69 2252 continue
jpayne@69 2253 }
jpayne@69 2254
jpayne@69 2255 # Determine whether the current answer is better than the last.
jpayne@69 2256
jpayne@69 2257 set fPos [lsort -integer -decreasing $fieldPos]
jpayne@69 2258
jpayne@69 2259 if { $prio == $currPrio } {
jpayne@69 2260 foreach currPos $currFieldPos newPos $fPos {
jpayne@69 2261 if {
jpayne@69 2262 ![string is integer $newPos]
jpayne@69 2263 || ![string is integer $currPos]
jpayne@69 2264 || $newPos > $currPos
jpayne@69 2265 } then {
jpayne@69 2266 break
jpayne@69 2267 }
jpayne@69 2268 if { $newPos < $currPos } {
jpayne@69 2269 set ok 0
jpayne@69 2270 break
jpayne@69 2271 }
jpayne@69 2272 }
jpayne@69 2273 }
jpayne@69 2274 if { !$ok } {
jpayne@69 2275 continue
jpayne@69 2276 }
jpayne@69 2277
jpayne@69 2278 # Remember the best possibility for extracting date information
jpayne@69 2279
jpayne@69 2280 set currPrio $prio
jpayne@69 2281 set currFieldPos $fPos
jpayne@69 2282 set currCodeBurst $parseAction
jpayne@69 2283 }
jpayne@69 2284
jpayne@69 2285 return $currCodeBurst
jpayne@69 2286 }
jpayne@69 2287
jpayne@69 2288 #----------------------------------------------------------------------
jpayne@69 2289 #
jpayne@69 2290 # EnterLocale --
jpayne@69 2291 #
jpayne@69 2292 # Switch [mclocale] to a given locale if necessary
jpayne@69 2293 #
jpayne@69 2294 # Parameters:
jpayne@69 2295 # locale -- Desired locale
jpayne@69 2296 #
jpayne@69 2297 # Results:
jpayne@69 2298 # Returns the locale that was previously current.
jpayne@69 2299 #
jpayne@69 2300 # Side effects:
jpayne@69 2301 # Does [mclocale]. If necessary, loades the designated locale's files.
jpayne@69 2302 #
jpayne@69 2303 #----------------------------------------------------------------------
jpayne@69 2304
jpayne@69 2305 proc ::tcl::clock::EnterLocale { locale } {
jpayne@69 2306 if { $locale eq {system} } {
jpayne@69 2307 if { $::tcl_platform(platform) ne {windows} } {
jpayne@69 2308 # On a non-windows platform, the 'system' locale is the same as
jpayne@69 2309 # the 'current' locale
jpayne@69 2310
jpayne@69 2311 set locale current
jpayne@69 2312 } else {
jpayne@69 2313 # On a windows platform, the 'system' locale is adapted from the
jpayne@69 2314 # 'current' locale by applying the date and time formats from the
jpayne@69 2315 # Control Panel. First, load the 'current' locale if it's not yet
jpayne@69 2316 # loaded
jpayne@69 2317
jpayne@69 2318 mcpackagelocale set [mclocale]
jpayne@69 2319
jpayne@69 2320 # Make a new locale string for the system locale, and get the
jpayne@69 2321 # Control Panel information
jpayne@69 2322
jpayne@69 2323 set locale [mclocale]_windows
jpayne@69 2324 if { ! [mcpackagelocale present $locale] } {
jpayne@69 2325 LoadWindowsDateTimeFormats $locale
jpayne@69 2326 }
jpayne@69 2327 }
jpayne@69 2328 }
jpayne@69 2329 if { $locale eq {current}} {
jpayne@69 2330 set locale [mclocale]
jpayne@69 2331 }
jpayne@69 2332 # Eventually load the locale
jpayne@69 2333 mcpackagelocale set $locale
jpayne@69 2334 }
jpayne@69 2335
jpayne@69 2336 #----------------------------------------------------------------------
jpayne@69 2337 #
jpayne@69 2338 # LoadWindowsDateTimeFormats --
jpayne@69 2339 #
jpayne@69 2340 # Load the date/time formats from the Control Panel in Windows and
jpayne@69 2341 # convert them so that they're usable by Tcl.
jpayne@69 2342 #
jpayne@69 2343 # Parameters:
jpayne@69 2344 # locale - Name of the locale in whose message catalog
jpayne@69 2345 # the converted formats are to be stored.
jpayne@69 2346 #
jpayne@69 2347 # Results:
jpayne@69 2348 # None.
jpayne@69 2349 #
jpayne@69 2350 # Side effects:
jpayne@69 2351 # Updates the given message catalog with the locale strings.
jpayne@69 2352 #
jpayne@69 2353 # Presumes that on entry, [mclocale] is set to the current locale, so that
jpayne@69 2354 # default strings can be obtained if the Registry query fails.
jpayne@69 2355 #
jpayne@69 2356 #----------------------------------------------------------------------
jpayne@69 2357
jpayne@69 2358 proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
jpayne@69 2359 # Bail out if we can't find the Registry
jpayne@69 2360
jpayne@69 2361 variable NoRegistry
jpayne@69 2362 if { [info exists NoRegistry] } return
jpayne@69 2363
jpayne@69 2364 if { ![catch {
jpayne@69 2365 registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
jpayne@69 2366 sShortDate
jpayne@69 2367 } string] } {
jpayne@69 2368 set quote {}
jpayne@69 2369 set datefmt {}
jpayne@69 2370 foreach { unquoted quoted } [split $string '] {
jpayne@69 2371 append datefmt $quote [string map {
jpayne@69 2372 dddd %A
jpayne@69 2373 ddd %a
jpayne@69 2374 dd %d
jpayne@69 2375 d %e
jpayne@69 2376 MMMM %B
jpayne@69 2377 MMM %b
jpayne@69 2378 MM %m
jpayne@69 2379 M %N
jpayne@69 2380 yyyy %Y
jpayne@69 2381 yy %y
jpayne@69 2382 y %y
jpayne@69 2383 gg {}
jpayne@69 2384 } $unquoted]
jpayne@69 2385 if { $quoted eq {} } {
jpayne@69 2386 set quote '
jpayne@69 2387 } else {
jpayne@69 2388 set quote $quoted
jpayne@69 2389 }
jpayne@69 2390 }
jpayne@69 2391 ::msgcat::mcset $locale DATE_FORMAT $datefmt
jpayne@69 2392 }
jpayne@69 2393
jpayne@69 2394 if { ![catch {
jpayne@69 2395 registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
jpayne@69 2396 sLongDate
jpayne@69 2397 } string] } {
jpayne@69 2398 set quote {}
jpayne@69 2399 set ldatefmt {}
jpayne@69 2400 foreach { unquoted quoted } [split $string '] {
jpayne@69 2401 append ldatefmt $quote [string map {
jpayne@69 2402 dddd %A
jpayne@69 2403 ddd %a
jpayne@69 2404 dd %d
jpayne@69 2405 d %e
jpayne@69 2406 MMMM %B
jpayne@69 2407 MMM %b
jpayne@69 2408 MM %m
jpayne@69 2409 M %N
jpayne@69 2410 yyyy %Y
jpayne@69 2411 yy %y
jpayne@69 2412 y %y
jpayne@69 2413 gg {}
jpayne@69 2414 } $unquoted]
jpayne@69 2415 if { $quoted eq {} } {
jpayne@69 2416 set quote '
jpayne@69 2417 } else {
jpayne@69 2418 set quote $quoted
jpayne@69 2419 }
jpayne@69 2420 }
jpayne@69 2421 ::msgcat::mcset $locale LOCALE_DATE_FORMAT $ldatefmt
jpayne@69 2422 }
jpayne@69 2423
jpayne@69 2424 if { ![catch {
jpayne@69 2425 registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
jpayne@69 2426 sTimeFormat
jpayne@69 2427 } string] } {
jpayne@69 2428 set quote {}
jpayne@69 2429 set timefmt {}
jpayne@69 2430 foreach { unquoted quoted } [split $string '] {
jpayne@69 2431 append timefmt $quote [string map {
jpayne@69 2432 HH %H
jpayne@69 2433 H %k
jpayne@69 2434 hh %I
jpayne@69 2435 h %l
jpayne@69 2436 mm %M
jpayne@69 2437 m %M
jpayne@69 2438 ss %S
jpayne@69 2439 s %S
jpayne@69 2440 tt %p
jpayne@69 2441 t %p
jpayne@69 2442 } $unquoted]
jpayne@69 2443 if { $quoted eq {} } {
jpayne@69 2444 set quote '
jpayne@69 2445 } else {
jpayne@69 2446 set quote $quoted
jpayne@69 2447 }
jpayne@69 2448 }
jpayne@69 2449 ::msgcat::mcset $locale TIME_FORMAT $timefmt
jpayne@69 2450 }
jpayne@69 2451
jpayne@69 2452 catch {
jpayne@69 2453 ::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt"
jpayne@69 2454 }
jpayne@69 2455 catch {
jpayne@69 2456 ::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt"
jpayne@69 2457 }
jpayne@69 2458
jpayne@69 2459 return
jpayne@69 2460
jpayne@69 2461 }
jpayne@69 2462
jpayne@69 2463 #----------------------------------------------------------------------
jpayne@69 2464 #
jpayne@69 2465 # LocalizeFormat --
jpayne@69 2466 #
jpayne@69 2467 # Map away locale-dependent format groups in a clock format.
jpayne@69 2468 #
jpayne@69 2469 # Parameters:
jpayne@69 2470 # locale -- Current [mclocale] locale, supplied to avoid
jpayne@69 2471 # an extra call
jpayne@69 2472 # format -- Format supplied to [clock scan] or [clock format]
jpayne@69 2473 #
jpayne@69 2474 # Results:
jpayne@69 2475 # Returns the string with locale-dependent composite format groups
jpayne@69 2476 # substituted out.
jpayne@69 2477 #
jpayne@69 2478 # Side effects:
jpayne@69 2479 # None.
jpayne@69 2480 #
jpayne@69 2481 #----------------------------------------------------------------------
jpayne@69 2482
jpayne@69 2483 proc ::tcl::clock::LocalizeFormat { locale format } {
jpayne@69 2484
jpayne@69 2485 # message catalog key to cache this format
jpayne@69 2486 set key FORMAT_$format
jpayne@69 2487
jpayne@69 2488 if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
jpayne@69 2489 return [mc $key]
jpayne@69 2490 }
jpayne@69 2491 # Handle locale-dependent format groups by mapping them out of the format
jpayne@69 2492 # string. Note that the order of the [string map] operations is
jpayne@69 2493 # significant because later formats can refer to later ones; for example
jpayne@69 2494 # %c can refer to %X, which in turn can refer to %T.
jpayne@69 2495
jpayne@69 2496 set list {
jpayne@69 2497 %% %%
jpayne@69 2498 %D %m/%d/%Y
jpayne@69 2499 %+ {%a %b %e %H:%M:%S %Z %Y}
jpayne@69 2500 }
jpayne@69 2501 lappend list %EY [string map $list [mc LOCALE_YEAR_FORMAT]]
jpayne@69 2502 lappend list %T [string map $list [mc TIME_FORMAT_24_SECS]]
jpayne@69 2503 lappend list %R [string map $list [mc TIME_FORMAT_24]]
jpayne@69 2504 lappend list %r [string map $list [mc TIME_FORMAT_12]]
jpayne@69 2505 lappend list %X [string map $list [mc TIME_FORMAT]]
jpayne@69 2506 lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]]
jpayne@69 2507 lappend list %x [string map $list [mc DATE_FORMAT]]
jpayne@69 2508 lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]]
jpayne@69 2509 lappend list %c [string map $list [mc DATE_TIME_FORMAT]]
jpayne@69 2510 lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
jpayne@69 2511 set format [string map $list $format]
jpayne@69 2512
jpayne@69 2513 ::msgcat::mcset $locale $key $format
jpayne@69 2514 return $format
jpayne@69 2515 }
jpayne@69 2516
jpayne@69 2517 #----------------------------------------------------------------------
jpayne@69 2518 #
jpayne@69 2519 # FormatNumericTimeZone --
jpayne@69 2520 #
jpayne@69 2521 # Formats a time zone as +hhmmss
jpayne@69 2522 #
jpayne@69 2523 # Parameters:
jpayne@69 2524 # z - Time zone in seconds east of Greenwich
jpayne@69 2525 #
jpayne@69 2526 # Results:
jpayne@69 2527 # Returns the time zone formatted in a numeric form
jpayne@69 2528 #
jpayne@69 2529 # Side effects:
jpayne@69 2530 # None.
jpayne@69 2531 #
jpayne@69 2532 #----------------------------------------------------------------------
jpayne@69 2533
jpayne@69 2534 proc ::tcl::clock::FormatNumericTimeZone { z } {
jpayne@69 2535 if { $z < 0 } {
jpayne@69 2536 set z [expr { - $z }]
jpayne@69 2537 set retval -
jpayne@69 2538 } else {
jpayne@69 2539 set retval +
jpayne@69 2540 }
jpayne@69 2541 append retval [::format %02d [expr { $z / 3600 }]]
jpayne@69 2542 set z [expr { $z % 3600 }]
jpayne@69 2543 append retval [::format %02d [expr { $z / 60 }]]
jpayne@69 2544 set z [expr { $z % 60 }]
jpayne@69 2545 if { $z != 0 } {
jpayne@69 2546 append retval [::format %02d $z]
jpayne@69 2547 }
jpayne@69 2548 return $retval
jpayne@69 2549 }
jpayne@69 2550
jpayne@69 2551 #----------------------------------------------------------------------
jpayne@69 2552 #
jpayne@69 2553 # FormatStarDate --
jpayne@69 2554 #
jpayne@69 2555 # Formats a date as a StarDate.
jpayne@69 2556 #
jpayne@69 2557 # Parameters:
jpayne@69 2558 # date - Dictionary containing 'year', 'dayOfYear', and
jpayne@69 2559 # 'localSeconds' fields.
jpayne@69 2560 #
jpayne@69 2561 # Results:
jpayne@69 2562 # Returns the given date formatted as a StarDate.
jpayne@69 2563 #
jpayne@69 2564 # Side effects:
jpayne@69 2565 # None.
jpayne@69 2566 #
jpayne@69 2567 # Jeff Hobbs put this in to support an atrocious pun about Tcl being
jpayne@69 2568 # "Enterprise ready." Now we're stuck with it.
jpayne@69 2569 #
jpayne@69 2570 #----------------------------------------------------------------------
jpayne@69 2571
jpayne@69 2572 proc ::tcl::clock::FormatStarDate { date } {
jpayne@69 2573 variable Roddenberry
jpayne@69 2574
jpayne@69 2575 # Get day of year, zero based
jpayne@69 2576
jpayne@69 2577 set doy [expr { [dict get $date dayOfYear] - 1 }]
jpayne@69 2578
jpayne@69 2579 # Determine whether the year is a leap year
jpayne@69 2580
jpayne@69 2581 set lp [IsGregorianLeapYear $date]
jpayne@69 2582
jpayne@69 2583 # Convert day of year to a fractional year
jpayne@69 2584
jpayne@69 2585 if { $lp } {
jpayne@69 2586 set fractYear [expr { 1000 * $doy / 366 }]
jpayne@69 2587 } else {
jpayne@69 2588 set fractYear [expr { 1000 * $doy / 365 }]
jpayne@69 2589 }
jpayne@69 2590
jpayne@69 2591 # Put together the StarDate
jpayne@69 2592
jpayne@69 2593 return [::format "Stardate %02d%03d.%1d" \
jpayne@69 2594 [expr { [dict get $date year] - $Roddenberry }] \
jpayne@69 2595 $fractYear \
jpayne@69 2596 [expr { [dict get $date localSeconds] % 86400
jpayne@69 2597 / ( 86400 / 10 ) }]]
jpayne@69 2598 }
jpayne@69 2599
jpayne@69 2600 #----------------------------------------------------------------------
jpayne@69 2601 #
jpayne@69 2602 # ParseStarDate --
jpayne@69 2603 #
jpayne@69 2604 # Parses a StarDate
jpayne@69 2605 #
jpayne@69 2606 # Parameters:
jpayne@69 2607 # year - Year from the Roddenberry epoch
jpayne@69 2608 # fractYear - Fraction of a year specifiying the day of year.
jpayne@69 2609 # fractDay - Fraction of a day
jpayne@69 2610 #
jpayne@69 2611 # Results:
jpayne@69 2612 # Returns a count of seconds from the Posix epoch.
jpayne@69 2613 #
jpayne@69 2614 # Side effects:
jpayne@69 2615 # None.
jpayne@69 2616 #
jpayne@69 2617 # Jeff Hobbs put this in to support an atrocious pun about Tcl being
jpayne@69 2618 # "Enterprise ready." Now we're stuck with it.
jpayne@69 2619 #
jpayne@69 2620 #----------------------------------------------------------------------
jpayne@69 2621
jpayne@69 2622 proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {
jpayne@69 2623 variable Roddenberry
jpayne@69 2624
jpayne@69 2625 # Build a tentative date from year and fraction.
jpayne@69 2626
jpayne@69 2627 set date [dict create \
jpayne@69 2628 gregorian 1 \
jpayne@69 2629 era CE \
jpayne@69 2630 year [expr { $year + $Roddenberry }] \
jpayne@69 2631 dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]]
jpayne@69 2632 set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]
jpayne@69 2633
jpayne@69 2634 # Determine whether the given year is a leap year
jpayne@69 2635
jpayne@69 2636 set lp [IsGregorianLeapYear $date]
jpayne@69 2637
jpayne@69 2638 # Reconvert the fractional year according to whether the given year is a
jpayne@69 2639 # leap year
jpayne@69 2640
jpayne@69 2641 if { $lp } {
jpayne@69 2642 dict set date dayOfYear \
jpayne@69 2643 [expr { $fractYear * 366 / 1000 + 1 }]
jpayne@69 2644 } else {
jpayne@69 2645 dict set date dayOfYear \
jpayne@69 2646 [expr { $fractYear * 365 / 1000 + 1 }]
jpayne@69 2647 }
jpayne@69 2648 dict unset date julianDay
jpayne@69 2649 dict unset date gregorian
jpayne@69 2650 set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]
jpayne@69 2651
jpayne@69 2652 return [expr {
jpayne@69 2653 86400 * [dict get $date julianDay]
jpayne@69 2654 - 210866803200
jpayne@69 2655 + ( 86400 / 10 ) * $fractDay
jpayne@69 2656 }]
jpayne@69 2657 }
jpayne@69 2658
jpayne@69 2659 #----------------------------------------------------------------------
jpayne@69 2660 #
jpayne@69 2661 # ScanWide --
jpayne@69 2662 #
jpayne@69 2663 # Scans a wide integer from an input
jpayne@69 2664 #
jpayne@69 2665 # Parameters:
jpayne@69 2666 # str - String containing a decimal wide integer
jpayne@69 2667 #
jpayne@69 2668 # Results:
jpayne@69 2669 # Returns the string as a pure wide integer. Throws an error if the
jpayne@69 2670 # string is misformatted or out of range.
jpayne@69 2671 #
jpayne@69 2672 #----------------------------------------------------------------------
jpayne@69 2673
jpayne@69 2674 proc ::tcl::clock::ScanWide { str } {
jpayne@69 2675 set count [::scan $str {%ld %c} result junk]
jpayne@69 2676 if { $count != 1 } {
jpayne@69 2677 return -code error -errorcode [list CLOCK notAnInteger $str] \
jpayne@69 2678 "\"$str\" is not an integer"
jpayne@69 2679 }
jpayne@69 2680 if { [incr result 0] != $str } {
jpayne@69 2681 return -code error -errorcode [list CLOCK integervalueTooLarge] \
jpayne@69 2682 "integer value too large to represent"
jpayne@69 2683 }
jpayne@69 2684 return $result
jpayne@69 2685 }
jpayne@69 2686
jpayne@69 2687 #----------------------------------------------------------------------
jpayne@69 2688 #
jpayne@69 2689 # InterpretTwoDigitYear --
jpayne@69 2690 #
jpayne@69 2691 # Given a date that contains only the year of the century, determines
jpayne@69 2692 # the target value of a two-digit year.
jpayne@69 2693 #
jpayne@69 2694 # Parameters:
jpayne@69 2695 # date - Dictionary containing fields of the date.
jpayne@69 2696 # baseTime - Base time relative to which the date is expressed.
jpayne@69 2697 # twoDigitField - Name of the field that stores the two-digit year.
jpayne@69 2698 # Default is 'yearOfCentury'
jpayne@69 2699 # fourDigitField - Name of the field that will receive the four-digit
jpayne@69 2700 # year. Default is 'year'
jpayne@69 2701 #
jpayne@69 2702 # Results:
jpayne@69 2703 # Returns the dictionary augmented with the four-digit year, stored in
jpayne@69 2704 # the given key.
jpayne@69 2705 #
jpayne@69 2706 # Side effects:
jpayne@69 2707 # None.
jpayne@69 2708 #
jpayne@69 2709 # The current rule for interpreting a two-digit year is that the year shall be
jpayne@69 2710 # between 1937 and 2037, thus staying within the range of a 32-bit signed
jpayne@69 2711 # value for time. This rule may change to a sliding window in future
jpayne@69 2712 # versions, so the 'baseTime' parameter (which is currently ignored) is
jpayne@69 2713 # provided in the procedure signature.
jpayne@69 2714 #
jpayne@69 2715 #----------------------------------------------------------------------
jpayne@69 2716
jpayne@69 2717 proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
jpayne@69 2718 { twoDigitField yearOfCentury }
jpayne@69 2719 { fourDigitField year } } {
jpayne@69 2720 set yr [dict get $date $twoDigitField]
jpayne@69 2721 if { $yr <= 37 } {
jpayne@69 2722 dict set date $fourDigitField [expr { $yr + 2000 }]
jpayne@69 2723 } else {
jpayne@69 2724 dict set date $fourDigitField [expr { $yr + 1900 }]
jpayne@69 2725 }
jpayne@69 2726 return $date
jpayne@69 2727 }
jpayne@69 2728
jpayne@69 2729 #----------------------------------------------------------------------
jpayne@69 2730 #
jpayne@69 2731 # AssignBaseYear --
jpayne@69 2732 #
jpayne@69 2733 # Places the number of the current year into a dictionary.
jpayne@69 2734 #
jpayne@69 2735 # Parameters:
jpayne@69 2736 # date - Dictionary value to update
jpayne@69 2737 # baseTime - Base time from which to extract the year, expressed
jpayne@69 2738 # in seconds from the Posix epoch
jpayne@69 2739 # timezone - the time zone in which the date is being scanned
jpayne@69 2740 # changeover - the Julian Day on which the Gregorian calendar
jpayne@69 2741 # was adopted in the target locale.
jpayne@69 2742 #
jpayne@69 2743 # Results:
jpayne@69 2744 # Returns the dictionary with the current year assigned.
jpayne@69 2745 #
jpayne@69 2746 # Side effects:
jpayne@69 2747 # None.
jpayne@69 2748 #
jpayne@69 2749 #----------------------------------------------------------------------
jpayne@69 2750
jpayne@69 2751 proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } {
jpayne@69 2752 variable TZData
jpayne@69 2753
jpayne@69 2754 # Find the Julian Day Number corresponding to the base time, and
jpayne@69 2755 # find the Gregorian year corresponding to that Julian Day.
jpayne@69 2756
jpayne@69 2757 set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
jpayne@69 2758
jpayne@69 2759 # Store the converted year
jpayne@69 2760
jpayne@69 2761 dict set date era [dict get $date2 era]
jpayne@69 2762 dict set date year [dict get $date2 year]
jpayne@69 2763
jpayne@69 2764 return $date
jpayne@69 2765 }
jpayne@69 2766
jpayne@69 2767 #----------------------------------------------------------------------
jpayne@69 2768 #
jpayne@69 2769 # AssignBaseIso8601Year --
jpayne@69 2770 #
jpayne@69 2771 # Determines the base year in the ISO8601 fiscal calendar.
jpayne@69 2772 #
jpayne@69 2773 # Parameters:
jpayne@69 2774 # date - Dictionary containing the fields of the date that
jpayne@69 2775 # is to be augmented with the base year.
jpayne@69 2776 # baseTime - Base time expressed in seconds from the Posix epoch.
jpayne@69 2777 # timeZone - Target time zone
jpayne@69 2778 # changeover - Julian Day of adoption of the Gregorian calendar in
jpayne@69 2779 # the target locale.
jpayne@69 2780 #
jpayne@69 2781 # Results:
jpayne@69 2782 # Returns the given date with "iso8601Year" set to the
jpayne@69 2783 # base year.
jpayne@69 2784 #
jpayne@69 2785 # Side effects:
jpayne@69 2786 # None.
jpayne@69 2787 #
jpayne@69 2788 #----------------------------------------------------------------------
jpayne@69 2789
jpayne@69 2790 proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {
jpayne@69 2791 variable TZData
jpayne@69 2792
jpayne@69 2793 # Find the Julian Day Number corresponding to the base time
jpayne@69 2794
jpayne@69 2795 set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
jpayne@69 2796
jpayne@69 2797 # Calculate the ISO8601 date and transfer the year
jpayne@69 2798
jpayne@69 2799 dict set date era CE
jpayne@69 2800 dict set date iso8601Year [dict get $date2 iso8601Year]
jpayne@69 2801 return $date
jpayne@69 2802 }
jpayne@69 2803
jpayne@69 2804 #----------------------------------------------------------------------
jpayne@69 2805 #
jpayne@69 2806 # AssignBaseMonth --
jpayne@69 2807 #
jpayne@69 2808 # Places the number of the current year and month into a
jpayne@69 2809 # dictionary.
jpayne@69 2810 #
jpayne@69 2811 # Parameters:
jpayne@69 2812 # date - Dictionary value to update
jpayne@69 2813 # baseTime - Time from which the year and month are to be
jpayne@69 2814 # obtained, expressed in seconds from the Posix epoch.
jpayne@69 2815 # timezone - Name of the desired time zone
jpayne@69 2816 # changeover - Julian Day on which the Gregorian calendar was adopted.
jpayne@69 2817 #
jpayne@69 2818 # Results:
jpayne@69 2819 # Returns the dictionary with the base year and month assigned.
jpayne@69 2820 #
jpayne@69 2821 # Side effects:
jpayne@69 2822 # None.
jpayne@69 2823 #
jpayne@69 2824 #----------------------------------------------------------------------
jpayne@69 2825
jpayne@69 2826 proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} {
jpayne@69 2827 variable TZData
jpayne@69 2828
jpayne@69 2829 # Find the year and month corresponding to the base time
jpayne@69 2830
jpayne@69 2831 set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
jpayne@69 2832 dict set date era [dict get $date2 era]
jpayne@69 2833 dict set date year [dict get $date2 year]
jpayne@69 2834 dict set date month [dict get $date2 month]
jpayne@69 2835 return $date
jpayne@69 2836 }
jpayne@69 2837
jpayne@69 2838 #----------------------------------------------------------------------
jpayne@69 2839 #
jpayne@69 2840 # AssignBaseWeek --
jpayne@69 2841 #
jpayne@69 2842 # Determines the base year and week in the ISO8601 fiscal calendar.
jpayne@69 2843 #
jpayne@69 2844 # Parameters:
jpayne@69 2845 # date - Dictionary containing the fields of the date that
jpayne@69 2846 # is to be augmented with the base year and week.
jpayne@69 2847 # baseTime - Base time expressed in seconds from the Posix epoch.
jpayne@69 2848 # changeover - Julian Day on which the Gregorian calendar was adopted
jpayne@69 2849 # in the target locale.
jpayne@69 2850 #
jpayne@69 2851 # Results:
jpayne@69 2852 # Returns the given date with "iso8601Year" set to the
jpayne@69 2853 # base year and "iso8601Week" to the week number.
jpayne@69 2854 #
jpayne@69 2855 # Side effects:
jpayne@69 2856 # None.
jpayne@69 2857 #
jpayne@69 2858 #----------------------------------------------------------------------
jpayne@69 2859
jpayne@69 2860 proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} {
jpayne@69 2861 variable TZData
jpayne@69 2862
jpayne@69 2863 # Find the Julian Day Number corresponding to the base time
jpayne@69 2864
jpayne@69 2865 set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
jpayne@69 2866
jpayne@69 2867 # Calculate the ISO8601 date and transfer the year
jpayne@69 2868
jpayne@69 2869 dict set date era CE
jpayne@69 2870 dict set date iso8601Year [dict get $date2 iso8601Year]
jpayne@69 2871 dict set date iso8601Week [dict get $date2 iso8601Week]
jpayne@69 2872 return $date
jpayne@69 2873 }
jpayne@69 2874
jpayne@69 2875 #----------------------------------------------------------------------
jpayne@69 2876 #
jpayne@69 2877 # AssignBaseJulianDay --
jpayne@69 2878 #
jpayne@69 2879 # Determines the base day for a time-of-day conversion.
jpayne@69 2880 #
jpayne@69 2881 # Parameters:
jpayne@69 2882 # date - Dictionary that is to get the base day
jpayne@69 2883 # baseTime - Base time expressed in seconds from the Posix epoch
jpayne@69 2884 # changeover - Julian day on which the Gregorian calendar was
jpayne@69 2885 # adpoted in the target locale.
jpayne@69 2886 #
jpayne@69 2887 # Results:
jpayne@69 2888 # Returns the given dictionary augmented with a 'julianDay' field
jpayne@69 2889 # that contains the base day.
jpayne@69 2890 #
jpayne@69 2891 # Side effects:
jpayne@69 2892 # None.
jpayne@69 2893 #
jpayne@69 2894 #----------------------------------------------------------------------
jpayne@69 2895
jpayne@69 2896 proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } {
jpayne@69 2897 variable TZData
jpayne@69 2898
jpayne@69 2899 # Find the Julian Day Number corresponding to the base time
jpayne@69 2900
jpayne@69 2901 set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
jpayne@69 2902 dict set date julianDay [dict get $date2 julianDay]
jpayne@69 2903
jpayne@69 2904 return $date
jpayne@69 2905 }
jpayne@69 2906
jpayne@69 2907 #----------------------------------------------------------------------
jpayne@69 2908 #
jpayne@69 2909 # InterpretHMSP --
jpayne@69 2910 #
jpayne@69 2911 # Interprets a time in the form "hh:mm:ss am".
jpayne@69 2912 #
jpayne@69 2913 # Parameters:
jpayne@69 2914 # date -- Dictionary containing "hourAMPM", "minute", "second"
jpayne@69 2915 # and "amPmIndicator" fields.
jpayne@69 2916 #
jpayne@69 2917 # Results:
jpayne@69 2918 # Returns the number of seconds from local midnight.
jpayne@69 2919 #
jpayne@69 2920 # Side effects:
jpayne@69 2921 # None.
jpayne@69 2922 #
jpayne@69 2923 #----------------------------------------------------------------------
jpayne@69 2924
jpayne@69 2925 proc ::tcl::clock::InterpretHMSP { date } {
jpayne@69 2926 set hr [dict get $date hourAMPM]
jpayne@69 2927 if { $hr == 12 } {
jpayne@69 2928 set hr 0
jpayne@69 2929 }
jpayne@69 2930 if { [dict get $date amPmIndicator] } {
jpayne@69 2931 incr hr 12
jpayne@69 2932 }
jpayne@69 2933 dict set date hour $hr
jpayne@69 2934 return [InterpretHMS $date[set date {}]]
jpayne@69 2935 }
jpayne@69 2936
jpayne@69 2937 #----------------------------------------------------------------------
jpayne@69 2938 #
jpayne@69 2939 # InterpretHMS --
jpayne@69 2940 #
jpayne@69 2941 # Interprets a 24-hour time "hh:mm:ss"
jpayne@69 2942 #
jpayne@69 2943 # Parameters:
jpayne@69 2944 # date -- Dictionary containing the "hour", "minute" and "second"
jpayne@69 2945 # fields.
jpayne@69 2946 #
jpayne@69 2947 # Results:
jpayne@69 2948 # Returns the given dictionary augmented with a "secondOfDay"
jpayne@69 2949 # field containing the number of seconds from local midnight.
jpayne@69 2950 #
jpayne@69 2951 # Side effects:
jpayne@69 2952 # None.
jpayne@69 2953 #
jpayne@69 2954 #----------------------------------------------------------------------
jpayne@69 2955
jpayne@69 2956 proc ::tcl::clock::InterpretHMS { date } {
jpayne@69 2957 return [expr {
jpayne@69 2958 ( [dict get $date hour] * 60
jpayne@69 2959 + [dict get $date minute] ) * 60
jpayne@69 2960 + [dict get $date second]
jpayne@69 2961 }]
jpayne@69 2962 }
jpayne@69 2963
jpayne@69 2964 #----------------------------------------------------------------------
jpayne@69 2965 #
jpayne@69 2966 # GetSystemTimeZone --
jpayne@69 2967 #
jpayne@69 2968 # Determines the system time zone, which is the default for the
jpayne@69 2969 # 'clock' command if no other zone is supplied.
jpayne@69 2970 #
jpayne@69 2971 # Parameters:
jpayne@69 2972 # None.
jpayne@69 2973 #
jpayne@69 2974 # Results:
jpayne@69 2975 # Returns the system time zone.
jpayne@69 2976 #
jpayne@69 2977 # Side effects:
jpayne@69 2978 # Stores the sustem time zone in the 'CachedSystemTimeZone'
jpayne@69 2979 # variable, since determining it may be an expensive process.
jpayne@69 2980 #
jpayne@69 2981 #----------------------------------------------------------------------
jpayne@69 2982
jpayne@69 2983 proc ::tcl::clock::GetSystemTimeZone {} {
jpayne@69 2984 variable CachedSystemTimeZone
jpayne@69 2985 variable TimeZoneBad
jpayne@69 2986
jpayne@69 2987 if {[set result [getenv TCL_TZ]] ne {}} {
jpayne@69 2988 set timezone $result
jpayne@69 2989 } elseif {[set result [getenv TZ]] ne {}} {
jpayne@69 2990 set timezone $result
jpayne@69 2991 } else {
jpayne@69 2992 # Cache the time zone only if it was detected by one of the
jpayne@69 2993 # expensive methods.
jpayne@69 2994 if { [info exists CachedSystemTimeZone] } {
jpayne@69 2995 set timezone $CachedSystemTimeZone
jpayne@69 2996 } elseif { $::tcl_platform(platform) eq {windows} } {
jpayne@69 2997 set timezone [GuessWindowsTimeZone]
jpayne@69 2998 } elseif { [file exists /etc/localtime]
jpayne@69 2999 && ![catch {ReadZoneinfoFile \
jpayne@69 3000 Tcl/Localtime /etc/localtime}] } {
jpayne@69 3001 set timezone :Tcl/Localtime
jpayne@69 3002 } else {
jpayne@69 3003 set timezone :localtime
jpayne@69 3004 }
jpayne@69 3005 set CachedSystemTimeZone $timezone
jpayne@69 3006 }
jpayne@69 3007 if { ![dict exists $TimeZoneBad $timezone] } {
jpayne@69 3008 dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
jpayne@69 3009 }
jpayne@69 3010 if { [dict get $TimeZoneBad $timezone] } {
jpayne@69 3011 return :localtime
jpayne@69 3012 } else {
jpayne@69 3013 return $timezone
jpayne@69 3014 }
jpayne@69 3015 }
jpayne@69 3016
jpayne@69 3017 #----------------------------------------------------------------------
jpayne@69 3018 #
jpayne@69 3019 # ConvertLegacyTimeZone --
jpayne@69 3020 #
jpayne@69 3021 # Given an alphanumeric time zone identifier and the system time zone,
jpayne@69 3022 # convert the alphanumeric identifier to an unambiguous time zone.
jpayne@69 3023 #
jpayne@69 3024 # Parameters:
jpayne@69 3025 # tzname - Name of the time zone to convert
jpayne@69 3026 #
jpayne@69 3027 # Results:
jpayne@69 3028 # Returns a time zone name corresponding to tzname, but in an
jpayne@69 3029 # unambiguous form, generally +hhmm.
jpayne@69 3030 #
jpayne@69 3031 # This procedure is implemented primarily to allow the parsing of RFC822
jpayne@69 3032 # date/time strings. Processing a time zone name on input is not recommended
jpayne@69 3033 # practice, because there is considerable room for ambiguity; for instance, is
jpayne@69 3034 # BST Brazilian Standard Time, or British Summer Time?
jpayne@69 3035 #
jpayne@69 3036 #----------------------------------------------------------------------
jpayne@69 3037
jpayne@69 3038 proc ::tcl::clock::ConvertLegacyTimeZone { tzname } {
jpayne@69 3039 variable LegacyTimeZone
jpayne@69 3040
jpayne@69 3041 set tzname [string tolower $tzname]
jpayne@69 3042 if { ![dict exists $LegacyTimeZone $tzname] } {
jpayne@69 3043 return -code error -errorcode [list CLOCK badTZName $tzname] \
jpayne@69 3044 "time zone \"$tzname\" not found"
jpayne@69 3045 }
jpayne@69 3046 return [dict get $LegacyTimeZone $tzname]
jpayne@69 3047 }
jpayne@69 3048
jpayne@69 3049 #----------------------------------------------------------------------
jpayne@69 3050 #
jpayne@69 3051 # SetupTimeZone --
jpayne@69 3052 #
jpayne@69 3053 # Given the name or specification of a time zone, sets up its in-memory
jpayne@69 3054 # data.
jpayne@69 3055 #
jpayne@69 3056 # Parameters:
jpayne@69 3057 # tzname - Name of a time zone
jpayne@69 3058 #
jpayne@69 3059 # Results:
jpayne@69 3060 # Unless the time zone is ':localtime', sets the TZData array to contain
jpayne@69 3061 # the lookup table for local<->UTC conversion. Returns an error if the
jpayne@69 3062 # time zone cannot be parsed.
jpayne@69 3063 #
jpayne@69 3064 #----------------------------------------------------------------------
jpayne@69 3065
jpayne@69 3066 proc ::tcl::clock::SetupTimeZone { timezone } {
jpayne@69 3067 variable TZData
jpayne@69 3068
jpayne@69 3069 if {! [info exists TZData($timezone)] } {
jpayne@69 3070 variable MINWIDE
jpayne@69 3071 if { $timezone eq {:localtime} } {
jpayne@69 3072 # Nothing to do, we'll convert using the localtime function
jpayne@69 3073
jpayne@69 3074 } elseif {
jpayne@69 3075 [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
jpayne@69 3076 -> s hh mm ss]
jpayne@69 3077 } then {
jpayne@69 3078 # Make a fixed offset
jpayne@69 3079
jpayne@69 3080 ::scan $hh %d hh
jpayne@69 3081 if { $mm eq {} } {
jpayne@69 3082 set mm 0
jpayne@69 3083 } else {
jpayne@69 3084 ::scan $mm %d mm
jpayne@69 3085 }
jpayne@69 3086 if { $ss eq {} } {
jpayne@69 3087 set ss 0
jpayne@69 3088 } else {
jpayne@69 3089 ::scan $ss %d ss
jpayne@69 3090 }
jpayne@69 3091 set offset [expr { ( $hh * 60 + $mm ) * 60 + $ss }]
jpayne@69 3092 if { $s eq {-} } {
jpayne@69 3093 set offset [expr { - $offset }]
jpayne@69 3094 }
jpayne@69 3095 set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]
jpayne@69 3096
jpayne@69 3097 } elseif { [string index $timezone 0] eq {:} } {
jpayne@69 3098 # Convert using a time zone file
jpayne@69 3099
jpayne@69 3100 if {
jpayne@69 3101 [catch {
jpayne@69 3102 LoadTimeZoneFile [string range $timezone 1 end]
jpayne@69 3103 }] && [catch {
jpayne@69 3104 LoadZoneinfoFile [string range $timezone 1 end]
jpayne@69 3105 }]
jpayne@69 3106 } then {
jpayne@69 3107 return -code error \
jpayne@69 3108 -errorcode [list CLOCK badTimeZone $timezone] \
jpayne@69 3109 "time zone \"$timezone\" not found"
jpayne@69 3110 }
jpayne@69 3111 } elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
jpayne@69 3112 # This looks like a POSIX time zone - try to process it
jpayne@69 3113
jpayne@69 3114 if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
jpayne@69 3115 if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
jpayne@69 3116 dict unset opts -errorinfo
jpayne@69 3117 }
jpayne@69 3118 return -options $opts $data
jpayne@69 3119 } else {
jpayne@69 3120 set TZData($timezone) $data
jpayne@69 3121 }
jpayne@69 3122
jpayne@69 3123 } else {
jpayne@69 3124 # We couldn't parse this as a POSIX time zone. Try again with a
jpayne@69 3125 # time zone file - this time without a colon
jpayne@69 3126
jpayne@69 3127 if { [catch { LoadTimeZoneFile $timezone }]
jpayne@69 3128 && [catch { LoadZoneinfoFile $timezone } - opts] } {
jpayne@69 3129 dict unset opts -errorinfo
jpayne@69 3130 return -options $opts "time zone $timezone not found"
jpayne@69 3131 }
jpayne@69 3132 set TZData($timezone) $TZData(:$timezone)
jpayne@69 3133 }
jpayne@69 3134 }
jpayne@69 3135
jpayne@69 3136 return
jpayne@69 3137 }
jpayne@69 3138
jpayne@69 3139 #----------------------------------------------------------------------
jpayne@69 3140 #
jpayne@69 3141 # GuessWindowsTimeZone --
jpayne@69 3142 #
jpayne@69 3143 # Determines the system time zone on windows.
jpayne@69 3144 #
jpayne@69 3145 # Parameters:
jpayne@69 3146 # None.
jpayne@69 3147 #
jpayne@69 3148 # Results:
jpayne@69 3149 # Returns a time zone specifier that corresponds to the system time zone
jpayne@69 3150 # information found in the Registry.
jpayne@69 3151 #
jpayne@69 3152 # Bugs:
jpayne@69 3153 # Fixed dates for DST change are unimplemented at present, because no
jpayne@69 3154 # time zone information supplied with Windows actually uses them!
jpayne@69 3155 #
jpayne@69 3156 # On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is specified,
jpayne@69 3157 # GuessWindowsTimeZone looks in the Registry for the system time zone
jpayne@69 3158 # information. It then attempts to find an entry in WinZoneInfo for a time
jpayne@69 3159 # zone that uses the same rules. If it finds one, it returns it; otherwise,
jpayne@69 3160 # it constructs a Posix-style time zone string and returns that.
jpayne@69 3161 #
jpayne@69 3162 #----------------------------------------------------------------------
jpayne@69 3163
jpayne@69 3164 proc ::tcl::clock::GuessWindowsTimeZone {} {
jpayne@69 3165 variable WinZoneInfo
jpayne@69 3166 variable NoRegistry
jpayne@69 3167 variable TimeZoneBad
jpayne@69 3168
jpayne@69 3169 if { [info exists NoRegistry] } {
jpayne@69 3170 return :localtime
jpayne@69 3171 }
jpayne@69 3172
jpayne@69 3173 # Dredge time zone information out of the registry
jpayne@69 3174
jpayne@69 3175 if { [catch {
jpayne@69 3176 set rpath HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation
jpayne@69 3177 set data [list \
jpayne@69 3178 [expr { -60
jpayne@69 3179 * [registry get $rpath Bias] }] \
jpayne@69 3180 [expr { -60
jpayne@69 3181 * [registry get $rpath StandardBias] }] \
jpayne@69 3182 [expr { -60 \
jpayne@69 3183 * [registry get $rpath DaylightBias] }]]
jpayne@69 3184 set stdtzi [registry get $rpath StandardStart]
jpayne@69 3185 foreach ind {0 2 14 4 6 8 10 12} {
jpayne@69 3186 binary scan $stdtzi @${ind}s val
jpayne@69 3187 lappend data $val
jpayne@69 3188 }
jpayne@69 3189 set daytzi [registry get $rpath DaylightStart]
jpayne@69 3190 foreach ind {0 2 14 4 6 8 10 12} {
jpayne@69 3191 binary scan $daytzi @${ind}s val
jpayne@69 3192 lappend data $val
jpayne@69 3193 }
jpayne@69 3194 }] } {
jpayne@69 3195 # Missing values in the Registry - bail out
jpayne@69 3196
jpayne@69 3197 return :localtime
jpayne@69 3198 }
jpayne@69 3199
jpayne@69 3200 # Make up a Posix time zone specifier if we can't find one. Check here
jpayne@69 3201 # that the tzdata file exists, in case we're running in an environment
jpayne@69 3202 # (e.g. starpack) where tzdata is incomplete. (Bug 1237907)
jpayne@69 3203
jpayne@69 3204 if { [dict exists $WinZoneInfo $data] } {
jpayne@69 3205 set tzname [dict get $WinZoneInfo $data]
jpayne@69 3206 if { ! [dict exists $TimeZoneBad $tzname] } {
jpayne@69 3207 dict set TimeZoneBad $tzname [catch {SetupTimeZone $tzname}]
jpayne@69 3208 }
jpayne@69 3209 } else {
jpayne@69 3210 set tzname {}
jpayne@69 3211 }
jpayne@69 3212 if { $tzname eq {} || [dict get $TimeZoneBad $tzname] } {
jpayne@69 3213 lassign $data \
jpayne@69 3214 bias stdBias dstBias \
jpayne@69 3215 stdYear stdMonth stdDayOfWeek stdDayOfMonth \
jpayne@69 3216 stdHour stdMinute stdSecond stdMillisec \
jpayne@69 3217 dstYear dstMonth dstDayOfWeek dstDayOfMonth \
jpayne@69 3218 dstHour dstMinute dstSecond dstMillisec
jpayne@69 3219 set stdDelta [expr { $bias + $stdBias }]
jpayne@69 3220 set dstDelta [expr { $bias + $dstBias }]
jpayne@69 3221 if { $stdDelta <= 0 } {
jpayne@69 3222 set stdSignum +
jpayne@69 3223 set stdDelta [expr { - $stdDelta }]
jpayne@69 3224 set dispStdSignum -
jpayne@69 3225 } else {
jpayne@69 3226 set stdSignum -
jpayne@69 3227 set dispStdSignum +
jpayne@69 3228 }
jpayne@69 3229 set hh [::format %02d [expr { $stdDelta / 3600 }]]
jpayne@69 3230 set mm [::format %02d [expr { ($stdDelta / 60 ) % 60 }]]
jpayne@69 3231 set ss [::format %02d [expr { $stdDelta % 60 }]]
jpayne@69 3232 set tzname {}
jpayne@69 3233 append tzname < $dispStdSignum $hh $mm > $stdSignum $hh : $mm : $ss
jpayne@69 3234 if { $stdMonth >= 0 } {
jpayne@69 3235 if { $dstDelta <= 0 } {
jpayne@69 3236 set dstSignum +
jpayne@69 3237 set dstDelta [expr { - $dstDelta }]
jpayne@69 3238 set dispDstSignum -
jpayne@69 3239 } else {
jpayne@69 3240 set dstSignum -
jpayne@69 3241 set dispDstSignum +
jpayne@69 3242 }
jpayne@69 3243 set hh [::format %02d [expr { $dstDelta / 3600 }]]
jpayne@69 3244 set mm [::format %02d [expr { ($dstDelta / 60 ) % 60 }]]
jpayne@69 3245 set ss [::format %02d [expr { $dstDelta % 60 }]]
jpayne@69 3246 append tzname < $dispDstSignum $hh $mm > $dstSignum $hh : $mm : $ss
jpayne@69 3247 if { $dstYear == 0 } {
jpayne@69 3248 append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek
jpayne@69 3249 } else {
jpayne@69 3250 # I have not been able to find any locale on which Windows
jpayne@69 3251 # converts time zone on a fixed day of the year, hence don't
jpayne@69 3252 # know how to interpret the fields. If someone can inform me,
jpayne@69 3253 # I'd be glad to code it up. For right now, we bail out in
jpayne@69 3254 # such a case.
jpayne@69 3255 return :localtime
jpayne@69 3256 }
jpayne@69 3257 append tzname / [::format %02d $dstHour] \
jpayne@69 3258 : [::format %02d $dstMinute] \
jpayne@69 3259 : [::format %02d $dstSecond]
jpayne@69 3260 if { $stdYear == 0 } {
jpayne@69 3261 append tzname ,M $stdMonth . $stdDayOfMonth . $stdDayOfWeek
jpayne@69 3262 } else {
jpayne@69 3263 # I have not been able to find any locale on which Windows
jpayne@69 3264 # converts time zone on a fixed day of the year, hence don't
jpayne@69 3265 # know how to interpret the fields. If someone can inform me,
jpayne@69 3266 # I'd be glad to code it up. For right now, we bail out in
jpayne@69 3267 # such a case.
jpayne@69 3268 return :localtime
jpayne@69 3269 }
jpayne@69 3270 append tzname / [::format %02d $stdHour] \
jpayne@69 3271 : [::format %02d $stdMinute] \
jpayne@69 3272 : [::format %02d $stdSecond]
jpayne@69 3273 }
jpayne@69 3274 dict set WinZoneInfo $data $tzname
jpayne@69 3275 }
jpayne@69 3276
jpayne@69 3277 return [dict get $WinZoneInfo $data]
jpayne@69 3278 }
jpayne@69 3279
jpayne@69 3280 #----------------------------------------------------------------------
jpayne@69 3281 #
jpayne@69 3282 # LoadTimeZoneFile --
jpayne@69 3283 #
jpayne@69 3284 # Load the data file that specifies the conversion between a
jpayne@69 3285 # given time zone and Greenwich.
jpayne@69 3286 #
jpayne@69 3287 # Parameters:
jpayne@69 3288 # fileName -- Name of the file to load
jpayne@69 3289 #
jpayne@69 3290 # Results:
jpayne@69 3291 # None.
jpayne@69 3292 #
jpayne@69 3293 # Side effects:
jpayne@69 3294 # TZData(:fileName) contains the time zone data
jpayne@69 3295 #
jpayne@69 3296 #----------------------------------------------------------------------
jpayne@69 3297
jpayne@69 3298 proc ::tcl::clock::LoadTimeZoneFile { fileName } {
jpayne@69 3299 variable DataDir
jpayne@69 3300 variable TZData
jpayne@69 3301
jpayne@69 3302 if { [info exists TZData($fileName)] } {
jpayne@69 3303 return
jpayne@69 3304 }
jpayne@69 3305
jpayne@69 3306 # Since an unsafe interp uses the [clock] command in the parent, this code
jpayne@69 3307 # is security sensitive. Make sure that the path name cannot escape the
jpayne@69 3308 # given directory.
jpayne@69 3309
jpayne@69 3310 if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
jpayne@69 3311 return -code error \
jpayne@69 3312 -errorcode [list CLOCK badTimeZone $:fileName] \
jpayne@69 3313 "time zone \":$fileName\" not valid"
jpayne@69 3314 }
jpayne@69 3315 try {
jpayne@69 3316 source -encoding utf-8 [file join $DataDir $fileName]
jpayne@69 3317 } on error {} {
jpayne@69 3318 return -code error \
jpayne@69 3319 -errorcode [list CLOCK badTimeZone :$fileName] \
jpayne@69 3320 "time zone \":$fileName\" not found"
jpayne@69 3321 }
jpayne@69 3322 return
jpayne@69 3323 }
jpayne@69 3324
jpayne@69 3325 #----------------------------------------------------------------------
jpayne@69 3326 #
jpayne@69 3327 # LoadZoneinfoFile --
jpayne@69 3328 #
jpayne@69 3329 # Loads a binary time zone information file in Olson format.
jpayne@69 3330 #
jpayne@69 3331 # Parameters:
jpayne@69 3332 # fileName - Relative path name of the file to load.
jpayne@69 3333 #
jpayne@69 3334 # Results:
jpayne@69 3335 # Returns an empty result normally; returns an error if no Olson file
jpayne@69 3336 # was found or the file was malformed in some way.
jpayne@69 3337 #
jpayne@69 3338 # Side effects:
jpayne@69 3339 # TZData(:fileName) contains the time zone data
jpayne@69 3340 #
jpayne@69 3341 #----------------------------------------------------------------------
jpayne@69 3342
jpayne@69 3343 proc ::tcl::clock::LoadZoneinfoFile { fileName } {
jpayne@69 3344 variable ZoneinfoPaths
jpayne@69 3345
jpayne@69 3346 # Since an unsafe interp uses the [clock] command in the parent, this code
jpayne@69 3347 # is security sensitive. Make sure that the path name cannot escape the
jpayne@69 3348 # given directory.
jpayne@69 3349
jpayne@69 3350 if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
jpayne@69 3351 return -code error \
jpayne@69 3352 -errorcode [list CLOCK badTimeZone $:fileName] \
jpayne@69 3353 "time zone \":$fileName\" not valid"
jpayne@69 3354 }
jpayne@69 3355 foreach d $ZoneinfoPaths {
jpayne@69 3356 set fname [file join $d $fileName]
jpayne@69 3357 if { [file readable $fname] && [file isfile $fname] } {
jpayne@69 3358 break
jpayne@69 3359 }
jpayne@69 3360 unset fname
jpayne@69 3361 }
jpayne@69 3362 ReadZoneinfoFile $fileName $fname
jpayne@69 3363 }
jpayne@69 3364
jpayne@69 3365 #----------------------------------------------------------------------
jpayne@69 3366 #
jpayne@69 3367 # ReadZoneinfoFile --
jpayne@69 3368 #
jpayne@69 3369 # Loads a binary time zone information file in Olson format.
jpayne@69 3370 #
jpayne@69 3371 # Parameters:
jpayne@69 3372 # fileName - Name of the time zone (relative path name of the
jpayne@69 3373 # file).
jpayne@69 3374 # fname - Absolute path name of the file.
jpayne@69 3375 #
jpayne@69 3376 # Results:
jpayne@69 3377 # Returns an empty result normally; returns an error if no Olson file
jpayne@69 3378 # was found or the file was malformed in some way.
jpayne@69 3379 #
jpayne@69 3380 # Side effects:
jpayne@69 3381 # TZData(:fileName) contains the time zone data
jpayne@69 3382 #
jpayne@69 3383 #----------------------------------------------------------------------
jpayne@69 3384
jpayne@69 3385 proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
jpayne@69 3386 variable MINWIDE
jpayne@69 3387 variable TZData
jpayne@69 3388 if { ![file exists $fname] } {
jpayne@69 3389 return -code error "$fileName not found"
jpayne@69 3390 }
jpayne@69 3391
jpayne@69 3392 if { [file size $fname] > 262144 } {
jpayne@69 3393 return -code error "$fileName too big"
jpayne@69 3394 }
jpayne@69 3395
jpayne@69 3396 # Suck in all the data from the file
jpayne@69 3397
jpayne@69 3398 set f [open $fname r]
jpayne@69 3399 fconfigure $f -translation binary
jpayne@69 3400 set d [read $f]
jpayne@69 3401 close $f
jpayne@69 3402
jpayne@69 3403 # The file begins with a magic number, sixteen reserved bytes, and then
jpayne@69 3404 # six 4-byte integers giving counts of fileds in the file.
jpayne@69 3405
jpayne@69 3406 binary scan $d a4a1x15IIIIII \
jpayne@69 3407 magic version nIsGMT nIsStd nLeap nTime nType nChar
jpayne@69 3408 set seek 44
jpayne@69 3409 set ilen 4
jpayne@69 3410 set iformat I
jpayne@69 3411 if { $magic != {TZif} } {
jpayne@69 3412 return -code error "$fileName not a time zone information file"
jpayne@69 3413 }
jpayne@69 3414 if { $nType > 255 } {
jpayne@69 3415 return -code error "$fileName contains too many time types"
jpayne@69 3416 }
jpayne@69 3417 # Accept only Posix-style zoneinfo. Sorry, 'leaps' bigots.
jpayne@69 3418 if { $nLeap != 0 } {
jpayne@69 3419 return -code error "$fileName contains leap seconds"
jpayne@69 3420 }
jpayne@69 3421
jpayne@69 3422 # In a version 2 file, we use the second part of the file, which contains
jpayne@69 3423 # 64-bit transition times.
jpayne@69 3424
jpayne@69 3425 if {$version eq "2"} {
jpayne@69 3426 set seek [expr {
jpayne@69 3427 44
jpayne@69 3428 + 5 * $nTime
jpayne@69 3429 + 6 * $nType
jpayne@69 3430 + 4 * $nLeap
jpayne@69 3431 + $nIsStd
jpayne@69 3432 + $nIsGMT
jpayne@69 3433 + $nChar
jpayne@69 3434 }]
jpayne@69 3435 binary scan $d @${seek}a4a1x15IIIIII \
jpayne@69 3436 magic version nIsGMT nIsStd nLeap nTime nType nChar
jpayne@69 3437 if {$magic ne {TZif}} {
jpayne@69 3438 return -code error "seek address $seek miscomputed, magic = $magic"
jpayne@69 3439 }
jpayne@69 3440 set iformat W
jpayne@69 3441 set ilen 8
jpayne@69 3442 incr seek 44
jpayne@69 3443 }
jpayne@69 3444
jpayne@69 3445 # Next come ${nTime} transition times, followed by ${nTime} time type
jpayne@69 3446 # codes. The type codes are unsigned 1-byte quantities. We insert an
jpayne@69 3447 # arbitrary start time in front of the transitions.
jpayne@69 3448
jpayne@69 3449 binary scan $d @${seek}${iformat}${nTime}c${nTime} times tempCodes
jpayne@69 3450 incr seek [expr { ($ilen + 1) * $nTime }]
jpayne@69 3451 set times [linsert $times 0 $MINWIDE]
jpayne@69 3452 set codes {}
jpayne@69 3453 foreach c $tempCodes {
jpayne@69 3454 lappend codes [expr { $c & 0xFF }]
jpayne@69 3455 }
jpayne@69 3456 set codes [linsert $codes 0 0]
jpayne@69 3457
jpayne@69 3458 # Next come ${nType} time type descriptions, each of which has an offset
jpayne@69 3459 # (seconds east of GMT), a DST indicator, and an index into the
jpayne@69 3460 # abbreviation text.
jpayne@69 3461
jpayne@69 3462 for { set i 0 } { $i < $nType } { incr i } {
jpayne@69 3463 binary scan $d @${seek}Icc gmtOff isDst abbrInd
jpayne@69 3464 lappend types [list $gmtOff $isDst $abbrInd]
jpayne@69 3465 incr seek 6
jpayne@69 3466 }
jpayne@69 3467
jpayne@69 3468 # Next come $nChar characters of time zone name abbreviations, which are
jpayne@69 3469 # null-terminated.
jpayne@69 3470 # We build them up into a dictionary indexed by character index, because
jpayne@69 3471 # that's what's in the indices above.
jpayne@69 3472
jpayne@69 3473 binary scan $d @${seek}a${nChar} abbrs
jpayne@69 3474 incr seek ${nChar}
jpayne@69 3475 set abbrList [split $abbrs \0]
jpayne@69 3476 set i 0
jpayne@69 3477 set abbrevs {}
jpayne@69 3478 foreach a $abbrList {
jpayne@69 3479 for {set j 0} {$j <= [string length $a]} {incr j} {
jpayne@69 3480 dict set abbrevs $i [string range $a $j end]
jpayne@69 3481 incr i
jpayne@69 3482 }
jpayne@69 3483 }
jpayne@69 3484
jpayne@69 3485 # Package up a list of tuples, each of which contains transition time,
jpayne@69 3486 # seconds east of Greenwich, DST flag and time zone abbreviation.
jpayne@69 3487
jpayne@69 3488 set r {}
jpayne@69 3489 set lastTime $MINWIDE
jpayne@69 3490 foreach t $times c $codes {
jpayne@69 3491 if { $t < $lastTime } {
jpayne@69 3492 return -code error "$fileName has times out of order"
jpayne@69 3493 }
jpayne@69 3494 set lastTime $t
jpayne@69 3495 lassign [lindex $types $c] gmtoff isDst abbrInd
jpayne@69 3496 set abbrev [dict get $abbrevs $abbrInd]
jpayne@69 3497 lappend r [list $t $gmtoff $isDst $abbrev]
jpayne@69 3498 }
jpayne@69 3499
jpayne@69 3500 # In a version 2 file, there is also a POSIX-style time zone description
jpayne@69 3501 # at the very end of the file. To get to it, skip over nLeap leap second
jpayne@69 3502 # values (8 bytes each),
jpayne@69 3503 # nIsStd standard/DST indicators and nIsGMT UTC/local indicators.
jpayne@69 3504
jpayne@69 3505 if {$version eq {2}} {
jpayne@69 3506 set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}]
jpayne@69 3507 set last [string first \n $d $seek]
jpayne@69 3508 set posix [string range $d $seek [expr {$last-1}]]
jpayne@69 3509 if {[llength $posix] > 0} {
jpayne@69 3510 set posixFields [ParsePosixTimeZone $posix]
jpayne@69 3511 foreach tuple [ProcessPosixTimeZone $posixFields] {
jpayne@69 3512 lassign $tuple t gmtoff isDst abbrev
jpayne@69 3513 if {$t > $lastTime} {
jpayne@69 3514 lappend r $tuple
jpayne@69 3515 }
jpayne@69 3516 }
jpayne@69 3517 }
jpayne@69 3518 }
jpayne@69 3519
jpayne@69 3520 set TZData(:$fileName) $r
jpayne@69 3521
jpayne@69 3522 return
jpayne@69 3523 }
jpayne@69 3524
jpayne@69 3525 #----------------------------------------------------------------------
jpayne@69 3526 #
jpayne@69 3527 # ParsePosixTimeZone --
jpayne@69 3528 #
jpayne@69 3529 # Parses the TZ environment variable in Posix form
jpayne@69 3530 #
jpayne@69 3531 # Parameters:
jpayne@69 3532 # tz Time zone specifier to be interpreted
jpayne@69 3533 #
jpayne@69 3534 # Results:
jpayne@69 3535 # Returns a dictionary whose values contain the various pieces of the
jpayne@69 3536 # time zone specification.
jpayne@69 3537 #
jpayne@69 3538 # Side effects:
jpayne@69 3539 # None.
jpayne@69 3540 #
jpayne@69 3541 # Errors:
jpayne@69 3542 # Throws an error if the syntax of the time zone is incorrect.
jpayne@69 3543 #
jpayne@69 3544 # The following keys are present in the dictionary:
jpayne@69 3545 # stdName - Name of the time zone when Daylight Saving Time
jpayne@69 3546 # is not in effect.
jpayne@69 3547 # stdSignum - Sign (+, -, or empty) of the offset from Greenwich
jpayne@69 3548 # to the given (non-DST) time zone. + and the empty
jpayne@69 3549 # string denote zones west of Greenwich, - denotes east
jpayne@69 3550 # of Greenwich; this is contrary to the ISO convention
jpayne@69 3551 # but follows Posix.
jpayne@69 3552 # stdHours - Hours part of the offset from Greenwich to the given
jpayne@69 3553 # (non-DST) time zone.
jpayne@69 3554 # stdMinutes - Minutes part of the offset from Greenwich to the
jpayne@69 3555 # given (non-DST) time zone. Empty denotes zero.
jpayne@69 3556 # stdSeconds - Seconds part of the offset from Greenwich to the
jpayne@69 3557 # given (non-DST) time zone. Empty denotes zero.
jpayne@69 3558 # dstName - Name of the time zone when DST is in effect, or the
jpayne@69 3559 # empty string if the time zone does not observe Daylight
jpayne@69 3560 # Saving Time.
jpayne@69 3561 # dstSignum, dstHours, dstMinutes, dstSeconds -
jpayne@69 3562 # Fields corresponding to stdSignum, stdHours, stdMinutes,
jpayne@69 3563 # stdSeconds for the Daylight Saving Time version of the
jpayne@69 3564 # time zone. If dstHours is empty, it is presumed to be 1.
jpayne@69 3565 # startDayOfYear - The ordinal number of the day of the year on which
jpayne@69 3566 # Daylight Saving Time begins. If this field is
jpayne@69 3567 # empty, then DST begins on a given month-week-day,
jpayne@69 3568 # as below.
jpayne@69 3569 # startJ - The letter J, or an empty string. If a J is present in
jpayne@69 3570 # this field, then startDayOfYear does not count February 29
jpayne@69 3571 # even in leap years.
jpayne@69 3572 # startMonth - The number of the month in which Daylight Saving Time
jpayne@69 3573 # begins, supplied if startDayOfYear is empty. If both
jpayne@69 3574 # startDayOfYear and startMonth are empty, then US rules
jpayne@69 3575 # are presumed.
jpayne@69 3576 # startWeekOfMonth - The number of the week in the month in which
jpayne@69 3577 # Daylight Saving Time begins, in the range 1-5.
jpayne@69 3578 # 5 denotes the last week of the month even in a
jpayne@69 3579 # 4-week month.
jpayne@69 3580 # startDayOfWeek - The number of the day of the week (Sunday=0,
jpayne@69 3581 # Saturday=6) on which Daylight Saving Time begins.
jpayne@69 3582 # startHours - The hours part of the time of day at which Daylight
jpayne@69 3583 # Saving Time begins. An empty string is presumed to be 2.
jpayne@69 3584 # startMinutes - The minutes part of the time of day at which DST begins.
jpayne@69 3585 # An empty string is presumed zero.
jpayne@69 3586 # startSeconds - The seconds part of the time of day at which DST begins.
jpayne@69 3587 # An empty string is presumed zero.
jpayne@69 3588 # endDayOfYear, endJ, endMonth, endWeekOfMonth, endDayOfWeek,
jpayne@69 3589 # endHours, endMinutes, endSeconds -
jpayne@69 3590 # Specify the end of DST in the same way that the start* fields
jpayne@69 3591 # specify the beginning of DST.
jpayne@69 3592 #
jpayne@69 3593 # This procedure serves only to break the time specifier into fields. No
jpayne@69 3594 # attempt is made to canonicalize the fields or supply default values.
jpayne@69 3595 #
jpayne@69 3596 #----------------------------------------------------------------------
jpayne@69 3597
jpayne@69 3598 proc ::tcl::clock::ParsePosixTimeZone { tz } {
jpayne@69 3599 if {[regexp -expanded -nocase -- {
jpayne@69 3600 ^
jpayne@69 3601 # 1 - Standard time zone name
jpayne@69 3602 ([[:alpha:]]+ | <[-+[:alnum:]]+>)
jpayne@69 3603 # 2 - Standard time zone offset, signum
jpayne@69 3604 ([-+]?)
jpayne@69 3605 # 3 - Standard time zone offset, hours
jpayne@69 3606 ([[:digit:]]{1,2})
jpayne@69 3607 (?:
jpayne@69 3608 # 4 - Standard time zone offset, minutes
jpayne@69 3609 : ([[:digit:]]{1,2})
jpayne@69 3610 (?:
jpayne@69 3611 # 5 - Standard time zone offset, seconds
jpayne@69 3612 : ([[:digit:]]{1,2} )
jpayne@69 3613 )?
jpayne@69 3614 )?
jpayne@69 3615 (?:
jpayne@69 3616 # 6 - DST time zone name
jpayne@69 3617 ([[:alpha:]]+ | <[-+[:alnum:]]+>)
jpayne@69 3618 (?:
jpayne@69 3619 (?:
jpayne@69 3620 # 7 - DST time zone offset, signum
jpayne@69 3621 ([-+]?)
jpayne@69 3622 # 8 - DST time zone offset, hours
jpayne@69 3623 ([[:digit:]]{1,2})
jpayne@69 3624 (?:
jpayne@69 3625 # 9 - DST time zone offset, minutes
jpayne@69 3626 : ([[:digit:]]{1,2})
jpayne@69 3627 (?:
jpayne@69 3628 # 10 - DST time zone offset, seconds
jpayne@69 3629 : ([[:digit:]]{1,2})
jpayne@69 3630 )?
jpayne@69 3631 )?
jpayne@69 3632 )?
jpayne@69 3633 (?:
jpayne@69 3634 ,
jpayne@69 3635 (?:
jpayne@69 3636 # 11 - Optional J in n and Jn form 12 - Day of year
jpayne@69 3637 ( J ? ) ( [[:digit:]]+ )
jpayne@69 3638 | M
jpayne@69 3639 # 13 - Month number 14 - Week of month 15 - Day of week
jpayne@69 3640 ( [[:digit:]] + )
jpayne@69 3641 [.] ( [[:digit:]] + )
jpayne@69 3642 [.] ( [[:digit:]] + )
jpayne@69 3643 )
jpayne@69 3644 (?:
jpayne@69 3645 # 16 - Start time of DST - hours
jpayne@69 3646 / ( [[:digit:]]{1,2} )
jpayne@69 3647 (?:
jpayne@69 3648 # 17 - Start time of DST - minutes
jpayne@69 3649 : ( [[:digit:]]{1,2} )
jpayne@69 3650 (?:
jpayne@69 3651 # 18 - Start time of DST - seconds
jpayne@69 3652 : ( [[:digit:]]{1,2} )
jpayne@69 3653 )?
jpayne@69 3654 )?
jpayne@69 3655 )?
jpayne@69 3656 ,
jpayne@69 3657 (?:
jpayne@69 3658 # 19 - Optional J in n and Jn form 20 - Day of year
jpayne@69 3659 ( J ? ) ( [[:digit:]]+ )
jpayne@69 3660 | M
jpayne@69 3661 # 21 - Month number 22 - Week of month 23 - Day of week
jpayne@69 3662 ( [[:digit:]] + )
jpayne@69 3663 [.] ( [[:digit:]] + )
jpayne@69 3664 [.] ( [[:digit:]] + )
jpayne@69 3665 )
jpayne@69 3666 (?:
jpayne@69 3667 # 24 - End time of DST - hours
jpayne@69 3668 / ( [[:digit:]]{1,2} )
jpayne@69 3669 (?:
jpayne@69 3670 # 25 - End time of DST - minutes
jpayne@69 3671 : ( [[:digit:]]{1,2} )
jpayne@69 3672 (?:
jpayne@69 3673 # 26 - End time of DST - seconds
jpayne@69 3674 : ( [[:digit:]]{1,2} )
jpayne@69 3675 )?
jpayne@69 3676 )?
jpayne@69 3677 )?
jpayne@69 3678 )?
jpayne@69 3679 )?
jpayne@69 3680 )?
jpayne@69 3681 $
jpayne@69 3682 } $tz -> x(stdName) x(stdSignum) x(stdHours) x(stdMinutes) x(stdSeconds) \
jpayne@69 3683 x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
jpayne@69 3684 x(startJ) x(startDayOfYear) \
jpayne@69 3685 x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
jpayne@69 3686 x(startHours) x(startMinutes) x(startSeconds) \
jpayne@69 3687 x(endJ) x(endDayOfYear) \
jpayne@69 3688 x(endMonth) x(endWeekOfMonth) x(endDayOfWeek) \
jpayne@69 3689 x(endHours) x(endMinutes) x(endSeconds)] } {
jpayne@69 3690 # it's a good timezone
jpayne@69 3691
jpayne@69 3692 return [array get x]
jpayne@69 3693 }
jpayne@69 3694
jpayne@69 3695 return -code error\
jpayne@69 3696 -errorcode [list CLOCK badTimeZone $tz] \
jpayne@69 3697 "unable to parse time zone specification \"$tz\""
jpayne@69 3698 }
jpayne@69 3699
jpayne@69 3700 #----------------------------------------------------------------------
jpayne@69 3701 #
jpayne@69 3702 # ProcessPosixTimeZone --
jpayne@69 3703 #
jpayne@69 3704 # Handle a Posix time zone after it's been broken out into fields.
jpayne@69 3705 #
jpayne@69 3706 # Parameters:
jpayne@69 3707 # z - Dictionary returned from 'ParsePosixTimeZone'
jpayne@69 3708 #
jpayne@69 3709 # Results:
jpayne@69 3710 # Returns time zone information for the 'TZData' array.
jpayne@69 3711 #
jpayne@69 3712 # Side effects:
jpayne@69 3713 # None.
jpayne@69 3714 #
jpayne@69 3715 #----------------------------------------------------------------------
jpayne@69 3716
jpayne@69 3717 proc ::tcl::clock::ProcessPosixTimeZone { z } {
jpayne@69 3718 variable MINWIDE
jpayne@69 3719 variable TZData
jpayne@69 3720
jpayne@69 3721 # Determine the standard time zone name and seconds east of Greenwich
jpayne@69 3722
jpayne@69 3723 set stdName [dict get $z stdName]
jpayne@69 3724 if { [string index $stdName 0] eq {<} } {
jpayne@69 3725 set stdName [string range $stdName 1 end-1]
jpayne@69 3726 }
jpayne@69 3727 if { [dict get $z stdSignum] eq {-} } {
jpayne@69 3728 set stdSignum +1
jpayne@69 3729 } else {
jpayne@69 3730 set stdSignum -1
jpayne@69 3731 }
jpayne@69 3732 set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
jpayne@69 3733 if { [dict get $z stdMinutes] ne {} } {
jpayne@69 3734 set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
jpayne@69 3735 } else {
jpayne@69 3736 set stdMinutes 0
jpayne@69 3737 }
jpayne@69 3738 if { [dict get $z stdSeconds] ne {} } {
jpayne@69 3739 set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
jpayne@69 3740 } else {
jpayne@69 3741 set stdSeconds 0
jpayne@69 3742 }
jpayne@69 3743 set stdOffset [expr {
jpayne@69 3744 (($stdHours * 60 + $stdMinutes) * 60 + $stdSeconds) * $stdSignum
jpayne@69 3745 }]
jpayne@69 3746 set data [list [list $MINWIDE $stdOffset 0 $stdName]]
jpayne@69 3747
jpayne@69 3748 # If there's no daylight zone, we're done
jpayne@69 3749
jpayne@69 3750 set dstName [dict get $z dstName]
jpayne@69 3751 if { $dstName eq {} } {
jpayne@69 3752 return $data
jpayne@69 3753 }
jpayne@69 3754 if { [string index $dstName 0] eq {<} } {
jpayne@69 3755 set dstName [string range $dstName 1 end-1]
jpayne@69 3756 }
jpayne@69 3757
jpayne@69 3758 # Determine the daylight name
jpayne@69 3759
jpayne@69 3760 if { [dict get $z dstSignum] eq {-} } {
jpayne@69 3761 set dstSignum +1
jpayne@69 3762 } else {
jpayne@69 3763 set dstSignum -1
jpayne@69 3764 }
jpayne@69 3765 if { [dict get $z dstHours] eq {} } {
jpayne@69 3766 set dstOffset [expr { 3600 + $stdOffset }]
jpayne@69 3767 } else {
jpayne@69 3768 set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
jpayne@69 3769 if { [dict get $z dstMinutes] ne {} } {
jpayne@69 3770 set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
jpayne@69 3771 } else {
jpayne@69 3772 set dstMinutes 0
jpayne@69 3773 }
jpayne@69 3774 if { [dict get $z dstSeconds] ne {} } {
jpayne@69 3775 set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
jpayne@69 3776 } else {
jpayne@69 3777 set dstSeconds 0
jpayne@69 3778 }
jpayne@69 3779 set dstOffset [expr {
jpayne@69 3780 (($dstHours*60 + $dstMinutes) * 60 + $dstSeconds) * $dstSignum
jpayne@69 3781 }]
jpayne@69 3782 }
jpayne@69 3783
jpayne@69 3784 # Fill in defaults for European or US DST rules
jpayne@69 3785 # US start time is the second Sunday in March
jpayne@69 3786 # EU start time is the last Sunday in March
jpayne@69 3787 # US end time is the first Sunday in November.
jpayne@69 3788 # EU end time is the last Sunday in October
jpayne@69 3789
jpayne@69 3790 if {
jpayne@69 3791 [dict get $z startDayOfYear] eq {}
jpayne@69 3792 && [dict get $z startMonth] eq {}
jpayne@69 3793 } then {
jpayne@69 3794 if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
jpayne@69 3795 # EU
jpayne@69 3796 dict set z startWeekOfMonth 5
jpayne@69 3797 if {$stdHours>2} {
jpayne@69 3798 dict set z startHours 2
jpayne@69 3799 } else {
jpayne@69 3800 dict set z startHours [expr {$stdHours+1}]
jpayne@69 3801 }
jpayne@69 3802 } else {
jpayne@69 3803 # US
jpayne@69 3804 dict set z startWeekOfMonth 2
jpayne@69 3805 dict set z startHours 2
jpayne@69 3806 }
jpayne@69 3807 dict set z startMonth 3
jpayne@69 3808 dict set z startDayOfWeek 0
jpayne@69 3809 dict set z startMinutes 0
jpayne@69 3810 dict set z startSeconds 0
jpayne@69 3811 }
jpayne@69 3812 if {
jpayne@69 3813 [dict get $z endDayOfYear] eq {}
jpayne@69 3814 && [dict get $z endMonth] eq {}
jpayne@69 3815 } then {
jpayne@69 3816 if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
jpayne@69 3817 # EU
jpayne@69 3818 dict set z endMonth 10
jpayne@69 3819 dict set z endWeekOfMonth 5
jpayne@69 3820 if {$stdHours>2} {
jpayne@69 3821 dict set z endHours 3
jpayne@69 3822 } else {
jpayne@69 3823 dict set z endHours [expr {$stdHours+2}]
jpayne@69 3824 }
jpayne@69 3825 } else {
jpayne@69 3826 # US
jpayne@69 3827 dict set z endMonth 11
jpayne@69 3828 dict set z endWeekOfMonth 1
jpayne@69 3829 dict set z endHours 2
jpayne@69 3830 }
jpayne@69 3831 dict set z endDayOfWeek 0
jpayne@69 3832 dict set z endMinutes 0
jpayne@69 3833 dict set z endSeconds 0
jpayne@69 3834 }
jpayne@69 3835
jpayne@69 3836 # Put DST in effect in all years from 1916 to 2099.
jpayne@69 3837
jpayne@69 3838 for { set y 1916 } { $y < 2100 } { incr y } {
jpayne@69 3839 set startTime [DeterminePosixDSTTime $z start $y]
jpayne@69 3840 incr startTime [expr { - wide($stdOffset) }]
jpayne@69 3841 set endTime [DeterminePosixDSTTime $z end $y]
jpayne@69 3842 incr endTime [expr { - wide($dstOffset) }]
jpayne@69 3843 if { $startTime < $endTime } {
jpayne@69 3844 lappend data \
jpayne@69 3845 [list $startTime $dstOffset 1 $dstName] \
jpayne@69 3846 [list $endTime $stdOffset 0 $stdName]
jpayne@69 3847 } else {
jpayne@69 3848 lappend data \
jpayne@69 3849 [list $endTime $stdOffset 0 $stdName] \
jpayne@69 3850 [list $startTime $dstOffset 1 $dstName]
jpayne@69 3851 }
jpayne@69 3852 }
jpayne@69 3853
jpayne@69 3854 return $data
jpayne@69 3855 }
jpayne@69 3856
jpayne@69 3857 #----------------------------------------------------------------------
jpayne@69 3858 #
jpayne@69 3859 # DeterminePosixDSTTime --
jpayne@69 3860 #
jpayne@69 3861 # Determines the time that Daylight Saving Time starts or ends from a
jpayne@69 3862 # Posix time zone specification.
jpayne@69 3863 #
jpayne@69 3864 # Parameters:
jpayne@69 3865 # z - Time zone data returned from ParsePosixTimeZone.
jpayne@69 3866 # Missing fields are expected to be filled in with
jpayne@69 3867 # default values.
jpayne@69 3868 # bound - The word 'start' or 'end'
jpayne@69 3869 # y - The year for which the transition time is to be determined.
jpayne@69 3870 #
jpayne@69 3871 # Results:
jpayne@69 3872 # Returns the transition time as a count of seconds from the epoch. The
jpayne@69 3873 # time is relative to the wall clock, not UTC.
jpayne@69 3874 #
jpayne@69 3875 #----------------------------------------------------------------------
jpayne@69 3876
jpayne@69 3877 proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
jpayne@69 3878
jpayne@69 3879 variable FEB_28
jpayne@69 3880
jpayne@69 3881 # Determine the start or end day of DST
jpayne@69 3882
jpayne@69 3883 set date [dict create era CE year $y]
jpayne@69 3884 set doy [dict get $z ${bound}DayOfYear]
jpayne@69 3885 if { $doy ne {} } {
jpayne@69 3886
jpayne@69 3887 # Time was specified as a day of the year
jpayne@69 3888
jpayne@69 3889 if { [dict get $z ${bound}J] ne {}
jpayne@69 3890 && [IsGregorianLeapYear $y]
jpayne@69 3891 && ( $doy > $FEB_28 ) } {
jpayne@69 3892 incr doy
jpayne@69 3893 }
jpayne@69 3894 dict set date dayOfYear $doy
jpayne@69 3895 set date [GetJulianDayFromEraYearDay $date[set date {}] 2361222]
jpayne@69 3896 } else {
jpayne@69 3897 # Time was specified as a day of the week within a month
jpayne@69 3898
jpayne@69 3899 dict set date month [dict get $z ${bound}Month]
jpayne@69 3900 dict set date dayOfWeek [dict get $z ${bound}DayOfWeek]
jpayne@69 3901 set dowim [dict get $z ${bound}WeekOfMonth]
jpayne@69 3902 if { $dowim >= 5 } {
jpayne@69 3903 set dowim -1
jpayne@69 3904 }
jpayne@69 3905 dict set date dayOfWeekInMonth $dowim
jpayne@69 3906 set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222]
jpayne@69 3907
jpayne@69 3908 }
jpayne@69 3909
jpayne@69 3910 set jd [dict get $date julianDay]
jpayne@69 3911 set seconds [expr {
jpayne@69 3912 wide($jd) * wide(86400) - wide(210866803200)
jpayne@69 3913 }]
jpayne@69 3914
jpayne@69 3915 set h [dict get $z ${bound}Hours]
jpayne@69 3916 if { $h eq {} } {
jpayne@69 3917 set h 2
jpayne@69 3918 } else {
jpayne@69 3919 set h [lindex [::scan $h %d] 0]
jpayne@69 3920 }
jpayne@69 3921 set m [dict get $z ${bound}Minutes]
jpayne@69 3922 if { $m eq {} } {
jpayne@69 3923 set m 0
jpayne@69 3924 } else {
jpayne@69 3925 set m [lindex [::scan $m %d] 0]
jpayne@69 3926 }
jpayne@69 3927 set s [dict get $z ${bound}Seconds]
jpayne@69 3928 if { $s eq {} } {
jpayne@69 3929 set s 0
jpayne@69 3930 } else {
jpayne@69 3931 set s [lindex [::scan $s %d] 0]
jpayne@69 3932 }
jpayne@69 3933 set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
jpayne@69 3934 return [expr { $seconds + $tod }]
jpayne@69 3935 }
jpayne@69 3936
jpayne@69 3937 #----------------------------------------------------------------------
jpayne@69 3938 #
jpayne@69 3939 # GetLocaleEra --
jpayne@69 3940 #
jpayne@69 3941 # Given local time expressed in seconds from the Posix epoch,
jpayne@69 3942 # determine localized era and year within the era.
jpayne@69 3943 #
jpayne@69 3944 # Parameters:
jpayne@69 3945 # date - Dictionary that must contain the keys, 'localSeconds',
jpayne@69 3946 # whose value is expressed as the appropriate local time;
jpayne@69 3947 # and 'year', whose value is the Gregorian year.
jpayne@69 3948 # etable - Value of the LOCALE_ERAS key in the message catalogue
jpayne@69 3949 # for the target locale.
jpayne@69 3950 #
jpayne@69 3951 # Results:
jpayne@69 3952 # Returns the dictionary, augmented with the keys, 'localeEra' and
jpayne@69 3953 # 'localeYear'.
jpayne@69 3954 #
jpayne@69 3955 #----------------------------------------------------------------------
jpayne@69 3956
jpayne@69 3957 proc ::tcl::clock::GetLocaleEra { date etable } {
jpayne@69 3958 set index [BSearch $etable [dict get $date localSeconds]]
jpayne@69 3959 if { $index < 0} {
jpayne@69 3960 dict set date localeEra \
jpayne@69 3961 [::format %02d [expr { [dict get $date year] / 100 }]]
jpayne@69 3962 dict set date localeYear [expr {
jpayne@69 3963 [dict get $date year] % 100
jpayne@69 3964 }]
jpayne@69 3965 } else {
jpayne@69 3966 dict set date localeEra [lindex $etable $index 1]
jpayne@69 3967 dict set date localeYear [expr {
jpayne@69 3968 [dict get $date year] - [lindex $etable $index 2]
jpayne@69 3969 }]
jpayne@69 3970 }
jpayne@69 3971 return $date
jpayne@69 3972 }
jpayne@69 3973
jpayne@69 3974 #----------------------------------------------------------------------
jpayne@69 3975 #
jpayne@69 3976 # GetJulianDayFromEraYearDay --
jpayne@69 3977 #
jpayne@69 3978 # Given a year, month and day on the Gregorian calendar, determines
jpayne@69 3979 # the Julian Day Number beginning at noon on that date.
jpayne@69 3980 #
jpayne@69 3981 # Parameters:
jpayne@69 3982 # date -- A dictionary in which the 'era', 'year', and
jpayne@69 3983 # 'dayOfYear' slots are populated. The calendar in use
jpayne@69 3984 # is determined by the date itself relative to:
jpayne@69 3985 # changeover -- Julian day on which the Gregorian calendar was
jpayne@69 3986 # adopted in the current locale.
jpayne@69 3987 #
jpayne@69 3988 # Results:
jpayne@69 3989 # Returns the given dictionary augmented with a 'julianDay' key whose
jpayne@69 3990 # value is the desired Julian Day Number, and a 'gregorian' key that
jpayne@69 3991 # specifies whether the calendar is Gregorian (1) or Julian (0).
jpayne@69 3992 #
jpayne@69 3993 # Side effects:
jpayne@69 3994 # None.
jpayne@69 3995 #
jpayne@69 3996 # Bugs:
jpayne@69 3997 # This code needs to be moved to the C layer.
jpayne@69 3998 #
jpayne@69 3999 #----------------------------------------------------------------------
jpayne@69 4000
jpayne@69 4001 proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
jpayne@69 4002 # Get absolute year number from the civil year
jpayne@69 4003
jpayne@69 4004 switch -exact -- [dict get $date era] {
jpayne@69 4005 BCE {
jpayne@69 4006 set year [expr { 1 - [dict get $date year] }]
jpayne@69 4007 }
jpayne@69 4008 CE {
jpayne@69 4009 set year [dict get $date year]
jpayne@69 4010 }
jpayne@69 4011 }
jpayne@69 4012 set ym1 [expr { $year - 1 }]
jpayne@69 4013
jpayne@69 4014 # Try the Gregorian calendar first.
jpayne@69 4015
jpayne@69 4016 dict set date gregorian 1
jpayne@69 4017 set jd [expr {
jpayne@69 4018 1721425
jpayne@69 4019 + [dict get $date dayOfYear]
jpayne@69 4020 + ( 365 * $ym1 )
jpayne@69 4021 + ( $ym1 / 4 )
jpayne@69 4022 - ( $ym1 / 100 )
jpayne@69 4023 + ( $ym1 / 400 )
jpayne@69 4024 }]
jpayne@69 4025
jpayne@69 4026 # If the date is before the Gregorian change, use the Julian calendar.
jpayne@69 4027
jpayne@69 4028 if { $jd < $changeover } {
jpayne@69 4029 dict set date gregorian 0
jpayne@69 4030 set jd [expr {
jpayne@69 4031 1721423
jpayne@69 4032 + [dict get $date dayOfYear]
jpayne@69 4033 + ( 365 * $ym1 )
jpayne@69 4034 + ( $ym1 / 4 )
jpayne@69 4035 }]
jpayne@69 4036 }
jpayne@69 4037
jpayne@69 4038 dict set date julianDay $jd
jpayne@69 4039 return $date
jpayne@69 4040 }
jpayne@69 4041
jpayne@69 4042 #----------------------------------------------------------------------
jpayne@69 4043 #
jpayne@69 4044 # GetJulianDayFromEraYearMonthWeekDay --
jpayne@69 4045 #
jpayne@69 4046 # Determines the Julian Day number corresponding to the nth given
jpayne@69 4047 # day-of-the-week in a given month.
jpayne@69 4048 #
jpayne@69 4049 # Parameters:
jpayne@69 4050 # date - Dictionary containing the keys, 'era', 'year', 'month'
jpayne@69 4051 # 'weekOfMonth', 'dayOfWeek', and 'dayOfWeekInMonth'.
jpayne@69 4052 # changeover - Julian Day of adoption of the Gregorian calendar
jpayne@69 4053 #
jpayne@69 4054 # Results:
jpayne@69 4055 # Returns the given dictionary, augmented with a 'julianDay' key.
jpayne@69 4056 #
jpayne@69 4057 # Side effects:
jpayne@69 4058 # None.
jpayne@69 4059 #
jpayne@69 4060 # Bugs:
jpayne@69 4061 # This code needs to be moved to the C layer.
jpayne@69 4062 #
jpayne@69 4063 #----------------------------------------------------------------------
jpayne@69 4064
jpayne@69 4065 proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {
jpayne@69 4066 # Come up with a reference day; either the zeroeth day of the given month
jpayne@69 4067 # (dayOfWeekInMonth >= 0) or the seventh day of the following month
jpayne@69 4068 # (dayOfWeekInMonth < 0)
jpayne@69 4069
jpayne@69 4070 set date2 $date
jpayne@69 4071 set week [dict get $date dayOfWeekInMonth]
jpayne@69 4072 if { $week >= 0 } {
jpayne@69 4073 dict set date2 dayOfMonth 0
jpayne@69 4074 } else {
jpayne@69 4075 dict incr date2 month
jpayne@69 4076 dict set date2 dayOfMonth 7
jpayne@69 4077 }
jpayne@69 4078 set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
jpayne@69 4079 $changeover]
jpayne@69 4080 set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
jpayne@69 4081 [dict get $date2 julianDay]]
jpayne@69 4082 dict set date julianDay [expr { $wd0 + 7 * $week }]
jpayne@69 4083 return $date
jpayne@69 4084 }
jpayne@69 4085
jpayne@69 4086 #----------------------------------------------------------------------
jpayne@69 4087 #
jpayne@69 4088 # IsGregorianLeapYear --
jpayne@69 4089 #
jpayne@69 4090 # Determines whether a given date represents a leap year in the
jpayne@69 4091 # Gregorian calendar.
jpayne@69 4092 #
jpayne@69 4093 # Parameters:
jpayne@69 4094 # date -- The date to test. The fields, 'era', 'year' and 'gregorian'
jpayne@69 4095 # must be set.
jpayne@69 4096 #
jpayne@69 4097 # Results:
jpayne@69 4098 # Returns 1 if the year is a leap year, 0 otherwise.
jpayne@69 4099 #
jpayne@69 4100 # Side effects:
jpayne@69 4101 # None.
jpayne@69 4102 #
jpayne@69 4103 #----------------------------------------------------------------------
jpayne@69 4104
jpayne@69 4105 proc ::tcl::clock::IsGregorianLeapYear { date } {
jpayne@69 4106 switch -exact -- [dict get $date era] {
jpayne@69 4107 BCE {
jpayne@69 4108 set year [expr { 1 - [dict get $date year]}]
jpayne@69 4109 }
jpayne@69 4110 CE {
jpayne@69 4111 set year [dict get $date year]
jpayne@69 4112 }
jpayne@69 4113 }
jpayne@69 4114 if { $year % 4 != 0 } {
jpayne@69 4115 return 0
jpayne@69 4116 } elseif { ![dict get $date gregorian] } {
jpayne@69 4117 return 1
jpayne@69 4118 } elseif { $year % 400 == 0 } {
jpayne@69 4119 return 1
jpayne@69 4120 } elseif { $year % 100 == 0 } {
jpayne@69 4121 return 0
jpayne@69 4122 } else {
jpayne@69 4123 return 1
jpayne@69 4124 }
jpayne@69 4125 }
jpayne@69 4126
jpayne@69 4127 #----------------------------------------------------------------------
jpayne@69 4128 #
jpayne@69 4129 # WeekdayOnOrBefore --
jpayne@69 4130 #
jpayne@69 4131 # Determine the nearest day of week (given by the 'weekday' parameter,
jpayne@69 4132 # Sunday==0) on or before a given Julian Day.
jpayne@69 4133 #
jpayne@69 4134 # Parameters:
jpayne@69 4135 # weekday -- Day of the week
jpayne@69 4136 # j -- Julian Day number
jpayne@69 4137 #
jpayne@69 4138 # Results:
jpayne@69 4139 # Returns the Julian Day Number of the desired date.
jpayne@69 4140 #
jpayne@69 4141 # Side effects:
jpayne@69 4142 # None.
jpayne@69 4143 #
jpayne@69 4144 #----------------------------------------------------------------------
jpayne@69 4145
jpayne@69 4146 proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
jpayne@69 4147 set k [expr { ( $weekday + 6 ) % 7 }]
jpayne@69 4148 return [expr { $j - ( $j - $k ) % 7 }]
jpayne@69 4149 }
jpayne@69 4150
jpayne@69 4151 #----------------------------------------------------------------------
jpayne@69 4152 #
jpayne@69 4153 # BSearch --
jpayne@69 4154 #
jpayne@69 4155 # Service procedure that does binary search in several places inside the
jpayne@69 4156 # 'clock' command.
jpayne@69 4157 #
jpayne@69 4158 # Parameters:
jpayne@69 4159 # list - List of lists, sorted in ascending order by the
jpayne@69 4160 # first elements
jpayne@69 4161 # key - Value to search for
jpayne@69 4162 #
jpayne@69 4163 # Results:
jpayne@69 4164 # Returns the index of the greatest element in $list that is less than
jpayne@69 4165 # or equal to $key.
jpayne@69 4166 #
jpayne@69 4167 # Side effects:
jpayne@69 4168 # None.
jpayne@69 4169 #
jpayne@69 4170 #----------------------------------------------------------------------
jpayne@69 4171
jpayne@69 4172 proc ::tcl::clock::BSearch { list key } {
jpayne@69 4173 if {[llength $list] == 0} {
jpayne@69 4174 return -1
jpayne@69 4175 }
jpayne@69 4176 if { $key < [lindex $list 0 0] } {
jpayne@69 4177 return -1
jpayne@69 4178 }
jpayne@69 4179
jpayne@69 4180 set l 0
jpayne@69 4181 set u [expr { [llength $list] - 1 }]
jpayne@69 4182
jpayne@69 4183 while { $l < $u } {
jpayne@69 4184 # At this point, we know that
jpayne@69 4185 # $k >= [lindex $list $l 0]
jpayne@69 4186 # Either $u == [llength $list] or else $k < [lindex $list $u+1 0]
jpayne@69 4187 # We find the midpoint of the interval {l,u} rounded UP, compare
jpayne@69 4188 # against it, and set l or u to maintain the invariant. Note that the
jpayne@69 4189 # interval shrinks at each step, guaranteeing convergence.
jpayne@69 4190
jpayne@69 4191 set m [expr { ( $l + $u + 1 ) / 2 }]
jpayne@69 4192 if { $key >= [lindex $list $m 0] } {
jpayne@69 4193 set l $m
jpayne@69 4194 } else {
jpayne@69 4195 set u [expr { $m - 1 }]
jpayne@69 4196 }
jpayne@69 4197 }
jpayne@69 4198
jpayne@69 4199 return $l
jpayne@69 4200 }
jpayne@69 4201
jpayne@69 4202 #----------------------------------------------------------------------
jpayne@69 4203 #
jpayne@69 4204 # clock add --
jpayne@69 4205 #
jpayne@69 4206 # Adds an offset to a given time.
jpayne@69 4207 #
jpayne@69 4208 # Syntax:
jpayne@69 4209 # clock add clockval ?count unit?... ?-option value?
jpayne@69 4210 #
jpayne@69 4211 # Parameters:
jpayne@69 4212 # clockval -- Starting time value
jpayne@69 4213 # count -- Amount of a unit of time to add
jpayne@69 4214 # unit -- Unit of time to add, must be one of:
jpayne@69 4215 # years year months month weeks week
jpayne@69 4216 # days day hours hour minutes minute
jpayne@69 4217 # seconds second
jpayne@69 4218 #
jpayne@69 4219 # Options:
jpayne@69 4220 # -gmt BOOLEAN
jpayne@69 4221 # (Deprecated) Flag synonymous with '-timezone :GMT'
jpayne@69 4222 # -timezone ZONE
jpayne@69 4223 # Name of the time zone in which calculations are to be done.
jpayne@69 4224 # -locale NAME
jpayne@69 4225 # Name of the locale in which calculations are to be done.
jpayne@69 4226 # Used to determine the Gregorian change date.
jpayne@69 4227 #
jpayne@69 4228 # Results:
jpayne@69 4229 # Returns the given time adjusted by the given offset(s) in
jpayne@69 4230 # order.
jpayne@69 4231 #
jpayne@69 4232 # Notes:
jpayne@69 4233 # It is possible that adding a number of months or years will adjust the
jpayne@69 4234 # day of the month as well. For instance, the time at one month after
jpayne@69 4235 # 31 January is either 28 or 29 February, because February has fewer
jpayne@69 4236 # than 31 days.
jpayne@69 4237 #
jpayne@69 4238 #----------------------------------------------------------------------
jpayne@69 4239
jpayne@69 4240 proc ::tcl::clock::add { clockval args } {
jpayne@69 4241 if { [llength $args] % 2 != 0 } {
jpayne@69 4242 set cmdName "clock add"
jpayne@69 4243 return -code error \
jpayne@69 4244 -errorcode [list CLOCK wrongNumArgs] \
jpayne@69 4245 "wrong \# args: should be\
jpayne@69 4246 \"$cmdName clockval ?number units?...\
jpayne@69 4247 ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
jpayne@69 4248 }
jpayne@69 4249 if { [catch { expr {wide($clockval)} } result] } {
jpayne@69 4250 return -code error $result
jpayne@69 4251 }
jpayne@69 4252
jpayne@69 4253 set offsets {}
jpayne@69 4254 set gmt 0
jpayne@69 4255 set locale c
jpayne@69 4256 set timezone [GetSystemTimeZone]
jpayne@69 4257
jpayne@69 4258 foreach { a b } $args {
jpayne@69 4259 if { [string is integer -strict $a] } {
jpayne@69 4260 lappend offsets $a $b
jpayne@69 4261 } else {
jpayne@69 4262 switch -exact -- $a {
jpayne@69 4263 -g - -gm - -gmt {
jpayne@69 4264 set gmt $b
jpayne@69 4265 }
jpayne@69 4266 -l - -lo - -loc - -loca - -local - -locale {
jpayne@69 4267 set locale [string tolower $b]
jpayne@69 4268 }
jpayne@69 4269 -t - -ti - -tim - -time - -timez - -timezo - -timezon -
jpayne@69 4270 -timezone {
jpayne@69 4271 set timezone $b
jpayne@69 4272 }
jpayne@69 4273 default {
jpayne@69 4274 throw [list CLOCK badOption $a] \
jpayne@69 4275 "bad option \"$a\",\
jpayne@69 4276 must be -gmt, -locale or -timezone"
jpayne@69 4277 }
jpayne@69 4278 }
jpayne@69 4279 }
jpayne@69 4280 }
jpayne@69 4281
jpayne@69 4282 # Check options for validity
jpayne@69 4283
jpayne@69 4284 if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
jpayne@69 4285 return -code error \
jpayne@69 4286 -errorcode [list CLOCK gmtWithTimezone] \
jpayne@69 4287 "cannot use -gmt and -timezone in same call"
jpayne@69 4288 }
jpayne@69 4289 if { [catch { expr { wide($clockval) } } result] } {
jpayne@69 4290 return -code error "expected integer but got \"$clockval\""
jpayne@69 4291 }
jpayne@69 4292 if { ![string is boolean -strict $gmt] } {
jpayne@69 4293 return -code error "expected boolean value but got \"$gmt\""
jpayne@69 4294 } elseif { $gmt } {
jpayne@69 4295 set timezone :GMT
jpayne@69 4296 }
jpayne@69 4297
jpayne@69 4298 EnterLocale $locale
jpayne@69 4299
jpayne@69 4300 set changeover [mc GREGORIAN_CHANGE_DATE]
jpayne@69 4301
jpayne@69 4302 if {[catch {SetupTimeZone $timezone} retval opts]} {
jpayne@69 4303 dict unset opts -errorinfo
jpayne@69 4304 return -options $opts $retval
jpayne@69 4305 }
jpayne@69 4306
jpayne@69 4307 try {
jpayne@69 4308 foreach { quantity unit } $offsets {
jpayne@69 4309 switch -exact -- $unit {
jpayne@69 4310 years - year {
jpayne@69 4311 set clockval [AddMonths [expr { 12 * $quantity }] \
jpayne@69 4312 $clockval $timezone $changeover]
jpayne@69 4313 }
jpayne@69 4314 months - month {
jpayne@69 4315 set clockval [AddMonths $quantity $clockval $timezone \
jpayne@69 4316 $changeover]
jpayne@69 4317 }
jpayne@69 4318
jpayne@69 4319 weeks - week {
jpayne@69 4320 set clockval [AddDays [expr { 7 * $quantity }] \
jpayne@69 4321 $clockval $timezone $changeover]
jpayne@69 4322 }
jpayne@69 4323 days - day {
jpayne@69 4324 set clockval [AddDays $quantity $clockval $timezone \
jpayne@69 4325 $changeover]
jpayne@69 4326 }
jpayne@69 4327
jpayne@69 4328 hours - hour {
jpayne@69 4329 set clockval [expr { 3600 * $quantity + $clockval }]
jpayne@69 4330 }
jpayne@69 4331 minutes - minute {
jpayne@69 4332 set clockval [expr { 60 * $quantity + $clockval }]
jpayne@69 4333 }
jpayne@69 4334 seconds - second {
jpayne@69 4335 set clockval [expr { $quantity + $clockval }]
jpayne@69 4336 }
jpayne@69 4337
jpayne@69 4338 default {
jpayne@69 4339 throw [list CLOCK badUnit $unit] \
jpayne@69 4340 "unknown unit \"$unit\", must be \
jpayne@69 4341 years, months, weeks, days, hours, minutes or seconds"
jpayne@69 4342 }
jpayne@69 4343 }
jpayne@69 4344 }
jpayne@69 4345 return $clockval
jpayne@69 4346 } trap CLOCK {result opts} {
jpayne@69 4347 # Conceal the innards of [clock] when it's an expected error
jpayne@69 4348 dict unset opts -errorinfo
jpayne@69 4349 return -options $opts $result
jpayne@69 4350 }
jpayne@69 4351 }
jpayne@69 4352
jpayne@69 4353 #----------------------------------------------------------------------
jpayne@69 4354 #
jpayne@69 4355 # AddMonths --
jpayne@69 4356 #
jpayne@69 4357 # Add a given number of months to a given clock value in a given
jpayne@69 4358 # time zone.
jpayne@69 4359 #
jpayne@69 4360 # Parameters:
jpayne@69 4361 # months - Number of months to add (may be negative)
jpayne@69 4362 # clockval - Seconds since the epoch before the operation
jpayne@69 4363 # timezone - Time zone in which the operation is to be performed
jpayne@69 4364 #
jpayne@69 4365 # Results:
jpayne@69 4366 # Returns the new clock value as a number of seconds since
jpayne@69 4367 # the epoch.
jpayne@69 4368 #
jpayne@69 4369 # Side effects:
jpayne@69 4370 # None.
jpayne@69 4371 #
jpayne@69 4372 #----------------------------------------------------------------------
jpayne@69 4373
jpayne@69 4374 proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
jpayne@69 4375 variable DaysInRomanMonthInCommonYear
jpayne@69 4376 variable DaysInRomanMonthInLeapYear
jpayne@69 4377 variable TZData
jpayne@69 4378
jpayne@69 4379 # Convert the time to year, month, day, and fraction of day.
jpayne@69 4380
jpayne@69 4381 set date [GetDateFields $clockval $TZData($timezone) $changeover]
jpayne@69 4382 dict set date secondOfDay [expr {
jpayne@69 4383 [dict get $date localSeconds] % 86400
jpayne@69 4384 }]
jpayne@69 4385 dict set date tzName $timezone
jpayne@69 4386
jpayne@69 4387 # Add the requisite number of months
jpayne@69 4388
jpayne@69 4389 set m [dict get $date month]
jpayne@69 4390 incr m $months
jpayne@69 4391 incr m -1
jpayne@69 4392 set delta [expr { $m / 12 }]
jpayne@69 4393 set mm [expr { $m % 12 }]
jpayne@69 4394 dict set date month [expr { $mm + 1 }]
jpayne@69 4395 dict incr date year $delta
jpayne@69 4396
jpayne@69 4397 # If the date doesn't exist in the current month, repair it
jpayne@69 4398
jpayne@69 4399 if { [IsGregorianLeapYear $date] } {
jpayne@69 4400 set hath [lindex $DaysInRomanMonthInLeapYear $mm]
jpayne@69 4401 } else {
jpayne@69 4402 set hath [lindex $DaysInRomanMonthInCommonYear $mm]
jpayne@69 4403 }
jpayne@69 4404 if { [dict get $date dayOfMonth] > $hath } {
jpayne@69 4405 dict set date dayOfMonth $hath
jpayne@69 4406 }
jpayne@69 4407
jpayne@69 4408 # Reconvert to a number of seconds
jpayne@69 4409
jpayne@69 4410 set date [GetJulianDayFromEraYearMonthDay \
jpayne@69 4411 $date[set date {}]\
jpayne@69 4412 $changeover]
jpayne@69 4413 dict set date localSeconds [expr {
jpayne@69 4414 -210866803200
jpayne@69 4415 + ( 86400 * wide([dict get $date julianDay]) )
jpayne@69 4416 + [dict get $date secondOfDay]
jpayne@69 4417 }]
jpayne@69 4418 set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
jpayne@69 4419 $changeover]
jpayne@69 4420
jpayne@69 4421 return [dict get $date seconds]
jpayne@69 4422
jpayne@69 4423 }
jpayne@69 4424
jpayne@69 4425 #----------------------------------------------------------------------
jpayne@69 4426 #
jpayne@69 4427 # AddDays --
jpayne@69 4428 #
jpayne@69 4429 # Add a given number of days to a given clock value in a given time
jpayne@69 4430 # zone.
jpayne@69 4431 #
jpayne@69 4432 # Parameters:
jpayne@69 4433 # days - Number of days to add (may be negative)
jpayne@69 4434 # clockval - Seconds since the epoch before the operation
jpayne@69 4435 # timezone - Time zone in which the operation is to be performed
jpayne@69 4436 # changeover - Julian Day on which the Gregorian calendar was adopted
jpayne@69 4437 # in the target locale.
jpayne@69 4438 #
jpayne@69 4439 # Results:
jpayne@69 4440 # Returns the new clock value as a number of seconds since the epoch.
jpayne@69 4441 #
jpayne@69 4442 # Side effects:
jpayne@69 4443 # None.
jpayne@69 4444 #
jpayne@69 4445 #----------------------------------------------------------------------
jpayne@69 4446
jpayne@69 4447 proc ::tcl::clock::AddDays { days clockval timezone changeover } {
jpayne@69 4448 variable TZData
jpayne@69 4449
jpayne@69 4450 # Convert the time to Julian Day
jpayne@69 4451
jpayne@69 4452 set date [GetDateFields $clockval $TZData($timezone) $changeover]
jpayne@69 4453 dict set date secondOfDay [expr {
jpayne@69 4454 [dict get $date localSeconds] % 86400
jpayne@69 4455 }]
jpayne@69 4456 dict set date tzName $timezone
jpayne@69 4457
jpayne@69 4458 # Add the requisite number of days
jpayne@69 4459
jpayne@69 4460 dict incr date julianDay $days
jpayne@69 4461
jpayne@69 4462 # Reconvert to a number of seconds
jpayne@69 4463
jpayne@69 4464 dict set date localSeconds [expr {
jpayne@69 4465 -210866803200
jpayne@69 4466 + ( 86400 * wide([dict get $date julianDay]) )
jpayne@69 4467 + [dict get $date secondOfDay]
jpayne@69 4468 }]
jpayne@69 4469 set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
jpayne@69 4470 $changeover]
jpayne@69 4471
jpayne@69 4472 return [dict get $date seconds]
jpayne@69 4473
jpayne@69 4474 }
jpayne@69 4475
jpayne@69 4476 #----------------------------------------------------------------------
jpayne@69 4477 #
jpayne@69 4478 # ChangeCurrentLocale --
jpayne@69 4479 #
jpayne@69 4480 # The global locale was changed within msgcat.
jpayne@69 4481 # Clears the buffered parse functions of the current locale.
jpayne@69 4482 #
jpayne@69 4483 # Parameters:
jpayne@69 4484 # loclist (ignored)
jpayne@69 4485 #
jpayne@69 4486 # Results:
jpayne@69 4487 # None.
jpayne@69 4488 #
jpayne@69 4489 # Side effects:
jpayne@69 4490 # Buffered parse functions are cleared.
jpayne@69 4491 #
jpayne@69 4492 #----------------------------------------------------------------------
jpayne@69 4493
jpayne@69 4494 proc ::tcl::clock::ChangeCurrentLocale {args} {
jpayne@69 4495 variable FormatProc
jpayne@69 4496 variable LocaleNumeralCache
jpayne@69 4497 variable CachedSystemTimeZone
jpayne@69 4498 variable TimeZoneBad
jpayne@69 4499
jpayne@69 4500 foreach p [info procs [namespace current]::scanproc'*'current] {
jpayne@69 4501 rename $p {}
jpayne@69 4502 }
jpayne@69 4503 foreach p [info procs [namespace current]::formatproc'*'current] {
jpayne@69 4504 rename $p {}
jpayne@69 4505 }
jpayne@69 4506
jpayne@69 4507 catch {array unset FormatProc *'current}
jpayne@69 4508 set LocaleNumeralCache {}
jpayne@69 4509 }
jpayne@69 4510
jpayne@69 4511 #----------------------------------------------------------------------
jpayne@69 4512 #
jpayne@69 4513 # ClearCaches --
jpayne@69 4514 #
jpayne@69 4515 # Clears all caches to reclaim the memory used in [clock]
jpayne@69 4516 #
jpayne@69 4517 # Parameters:
jpayne@69 4518 # None.
jpayne@69 4519 #
jpayne@69 4520 # Results:
jpayne@69 4521 # None.
jpayne@69 4522 #
jpayne@69 4523 # Side effects:
jpayne@69 4524 # Caches are cleared.
jpayne@69 4525 #
jpayne@69 4526 #----------------------------------------------------------------------
jpayne@69 4527
jpayne@69 4528 proc ::tcl::clock::ClearCaches {} {
jpayne@69 4529 variable FormatProc
jpayne@69 4530 variable LocaleNumeralCache
jpayne@69 4531 variable CachedSystemTimeZone
jpayne@69 4532 variable TimeZoneBad
jpayne@69 4533
jpayne@69 4534 foreach p [info procs [namespace current]::scanproc'*] {
jpayne@69 4535 rename $p {}
jpayne@69 4536 }
jpayne@69 4537 foreach p [info procs [namespace current]::formatproc'*] {
jpayne@69 4538 rename $p {}
jpayne@69 4539 }
jpayne@69 4540
jpayne@69 4541 catch {unset FormatProc}
jpayne@69 4542 set LocaleNumeralCache {}
jpayne@69 4543 catch {unset CachedSystemTimeZone}
jpayne@69 4544 set TimeZoneBad {}
jpayne@69 4545 InitTZData
jpayne@69 4546 }