Index: library/clock.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/clock.tcl,v
retrieving revision 1.20
diff -u -r1.20 clock.tcl
--- library/clock.tcl	4 Nov 2005 20:13:30 -0000	1.20
+++ library/clock.tcl	20 Nov 2005 14:23:51 -0000
@@ -638,13 +638,11 @@
 #
 #----------------------------------------------------------------------
 
-proc ::tcl::clock::format { args } {
-
-    set format {}
+proc ::tcl::clock::format { {clockval {}} args } {
 
     # Check the count of args
 
-    if { [llength $args] < 1 || [llength $args] % 2 != 1 } {
+    if { ($clockval eq {}) || [llength $args] % 2 } {
 	return -code error \
 	    -errorcode [list CLOCK wrongNumArgs] \
 	    "wrong \# args: should be\
@@ -653,9 +651,36 @@
              ?-locale LOCALE? ?-timezone ZONE?\""
     }
 
+    set procName formatproc'$args'
+    if { [info procs $procName] eq {} } {
+	set status [catch {
+	    MakeFormatProc $procName $args
+	} result opts]
+    } else {
+	set status 0
+    }
+
+    if {!$status} {
+	set status [catch {
+	    $procName $clockval
+	} result opts]
+    }
+
+    if { $status == 1 } {
+	if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
+	    return -code error $result
+	} else {
+	    return -options $opts $result
+	}
+    } else {
+	return $result
+    }
+}
+
+proc ::tcl::clock::MakeFormatProc {procName argList} {
+
     # Set defaults
 
-    set clockval [lindex $args 0]
     set format {%a %b %d %H:%M:%S %z %Y}
     set gmt 0
     set locale C
@@ -663,7 +688,7 @@
 
     # Pick up command line options.
 
-    foreach { flag value } [lreplace $args 0 0] {
+    foreach { flag value } $argList {
 	set saw($flag) {}
 	switch -exact -- $flag {
 	    -format {
@@ -694,10 +719,6 @@
 	    -errorcode [list CLOCK gmtWithTimezone] \
 	    "cannot use -gmt and -timezone in same call"
     }
-    if { [catch { expr { wide($clockval) } } result] } {
-	return -code error \
-	    "expected integer but got \"$clockval\"" 
-    }
     if { ![string is boolean $gmt] } {
 	return -code error \
 	    "expected boolean value but got \"$gmt\""
@@ -707,6 +728,26 @@
 	}
     }
 
+    set procBody [string map [list @TMZ@ $timezone] {
+	if { [catch { expr { wide($clockval) } } result] } {
+	    return -code error \
+		"expected integer but got \"$clockval\"" 
+	}
+
+	# Convert the given time to local time.
+
+	set date [dict create seconds $clockval]
+	set date [ConvertUTCToLocal $date[set date {}] @TMZ@]
+
+	# Extract the fields of the date.
+
+	set date [GetJulianDay $date[set date {}]]
+	set date [GetGregorianEraYearDay $date[set date {}]]
+	set date [GetMonthDay $date[set date {}]]
+	set date [GetYearWeekDay $date[set date {}]]
+	set localSeconds [dict get $date localSeconds]
+    }]
+
     EnterLocale $locale oldLocale
 
     # Change locale if a fresh locale has been given on the command line.
@@ -717,143 +758,141 @@
 
 	set format [LocalizeFormat $locale $format]
 
-	# Convert the given time to local time.
-	
-	set date [dict create seconds $clockval]
-	set date [ConvertUTCToLocal $date[set date {}] $timezone]
-	
-	# Extract the fields of the date.
-	
-	set date [GetJulianDay $date[set date {}]]
-	set date [GetGregorianEraYearDay $date[set date {}]]
-	set date [GetMonthDay $date[set date {}]]
-	set date [GetYearWeekDay $date[set date {}]]
-	
-	# Format the result
-	
+	# Prepare the format string and arguments to [format]
+
 	set state {}
-	set retval {}
+	set formatString {}
+	set formatArgs {}
+
 	foreach char [split $format {}] {
 	    switch -exact -- $state {
 		{} {
 		    if { [string equal % $char] } {
 			set state percent
 		    } else {
-			append retval $char
+			append formatString $char
 		    }
 		}
 		percent {		# Character following a '%' character
 		    set state {}
 		    switch -exact -- $char {
 			% {		# A literal character, '%'
-			    append retval %
+			    append formatString %%
 			}
 			a {		# Day of week, abbreviated
-			    set dow [expr { [dict get $date dayOfWeek] % 7 }]
-			    append retval \
-				[lindex [mc DAYS_OF_WEEK_ABBREV] $dow]
+			    append formatString %s
+			    set smap [list @DOW@ \{[mc DAYS_OF_WEEK_ABBREV]\}]
+			    append formatArgs [string map $smap \
+				    { [lindex @DOW@ [expr {[dict get $date dayOfWeek]%7}]] }] 
 			}
 			A {		# Day of week, spelt out.
-			    set dow [expr { [dict get $date dayOfWeek] % 7 }]
-			    append retval [lindex [mc DAYS_OF_WEEK_FULL] $dow]
+			    append formatString %s
+			    set smap [list @DOW@ \{[mc DAYS_OF_WEEK_FULL]\}]
+			    append formatArgs [string map $smap \
+				    { [lindex @DOW@ [expr {[dict get $date dayOfWeek]%7}]] }] 
 			}
 			b - h {		# Name of month, abbreviated.
-			    set month [expr { [dict get $date month] - 1 }]
-			    append retval [lindex [mc MONTHS_ABBREV] $month]
+			    append formatString %s
+			    set smap [list @MTH@ \{[mc MONTHS_ABBREV]\}]
+			    append formatArgs [string map $smap\
+			            { [lindex @MTH@ [expr {[dict get $date month]-1}]] }] 
 			}
 			B {		# Name of month, spelt out
-			    set month [expr { [dict get $date month] - 1 }]
-			    append retval [lindex [mc MONTHS_FULL] $month]
+			    append formatString %s
+			    set smap [list @MTH@ \{[mc MONTHS_FULL]\}]
+			    append formatArgs [string map $smap\
+			            { [lindex @MTH@ [expr {[dict get $date month]-1}]] }] 
 			}
 			C {		# Century number
-			    set cent [expr { [dict get $date year] / 100 }]
-			    append retval [::format %02d $cent]
+			    append formatString %02d
+			    append formatArgs { [
+			        expr { [dict get $date year]/100 }
+			       ] }
 			}
 			d {		# Day of month, with leading zero
-			    append retval [::format %02d \
-					       [dict get $date dayOfMonth]]
+			    append formatString %02d
+			    append formatArgs { [dict get $date dayOfMonth] }
 			}
 			e {		# Day of month, without leading zero
-			    append retval [::format %2d \
-					       [dict get $date dayOfMonth]]
+			    append formatString %2d
+			    append formatArgs { [dict get $date dayOfMonth] }
 			}
 			E {		# Format group in a locale-dependent
 					# alternative era
 			    set state percentE
-			    if { ![dict exists $date localeEra] } {
-				set date [GetLocaleEra $date[set date {}]]
+			    if {![info exists percentEUsed]} {
+				set percentEUsed 1
+				append procBody [string map [list @LOC@ $locale] {
+				    EnterLocale @LOC@ oldLocale
+				    set date [GetLocaleEra $date[set date {}]]
+				    mclocale $oldLocale
+				}]
 			    }
 			}
 			g {		# Two-digit year relative to ISO8601
 					# week number
-			    set year \
-				[expr { [dict get $date iso8601Year] % 100 }]
-			    append retval [::format %02d $year]
+			    append formatString %02d
+			    append formatArgs { \
+			            [expr { [dict get $date iso8601Year] % 100 }] }
 			}
 			G {		# Four-digit year relative to ISO8601
 					# week number
-			    append retval [::format %04d \
-					       [dict get $date iso8601Year]]
+			    append formatString %04d
+			    append formatArgs { [dict get $date iso8601Year] }
 			}
 			H {		# Hour in the 24-hour day, leading zero
-			    append retval \
-				[::format %02d \
-				     [expr { [dict get $date localSeconds] 
-					     / 3600
-					     % 24 }]]
+			    append formatString %02d
+			    append formatArgs { \
+			            [expr { $localSeconds / 3600 % 24 }] }
 			}
 			I {		# Hour AM/PM, with leading zero
-			    set hour12 \
-				[expr { ( ( ( [dict get $date localSeconds]
-					      % 86400 )
-					    + 86400
-					    - 3600 )
-					  / 3600 )
-					% 12 + 1 }]
-			    append retval [::format %02d $hour12]
+			    append formatString %02d
+			    append formatArgs { \
+			            [expr { ( ( ( $localSeconds
+						  % 86400 )
+						+ 86400
+						- 3600 )
+					      / 3600 )
+					    % 12 + 1 }] }
 			}
 			j {		# Day of year (001-366)
-			    append retval [::format %03d \
-					       [dict get $date dayOfYear]]
+			    append formatString %03d
+			    append formatArgs { [dict get $date dayOfYear] }
 			}
 			J {		# Julian Day Number
-			    append retval [::format %07ld \
-					       [dict get $date julianDay]]
+			    append formatString %07ld
+			    append formatArgs { [dict get $date julianDay] }
 			}
 			k {		# Hour (0-23), no leading zero
-			    append retval \
-				[::format %2d \
-				     [expr { [dict get $date localSeconds] 
-					     / 3600
-					     % 24 }]]
+			    append formatString %2d
+			    append formatArgs { \
+			            [expr { $localSeconds / 3600 % 24 }] }
 			}
 			l {		# Hour (12-11), no leading zero
-			    set hour12 \
-				[expr { ( ( ( [dict get $date localSeconds]
-					      % 86400 )
-					    + 86400
-					    - 3600 )
-					  / 3600 )
-					% 12 + 1 }]
-			    append retval [::format %2d $hour12]
+			    append formatString %2d
+			    append formatArgs { \
+			            [expr { ( ( ( $localSeconds
+						  % 86400 )
+						+ 86400
+						- 3600 )
+					      / 3600 )
+					    % 12 + 1 }] }
 			}
 			m {		# Month number, leading zero
-			    append retval [::format %02d \
-					       [dict get $date month]]
+			    append formatString %02d
+			    append formatArgs { [dict get $date month] }
 			}
 			M {		# Minute of the hour, leading zero
-			    append retval \
-				[::format %02d \
-				     [expr { [dict get $date localSeconds] 
-					     / 60
-					     % 60 }]]
+			    append formatString %02d
+			    append formatArgs { \
+				     [expr { $localSeconds / 60 % 60 }] }
 			}
 			n {		# A literal newline
-			    append retval \n
+			    append formatString \n
 			}
 			N {		# Month number, no leading zero
-			    append retval [::format %2d \
-					       [dict get $date month]]
+			    append formatString %2d
+			    append formatArgs { [dict get $date month] }
 			}
 			O {		# A format group in the locale's
 					# alternative numerals
@@ -861,97 +900,105 @@
 			}
 			p {		# Localized 'AM' or 'PM' indicator
 					# converted to uppercase
-			    set tod [expr { [dict get $date localSeconds] 
-					    % 86400 }]
-			    if { $tod >= ( 86400 / 2 ) } {
-				append retval [string toupper [mc PM]]
-			    } else {
-				append retval [string toupper [mc AM]]
-			    }
+			    append formatString %s
+			    set smap  [list \
+					  @PM@ [string toupper [mc PM]] \
+					  @AM@ [string toupper [mc AM]]]
+			    append formatArgs [string map $smap { \
+			            [set tod [expr { $localSeconds % 86400 }];\
+				     expr {($tod >= ( 86400 / 2 ))? 
+					   "@PM@" : "@AM@" }] }]
 			}
 			P {		# Localized 'AM' or 'PM' indicator
-			    set tod [expr { [dict get $date localSeconds] 
-					    % 86400 }]
-			    if { $tod >= ( 86400 / 2 ) } {
-				append retval [mc PM]
-			    } else {
-				append retval [mc AM]
-			    }
+			    append formatString %s
+			    set smap  [list @PM@ [mc PM] @AM@ [mc AM]]
+			    append formatArgs [string map $smap { \
+			            [set tod [expr { $localSeconds % 86400 }];\
+				     expr {($tod >= ( 86400 / 2 ))? 
+					   "@PM@" : "@AM@" }] }]
 			}
 			Q {			# Hi, Jeff!
-			    append retval [FormatStarDate $date]
+			    append formatString %s
+			    append formatArgs { [FormatStarDate $date] }
 			}
 			s {		# Seconds from the Posix Epoch
-			    append retval $clockval
+			    append formatString %s
+			    append formatArgs { $clockval }
 			}
 			S {		# Second of the minute, with 
 					# leading zero
-			    append retval \
-				[::format %02d \
-				     [expr { [dict get $date localSeconds] 
-					     % 60 }]]
+			    append formatString %02d
+			    append formatArgs { [expr { $localSeconds % 60}] }
 			}
 			t {		# A literal tab character
-			    append retval \t
+			    append formatString \t
 			}
 			u {		# Day of the week (1-Monday, 7-Sunday)
-			    append retval [dict get $date dayOfWeek]
+			    append formatString %s
+			    append formatArgs { [dict get $date dayOfWeek] }
 			}
 			U {		# Week of the year (00-53). The
 					# first Sunday of the year is the
 					# first day of week 01
-			    set dow [dict get $date dayOfWeek]
-			    if { $dow == 7 } {
-				set dow 0
-			    }
-			    incr dow
-			    set weekNumber \
-				[expr { ( [dict get $date dayOfYear] 
-					  - $dow + 7 )
-					/ 7 }]
-			    append retval [::format %02d $weekNumber]
+			    append formatString %02d
+			    append formatArgs { [
+			            set dow [dict get $date dayOfWeek]
+				    if { $dow == 7 } {
+					set dow 0
+				    }
+				    incr dow
+				    expr { ( [dict get $date dayOfYear] 
+					  - $dow + 7 ) / 7 }
+				   ] }
 			}
 			V {		# The ISO8601 week number
-			    append retval [::format %02d \
-					       [dict get $date iso8601Week]]
+			    append formatString %02d
+			    append formatArgs { [dict get $date iso8601Week] }
 			}
 			w {		# Day of the week (0-Sunday,
 					# 6-Saturday)
-			    append retval \
-				[expr { [dict get $date dayOfWeek] % 7 }]
+			    append formatString %s
+			    append formatArgs { [
+			        expr { [dict get $date dayOfWeek] % 7 }
+			       ] }
 			}
 			W {		# Week of the year (00-53). The first
 					# Monday of the year is the first day
 					# of week 01.
-			    set weekNumber \
-				[expr { ( [dict get $date dayOfYear]
-					  - [dict get $date dayOfWeek]
-					  + 7 ) 
-					/ 7 }]
-			    append retval [::format %02d $weekNumber]
+			    append formatString %02d
+			    append formatArgs { [
+			        expr { ( [dict get $date dayOfYear]
+					 - [dict get $date dayOfWeek]
+					 + 7 ) 
+				       / 7 }
+			       ] }
 			}
 			y {		# The two-digit year of the century
-			    append retval \
-				[::format %02d \
-				     [expr { [dict get $date year] % 100 }]]
+			    append formatString %02d
+			    append formatArgs { [
+			            expr { [dict get $date year] % 100 }
+				   ] }
 			}
 			Y {		# The four-digit year
-			    append retval [::format %04d \
-					       [dict get $date year]]
+			    append formatString %04d
+			    append formatArgs { [dict get $date year] }
 			}
 			z {		# The time zone as hours and minutes
 					# east (+) or west (-) of Greenwich
-			    append retval [FormatNumericTimeZone \
-					       [dict get $date tzOffset]]
+			    append formatString %s
+			    append formatArgs { [
+			            FormatNumericTimeZone [dict get $date tzOffset] 
+				   ] }
 			}
 			Z {		# The name of the time zone
-			    append retval [dict get $date tzName]
+			    append formatString %s
+			    append formatArgs { [dict get $date tzName] }
 			}
 			% {		# A literal percent character
-			    append retval %
+			    append formatArgs %%
 			}
 			default {	# An unknown escape sequence
-			    append retval % $char
+			    append formatString %%$char
 			}
 		    }
 		}
@@ -959,18 +1006,20 @@
 		    set state {}
 		    switch -exact -- $char {
 			C {		# Locale-dependent era
-			    append retval [dict get $date localeEra]
+			    append formatString %s
+			    append formatArgs { [dict get $date localeEra] }
 			}
 			y {		# Locale-dependent year of the era
-			    set y [dict get $date localeYear]
-			    if { $y >= 0 && $y < 100 } {
-				append retval [lindex [mc LOCALE_NUMERALS] $y]
-			    } else {
-				append retval $y
-			    }
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+			        set y [dict get $date localeYear]
+				expr {($y >= 0 && $y < 100) ?
+				     [lindex @LN@ $y] : $y }
+			       ] }]
 			}
 			default {	# Unknown format group
-			    append retval %E $char
+			    append formatString %%E$char
 			}
 		    }
 		}
@@ -979,68 +1028,89 @@
 		    switch -exact -- $char {
 			d - e {		# Day of the month in alternative 
 					# numerals
-			    append retval [lindex \
-					       [mc LOCALE_NUMERALS] \
-					       [dict get $date dayOfMonth]]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+			        lindex @LN@ [dict get $date dayOfMonth]
+			       ] }]
 			}
 			H - k {		# Hour of the day in alternative
 					# numerals
-			    set hour [expr { [dict get $date localSeconds] 
-					     / 3600
-					     % 24 }]
-			    append retval [lindex [mc LOCALE_NUMERALS] $hour]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+				set hour [expr { $localSeconds / 3600 % 24 }]
+			        lindex @LN@ $hour
+			       ] }]
 			}
 			I - l {		# Hour (12-11) AM/PM in alternative
 					# numerals
-			    set hour12 \
-				[expr { ( ( ( [dict get $date localSeconds]
-					      % 86400 )
-					    + 86400
-					    - 3600 )
-					  / 3600 )
-					% 12 + 1 }]
-			    append retval [lindex [mc LOCALE_NUMERALS] $hour12]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+				set hour12 [expr { 
+				    ( ( ( $localSeconds
+					  % 86400 )
+					+ 86400
+					- 3600 )
+				      / 3600 )
+				    % 12 + 1 }]
+			        lindex @LN@ $hour12
+			       ] }]
 			}
 			m {		# Month number in alternative numerals
-			    append retval [lindex \
-					       [mc LOCALE_NUMERALS] \
-					       [dict get $date month]]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+			        lindex @LN@ [dict get $date month]
+			       ] }] 
 			}
 			M {		# Minute of the hour in alternative
 					# numerals
-			    set minute [expr { [dict get $date localSeconds] 
-					       / 60
-					       % 60 }]
-			    append retval [lindex [mc LOCALE_NUMERALS] $minute]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+			        set minute [expr { $localSeconds 
+						   / 60
+						   % 60 }]
+				lindex @LN@ $minute
+			       ] }]
 			}
 			S {		# Second of the minute in alternative
 					# numerals
-			    set second [expr { [dict get $date localSeconds] 
-					       % 60 }]
-			    append retval [lindex [mc LOCALE_NUMERALS] $second]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+			        set second [expr { $localSeconds% 60 }]
+				lindex @LN@ $second
+			       ] }]
 			}
 			u {		# Day of the week (Monday=1,Sunday=7)
 					# in alternative numerals
-			    append retval [lindex \
-					       [mc LOCALE_NUMERALS] \
-					       [dict get $date dayOfWeek]]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+			        lindex @LN@ [dict get $date dayOfWeek]
+			       ] }]
 			}
 			w {		# Day of the week (Sunday=0,Saturday=6)
 					# in alternative numerals
-			    append retval \
-				[lindex \
-				     [mc LOCALE_NUMERALS] \
-				     [expr { [dict get $date dayOfWeek] % 7 }]]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+			        lindex @LN@ [expr {[dict get $date dayOfWeek]%7}]
+			       ] }]
 			}
 			y {		# Year of the century in alternative
 					# numerals
-			    append retval \
-				[lindex \
-				     [mc LOCALE_NUMERALS] \
-				     [expr { [dict get $date year] % 100 }]]
+			    append formatString %s
+			    set smap [list @LN@ \{[mc LOCALE_NUMERALS]\}]
+			    append formatArgs [string map $smap { [
+			        lindex @LN@ [expr { [dict get $date year] % 100 }]
+			   ] }]
 			}
 			default {	# Unknown format group
-			    append retval %O $char
+			    append formatString %%O$char
 			}
 		    }
 		}
@@ -1051,18 +1121,16 @@
 	
 	switch -exact -- $state {
 	    percent {
-		append retval %
+		append formatString %%
 	    }
 	    percentE {
-		append retval %E
+		append formatString %%E
 	    }
 	    percentO {
-		append retval %O
+		append formatString %%O
 	    }
 	}
 
-	set retval
-
     } result opts]
 
     # Restore the locale
@@ -1078,7 +1146,8 @@
 	    return -options $opts $result
 	}
     } else {
-	return $result
+	append procBody "::format \"$formatString\" $formatArgs\n"
+	proc $procName clockval $procBody
     }
 
 }
