#!/usr/bin/env wish8.3
# aqqdcal - quick-and-dirty calendar in Tcl/Tk
#
###############################################################################
#  Copyright 1992-2001 by Jay Sekora.  This file may be freely distributed,   #
#  modified or unmodified, for any purpose, provided that this copyright      #
#  notice is retained verbatim in all copies and no attempt is made to        #
#  obscure the authorship of this file.  If you distribute any modified       #
#  versions, I ask, but do not require, that you clearly mark any changes     #
#  you make as such and that you provide your users with instructions for     #
#  getting the original sources.                                              #
###############################################################################
## begin boiler_header

if {[info exists env(AQTOOLS_LIB)]} {
  set aq_library $env(AQTOOLS_LIB)
  set aq_pkg [file join $env(AQTOOLS_LIB) pkg]
} else {
  set aq_library /usr/lib/aq
  set aq_pkg [file join $aq_library pkg]
}

# add the aq library to the library search path:

set auto_path  [concat  [list $aq_pkg]  [list $aq_library]  $auto_path]

# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the aq libraries.

if {[file isdirectory ~/.tk]} then {
  set auto_path [concat [list [glob ~/.tk]] $auto_path]
}

## end boiler_header

# the import IS A BIG PROBLEM until this whole file gets wrapped in its own
# namespace:

catch {
  package require jldb
  # following likely to fail, because done by other libraries too
  namespace import ::jldb::shortcuts::*
}

catch {
  package require aq
  namespace eval ::aq { }			;# so namespace is defined
}

######################################################################

global NAME			;# user's login name
global HOME			;# user's home directory

global J_PREFS			;# user preferences

global buttonBackground
global buttonForeground

::aq::aq_init aqqdcal	;# prefs, libraries, bindings...

###################################################################

global CELLWIDTH		;# width of a date cell
set CELLWIDTH 108		;# 72 * 1.5
global CELLHEIGHT		;# height of a date cell
set CELLHEIGHT 90		;# 72 * 1.25
global APPTWIDTH		;# number of chars to display in date box
set APPTWIDTH [expr {$CELLWIDTH - 2}]

global currentyyyy currentmm currentdd

###################################################################
# given current month/year, view next

proc smallnext {yyyy mm} {
  incr mm 1
  if {$mm > 12} {
    incr yyyy 1
    set mm 1
  }
  smallmonth $yyyy $mm
}

###################################################################
# given current month/year, view previous

proc smallprev {yyyy mm} {
  incr mm -1
  if {$mm < 1} {
    incr yyyy -1
    set mm 12
  }
  smallmonth $yyyy $mm
}

###################################################################
# given current month/year, view next

proc bignext {yyyy mm} {
  incr mm 1
  if {$mm > 12} {
    incr yyyy 1
    set mm 1
  }
  bigmonth $yyyy $mm
}

###################################################################
# given current month/year, view previous

proc bigprev {yyyy mm} {
  incr mm -1
  if {$mm < 1} {
    incr yyyy -1
    set mm 12
  }
  bigmonth $yyyy $mm
}

###################################################################

proc numdays {yyyy mm} {
  set days(1)  31
  set days(2)  28
  set days(3)  31
  set days(4)  30
  set days(5)  31
  set days(6)  30
  set days(7)  31
  set days(8)  31
  set days(9)  30
  set days(10) 31
  set days(11) 30
  set days(12) 31
  
  if {(($yyyy % 4) == 0) & (($yyyy % 100) != 0)} {
    set days(2) 29
  }
  return $days($mm)
}

###################################################################

proc daynum2dayname {daynum {length -short}} {
  if {$length == "-short"} {
    set days(0) Sun
    set days(1) Mon
    set days(2) Tue
    set days(3) Wed
    set days(4) Thu
    set days(5) Fri
    set days(6) Sat
  } else {
    set days(0) Sunday
    set days(1) Monday
    set days(2) Tuesday
    set days(3) Wednesday
    set days(4) Thursday
    set days(5) Friday
    set days(6) Saturday
  }
  return $days($daynum)
}

###################################################################

proc date2dayname {yyyy mm dd {length -short}} {
  return [daynum2dayname [date2daynum $yyyy $mm $dd] $length]
}

