Index: openacs-4/packages/acs-datetime/tcl/acs-calendar-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-datetime/tcl/acs-calendar-procs.tcl,v diff -u -N -r1.1 -r1.2 --- openacs-4/packages/acs-datetime/tcl/acs-calendar-procs.tcl 20 Apr 2001 20:51:09 -0000 1.1 +++ openacs-4/packages/acs-datetime/tcl/acs-calendar-procs.tcl 23 Aug 2001 19:10:51 -0000 1.2 @@ -1,4 +1,4 @@ -# /packages/acs-datetime/tcl/acs-calendar-widgets.tcl +# /packages/acs-datetime/tcl/acs-calendar-procs.tcl ad_library { @@ -41,7 +41,7 @@ Julian date of the day, and the value is a string (possibly with HTML formatting) that represents the details. } { - dt_get_info_from_db $date + dt_get_info $date if [empty_string_p $calendar_details] { set calendar_details [ns_set create calendar_details] @@ -264,7 +264,7 @@ } { set output "" - dt_get_info_from_db $date + dt_get_info $date append output " @@ -319,7 +319,7 @@ set current_width 0 for { set n 1 } { $n <= 12 } { incr n } { - dt_get_info_from_db $date + dt_get_info $date append output "
@@ -364,7 +364,7 @@ Returns a calendar year of small calendars for the year of the passed in date. Defaults to this year. } { - dt_get_info_from_db $date + dt_get_info $date return [dt_widget_year \ -calendar_details $calendar_details \ @@ -549,7 +549,7 @@ # Get the current month, day, and the first day of the month - dt_get_info_from_db $date + dt_get_info $date set output " @@ -736,7 +736,7 @@ return $output } -ad_proc -private dt_get_info_from_db { +ad_proc -private dt_get_info { {the_date ""} } { Calculates various dates required by the dt_widget_month @@ -745,7 +745,7 @@ Returns the following (example for the_date = 2000-12-08): - julian_date_today 2451889 + julian_date_today 2451887 month December year 2000 first_julian_date 2451875 @@ -763,49 +763,55 @@ next_month_name January prev_month_name November - Input: + Input: the_day ANSI formatted date string (yyyy-mm-dd). If not specified this procedure will default to today's - date. + date. } { # If no date was passed in, let's set it to today if [empty_string_p $the_date] { - set the_date [dt_sysdate] + set the_date [dt_sysdate] } - # We put all the columns into dt_info_set and return it later + # get year, month, day + set date_list [dt_ansi_to_list $the_date] + set year [dt_trim_leading_zeros [lindex $date_list 0]] + set month [dt_trim_leading_zeros [lindex $date_list 1]] + set day [dt_trim_leading_zeros [lindex $date_list 2]] + + # We put all the data into dt_info_set and return it later set dt_info_set [ns_set create] - set bind_vars [ad_tcl_vars_to_ns_set the_date] - # This query gets us all of the date information we need to - # calculate the calendar, including the name of the month, the - # year, the julian date of the first of the month, the day of the - # week of the first day of the month, the day number of the last - # day (28, 29, 30 ,31) and a month string of the next and previous - # months + ns_set put $dt_info_set julian_date_today \ + [dt_ansi_to_julian $year $month $day] + ns_set put $dt_info_set month \ + [clock format [clock scan $the_date] -format %B] + ns_set put $dt_info_set year \ + [clock format [clock scan $the_date] -format %Y] + ns_set put $dt_info_set first_julian_date_of_month \ + [dt_ansi_to_julian $year $month 1] + ns_set put $dt_info_set num_days_in_month \ + [dt_num_days_in_month $year $month] + ns_set put $dt_info_set first_day_of_month \ + [dt_first_day_of_month $year $month] + ns_set put $dt_info_set last_day \ + [dt_num_days_in_month $year $month] + ns_set put $dt_info_set next_month \ + [dt_next_month $year $month $day] + ns_set put $dt_info_set prev_month \ + [dt_prev_month $year $month $day] + ns_set put $dt_info_set beginning_of_year \ + $year-01-01 + ns_set put $dt_info_set days_in_last_month \ + [dt_num_days_in_month $year [expr $month - 1]] + ns_set put $dt_info_set next_month_name \ + [dt_next_month_name $year $month] + ns_set put $dt_info_set prev_month_name \ + [dt_prev_month_name $year $month] - db_1row dt_get_information " - select to_char(to_date(:the_date,'yyyy-mm-dd'),'J') as julian_date_today, - to_char(trunc(to_date(:the_date, 'yyyy-mm-dd'), 'Month'), 'fmMonth') as month, - to_char(trunc(to_date(:the_date, 'yyyy-mm-dd'), 'Month'), 'YYYY') as year, - to_char(trunc(to_date(:the_date, 'yyyy-mm-dd'), 'Month'), 'J') as first_julian_date_of_month, - to_char(last_day(to_date(:the_date, 'yyyy-mm-dd')), 'DD') as num_days_in_month, - to_char(trunc(to_date(:the_date, 'yyyy-mm-dd'), 'Month'), 'D') as first_day_of_month, - to_char(last_day(to_date(:the_date, 'yyyy-mm-dd')), 'DD') as last_day, - trunc(add_months(to_date(:the_date, 'yyyy-mm-dd'), 1)) as next_month, - trunc(add_months(to_date(:the_date, 'yyyy-mm-dd'), -1)) as prev_month, - trunc(to_date(:the_date, 'yyyy-mm-dd'), 'yyyy') as beginning_of_year, - to_char(last_day(add_months(to_date(:the_date, 'yyyy-mm-dd'), -1)), 'DD') as days_in_last_month, - to_char(add_months(to_date(:the_date, 'yyyy-mm-dd'), 1), 'fmMonth') as next_month_name, - to_char(add_months(to_date(:the_date, 'yyyy-mm-dd'), -1), 'fmMonth') as prev_month_name - from dual - " -bind $bind_vars -column_set dt_info_set - - ns_set free $bind_vars - - # We need the variables from the select query here as well + # We need the variables from the ns_set ad_ns_set_to_tcl_vars $dt_info_set ns_set put $dt_info_set first_julian_date \ @@ -816,15 +822,14 @@ [expr $first_julian_date_of_month + $num_days_in_month - 1] set days_in_next_month \ - [expr (7-(($num_days_in_month + $first_day_of_month - 1) % 7)) % 7] + [expr (7-(($num_days_in_month + $first_day_of_month - 1) % 7)) % 7] ns_set put $dt_info_set last_julian_date \ - [expr $first_julian_date_of_month + $num_days_in_month - 1 + $days_in_next_month] + [expr $first_julian_date_of_month + $num_days_in_month - 1 + $days_in_next_month] # Now, set the variables in the caller's environment ad_ns_set_to_tcl_vars -level 2 $dt_info_set ns_set free $dt_info_set } - Index: openacs-4/packages/acs-datetime/tcl/acs-datetime-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-datetime/tcl/acs-datetime-procs.tcl,v diff -u -N -r1.1 -r1.2 --- openacs-4/packages/acs-datetime/tcl/acs-datetime-procs.tcl 20 Apr 2001 20:51:09 -0000 1.1 +++ openacs-4/packages/acs-datetime/tcl/acs-datetime-procs.tcl 23 Aug 2001 19:10:30 -0000 1.2 @@ -70,16 +70,99 @@ return $month_names } +ad_proc dt_ansi_to_julian { + year + month + day + {era ""} +} { + Returns the ANSI date as Julian or -1 in the case + of an invalid ANSI date argument (year less than + 4713 BCE, greater than 9999 CE, or equal to 0) +} { + if [empty_string_p $era] { + set era CE + } + + if {$year == 0} { + set julian_date -1 + } elseif {$year == 1582 && $month == 10 && $day > 4 && $day < 15} { + # mimic the functionality of Oracle for these non-existent + # gregorian dates (returns the julian date of the day following + # 1582-10-04; 1582-10-15) + set julian_date [dt_ansi_to_julian 1582 10 15 CE] + } else { + if {$era == "BCE"} { + set year [expr -$year + 1] + } + + if {$month > 2} { + set year_n $year + set month_n [expr $month + 1] + } else { + set year_n [expr $year - 1] + set month_n [expr $month + 13] + } + + set julian_date [expr floor(floor(365.25 * $year_n) + floor(30.6001 * $month_n) + ($day + 1720995))] + + # check for change to the Gregorian Calendar + set gregorian [expr 15 + 31 * (10 + 12 * 1582)] + if {$day + 31 * ($month + 12 * $year) >= $gregorian} { + set julian_date [expr $julian_date + (2 - floor(0.01 * $year_n) + floor(0.25 * floor(0.01 * $year_n)))] + } + } + + return [expr int($julian_date)] +} + ad_proc dt_julian_to_ansi { julian_date } { Returns julian_date formatted as "yyyy-mm-dd" } { - return [db_string julian_to_ansi " - select to_char(to_date(:julian_date,'J'),'yyyy-mm-dd') from dual"] + # Gregorian calendar correction + set gregorian 2299161 + + if {$julian_date >= $gregorian} { + set calc [expr floor((($julian_date - 1867216) - 0.25) / 36524.25)] + set calc [expr $julian_date + 1 + $calc - floor(0.25 * $calc)] + } else { + set calc $julian_date + } + + # get initial calculations to set year, month, day + set calc [expr $calc + 1524] + set calc2 [expr floor(6680 + (($calc - 2439870) - 122.1) / 365.25)] + set calc3 [expr floor($calc2 * 365.25)] + set calc4 [expr floor(($calc - $calc3) / 30.6001)] + + # set year, month, day + set year [expr floor($calc2 - 4715)] + set month [expr floor($calc4 - 1)] + if {$month > 12} { + set month [expr $month - 12] + } + if {$month > 2 || $year <= 0} { + set year [expr $year - 1] + } + set day [expr floor($calc - $calc3 - floor($calc4 * 30.6001))] + + set year [expr int($year)] + set month [expr int($month)] + set day [expr int($day)] + + if {$month < 10} { + set month 0$month + } + + if {$day < 10} { + set day 0$day + } + + return $year-$month-$day } - ad_proc dt_ansi_to_pretty { {ansi_date ""} } { @@ -115,6 +198,103 @@ return $date_info } +ad_proc dt_num_days_in_month { + year + month +} { + Returns the numbers of days for the given month/year +} { + if {$month == 0} { + set month 01 + } elseif {$month == 12} { + set year [expr $year + 1] + set month 01 + } elseif {$month == 13} { + set year [expr $year + 1] + set month 02 + } else { + set month [expr $month + 1] + } + + return [clock format [clock scan "last day" -base [clock scan $year-$month-01]] -format %d] +} + +ad_proc dt_first_day_of_month { + year + month +} { + Returns the weekday number of the first day for the given month/year +} { + # calendar widgets are expecting integers 1-7, so we must adjust + return [expr [clock format [clock scan $year-$month-01] -format %w] + 1] +} + +ad_proc dt_next_month { + year + month + day +} { + Returns the ANSI date for the next month +} { + if {$month == 12} { + set year [expr $year + 1] + set month 01 + } else { + set month [expr $month + 1] + } + + return [clock format [clock scan $year-$month-$day] -format %Y-%m-%d] +} + +ad_proc dt_prev_month { + year + month + day +} { + Returns the ANSI date for the previous month +} { + if {$month == 1} { + set year [expr $year - 1] + set month 12 + } else { + set month [expr $month - 1] + } + + return [clock format [clock scan $year-$month-$day] -format %Y-%m-%d] +} + +ad_proc dt_next_month_name { + year + month +} { + Returns the ANSI date for the next month +} { + if {$month == 12} { + set year [expr $year + 1] + set month 01 + } else { + set month [expr $month + 1] + } + + return [clock format [clock scan $year-$month-01] -format %B] +} + +ad_proc dt_prev_month_name { + year + month +} { + Returns the ANSI date for the previous month +} { + if {$month == 12} { + set year [expr $year + 1] + set month 01 + } else { + set month [expr $month + 1] + } + + return [clock format [clock scan $year-$month-01] -format %B] +} + ad_proc -public dt_widget_datetime { {-show_date 1 -date_time_sep " " -use_am_pm 0 -default none} {name}