[Richard Suchenwirth] - Here's a popup toplevel that displays a given month and allows to pick a date (or cancel):
----
Nice.  A couple of comments (that I might just implement myself when/if I get the time):

   * I'd really like to see the month name - ''RS: brings in i18n problems, though - month numbers are so universal...''

''CLN, 2001-06-22: Yes, but I thought 8.4 was going to have i18n date support in clock so either '''mc March''' or '''clock format''' with % for the month name should work.  No?''

''KBK, 27 June 2001:'' Alas, I've run out of time for 8.4.
Internationalizing '''clock''' is a bigger job than it looks at first.
I'll try to get it done over the summer.

   * I find partial weeks frustrating.   The first week of this month should be: 27  28  29  30  31  1  2 - ''RS: ... but marked in a different color, maybe gray?''

''CLN, 2001-06-22: Yes, a different color.  I'm not sure how to choose one.''
''[LV], 2001-Jun-22: Why not choose something Tk-ish, but use the option database so that it could be overridden.

   * It would be nice if it accomodated European weekday ordering with Saturday and Sunday at the end, not split (that is, M,T,W,T,F,S,S, not S,M,T,W,T,R,S).

   * I'd like clicking a date to select it and close the dialog. ''Easy: add "set date::res $date::date" to the <1> binding - RS''

Sorry to whine.  It really does look nice but I've thought about this a lot and have strong opinions.  -- CLN
----
Most of this wish list has now been fulfilled in [An i15d date chooser]
----
Feel free to add in your changes - that's one of the nice things about
the wiki.  In particular, if you are going to add in the month names, perhaps you will add them in a way that permits one to configure the language used to convey the months?  Configuration is what I will
probably be thinking about (after I think about what it will take to
build a parallel widget for selecting time.

Unfortunately, my coding skills are such that one should not hold
their breath waiting on me to write the time widget.

----

 namespace eval date {
    option add *Button.padX 0
    option add *Button.padY 0
    proc choose {} {
        variable month; variable year; variable date
        variable canvas; variable res
        variable day
        set year [clock format [clock seconds] -format "%Y"]
        scan [clock format [clock seconds] -format "%m"] %d month
        scan [clock format [clock seconds] -format "%d"] %d day
        toplevel .chooseDate -bg white
        wm title .chooseDate "Choose Date:"
        frame .chooseDate.1
        entry .chooseDate.1.1 -textvar date::month -width 3 -just center
        button .chooseDate.1.2 -text ^ -command {date::adjust 1 0}
        button .chooseDate.1.3 -text v -command {date::adjust -1 0}
        entry .chooseDate.1.4 -textvar date::year -width 4 -just center
        button .chooseDate.1.5 -text ^ -command {date::adjust 0 1}
        button .chooseDate.1.6 -text v -command {date::adjust 0 -1}
        eval pack [winfo children .chooseDate.1] -side left \
                -fill both
        set canvas [canvas .chooseDate.2 -width 160 -height 160 -bg white]
        frame .chooseDate.3
        entry .chooseDate.3.1 -textvar date::date -width 10
        button .chooseDate.3.2 -text OK -command {set date::res $date::date}
        button .chooseDate.3.3 -text Cancel -command {set date::res {}}
        eval pack [winfo children .chooseDate.3] -side left
        eval pack [winfo children .chooseDate]
        display
        vwait ::date::res
        destroy .chooseDate
        set res
    }
    proc adjust {dmonth dyear} {
        variable month; variable year; variable day
        set year  [expr {$year+$dyear}]
        set month [expr {$month+$dmonth}]
        if {$month>12} {set month 1; incr year}
        if {$month<1} {set month 12; incr year -1}
        if {[numberofdays $month $year]<$day} {
            set day [numberofdays $month $year]
        }
        display
    }
    proc display {} {
        variable month; variable year
        variable date; variable day
        variable canvas
        $canvas delete all
        set x0 20; set x $x0; set y 20
        set dx 20; set dy 20
        set xmax [expr {$x0+$dx*6}]
        foreach i {S M T W T F S} {
            $canvas create text $x $y -text $i -fill blue
            incr x $dx
        }
        scan [clock format [clock scan $month/1/$year] \
                -format %w] %d weekday
        set x [expr {$x0+$weekday*$dx}]
        incr y $dy
        set nmax [numberofdays $month $year]
        for {set d 1} {$d<=$nmax} {incr d} {
            set id [$canvas create text $x $y -text $d -tag day]
            if {$d==$day} {$canvas itemconfig $id -fill red}
            incr x $dx
            if {$x>$xmax} {set x $x0; incr y $dy}
        }
        $canvas bind day <1> {
            set item [%W find withtag current]
            set date::day [%W itemcget $item -text]
            set date::date "$date::month/$date::day/$date::year"
            %W itemconfig day -fill black
            %W itemconfig $item -fill red
        }
        set date "$month/$day/$year"
    }
    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
    }
 } ;# end namespace date

 #------ test and demo code (terminate by closing the main window)
 while 1 {
     set date [date::choose]
     puts $date
 }
----
2001-06-22 [RS]: stepping through months does not check for day validity, so you may get dates like 2/31/1999. Fixed in proc adjust.
----
[Arts and crafts of Tcl-Tk programming]