###################################################################

proc monthnum {month} {
  set monthnames(Jan) 1
  set monthnames(Feb) 2
  set monthnames(Mar) 3
  set monthnames(Apr) 4
  set monthnames(May) 5
  set monthnames(Jun) 6
  set monthnames(Jul) 7
  set monthnames(Aug) 8
  set monthnames(Sep) 9
  set monthnames(Oct) 10
  set monthnames(Nov) 11
  set monthnames(Dec) 12
  return $monthnames($month)
}

###################################################################

proc monthname {mm {length {-short}}} {
  if {$length == "-short"} {
  set mm [format "%d" $mm]
    set months(1) Jan
    set months(2) Feb
    set months(3) Mar
    set months(4) Apr
    set months(5) May
    set months(6) Jun
    set months(7) Jul
    set months(8) Aug
    set months(9) Sep
    set months(10) Oct
    set months(11) Nov
    set months(12) Dec
  } else {
    set months(1) January
    set months(2) February
    set months(3) March
    set months(4) April
    set months(5) May
    set months(6) June
    set months(7) July
    set months(8) August
    set months(9) September
    set months(10) October
    set months(11) November
    set months(12) December
  }
  return $months($mm)
}
  
###################################################################

proc date2daynum { yyyy mm dd } {
# should be table-driven!
#   set firstweek [exec cal $mm $yyyy | head -3 | tail -1]
#   set firstpos [string first "1" $firstweek]
#   set firstdaynum [expr int($firstpos / 3)]
#   
#   set daynum [expr int( ($firstdaynum + $dd - 1) % 7)]
#   return $daynum

  if { $mm == 2 } {				;# folg code breaks on feb.
    return [expr {([date2daynum $yyyy 1 $dd] + 3) % 7}]
  }
  set m [expr {($mm + 10) % 12}]
  if {$m > 10} {incr yyyy -1}
  set c [expr {$yyyy / 100}]	;# integer division
  set yy [expr {$yyyy % 100}]
  set daynum [expr {( ( (26*$m-2)/10 )+$dd+$yy+($yy/4)+($c/4)-(2*$c) ) % 7}]
  return $daynum
}

###################################################################

proc setcurrent {} {
  global currentyyyy currentmm currentdd
  set date [exec date]
  set currentyyyy [lindex $date 5]
  set currentmm [monthnum [lindex $date 1]]
  set currentdd [lindex $date 2]
  .button configure \
    -text [format "%04d.%02d.%02d" $currentyyyy $currentmm $currentdd]
}

###################################################################

proc showcurrent {} {
  global currentyyyy currentmm currentdd
  smallmonth $currentyyyy $currentmm
}
  
###################################################################

proc smallmonth {yyyy mm} {
  global HOME
  global currentyyyy currentmm currentdd
  
  set tl .$yyyy-$mm
  if [winfo exists $tl] {destroy $tl}
  
  toplevel $tl
  wm minsize $tl 5 5
  wm maxsize $tl 5000 5000

  frame $tl.b
  button $tl.b.prev -text "<<" -command "smallprev $yyyy $mm"
  button $tl.b.close -text "Close" -command "destroy $tl"
  button $tl.b.big -text "Big" -command "bigmonth $yyyy $mm"
  button $tl.b.next -text ">>" -command "smallnext $yyyy $mm"
  pack append $tl.b \
    $tl.b.prev {left} \
    $tl.b.close {left expand fillx} \
    $tl.b.big {left expand fillx} \
    $tl.b.next {left}
  pack $tl.b -side top -fill x
  
  label $tl.month \
    -text "[monthname $mm -long] $yyyy" \
    -font {Helvetica -10 bold}
  pack $tl.month -side top -fill x
  
  frame $tl.mid -width 240 -height 240
  text $tl.mid.view -wrap none \
    -yscrollcommand "$tl.mid.sb set" \
    -width 10 -height 20
  scrollbar $tl.mid.sb  -command "$tl.mid.view yview"
  pack propagate $tl.mid 0
  pack $tl.mid.view -expand 1 -fill both -side left
  pack $tl.mid.sb -fill y -side left
  pack $tl.mid -side top -expand 1 -fill both
  
  for {set dd 1} {$dd <= [numdays $yyyy $mm]} {incr dd 1} {
    set fr $tl.mid.view.date$dd
    set day $fr.day
    set button $fr.b
    set appointmentfile "$HOME/Calendar/xc$dd[monthname $mm]$yyyy"
    set appttext [readappts $yyyy $mm $dd]
    frame $fr
    label $day -width 6 -font {Helvetica -8} \
      -text "[date2dayname $yyyy $mm $dd] $dd"
    button $button \
      -text $appttext \
      -width 40 -font {Helvetica -8} -justify left -anchor nw \
      -height 1 -borderwidth 1 -padx 1 -pady 1 \
      -command "
        after 1 \{
          exec aqedit ${appointmentfile}
          $button configure -text \[readappts $yyyy $mm $dd\]
          adjustheight $button
          \}
      "
    adjustheight $button
    if {$yyyy == $currentyyyy && $mm == $currentmm && $dd == $currentdd} {
      $day configure -foreground blue
      $day configure -font {Helvetica -8 bold}
      $button configure -foreground blue
    } else {
      $day configure -foreground black
      $button configure -foreground black
    }
    pack append $fr $day {left} $button {left expand fill}
    $tl.mid.view window create end -window $fr
    $tl.mid.view insert end "\n"
  }
  fillmonth $yyyy $mm $tl.mid.view.scrolled $tl.mid.view $tl.mid.sb
}

