| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097 |
- #----------------------------------------------------------------------
- #
- # clock.tcl --
- #
- # This file implements the portions of the [clock] ensemble that are
- # coded in Tcl. Refer to the users' manual to see the description of
- # the [clock] command and its subcommands.
- #
- #
- #----------------------------------------------------------------------
- #
- # Copyright © 2004-2007 Kevin B. Kenny
- # Copyright © 2015 Sergey G. Brester aka sebres.
- # See the file "license.terms" for information on usage and redistribution
- # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- #
- #----------------------------------------------------------------------
- # msgcat 1.7 features are used.
- package require msgcat 1.7
- # Put the library directory into the namespace for the ensemble so that the
- # library code can find message catalogs and time zone definition files.
- namespace eval ::tcl::clock \
- [list variable LibDir [info library]]
- #----------------------------------------------------------------------
- #
- # clock --
- #
- # Manipulate times.
- #
- # The 'clock' command manipulates time. Refer to the user documentation for
- # the available subcommands and what they do.
- #
- #----------------------------------------------------------------------
- namespace eval ::tcl::clock {
- # Export the subcommands
- namespace export format
- namespace export clicks
- namespace export microseconds
- namespace export milliseconds
- namespace export scan
- namespace export seconds
- namespace export add
- # Import the message catalog commands that we use.
- namespace import ::msgcat::mclocale
- namespace import ::msgcat::mcpackagelocale
- }
- #----------------------------------------------------------------------
- #
- # ::tcl::clock::Initialize --
- #
- # Finish initializing the 'clock' subsystem
- #
- # Results:
- # None.
- #
- # Side effects:
- # Namespace variable in the 'clock' subsystem are initialized.
- #
- # The '::tcl::clock::Initialize' procedure initializes the namespace variables
- # and root locale message catalog for the 'clock' subsystem. It is broken
- # into a procedure rather than simply evaluated as a script so that it will be
- # able to use local variables, avoiding the dangers of 'creative writing' as
- # in Bug 1185933.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::Initialize {} {
- rename ::tcl::clock::Initialize {}
- variable LibDir
- # Define the Greenwich time zone
- proc InitTZData {} {
- variable TZData
- array unset TZData
- set TZData(:Etc/GMT) {
- {-9223372036854775808 0 0 GMT}
- }
- set TZData(:GMT) $TZData(:Etc/GMT)
- set TZData(:Etc/UTC) {
- {-9223372036854775808 0 0 UTC}
- }
- set TZData(:UTC) $TZData(:Etc/UTC)
- set TZData(:localtime) {}
- }
- InitTZData
- mcpackagelocale set {}
- ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs]
- ::msgcat::mcpackageconfig set unknowncmd ""
- ::msgcat::mcpackageconfig set changecmd ChangeCurrentLocale
- # Define the message catalog for the root locale.
- ::msgcat::mcmset {} {
- AM {am}
- BCE {B.C.E.}
- CE {C.E.}
- DATE_FORMAT {%m/%d/%Y}
- DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y}
- DAYS_OF_WEEK_ABBREV {
- Sun Mon Tue Wed Thu Fri Sat
- }
- DAYS_OF_WEEK_FULL {
- Sunday Monday Tuesday Wednesday Thursday Friday Saturday
- }
- GREGORIAN_CHANGE_DATE 2299161
- LOCALE_DATE_FORMAT {%m/%d/%Y}
- LOCALE_DATE_TIME_FORMAT {%a %b %e %H:%M:%S %Y}
- LOCALE_ERAS {}
- LOCALE_NUMERALS {
- 00 01 02 03 04 05 06 07 08 09
- 10 11 12 13 14 15 16 17 18 19
- 20 21 22 23 24 25 26 27 28 29
- 30 31 32 33 34 35 36 37 38 39
- 40 41 42 43 44 45 46 47 48 49
- 50 51 52 53 54 55 56 57 58 59
- 60 61 62 63 64 65 66 67 68 69
- 70 71 72 73 74 75 76 77 78 79
- 80 81 82 83 84 85 86 87 88 89
- 90 91 92 93 94 95 96 97 98 99
- }
- LOCALE_TIME_FORMAT {%H:%M:%S}
- LOCALE_YEAR_FORMAT {%EC%Ey}
- MONTHS_ABBREV {
- Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
- }
- MONTHS_FULL {
- January February March
- April May June
- July August September
- October November December
- }
- PM {pm}
- TIME_FORMAT {%H:%M:%S}
- TIME_FORMAT_12 {%I:%M:%S %P}
- TIME_FORMAT_24 {%H:%M}
- TIME_FORMAT_24_SECS {%H:%M:%S}
- }
- # Define a few Gregorian change dates for other locales. In most cases
- # the change date follows a language, because a nation's colonies changed
- # at the same time as the nation itself. In many cases, different
- # national boundaries existed; the dominating rule is to follow the
- # nation's capital.
- # Italy, Spain, Portugal, Poland
- ::msgcat::mcset it GREGORIAN_CHANGE_DATE 2299161
- ::msgcat::mcset es GREGORIAN_CHANGE_DATE 2299161
- ::msgcat::mcset pt GREGORIAN_CHANGE_DATE 2299161
- ::msgcat::mcset pl GREGORIAN_CHANGE_DATE 2299161
- # France, Austria
- ::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227
- # For Belgium, we follow Southern Netherlands; Liege Diocese changed
- # several weeks later.
- ::msgcat::mcset fr_BE GREGORIAN_CHANGE_DATE 2299238
- ::msgcat::mcset nl_BE GREGORIAN_CHANGE_DATE 2299238
- # Austria
- ::msgcat::mcset de_AT GREGORIAN_CHANGE_DATE 2299527
- # Hungary
- ::msgcat::mcset hu GREGORIAN_CHANGE_DATE 2301004
- # Germany, Norway, Denmark (Catholic Germany changed earlier)
- ::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
- ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
- ::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032
- ::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032
- ::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032
- # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed at
- # various times)
- ::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165
- # Protestant Switzerland (Catholic cantons changed earlier)
- ::msgcat::mcset fr_CH GREGORIAN_CHANGE_DATE 2361342
- ::msgcat::mcset it_CH GREGORIAN_CHANGE_DATE 2361342
- ::msgcat::mcset de_CH GREGORIAN_CHANGE_DATE 2361342
- # English speaking countries
- ::msgcat::mcset en GREGORIAN_CHANGE_DATE 2361222
- # Sweden (had several changes onto and off of the Gregorian calendar)
- ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390
- # Russia
- ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639
- # Romania (Transylvania changed earlier - perhaps de_RO should show the
- # earlier date?)
- ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063
- # Greece
- ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480
- #------------------------------------------------------------------
- #
- # CONSTANTS
- #
- #------------------------------------------------------------------
- # Paths at which binary time zone data for the Olson libraries are known
- # to reside on various operating systems
- variable ZoneinfoPaths {}
- foreach path {
- /usr/share/zoneinfo
- /usr/share/lib/zoneinfo
- /usr/lib/zoneinfo
- /usr/local/etc/zoneinfo
- } {
- if { [file isdirectory $path] } {
- lappend ZoneinfoPaths $path
- }
- }
- # Define the directories for time zone data and message catalogs.
- variable DataDir [file join $LibDir tzdata]
- # Number of days in the months, in common years and leap years.
- variable DaysInRomanMonthInCommonYear \
- { 31 28 31 30 31 30 31 31 30 31 30 31 }
- variable DaysInRomanMonthInLeapYear \
- { 31 29 31 30 31 30 31 31 30 31 30 31 }
- variable DaysInPriorMonthsInCommonYear [list 0]
- variable DaysInPriorMonthsInLeapYear [list 0]
- set i 0
- foreach j $DaysInRomanMonthInCommonYear {
- lappend DaysInPriorMonthsInCommonYear [incr i $j]
- }
- set i 0
- foreach j $DaysInRomanMonthInLeapYear {
- lappend DaysInPriorMonthsInLeapYear [incr i $j]
- }
- # Another epoch (Hi, Jeff!)
- variable Roddenberry 1946
- # Integer ranges
- variable MINWIDE -9223372036854775808
- variable MAXWIDE 9223372036854775807
- # Day before Leap Day
- variable FEB_28 58
- # Default configuration
- ::tcl::unsupported::clock::configure -current-locale [mclocale]
- #::tcl::unsupported::clock::configure -default-locale C
- #::tcl::unsupported::clock::configure -year-century 2000 \
- # -century-switch 38
- # Translation table to map Windows TZI onto cities, so that the Olson
- # rules can apply. In some cases the mapping is ambiguous, so it's wise
- # to specify $::env(TCL_TZ) rather than simply depending on the system
- # time zone.
- # The keys are long lists of values obtained from the time zone
- # information in the Registry. In order, the list elements are:
- # Bias StandardBias DaylightBias
- # StandardDate.wYear StandardDate.wMonth StandardDate.wDayOfWeek
- # StandardDate.wDay StandardDate.wHour StandardDate.wMinute
- # StandardDate.wSecond StandardDate.wMilliseconds
- # DaylightDate.wYear DaylightDate.wMonth DaylightDate.wDayOfWeek
- # DaylightDate.wDay DaylightDate.wHour DaylightDate.wMinute
- # DaylightDate.wSecond DaylightDate.wMilliseconds
- # The values are the names of time zones where those rules apply. There
- # is considerable ambiguity in certain zones; an attempt has been made to
- # make a reasonable guess, but this table needs to be taken with a grain
- # of salt.
- variable WinZoneInfo [dict create {*}{
- {-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Kwajalein
- {-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Midway
- {-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Honolulu
- {-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
- {-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
- {-28800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Tijuana
- {-25200 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Denver
- {-25200 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Chihuahua
- {-25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Phoenix
- {-21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Regina
- {-21600 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Chicago
- {-21600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Mexico_City
- {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/New_York
- {-18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Indianapolis
- {-14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Caracas
- {-14400 0 3600 0 3 6 2 23 59 59 999 0 10 6 2 23 59 59 999}
- :America/Santiago
- {-14400 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Manaus
- {-14400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Halifax
- {-12600 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/St_Johns
- {-10800 0 3600 0 2 0 2 2 0 0 0 0 10 0 3 2 0 0 0} :America/Sao_Paulo
- {-10800 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} :America/Godthab
- {-10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :America/Buenos_Aires
- {-10800 0 3600 0 2 0 5 2 0 0 0 0 11 0 1 2 0 0 0} :America/Bahia
- {-10800 0 3600 0 3 0 2 2 0 0 0 0 10 0 1 2 0 0 0} :America/Montevideo
- {-7200 0 3600 0 9 0 5 2 0 0 0 0 3 0 5 2 0 0 0} :America/Noronha
- {-3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Atlantic/Azores
- {-3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Atlantic/Cape_Verde
- {0 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :UTC
- {0 0 3600 0 10 0 5 2 0 0 0 0 3 0 5 1 0 0 0} :Europe/London
- {3600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Kinshasa
- {3600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :CET
- {7200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Africa/Harare
- {7200 0 3600 0 9 4 5 23 59 59 0 0 4 4 5 23 59 59 0}
- :Africa/Cairo
- {7200 0 3600 0 10 0 5 4 0 0 0 0 3 0 5 3 0 0 0} :Europe/Helsinki
- {7200 0 3600 0 9 0 3 2 0 0 0 0 3 5 5 2 0 0 0} :Asia/Jerusalem
- {7200 0 3600 0 9 0 5 1 0 0 0 0 3 0 5 0 0 0 0} :Europe/Bucharest
- {7200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Athens
- {7200 0 3600 0 9 5 5 1 0 0 0 0 3 4 5 0 0 0 0} :Asia/Amman
- {7200 0 3600 0 10 6 5 23 59 59 999 0 3 0 5 0 0 0 0}
- :Asia/Beirut
- {7200 0 -3600 0 4 0 1 2 0 0 0 0 9 0 1 2 0 0 0} :Africa/Windhoek
- {10800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Riyadh
- {10800 0 3600 0 10 0 1 4 0 0 0 0 4 0 1 3 0 0 0} :Asia/Baghdad
- {10800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Europe/Moscow
- {12600 0 3600 0 9 2 4 2 0 0 0 0 3 0 1 2 0 0 0} :Asia/Tehran
- {14400 0 3600 0 10 0 5 5 0 0 0 0 3 0 5 4 0 0 0} :Asia/Baku
- {14400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Muscat
- {14400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Tbilisi
- {16200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Kabul
- {18000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Karachi
- {18000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yekaterinburg
- {19800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Calcutta
- {20700 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Katmandu
- {21600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Dhaka
- {21600 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Novosibirsk
- {23400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Rangoon
- {25200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Bangkok
- {25200 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Krasnoyarsk
- {28800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Chongqing
- {28800 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Irkutsk
- {32400 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Asia/Tokyo
- {32400 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Yakutsk
- {34200 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Adelaide
- {34200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Darwin
- {36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Australia/Brisbane
- {36000 0 3600 0 10 0 5 3 0 0 0 0 3 0 5 2 0 0 0} :Asia/Vladivostok
- {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 1 2 0 0 0} :Australia/Hobart
- {36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0} :Australia/Sydney
- {39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Noumea
- {43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0} :Pacific/Auckland
- {43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Fiji
- {46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} :Pacific/Tongatapu
- }]
- # Legacy time zones, used primarily for parsing RFC822 dates.
- variable LegacyTimeZone [dict create \
- gmt +0000 \
- ut +0000 \
- utc +0000 \
- bst +0100 \
- wet +0000 \
- wat -0100 \
- at -0200 \
- nft -0330 \
- nst -0330 \
- ndt -0230 \
- ast -0400 \
- adt -0300 \
- est -0500 \
- edt -0400 \
- cst -0600 \
- cdt -0500 \
- mst -0700 \
- mdt -0600 \
- pst -0800 \
- pdt -0700 \
- yst -0900 \
- ydt -0800 \
- akst -0900 \
- akdt -0800 \
- hst -1000 \
- hdt -0900 \
- cat -1000 \
- ahst -1000 \
- nt -1100 \
- idlw -1200 \
- cet +0100 \
- cest +0200 \
- met +0100 \
- mewt +0100 \
- mest +0200 \
- swt +0100 \
- sst +0200 \
- fwt +0100 \
- fst +0200 \
- eet +0200 \
- eest +0300 \
- bt +0300 \
- it +0330 \
- zp4 +0400 \
- zp5 +0500 \
- ist +0530 \
- zp6 +0600 \
- wast +0700 \
- wadt +0800 \
- jt +0730 \
- cct +0800 \
- jst +0900 \
- kst +0900 \
- cast +0930 \
- jdt +1000 \
- kdt +1000 \
- cadt +1030 \
- east +1000 \
- eadt +1030 \
- gst +1000 \
- nzt +1200 \
- nzst +1200 \
- nzdt +1300 \
- idle +1200 \
- a +0100 \
- b +0200 \
- c +0300 \
- d +0400 \
- e +0500 \
- f +0600 \
- g +0700 \
- h +0800 \
- i +0900 \
- k +1000 \
- l +1100 \
- m +1200 \
- n -0100 \
- o -0200 \
- p -0300 \
- q -0400 \
- r -0500 \
- s -0600 \
- t -0700 \
- u -0800 \
- v -0900 \
- w -1000 \
- x -1100 \
- y -1200 \
- z +0000 \
- ]
- # Caches
- variable LocFmtMap [dict create]; # Dictionary with localized format maps
- variable TimeZoneBad [dict create]; # Dictionary whose keys are time zone
- # names and whose values are 1 if
- # the time zone is unknown and 0
- # if it is known.
- variable TZData; # Array whose keys are time zone names
- # and whose values are lists of quads
- # comprising start time, UTC offset,
- # Daylight Saving Time indicator, and
- # time zone abbreviation.
- variable mcLocales [dict create]; # Dictionary with loaded locales
- variable mcMergedCat [dict create]; # Dictionary with merged locale catalogs
- }
- ::tcl::clock::Initialize
- #----------------------------------------------------------------------
- # mcget --
- #
- # Return the merged translation catalog for the ::tcl::clock namespace
- # Searching of catalog is similar to "msgcat::mc".
- #
- # Contrary to "msgcat::mc" may additionally load a package catalog
- # on demand.
- #
- # Arguments:
- # loc The locale used for translation.
- #
- # Results:
- # Returns the dictionary object as whole catalog of the package/locale.
- #
- proc ::tcl::clock::mcget {loc} {
- variable mcMergedCat
- switch -- $loc system {
- set loc [GetSystemLocale]
- } current {
- set loc [mclocale]
- }
- if {$loc ne {}} {
- set loc [string tolower $loc]
- }
- # try to retrieve now if already available:
- if {[dict exists $mcMergedCat $loc]} {
- return [dict get $mcMergedCat $loc]
- }
- # get locales list for given locale (de_de -> {de_de de {}})
- variable mcLocales
- if {[dict exists $mcLocales $loc]} {
- set loclist [dict get $mcLocales $loc]
- } else {
- # save current locale:
- set prevloc [mclocale]
- # lazy load catalog on demand (set it will load the catalog)
- mcpackagelocale set $loc
- set loclist [msgcat::mcutil::getpreferences $loc]
- dict set $mcLocales $loc $loclist
- # restore:
- if {$prevloc ne $loc} {
- mcpackagelocale set $prevloc
- }
- }
- # get whole catalog:
- mcMerge $loclist
- }
- # mcMerge --
- #
- # Merge message catalog dictionaries to one dictionary.
- #
- # Arguments:
- # locales List of locales to merge.
- #
- # Results:
- # Returns the (weak pointer) to merged dictionary of message catalog.
- #
- proc ::tcl::clock::mcMerge {locales} {
- variable mcMergedCat
- if {[dict exists $mcMergedCat [set loc [lindex $locales 0]]]} {
- return [dict get $mcMergedCat $loc]
- }
- # package msgcat currently does not provide possibility to get whole catalog:
- upvar ::msgcat::Msgs Msgs
- set ns ::tcl::clock
- # Merge sequential locales (in reverse order, e. g. {} -> en -> en_en):
- if {[llength $locales] > 1} {
- set mrgcat [mcMerge [lrange $locales 1 end]]
- if {[dict exists $Msgs $ns $loc]} {
- set mrgcat [dict merge $mrgcat [dict get $Msgs $ns $loc]]
- dict set mrgcat L $loc
- } else {
- # be sure a duplicate is created, don't overwrite {} (common) locale:
- set mrgcat [dict merge $mrgcat [dict create L $loc]]
- }
- } else {
- if {[dict exists $Msgs $ns $loc]} {
- set mrgcat [dict get $Msgs $ns $loc]
- dict set mrgcat L $loc
- } else {
- # be sure a duplicate is created, don't overwrite {} (common) locale:
- set mrgcat [dict create L $loc]
- }
- }
- dict set mcMergedCat $loc $mrgcat
- # return smart reference (shared dict as object with exact one ref-counter)
- return $mrgcat
- }
- #----------------------------------------------------------------------
- #
- # GetSystemLocale --
- #
- # Determines the system locale, which corresponds to "system"
- # keyword for locale parameter of 'clock' command.
- #
- # Parameters:
- # None.
- #
- # Results:
- # Returns the system locale.
- #
- # Side effects:
- # None.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::GetSystemLocale {} {
- if { $::tcl_platform(platform) ne {windows} } {
- # On a non-windows platform, the 'system' locale is the same as
- # the 'current' locale
- return [mclocale]
- }
- # On a windows platform, the 'system' locale is adapted from the
- # 'current' locale by applying the date and time formats from the
- # Control Panel. First, load the 'current' locale if it's not yet
- # loaded
- mcpackagelocale set [mclocale]
- # Make a new locale string for the system locale, and get the
- # Control Panel information
- set locale [mclocale]_windows
- if { ! [mcpackagelocale present $locale] } {
- LoadWindowsDateTimeFormats $locale
- }
- return $locale
- }
- #----------------------------------------------------------------------
- #
- # EnterLocale --
- #
- # Switch [mclocale] to a given locale if necessary
- #
- # Parameters:
- # locale -- Desired locale
- #
- # Results:
- # Returns the locale that was previously current.
- #
- # Side effects:
- # Does [mclocale]. If necessary, loades the designated locale's files.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::EnterLocale { locale } {
- switch -- $locale system {
- set locale [GetSystemLocale]
- } current {
- set locale [mclocale]
- }
- # Select the locale, eventually load it
- mcpackagelocale set $locale
- return $locale
- }
- #----------------------------------------------------------------------
- #
- # _hasRegistry --
- #
- # Helper that checks whether registry module is available (Windows only)
- # and loads it on demand.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::_hasRegistry {} {
- set res 0
- if { $::tcl_platform(platform) eq {windows} } {
- if { [catch { package require registry 1.3 }] } {
- # try to load registry directly from root (if uninstalled / development env):
- if {[regexp {[/\\]library$} [info library]]} {catch {
- load [lindex \
- [glob -tails -directory [file dirname [info nameofexecutable]] \
- tcl9registry*[expr {[::tcl::pkgconfig get debug] ? {g} : {}}].dll] 0 \
- ] Registry
- }}
- }
- if { [namespace which -command ::registry] ne "" } {
- set res 1
- }
- }
- proc ::tcl::clock::_hasRegistry {} [list return $res]
- return $res
- }
- #----------------------------------------------------------------------
- #
- # LoadWindowsDateTimeFormats --
- #
- # Load the date/time formats from the Control Panel in Windows and
- # convert them so that they're usable by Tcl.
- #
- # Parameters:
- # locale - Name of the locale in whose message catalog
- # the converted formats are to be stored.
- #
- # Results:
- # None.
- #
- # Side effects:
- # Updates the given message catalog with the locale strings.
- #
- # Presumes that on entry, [mclocale] is set to the current locale, so that
- # default strings can be obtained if the Registry query fails.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {
- # Bail out if we can't find the Registry
- if { ![_hasRegistry] } return
- if { ![catch {
- registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
- sShortDate
- } string] } {
- set quote {}
- set datefmt {}
- foreach { unquoted quoted } [split $string '] {
- append datefmt $quote [string map {
- dddd %A
- ddd %a
- dd %d
- d %e
- MMMM %B
- MMM %b
- MM %m
- M %N
- yyyy %Y
- yy %y
- y %y
- gg {}
- } $unquoted]
- if { $quoted eq {} } {
- set quote '
- } else {
- set quote $quoted
- }
- }
- ::msgcat::mcset $locale DATE_FORMAT $datefmt
- }
- if { ![catch {
- registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
- sLongDate
- } string] } {
- set quote {}
- set ldatefmt {}
- foreach { unquoted quoted } [split $string '] {
- append ldatefmt $quote [string map {
- dddd %A
- ddd %a
- dd %d
- d %e
- MMMM %B
- MMM %b
- MM %m
- M %N
- yyyy %Y
- yy %y
- y %y
- gg {}
- } $unquoted]
- if { $quoted eq {} } {
- set quote '
- } else {
- set quote $quoted
- }
- }
- ::msgcat::mcset $locale LOCALE_DATE_FORMAT $ldatefmt
- }
- if { ![catch {
- registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
- sTimeFormat
- } string] } {
- set quote {}
- set timefmt {}
- foreach { unquoted quoted } [split $string '] {
- append timefmt $quote [string map {
- HH %H
- H %k
- hh %I
- h %l
- mm %M
- m %M
- ss %S
- s %S
- tt %p
- t %p
- } $unquoted]
- if { $quoted eq {} } {
- set quote '
- } else {
- set quote $quoted
- }
- }
- ::msgcat::mcset $locale TIME_FORMAT $timefmt
- }
- catch {
- ::msgcat::mcset $locale DATE_TIME_FORMAT "$datefmt $timefmt"
- }
- catch {
- ::msgcat::mcset $locale LOCALE_DATE_TIME_FORMAT "$ldatefmt $timefmt"
- }
- return
- }
- #----------------------------------------------------------------------
- #
- # LocalizeFormat --
- #
- # Map away locale-dependent format groups in a clock format.
- #
- # Parameters:
- # locale -- Current [mclocale] locale, supplied to avoid
- # an extra call
- # format -- Format supplied to [clock scan] or [clock format]
- # mcd -- Message catalog dictionary for current locale (read-only,
- # don't store it to avoid shared references).
- #
- # Results:
- # Returns the string with locale-dependent composite format groups
- # substituted out.
- #
- # Side effects:
- # None.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::LocalizeFormat { locale format mcd } {
- variable LocFmtMap
- # get map list cached or build it:
- if {[dict exists $LocFmtMap $locale]} {
- set mlst [dict get $LocFmtMap $locale]
- } else {
- # Handle locale-dependent format groups by mapping them out of the format
- # string. Note that the order of the [string map] operations is
- # significant because later formats can refer to later ones; for example
- # %c can refer to %X, which in turn can refer to %T.
- set mlst {
- %% %%
- %D %m/%d/%Y
- %+ {%a %b %e %H:%M:%S %Z %Y}
- }
- lappend mlst %EY [string map $mlst [dict get $mcd LOCALE_YEAR_FORMAT]]
- lappend mlst %T [string map $mlst [dict get $mcd TIME_FORMAT_24_SECS]]
- lappend mlst %R [string map $mlst [dict get $mcd TIME_FORMAT_24]]
- lappend mlst %r [string map $mlst [dict get $mcd TIME_FORMAT_12]]
- lappend mlst %X [string map $mlst [dict get $mcd TIME_FORMAT]]
- lappend mlst %EX [string map $mlst [dict get $mcd LOCALE_TIME_FORMAT]]
- lappend mlst %x [string map $mlst [dict get $mcd DATE_FORMAT]]
- lappend mlst %Ex [string map $mlst [dict get $mcd LOCALE_DATE_FORMAT]]
- lappend mlst %c [string map $mlst [dict get $mcd DATE_TIME_FORMAT]]
- lappend mlst %Ec [string map $mlst [dict get $mcd LOCALE_DATE_TIME_FORMAT]]
- dict set LocFmtMap $locale $mlst
- }
- # translate copy of format (don't use format object here, because otherwise
- # it can lose its internal representation (string map - convert to unicode)
- set locfmt [string map $mlst [string range " $format" 1 end]]
- # Save original format as long as possible, because of internal
- # representation (performance).
- # Note that in this case such format will be never localized (also
- # using another locales). To prevent this return a duplicate (but
- # it may be slower).
- if {$locfmt eq $format} {
- set locfmt $format
- }
- return $locfmt
- }
- #----------------------------------------------------------------------
- #
- # GetSystemTimeZone --
- #
- # Determines the system time zone, which is the default for the
- # 'clock' command if no other zone is supplied.
- #
- # Parameters:
- # None.
- #
- # Results:
- # Returns the system time zone.
- #
- # Side effects:
- # Stores the system time zone in engine configuration, since
- # determining it may be an expensive process.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::GetSystemTimeZone {} {
- variable TimeZoneBad
- if {[set result [getenv TCL_TZ]] ne {}} {
- set timezone $result
- } elseif {[set result [getenv TZ]] ne {}} {
- set timezone $result
- } else {
- # ask engine for the cached timezone:
- set timezone [::tcl::unsupported::clock::configure -system-tz]
- if { $timezone ne "" } {
- return $timezone
- }
- if { $::tcl_platform(platform) eq {windows} } {
- set timezone [GuessWindowsTimeZone]
- } elseif { [file exists /etc/localtime]
- && ![catch {ReadZoneinfoFile \
- Tcl/Localtime /etc/localtime}] } {
- set timezone :Tcl/Localtime
- } else {
- set timezone :localtime
- }
- }
- if { ![dict exists $TimeZoneBad $timezone] } {
- catch {set timezone [SetupTimeZone $timezone]}
- }
- if { [dict exists $TimeZoneBad $timezone] } {
- set timezone :localtime
- }
- # tell backend - current system timezone:
- ::tcl::unsupported::clock::configure -system-tz $timezone
- return $timezone
- }
- #----------------------------------------------------------------------
- #
- # SetupTimeZone --
- #
- # Given the name or specification of a time zone, sets up its in-memory
- # data.
- #
- # Parameters:
- # tzname - Name of a time zone
- #
- # Results:
- # Unless the time zone is ':localtime', sets the TZData array to contain
- # the lookup table for local<->UTC conversion. Returns an error if the
- # time zone cannot be parsed.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::SetupTimeZone { timezone {alias {}} } {
- variable TZData
- if {! [info exists TZData($timezone)] } {
- variable TimeZoneBad
- if { [dict exists $TimeZoneBad $timezone] } {
- return -code error \
- -errorcode [list CLOCK badTimeZone $timezone] \
- "time zone \"$timezone\" not found"
- }
- variable MINWIDE
- if {
- [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
- -> s hh mm ss]
- } then {
- # Make a fixed offset
- ::scan $hh %d hh
- if { $mm eq {} } {
- set mm 0
- } else {
- ::scan $mm %d mm
- }
- if { $ss eq {} } {
- set ss 0
- } else {
- ::scan $ss %d ss
- }
- set offset [expr { ( $hh * 60 + $mm ) * 60 + $ss }]
- if { $s eq {-} } {
- set offset [expr { - $offset }]
- }
- set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]
- } elseif { [string index $timezone 0] eq {:} } {
- # Convert using a time zone file
- if {
- [catch {
- LoadTimeZoneFile [string range $timezone 1 end]
- }] && [catch {
- LoadZoneinfoFile [string range $timezone 1 end]
- } ret opts]
- } then {
- dict unset opts -errorinfo
- if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
- dict set opts -errorcode [list CLOCK badTimeZone $timezone]
- set ret "time zone \"$timezone\" not found: $ret"
- }
- dict set TimeZoneBad $timezone 1
- return -options $opts $ret
- }
- } elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {
- # This looks like a POSIX time zone - try to process it
- if { [catch {ProcessPosixTimeZone $tzfields} ret opts] } {
- dict unset opts -errorinfo
- if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
- dict set opts -errorcode [list CLOCK badTimeZone $timezone]
- set ret "time zone \"$timezone\" not found: $ret"
- }
- dict set TimeZoneBad $timezone 1
- return -options $opts $ret
- } else {
- set TZData($timezone) $ret
- }
- } else {
- variable LegacyTimeZone
- # We couldn't parse this as a POSIX time zone. Try again with a
- # time zone file - this time without a colon
- if { [catch { LoadTimeZoneFile $timezone }]
- && [catch { LoadZoneinfoFile $timezone } ret opts] } {
- # Check may be a legacy zone:
- if { $alias eq {} && ![catch {
- set tzname [dict get $LegacyTimeZone [string tolower $timezone]]
- }] } {
- set tzname [::tcl::clock::SetupTimeZone $tzname $timezone]
- set TZData($timezone) $TZData($tzname)
- # tell backend - timezone is initialized and return shared timezone object:
- return [::tcl::unsupported::clock::configure -setup-tz $timezone]
- }
- dict unset opts -errorinfo
- if {[lindex [dict get $opts -errorcode] 0] ne "CLOCK"} {
- dict set opts -errorcode [list CLOCK badTimeZone $timezone]
- set ret "time zone \"$timezone\" not found: $ret"
- }
- dict set TimeZoneBad $timezone 1
- return -options $opts $ret
- }
- set TZData($timezone) $TZData(:$timezone)
- }
- }
- # tell backend - timezone is initialized and return shared timezone object:
- ::tcl::unsupported::clock::configure -setup-tz $timezone
- }
- #----------------------------------------------------------------------
- #
- # GuessWindowsTimeZone --
- #
- # Determines the system time zone on windows.
- #
- # Parameters:
- # None.
- #
- # Results:
- # Returns a time zone specifier that corresponds to the system time zone
- # information found in the Registry.
- #
- # Bugs:
- # Fixed dates for DST change are unimplemented at present, because no
- # time zone information supplied with Windows actually uses them!
- #
- # On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is specified,
- # GuessWindowsTimeZone looks in the Registry for the system time zone
- # information. It then attempts to find an entry in WinZoneInfo for a time
- # zone that uses the same rules. If it finds one, it returns it; otherwise,
- # it constructs a Posix-style time zone string and returns that.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::GuessWindowsTimeZone {} {
- variable WinZoneInfo
- variable TimeZoneBad
- if { ![_hasRegistry] } {
- return :localtime
- }
- # Dredge time zone information out of the registry
- if { [catch {
- set rpath HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation
- set data [list \
- [expr { -60
- * [registry get $rpath Bias] }] \
- [expr { -60
- * [registry get $rpath StandardBias] }] \
- [expr { -60 \
- * [registry get $rpath DaylightBias] }]]
- set stdtzi [registry get $rpath StandardStart]
- foreach ind {0 2 14 4 6 8 10 12} {
- binary scan $stdtzi @${ind}s val
- lappend data $val
- }
- set daytzi [registry get $rpath DaylightStart]
- foreach ind {0 2 14 4 6 8 10 12} {
- binary scan $daytzi @${ind}s val
- lappend data $val
- }
- }] } {
- # Missing values in the Registry - bail out
- return :localtime
- }
- # Make up a Posix time zone specifier if we can't find one. Check here
- # that the tzdata file exists, in case we're running in an environment
- # (e.g. starpack) where tzdata is incomplete. (Bug 1237907)
- if { [dict exists $WinZoneInfo $data] } {
- set tzname [dict get $WinZoneInfo $data]
- if { ! [dict exists $TimeZoneBad $tzname] } {
- catch {set tzname [SetupTimeZone $tzname]}
- }
- } else {
- set tzname {}
- }
- if { $tzname eq {} || [dict exists $TimeZoneBad $tzname] } {
- lassign $data \
- bias stdBias dstBias \
- stdYear stdMonth stdDayOfWeek stdDayOfMonth \
- stdHour stdMinute stdSecond stdMillisec \
- dstYear dstMonth dstDayOfWeek dstDayOfMonth \
- dstHour dstMinute dstSecond dstMillisec
- set stdDelta [expr { $bias + $stdBias }]
- set dstDelta [expr { $bias + $dstBias }]
- if { $stdDelta <= 0 } {
- set stdSignum +
- set stdDelta [expr { - $stdDelta }]
- set dispStdSignum -
- } else {
- set stdSignum -
- set dispStdSignum +
- }
- set hh [::format %02d [expr { $stdDelta / 3600 }]]
- set mm [::format %02d [expr { ($stdDelta / 60 ) % 60 }]]
- set ss [::format %02d [expr { $stdDelta % 60 }]]
- set tzname {}
- append tzname < $dispStdSignum $hh $mm > $stdSignum $hh : $mm : $ss
- if { $stdMonth >= 0 } {
- if { $dstDelta <= 0 } {
- set dstSignum +
- set dstDelta [expr { - $dstDelta }]
- set dispDstSignum -
- } else {
- set dstSignum -
- set dispDstSignum +
- }
- set hh [::format %02d [expr { $dstDelta / 3600 }]]
- set mm [::format %02d [expr { ($dstDelta / 60 ) % 60 }]]
- set ss [::format %02d [expr { $dstDelta % 60 }]]
- append tzname < $dispDstSignum $hh $mm > $dstSignum $hh : $mm : $ss
- if { $dstYear == 0 } {
- append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek
- } else {
- # I have not been able to find any locale on which Windows
- # converts time zone on a fixed day of the year, hence don't
- # know how to interpret the fields. If someone can inform me,
- # I'd be glad to code it up. For right now, we bail out in
- # such a case.
- return :localtime
- }
- append tzname / [::format %02d $dstHour] \
- : [::format %02d $dstMinute] \
- : [::format %02d $dstSecond]
- if { $stdYear == 0 } {
- append tzname ,M $stdMonth . $stdDayOfMonth . $stdDayOfWeek
- } else {
- # I have not been able to find any locale on which Windows
- # converts time zone on a fixed day of the year, hence don't
- # know how to interpret the fields. If someone can inform me,
- # I'd be glad to code it up. For right now, we bail out in
- # such a case.
- return :localtime
- }
- append tzname / [::format %02d $stdHour] \
- : [::format %02d $stdMinute] \
- : [::format %02d $stdSecond]
- }
- dict set WinZoneInfo $data $tzname
- }
- return [dict get $WinZoneInfo $data]
- }
- #----------------------------------------------------------------------
- #
- # LoadTimeZoneFile --
- #
- # Load the data file that specifies the conversion between a
- # given time zone and Greenwich.
- #
- # Parameters:
- # fileName -- Name of the file to load
- #
- # Results:
- # None.
- #
- # Side effects:
- # TZData(:fileName) contains the time zone data
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::LoadTimeZoneFile { fileName } {
- variable DataDir
- variable TZData
- if { [info exists TZData($fileName)] } {
- return
- }
- # Since an unsafe interp uses the [clock] command in the parent, this code
- # is security sensitive. Make sure that the path name cannot escape the
- # given directory.
- if { [regexp {^[/\\]|^[a-zA-Z]+:|(?:^|[/\\])\.\.} $fileName] } {
- return -code error \
- -errorcode [list CLOCK badTimeZone :$fileName] \
- "time zone \":$fileName\" not valid"
- }
- try {
- source [file join $DataDir $fileName]
- } on error {} {
- return -code error \
- -errorcode [list CLOCK badTimeZone :$fileName] \
- "time zone \":$fileName\" not found"
- }
- return
- }
- #----------------------------------------------------------------------
- #
- # LoadZoneinfoFile --
- #
- # Loads a binary time zone information file in Olson format.
- #
- # Parameters:
- # fileName - Relative path name of the file to load.
- #
- # Results:
- # Returns an empty result normally; returns an error if no Olson file
- # was found or the file was malformed in some way.
- #
- # Side effects:
- # TZData(:fileName) contains the time zone data
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::LoadZoneinfoFile { fileName } {
- variable ZoneinfoPaths
- # Since an unsafe interp uses the [clock] command in the parent, this code
- # is security sensitive. Make sure that the path name cannot escape the
- # given directory.
- if { [regexp {^[/\\]|^[a-zA-Z]+:|(?:^|[/\\])\.\.} $fileName] } {
- return -code error \
- -errorcode [list CLOCK badTimeZone :$fileName] \
- "time zone \":$fileName\" not valid"
- }
- set fname ""
- foreach d $ZoneinfoPaths {
- set fname [file join $d $fileName]
- if { [file readable $fname] && [file isfile $fname] } {
- break
- }
- set fname ""
- }
- if {$fname eq ""} {
- return -code error \
- -errorcode [list CLOCK badTimeZone :$fileName] \
- "time zone \":$fileName\" not found"
- }
- ReadZoneinfoFile $fileName $fname
- }
- #----------------------------------------------------------------------
- #
- # ReadZoneinfoFile --
- #
- # Loads a binary time zone information file in Olson format.
- #
- # Parameters:
- # fileName - Name of the time zone (relative path name of the
- # file).
- # fname - Absolute path name of the file.
- #
- # Results:
- # Returns an empty result normally; returns an error if no Olson file
- # was found or the file was malformed in some way.
- #
- # Side effects:
- # TZData(:fileName) contains the time zone data
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
- variable MINWIDE
- variable TZData
- if { ![file exists $fname] } {
- return -code error "$fileName not found"
- }
- if { [file size $fname] > 262144 } {
- return -code error "$fileName too big"
- }
- # Suck in all the data from the file
- set f [open $fname r]
- fconfigure $f -translation binary
- set d [read $f]
- close $f
- # The file begins with a magic number, sixteen reserved bytes, and then
- # six 4-byte integers giving counts of fields in the file.
- binary scan $d a4a1x15IIIIII \
- magic version nIsGMT nIsStd nLeap nTime nType nChar
- set seek 44
- set ilen 4
- set iformat I
- if { $magic != {TZif} } {
- return -code error "$fileName not a time zone information file"
- }
- if { $nType > 255 } {
- return -code error "$fileName contains too many time types"
- }
- # Accept only Posix-style zoneinfo. Sorry, 'leaps' bigots.
- if { $nLeap != 0 } {
- return -code error "$fileName contains leap seconds"
- }
- # In a version 2 file, we use the second part of the file, which contains
- # 64-bit transition times.
- if {$version eq "2"} {
- set seek [expr {
- 44
- + 5 * $nTime
- + 6 * $nType
- + 4 * $nLeap
- + $nIsStd
- + $nIsGMT
- + $nChar
- }]
- binary scan $d @${seek}a4a1x15IIIIII \
- magic version nIsGMT nIsStd nLeap nTime nType nChar
- if {$magic ne {TZif}} {
- return -code error "seek address $seek miscomputed, magic = $magic"
- }
- set iformat W
- set ilen 8
- incr seek 44
- }
- # Next come ${nTime} transition times, followed by ${nTime} time type
- # codes. The type codes are unsigned 1-byte quantities. We insert an
- # arbitrary start time in front of the transitions.
- binary scan $d @${seek}${iformat}${nTime}c${nTime} times tempCodes
- incr seek [expr { ($ilen + 1) * $nTime }]
- set times [linsert $times 0 $MINWIDE]
- set codes {}
- foreach c $tempCodes {
- lappend codes [expr { $c & 0xFF }]
- }
- set codes [linsert $codes 0 0]
- # Next come ${nType} time type descriptions, each of which has an offset
- # (seconds east of GMT), a DST indicator, and an index into the
- # abbreviation text.
- for { set i 0 } { $i < $nType } { incr i } {
- binary scan $d @${seek}Icc gmtOff isDst abbrInd
- lappend types [list $gmtOff $isDst $abbrInd]
- incr seek 6
- }
- # Next come $nChar characters of time zone name abbreviations, which are
- # null-terminated.
- # We build them up into a dictionary indexed by character index, because
- # that's what's in the indices above.
- binary scan $d @${seek}a${nChar} abbrs
- incr seek ${nChar}
- set abbrList [split $abbrs \0]
- set i 0
- set abbrevs {}
- foreach a $abbrList {
- for {set j 0} {$j <= [string length $a]} {incr j} {
- dict set abbrevs $i [string range $a $j end]
- incr i
- }
- }
- # Package up a list of tuples, each of which contains transition time,
- # seconds east of Greenwich, DST flag and time zone abbreviation.
- set r {}
- set lastTime $MINWIDE
- foreach t $times c $codes {
- if { $t < $lastTime } {
- return -code error "$fileName has times out of order"
- }
- set lastTime $t
- lassign [lindex $types $c] gmtoff isDst abbrInd
- set abbrev [dict get $abbrevs $abbrInd]
- lappend r [list $t $gmtoff $isDst $abbrev]
- }
- # In a version 2 file, there is also a POSIX-style time zone description
- # at the very end of the file. To get to it, skip over nLeap leap second
- # values (8 bytes each),
- # nIsStd standard/DST indicators and nIsGMT UTC/local indicators.
- if {$version eq {2}} {
- set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}]
- set last [string first \n $d $seek]
- set posix [string range $d $seek [expr {$last-1}]]
- if {[llength $posix] > 0} {
- set posixFields [ParsePosixTimeZone $posix]
- foreach tuple [ProcessPosixTimeZone $posixFields] {
- lassign $tuple t gmtoff isDst abbrev
- if {$t > $lastTime} {
- lappend r $tuple
- }
- }
- }
- }
- set TZData(:$fileName) $r
- return
- }
- #----------------------------------------------------------------------
- #
- # ParsePosixTimeZone --
- #
- # Parses the TZ environment variable in Posix form
- #
- # Parameters:
- # tz Time zone specifier to be interpreted
- #
- # Results:
- # Returns a dictionary whose values contain the various pieces of the
- # time zone specification.
- #
- # Side effects:
- # None.
- #
- # Errors:
- # Throws an error if the syntax of the time zone is incorrect.
- #
- # The following keys are present in the dictionary:
- # stdName - Name of the time zone when Daylight Saving Time
- # is not in effect.
- # stdSignum - Sign (+, -, or empty) of the offset from Greenwich
- # to the given (non-DST) time zone. + and the empty
- # string denote zones west of Greenwich, - denotes east
- # of Greenwich; this is contrary to the ISO convention
- # but follows Posix.
- # stdHours - Hours part of the offset from Greenwich to the given
- # (non-DST) time zone.
- # stdMinutes - Minutes part of the offset from Greenwich to the
- # given (non-DST) time zone. Empty denotes zero.
- # stdSeconds - Seconds part of the offset from Greenwich to the
- # given (non-DST) time zone. Empty denotes zero.
- # dstName - Name of the time zone when DST is in effect, or the
- # empty string if the time zone does not observe Daylight
- # Saving Time.
- # dstSignum, dstHours, dstMinutes, dstSeconds -
- # Fields corresponding to stdSignum, stdHours, stdMinutes,
- # stdSeconds for the Daylight Saving Time version of the
- # time zone. If dstHours is empty, it is presumed to be 1.
- # startDayOfYear - The ordinal number of the day of the year on which
- # Daylight Saving Time begins. If this field is
- # empty, then DST begins on a given month-week-day,
- # as below.
- # startJ - The letter J, or an empty string. If a J is present in
- # this field, then startDayOfYear does not count February 29
- # even in leap years.
- # startMonth - The number of the month in which Daylight Saving Time
- # begins, supplied if startDayOfYear is empty. If both
- # startDayOfYear and startMonth are empty, then US rules
- # are presumed.
- # startWeekOfMonth - The number of the week in the month in which
- # Daylight Saving Time begins, in the range 1-5.
- # 5 denotes the last week of the month even in a
- # 4-week month.
- # startDayOfWeek - The number of the day of the week (Sunday=0,
- # Saturday=6) on which Daylight Saving Time begins.
- # startHours - The hours part of the time of day at which Daylight
- # Saving Time begins. An empty string is presumed to be 2.
- # startMinutes - The minutes part of the time of day at which DST begins.
- # An empty string is presumed zero.
- # startSeconds - The seconds part of the time of day at which DST begins.
- # An empty string is presumed zero.
- # endDayOfYear, endJ, endMonth, endWeekOfMonth, endDayOfWeek,
- # endHours, endMinutes, endSeconds -
- # Specify the end of DST in the same way that the start* fields
- # specify the beginning of DST.
- #
- # This procedure serves only to break the time specifier into fields. No
- # attempt is made to canonicalize the fields or supply default values.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::ParsePosixTimeZone { tz } {
- if {[regexp -expanded -nocase -- {
- ^
- # 1 - Standard time zone name
- ([[:alpha:]]+ | <[-+[:alnum:]]+>)
- # 2 - Standard time zone offset, signum
- ([-+]?)
- # 3 - Standard time zone offset, hours
- ([[:digit:]]{1,2})
- (?:
- # 4 - Standard time zone offset, minutes
- : ([[:digit:]]{1,2})
- (?:
- # 5 - Standard time zone offset, seconds
- : ([[:digit:]]{1,2} )
- )?
- )?
- (?:
- # 6 - DST time zone name
- ([[:alpha:]]+ | <[-+[:alnum:]]+>)
- (?:
- (?:
- # 7 - DST time zone offset, signum
- ([-+]?)
- # 8 - DST time zone offset, hours
- ([[:digit:]]{1,2})
- (?:
- # 9 - DST time zone offset, minutes
- : ([[:digit:]]{1,2})
- (?:
- # 10 - DST time zone offset, seconds
- : ([[:digit:]]{1,2})
- )?
- )?
- )?
- (?:
- ,
- (?:
- # 11 - Optional J in n and Jn form 12 - Day of year
- ( J ? ) ( [[:digit:]]+ )
- | M
- # 13 - Month number 14 - Week of month 15 - Day of week
- ( [[:digit:]] + )
- [.] ( [[:digit:]] + )
- [.] ( [[:digit:]] + )
- )
- (?:
- # 16 - Start time of DST - hours
- / ( [[:digit:]]{1,2} )
- (?:
- # 17 - Start time of DST - minutes
- : ( [[:digit:]]{1,2} )
- (?:
- # 18 - Start time of DST - seconds
- : ( [[:digit:]]{1,2} )
- )?
- )?
- )?
- ,
- (?:
- # 19 - Optional J in n and Jn form 20 - Day of year
- ( J ? ) ( [[:digit:]]+ )
- | M
- # 21 - Month number 22 - Week of month 23 - Day of week
- ( [[:digit:]] + )
- [.] ( [[:digit:]] + )
- [.] ( [[:digit:]] + )
- )
- (?:
- # 24 - End time of DST - hours
- / ( [[:digit:]]{1,2} )
- (?:
- # 25 - End time of DST - minutes
- : ( [[:digit:]]{1,2} )
- (?:
- # 26 - End time of DST - seconds
- : ( [[:digit:]]{1,2} )
- )?
- )?
- )?
- )?
- )?
- )?
- $
- } $tz -> x(stdName) x(stdSignum) x(stdHours) x(stdMinutes) x(stdSeconds) \
- x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
- x(startJ) x(startDayOfYear) \
- x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
- x(startHours) x(startMinutes) x(startSeconds) \
- x(endJ) x(endDayOfYear) \
- x(endMonth) x(endWeekOfMonth) x(endDayOfWeek) \
- x(endHours) x(endMinutes) x(endSeconds)] } {
- # it's a good timezone
- return [array get x]
- }
- return -code error\
- -errorcode [list CLOCK badTimeZone $tz] \
- "unable to parse time zone specification \"$tz\""
- }
- #----------------------------------------------------------------------
- #
- # ProcessPosixTimeZone --
- #
- # Handle a Posix time zone after it's been broken out into fields.
- #
- # Parameters:
- # z - Dictionary returned from 'ParsePosixTimeZone'
- #
- # Results:
- # Returns time zone information for the 'TZData' array.
- #
- # Side effects:
- # None.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::ProcessPosixTimeZone { z } {
- variable MINWIDE
- variable TZData
- # Determine the standard time zone name and seconds east of Greenwich
- set stdName [dict get $z stdName]
- if { [string index $stdName 0] eq {<} } {
- set stdName [string range $stdName 1 end-1]
- }
- if { [dict get $z stdSignum] eq {-} } {
- set stdSignum +1
- } else {
- set stdSignum -1
- }
- set stdHours [lindex [::scan [dict get $z stdHours] %d] 0]
- if { [dict get $z stdMinutes] ne {} } {
- set stdMinutes [lindex [::scan [dict get $z stdMinutes] %d] 0]
- } else {
- set stdMinutes 0
- }
- if { [dict get $z stdSeconds] ne {} } {
- set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
- } else {
- set stdSeconds 0
- }
- set stdOffset [expr {
- (($stdHours * 60 + $stdMinutes) * 60 + $stdSeconds) * $stdSignum
- }]
- set data [list [list $MINWIDE $stdOffset 0 $stdName]]
- # If there's no daylight zone, we're done
- set dstName [dict get $z dstName]
- if { $dstName eq {} } {
- return $data
- }
- if { [string index $dstName 0] eq {<} } {
- set dstName [string range $dstName 1 end-1]
- }
- # Determine the daylight name
- if { [dict get $z dstSignum] eq {-} } {
- set dstSignum +1
- } else {
- set dstSignum -1
- }
- if { [dict get $z dstHours] eq {} } {
- set dstOffset [expr { 3600 + $stdOffset }]
- } else {
- set dstHours [lindex [::scan [dict get $z dstHours] %d] 0]
- if { [dict get $z dstMinutes] ne {} } {
- set dstMinutes [lindex [::scan [dict get $z dstMinutes] %d] 0]
- } else {
- set dstMinutes 0
- }
- if { [dict get $z dstSeconds] ne {} } {
- set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
- } else {
- set dstSeconds 0
- }
- set dstOffset [expr {
- (($dstHours*60 + $dstMinutes) * 60 + $dstSeconds) * $dstSignum
- }]
- }
- # Fill in defaults for European or US DST rules
- # US start time is the second Sunday in March
- # EU start time is the last Sunday in March
- # US end time is the first Sunday in November.
- # EU end time is the last Sunday in October
- if {
- [dict get $z startDayOfYear] eq {}
- && [dict get $z startMonth] eq {}
- } then {
- if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
- # EU
- dict set z startWeekOfMonth 5
- if {$stdHours>2} {
- dict set z startHours 2
- } else {
- dict set z startHours [expr {$stdHours+1}]
- }
- } else {
- # US
- dict set z startWeekOfMonth 2
- dict set z startHours 2
- }
- dict set z startMonth 3
- dict set z startDayOfWeek 0
- dict set z startMinutes 0
- dict set z startSeconds 0
- }
- if {
- [dict get $z endDayOfYear] eq {}
- && [dict get $z endMonth] eq {}
- } then {
- if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
- # EU
- dict set z endMonth 10
- dict set z endWeekOfMonth 5
- if {$stdHours>2} {
- dict set z endHours 3
- } else {
- dict set z endHours [expr {$stdHours+2}]
- }
- } else {
- # US
- dict set z endMonth 11
- dict set z endWeekOfMonth 1
- dict set z endHours 2
- }
- dict set z endDayOfWeek 0
- dict set z endMinutes 0
- dict set z endSeconds 0
- }
- # Put DST in effect in all years from 1916 to 2099.
- for { set y 1916 } { $y < 2100 } { incr y } {
- set startTime [DeterminePosixDSTTime $z start $y]
- incr startTime [expr { - wide($stdOffset) }]
- set endTime [DeterminePosixDSTTime $z end $y]
- incr endTime [expr { - wide($dstOffset) }]
- if { $startTime < $endTime } {
- lappend data \
- [list $startTime $dstOffset 1 $dstName] \
- [list $endTime $stdOffset 0 $stdName]
- } else {
- lappend data \
- [list $endTime $stdOffset 0 $stdName] \
- [list $startTime $dstOffset 1 $dstName]
- }
- }
- return $data
- }
- #----------------------------------------------------------------------
- #
- # DeterminePosixDSTTime --
- #
- # Determines the time that Daylight Saving Time starts or ends from a
- # Posix time zone specification.
- #
- # Parameters:
- # z - Time zone data returned from ParsePosixTimeZone.
- # Missing fields are expected to be filled in with
- # default values.
- # bound - The word 'start' or 'end'
- # y - The year for which the transition time is to be determined.
- #
- # Results:
- # Returns the transition time as a count of seconds from the epoch. The
- # time is relative to the wall clock, not UTC.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {
- variable FEB_28
- # Determine the start or end day of DST
- set date [dict create era CE year $y gregorian 1]
- set doy [dict get $z ${bound}DayOfYear]
- if { $doy ne {} } {
- # Time was specified as a day of the year
- if { [dict get $z ${bound}J] ne {}
- && [IsGregorianLeapYear $date]
- && ( $doy > $FEB_28 ) } {
- incr doy
- }
- dict set date dayOfYear $doy
- set date [GetJulianDayFromEraYearDay $date[set date {}] 2361222]
- } else {
- # Time was specified as a day of the week within a month
- dict set date month [dict get $z ${bound}Month]
- dict set date dayOfWeek [dict get $z ${bound}DayOfWeek]
- set dowim [dict get $z ${bound}WeekOfMonth]
- if { $dowim >= 5 } {
- set dowim -1
- }
- dict set date dayOfWeekInMonth $dowim
- set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222]
- }
- set jd [dict get $date julianDay]
- set seconds [expr {
- wide($jd) * wide(86400) - wide(210866803200)
- }]
- set h [dict get $z ${bound}Hours]
- if { $h eq {} } {
- set h 2
- } else {
- set h [lindex [::scan $h %d] 0]
- }
- set m [dict get $z ${bound}Minutes]
- if { $m eq {} } {
- set m 0
- } else {
- set m [lindex [::scan $m %d] 0]
- }
- set s [dict get $z ${bound}Seconds]
- if { $s eq {} } {
- set s 0
- } else {
- set s [lindex [::scan $s %d] 0]
- }
- set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
- return [expr { $seconds + $tod }]
- }
- #----------------------------------------------------------------------
- #
- # GetJulianDayFromEraYearDay --
- #
- # Given a year, month and day on the Gregorian calendar, determines
- # the Julian Day Number beginning at noon on that date.
- #
- # Parameters:
- # date -- A dictionary in which the 'era', 'year', and
- # 'dayOfYear' slots are populated. The calendar in use
- # is determined by the date itself relative to:
- # changeover -- Julian day on which the Gregorian calendar was
- # adopted in the current locale.
- #
- # Results:
- # Returns the given dictionary augmented with a 'julianDay' key whose
- # value is the desired Julian Day Number, and a 'gregorian' key that
- # specifies whether the calendar is Gregorian (1) or Julian (0).
- #
- # Side effects:
- # None.
- #
- # Bugs:
- # This code needs to be moved to the C layer.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {
- # Get absolute year number from the civil year
- switch -exact -- [dict get $date era] {
- BCE {
- set year [expr { 1 - [dict get $date year] }]
- }
- CE {
- set year [dict get $date year]
- }
- }
- set ym1 [expr { $year - 1 }]
- # Try the Gregorian calendar first.
- dict set date gregorian 1
- set jd [expr {
- 1721425
- + [dict get $date dayOfYear]
- + ( 365 * $ym1 )
- + ( $ym1 / 4 )
- - ( $ym1 / 100 )
- + ( $ym1 / 400 )
- }]
- # If the date is before the Gregorian change, use the Julian calendar.
- if { $jd < $changeover } {
- dict set date gregorian 0
- set jd [expr {
- 1721423
- + [dict get $date dayOfYear]
- + ( 365 * $ym1 )
- + ( $ym1 / 4 )
- }]
- }
- dict set date julianDay $jd
- return $date
- }
- #----------------------------------------------------------------------
- #
- # GetJulianDayFromEraYearMonthWeekDay --
- #
- # Determines the Julian Day number corresponding to the nth given
- # day-of-the-week in a given month.
- #
- # Parameters:
- # date - Dictionary containing the keys, 'era', 'year', 'month'
- # 'weekOfMonth', 'dayOfWeek', and 'dayOfWeekInMonth'.
- # changeover - Julian Day of adoption of the Gregorian calendar
- #
- # Results:
- # Returns the given dictionary, augmented with a 'julianDay' key.
- #
- # Side effects:
- # None.
- #
- # Bugs:
- # This code needs to be moved to the C layer.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {
- # Come up with a reference day; either the zeroeth day of the given month
- # (dayOfWeekInMonth >= 0) or the seventh day of the following month
- # (dayOfWeekInMonth < 0)
- set date2 $date
- set week [dict get $date dayOfWeekInMonth]
- if { $week >= 0 } {
- dict set date2 dayOfMonth 0
- } else {
- dict incr date2 month
- dict set date2 dayOfMonth 7
- }
- set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
- $changeover]
- set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
- [dict get $date2 julianDay]]
- dict set date julianDay [expr { $wd0 + 7 * $week }]
- return $date
- }
- #----------------------------------------------------------------------
- #
- # IsGregorianLeapYear --
- #
- # Determines whether a given date represents a leap year in the
- # Gregorian calendar.
- #
- # Parameters:
- # date -- The date to test. The fields, 'era', 'year' and 'gregorian'
- # must be set.
- #
- # Results:
- # Returns 1 if the year is a leap year, 0 otherwise.
- #
- # Side effects:
- # None.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::IsGregorianLeapYear { date } {
- switch -exact -- [dict get $date era] {
- BCE {
- set year [expr { 1 - [dict get $date year]}]
- }
- CE {
- set year [dict get $date year]
- }
- }
- if { $year % 4 != 0 } {
- return 0
- } elseif { ![dict get $date gregorian] } {
- return 1
- } elseif { $year % 400 == 0 } {
- return 1
- } elseif { $year % 100 == 0 } {
- return 0
- } else {
- return 1
- }
- }
- #----------------------------------------------------------------------
- #
- # WeekdayOnOrBefore --
- #
- # Determine the nearest day of week (given by the 'weekday' parameter,
- # Sunday==0) on or before a given Julian Day.
- #
- # Parameters:
- # weekday -- Day of the week
- # j -- Julian Day number
- #
- # Results:
- # Returns the Julian Day Number of the desired date.
- #
- # Side effects:
- # None.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {
- set k [expr { ( $weekday + 6 ) % 7 }]
- return [expr { $j - ( $j - $k ) % 7 }]
- }
- #----------------------------------------------------------------------
- #
- # ChangeCurrentLocale --
- #
- # The global locale was changed within msgcat.
- # Clears the buffered parse functions of the current locale.
- #
- # Parameters:
- # loclist (ignored)
- #
- # Results:
- # None.
- #
- # Side effects:
- # Buffered parse functions are cleared.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::ChangeCurrentLocale {args} {
- ::tcl::unsupported::clock::configure -current-locale [lindex $args 0]
- }
- #----------------------------------------------------------------------
- #
- # ClearCaches --
- #
- # Clears all caches to reclaim the memory used in [clock]
- #
- # Parameters:
- # None.
- #
- # Results:
- # None.
- #
- # Side effects:
- # Caches are cleared.
- #
- #----------------------------------------------------------------------
- proc ::tcl::clock::ClearCaches {} {
- variable LocFmtMap
- variable mcMergedCat
- variable TimeZoneBad
- # tell backend - should invalidate:
- ::tcl::unsupported::clock::configure -clear
- # clear msgcat cache:
- set mcMergedCat [dict create]
- set LocFmtMap {}
- set TimeZoneBad {}
- InitTZData
- }
|