clock.tcl 59 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097
  1. #----------------------------------------------------------------------
  2. #
  3. # clock.tcl --
  4. #
  5. # This file implements the portions of the [clock] ensemble that are
  6. # coded in Tcl. Refer to the users' manual to see the description of
  7. # the [clock] command and its subcommands.
  8. #
  9. #
  10. #----------------------------------------------------------------------
  11. #
  12. # Copyright © 2004-2007 Kevin B. Kenny
  13. # Copyright © 2015 Sergey G. Brester aka sebres.
  14. # See the file "license.terms" for information on usage and redistribution
  15. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16. #
  17. #----------------------------------------------------------------------
  18. # msgcat 1.7 features are used.
  19. package require msgcat 1.7
  20. # Put the library directory into the namespace for the ensemble so that the
  21. # library code can find message catalogs and time zone definition files.
  22. namespace eval ::tcl::clock \
  23. [list variable LibDir [info library]]
  24. #----------------------------------------------------------------------
  25. #
  26. # clock --
  27. #
  28. # Manipulate times.
  29. #
  30. # The 'clock' command manipulates time. Refer to the user documentation for
  31. # the available subcommands and what they do.
  32. #
  33. #----------------------------------------------------------------------
  34. namespace eval ::tcl::clock {
  35. # Export the subcommands
  36. namespace export format
  37. namespace export clicks
  38. namespace export microseconds
  39. namespace export milliseconds
  40. namespace export scan
  41. namespace export seconds
  42. namespace export add
  43. # Import the message catalog commands that we use.
  44. namespace import ::msgcat::mclocale
  45. namespace import ::msgcat::mcpackagelocale
  46. }
  47. #----------------------------------------------------------------------
  48. #
  49. # ::tcl::clock::Initialize --
  50. #
  51. # Finish initializing the 'clock' subsystem
  52. #
  53. # Results:
  54. # None.
  55. #
  56. # Side effects:
  57. # Namespace variable in the 'clock' subsystem are initialized.
  58. #
  59. # The '::tcl::clock::Initialize' procedure initializes the namespace variables
  60. # and root locale message catalog for the 'clock' subsystem. It is broken
  61. # into a procedure rather than simply evaluated as a script so that it will be
  62. # able to use local variables, avoiding the dangers of 'creative writing' as
  63. # in Bug 1185933.
  64. #
  65. #----------------------------------------------------------------------
  66. proc ::tcl::clock::Initialize {} {
  67. rename ::tcl::clock::Initialize {}
  68. variable LibDir
  69. # Define the Greenwich time zone
  70. proc InitTZData {} {
  71. variable TZData
  72. array unset TZData
  73. set TZData(:Etc/GMT) {
  74. {-9223372036854775808 0 0 GMT}
  75. }
  76. set TZData(:GMT) $TZData(:Etc/GMT)
  77. set TZData(:Etc/UTC) {
  78. {-9223372036854775808 0 0 UTC}
  79. }
  80. set TZData(:UTC) $TZData(:Etc/UTC)
  81. set TZData(:localtime) {}
  82. }
  83. InitTZData
  84. mcpackagelocale set {}
  85. ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs]
  86. ::msgcat::mcpackageconfig set unknowncmd ""
  87. ::msgcat::mcpackageconfig set changecmd ChangeCurrentLocale
  88. # Define the message catalog for the root locale.
  89. ::msgcat::mcmset {} {
  90. AM {am}
  91. BCE {B.C.E.}
  92. CE {C.E.}
  93. DATE_FORMAT {%m/%d/%Y}
  94. DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y}
  95. DAYS_OF_WEEK_ABBREV {
  96. Sun Mon Tue Wed Thu Fri Sat
  97. }
  98. DAYS_OF_WEEK_FULL {
  99. Sunday Monday Tuesday Wednesday Thursday Friday Saturday
  100. }
  101. GREGORIAN_CHANGE_DATE 2299161
  102. LOCALE_DATE_FORMAT {%m/%d/%Y}
  103. LOCALE_DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y}
  104. LOCALE_ERAS {}
  105. LOCALE_NUMERALS {
  106. 00 01 02 03 04 05 06 07 08 09
  107. 10 11 12 13 14 15 16 17 18 19
  108. 20 21 22 23 24 25 26 27 28 29
  109. 30 31 32 33 34 35 36 37 38 39
  110. 40 41 42 43 44 45 46 47 48 49
  111. 50 51 52 53 54 55 56 57 58 59
  112. 60 61 62 63 64 65 66 67 68 69
  113. 70 71 72 73 74 75 76 77 78 79
  114. 80 81 82 83 84 85 86 87 88 89
  115. 90 91 92 93 94 95 96 97 98 99
  116. }
  117. LOCALE_TIME_FORMAT {%H:%M:%S}
  118. LOCALE_YEAR_FORMAT {%EC%Ey}
  119. MONTHS_ABBREV {
  120. Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
  121. }
  122. MONTHS_FULL {
  123. January February March
  124. April May June
  125. July August September
  126. October November December
  127. }
  128. PM {pm}
  129. TIME_FORMAT {%H:%M:%S}
  130. TIME_FORMAT_12 {%I:%M:%S %P}
  131. TIME_FORMAT_24 {%H:%M}
  132. TIME_FORMAT_24_SECS {%H:%M:%S}
  133. }
  134. # Define a few Gregorian change dates for other locales. In most cases
  135. # the change date follows a language, because a nation's colonies changed
  136. # at the same time as the nation itself. In many cases, different
  137. # national boundaries existed; the dominating rule is to follow the
  138. # nation's capital.
  139. # Italy, Spain, Portugal, Poland
  140. ::msgcat::mcset it GREGORIAN_CHANGE_DATE 2299161
  141. ::msgcat::mcset es GREGORIAN_CHANGE_DATE 2299161
  142. ::msgcat::mcset pt GREGORIAN_CHANGE_DATE 2299161
  143. ::msgcat::mcset pl GREGORIAN_CHANGE_DATE 2299161
  144. # France, Austria
  145. ::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227
  146. # For Belgium, we follow Southern Netherlands; Liege Diocese changed
  147. # several weeks later.
  148. ::msgcat::mcset fr_BE GREGORIAN_CHANGE_DATE 2299238
  149. ::msgcat::mcset nl_BE GREGORIAN_CHANGE_DATE 2299238
  150. # Austria
  151. ::msgcat::mcset de_AT GREGORIAN_CHANGE_DATE 2299527
  152. # Hungary
  153. ::msgcat::mcset hu GREGORIAN_CHANGE_DATE 2301004
  154. # Germany, Norway, Denmark (Catholic Germany changed earlier)
  155. ::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
  156. ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
  157. ::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032
  158. ::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032
  159. ::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032
  160. # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed at
  161. # various times)
  162. ::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165
  163. # Protestant Switzerland (Catholic cantons changed earlier)
  164. ::msgcat::mcset fr_CH GREGORIAN_CHANGE_DATE 2361342
  165. ::msgcat::mcset it_CH GREGORIAN_CHANGE_DATE 2361342
  166. ::msgcat::mcset de_CH GREGORIAN_CHANGE_DATE 2361342
  167. # English speaking countries
  168. ::msgcat::mcset en GREGORIAN_CHANGE_DATE 2361222
  169. # Sweden (had several changes onto and off of the Gregorian calendar)
  170. ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390
  171. # Russia
  172. ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639
  173. # Romania (Transylvania changed earlier - perhaps de_RO should show the
  174. # earlier date?)
  175. ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063
  176. # Greece
  177. ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480
  178. #------------------------------------------------------------------
  179. #
  180. # CONSTANTS
  181. #
  182. #------------------------------------------------------------------
  183. # Paths at which binary time zone data for the Olson libraries are known
  184. # to reside on various operating systems
  185. variable ZoneinfoPaths {}
  186. foreach path {
  187. /usr/share/zoneinfo
  188. /usr/share/lib/zoneinfo
  189. /usr/lib/zoneinfo
  190. /usr/local/etc/zoneinfo
  191. } {
  192. if { [file isdirectory $path] } {
  193. lappend ZoneinfoPaths $path
  194. }
  195. }
  196. # Define the directories for time zone data and message catalogs.
  197. variable DataDir [file join $LibDir tzdata]
  198. # Number of days in the months, in common years and leap years.
  199. variable DaysInRomanMonthInCommonYear \
  200. { 31 28 31 30 31 30 31 31 30 31 30 31 }
  201. variable DaysInRomanMonthInLeapYear \
  202. { 31 29 31 30 31 30 31 31 30 31 30 31 }
  203. variable DaysInPriorMonthsInCommonYear [list 0]
  204. variable DaysInPriorMonthsInLeapYear [list 0]
  205. set i 0
  206. foreach j $DaysInRomanMonthInCommonYear {
  207. lappend DaysInPriorMonthsInCommonYear [incr i $j]
  208. }
  209. set i 0
  210. foreach j $DaysInRomanMonthInLeapYear {
  211. lappend DaysInPriorMonthsInLeapYear [incr i $j]
  212. }
  213. # Another epoch (Hi, Jeff!)
  214. variable Roddenberry 1946
  215. # Integer ranges
  216. variable MINWIDE -9223372036854775808
  217. variable MAXWIDE 9223372036854775807
  218. # Day before Leap Day
  219. variable FEB_28 58
  220. # Default configuration
  221. ::tcl::unsupported::clock::configure -current-locale [mclocale]
  222. #::tcl::unsupported::clock::configure -default-locale C
  223. #::tcl::unsupported::clock::configure -year-century 2000 \
  224. # -century-switch 38
  225. # Translation table to map Windows TZI onto cities, so that the Olson
  226. # rules can apply. In some cases the mapping is ambiguous, so it's wise
  227. # to specify $::env(TCL_TZ) rather than simply depending on the system
  228. # time zone.
  229. # The keys are long lists of values obtained from the time zone
  230. # information in the Registry. In order, the list elements are:
  231. # Bias StandardBias DaylightBias
  232. # StandardDate.wYear StandardDate.wMonth StandardDate.wDayOfWeek
  233. # StandardDate.wDay StandardDate.wHour StandardDate.wMinute
  234. # StandardDate.wSecond StandardDate.wMilliseconds
  235. # DaylightDate.wYear DaylightDate.wMonth DaylightDate.wDayOfWeek
  236. # DaylightDate.wDay DaylightDate.wHour DaylightDate.wMinute
  237. # DaylightDate.wSecond DaylightDate.wMilliseconds
  238. # The values are the names of time zones where those rules apply. There
  239. # is considerable ambiguity in certain zones; an attempt has been made to
  240. # make a reasonable guess, but this table needs to be taken with a grain
  241. # of salt.
  242. variable WinZoneInfo [dict create {*}{
  243. {-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Kwajalein
  244. {-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Midway
  245. {-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Honolulu
  246. {-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
  247. {-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
  248. {-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana
  249. {-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver
  250. {-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua
  251. {-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Phoenix
  252. {-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Regina
  253. {-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago
  254. {-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City
  255. {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York
  256. {-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Indianapolis
  257. {-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Caracas
  258. {-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999}
  259. :America/Santiago
  260. {-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus
  261. {-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax
  262. {-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns
  263. {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
  264. {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
  265. {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires
  266. {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
  267. {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
  268. {-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha
  269. {-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores
  270. {-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Atlantic/Cape_Verde
  271. {0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :UTC
  272. {0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0} :Europe/London
  273. {3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Kinshasa
  274. {3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :CET
  275. {7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Harare
  276. {7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0}
  277. :Africa/Cairo
  278. {7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0} :Europe/Helsinki
  279. {7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0} :Asia/Jerusalem
  280. {7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0} :Europe/Bucharest
  281. {7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Athens
  282. {7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0} :Asia/Amman
  283. {7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0}
  284. :Asia/Beirut
  285. {7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0} :Africa/Windhoek
  286. {10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Riyadh
  287. {10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0} :Asia/Baghdad
  288. {10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Moscow
  289. {12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0} :Asia/Tehran
  290. {14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0} :Asia/Baku
  291. {14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Muscat
  292. {14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Tbilisi
  293. {16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Kabul
  294. {18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Karachi
  295. {18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yekaterinburg
  296. {19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Calcutta
  297. {20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Katmandu
  298. {21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Dhaka
  299. {21600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Novosibirsk
  300. {23400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Rangoon
  301. {25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Bangkok
  302. {25200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Krasnoyarsk
  303. {28800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Chongqing
  304. {28800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Irkutsk
  305. {32400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Tokyo
  306. {32400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yakutsk
  307. {34200 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Adelaide
  308. {34200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Darwin
  309. {36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Brisbane
  310. {36000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Vladivostok
  311. {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 1 2 0 0 0} :Australia/Hobart
  312. {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Sydney
  313. {39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Noumea
  314. {43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0} :Pacific/Auckland
  315. {43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Fiji
  316. {46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu
  317. }]
  318. # Legacy time zones, used primarily for parsing RFC822 dates.
  319. variable LegacyTimeZone [dict create \
  320. gmt +0000 \
  321. ut +0000 \
  322. utc +0000 \
  323. bst +0100 \
  324. wet +0000 \
  325. wat -0100 \
  326. at -0200 \
  327. nft -0330 \
  328. nst -0330 \
  329. ndt -0230 \
  330. ast -0400 \
  331. adt -0300 \
  332. est -0500 \
  333. edt -0400 \
  334. cst -0600 \
  335. cdt -0500 \
  336. mst -0700 \
  337. mdt -0600 \
  338. pst -0800 \
  339. pdt -0700 \
  340. yst -0900 \
  341. ydt -0800 \
  342. akst -0900 \
  343. akdt -0800 \
  344. hst -1000 \
  345. hdt -0900 \
  346. cat -1000 \
  347. ahst -1000 \
  348. nt -1100 \
  349. idlw -1200 \
  350. cet +0100 \
  351. cest +0200 \
  352. met +0100 \
  353. mewt +0100 \
  354. mest +0200 \
  355. swt +0100 \
  356. sst +0200 \
  357. fwt +0100 \
  358. fst +0200 \
  359. eet +0200 \
  360. eest +0300 \
  361. bt +0300 \
  362. it +0330 \
  363. zp4 +0400 \
  364. zp5 +0500 \
  365. ist +0530 \
  366. zp6 +0600 \
  367. wast +0700 \
  368. wadt +0800 \
  369. jt +0730 \
  370. cct +0800 \
  371. jst +0900 \
  372. kst +0900 \
  373. cast +0930 \
  374. jdt +1000 \
  375. kdt +1000 \
  376. cadt +1030 \
  377. east +1000 \
  378. eadt +1030 \
  379. gst +1000 \
  380. nzt +1200 \
  381. nzst +1200 \
  382. nzdt +1300 \
  383. idle +1200 \
  384. a +0100 \
  385. b +0200 \
  386. c +0300 \
  387. d +0400 \
  388. e +0500 \
  389. f +0600 \
  390. g +0700 \
  391. h +0800 \
  392. i +0900 \
  393. k +1000 \
  394. l +1100 \
  395. m +1200 \
  396. n -0100 \
  397. o -0200 \
  398. p -0300 \
  399. q -0400 \
  400. r -0500 \
  401. s -0600 \
  402. t -0700 \
  403. u -0800 \
  404. v -0900 \
  405. w -1000 \
  406. x -1100 \
  407. y -1200 \
  408. z +0000 \
  409. ]
  410. # Caches
  411. variable LocFmtMap [dict create]; # Dictionary with localized format maps
  412. variable TimeZoneBad [dict create]; # Dictionary whose keys are time zone
  413. # names and whose values are 1 if
  414. # the time zone is unknown and 0
  415. # if it is known.
  416. variable TZData; # Array whose keys are time zone names
  417. # and whose values are lists of quads
  418. # comprising start time, UTC offset,
  419. # Daylight Saving Time indicator, and
  420. # time zone abbreviation.
  421. variable mcLocales [dict create]; # Dictionary with loaded locales
  422. variable mcMergedCat [dict create]; # Dictionary with merged locale catalogs
  423. }
  424. ::tcl::clock::Initialize
  425. #----------------------------------------------------------------------
  426. # mcget --
  427. #
  428. # Return the merged translation catalog for the ::tcl::clock namespace
  429. # Searching of catalog is similar to "msgcat::mc".
  430. #
  431. # Contrary to "msgcat::mc" may additionally load a package catalog
  432. # on demand.
  433. #
  434. # Arguments:
  435. # loc The locale used for translation.
  436. #
  437. # Results:
  438. # Returns the dictionary object as whole catalog of the package/locale.
  439. #
  440. proc ::tcl::clock::mcget {loc} {
  441. variable mcMergedCat
  442. switch -- $loc system {
  443. set loc [GetSystemLocale]
  444. } current {
  445. set loc [mclocale]
  446. }
  447. if {$loc ne {}} {
  448. set loc [string tolower $loc]
  449. }
  450. # try to retrieve now if already available:
  451. if {[dict exists $mcMergedCat $loc]} {
  452. return [dict get $mcMergedCat $loc]
  453. }
  454. # get locales list for given locale (de_de -> {de_de de {}})
  455. variable mcLocales
  456. if {[dict exists $mcLocales $loc]} {
  457. set loclist [dict get $mcLocales $loc]
  458. } else {
  459. # save current locale:
  460. set prevloc [mclocale]
  461. # lazy load catalog on demand (set it will load the catalog)
  462. mcpackagelocale set $loc
  463. set loclist [msgcat::mcutil::getpreferences $loc]
  464. dict set $mcLocales $loc $loclist
  465. # restore:
  466. if {$prevloc ne $loc} {
  467. mcpackagelocale set $prevloc
  468. }
  469. }
  470. # get whole catalog:
  471. mcMerge $loclist
  472. }
  473. # mcMerge --
  474. #
  475. # Merge message catalog dictionaries to one dictionary.
  476. #
  477. # Arguments:
  478. # locales List of locales to merge.
  479. #
  480. # Results:
  481. # Returns the (weak pointer) to merged dictionary of message catalog.
  482. #
  483. proc ::tcl::clock::mcMerge {locales} {
  484. variable mcMergedCat
  485. if {[dict exists $mcMergedCat [set loc [lindex $locales 0]]]} {
  486. return [dict get $mcMergedCat $loc]
  487. }
  488. # package msgcat currently does not provide possibility to get whole catalog:
  489. upvar ::msgcat::Msgs Msgs
  490. set ns ::tcl::clock
  491. # Merge sequential locales (in reverse order, e. g. {} -> en -> en_en):
  492. if {[llength $locales] > 1} {
  493. set mrgcat [mcMerge [lrange $locales 1 end]]
  494. if {[dict exists $Msgs $ns $loc]} {
  495. set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]]
  496. dict set mrgcat L $loc
  497. } else {
  498. # be sure a duplicate is created, don't overwrite {} (common) locale:
  499. set mrgcat [dict merge $mrgcat [dict create L $loc]]
  500. }
  501. } else {
  502. if {[dict exists $Msgs $ns $loc]} {
  503. set mrgcat [dict get $Msgs $ns $loc]
  504. dict set mrgcat L $loc
  505. } else {
  506. # be sure a duplicate is created, don't overwrite {} (common) locale:
  507. set mrgcat [dict create L $loc]
  508. }
  509. }
  510. dict set mcMergedCat $loc $mrgcat
  511. # return smart reference (shared dict as object with exact one ref-counter)
  512. return $mrgcat
  513. }
  514. #----------------------------------------------------------------------
  515. #
  516. # GetSystemLocale --
  517. #
  518. # Determines the system locale, which corresponds to "system"
  519. # keyword for locale parameter of 'clock' command.
  520. #
  521. # Parameters:
  522. # None.
  523. #
  524. # Results:
  525. # Returns the system locale.
  526. #
  527. # Side effects:
  528. # None.
  529. #
  530. #----------------------------------------------------------------------
  531. proc ::tcl::clock::GetSystemLocale {} {
  532. if { $::tcl_platform(platform) ne {windows} } {
  533. # On a non-windows platform, the 'system' locale is the same as
  534. # the 'current' locale
  535. return [mclocale]
  536. }
  537. # On a windows platform, the 'system' locale is adapted from the
  538. # 'current' locale by applying the date and time formats from the
  539. # Control Panel. First, load the 'current' locale if it's not yet
  540. # loaded
  541. mcpackagelocale set [mclocale]
  542. # Make a new locale string for the system locale, and get the
  543. # Control Panel information
  544. set locale [mclocale]_windows
  545. if { ! [mcpackagelocale present $locale] } {
  546. LoadWindowsDateTimeFormats $locale
  547. }
  548. return $locale
  549. }
  550. #----------------------------------------------------------------------
  551. #
  552. # EnterLocale --
  553. #
  554. # Switch [mclocale] to a given locale if necessary
  555. #
  556. # Parameters:
  557. # locale -- Desired locale
  558. #
  559. # Results:
  560. # Returns the locale that was previously current.
  561. #
  562. # Side effects:
  563. # Does [mclocale]. If necessary, loades the designated locale's files.
  564. #
  565. #----------------------------------------------------------------------
  566. proc ::tcl::clock::EnterLocale { locale } {
  567. switch -- $locale system {
  568. set locale [GetSystemLocale]
  569. } current {
  570. set locale [mclocale]
  571. }
  572. # Select the locale, eventually load it
  573. mcpackagelocale set $locale
  574. return $locale
  575. }
  576. #----------------------------------------------------------------------
  577. #
  578. # _hasRegistry --
  579. #
  580. # Helper that checks whether registry module is available (Windows only)
  581. # and loads it on demand.
  582. #
  583. #----------------------------------------------------------------------
  584. proc ::tcl::clock::_hasRegistry {} {
  585. set res 0
  586. if { $::tcl_platform(platform) eq {windows} } {
  587. if { [catch { package require registry 1.3 }] } {
  588. # try to load registry directly from root (if uninstalled / development env):
  589. if {[regexp {[/\\]library$} [info library]]} {catch {
  590. load [lindex \
  591. [glob -tails -directory [file dirname [info nameofexecutable]] \
  592. tcl9registry*[expr {[::tcl::pkgconfig get debug] ? {g} : {}}].dll] 0 \
  593. ] Registry
  594. }}
  595. }
  596. if { [namespace which -command ::registry] ne "" } {
  597. set res 1
  598. }
  599. }
  600. proc ::tcl::clock::_hasRegistry {} [list return $res]
  601. return $res
  602. }
  603. #----------------------------------------------------------------------
  604. #
  605. # LoadWindowsDateTimeFormats --
  606. #
  607. # Load the date/time formats from the Control Panel in Windows and
  608. # convert them so that they're usable by Tcl.
  609. #
  610. # Parameters:
  611. # locale - Name of the locale in whose message catalog
  612. # the converted formats are to be stored.
  613. #
  614. # Results:
  615. # None.
  616. #
  617. # Side effects:
  618. # Updates the given message catalog with the locale strings.
  619. #
  620. # Presumes that on entry, [mclocale] is set to the current locale, so that
  621. # default strings can be obtained if the Registry query fails.
  622. #
  623. #----------------------------------------------------------------------
  624. proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
  625. # Bail out if we can't find the Registry
  626. if { ![_hasRegistry] } return
  627. if { ![catch {
  628. registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
  629. sShortDate
  630. } string] } {
  631. set quote {}
  632. set datefmt {}
  633. foreach { unquoted quoted } [split $string '] {
  634. append datefmt $quote [string map {
  635. dddd %A
  636. ddd %a
  637. dd %d
  638. d %e
  639. MMMM %B
  640. MMM %b
  641. MM %m
  642. M %N
  643. yyyy %Y
  644. yy %y
  645. y %y
  646. gg {}
  647. } $unquoted]
  648. if { $quoted eq {} } {
  649. set quote '
  650. } else {
  651. set quote $quoted
  652. }
  653. }
  654. ::msgcat::mcset $locale DATE_FORMAT $datefmt
  655. }
  656. if { ![catch {
  657. registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
  658. sLongDate
  659. } string] } {
  660. set quote {}
  661. set ldatefmt {}
  662. foreach { unquoted quoted } [split $string '] {
  663. append ldatefmt $quote [string map {
  664. dddd %A
  665. ddd %a
  666. dd %d
  667. d %e
  668. MMMM %B
  669. MMM %b
  670. MM %m
  671. M %N
  672. yyyy %Y
  673. yy %y
  674. y %y
  675. gg {}
  676. } $unquoted]
  677. if { $quoted eq {} } {
  678. set quote '
  679. } else {
  680. set quote $quoted
  681. }
  682. }
  683. ::msgcat::mcset $locale LOCALE_DATE_FORMAT $ldatefmt
  684. }
  685. if { ![catch {
  686. registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
  687. sTimeFormat
  688. } string] } {
  689. set quote {}
  690. set timefmt {}
  691. foreach { unquoted quoted } [split $string '] {
  692. append timefmt $quote [string map {
  693. HH %H
  694. H %k
  695. hh %I
  696. h %l
  697. mm %M
  698. m %M
  699. ss %S
  700. s %S
  701. tt %p
  702. t %p
  703. } $unquoted]
  704. if { $quoted eq {} } {
  705. set quote '
  706. } else {
  707. set quote $quoted
  708. }
  709. }
  710. ::msgcat::mcset $locale TIME_FORMAT $timefmt
  711. }
  712. catch {
  713. ::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt"
  714. }
  715. catch {
  716. ::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt"
  717. }
  718. return
  719. }
  720. #----------------------------------------------------------------------
  721. #
  722. # LocalizeFormat --
  723. #
  724. # Map away locale-dependent format groups in a clock format.
  725. #
  726. # Parameters:
  727. # locale -- Current [mclocale] locale, supplied to avoid
  728. # an extra call
  729. # format -- Format supplied to [clock scan] or [clock format]
  730. # mcd -- Message catalog dictionary for current locale (read-only,
  731. # don't store it to avoid shared references).
  732. #
  733. # Results:
  734. # Returns the string with locale-dependent composite format groups
  735. # substituted out.
  736. #
  737. # Side effects:
  738. # None.
  739. #
  740. #----------------------------------------------------------------------
  741. proc ::tcl::clock::LocalizeFormat { locale format mcd } {
  742. variable LocFmtMap
  743. # get map list cached or build it:
  744. if {[dict exists $LocFmtMap $locale]} {
  745. set mlst [dict get $LocFmtMap $locale]
  746. } else {
  747. # Handle locale-dependent format groups by mapping them out of the format
  748. # string. Note that the order of the [string map] operations is
  749. # significant because later formats can refer to later ones; for example
  750. # %c can refer to %X, which in turn can refer to %T.
  751. set mlst {
  752. %% %%
  753. %D %m/%d/%Y
  754. %+ {%a %b %e %H:%M:%S %Z %Y}
  755. }
  756. lappend mlst %EY [string map $mlst [dict get $mcd LOCALE_YEAR_FORMAT]]
  757. lappend mlst %T [string map $mlst [dict get $mcd TIME_FORMAT_24_SECS]]
  758. lappend mlst %R [string map $mlst [dict get $mcd TIME_FORMAT_24]]
  759. lappend mlst %r [string map $mlst [dict get $mcd TIME_FORMAT_12]]
  760. lappend mlst %X [string map $mlst [dict get $mcd TIME_FORMAT]]
  761. lappend mlst %EX [string map $mlst [dict get $mcd LOCALE_TIME_FORMAT]]
  762. lappend mlst %x [string map $mlst [dict get $mcd DATE_FORMAT]]
  763. lappend mlst %Ex [string map $mlst [dict get $mcd LOCALE_DATE_FORMAT]]
  764. lappend mlst %c [string map $mlst [dict get $mcd DATE_TIME_FORMAT]]
  765. lappend mlst %Ec [string map $mlst [dict get $mcd LOCALE_DATE_TIME_FORMAT]]
  766. dict set LocFmtMap $locale $mlst
  767. }
  768. # translate copy of format (don't use format object here, because otherwise
  769. # it can lose its internal representation (string map - convert to unicode)
  770. set locfmt [string map $mlst [string range " $format" 1 end]]
  771. # Save original format as long as possible, because of internal
  772. # representation (performance).
  773. # Note that in this case such format will be never localized (also
  774. # using another locales). To prevent this return a duplicate (but
  775. # it may be slower).
  776. if {$locfmt eq $format} {
  777. set locfmt $format
  778. }
  779. return $locfmt
  780. }
  781. #----------------------------------------------------------------------
  782. #
  783. # GetSystemTimeZone --
  784. #
  785. # Determines the system time zone, which is the default for the
  786. # 'clock' command if no other zone is supplied.
  787. #
  788. # Parameters:
  789. # None.
  790. #
  791. # Results:
  792. # Returns the system time zone.
  793. #
  794. # Side effects:
  795. # Stores the system time zone in engine configuration, since
  796. # determining it may be an expensive process.
  797. #
  798. #----------------------------------------------------------------------
  799. proc ::tcl::clock::GetSystemTimeZone {} {
  800. variable TimeZoneBad
  801. if {[set result [getenv TCL_TZ]] ne {}} {
  802. set timezone $result
  803. } elseif {[set result [getenv TZ]] ne {}} {
  804. set timezone $result
  805. } else {
  806. # ask engine for the cached timezone:
  807. set timezone [::tcl::unsupported::clock::configure -system-tz]
  808. if { $timezone ne "" } {
  809. return $timezone
  810. }
  811. if { $::tcl_platform(platform) eq {windows} } {
  812. set timezone [GuessWindowsTimeZone]
  813. } elseif { [file exists /etc/localtime]
  814. && ![catch {ReadZoneinfoFile \
  815. Tcl/Localtime /etc/localtime}] } {
  816. set timezone :Tcl/Localtime
  817. } else {
  818. set timezone :localtime
  819. }
  820. }
  821. if { ![dict exists $TimeZoneBad $timezone] } {
  822. catch {set timezone [SetupTimeZone $timezone]}
  823. }
  824. if { [dict exists $TimeZoneBad $timezone] } {
  825. set timezone :localtime
  826. }
  827. # tell backend - current system timezone:
  828. ::tcl::unsupported::clock::configure -system-tz $timezone
  829. return $timezone
  830. }
  831. #----------------------------------------------------------------------
  832. #
  833. # SetupTimeZone --
  834. #
  835. # Given the name or specification of a time zone, sets up its in-memory
  836. # data.
  837. #
  838. # Parameters:
  839. # tzname - Name of a time zone
  840. #
  841. # Results:
  842. # Unless the time zone is ':localtime', sets the TZData array to contain
  843. # the lookup table for local<->UTC conversion. Returns an error if the
  844. # time zone cannot be parsed.
  845. #
  846. #----------------------------------------------------------------------
  847. proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
  848. variable TZData
  849. if {! [info exists TZData($timezone)] } {
  850. variable TimeZoneBad
  851. if { [dict exists $TimeZoneBad $timezone] } {
  852. return -code error \
  853. -errorcode [list CLOCK badTimeZone $timezone] \
  854. "time zone \"$timezone\" not found"
  855. }
  856. variable MINWIDE
  857. if {
  858. [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
  859. -> s hh mm ss]
  860. } then {
  861. # Make a fixed offset
  862. ::scan $hh %d hh
  863. if { $mm eq {} } {
  864. set mm 0
  865. } else {
  866. ::scan $mm %d mm
  867. }
  868. if { $ss eq {} } {
  869. set ss 0
  870. } else {
  871. ::scan $ss %d ss
  872. }
  873. set offset [expr { ( $hh * 60 + $mm ) * 60 + $ss }]
  874. if { $s eq {-} } {
  875. set offset [expr { - $offset }]
  876. }
  877. set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]
  878. } elseif { [string index $timezone 0] eq {:} } {
  879. # Convert using a time zone file
  880. if {
  881. [catch {
  882. LoadTimeZoneFile [string range $timezone 1 end]
  883. }] && [catch {
  884. LoadZoneinfoFile [string range $timezone 1 end]
  885. } ret opts]
  886. } then {
  887. dict unset opts -errorinfo
  888. if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
  889. dict set opts -errorcode [list CLOCK badTimeZone $timezone]
  890. set ret "time zone \"$timezone\" not found: $ret"
  891. }
  892. dict set TimeZoneBad $timezone 1
  893. return -options $opts $ret
  894. }
  895. } elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
  896. # This looks like a POSIX time zone - try to process it
  897. if { [catch {ProcessPosixTimeZone $tzfields} ret opts] } {
  898. dict unset opts -errorinfo
  899. if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
  900. dict set opts -errorcode [list CLOCK badTimeZone $timezone]
  901. set ret "time zone \"$timezone\" not found: $ret"
  902. }
  903. dict set TimeZoneBad $timezone 1
  904. return -options $opts $ret
  905. } else {
  906. set TZData($timezone) $ret
  907. }
  908. } else {
  909. variable LegacyTimeZone
  910. # We couldn't parse this as a POSIX time zone. Try again with a
  911. # time zone file - this time without a colon
  912. if { [catch { LoadTimeZoneFile $timezone }]
  913. && [catch { LoadZoneinfoFile $timezone } ret opts] } {
  914. # Check may be a legacy zone:
  915. if { $alias eq {} && ![catch {
  916. set tzname [dict get $LegacyTimeZone [string tolower $timezone]]
  917. }] } {
  918. set tzname [::tcl::clock::SetupTimeZone $tzname $timezone]
  919. set TZData($timezone) $TZData($tzname)
  920. # tell backend - timezone is initialized and return shared timezone object:
  921. return [::tcl::unsupported::clock::configure -setup-tz $timezone]
  922. }
  923. dict unset opts -errorinfo
  924. if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
  925. dict set opts -errorcode [list CLOCK badTimeZone $timezone]
  926. set ret "time zone \"$timezone\" not found: $ret"
  927. }
  928. dict set TimeZoneBad $timezone 1
  929. return -options $opts $ret
  930. }
  931. set TZData($timezone) $TZData(:$timezone)
  932. }
  933. }
  934. # tell backend - timezone is initialized and return shared timezone object:
  935. ::tcl::unsupported::clock::configure -setup-tz $timezone
  936. }
  937. #----------------------------------------------------------------------
  938. #
  939. # GuessWindowsTimeZone --
  940. #
  941. # Determines the system time zone on windows.
  942. #
  943. # Parameters:
  944. # None.
  945. #
  946. # Results:
  947. # Returns a time zone specifier that corresponds to the system time zone
  948. # information found in the Registry.
  949. #
  950. # Bugs:
  951. # Fixed dates for DST change are unimplemented at present, because no
  952. # time zone information supplied with Windows actually uses them!
  953. #
  954. # On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is specified,
  955. # GuessWindowsTimeZone looks in the Registry for the system time zone
  956. # information. It then attempts to find an entry in WinZoneInfo for a time
  957. # zone that uses the same rules. If it finds one, it returns it; otherwise,
  958. # it constructs a Posix-style time zone string and returns that.
  959. #
  960. #----------------------------------------------------------------------
  961. proc ::tcl::clock::GuessWindowsTimeZone {} {
  962. variable WinZoneInfo
  963. variable TimeZoneBad
  964. if { ![_hasRegistry] } {
  965. return :localtime
  966. }
  967. # Dredge time zone information out of the registry
  968. if { [catch {
  969. set rpath HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation
  970. set data [list \
  971. [expr { -60
  972. * [registry get $rpath Bias] }] \
  973. [expr { -60
  974. * [registry get $rpath StandardBias] }] \
  975. [expr { -60 \
  976. * [registry get $rpath DaylightBias] }]]
  977. set stdtzi [registry get $rpath StandardStart]
  978. foreach ind {0 2 14 4 6 8 10 12} {
  979. binary scan $stdtzi @${ind}s val
  980. lappend data $val
  981. }
  982. set daytzi [registry get $rpath DaylightStart]
  983. foreach ind {0 2 14 4 6 8 10 12} {
  984. binary scan $daytzi @${ind}s val
  985. lappend data $val
  986. }
  987. }] } {
  988. # Missing values in the Registry - bail out
  989. return :localtime
  990. }
  991. # Make up a Posix time zone specifier if we can't find one. Check here
  992. # that the tzdata file exists, in case we're running in an environment
  993. # (e.g. starpack) where tzdata is incomplete. (Bug 1237907)
  994. if { [dict exists $WinZoneInfo $data] } {
  995. set tzname [dict get $WinZoneInfo $data]
  996. if { ! [dict exists $TimeZoneBad $tzname] } {
  997. catch {set tzname [SetupTimeZone $tzname]}
  998. }
  999. } else {
  1000. set tzname {}
  1001. }
  1002. if { $tzname eq {} || [dict exists $TimeZoneBad $tzname] } {
  1003. lassign $data \
  1004. bias stdBias dstBias \
  1005. stdYear stdMonth stdDayOfWeek stdDayOfMonth \
  1006. stdHour stdMinute stdSecond stdMillisec \
  1007. dstYear dstMonth dstDayOfWeek dstDayOfMonth \
  1008. dstHour dstMinute dstSecond dstMillisec
  1009. set stdDelta [expr { $bias + $stdBias }]
  1010. set dstDelta [expr { $bias + $dstBias }]
  1011. if { $stdDelta <= 0 } {
  1012. set stdSignum +
  1013. set stdDelta [expr { - $stdDelta }]
  1014. set dispStdSignum -
  1015. } else {
  1016. set stdSignum -
  1017. set dispStdSignum +
  1018. }
  1019. set hh [::format %02d [expr { $stdDelta / 3600 }]]
  1020. set mm [::format %02d [expr { ($stdDelta / 60 ) % 60 }]]
  1021. set ss [::format %02d [expr { $stdDelta % 60 }]]
  1022. set tzname {}
  1023. append tzname < $dispStdSignum $hh $mm > $stdSignum $hh : $mm : $ss
  1024. if { $stdMonth >= 0 } {
  1025. if { $dstDelta <= 0 } {
  1026. set dstSignum +
  1027. set dstDelta [expr { - $dstDelta }]
  1028. set dispDstSignum -
  1029. } else {
  1030. set dstSignum -
  1031. set dispDstSignum +
  1032. }
  1033. set hh [::format %02d [expr { $dstDelta / 3600 }]]
  1034. set mm [::format %02d [expr { ($dstDelta / 60 ) % 60 }]]
  1035. set ss [::format %02d [expr { $dstDelta % 60 }]]
  1036. append tzname < $dispDstSignum $hh $mm > $dstSignum $hh : $mm : $ss
  1037. if { $dstYear == 0 } {
  1038. append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek
  1039. } else {
  1040. # I have not been able to find any locale on which Windows
  1041. # converts time zone on a fixed day of the year, hence don't
  1042. # know how to interpret the fields. If someone can inform me,
  1043. # I'd be glad to code it up. For right now, we bail out in
  1044. # such a case.
  1045. return :localtime
  1046. }
  1047. append tzname / [::format %02d $dstHour] \
  1048. : [::format %02d $dstMinute] \
  1049. : [::format %02d $dstSecond]
  1050. if { $stdYear == 0 } {
  1051. append tzname ,M $stdMonth . $stdDayOfMonth . $stdDayOfWeek
  1052. } else {
  1053. # I have not been able to find any locale on which Windows
  1054. # converts time zone on a fixed day of the year, hence don't
  1055. # know how to interpret the fields. If someone can inform me,
  1056. # I'd be glad to code it up. For right now, we bail out in
  1057. # such a case.
  1058. return :localtime
  1059. }
  1060. append tzname / [::format %02d $stdHour] \
  1061. : [::format %02d $stdMinute] \
  1062. : [::format %02d $stdSecond]
  1063. }
  1064. dict set WinZoneInfo $data $tzname
  1065. }
  1066. return [dict get $WinZoneInfo $data]
  1067. }
  1068. #----------------------------------------------------------------------
  1069. #
  1070. # LoadTimeZoneFile --
  1071. #
  1072. # Load the data file that specifies the conversion between a
  1073. # given time zone and Greenwich.
  1074. #
  1075. # Parameters:
  1076. # fileName -- Name of the file to load
  1077. #
  1078. # Results:
  1079. # None.
  1080. #
  1081. # Side effects:
  1082. # TZData(:fileName) contains the time zone data
  1083. #
  1084. #----------------------------------------------------------------------
  1085. proc ::tcl::clock::LoadTimeZoneFile { fileName } {
  1086. variable DataDir
  1087. variable TZData
  1088. if { [info exists TZData($fileName)] } {
  1089. return
  1090. }
  1091. # Since an unsafe interp uses the [clock] command in the parent, this code
  1092. # is security sensitive. Make sure that the path name cannot escape the
  1093. # given directory.
  1094. if { [regexp {^[/\\]|^[a-zA-Z]+:|(?:^|[/\\])\.\.} $fileName] } {
  1095. return -code error \
  1096. -errorcode [list CLOCK badTimeZone :$fileName] \
  1097. "time zone \":$fileName\" not valid"
  1098. }
  1099. try {
  1100. source [file join $DataDir $fileName]
  1101. } on error {} {
  1102. return -code error \
  1103. -errorcode [list CLOCK badTimeZone :$fileName] \
  1104. "time zone \":$fileName\" not found"
  1105. }
  1106. return
  1107. }
  1108. #----------------------------------------------------------------------
  1109. #
  1110. # LoadZoneinfoFile --
  1111. #
  1112. # Loads a binary time zone information file in Olson format.
  1113. #
  1114. # Parameters:
  1115. # fileName - Relative path name of the file to load.
  1116. #
  1117. # Results:
  1118. # Returns an empty result normally; returns an error if no Olson file
  1119. # was found or the file was malformed in some way.
  1120. #
  1121. # Side effects:
  1122. # TZData(:fileName) contains the time zone data
  1123. #
  1124. #----------------------------------------------------------------------
  1125. proc ::tcl::clock::LoadZoneinfoFile { fileName } {
  1126. variable ZoneinfoPaths
  1127. # Since an unsafe interp uses the [clock] command in the parent, this code
  1128. # is security sensitive. Make sure that the path name cannot escape the
  1129. # given directory.
  1130. if { [regexp {^[/\\]|^[a-zA-Z]+:|(?:^|[/\\])\.\.} $fileName] } {
  1131. return -code error \
  1132. -errorcode [list CLOCK badTimeZone :$fileName] \
  1133. "time zone \":$fileName\" not valid"
  1134. }
  1135. set fname ""
  1136. foreach d $ZoneinfoPaths {
  1137. set fname [file join $d $fileName]
  1138. if { [file readable $fname] && [file isfile $fname] } {
  1139. break
  1140. }
  1141. set fname ""
  1142. }
  1143. if {$fname eq ""} {
  1144. return -code error \
  1145. -errorcode [list CLOCK badTimeZone :$fileName] \
  1146. "time zone \":$fileName\" not found"
  1147. }
  1148. ReadZoneinfoFile $fileName $fname
  1149. }
  1150. #----------------------------------------------------------------------
  1151. #
  1152. # ReadZoneinfoFile --
  1153. #
  1154. # Loads a binary time zone information file in Olson format.
  1155. #
  1156. # Parameters:
  1157. # fileName - Name of the time zone (relative path name of the
  1158. # file).
  1159. # fname - Absolute path name of the file.
  1160. #
  1161. # Results:
  1162. # Returns an empty result normally; returns an error if no Olson file
  1163. # was found or the file was malformed in some way.
  1164. #
  1165. # Side effects:
  1166. # TZData(:fileName) contains the time zone data
  1167. #
  1168. #----------------------------------------------------------------------
  1169. proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
  1170. variable MINWIDE
  1171. variable TZData
  1172. if { ![file exists $fname] } {
  1173. return -code error "$fileName not found"
  1174. }
  1175. if { [file size $fname] > 262144 } {
  1176. return -code error "$fileName too big"
  1177. }
  1178. # Suck in all the data from the file
  1179. set f [open $fname r]
  1180. fconfigure $f -translation binary
  1181. set d [read $f]
  1182. close $f
  1183. # The file begins with a magic number, sixteen reserved bytes, and then
  1184. # six 4-byte integers giving counts of fields in the file.
  1185. binary scan $d a4a1x15IIIIII \
  1186. magic version nIsGMT nIsStd nLeap nTime nType nChar
  1187. set seek 44
  1188. set ilen 4
  1189. set iformat I
  1190. if { $magic != {TZif} } {
  1191. return -code error "$fileName not a time zone information file"
  1192. }
  1193. if { $nType > 255 } {
  1194. return -code error "$fileName contains too many time types"
  1195. }
  1196. # Accept only Posix-style zoneinfo. Sorry, 'leaps' bigots.
  1197. if { $nLeap != 0 } {
  1198. return -code error "$fileName contains leap seconds"
  1199. }
  1200. # In a version 2 file, we use the second part of the file, which contains
  1201. # 64-bit transition times.
  1202. if {$version eq "2"} {
  1203. set seek [expr {
  1204. 44
  1205. + 5 * $nTime
  1206. + 6 * $nType
  1207. + 4 * $nLeap
  1208. + $nIsStd
  1209. + $nIsGMT
  1210. + $nChar
  1211. }]
  1212. binary scan $d @${seek}a4a1x15IIIIII \
  1213. magic version nIsGMT nIsStd nLeap nTime nType nChar
  1214. if {$magic ne {TZif}} {
  1215. return -code error "seek address $seek miscomputed, magic = $magic"
  1216. }
  1217. set iformat W
  1218. set ilen 8
  1219. incr seek 44
  1220. }
  1221. # Next come ${nTime} transition times, followed by ${nTime} time type
  1222. # codes. The type codes are unsigned 1-byte quantities. We insert an
  1223. # arbitrary start time in front of the transitions.
  1224. binary scan $d @${seek}${iformat}${nTime}c${nTime} times tempCodes
  1225. incr seek [expr { ($ilen + 1) * $nTime }]
  1226. set times [linsert $times 0 $MINWIDE]
  1227. set codes {}
  1228. foreach c $tempCodes {
  1229. lappend codes [expr { $c & 0xFF }]
  1230. }
  1231. set codes [linsert $codes 0 0]
  1232. # Next come ${nType} time type descriptions, each of which has an offset
  1233. # (seconds east of GMT), a DST indicator, and an index into the
  1234. # abbreviation text.
  1235. for { set i 0 } { $i < $nType } { incr i } {
  1236. binary scan $d @${seek}Icc gmtOff isDst abbrInd
  1237. lappend types [list $gmtOff $isDst $abbrInd]
  1238. incr seek 6
  1239. }
  1240. # Next come $nChar characters of time zone name abbreviations, which are
  1241. # null-terminated.
  1242. # We build them up into a dictionary indexed by character index, because
  1243. # that's what's in the indices above.
  1244. binary scan $d @${seek}a${nChar} abbrs
  1245. incr seek ${nChar}
  1246. set abbrList [split $abbrs \0]
  1247. set i 0
  1248. set abbrevs {}
  1249. foreach a $abbrList {
  1250. for {set j 0} {$j <= [string length $a]} {incr j} {
  1251. dict set abbrevs $i [string range $a $j end]
  1252. incr i
  1253. }
  1254. }
  1255. # Package up a list of tuples, each of which contains transition time,
  1256. # seconds east of Greenwich, DST flag and time zone abbreviation.
  1257. set r {}
  1258. set lastTime $MINWIDE
  1259. foreach t $times c $codes {
  1260. if { $t < $lastTime } {
  1261. return -code error "$fileName has times out of order"
  1262. }
  1263. set lastTime $t
  1264. lassign [lindex $types $c] gmtoff isDst abbrInd
  1265. set abbrev [dict get $abbrevs $abbrInd]
  1266. lappend r [list $t $gmtoff $isDst $abbrev]
  1267. }
  1268. # In a version 2 file, there is also a POSIX-style time zone description
  1269. # at the very end of the file. To get to it, skip over nLeap leap second
  1270. # values (8 bytes each),
  1271. # nIsStd standard/DST indicators and nIsGMT UTC/local indicators.
  1272. if {$version eq {2}} {
  1273. set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}]
  1274. set last [string first \n $d $seek]
  1275. set posix [string range $d $seek [expr {$last-1}]]
  1276. if {[llength $posix] > 0} {
  1277. set posixFields [ParsePosixTimeZone $posix]
  1278. foreach tuple [ProcessPosixTimeZone $posixFields] {
  1279. lassign $tuple t gmtoff isDst abbrev
  1280. if {$t > $lastTime} {
  1281. lappend r $tuple
  1282. }
  1283. }
  1284. }
  1285. }
  1286. set TZData(:$fileName) $r
  1287. return
  1288. }
  1289. #----------------------------------------------------------------------
  1290. #
  1291. # ParsePosixTimeZone --
  1292. #
  1293. # Parses the TZ environment variable in Posix form
  1294. #
  1295. # Parameters:
  1296. # tz Time zone specifier to be interpreted
  1297. #
  1298. # Results:
  1299. # Returns a dictionary whose values contain the various pieces of the
  1300. # time zone specification.
  1301. #
  1302. # Side effects:
  1303. # None.
  1304. #
  1305. # Errors:
  1306. # Throws an error if the syntax of the time zone is incorrect.
  1307. #
  1308. # The following keys are present in the dictionary:
  1309. # stdName - Name of the time zone when Daylight Saving Time
  1310. # is not in effect.
  1311. # stdSignum - Sign (+, -, or empty) of the offset from Greenwich
  1312. # to the given (non-DST) time zone. + and the empty
  1313. # string denote zones west of Greenwich, - denotes east
  1314. # of Greenwich; this is contrary to the ISO convention
  1315. # but follows Posix.
  1316. # stdHours - Hours part of the offset from Greenwich to the given
  1317. # (non-DST) time zone.
  1318. # stdMinutes - Minutes part of the offset from Greenwich to the
  1319. # given (non-DST) time zone. Empty denotes zero.
  1320. # stdSeconds - Seconds part of the offset from Greenwich to the
  1321. # given (non-DST) time zone. Empty denotes zero.
  1322. # dstName - Name of the time zone when DST is in effect, or the
  1323. # empty string if the time zone does not observe Daylight
  1324. # Saving Time.
  1325. # dstSignum, dstHours, dstMinutes, dstSeconds -
  1326. # Fields corresponding to stdSignum, stdHours, stdMinutes,
  1327. # stdSeconds for the Daylight Saving Time version of the
  1328. # time zone. If dstHours is empty, it is presumed to be 1.
  1329. # startDayOfYear - The ordinal number of the day of the year on which
  1330. # Daylight Saving Time begins. If this field is
  1331. # empty, then DST begins on a given month-week-day,
  1332. # as below.
  1333. # startJ - The letter J, or an empty string. If a J is present in
  1334. # this field, then startDayOfYear does not count February 29
  1335. # even in leap years.
  1336. # startMonth - The number of the month in which Daylight Saving Time
  1337. # begins, supplied if startDayOfYear is empty. If both
  1338. # startDayOfYear and startMonth are empty, then US rules
  1339. # are presumed.
  1340. # startWeekOfMonth - The number of the week in the month in which
  1341. # Daylight Saving Time begins, in the range 1-5.
  1342. # 5 denotes the last week of the month even in a
  1343. # 4-week month.
  1344. # startDayOfWeek - The number of the day of the week (Sunday=0,
  1345. # Saturday=6) on which Daylight Saving Time begins.
  1346. # startHours - The hours part of the time of day at which Daylight
  1347. # Saving Time begins. An empty string is presumed to be 2.
  1348. # startMinutes - The minutes part of the time of day at which DST begins.
  1349. # An empty string is presumed zero.
  1350. # startSeconds - The seconds part of the time of day at which DST begins.
  1351. # An empty string is presumed zero.
  1352. # endDayOfYear, endJ, endMonth, endWeekOfMonth, endDayOfWeek,
  1353. # endHours, endMinutes, endSeconds -
  1354. # Specify the end of DST in the same way that the start* fields
  1355. # specify the beginning of DST.
  1356. #
  1357. # This procedure serves only to break the time specifier into fields. No
  1358. # attempt is made to canonicalize the fields or supply default values.
  1359. #
  1360. #----------------------------------------------------------------------
  1361. proc ::tcl::clock::ParsePosixTimeZone { tz } {
  1362. if {[regexp -expanded -nocase -- {
  1363. ^
  1364. # 1 - Standard time zone name
  1365. ([[:alpha:]]+ | <[-+[:alnum:]]+>)
  1366. # 2 - Standard time zone offset, signum
  1367. ([-+]?)
  1368. # 3 - Standard time zone offset, hours
  1369. ([[:digit:]]{1,2})
  1370. (?:
  1371. # 4 - Standard time zone offset, minutes
  1372. : ([[:digit:]]{1,2})
  1373. (?:
  1374. # 5 - Standard time zone offset, seconds
  1375. : ([[:digit:]]{1,2} )
  1376. )?
  1377. )?
  1378. (?:
  1379. # 6 - DST time zone name
  1380. ([[:alpha:]]+ | <[-+[:alnum:]]+>)
  1381. (?:
  1382. (?:
  1383. # 7 - DST time zone offset, signum
  1384. ([-+]?)
  1385. # 8 - DST time zone offset, hours
  1386. ([[:digit:]]{1,2})
  1387. (?:
  1388. # 9 - DST time zone offset, minutes
  1389. : ([[:digit:]]{1,2})
  1390. (?:
  1391. # 10 - DST time zone offset, seconds
  1392. : ([[:digit:]]{1,2})
  1393. )?
  1394. )?
  1395. )?
  1396. (?:
  1397. ,
  1398. (?:
  1399. # 11 - Optional J in n and Jn form 12 - Day of year
  1400. ( J ? ) ( [[:digit:]]+ )
  1401. | M
  1402. # 13 - Month number 14 - Week of month 15 - Day of week
  1403. ( [[:digit:]] + )
  1404. [.] ( [[:digit:]] + )
  1405. [.] ( [[:digit:]] + )
  1406. )
  1407. (?:
  1408. # 16 - Start time of DST - hours
  1409. / ( [[:digit:]]{1,2} )
  1410. (?:
  1411. # 17 - Start time of DST - minutes
  1412. : ( [[:digit:]]{1,2} )
  1413. (?:
  1414. # 18 - Start time of DST - seconds
  1415. : ( [[:digit:]]{1,2} )
  1416. )?
  1417. )?
  1418. )?
  1419. ,
  1420. (?:
  1421. # 19 - Optional J in n and Jn form 20 - Day of year
  1422. ( J ? ) ( [[:digit:]]+ )
  1423. | M
  1424. # 21 - Month number 22 - Week of month 23 - Day of week
  1425. ( [[:digit:]] + )
  1426. [.] ( [[:digit:]] + )
  1427. [.] ( [[:digit:]] + )
  1428. )
  1429. (?:
  1430. # 24 - End time of DST - hours
  1431. / ( [[:digit:]]{1,2} )
  1432. (?:
  1433. # 25 - End time of DST - minutes
  1434. : ( [[:digit:]]{1,2} )
  1435. (?:
  1436. # 26 - End time of DST - seconds
  1437. : ( [[:digit:]]{1,2} )
  1438. )?
  1439. )?
  1440. )?
  1441. )?
  1442. )?
  1443. )?
  1444. $
  1445. } $tz -> x(stdName) x(stdSignum) x(stdHours) x(stdMinutes) x(stdSeconds) \
  1446. x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
  1447. x(startJ) x(startDayOfYear) \
  1448. x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
  1449. x(startHours) x(startMinutes) x(startSeconds) \
  1450. x(endJ) x(endDayOfYear) \
  1451. x(endMonth) x(endWeekOfMonth) x(endDayOfWeek) \
  1452. x(endHours) x(endMinutes) x(endSeconds)] } {
  1453. # it's a good timezone
  1454. return [array get x]
  1455. }
  1456. return -code error\
  1457. -errorcode [list CLOCK badTimeZone $tz] \
  1458. "unable to parse time zone specification \"$tz\""
  1459. }
  1460. #----------------------------------------------------------------------
  1461. #
  1462. # ProcessPosixTimeZone --
  1463. #
  1464. # Handle a Posix time zone after it's been broken out into fields.
  1465. #
  1466. # Parameters:
  1467. # z - Dictionary returned from 'ParsePosixTimeZone'
  1468. #
  1469. # Results:
  1470. # Returns time zone information for the 'TZData' array.
  1471. #
  1472. # Side effects:
  1473. # None.
  1474. #
  1475. #----------------------------------------------------------------------
  1476. proc ::tcl::clock::ProcessPosixTimeZone { z } {
  1477. variable MINWIDE
  1478. variable TZData
  1479. # Determine the standard time zone name and seconds east of Greenwich
  1480. set stdName [dict get $z stdName]
  1481. if { [string index $stdName 0] eq {<} } {
  1482. set stdName [string range $stdName 1 end-1]
  1483. }
  1484. if { [dict get $z stdSignum] eq {-} } {
  1485. set stdSignum +1
  1486. } else {
  1487. set stdSignum -1
  1488. }
  1489. set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
  1490. if { [dict get $z stdMinutes] ne {} } {
  1491. set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
  1492. } else {
  1493. set stdMinutes 0
  1494. }
  1495. if { [dict get $z stdSeconds] ne {} } {
  1496. set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
  1497. } else {
  1498. set stdSeconds 0
  1499. }
  1500. set stdOffset [expr {
  1501. (($stdHours * 60 + $stdMinutes) * 60 + $stdSeconds) * $stdSignum
  1502. }]
  1503. set data [list [list $MINWIDE $stdOffset 0 $stdName]]
  1504. # If there's no daylight zone, we're done
  1505. set dstName [dict get $z dstName]
  1506. if { $dstName eq {} } {
  1507. return $data
  1508. }
  1509. if { [string index $dstName 0] eq {<} } {
  1510. set dstName [string range $dstName 1 end-1]
  1511. }
  1512. # Determine the daylight name
  1513. if { [dict get $z dstSignum] eq {-} } {
  1514. set dstSignum +1
  1515. } else {
  1516. set dstSignum -1
  1517. }
  1518. if { [dict get $z dstHours] eq {} } {
  1519. set dstOffset [expr { 3600 + $stdOffset }]
  1520. } else {
  1521. set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
  1522. if { [dict get $z dstMinutes] ne {} } {
  1523. set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
  1524. } else {
  1525. set dstMinutes 0
  1526. }
  1527. if { [dict get $z dstSeconds] ne {} } {
  1528. set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
  1529. } else {
  1530. set dstSeconds 0
  1531. }
  1532. set dstOffset [expr {
  1533. (($dstHours*60 + $dstMinutes) * 60 + $dstSeconds) * $dstSignum
  1534. }]
  1535. }
  1536. # Fill in defaults for European or US DST rules
  1537. # US start time is the second Sunday in March
  1538. # EU start time is the last Sunday in March
  1539. # US end time is the first Sunday in November.
  1540. # EU end time is the last Sunday in October
  1541. if {
  1542. [dict get $z startDayOfYear] eq {}
  1543. && [dict get $z startMonth] eq {}
  1544. } then {
  1545. if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
  1546. # EU
  1547. dict set z startWeekOfMonth 5
  1548. if {$stdHours>2} {
  1549. dict set z startHours 2
  1550. } else {
  1551. dict set z startHours [expr {$stdHours+1}]
  1552. }
  1553. } else {
  1554. # US
  1555. dict set z startWeekOfMonth 2
  1556. dict set z startHours 2
  1557. }
  1558. dict set z startMonth 3
  1559. dict set z startDayOfWeek 0
  1560. dict set z startMinutes 0
  1561. dict set z startSeconds 0
  1562. }
  1563. if {
  1564. [dict get $z endDayOfYear] eq {}
  1565. && [dict get $z endMonth] eq {}
  1566. } then {
  1567. if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
  1568. # EU
  1569. dict set z endMonth 10
  1570. dict set z endWeekOfMonth 5
  1571. if {$stdHours>2} {
  1572. dict set z endHours 3
  1573. } else {
  1574. dict set z endHours [expr {$stdHours+2}]
  1575. }
  1576. } else {
  1577. # US
  1578. dict set z endMonth 11
  1579. dict set z endWeekOfMonth 1
  1580. dict set z endHours 2
  1581. }
  1582. dict set z endDayOfWeek 0
  1583. dict set z endMinutes 0
  1584. dict set z endSeconds 0
  1585. }
  1586. # Put DST in effect in all years from 1916 to 2099.
  1587. for { set y 1916 } { $y < 2100 } { incr y } {
  1588. set startTime [DeterminePosixDSTTime $z start $y]
  1589. incr startTime [expr { - wide($stdOffset) }]
  1590. set endTime [DeterminePosixDSTTime $z end $y]
  1591. incr endTime [expr { - wide($dstOffset) }]
  1592. if { $startTime < $endTime } {
  1593. lappend data \
  1594. [list $startTime $dstOffset 1 $dstName] \
  1595. [list $endTime $stdOffset 0 $stdName]
  1596. } else {
  1597. lappend data \
  1598. [list $endTime $stdOffset 0 $stdName] \
  1599. [list $startTime $dstOffset 1 $dstName]
  1600. }
  1601. }
  1602. return $data
  1603. }
  1604. #----------------------------------------------------------------------
  1605. #
  1606. # DeterminePosixDSTTime --
  1607. #
  1608. # Determines the time that Daylight Saving Time starts or ends from a
  1609. # Posix time zone specification.
  1610. #
  1611. # Parameters:
  1612. # z - Time zone data returned from ParsePosixTimeZone.
  1613. # Missing fields are expected to be filled in with
  1614. # default values.
  1615. # bound - The word 'start' or 'end'
  1616. # y - The year for which the transition time is to be determined.
  1617. #
  1618. # Results:
  1619. # Returns the transition time as a count of seconds from the epoch. The
  1620. # time is relative to the wall clock, not UTC.
  1621. #
  1622. #----------------------------------------------------------------------
  1623. proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
  1624. variable FEB_28
  1625. # Determine the start or end day of DST
  1626. set date [dict create era CE year $y gregorian 1]
  1627. set doy [dict get $z ${bound}DayOfYear]
  1628. if { $doy ne {} } {
  1629. # Time was specified as a day of the year
  1630. if { [dict get $z ${bound}J] ne {}
  1631. && [IsGregorianLeapYear $date]
  1632. && ( $doy > $FEB_28 ) } {
  1633. incr doy
  1634. }
  1635. dict set date dayOfYear $doy
  1636. set date [GetJulianDayFromEraYearDay $date[set date {}] 2361222]
  1637. } else {
  1638. # Time was specified as a day of the week within a month
  1639. dict set date month [dict get $z ${bound}Month]
  1640. dict set date dayOfWeek [dict get $z ${bound}DayOfWeek]
  1641. set dowim [dict get $z ${bound}WeekOfMonth]
  1642. if { $dowim >= 5 } {
  1643. set dowim -1
  1644. }
  1645. dict set date dayOfWeekInMonth $dowim
  1646. set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222]
  1647. }
  1648. set jd [dict get $date julianDay]
  1649. set seconds [expr {
  1650. wide($jd) * wide(86400) - wide(210866803200)
  1651. }]
  1652. set h [dict get $z ${bound}Hours]
  1653. if { $h eq {} } {
  1654. set h 2
  1655. } else {
  1656. set h [lindex [::scan $h %d] 0]
  1657. }
  1658. set m [dict get $z ${bound}Minutes]
  1659. if { $m eq {} } {
  1660. set m 0
  1661. } else {
  1662. set m [lindex [::scan $m %d] 0]
  1663. }
  1664. set s [dict get $z ${bound}Seconds]
  1665. if { $s eq {} } {
  1666. set s 0
  1667. } else {
  1668. set s [lindex [::scan $s %d] 0]
  1669. }
  1670. set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
  1671. return [expr { $seconds + $tod }]
  1672. }
  1673. #----------------------------------------------------------------------
  1674. #
  1675. # GetJulianDayFromEraYearDay --
  1676. #
  1677. # Given a year, month and day on the Gregorian calendar, determines
  1678. # the Julian Day Number beginning at noon on that date.
  1679. #
  1680. # Parameters:
  1681. # date -- A dictionary in which the 'era', 'year', and
  1682. # 'dayOfYear' slots are populated. The calendar in use
  1683. # is determined by the date itself relative to:
  1684. # changeover -- Julian day on which the Gregorian calendar was
  1685. # adopted in the current locale.
  1686. #
  1687. # Results:
  1688. # Returns the given dictionary augmented with a 'julianDay' key whose
  1689. # value is the desired Julian Day Number, and a 'gregorian' key that
  1690. # specifies whether the calendar is Gregorian (1) or Julian (0).
  1691. #
  1692. # Side effects:
  1693. # None.
  1694. #
  1695. # Bugs:
  1696. # This code needs to be moved to the C layer.
  1697. #
  1698. #----------------------------------------------------------------------
  1699. proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
  1700. # Get absolute year number from the civil year
  1701. switch -exact -- [dict get $date era] {
  1702. BCE {
  1703. set year [expr { 1 - [dict get $date year] }]
  1704. }
  1705. CE {
  1706. set year [dict get $date year]
  1707. }
  1708. }
  1709. set ym1 [expr { $year - 1 }]
  1710. # Try the Gregorian calendar first.
  1711. dict set date gregorian 1
  1712. set jd [expr {
  1713. 1721425
  1714. + [dict get $date dayOfYear]
  1715. + ( 365 * $ym1 )
  1716. + ( $ym1 / 4 )
  1717. - ( $ym1 / 100 )
  1718. + ( $ym1 / 400 )
  1719. }]
  1720. # If the date is before the Gregorian change, use the Julian calendar.
  1721. if { $jd < $changeover } {
  1722. dict set date gregorian 0
  1723. set jd [expr {
  1724. 1721423
  1725. + [dict get $date dayOfYear]
  1726. + ( 365 * $ym1 )
  1727. + ( $ym1 / 4 )
  1728. }]
  1729. }
  1730. dict set date julianDay $jd
  1731. return $date
  1732. }
  1733. #----------------------------------------------------------------------
  1734. #
  1735. # GetJulianDayFromEraYearMonthWeekDay --
  1736. #
  1737. # Determines the Julian Day number corresponding to the nth given
  1738. # day-of-the-week in a given month.
  1739. #
  1740. # Parameters:
  1741. # date - Dictionary containing the keys, 'era', 'year', 'month'
  1742. # 'weekOfMonth', 'dayOfWeek', and 'dayOfWeekInMonth'.
  1743. # changeover - Julian Day of adoption of the Gregorian calendar
  1744. #
  1745. # Results:
  1746. # Returns the given dictionary, augmented with a 'julianDay' key.
  1747. #
  1748. # Side effects:
  1749. # None.
  1750. #
  1751. # Bugs:
  1752. # This code needs to be moved to the C layer.
  1753. #
  1754. #----------------------------------------------------------------------
  1755. proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {
  1756. # Come up with a reference day; either the zeroeth day of the given month
  1757. # (dayOfWeekInMonth >= 0) or the seventh day of the following month
  1758. # (dayOfWeekInMonth < 0)
  1759. set date2 $date
  1760. set week [dict get $date dayOfWeekInMonth]
  1761. if { $week >= 0 } {
  1762. dict set date2 dayOfMonth 0
  1763. } else {
  1764. dict incr date2 month
  1765. dict set date2 dayOfMonth 7
  1766. }
  1767. set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
  1768. $changeover]
  1769. set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
  1770. [dict get $date2 julianDay]]
  1771. dict set date julianDay [expr { $wd0 + 7 * $week }]
  1772. return $date
  1773. }
  1774. #----------------------------------------------------------------------
  1775. #
  1776. # IsGregorianLeapYear --
  1777. #
  1778. # Determines whether a given date represents a leap year in the
  1779. # Gregorian calendar.
  1780. #
  1781. # Parameters:
  1782. # date -- The date to test. The fields, 'era', 'year' and 'gregorian'
  1783. # must be set.
  1784. #
  1785. # Results:
  1786. # Returns 1 if the year is a leap year, 0 otherwise.
  1787. #
  1788. # Side effects:
  1789. # None.
  1790. #
  1791. #----------------------------------------------------------------------
  1792. proc ::tcl::clock::IsGregorianLeapYear { date } {
  1793. switch -exact -- [dict get $date era] {
  1794. BCE {
  1795. set year [expr { 1 - [dict get $date year]}]
  1796. }
  1797. CE {
  1798. set year [dict get $date year]
  1799. }
  1800. }
  1801. if { $year % 4 != 0 } {
  1802. return 0
  1803. } elseif { ![dict get $date gregorian] } {
  1804. return 1
  1805. } elseif { $year % 400 == 0 } {
  1806. return 1
  1807. } elseif { $year % 100 == 0 } {
  1808. return 0
  1809. } else {
  1810. return 1
  1811. }
  1812. }
  1813. #----------------------------------------------------------------------
  1814. #
  1815. # WeekdayOnOrBefore --
  1816. #
  1817. # Determine the nearest day of week (given by the 'weekday' parameter,
  1818. # Sunday==0) on or before a given Julian Day.
  1819. #
  1820. # Parameters:
  1821. # weekday -- Day of the week
  1822. # j -- Julian Day number
  1823. #
  1824. # Results:
  1825. # Returns the Julian Day Number of the desired date.
  1826. #
  1827. # Side effects:
  1828. # None.
  1829. #
  1830. #----------------------------------------------------------------------
  1831. proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
  1832. set k [expr { ( $weekday + 6 ) % 7 }]
  1833. return [expr { $j - ( $j - $k ) % 7 }]
  1834. }
  1835. #----------------------------------------------------------------------
  1836. #
  1837. # ChangeCurrentLocale --
  1838. #
  1839. # The global locale was changed within msgcat.
  1840. # Clears the buffered parse functions of the current locale.
  1841. #
  1842. # Parameters:
  1843. # loclist (ignored)
  1844. #
  1845. # Results:
  1846. # None.
  1847. #
  1848. # Side effects:
  1849. # Buffered parse functions are cleared.
  1850. #
  1851. #----------------------------------------------------------------------
  1852. proc ::tcl::clock::ChangeCurrentLocale {args} {
  1853. ::tcl::unsupported::clock::configure -current-locale [lindex $args 0]
  1854. }
  1855. #----------------------------------------------------------------------
  1856. #
  1857. # ClearCaches --
  1858. #
  1859. # Clears all caches to reclaim the memory used in [clock]
  1860. #
  1861. # Parameters:
  1862. # None.
  1863. #
  1864. # Results:
  1865. # None.
  1866. #
  1867. # Side effects:
  1868. # Caches are cleared.
  1869. #
  1870. #----------------------------------------------------------------------
  1871. proc ::tcl::clock::ClearCaches {} {
  1872. variable LocFmtMap
  1873. variable mcMergedCat
  1874. variable TimeZoneBad
  1875. # tell backend - should invalidate:
  1876. ::tcl::unsupported::clock::configure -clear
  1877. # clear msgcat cache:
  1878. set mcMergedCat [dict create]
  1879. set LocFmtMap {}
  1880. set TimeZoneBad {}
  1881. InitTZData
  1882. }