cal

Richard Suchenwirth 2007-04-26 - A little fun project while waiting for a lengthy build: the following code produces a string with the calendar of one month (as a subset of what the Unix command of same name does), e.g.

 % cal April 2007
     April 2007
 Su Mo Tu We Th Fr Sa
  1  2  3  4  5  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

Here's the code, densely textured :^)


 proc cal {{month {}} {year {}}} {
    if {$year == {} && [regexp {^[0-9]+$} $month]} {
      return [cal {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} $month]
    }
    if {$month eq ""} {set month [clock format [clock sec] -format %B]}
    if {[llength $month] > 1} {
      set res {}
      foreach m $month {
        append res [cal $m $year]\n\n
      }
      return [string trimright $res]
    }
    if {$year eq ""}  {set year [clock format [clock sec] -format %Y]}
    set res "     $month $year\n Su Mo Tu We Th Fr Sa\n"
    set weekday [clock format [clock scan "1 $month $year"] -format %w]
    append res  [string repeat "   " $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} {
        append res [format %3d $d]
        if {[incr weekday]>6} {append res \n; set weekday 0}
    }
    set res
 }
 proc numberofdays {month year} {
    if {$month==12} {set month 1; incr year}
    clock format [clock scan "[incr month]/1/$year  1 day ago"] \
        -format %d
 }
 # Test:
  catch {console show}
  catch {wm withdraw .}

  puts [ cal Jan 2007 ]
  puts "\n"
  puts "List of month:\n [ cal {Apr May} ]\n"
  puts "Current month:\n [ cal "" 2007 ]"
  puts "Default is the current month:\n [ cal ]"

Someone else might want to take a look at the above code and add the appropriate localisation/internationalizations (so that the day and month names are displayed in the local language preferences, etc.


wdb simply great!


MJ - Added that if the month is a list of month names, the result will be a calender for all the months.

 % cal {Apr May}
      Apr 2007
  Su Mo Tu We Th Fr Sa
   1  2  3  4  5  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

      May 2007
  Su Mo Tu We Th Fr Sa
         1  2  3  4  5
   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 31

HJG Added a little test.


LV Added the output of the default call.

HOWEVER, one behavior missing from the above routine is the behavior if one supplies only a year:

 unable to convert date-time string "1 2007 2007"
    while executing
 "FreeScan $string $base $timezone $locale"
    (procedure "::tcl::clock::scan" line 70)
    invoked from within
 "clock scan "1 $month $year""
    (procedure "cal" line 12)
    invoked from within
 "cal 2007 "
    invoked from within
 "puts "Year calendar output:\n [ cal 2007 ]""
    (file "/tmp/cal.tcl" line 37)

RS Wrong call. The signature specifies that you can give an optional month, and if you have, an optional year. Call it right, get it right; call it wrong, get some error. One could add checks to change that (8.5?) error to a clearer one; but for Wiki examples I prefer to code as simple as possible :^)

MJ - Added functionality to display the whole year if the first argument is a number and the second empty anyway. (This arguably is a hack because it uses the month parameter as a year instead)

MJ seems to gloss over the issue that the error message was unclear instead of any missing functionality. Only way to really resolve that is to do checks on the parameters.


MHo: How about marking the current day?


