Source of calendar.stt

<?stt 
    "/ inspired by a corresponding example from the smlServer...
    "/ see http://www.smlserver.org

    |year calMonth calYear|

    year := Date today year.

    calMonth := 
	[:year :month | 
	    |nDays weekDay thisMonth thisDay|

	    thisMonth := Date today month.
	    thisDay := Date today day.

	    nDays := Date daysInMonth:month forYear:year.
	    weekDay := (Date day:1 month:month year:year) dayInWeek.
	    response tableStart:'BORDER'.

	    response tableRow:[
		response nextPutLine:'<th COLSPAN="7">',(Date nameOfMonth:month) asUppercaseFirst, ' ' , year printString,'</th>'.
	    ].

	    response tableRow:[
		(((1 to:7) collect:[:i | (Date abbreviatedNameOfDay:i) asUppercaseFirst]) collect:[:dayName | dayName asUppercaseFirst]) do:[:dayName |
		    response nextPutAll:'<th>',dayName,'</th>'.
		].
	    ].

	    response tableRowStart:'ALIGN="RIGHT"'.
	    1 to:weekDay-1 do:[:empty | 
		response nextPutAll:'<td></td>'.
	    ].
	    1 to:nDays do:[:day | 
		(month == thisMonth and:[day == thisDay]) ifTrue:[
		    response nextPutAll:'<td bgcolor="#FF7F7F">'.
		    response nextPutAll:'<b>', day printString , '</b>'.
		] ifFalse:[
		    response nextPutAll:'<td>'.
		    response nextPutAll:day printString.
		].
		response nextPutAll:'</td>'.
		weekDay := weekDay + 1.
		weekDay == 8 ifTrue:[
		    response tableRowEnd.
		    response nextPutLine:'</tr>'.
		    response tableRowStart:'ALIGN="RIGHT"'.
		    weekDay := 1.
		]
	    ].
	    weekDay ~~ 1 ifTrue:[
		weekDay to:7 do:[:empty | 
		    response nextPutAll:'<td></td>'.
		].
	    ].

	    response tableRowEnd.
	    response tableEnd.
	].

    calYear := 
	[:year |
	    response tableStart:'BORDER'.
	    1 to:12 by:3 do:[:i | 
		response tableRowStart:'VALIGN="TOP"'.
		i to:i+2 do:[:month |
		    response nextPutLine:'<td>'.
		    calMonth value:year value:month.
		    response nextPutLine:'</td>'.
		].
		response tableRowEnd.
	    ].
	    response tableEnd.
	]

"/  the original ML-code:
"/<?MSP(* ML Server Pages calendar -- sestoft@dina.kvl.dk 2000-01-09 *)
"/
"/local
"/    open Date Msp
"/    infix &&
"/
"/    val daynames = ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"]
"/
"/    val monthnames = 
"/        Vector.fromList ["January", "February", "March", "April", "May", "June", "July",
"/                         "August", "September", "October", "November", "December"]
"/
"/    fun leap y = y mod 4 = 0 andalso y mod 100 <> 0 orelse y mod 400 = 0
"/
"/    fun daysinmonth year = 
"/        fn Jan => 31 | Feb => if leap year then 29 else 28
"/         | Mar => 31 | Apr => 30 | May => 31 | Jun => 30
"/         | Jul => 31 | Aug => 31 | Sep => 30 | Oct => 31
"/         | Nov => 30 | Dec => 31
"/
"/    val tomonthcode = 
"/        fn 1 => Jan | 2 => Feb | 3 => Mar | 4 => Apr | 5 => May | 6 => Jun
"/         | 7 => Jul | 8 => Aug | 9 => Sep | 10 => Oct | 11 => Nov | 12 => Dec
"/         | _ => raise Fail "Illegal month number"
"/
"/    val frommonthcode = 
"/        fn Jan => 1 | Feb => 2 | Mar => 3 | Apr => 4 
"/         | May => 5 | Jun => 6 | Jul => 7 | Aug => 8 
"/         | Sep => 9 | Oct => 10 | Nov => 11 | Dec => 12
"/
"/    fun toDatedate (year, month, day) =
"/        date { year = year, month = tomonthcode month, day = day, 
"/               hour = 12, minute = 0, second = 0, offset = NONE }
"/
"/    val wdayno = 
"/        fn Mon => 1 | Tue => 2 | Wed => 3 | Thu => 4 
"/         | Fri => 5 | Sat => 6 | Sun => 7
"/
"/    val dayheader = tr(prmap (th o $) daynames)
"/
"/    fun mkmonth (year : int) (month : int) wrap = 
"/        let val firstwdayno = wdayno (weekDay (toDatedate (year, month, 1)))
"/            val daysinmonth = daysinmonth year (tomonthcode month)
"/            val days = List.tabulate(firstwdayno-1, fn _ => NONE)
"/                       @ List.tabulate(daysinmonth, fn d => SOME(d+1))
"/                fun makeday NONE       = Empty
"/                  | makeday (SOME day) =
"/                    let val daystring = $ (Int.toString day)
"/                    in wrap (year, month, day) daystring end
"/                fun weeks [] = []
"/                  | weeks days =
"/                    let val thisweek = List.take(days, Int.min(7, length days))
"/                        val nextweek = List.drop(days, Int.min(7, length days))
"/                        val firstrow = prmap (td o makeday) thisweek
"/                    in 
"/                        firstrow :: weeks nextweek 
"/                    end
"/                val monthheader = 
"/                    $$[Vector.sub(monthnames, month-1), " ", Int.toString year]
"/        in 
"/            tablea "BORDER" (tr(tha "COLSPAN=7" monthheader)
"/                            && dayheader && Nl
"/                            && prsep Nl (tra "ALIGN=RIGHT") (weeks days))
"/        end
"/in
"/    val today = 
"/        let val dt = fromTimeLocal(Time.now())
"/        in (year dt, frommonthcode (month dt), day dt) end
"/
"/    fun calmonth year month =
"/        let fun wrap date s = if date = today then strong s else s
"/        in mkmonth year month wrap end
"/
"/    fun calyear year = 
"/        let fun prtab(n, f) = List.foldr (op &&) Empty (List.tabulate(n, f))
"/            fun mkcalrow r = 
"/                tra "VALIGN=TOP" (prtab(3, 
"/                                        fn s => td(calmonth year (3*r+s+1))))
"/        in 
"/            tablea "BORDER" (prtab(4, mkcalrow))
"/        end
"/
"/    val year = %%#("year", #1 today);
"/end
?>

<!-- $Header$ -->

<html>
  <head>
    <title>STT example: Calendar for year <?stt= year printString ?></title>
  </head>
  <body bgcolor="#fbf2e7">
    <h2>STT example: calendar for year <?stt= year printString ?></h2>

    <?stt calYear value: year ?>
    <p>
    <hr>
    <p>
    Credits: 
    <br>Inspired by a corresponding example found on <A HREF="http://www.smlserver.org">http://www.smlserver.org</A>.
    <p>
    <hr><address>Served by your friendly <a href=http://www.exept.de>ST/X WebServer</a></address>
  </body>
</html>

  

Served by your friendly ST/X WebServer