###############################################################################
# set height of button to match its contents, up to four lines

proc adjustheight {b} {
  set text [$b cget -text]
  set l [llength [split $text "\n"]]
  if {$l > 4} {set l 4}
  if {$l < 1} {set l 1}
  $b configure -height $l
}

###################################################################

proc fillmonth {yyyy mm child parent scrollbar} {
  global HOME
  global currentyyyy
  global currentmm
  global currentdd
  
  if {! [winfo exists $child]} {
    return 0
  }
  for {set dd 1} {$dd <= [numdays $yyyy $mm]} {incr dd 1} {
    set fr $child.date$dd
    set button $fr.b

    $button configure -height 1
    
    # today is blue; other days are black
    if {$yyyy == $currentyyyy && $mm == $currentmm && $dd == $currentdd} {
      $button configure -foreground blue
    } else {
      $button configure -foreground black
    }

    set filename [format "$HOME/Calendar/xc%d%s%d" $dd [monthname $mm] $yyyy]
    if [file exists $filename] {
      set appt [::aq::read_file $filename]
      $button configure -text $appt
      set height [llength [split $appt \n]]
      if {$height > 4} {set height 4}
      $button configure -height $height
    }
  }
  
  update idletasks
}

###################################################################

proc readappts {yyyy mm dd} {
  global HOME

  set filename "$HOME/Calendar/xc$dd[monthname $mm]$yyyy"
  if [file exists $filename] {
    set file [open $filename {r}]
    set text [read $file]
    close $file
  } else {
    set text {}
  }
  return $text
}

###################################################################

