#!/usr/bin/wish
#----------------------------------------------------------------------------
# usage: tclcal
#
# 	Shows a calendar of the current month, with navigation buttons <- and ->
# 	for previous and next month.
#
#
# Author: Yoonsuck Choe <yschoe@cs.utexas.edu>
#
# Distributed under GNU Public License. See http://www.gnu.org for full
# detail. Provided as is, with no warranty.
#
# $Id: tclcal,v 1.5 2000/03/30 05:25:28 yschoe Exp yschoe $
#----------------------------------------------------------------------------
# Configuration : modify to your taste - default is similar to postit
#----------------------------------------------------------------------------
set myfg 	black			; # body and titlebar text color
set mybg 	\#f8fca0		; # body background
set mytitlefg 	white			; # titlebar button text color 
set mytitlebg 	\#d0d088		; # titlebar background
set geometry 	"180x150-0-0"		; # geometry
set font "-sony-fixed-medium-r-normal--16-150-75-75-c-80-iso8859-1" ; # font
set calcmd	"/usr/bin/cal"		; # calendar program path
set datecmd	"/bin/date"		; # date command path
#----------------------------------------------------------------------------
# End of configurable data
#----------------------------------------------------------------------------
global offsetx offsety


#----------------------------------------------------------------------------
# procedure: drag_move_setup : setup binding so that window can be dragged
#	and moved
#----------------------------------------------------------------------------
proc drag_move_setup { toptitle } {

  bind $toptitle <ButtonPress-1> {
	  set offsetx [expr [winfo pointerx .calendar ]-[winfo x .calendar]]
	  set offsety [expr [winfo pointery .calendar ]-[winfo y .calendar]]
	  bind $toptitle <Motion> {
		set lastx [expr [winfo pointerx .calendar ]-$offsetx]
		set lasty [expr [winfo pointery .calendar ]-$offsety]
		wm geometry .calendar "+${lastx}+${lasty}"
	  }
	}
  bind $toptitle <ButtonRelease-1> {
	set lastx [expr [winfo pointerx .calendar ]-$offsetx]
	set lasty [expr [winfo pointery .calendar ]-$offsety]
	wm geometry .calendar "+${lastx}+${lasty}"
	# Clear binding to the <Motion> event
	bind $toptitle  <Motion> {}
	}

  bind $toptitle <Enter> {
	$toptitle config -cursor fleur
	}

}

#----------------------------------------------------------------------------

wm withdraw . 

option add *activeBackground $mybg
#----------------------------------------
# Get current month and year
#----------------------------------------
set thismonth [exec $datecmd +%m]
regexp 0(0|1|2|3|4|5|6|7|8|9) $thismonth dummy thismonth
set thisyear [exec $datecmd +%Y]

#----------------------------------------
# Create new window
#----------------------------------------
toplevel .calendar -bg $mybg -relief flat 
wm geometry .calendar $geometry
wm overrideredirect .calendar 1

#----------------------------------------
# Top frame
#----------------------------------------
frame .calendar.top
pack .calendar.top -fill both 

set top .calendar.top
set cal "[exec $calcmd $thismonth $thisyear]"

#----------------------------------------
# Title frame
#----------------------------------------
frame $top.titleframe -bg $mytitlebg 
pack $top.titleframe -side top -fill both
drag_move_setup $top.titleframe

label $top.titleframe.title -text "Calendar" -bg $mytitlebg -fg $myfg \
	-height 1
# pack this later
# the title is packed in the end
pack $top.titleframe.title -side left -fill both -padx 0 -expand 1

set toptitle $top.titleframe.title

# Since overridedirect disables any direct influence of the window manager
# on this application, provide a primitive way of moving around the 
# application window.

drag_move_setup $toptitle

#----------------------------------------
# Body
#----------------------------------------
label $top.cal -textvariable cal -bg $mybg -fg $myfg -justify left \
	-font $font -borderwidth 0
	
pack $top.cal -side top -fill both

# Change cursor shape when it enters the calendar window
bind $top.cal <Enter> {
	$top.cal config -cursor left_ptr
}

#----------------------------------------
# Buttons in Title frame 
#----------------------------------------
frame $top.buttons 
pack $top.buttons -side top -fill both

set topt $top.titleframe

#--------------------
# Previous month button
#--------------------
button $topt.prev -text "<-" -bg $mytitlebg -fg $mytitlefg -font 5x7 -relief raised\
 	-command {set thismonth [expr $thismonth - 1] 
		  if {$thismonth==0} { 
			set thismonth 12 
			set thisyear [expr $thisyear -1 ] 
		  }
		  set cal "[exec $calcmd $thismonth $thisyear]"} \
	-padx 2 -borderwidth 1

#--------------------
# Next month button
#--------------------
button $topt.next -text "->" -bg $mytitlebg -fg $mytitlefg -font 5x7 -relief raised\
 	-command {set thismonth [expr $thismonth + 1] 
		  if {$thismonth==13} { 
			set thismonth 1
			set thisyear [expr $thisyear + 1 ] 
		  }
		  set cal "[exec $calcmd $thismonth $thisyear]"} \
	-padx 2 -borderwidth 1

#--------------------
# Quit button
#--------------------
button $topt.quit -text "X" -bg $mytitlebg -fg $mytitlefg -font 5x7 -relief raised\
 	-command "exit" -borderwidth 1 -padx 4 

#--------------------
# pack buttons in order
#--------------------
pack $topt.quit -padx 0 -pady 0 -side right -fill both
pack $topt.next -padx 0 -pady 0 -side right -fill both
pack $topt.prev -padx 0 -pady 0 -side right -fill both 

bind $topt.prev <Enter> { $topt.prev config -cursor hand2 }
bind $topt.next <Enter> { $topt.next config -cursor hand2 }
bind $topt.quit <Enter> { $topt.quit config -cursor hand2 }