diff options
author | Kevin B Kenny <kennykb@acm.org> | 2004-08-18 20:59:20 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2004-08-18 20:59:20 (GMT) |
commit | 53141db9967b22cf67fd4a345ee469f685093f16 (patch) | |
tree | 75f7ddb9d5363f23cf8ac328d02811c067a8e0ee | |
parent | fab56e2415bbbc5e2355f500b28d26c5e907ef29 (diff) | |
download | tcl-53141db9967b22cf67fd4a345ee469f685093f16.zip tcl-53141db9967b22cf67fd4a345ee469f685093f16.tar.gz tcl-53141db9967b22cf67fd4a345ee469f685093f16.tar.bz2 |
unbreak Win build after TIP#173 and TIP#209 commit
-rw-r--r-- | ChangeLog | 3 | ||||
-rw-r--r-- | library/clock.tcl | 88 | ||||
-rw-r--r-- | tests/clock.test | 23 | ||||
-rw-r--r-- | win/Makefile.in | 16 | ||||
-rw-r--r-- | win/makefile.vc | 15 |
5 files changed, 116 insertions, 29 deletions
@@ -18,6 +18,9 @@ * unix/Makefile.in: * unix/configure: (regenerated) * unix/tcl.m4: + * tests/clock.test (all): + * win/Makefile.in: + * win/Makefile.vc: Implementation of TIPs #173 and #209. The [clock] command is now a Tcl ensemble, with most of its diff --git a/library/clock.tcl b/library/clock.tcl index 44e7d8c..f4a561d 100644 --- a/library/clock.tcl +++ b/library/clock.tcl @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: clock.tcl,v 1.1 2004/08/18 19:59:00 kennykb Exp $ +# RCS: @(#) $Id: clock.tcl,v 1.2 2004/08/18 20:59:33 kennykb Exp $ # #---------------------------------------------------------------------- @@ -24,7 +24,26 @@ uplevel \#0 { package require msgcat 1.4 if { $::tcl_platform(platform) eq {windows} } { - package require registry 1.1 + if { [catch { package require registry 1.1 }] } { + + # HIDEOUS KLUDGE: [package require registry 1.1] has failed. + # This failure likely means that we're running in Tcl's build + # directory instead of the install directory. We recover by + # trying to load tclreg*.dll directly. + + if { [catch { + load [lindex \ + [glob -directory \ + [file join \ + [pwd] \ + [file dirname [info nameofexecutable]]] \ + tclReg*.dll] \ + 0] registry + }] } { + # Still no registry! + namespace eval ::tcl::clock [list variable NoRegistry {}] + } + } } } @@ -2140,6 +2159,11 @@ proc ::tcl::clock::EnterLocale { locale oldLocaleVar } { proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } { + # Bail out if we can't find the Registry + + variable NoRegistry + if { [info exists NoRegistry] } return + if { ![catch { registry get "HKEY_CURRENT_USER\\Control Panel\\International" \ sShortDate @@ -3144,13 +3168,12 @@ proc ::tcl::clock::SetupTimeZone { timezone } { # 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 - } msg] } { - return -code error -errorcode $::errorCode $msg + if { [catch { LoadTimeZoneFile $timezone }] + && [catch { LoadZoneinfoFile $timezone }] } { + return -code error -errorcode $::errorCode \ + "time zone $timezone not found" } set TZData($timezone) $TZData(:$timezone) - } } @@ -3190,25 +3213,38 @@ proc ::tcl::clock::GuessWindowsTimeZone {} { variable SecondsPerHour variable SecondsPerMinute variable MinutesPerHour + variable NoRegistry + + if { [info exists NoRegistry] } { + return :localtime + } # Dredge time zone information out of the registry - set rpath HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation - set data [list \ - [expr { -$SecondsPerMinute * [registry get $rpath Bias] }] \ - [expr { -$SecondsPerMinute \ - * [registry get $rpath StandardBias] }] \ - [expr { -$SecondsPerMinute \ - * [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 + if { [catch { + set rpath HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\TimeZoneInformation + set data [list \ + [expr { -$SecondsPerMinute + * [registry get $rpath Bias] }] \ + [expr { -$SecondsPerMinute \ + * [registry get $rpath StandardBias] }] \ + [expr { -$SecondsPerMinute \ + * [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 @@ -3302,6 +3338,10 @@ 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 master, # this code is security sensitive. Make sure that the path name # cannot escape the given directory. @@ -3318,6 +3358,7 @@ proc ::tcl::clock::LoadTimeZoneFile { fileName } { -errorcode [list CLOCK badTimeZone :$fileName] \ "time zone \":$fileName\" not found" } + return } #---------------------------------------------------------------------- @@ -3397,6 +3438,7 @@ proc ::tcl::clock::LoadZoneinfoFile { fileName } { binary scan $d @${seek}I${nTime}c${nTime} times tempCodes incr seek [expr { 5 * $nTime }] set times [linsert $times 0 $MINWIDE] + set codes {} foreach c $tempCodes { lappend codes [expr { $c & 0xff }] } diff --git a/tests/clock.test b/tests/clock.test index bba7feb..5736dfc 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: clock.test,v 1.35 2004/08/18 19:59:07 kennykb Exp $ +# RCS: @(#) $Id: clock.test,v 1.36 2004/08/18 20:59:34 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -19,7 +19,26 @@ if {[lsearch [namespace children] ::tcltest] == -1} { } if { $::tcl_platform(platform) eq {windows} } { - package require registry + if { [catch { package require registry 1.1 }] } { + + # HIDEOUS KLUDGE: [package require registry 1.1] has failed. + # This failure likely means that we're running in Tcl's build + # directory instead of the install directory. We recover by + # trying to load tclreg*.dll directly. + + if { [catch { + load [lindex \ + [glob -directory \ + [file join \ + [pwd] \ + [file dirname [info nameofexecutable]]] \ + tclReg*.dll] \ + 0] registry + }] } { + # Still no registry! + namespace eval ::tcl::clock [set NoRegistry {}] + } + } } package require msgcat 1.4 diff --git a/win/Makefile.in b/win/Makefile.in index 06c9a7b..ac2ea0d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -5,7 +5,7 @@ # "autoconf" program (constructs like "@foo@" will get replaced in the # actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.79 2004/07/20 10:23:14 das Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.80 2004/08/18 20:59:35 kennykb Exp $ VERSION = @TCL_VERSION@ @@ -514,7 +514,7 @@ install-binaries: binaries $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.1; \ fi -install-libraries: libraries +install-libraries: libraries install-tzdata install-msgs @for i in $(prefix)/lib $(INCLUDE_INSTALL_DIR) \ $(SCRIPT_INSTALL_DIR); \ do \ @@ -573,6 +573,18 @@ install-libraries: libraries $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \ done; +install-tzdata: + @echo "Installing time zone data" + @TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + +install-msgs: + @echo "Installing message catalogs" + @TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \ + ./$(TCLSH) "$(ROOT_DIR)/tools/installData.tcl" \ + "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" + install-doc: doc # Optional target to install private headers diff --git a/win/makefile.vc b/win/makefile.vc index ec11e56..2df2cdb 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -12,7 +12,7 @@ # Copyright (c) 2001-2004 David Gravereaux. # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.129 2004/06/24 01:29:07 mistachkin Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.130 2004/08/18 20:59:36 kennykb Exp $ #------------------------------------------------------------------------------ !if !defined(MSDEVDIR) && !defined(MSVCDIR) @@ -863,7 +863,7 @@ install-binaries: @echo installing $(TCLSTUBLIBNAME) @$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\" -install-libraries: tclConfig +install-libraries: tclConfig install-msgs install-tzdata @echo installing tclConfig.sh @$(CPY) "$(OUT_DIR)\tclConfig.sh" "$(LIB_INSTALL_DIR)\" @echo installing http1.0 @@ -914,6 +914,17 @@ install-libraries: tclConfig @$(CPY) "$(ROOT)\library\word.tcl" "$(SCRIPT_INSTALL_DIR)\" @$(CPY) "$(ROOT)\library\auto.tcl" "$(SCRIPT_INSTALL_DIR)\" +install-tzdata: + @echo "Installing time zone data" + set TCL_LIBRARY="$(ROOT)/library" + $(TCLSH) "$(ROOT)/tools/installData.tcl" \ + "$(ROOT)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata" + +install-msgs: + @echo "Installing message catalogs" + set TCL_LIBRARY="$(ROOT)/library" + $(TCLSH) "$(ROOT)/tools/installData.tcl" \ + "$(ROOT)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs" #--------------------------------------------------------------------- # Clean up |