| # calendar.tcl --- |
| # |
| # |
| # Copyright 2010 The Apache Rivet Team |
| # |
| # Licensed under the Apache License, Version 2.0 (the "License"); |
| # you may not use this file except in compliance with the License. |
| # You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, software |
| # distributed under the License is distributed on an "AS IS" BASIS, |
| # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| # See the License for the specific language governing permissions and |
| # limitations under the License. |
| # |
| # |
| # $Id: calendar.tcl 916 2010-07-03 00:37:44Z massimo.manghi $ |
| # |
| |
| package provide Calendar 1.2 |
| package require Itcl |
| |
| # Calendar: base class to create a calendar table. |
| # |
| # Calendar prints an ascii calendar following the output form of a Unix |
| # 'cal' command. Even though it can be used as a concrete class it was |
| # designed to have methods and mechanisms abstract enough to be easly |
| # customized and specialized through derivation of other classes (see XmlCalendar) |
| # |
| # The output of Calendar (method 'emit') |
| # |
| # |
| # Jun 2010 | header | banner |
| # Su Mo Tu We Th Fr Sa | | weekdays |
| # 1 2 3 4 5 | table |
| # 6 7 8 9 10 11 12 | |
| # 13 14 15 16 17 18 19 | |
| # 20 21 22 23 24 25 26 |
| # 27 28 29 30 |
| # |
| # |
| |
| ::itcl::class Calendar { |
| public common month_names |
| public common day_names |
| |
| private variable month_year_processed {} |
| |
| # language to be used: key to be used in 'month_names' |
| # and in case in other databases |
| |
| public variable language en |
| |
| private method numberOfDays { month year } |
| private method cal { month year } |
| |
| protected method weekdays { } |
| protected method banner { mth yr } |
| protected method header { mth yr } |
| protected method first_week { mth yr wkday } |
| protected method formatDayCell { day } |
| protected method openRow { wkn } |
| protected method closeRow { } |
| protected method table { mth yr } |
| protected method startOutput { } |
| protected method closeOutput { } |
| |
| public method cal_processed {} { return $month_year_processed } |
| |
| public method emit { args } |
| |
| constructor {args} { |
| set month_names(en) { Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec } |
| set month_names(it) { Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic } |
| set day_names(en) { Su Mo Tu We Th Fr Sa } |
| set day_names(it) { Do Lu Ma Me Gi Ve Sa } |
| } |
| } |
| |
| |
| # numberOfDays <month> <year>: private method that returns the number of days in |
| # the current month. |
| # |
| |
| ::itcl::body Calendar::numberOfDays {month year} { |
| |
| if {$month == 12} { set month 1; incr year } |
| return [clock format [clock scan "[incr month]/1/$year 1 day ago"] -format %d] |
| |
| } |
| |
| ::itcl::body Calendar::banner {month_idx yr} { |
| |
| set month_name [lindex $month_names($language) $month_idx] |
| return " $month_name $yr\n" |
| |
| } |
| |
| ::itcl::body Calendar::weekdays {} { |
| return "$day_names($language)\n" |
| } |
| |
| # header <month_idx> <year> |
| # returns the header of the calendar table. The header is made of a banner (e.g. "Jul 2010") |
| # and a list of the weekdays (Su Mo ... Sa) |
| # |
| # Arguments: <month_idx> month index (0: jan, 11: dec). |
| # <year> year number. |
| # |
| # Returned value: text of the cal table header. |
| # |
| |
| ::itcl::body Calendar::header {mth_idx yr} { |
| return "[$this banner $mth_idx $yr][$this weekdays]" |
| } |
| |
| # first_week: cal tables are organized in columns corresponding to weekdays (from Sunday to Saturday). |
| # first_week returns as many blank cells as the number of weekdays starting from Sun up to the first day of the |
| # month. |
| # |
| ::itcl::body Calendar::first_week {month_idx year weekday} { |
| return [string repeat " " $weekday] |
| } |
| |
| ::itcl::body Calendar::formatDayCell { day } { return [format %3d $day] } |
| ::itcl::body Calendar::openRow { wkn } { return "" } |
| ::itcl::body Calendar::closeRow { } { return "\n" } |
| |
| # table <month> <year>: |
| |
| ::itcl::body Calendar::table {month_idx year} { |
| |
| set wk 0 |
| set tbl [$this openRow $wk] |
| |
| set month [lindex $month_names(en) $month_idx] |
| set weekday [clock format [clock scan "1 $month $year"] -format %w] |
| |
| append tbl [$this first_week $month_idx $year $weekday] |
| |
| scan [clock format [clock scan "1 $month $year"] -format %m] %d decm |
| set maxd [numberOfDays $decm $year] |
| |
| for {set d 1} {$d <= $maxd} {incr d} { |
| if {$weekday == 0} { |
| incr wk |
| append tbl [$this openRow $wk] |
| } |
| append tbl [formatDayCell $d] |
| if {[incr weekday] > 6} {append tbl [$this closeRow]; set weekday 0} |
| } |
| return $tbl |
| } |
| |
| |
| # abstract base methods for starting and closing the output buffer. |
| |
| ::itcl::body Calendar::startOutput {} { return "" } |
| ::itcl::body Calendar::closeOutput {} { return "" } |
| |
| # cal <month> <year>: cal does the real heavy lifting of building the |
| # calendar table. cal is designed to be the most abstract possible: |
| # - the output buffer is initialized by startOutput (this class does nothing) |
| # - the output buffer is filled with the header: in the classical Unix cal |
| # command output this corresponds to the 2 lines showing the year, the month and |
| # the weekdays |
| # - the output buffer is appended filled with the actual table of days of the month |
| # - the output is closed. This class does basically nothing |
| |
| ::itcl::body Calendar::cal {month_idx year} { |
| |
| set month_year_processed [list $month_idx $year] |
| |
| set res [$this startOutput] |
| append res [$this header $month_idx $year] |
| append res [$this table $month_idx $year] |
| append res [$this closeOutput] |
| |
| return $res |
| |
| } |
| |
| # emit args: |
| # |
| # emit returns the text of the calendar. If one argument is passed |
| # to this method its value is taken as a year number and the whole |
| # calendar for that year is printed, thus cycling this same method |
| # for each month of the year and concatenating the output in a single |
| # buffer. If 2 arguments are passed emit interprets them as month |
| # and year. <month> can be specified both in number (1-12) or |
| # abbreviated name (Jan,Feb,....,Dec). A minimal support for other |
| # languages exists. If no arguments are passed to 'emit' the current |
| # month calendar is displayed. |
| # |
| |
| ::itcl::body Calendar::emit { args } { |
| |
| set argsnumber [llength $args] |
| |
| # if we have just one argument therefore it be an year and we proceed to |
| # generate a whole year calendar, otherwise we have to examine possible |
| # options and values |
| |
| if {$argsnumber > 1} { |
| |
| if {$argsnumber%2 == 0} { |
| |
| set primo_chr [string range [lindex $args 0] 0 0] |
| if {$primo_chr == "-"} { |
| |
| # we proceed to eval import_arguments $args |
| |
| set numeric_parameters {} |
| eval $this configure $args |
| |
| } else { |
| |
| # arguments number is even. If the first switch is not an option (-opt) |
| # we assume we are passing 2 parameters to the methods, while the |
| # remaining list are actually an -opt val pairs list |
| |
| # we assume the rest of the args are in the form -opt1 val1 -opt2 val2 ... |
| # we proceed to eval import_arguments [lrange $args 2 end] |
| |
| set numeric_parameters [lrange $args 0 1] |
| eval $this configure [lrange $args 2 end] |
| |
| } |
| } else { |
| |
| # we assume the rest of the args are in the form -opt1 val1 -opt2 val2 ... |
| # and then we eval import_arguments [lrange $args 1 end] |
| |
| set numeric_parameters [lrange $args 0 0] |
| eval $this configure [lrange $args 1 end] |
| } |
| |
| } else { |
| set numeric_parameters $args |
| } |
| |
| set argsnumber [llength $numeric_parameters] |
| |
| switch $argsnumber { |
| 1 { |
| |
| # if only one argument is passed to this procedure then we treat it as either as a |
| # year (therefore must be a number) or a month name of the current year |
| |
| if {[regexp {^[0-9]+$} $numeric_parameters]} { |
| set res {} |
| set year $numeric_parameters |
| for {set m 0} {$m < 12} {incr m} { |
| append res [cal $m $year]\n\n |
| } |
| |
| return [string trimright $res] |
| } |
| |
| set month_idx [lsearch $month_names($language) $numeric_parameters] |
| if {$month_idx >= 0} { |
| set year [clock format [clock sec] -format %Y] |
| return [cal $month_idx $year] |
| } else { |
| return "" |
| } |
| } |
| 2 { |
| |
| # two args: the first is the month, the second the year. |
| |
| set month [lindex $numeric_parameters 0] |
| set year [lindex $numeric_parameters 1] |
| |
| if {[regexp {^\d{1,2}$} $month mat] && ($month > 0) && ($month <= 12)} { |
| return [cal [incr month -1] $year] |
| } elseif { [lsearch $month_names($language) $month] >= 0} { |
| return [cal [lsearch $month_names($language) $month] $year] |
| } |
| } |
| 0 - |
| default { |
| |
| # no arguments, we take today as reference |
| |
| scan [clock format [clock seconds] -format %m] "%d" month |
| set year [format "%d" [clock format [clock sec] -format %Y]] |
| return [cal [incr month -1] $year] |
| |
| } |
| } |
| |
| } |
| |
| # XmlCalendar: XmlCalendar inherits the table structure of Calendar and |
| # adds XML markup to a calendar table. The design is driven by the layout |
| # of a calendar table. This is probably a rather naive approach. |
| # A better implementation would require separate data and layout classes, |
| # but it's only a calendar table anyway |
| |
| ::itcl::class XmlCalendar { |
| inherit Calendar |
| |
| private method validateWeekday { wkd } |
| |
| # dictionary of table generation parameters (tag , attributes). key for the dictionary can be |
| # |
| # - container: |
| # - header |
| # - weekdays |
| # - days_row |
| # - days_cell |
| # |
| # for every key a 'tag' and 'attr' key is defined. attr is a even-length list storing |
| # attribute-value pairs |
| |
| public variable parameters |
| |
| # we are emitting (x)html code that has to be encapsulated |
| # in this root element. If the value is a list the first element is |
| # the tag name and the rest is treated as a list of <attr>,<value pairs |
| # so this list has to have an odd length |
| |
| # These public variables are listed in order to enable the corresponding configuration options: |
| # |
| # $calObj configure -current_day 4 -container table -banner .... |
| # |
| # They work as transit variables as the values are actually stored in the dictionary 'parameters' |
| # |
| |
| |
| public variable container {} { $this expandValues container $container } |
| public variable header {} { $this expandValues header $header } |
| public variable body {} { $this expandValues body $body } |
| public variable foot {} { $this expandValues foot $foot } |
| public variable banner {} { $this expandValues banner $banner } |
| public variable banner_month {} { $this expandValues banner_month $banner_month } |
| public variable banner_year {} { $this expandValues banner_year $banner_year } |
| public variable weekdays {} { $this expandValues wkdays_bar $weekdays } |
| public variable weekday_cell {} { $this expandValues wkday_cell $weekday_cell } |
| public variable days_row {} { $this expandValues days_row $days_row } |
| public variable days_cell {} { $this expandValues days_cell $days_cell } |
| public variable cell_function "" |
| public variable current_day 0 |
| public variable current_weekday -1 { $this validateWeekday $current_weekday } |
| |
| private method expandValues { element values_list } |
| |
| protected method startOutput { } |
| protected method closeOutput { } |
| |
| protected method mkOpenTag { tag {attrib {}} } |
| protected method mkCloseTag { tag } |
| |
| protected method header { mth yr } |
| protected method table { mth yr } |
| protected method weekdays { } |
| protected method banner { mth yr } |
| protected method first_week { mth yr wkday } |
| protected method openRow { wkn } |
| protected method closeRow { } |
| protected method formatDayCell { day } |
| protected method getParameters { param what } |
| |
| constructor {args} {Calendar::constructor $args} { |
| |
| set parameters [dict create container {tag "calendar" attr "" } \ |
| header {tag "calheader" attr "" } \ |
| body {tag "calbody" attr "" } \ |
| foot {tag "calfoot" attr "" } \ |
| banner {tag "monthyear" attr "" } \ |
| banner_month {tag "month" attr "" } \ |
| banner_year {tag "year" attr "" } \ |
| wkdays_bar {tag "weekdays" attr "" } \ |
| wkday_cell {tag "wkday" attr "" } \ |
| days_row {tag "week" attr "" } \ |
| days_cell {tag "day" attr "" }] |
| } |
| } |
| |
| ::itcl::body XmlCalendar::getParameters {param what} { |
| if {[dict exists $parameters $param $what]} { |
| return [dict get $parameters $param $what] |
| } else { |
| return "" |
| } |
| } |
| |
| ::itcl::body XmlCalendar::expandValues { element value_list } { |
| |
| dict set parameters $element tag [lindex $value_list 0] |
| dict set parameters $element attr [lrange $value_list 1 end] |
| |
| } |
| |
| ::itcl::body XmlCalendar::validateWeekday { wkd } { |
| if {$wkd == "today"} { |
| set current_weekday [clock format [clock scan today] -format %w] |
| } |
| } |
| |
| ::itcl::body XmlCalendar::startOutput {} { |
| return [$this mkOpenTag [getParameters container tag] [getParameters container attr]] |
| } |
| |
| ::itcl::body XmlCalendar::closeOutput {} { |
| return [$this mkCloseTag [getParameters container tag]] |
| } |
| |
| ::itcl::body XmlCalendar::mkOpenTag {tag {attrib {}}} { |
| |
| set open_tag "<$tag" |
| foreach {a v} $attrib { |
| append open_tag " $a=\"$v\"" |
| } |
| append open_tag ">" |
| |
| return $open_tag |
| } |
| |
| ::itcl::body XmlCalendar::mkCloseTag {tag} { return "</$tag>" } |
| |
| # The Xml header is made of a banner (i.e Month Year) and |
| # a bar showing the weekdays with their markup. |
| # |
| |
| ::itcl::body XmlCalendar::header {mth_idx yr} { |
| set header_tag [getParameters header tag] |
| set header_att [getParameters header attr] |
| |
| return "[mkOpenTag $header_tag $header_att][Calendar::header $mth_idx $yr][mkCloseTag $header_tag]\n" |
| } |
| |
| ::itcl::body XmlCalendar::weekdays { } { |
| set rowtag [getParameters wkdays_bar tag] |
| set xml [mkOpenTag $rowtag] |
| |
| set tagname [getParameters wkday_cell tag] |
| set wdn 0 |
| foreach dn $day_names($language) { |
| if {$wdn == $current_weekday} { |
| append xml "[mkOpenTag $tagname {class current_wkday}]$dn[mkCloseTag $tagname]" |
| } else { |
| append xml "[mkOpenTag $tagname]$dn[mkCloseTag $tagname]" |
| } |
| incr wdn |
| } |
| append xml [mkCloseTag $rowtag] |
| return $xml |
| } |
| |
| ::itcl::body XmlCalendar::banner {month_idx yr} { |
| set month_name [lindex $month_names($language) $month_idx] |
| |
| set header_tag [getParameters banner tag] |
| |
| set month_open_tag [mkOpenTag [getParameters banner_month tag] [getParameters banner_month attr]] |
| set year_open_tag [mkOpenTag [getParameters banner_year tag] [getParameters banner_year attr]] |
| |
| set banner_html [mkOpenTag $header_tag] |
| append banner_html "${month_open_tag}${month_name}[mkCloseTag [getParameters banner_month tag]]" |
| append banner_html "${year_open_tag}$yr[mkCloseTag [getParameters banner_year tag]]" |
| append banner_html [mkCloseTag $header_tag] |
| return $banner_html |
| } |
| |
| ::itcl::body XmlCalendar::formatDayCell { day } { |
| set tagname [getParameters days_cell tag] |
| set tagattr [getParameters days_cell attr] |
| |
| array set attributes $tagattr |
| if {$day == $current_day} { |
| set attributes(class) current |
| } |
| |
| if {$cell_function != "" && $day != ""} { |
| set month_year [$this cal_processed] |
| |
| set month [lindex $month_names(en) [lindex $month_year 0]] |
| set year [lindex $month_year 1] |
| set wkday [clock format [clock scan "$month $day $year"] -format %w] |
| |
| array set attributes [eval $cell_function $day $month_year $wkday] |
| } |
| |
| set tagattr [array get attributes] |
| return "[mkOpenTag $tagname $tagattr]$day[mkCloseTag $tagname]" |
| } |
| |
| ::itcl::body XmlCalendar::first_week { mth yr wkday } { |
| set emptyCell [formatDayCell ""] |
| return [string repeat $emptyCell $wkday] |
| } |
| |
| ::itcl::body XmlCalendar::table {month_idx year} { |
| set body_tag [getParameters body tag] |
| set body_att [getParameters body attr] |
| |
| return "[mkOpenTag $body_tag $body_att][Calendar::table $month_idx $year][mkCloseTag $body_tag]\n" |
| } |
| |
| ::itcl::body XmlCalendar::openRow { wkn } { |
| set tagname [getParameters days_row tag] |
| set attributes [concat class week_${wkn} [getParameters days_row attr]] |
| return [mkOpenTag $tagname $attributes] |
| } |
| |
| ::itcl::body XmlCalendar::closeRow {} { |
| set tagname [getParameters days_row tag] |
| return "[mkCloseTag $tagname]\n" |
| } |
| |
| |
| # HtmlCalendar: concrete class for generating Html formatted cal output. |
| # |
| # |
| |
| ::itcl::class HtmlCalendar { |
| inherit XmlCalendar |
| |
| constructor {args} {XmlCalendar::constructor $args} { |
| $this configure -container table \ |
| -header thead \ |
| -body tbody \ |
| -banner tr \ |
| -banner_month {th colspan 3 style "text-align: right;"} \ |
| -banner_year {th colspan 4 style "text-align: left;"} \ |
| -weekdays tr \ |
| -weekday_cell th \ |
| -days_row tr \ |
| -days_cell td |
| } |
| } |
| |
