This is a proposed new module for tcllib -- ::calendar

On my todo list is to write the docs and tests.  Feeback welcome -- [Glenn Jackman]

I made a note in setfirstweekday -- [CLN], 2002-01-02

----
  # calendar.tcl --
  #
  #       Calendar printing functions (a la Python).
  #
  # Note, this package uses [clock scan ...], which can only convert dates in the
  # range "1902-01-01 00:00:00" to "2037-12-31 23:59:59" inclusive (tcl 8.3.2).
  
  package require Tcl 8
  package require textutil
  package provide calendar 0.1
  
  namespace eval ::calendar {
      variable month_days {31 28 31 30 31 30 31 31 30 31 30 31}
  
      variable day_names [list]
      for {set day 2} {$day <= 8} {incr day} {
          set date [clock scan "2001-12-${day}"]
          lappend day_names [clock format $date -format "%a"]
      }
  
      variable month_names [list]
      for {set month 1} {$month <= 12} {incr month} {
          set mon [format "%02d" $month]
          set date [clock scan "2001-${month}-01"]
          lappend month_names [clock format $date -format "%B"]
      }
  
      # firstweekday=0 ~ sunday, firstweekday=1 ~ monday
      variable firstweekday 0
  
      variable monthcalendar_cache
      array set monthcalendar_cache {}
  
      namespace export isleap leapdays 
      namespace export validatedate weekday monthrange 
      namespace export setfirstweekday monthcalendar month calendar
  
      namespace import ::textutil::strRepeat ::textutil::adjust
  }
  
  # ::calendar::isleap --
  #
  #       Return true if year is a leap year, false otherwise
  
  proc ::calendar::isleap {year} {
      return [expr {($year % 4 == 0) && (($year % 100 != 0) || ($year % 400 == 0))}]
  }
  
  # ::calendar::leapdays --
  #
  #       Calculate the number of leap days in the range of years from
  #       "year1" up to, but not including, "year2".
  
  proc ::calendar::leapdays {year1 year2} {
      if {$year1 > $year2} {
          # swap year1, year2
          foreach {year2 year1} [list $year1 $year2] {break}
      }
      incr year1 -1
      incr year2 -1
      return [expr {($year2/4 - $year1/4) - ($year2/100 - $year1/100) + ($year2/400 - $year1/400)}]
  }
  
  # ::calendar::validatedate --
  #
  #       Validates a given date, "year-month-day":
  #               - each element is an integer
  #               - the month and day are legal
  #
  # Returns:
  #       1 if year-month-day is a valid date, else
  #       throws an error with a message indicating the "failure mode"
  
  proc ::calendar::validatedate {year month day} {
      foreach item {year month day} {
          if {![string is integer [set $item]]} {
              error "$item is not an integer: [set $item]"
          }
      }
      if {$month < 1 || $month > 12} {
          error "error: month must be between 1 and 12 inclusive"
      }
      set d [DaysInMonth $year $month]
      if {$day < 1 || $day > $d} {
          error "error: day must be between 1 and $d inclusive"
      }
      return 1
  }
  
  # ::calendar::DaysInMonth --  private procedure
  #
  #       Return the number of days in the specified month, 
  #       adjusted for leap year
  
  proc ::calendar::DaysInMonth {year month} {
      variable month_days
      set days_in_month [lindex $month_days [expr {$month - 1}]]
      if {[isleap $year] && $month == 2} {incr days_in_month}
      return $days_in_month
  }
  
  # ::calendar::weekday --
  #
  #       Return the weekday number of the specified day.
  #       0 ~ Sunday, 1 ~ Monday, ... 6 ~ Saturday
  
  proc ::calendar::weekday {year month day} {
      validatedate $year $month $day
      set date [format "%04d-%02d-%02d" $year $month $day]
      return [clock format [clock scan $date] -format %w]
  }
  
  # ::calendar::monthrange --
  #
  #       Returns a list containing the weekday number of the first day of the
  #       specified month, and the number of days in the month.
  
  proc ::calendar::monthrange {year month} {
      return [list [weekday $year $month 1] [DaysInMonth $year $month]]
  }
  
  # ::calendar::setfirstweekday --
  #
  #       For formatted monthly calendars, should Sunday or Monday be
  #       printed as the first day of the week.
  #
  # Arguments:
  #       day:  0 or any abbreviation of "sunday" to set Sunday as the first day
  #             1 or any abbreviation of "monday" to set Monday as the first day

  # CLN - This seems to be the only routine to assume English.  Others
  # Would produce or test against localized values (Lunedi, etc.) if
  # clock were, itself, localized.  Might you use clock format to get
  # the string for sunday and monday and use _that_ instead of hard-
  # coding?
  
  proc ::calendar::setfirstweekday {day} {
      variable firstweekday
      switch -regexp -- [string tolower $day] {
          {^0$} - {^s(u(n(d(ay?)?)?)?)?$} {set firstweekday 0}
          {^1$} - {^m(o(n(d(ay?)?)?)?)?$} {set firstweekday 1}
          default {error "error: first weekday must be either sunday or monday"}
      }
  }
  
  # ::calendar::monthcalendar --
  #
  #       Calculate the days in each week of a month
  #
  # Returns:
  #       A list of lists:  each row represents a week; days outside this month
  #       are zero.
  
  proc ::calendar::monthcalendar {year month} {
      variable monthcalendar_cache
      variable firstweekday
      if {![info exists monthcalendar_cache($year,$month,$firstweekday)]} {
          foreach {firstday ndays} [monthrange $year $month] {break}
          if {$firstweekday == 1} {
              incr firstday [expr {$firstday == 0 ? 6 : -1}]
          }
          set themonth [list]
          set week [list]
          for {set i 0} {$i < $firstday} {incr i} {lappend week 0}
          for {set i 1} {$i <= $ndays} {incr i} {
              if {[llength $week] == 7} {
                  lappend themonth $week
                  set week [list]
              }
              lappend week $i
          }
          for {set i [llength $week]} {$i < 7} {incr i} {lappend week 0}
          lappend themonth $week
          set monthcalendar_cache($year,$month,$firstweekday) $themonth
      }
      return $monthcalendar_cache($year,$month,$firstweekday)
  }
  
  # ::calendar::month --
  #
  #       Returns a formatted calendar for the specified month.
  #
  # Arguments:
  #       year, month:  obviously, the month
  #       daywidth:     the column width for each day in the week (minimum 2)
  #       daylinesp:    the number of blank lines to include for each week
  
  proc ::calendar::month {year month {daywidth 2} {daylinesp 0}} {
      variable month_names
      if {$daywidth < 2} {set daywidth 2}
      incr daylinesp
      set cal [adjust "[lindex $month_names [expr {$month - 1}]] $year" \
                  -justify center \
                  -full "true" \
                  -length [expr {7 * $daywidth + 6}]]
      append cal "\n" [FormatWeek [WeekHeader $daywidth] $daywidth] "\n"
      foreach week [monthcalendar $year $month] {
          append cal [FormatWeek $week $daywidth] [strRepeat "\n" $daylinesp]
      }
      regsub -all {\m0\M} $cal { } cal
      return $cal
  }
  
  # ::calendar::FormatWeek -- private procedure
  #
  #       Format the week (list of day numbers) with the specified width.
  
  proc ::calendar::FormatWeek {week width} {
      set format "%${width}s %${width}s %${width}s %${width}s %${width}s %${width}s %${width}s"
      return [eval [concat format [list $format] $week]]
  }
  
  # ::calendar::WeekHeader -- private procedure
  #
  #       Return a list of day names, Sunday or Monday first.
  
  proc ::calendar::WeekHeader {width} {
      variable firstweekday
      variable day_names
      if {$firstweekday == 0} {
          set days $day_names
      } else {
          set days [concat [lrange $day_names 1 end] [lindex $day_names 0]]
      }
      set header [list]
      incr width -1
      foreach day $days {
          lappend header [string range $day 0 $width]
      }
      return $header
  }
  
  # ::calendar::calendar --
  #
  #       Returns a formatted calendar for the specified year.
  #
  # Arguments:
  #       year:         obviously, the year
  #       columns:      the number of months to print in each row
  #       daywidth:     the column width for each day in the week (minimum 2)
  #       daylinesp:    the number of blank lines to include for each week
  #       monthlinesp:  the number of blank lines to include between each month
  
  proc ::calendar::calendar {year {columns 3} {daywidth 2} {daylinesp 0} {monthlinesp 1}} {
      incr monthlinesp -1
      set months [list]
      for {set month 1} {$month <= 12} {incr month} {
          lappend months [month $year $month $daywidth $daylinesp]
      }
      set cal ""
      set blank_week [strRepeat " " [expr {7 * $daywidth + 6}]]
      for {set i 0} {$i < 12} {incr i $columns} {
          set lines -1
          for {set j 0} {$j < $columns} {incr j 1} {
              set m($j) [split [lindex $months [expr {$j + $i}]] "\n"]
              if {[set l [llength $m($j)]] > $lines} {set lines $l}
          }
          for {set k 0} {$k < $lines} {incr k} {
              set line [list]
              for {set j 0} {$j < $columns} {incr j 1} {
                  set week [lindex $m($j) $k]
                  if {[string length $week] == 0} {
                      set week $blank_week
                  }
                  lappend line $week
              }
              append cal [join $line "\t"] "\n"
          }
          append cal [strRepeat "\n" $monthlinesp]
      }
      return $cal
  }