Index: openacs-4/packages/acs-templating/tcl/currency-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/currency-procs.tcl,v diff -u -N -r1.2 -r1.2.2.1 --- openacs-4/packages/acs-templating/tcl/currency-procs.tcl 9 Feb 2002 02:33:35 -0000 1.2 +++ openacs-4/packages/acs-templating/tcl/currency-procs.tcl 12 May 2002 20:28:34 -0000 1.2.2.1 @@ -128,29 +128,87 @@ # is not completely erased set value [template::util::leadingTrim $value] + set format [lindex $currency_list 5] + switch $what { sql_number { - set value_parts [split $value "."] - set new_value [lreplace $currency_list 1 1 [lindex $value_parts 0]] - return [lreplace $new_value 3 3 [lindex $value_parts 1]] + + if { [empty_string_p $value]} { + return "" + } + + foreach {whole_part fractional_part} [split $value "."] { + # Make sure we have at least one leading digit, i.e. zero + set whole_part "[string range "0" [string length $whole_part] end]$whole_part" + + # Chop off trailing digits beyond those called for by the given format + set fractional_part "[string range $fractional_part 0 [expr {[lindex $format 3] - 1}]]" + } + set new_value [lreplace $currency_list 1 1 $whole_part] + return [lreplace $new_value 3 3 $fractional_part] } } } ad_proc -public template::util::currency::get_property { what currency_list } { - # There's no internal error checking, just like the date version ... + # There's no internal error checking, just like the date version ... and + # of course whole_part might be pounds and fractional_part pfennings ... + set leading_symbol [lindex $currency_list 0] + set whole_part [lindex $currency_list 1] + set separator [lindex $currency_list 2] + set fractional_part [lindex $currency_list 3] + set trailing_money [lindex $currency_list 4] + set format [lindex $currency_list 5] + switch $what { + leading_symbol { + return $leading_symbol + } + whole_part { + return $whole_part + } + separator { + return $separator + } + fractional_part { + return $fractional_part + } + trailing_money { + return $trailing_money + } + format { + return $format + } sql_number { - set sql_number "[lindex $currency_list 1].[lindex $currency_list 3]" - if { [string equal $sql_number "."] } { - # No value hack ... + + if { [empty_string_p $whole_part] && [empty_string_p $fractional_part] } { return "" - } else { - return $sql_number } + + # Make sure we have at least one leading digit, i.e. zero + set whole_part "[string range "0" [string length $whole_part] end]$whole_part" + + # Pad out the fractional part with enough leading zeros to satisfy the format + set fractional_part "[string range [string repeat "0" [lindex $format 3]] [string length $fractional_part] end]$fractional_part" + return ${whole_part}.${fractional_part} } + display_currency { + + if { [empty_string_p $whole_part] && [empty_string_p $fractional_part] } { + return "" + } + + # Make sure we have at least one leading digit, i.e. zero + set whole_part "[string range "0" [string length $whole_part] end]$whole_part" + + # Pad out the fractional part with enough leading zeros to satisfy the format + set fractional_part "[string range [string repeat "0" [lindex $format 3]] [string length $fractional_part] end]$fractional_part" + + # Glom everything into one pretty picture + return "$leading_symbol$whole_part$separator$fractional_part$trailing_money" + } } } Index: openacs-4/packages/acs-templating/tcl/date-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/date-procs.tcl,v diff -u -N -r1.8.2.1 -r1.8.2.2 --- openacs-4/packages/acs-templating/tcl/date-procs.tcl 10 Mar 2002 00:00:56 -0000 1.8.2.1 +++ openacs-4/packages/acs-templating/tcl/date-procs.tcl 12 May 2002 20:28:34 -0000 1.8.2.2 @@ -224,14 +224,11 @@ set value "" set format "" set space "" + set pad "0000" foreach { index sql_form } { 0 YYYY 1 MM 2 DD 3 HH24 4 MI 5 SS } { set piece [lindex $date $index] if { ![string equal $piece {}] } { - append value $space - if { [string length $piece] == 1 } { - append value "0" - } - append value $piece + append value "$space[string range $pad [string length $piece] end]$piece" append format $space append format $sql_form set space " " @@ -244,17 +241,38 @@ # For use with karl's non-working form builder API set clipped_date [lrange $date 0 5] set ret [list] + set pad "0000" foreach fragment $clipped_date { - if { [string equal $fragment {}] } { - lappend ret "00" - } elseif {[string length $fragment] == 1} { - lappend ret "0$fragment" - } else { - lappend ret $fragment - } + lappend ret "[string range $pad [string length $fragment] end]$fragment" + set pad "00" } return $ret } + display_date { + + # Return a beautified date. It should use the widget format string but DRB + # doesn't have the time to dive into that today. The simple hack would be + # to use the database's to_char() function to do the conversion but that's + # not a terribly efficient thing to do. + + set clipped_date [lrange $date 0 2] + set date_list [list] + set pad "0000" + foreach fragment $clipped_date { + lappend date_list "[string range $pad [string length $fragment] end]$fragment" + set pad "00" + } + set value [util_AnsiDatetoPrettyDate [join $date_list "-"]] + unpack $date + if { ![string equal $hours {}] && \ + ![string equal $minutes {}] } { + append value " ${hours}:${minutes}" + if { ![string equal $seconds {}] } { + append value ":$seconds" + } + } + return $value + } clock { set value "" # Unreliable ! @@ -279,7 +297,14 @@ # Perform date comparison; same syntax as string compare ad_proc -public template::util::date::compare { date1 date2 } { - return [string compare [get_property clock $date1] [get_property clock $date2]] + for { set i 0 } { $i < 5 } { incr i } { + if { [lindex $date1 $i] < [lindex $date2 $i] } { + return -1 + } elseif { [lindex $date1 $i] > [lindex $date2 $i] } { + return 1 + } + } + return 0 } # mutate properties of the Date object Index: openacs-4/packages/acs-templating/tcl/element-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-templating/tcl/element-procs.tcl,v diff -u -N -r1.2.2.1 -r1.2.2.2 --- openacs-4/packages/acs-templating/tcl/element-procs.tcl 13 Mar 2002 19:12:55 -0000 1.2.2.1 +++ openacs-4/packages/acs-templating/tcl/element-procs.tcl 12 May 2002 20:28:34 -0000 1.2.2.2 @@ -375,6 +375,26 @@ set formerror($element_id) $message } +# @public error_p + +# Return true if the named element has an error set. Helpful for client code +# that wants to avoid overwriting an initial error message. + +# @param form_id The identifier of the form containing the element. +# @param element_id The unique identifier of the element with which +# the error message should be associated in the form +# template. + +ad_proc -public template::element::error_p { form_id element_id } { + + set level [template::adp_level] + + upvar #$level $form_id:error formerror + + # set the message + return [info exists formerror($element_id)] +} + # Get all values for an element, performing any transformation defined # for the datatype.