RS One could, like, by putting () or <> around it. But it makes only sense in the current month and year. And, Unix's cal doesn't do it either :) rdt Mine does, but then I'm using Linux. LV Somewhere - perhaps on Linux - I saw a version of cal which used colors to mark the current day of the current month. I don't know what version of cal that was though :-( ...

Whole Year

DKF: Here's a version that prints whole years at a time.

package require Tcl 8.5

# Produce information about the days in a month, without any assumptions about
# what those days actually are.
proc calMonthDays {timezone locale year month} {
    set days {}
    set moment [clock scan [format "%04d-%02d-00 12:00" $year $month] \
            -timezone $timezone -locale $locale -format "%Y-%m-%d %H:%M"]
    while 1 {
        set moment [clock add $moment 1 day]
        lassign [clock format $moment -timezone $timezone -locale $locale \
                -format "%m %d %u"] m d dow
        if {[scan $m %d] != $month} {
            return $days
        }
        lappend days $moment [scan $d %d] $dow
    }
}

proc calMonth {year month timezone locale} {
    set dow 0
    set line ""
    set lines {}
    foreach {t day dayofweek} [calMonthDays $timezone $locale $year $month] {
        if {![llength $lines]} {lappend lines $t}
        if {$dow > $dayofweek} {
            lappend lines [string trimright $line]
            set line ""
            set dow 0
        }
        while {$dow < $dayofweek-1} {
            append line "   "
            incr dow
        }
        append line [format "%2d " $day]
        set dow $dayofweek
    }
    lappend lines [string trimright $line]
}

proc cal3Month {year month timezone locale} {
    # Extract the month data
    set d1 [lassign [calMonth $year $month $timezone $locale] t1]; incr month
    set d2 [lassign [calMonth $year $month $timezone $locale] t2]; incr month
    set d3 [lassign [calMonth $year $month $timezone $locale] t3]
    # Print the header line of month names
    foreach t [list $t1 $t2 $t3] {
        set m [clock format $t -timezone $timezone -locale $locale -format "%B"]
        set l [expr {10 + [string length $m]/2}]
        puts -nonewline [format "%-25s" [format "%*s" $l $m]]
    }
    puts ""
    # Print the month days
    foreach l1 $d1 l2 $d2 l3 $d3 {
        puts [format "%-25s%-25s%s" $l1 $l2 $l3]
    }
}

proc cal {{year ""} {timezone :localtime} {locale en}} {
    if {$year eq ""} {
        set year [clock format [clock seconds] -format %Y]
    }
    puts [format "%40s" "-- $year --"]
    foreach m {1 4 7 10} {
        puts ""
        cal3Month $year $m $timezone $locale
    }
}

# Demonstrate by printing a particular calendar for a particular place
cal 1582 :Europe/Madrid es_ES

That produces this output:

                              -- 1582 --

       enero                   febrero                   marzo             
 1  2  3  4  5  6  7               1  2  3  4               1  2  3  4
 8  9 10 11 12 13 14      5  6  7  8  9 10 11      5  6  7  8  9 10 11
15 16 17 18 19 20 21     12 13 14 15 16 17 18     12 13 14 15 16 17 18
22 23 24 25 26 27 28     19 20 21 22 23 24 25     19 20 21 22 23 24 25
29 30 31                 26 27 28                 26 27 28 29 30 31

       abril                     mayo                    junio             
                   1         1  2  3  4  5  6                  1  2  3
 2  3  4  5  6  7  8      7  8  9 10 11 12 13      4  5  6  7  8  9 10
 9 10 11 12 13 14 15     14 15 16 17 18 19 20     11 12 13 14 15 16 17
16 17 18 19 20 21 22     21 22 23 24 25 26 27     18 19 20 21 22 23 24
23 24 25 26 27 28 29     28 29 30 31              25 26 27 28 29 30
30                                                

       julio                    agosto                 septiembre          
                   1            1  2  3  4  5                     1  2
 2  3  4  5  6  7  8      6  7  8  9 10 11 12      3  4  5  6  7  8  9
 9 10 11 12 13 14 15     13 14 15 16 17 18 19     10 11 12 13 14 15 16
16 17 18 19 20 21 22     20 21 22 23 24 25 26     17 18 19 20 21 22 23
23 24 25 26 27 28 29     27 28 29 30 31           24 25 26 27 28 29 30
30 31                                             

      octubre                 noviembre                diciembre           
 1  2  3  4 15 16 17      1  2  3  4  5  6  7            1  2  3  4  5
18 19 20 21 22 23 24      8  9 10 11 12 13 14      6  7  8  9 10 11 12
25 26 27 28 29 30 31     15 16 17 18 19 20 21     13 14 15 16 17 18 19
                         22 23 24 25 26 27 28     20 21 22 23 24 25 26
                         29 30                    27 28 29 30 31

Notice octubre (October)! That's when Spain switched from the Julian calendar to the Gregorian. (The UK switched the best part of two centuries later.)