proc bigmonth {yyyy mm} {
  global HOME
  global CELLWIDTH
  global CELLHEIGHT
  global APPTWIDTH
  global currentyyyy currentmm currentdd
  
  set tl .big-$yyyy-$mm

  if [winfo exists $tl] {
    destroy $tl
  }
  
  toplevel $tl
  canvas $tl.c \
    -width [expr {7*$CELLWIDTH+1}] \
    -height [expr {6*$CELLHEIGHT+24+1}] \
    -background white
  frame $tl.b
  button $tl.b.next -text Next -width 10 -command "bignext $yyyy $mm"
  button $tl.b.prev -text Back -width 10 -command "bigprev $yyyy $mm"
  button $tl.b.small -text Small -width 10 -command "smallmonth $yyyy $mm"
  button $tl.b.quit -text Close -width 10 -command "destroy $tl"
  button $tl.b.postscript -text PostScript -width 10 -command "
    $tl.c postscript -file \[::aq::fs\] -rotate 1 -pagewidth 10i
  "
  button $tl.b.print -text Print -width 10 -command "
    exec lpr -h << \[$tl.c postscript -rotate 1 -pagewidth 10i\]
  "
  pack append $tl.b \
    [::aq::filler $tl.b] {top} \
    [::aq::filler $tl.b] {bottom} \
    [::aq::filler $tl.b] {right} \
    $tl.b.next {right} \
    [::aq::filler $tl.b] {right} \
    $tl.b.prev {right} \
    [::aq::filler $tl.b] {right} \
    $tl.b.small {right} \
    [::aq::filler $tl.b] {right} \
    $tl.b.quit {right} \
    [::aq::filler $tl.b] {right} \
    $tl.b.postscript {right} \
    [::aq::filler $tl.b] {right} \
    $tl.b.print {right}
  pack append $tl $tl.c {top fill}
  pack append $tl $tl.b {top fillx}
  
  $tl.c create text [expr {3.5*$CELLWIDTH}] 12 \
    -text "[monthname $mm -long] $yyyy" \
    -font -*-times-bold-r-normal--18-180-*
  
  # following is horrendously inefficient!
  for {set i 0} {$i <= [expr 7*$CELLWIDTH]} {incr i $CELLWIDTH} {
    $tl.c create line $i 24 $i [expr {24+6*$CELLHEIGHT}]
  }
  for {set i 24} {$i <= [expr {6*$CELLHEIGHT+24}]} {incr i $CELLHEIGHT} {
    $tl.c create line 0 $i [expr {7*$CELLWIDTH}] $i
  }
  set offset [expr {[date2daynum $yyyy $mm 1] - 1}]
  for {set i 1} {$i <= [numdays $yyyy $mm]} {incr i} {
    set x [expr {((($i + $offset) % 7) * $CELLWIDTH) + 3}]
    set y [expr {((($i + $offset) / 7) * $CELLHEIGHT) + 24 + 2}]
    $tl.c create text $x $y -anchor nw -tag date-$i \
      -text "$i  [date2dayname $yyyy $mm $i]" \
      -font -*-helvetica-medium-r-normal--10-100-*
    set appointmentfile "$HOME/Calendar/xc$i[monthname $mm]$yyyy"
    catch {::aq::read_file $appointmentfile} foo
    set text [readappts $yyyy $mm $i]
    if {![string length $text]} {
      set text {                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
                                                                           
}
    }
    $tl.c create text $x [expr {$y + 12}] -anchor nw \
      -tag appointments-$i \
      -width $APPTWIDTH \
      -text $text \
      -font -*-times-medium-r-normal--8-80-*
    $tl.c bind appointments-$i <1> "
      after 1 \{
        exec aqedit ${appointmentfile}
        $tl.c itemconfigure appointments-$i \
          -text \[readappts $yyyy $mm $i\]
        \}
    "
  }
  if {$yyyy == $currentyyyy && $mm == $currentmm} {
    $tl.c itemconfigure appointments-$currentdd -fill blue
  }
}

###################################################################

wm title . calendar

if ![file isdirectory ~/Calendar] {
  exec mkdir [glob ~]/Calendar
}

set buttonBackground [option get . buttonBackground ToolBackground]
set buttonForeground [option get . buttonForeground ToolForeground]

if {$buttonBackground == ""} {set buttonBackground grey80}
if {$buttonForeground == ""} {set buttonForeground black}

button .button \
  -width 15 \
  -background $buttonBackground \
  -foreground $buttonForeground \
  -activebackground $buttonBackground \
  -font -*-lucidatypewriter-medium-r-normal-sans-10-100-*-*-m-*-*-* \
  -text {} \
  -relief raised \
  -command {setcurrent; showcurrent}

bind .button <Control-q> {exit}
bind .button <Meta-q> {exit}
bind .button <Control-c> {exit}
bind .button <Control-period> {exit}

# pack .button -in . -side top -ipady 2
# 
# setcurrent
# 
# focus .button

# showcurrent

wm withdraw .
setcurrent
showcurrent

# make sure we quit if the last window is deleted

bind all <Destroy> {
  # There's always one child, .button, although we're not using it
  # currently.  This is called before the window is actually destroyed,
  # so if we're the last toplevel there will be two children total.
  if {[llength [winfo children .]] == 2} {
    exit 0
  }
}
