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 -r1.63.2.7 -r1.63.2.8
--- openacs-4/packages/acs-templating/tcl/date-procs.tcl 1 Feb 2021 10:54:23 -0000 1.63.2.7
+++ openacs-4/packages/acs-templating/tcl/date-procs.tcl 18 Aug 2021 13:40:30 -0000 1.63.2.8
@@ -27,64 +27,71 @@
namespace eval template::data::to_sql {}
namespace eval template::data::from_sql {}
-ad_proc -public template::util::date { command args } {
+ad_proc -public template::util::date {
+ command
+ args
+} {
Dispatch procedure for the date object
} {
- template::util::date::$command {*}$args
+ template::util::date::$command {*}$args
}
ad_proc -public template::util::date::init {} {
- Sets up some initial variables and other conditions
- to facilitate the data structure template::util::date
- working properly and completely.
+ Sets up some initial variables and other conditions to facilitate
+ the data structure template::util::date working properly and
+ completely.
} {
- variable month_data
- variable fragment_widgets
- variable fragment_formats
- variable token_exp
+ variable month_data
+ variable fragment_widgets
+ variable fragment_formats
+ variable token_exp
- array set month_data {
- 1 {January Jan 31}
- 2 {February Feb 28}
- 3 {March Mar 31}
- 4 {April Apr 30}
- 5 {May May 31}
- 6 {June Jun 30}
- 7 {July Jul 31}
- 8 {August Aug 31}
- 9 {September Sep 30}
- 10 {October Oct 31}
- 11 {November Nov 30}
- 12 {December Dec 31}
- }
+ array set month_data {
+ 1 {January Jan 31}
+ 2 {February Feb 28}
+ 3 {March Mar 31}
+ 4 {April Apr 30}
+ 5 {May May 31}
+ 6 {June Jun 30}
+ 7 {July Jul 31}
+ 8 {August Aug 31}
+ 9 {September Sep 30}
+ 10 {October Oct 31}
+ 11 {November Nov 30}
+ 12 {December Dec 31}
+ }
- # Forward lookup
+ # Forward lookup
- # Bug# 1176
- array set fragment_widgets [list \
- YYYY [list dateFragment year 4 [_ acs-templating.Year]] \
- YY [list dateFragment short_year 2 [_ acs-templating.Year]] \
- MM [list dateFragment month 2 [_ acs-templating.Month]] \
- MON [list monthFragment month short [_ acs-templating.Month]] \
- MONTH [list monthFragment month long [_ acs-templating.Month]] \
- DD [list dateFragment day 2 [_ acs-templating.Day]] \
- HH12 [list dateFragment short_hours 2 [_ acs-templating.12-Hour]] \
- HH24 [list dateFragment hours 2 [_ acs-templating.24-Hour]] \
- MI [list dateFragment minutes 2 [_ acs-templating.Minutes]] \
- SS [list dateFragment seconds 2 [_ acs-templating.Seconds]] \
- AM [list ampmFragment ampm 2 [_ acs-templating.Meridian]] \
- ]
+ # Bug# 1176
+ array set fragment_widgets \
+ [list \
+ YYYY [list dateFragment year 4 [_ acs-templating.Year]] \
+ YY [list dateFragment short_year 2 [_ acs-templating.Year]] \
+ MM [list dateFragment month 2 [_ acs-templating.Month]] \
+ MON [list monthFragment month short [_ acs-templating.Month]] \
+ MONTH [list monthFragment month long [_ acs-templating.Month]] \
+ DD [list dateFragment day 2 [_ acs-templating.Day]] \
+ HH12 [list dateFragment short_hours 2 [_ acs-templating.12-Hour]] \
+ HH24 [list dateFragment hours 2 [_ acs-templating.24-Hour]] \
+ MI [list dateFragment minutes 2 [_ acs-templating.Minutes]] \
+ SS [list dateFragment seconds 2 [_ acs-templating.Seconds]] \
+ AM [list ampmFragment ampm 2 [_ acs-templating.Meridian]] \
+ ]
- # Reverse lookup
- foreach key [array names fragment_widgets] {
- set fragment_formats([lindex $fragment_widgets($key) 1]) $key
- }
+ # Reverse lookup
+ foreach key [array names fragment_widgets] {
+ set fragment_formats([lindex $fragment_widgets($key) 1]) $key
+ }
- # Expression to match any valid format token
- set token_exp "([join [array names fragment_widgets] |])(t*)"
+ # Expression to match any valid format token
+ set token_exp "([join [array names fragment_widgets] |])(t*)"
}
-ad_proc -public template::util::date::monthName { month length } {
+ad_proc -public template::util::date::monthName {
+ month
+ length
+} {
Return the specified month name (short or long)
} {
# trim leading zeros to avoid octal problem
@@ -96,8 +103,10 @@
}
}
-
-ad_proc -public template::util::date::daysInMonth { month {year 0} } {
+ad_proc -public template::util::date::daysInMonth {
+ month
+ {year 0}
+} {
@return the number of days in a month, accounting for leap years
LOOKATME: IS THE LEAP YEAR CODE CORRECT ?
} {
@@ -128,23 +137,26 @@
{seconds {}}
{format "DD MONTH YYYY"}
} {
- Create a new Date object
+ Create a new Date object.
I chose to implement the date objects as lists instead of
arrays, because arrays are not first-class in Tcl
} {
- return [list $year $month $day $hours $minutes $seconds $format]
+ return [list $year $month $day $hours $minutes $seconds $format]
}
-ad_proc -public template::util::date::acquire { type { value "" } } {
- Create a new date with some predefined value
- Basically, create and set the date
+ad_proc -public template::util::date::acquire {
+ type
+ {value ""}
} {
- set the_date [template::util::date::create]
- return [template::util::date::set_property $type $the_date $value]
+ Create a new date with some predefined value. Basically, create
+ and set the date.
+} {
+ set the_date [template::util::date::create]
+ return [template::util::date::set_property $type $the_date $value]
}
ad_proc -public template::util::date::today {} {
- Create a new Date object for the current date
+ Create a new Date object for the current date.
} {
set now [clock format [clock seconds] -format "%Y %m %d"]
@@ -159,14 +171,14 @@
}
ad_proc -public template::util::date::now {} {
- Create a new Date object for the current date and time
+ Create a new Date object for the current date and time.
} {
- set now [clock format [clock seconds] -format "%Y %m %d %H %M %S"]
- set today [list]
+ set now [clock format [clock seconds] -format "%Y %m %d %H %M %S"]
+ set today [list]
- foreach v $now {
- lappend today [util::trim_leading_zeros $v]
- }
+ foreach v $now {
+ lappend today [util::trim_leading_zeros $v]
+ }
return [create {*}$today]
}
@@ -178,8 +190,11 @@
Create a new templating system date structure from a full ANSI
date, i.e. in the format YYYY-MM-DD HH24:MI:SS.
- @param ansi_date Date in full ANSI format YYYY-MM-DD HH24:MI:SS (time portion is optional).
- @param format Format for the date object. Optional, defaults to YYYY MM DD.
+ @param ansi_date Date in full ANSI format YYYY-MM-DD HH24:MI:SS
+ (time portion is optional).
+ @param format Format for the date object. Optional, defaults to
+ YYYY MM DD.
+
@return Date object for use with e.g. form builder.
@author Lars Pind (lars@pinds.com)
@creation-date November 18, 2002
@@ -190,7 +205,10 @@
return $date
}
-ad_proc -public template::util::date::get_property { what date } {
+ad_proc -public template::util::date::get_property {
+ what
+ date
+} {
Returns a property of a date list, usually created by ad_form.
@@ -217,201 +235,203 @@
@param date the date widget list
} {
+ variable month_data
- variable month_data
-
- switch -- $what {
- year { return [lindex $date 0] }
- month { return [lindex $date 1] }
- day { return [lindex $date 2] }
- hours { return [lindex $date 3] }
- minutes { return [lindex $date 4] }
- seconds { return [lindex $date 5] }
- format { return [lindex $date 6] }
- long_month_name {
- if {[lindex $date 1] eq ""} {
- return {}
- } else {
- return [monthName [lindex $date 1] long]
- }
- }
- short_month_name {
- if {[lindex $date 1] eq ""} {
- return {}
- } else {
- return [monthName [lindex $date 1] short]
- }
- }
- days_in_month {
- if { [lindex $date 1] eq "" || [lindex $date 0] eq "" } {
- return 31
- } else {
- return [daysInMonth [lindex $date 1] [lindex $date 0]]
- }
- }
- short_year {
- if {[lindex $date 0] eq ""} {
- return {}
- } else {
- return [expr {[lindex $date 0] % 100}]
- }
- }
- short_hours {
- if {[lindex $date 3] eq ""} {
- return {}
- } else {
- set value [expr {[lindex $date 3] % 12}]
- if { $value == 0 } {
- return 12
- } else {
- return $value
+ switch -- $what {
+ year { return [lindex $date 0] }
+ month { return [lindex $date 1] }
+ day { return [lindex $date 2] }
+ hours { return [lindex $date 3] }
+ minutes { return [lindex $date 4] }
+ seconds { return [lindex $date 5] }
+ format { return [lindex $date 6] }
+ long_month_name {
+ if {[lindex $date 1] eq ""} {
+ return {}
+ } else {
+ return [monthName [lindex $date 1] long]
+ }
}
- }
- }
- ampm {
- if {[lindex $date 3] eq ""} {
- return {}
- } else {
- if { [lindex $date 3] > 11 } {
- return "pm"
- } else {
- return "am"
+ short_month_name {
+ if {[lindex $date 1] eq ""} {
+ return {}
+ } else {
+ return [monthName [lindex $date 1] short]
+ }
}
- }
- }
- not_null {
- for { set i 0 } { $i < 6 } { incr i } {
- if { [lindex $date $i] ne {} } {
- return 1
+ days_in_month {
+ if { [lindex $date 1] eq "" || [lindex $date 0] eq "" } {
+ return 31
+ } else {
+ return [daysInMonth [lindex $date 1] [lindex $date 0]]
+ }
}
- }
- return 0
- }
- sql_date -
- sql_timestamp {
- # LARS: Empty date results in NULL value
- if { $date eq "" } {
- return "NULL"
- }
- 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 { $piece ne {} } {
- append value "$space[string range $pad [string length $piece] end]$piece"
- append format $space
- append format $sql_form
- set space " "
+ short_year {
+ if {[lindex $date 0] eq ""} {
+ return {}
+ } else {
+ return [expr {[lindex $date 0] % 100}]
+ }
}
- set pad "00"
- }
- # DRB: We need to differentiate between date and timestamp, for PG, at least,
- # and since Oracle supports to_timestamp() we'll just do it for both DBs.
- # DEDS: revert this first as to_timestamp is only for
- # oracle9i. no clear announcement that OpenACS has dropped
- # support for 8i
- if { [llength $date] <= 3 || ([db_type] eq "oracle" && [string match "8.*" [db_version]]) } {
- return "to_date('$value', '$format')"
- } else {
- return "to_timestamp('$value', '$format')"
- }
- }
- ansi {
- # LARS: Empty date results in NULL value
- if { $date eq "" } {
- return {}
- }
- set value ""
- set pad "0000"
- set prepend ""
- set clipped_date [lrange $date 0 2]
- foreach fragment $clipped_date {
- append value "$prepend[string range $pad [string length $fragment] end]$fragment"
- set pad "00"
- set prepend "-"
- }
- append value " "
- set prepend ""
- set clipped_time [lrange $date 3 5]
- foreach fragment $clipped_time {
- append value "$prepend[string range $pad [string length $fragment] end]$fragment"
- set prepend ":"
- }
- return $value
- }
- linear_date {
- # Return a date in format "YYYY MM DD HH24 MI SS"
- # 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 {
- lappend ret "[string range $pad [string length $fragment] end]$fragment"
- set pad "00"
- }
- return $ret
- }
- linear_date_no_time {
- # Return a date in format "YYYY MM DD"
- set clipped_date [lrange $date 0 2]
- set ret [list]
- set pad "0000"
- foreach fragment $clipped_date {
- lappend ret "[string range $pad [string length $fragment] end]$fragment"
- set pad "00"
- }
- return $ret
- }
- display_date {
+ short_hours {
+ if {[lindex $date 3] eq ""} {
+ return {}
+ } else {
+ set value [expr {[lindex $date 3] % 12}]
+ if { $value == 0 } {
+ return 12
+ } else {
+ return $value
+ }
+ }
+ }
+ ampm {
+ if {[lindex $date 3] eq ""} {
+ return {}
+ } else {
+ if { [lindex $date 3] > 11 } {
+ return "pm"
+ } else {
+ return "am"
+ }
+ }
+ }
+ not_null {
+ for { set i 0 } { $i < 6 } { incr i } {
+ if { [lindex $date $i] ne {} } {
+ return 1
+ }
+ }
+ return 0
+ }
+ sql_date -
+ sql_timestamp {
+ # LARS: Empty date results in NULL value
+ if { $date eq "" } {
+ return "NULL"
+ }
+ 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 { $piece ne {} } {
+ append value "$space[string range $pad [string length $piece] end]$piece"
+ append format $space
+ append format $sql_form
+ set space " "
+ }
+ set pad "00"
+ }
+ # DRB: We need to differentiate between date and timestamp, for PG, at least,
+ # and since Oracle supports to_timestamp() we'll just do it for both DBs.
+ # DEDS: revert this first as to_timestamp is only for
+ # oracle9i. no clear announcement that OpenACS has dropped
+ # support for 8i
+ if { [llength $date] <= 3 || ([db_type] eq "oracle" && [string match "8.*" [db_version]]) } {
+ return "to_date('$value', '$format')"
+ } else {
+ return "to_timestamp('$value', '$format')"
+ }
+ }
+ ansi {
+ # LARS: Empty date results in NULL value
+ if { $date eq "" } {
+ return {}
+ }
+ set value ""
+ set pad "0000"
+ set prepend ""
+ set clipped_date [lrange $date 0 2]
+ foreach fragment $clipped_date {
+ append value "$prepend[string range $pad [string length $fragment] end]$fragment"
+ set pad "00"
+ set prepend "-"
+ }
+ append value " "
+ set prepend ""
+ set clipped_time [lrange $date 3 5]
+ foreach fragment $clipped_time {
+ append value "$prepend[string range $pad [string length $fragment] end]$fragment"
+ set prepend ":"
+ }
+ return $value
+ }
+ linear_date {
+ # Return a date in format "YYYY MM DD HH24 MI SS"
+ # 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 {
+ lappend ret "[string range $pad [string length $fragment] end]$fragment"
+ set pad "00"
+ }
+ return $ret
+ }
+ linear_date_no_time {
+ # Return a date in format "YYYY MM DD"
+ set clipped_date [lrange $date 0 2]
+ set ret [list]
+ set pad "0000"
+ foreach fragment $clipped_date {
+ 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.
+ # 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 [lc_time_fmt [join $date_list "-"] "%q"]
- unpack $date
- if { $hours ne "" && $minutes ne "" } {
- append value " [string range $pad [string length $hours] end]${hours}:[string range $pad [string length $minutes] end]$minutes"
- if { $seconds ne {} } {
- append value ":[string range $pad [string length $seconds] end]$seconds"
- }
- }
- return $value
- }
- clock {
- set value ""
- # Unreliable !
- unpack $date
- if { $year ne "" && $month ne "" && $day ne "" } {
- append value "$month/$day/$year"
- }
- if { $hours ne "" && $minutes ne "" } {
- append value " ${hours}:${minutes}"
- if { $seconds ne "" } {
- append value ":$seconds"
+ 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 [lc_time_fmt [join $date_list "-"] "%q"]
+ unpack $date
+ if { $hours ne "" && $minutes ne "" } {
+ append value " [string range $pad [string length $hours] end]${hours}:[string range $pad [string length $minutes] end]$minutes"
+ if { $seconds ne {} } {
+ append value ":[string range $pad [string length $seconds] end]$seconds"
+ }
+ }
+ return $value
}
- }
- return [clock scan $value]
+ clock {
+ set value ""
+ # Unreliable !
+ unpack $date
+ if { $year ne "" && $month ne "" && $day ne "" } {
+ append value "$month/$day/$year"
+ }
+ if { $hours ne "" && $minutes ne "" } {
+ append value " ${hours}:${minutes}"
+ if { $seconds ne "" } {
+ append value ":$seconds"
+ }
+ }
+ return [clock scan $value]
+ }
+ default {
+ error "util::date::get_property: unknown property: '$what'."
+ }
}
- default {
- error "util::date::get_property: unknown property: '$what'."
- }
- }
}
-ad_proc -public template::util::date::compare { date1 date2 } {
- Perform date comparison; same syntax as string compare
+ad_proc -public template::util::date::compare {
+ date1
+ date2
} {
+ Perform date comparison; same syntax as string compare.
+} {
for { set i 0 } { $i < 5 } { incr i } {
if { [lindex $date1 $i] < [lindex $date2 $i] } {
return -1
@@ -422,7 +442,11 @@
return 0
}
-ad_proc -public template::util::date::set_property { what date value } {
+ad_proc -public template::util::date::set_property {
+ what
+ date
+ value
+} {
Replace a property in a list created by a date widget.
@@ -443,119 +467,123 @@
return $date
}
- # Erase leading zeros from the value, but make sure that 00
- # is not completely erased - but only for single-element properties
+ # Erase leading zeros from the value, but make sure that 00
+ # is not completely erased - but only for single-element properties
- switch -- $value {
- year - month - day - hour - minutes - seconds - short_year - short_hours - ampm {
- set value [util::trim_leading_zeros $value]
+ switch -- $value {
+ year - month - day - hour - minutes - seconds - short_year - short_hours - ampm {
+ set value [util::trim_leading_zeros $value]
+ }
}
- }
- switch -- $what {
- year { return [lreplace $date 0 0 $value] }
- month { return [lreplace $date 1 1 $value] }
- day { return [lreplace $date 2 2 $value] }
- hours { return [lreplace $date 3 3 $value] }
- minutes { return [lreplace $date 4 4 $value] }
- seconds { return [lreplace $date 5 5 $value] }
- format { return [lreplace $date 6 6 $value] }
- short_year {
- if { $value < 69 } {
- return [lreplace $date 0 0 [expr {$value + 2000}]]
- } else {
- return [lreplace $date 0 0 [expr {$value + 1900}]]
- }
- }
- short_hours {
- return [lreplace $date 3 3 $value]
- }
- ampm {
- if {[lindex $date 3] eq ""} {
- return $date
- } else {
- set hours [lindex $date 3]
-
- # robustness check: make sure we handle form of 08:00am --jfr
- if {[regexp {0([0-9])} $hours match trimmed_hours]} {
- if {$trimmed_hours ne ""} {
- set hours $trimmed_hours
+ switch -- $what {
+ year { return [lreplace $date 0 0 $value] }
+ month { return [lreplace $date 1 1 $value] }
+ day { return [lreplace $date 2 2 $value] }
+ hours { return [lreplace $date 3 3 $value] }
+ minutes { return [lreplace $date 4 4 $value] }
+ seconds { return [lreplace $date 5 5 $value] }
+ format { return [lreplace $date 6 6 $value] }
+ short_year {
+ if { $value < 69 } {
+ return [lreplace $date 0 0 [expr {$value + 2000}]]
+ } else {
+ return [lreplace $date 0 0 [expr {$value + 1900}]]
}
}
+ short_hours {
+ return [lreplace $date 3 3 $value]
+ }
+ ampm {
+ if {[lindex $date 3] eq ""} {
+ return $date
+ } else {
+ set hours [lindex $date 3]
- if { $value eq "pm" && $hours < 12 } {
- return [lreplace $date 3 3 [expr {$hours + 12}]]
- } elseif {$value eq "am"} {
- return [lreplace $date 3 3 [expr {$hours % 12}]]
- } else {
- return $date
+ # robustness check: make sure we handle form of 08:00am --jfr
+ if {[regexp {0([0-9])} $hours match trimmed_hours]} {
+ if {$trimmed_hours ne ""} {
+ set hours $trimmed_hours
+ }
+ }
+
+ if { $value eq "pm" && $hours < 12 } {
+ return [lreplace $date 3 3 [expr {$hours + 12}]]
+ } elseif {$value eq "am"} {
+ return [lreplace $date 3 3 [expr {$hours % 12}]]
+ } else {
+ return $date
+ }
+ }
}
- }
- }
- clock {
- set old_date [clock format $value -format "%Y %m %d %H %M %S"]
- set new_date [list]
- foreach field $old_date {
- lappend new_date [util::trim_leading_zeros $field]
- }
- lappend new_date [lindex $date 6]
- return $new_date
- }
- sql_date {
- set old_format [lindex $date 6]
- set new_date [list]
- foreach fragment $value {
- lappend new_date [util::trim_leading_zeros $fragment]
- }
- lappend new_date $old_format
- return $new_date
- }
- ansi {
- # Some initialization...
- # Rip $date into $ansi_* as numbers, no leading zeros
- set matchdate {([0-9]{4})\-0?(1?[0-9])\-0?([1-3]?[0-9])}
- set matchtime {0?([1-2]?[0-9]):0?([1-5]?[0-9]):0?([1-6]?[0-9])}
- set matchfull "$matchdate $matchtime"
+ clock {
+ set old_date [clock format $value -format "%Y %m %d %H %M %S"]
+ set new_date [list]
+ foreach field $old_date {
+ lappend new_date [util::trim_leading_zeros $field]
+ }
+ lappend new_date [lindex $date 6]
+ return $new_date
+ }
+ sql_date {
+ set old_format [lindex $date 6]
+ set new_date [list]
+ foreach fragment $value {
+ lappend new_date [util::trim_leading_zeros $fragment]
+ }
+ lappend new_date $old_format
+ return $new_date
+ }
+ ansi {
+ # Some initialization...
+ # Rip $date into $ansi_* as numbers, no leading zeros
+ set matchdate {([0-9]{4})\-0?(1?[0-9])\-0?([1-3]?[0-9])}
+ set matchtime {0?([1-2]?[0-9]):0?([1-5]?[0-9]):0?([1-6]?[0-9])}
+ set matchfull "$matchdate $matchtime"
- set time_p 1
- if {![regexp -- $matchfull $value match ansi_year ansi_month ansi_days ansi_hours ansi_minutes ansi_seconds]} {
- if {[regexp -- $matchdate $value match ansi_year ansi_month ansi_days]} {
- set ansi_hours 0
- set ansi_minutes 0
- set ansi_seconds 0
- } else {
- error "Invalid date: $value"
+ set time_p 1
+ if {![regexp -- $matchfull $value match ansi_year ansi_month ansi_days ansi_hours ansi_minutes ansi_seconds]} {
+ if {[regexp -- $matchdate $value match ansi_year ansi_month ansi_days]} {
+ set ansi_hours 0
+ set ansi_minutes 0
+ set ansi_seconds 0
+ } else {
+ error "Invalid date: $value"
+ }
}
+ # Return new date, but use old format
+ return [list $ansi_year $ansi_month $ansi_days $ansi_hours $ansi_minutes $ansi_seconds [lindex $date 6]]
}
- # Return new date, but use old format
- return [list $ansi_year $ansi_month $ansi_days $ansi_hours $ansi_minutes $ansi_seconds [lindex $date 6]]
+ now {
+ return [template::util::date set_property clock $date [clock seconds]]
+ }
+ default {
+ error "util::date::set_property: unknown property: '$what'."
+ }
}
- now {
- return [template::util::date set_property clock $date [clock seconds]]
- }
- default {
- error "util::date::set_property: unknown property: '$what'."
- }
- }
}
-ad_proc -public template::util::date::defaultInterval { what } {
+ad_proc -public template::util::date::defaultInterval {
+ what
+} {
Get the default ranges for all the numeric fields of a Date object
} {
- switch -- $what {
- year { return [list 2002 2012 1 ] }
- month { return [list 1 12 1] }
- day { return [list 1 31 1] }
- hours { return [list 0 23 1] }
- minutes { return [list 0 59 5] }
- seconds { return [list 0 59 5] }
- short_year { return [list 0 10 1] }
- short_hours { return [list 1 12 1] }
- }
+ switch -- $what {
+ year { return [list 2002 2012 1 ] }
+ month { return [list 1 12 1] }
+ day { return [list 1 31 1] }
+ hours { return [list 0 23 1] }
+ minutes { return [list 0 59 5] }
+ seconds { return [list 0 59 5] }
+ short_year { return [list 0 10 1] }
+ short_hours { return [list 1 12 1] }
+ }
}
-ad_proc -public template::util::date::unpack { date } {
+ad_proc -public template::util::date::unpack {
+ date
+} {
Set the variables for each field of the date object in
the calling frame.
@@ -614,8 +642,8 @@
ad_proc -deprecated -public template::util::date::now_min_interval_plus_hour {
{-clock ""}
} {
- Create a new Date object for the current date and time
- plus one hour with the default interval for minutes
+ Create a new Date object for the current date and time plus one
+ hour with the default interval for minutes.
@param clock time in seconds, if not specified, it uses current time
@@ -657,11 +685,15 @@
return [create {*}$now]
}
-ad_proc -public template::util::date::add_time { {-time_array_name:required} {-date_array_name:required} } {
- set the time and date and new format properties
- into one date object (list) which is returned
- not sure this proc should live here...
+ad_proc -public template::util::date::add_time {
+ -time_array_name:required
+ -date_array_name:required
+} {
+ Set the time and date and new format properties into one date
+ object (list) which is returned.
+ Not sure this proc should live here...
+
@author Walter McGinnis (wtem@olywa.net)
@creation-date 2002-01-04
} {
@@ -674,7 +706,7 @@
# create an empty date object with the new format
set the_date [template::util::date::create \
- "" "" "" "" "" "" ""]
+ "" "" "" "" "" "" ""]
set the_date [template::util::date::set_property format $the_date $new_format]
@@ -726,118 +758,129 @@
}
}
-ad_proc -public template::util::negative { value } {
- Check if a value is less than zero, but return false
- if the value is an empty string
+ad_proc -public template::util::negative {
+ value
} {
- if {$value eq ""} {
- return 0
- } else {
- return [expr {[util::trim_leading_zeros $value] < 0}]
- }
+ Check if a value is less than zero, but return false if the value
+ is an empty string.
+} {
+ if {$value eq ""} {
+ return 0
+ } else {
+ return [expr {[util::trim_leading_zeros $value] < 0}]
+ }
}
+ad_proc -public template::util::date::validate {
+ date
+ error_ref
+} {
+ Validate a date object.
-ad_proc -public template::util::date::validate { date error_ref } {
- Validate a date object. Return 1 if the object is valid,
- 0 otherwise. Set the error_ref variable to contain
- an error message, if any
+ @return 1 if the object is valid, 0 otherwise. Set the error_ref
+ variable to contain an error message, if any.
} {
- # If the date is empty, it's valid
- if { ![get_property not_null $date] } {
- return 1
- }
+ # If the date is empty, it's valid
+ if { ![get_property not_null $date] } {
+ return 1
+ }
- variable fragment_formats
- upvar $error_ref error_msg
+ variable fragment_formats
+ upvar $error_ref error_msg
- unpack $date
+ unpack $date
- set error_msg [list]
+ set error_msg [list]
- foreach {field exp} { year "YYYY|YY" month "MM|MON|MONTH" day "DD"
- hours "HH24|HH12" minutes "MI" seconds "SS" } {
-
- # If the field is required, but missing, report an error
- if {[set $field] eq ""} {
- if { [regexp $exp $format match] } {
- set field_pretty [_ acs-templating.${field}]
- lappend error_msg [_ acs-templating.lt_No_value_supplied_for_-field_pretty-]
+ foreach {field exp} {
+ year "YYYY|YY"
+ month "MM|MON|MONTH"
+ day "DD"
+ hours "HH24|HH12"
+ minutes "MI"
+ seconds "SS"
+ } {
+ # If the field is required, but missing, report an error
+ if {[set $field] eq ""} {
+ if { [regexp $exp $format match] } {
+ set field_pretty [_ acs-templating.${field}]
+ lappend error_msg [_ acs-templating.lt_No_value_supplied_for_-field_pretty-]
+ }
+ } else {
+ # fields should only be integers
+ if { ![regexp {^[0-9]+$} [set $field] match] } {
+ set field_pretty [_ acs-templating.${field}]
+ lappend error_msg [_ acs-templating.lt_The_-field_pretty-_must_be_non_negative]
+ set $field {}
+ }
}
- } else {
- # fields should only be integers
- if { ![regexp {^[0-9]+$} [set $field] match] } {
- set field_pretty [_ acs-templating.${field}]
- lappend error_msg [_ acs-templating.lt_The_-field_pretty-_must_be_non_negative]
- set $field {}
- }
}
- }
- if { [template::util::negative $year] } {
- lappend error_msg [_ acs-templating.Year_must_be_positive]
- }
+ if { [template::util::negative $year] } {
+ lappend error_msg [_ acs-templating.Year_must_be_positive]
+ }
- if { $month ne {} } {
- if { [string trimleft $month "0"] < 1 || [string trimleft $month "0"] > 12 } {
- lappend error_msg [_ acs-templating.Month_must_be_between_1_and_12]
- } else {
- if { $year > 0 } {
- if { $day ne {} } {
- set maxdays [get_property days_in_month $date]
- if { [string trimleft $day "0"] < 1 || [string trimleft $day "0"] > $maxdays } {
- set month_pretty [template::util::date::get_property long_month_name $date]
- if { $month == 2 } {
- # February has a different number of days depending on the year
- append month_pretty " ${year}"
- }
- lappend error_msg [_ acs-templating.lt_day_between_for_month_pretty]
- }
+ if { $month ne {} } {
+ if { [string trimleft $month "0"] < 1 || [string trimleft $month "0"] > 12 } {
+ lappend error_msg [_ acs-templating.Month_must_be_between_1_and_12]
+ } else {
+ if { $year > 0 } {
+ if { $day ne {} } {
+ set maxdays [get_property days_in_month $date]
+ if { [string trimleft $day "0"] < 1 || [string trimleft $day "0"] > $maxdays } {
+ set month_pretty [template::util::date::get_property long_month_name $date]
+ if { $month == 2 } {
+ # February has a different number of days depending on the year
+ append month_pretty " ${year}"
+ }
+ lappend error_msg [_ acs-templating.lt_day_between_for_month_pretty]
+ }
+ }
+ }
}
- }
}
- }
- if { [template::util::negative $hours] || $hours > 23 } {
- lappend error_msg [_ acs-templating.Hours_must_be_between_0_and_23]
- }
+ if { [template::util::negative $hours] || $hours > 23 } {
+ lappend error_msg [_ acs-templating.Hours_must_be_between_0_and_23]
+ }
- if { [template::util::negative $minutes] || $minutes > 59 } {
- lappend error_msg [_ acs-templating.Minutes_must_be_between_0_and_59]
- }
+ if { [template::util::negative $minutes] || $minutes > 59 } {
+ lappend error_msg [_ acs-templating.Minutes_must_be_between_0_and_59]
+ }
- if { [template::util::negative $seconds] || $seconds > 59 } {
- lappend error_msg [_ acs-templating.Seconds_must_be_between_0_and_59]
- }
- if { [llength $error_msg] > 0 } {
- set error_msg "[join $error_msg {
}]"
- return 0
- } else {
- return 1
- }
+ if { [template::util::negative $seconds] || $seconds > 59 } {
+ lappend error_msg [_ acs-templating.Seconds_must_be_between_0_and_59]
+ }
+ if { [llength $error_msg] > 0 } {
+ set error_msg "[join $error_msg {
}]"
+ return 0
+ } else {
+ return 1
+ }
}
-
-
-ad_proc -public -deprecated template::util::leadingPad { string size } {
+ad_proc -public -deprecated template::util::leadingPad {
+ string
+ size
+} {
Pad a string with leading zeros
Deprecated: please use the new and more general 'ad_pad'.
@see ad_pad
} {
+ if {$string eq ""} {
+ return ""
+ }
- if {$string eq ""} {
- return ""
- }
-
- set ret [string repeat "0" [expr {$size - [string length $string]}]]
- append ret $string
- return $ret
-
+ set ret [string repeat "0" [expr {$size - [string length $string]}]]
+ append ret $string
+ return $ret
}
-ad_proc -public -deprecated template::util::leadingTrim { value } {
+ad_proc -public -deprecated template::util::leadingTrim {
+ value
+} {
Trim the leading zeros from the value, but preserve the value
as "0" if it is "00"
@@ -846,149 +889,177 @@
return [util::trim_leading_zeros $value]
}
-# Create an HTML fragment to display a numeric range widget
-# interval_def is in form { start stop interval }
+ad_proc -public template::widget::numericrange {
+ element_reference
+ tag_attributes
+} {
+ Widget proc usable with ad_form to display a numeric range widget.
-ad_proc -public template::widget::numericrange {element_reference tag_attributes} {
- Widget proc usable with ad_form, need to define interval_def as
- {interval_def {start end step}}
+ Need to define interval_def as {interval_def {start end step}}
} {
- upvar $element_reference element
+ upvar $element_reference element
- if { [info exists element(html)] } {
- array set attributes $element(html)
- }
+ if { [info exists element(html)] } {
+ array set attributes $element(html)
+ }
- return [template::widget::numericRange $element(name) $element(interval_def) $element(size) $element(value) $tag_attributes]
+ return [template::widget::numericRange $element(name) $element(interval_def) $element(size) $element(value) $tag_attributes]
}
-ad_proc -public template::widget::numericRange { name interval_def size {value ""} {tag_attributes {}} } {
+ad_proc -public template::widget::numericRange {
+ name
+ interval_def
+ size
+ {value ""}
+ {tag_attributes {}
+ }
+} {
Create an HTML fragment to display a numeric range widget
interval_def is in form { start stop interval }
} {
- array set attributes $tag_attributes
+ array set attributes $tag_attributes
- set interval_size [lindex $interval_def 2]
- set options [list [list "--" {}]]
+ set interval_size [lindex $interval_def 2]
+ set options [list [list "--" {}]]
- for { set i [lindex $interval_def 0] } \
- { $i <= [lindex $interval_def 1] } \
- { incr i $interval_size } {
- lappend options [list [ad_pad -left $i $size "0"] $i]
- }
+ for { set i [lindex $interval_def 0] } \
+ { $i <= [lindex $interval_def 1] } \
+ { incr i $interval_size } {
+ lappend options [list [ad_pad -left $i $size "0"] $i]
+ }
- if {$interval_size > 1} {
- # round minutes or seconds to nearest interval
- if { $value ne "" } {
- set value [expr {$value-($value - [lindex $interval_def 0])%$interval_size}]
+ if {$interval_size > 1} {
+ # round minutes or seconds to nearest interval
+ if { $value ne "" } {
+ set value [expr {$value-($value - [lindex $interval_def 0])%$interval_size}]
+ }
}
- }
- return [template::widget::menu $name $options [list $value] attributes]
+ return [template::widget::menu $name $options [list $value] attributes]
}
ad_proc -public template::widget::dateFragment {
- element_reference fragment size type value {mode edit} {tag_attributes {}} } {
- Create an input widget for the given date fragment
- If type is "t", uses a text widget for the fragment, with the given
- size.
- Otherwise, determines the proper widget based on the element flags,
- which may be text or a picklist
+ element_reference
+ fragment
+ size
+ type
+ value
+ {mode edit}
+ {tag_attributes {}}
} {
+ Create an input widget for the given date fragment If type is "t",
+ uses a text widget for the fragment, with the given size.
- upvar $element_reference element
+ Otherwise, determines the proper widget based on the element
+ flags, which may be text or a picklist.
+} {
+ upvar $element_reference element
- set value [template::util::date::get_property $fragment $value]
- set value [util::trim_leading_zeros $value]
+ set value [template::util::date::get_property $fragment $value]
+ set value [util::trim_leading_zeros $value]
- if { $mode ne "edit" } {
- return [subst {$value}]
- } else {
- if { [info exists element(${fragment}_interval)] } {
- set interval $element(${fragment}_interval)
+ if { $mode ne "edit" } {
+ return [subst {$value}]
} else {
- # Display text entry for some elements, or if the type is text
- if { $type == "t"
- || [regexp "year|short_year" $fragment]
- } {
- set output "\n"
- return $output
- } else {
- # Use a default range for others
- set interval [template::util::date::defaultInterval $fragment]
- }
- }
- return [template::widget::numericRange "$element(name).$fragment" \
- $interval $size $value $tag_attributes]
- }
+ if { [info exists element(${fragment}_interval)] } {
+ set interval $element(${fragment}_interval)
+ } else {
+ # Display text entry for some elements, or if the type is text
+ if { $type == "t"
+ || [regexp "year|short_year" $fragment]
+ } {
+ set output "\n"
+ return $output
+ } else {
+ # Use a default range for others
+ set interval [template::util::date::defaultInterval $fragment]
+ }
+ }
+ return [template::widget::numericRange "$element(name).$fragment" \
+ $interval $size $value $tag_attributes]
+ }
}
ad_proc -public template::widget::ampmFragment {
- element_reference fragment size type value {mode edit} {tag_attributes {}} } {
- Create a widget that shows the am/pm selection
+ element_reference
+ fragment
+ size
+ type
+ value
+ {mode edit}
+ {tag_attributes {}}
} {
+ Create a widget that shows the am/pm selection
+} {
+ upvar $element_reference element
+ array set attributes $tag_attributes
- upvar $element_reference element
- array set attributes $tag_attributes
+ set value [template::util::date::get_property $fragment $value]
- set value [template::util::date::get_property $fragment $value]
-
- if { $mode ne "edit" } {
- set output {}
- append output ""
- append output $value
- return $output
- } else {
- return [template::widget::menu \
- "$element(name).$fragment" { {A.M. am} {P.M. pm}} $value attributes]
- }
+ if { $mode ne "edit" } {
+ set output {}
+ append output ""
+ append output $value
+ return $output
+ } else {
+ return [template::widget::menu \
+ "$element(name).$fragment" { {A.M. am} {P.M. pm}} $value attributes]
+ }
}
ad_proc -public template::widget::monthFragment {
- element_reference fragment size type value {mode edit} {tag_attributes {}} } {
- Create a month entry widget with short or long month names
+ element_reference
+ fragment
+ size
+ type
+ value
+ {mode edit}
+ {tag_attributes {}}
} {
+ Create a month entry widget with short or long month names.
+} {
+ variable ::template::util::date::month_data
- variable ::template::util::date::month_data
+ upvar $element_reference element
+ array set attributes $tag_attributes
- upvar $element_reference element
- array set attributes $tag_attributes
+ set value [template::util::date::get_property $fragment $value]
- set value [template::util::date::get_property $fragment $value]
+ if { $mode ne "edit" } {
+ set output {}
+ if { $value ne "" } {
+ append output ""
+ append output [template::util::date::monthName $value $size]
+ }
+ return $output
+ } else {
+ set options [list [list "--" {}]]
+ for { set i 1 } { $i <= 12 } { incr i } {
+ lappend options [list [template::util::date::monthName $i $size] $i]
+ }
- if { $mode ne "edit" } {
- set output {}
- if { $value ne "" } {
- append output ""
- append output [template::util::date::monthName $value $size]
+ return [template::widget::menu \
+ "$element(name).$fragment" $options $value attributes]
}
- return $output
- } else {
- set options [list [list "--" {}]]
- for { set i 1 } { $i <= 12 } { incr i } {
- lappend options [list [template::util::date::monthName $i $size] $i]
- }
-
- return [template::widget::menu \
- "$element(name).$fragment" $options $value attributes]
- }
}
-
-ad_proc -public template::widget::date { element_reference tag_attributes } {
- Create a date entry widget according to a format string
- The format string should contain the following fields, separated
- by / \ - : . or whitespace:
+ad_proc -public template::widget::date {
+ element_reference
+ tag_attributes
+} {
+ Create a date entry widget according to a format string The format
+ string should contain the following fields, separated by / \ - :
+ . or whitespace:
string | meaning |
---|---|
YYYY | 4-digit year |
AM | am/pm flag |