#!/usr/local/bin/wish4.0
# jcalendar - simple Tk-based appointment calendar
#
######################################################################
# Copyright 1992-1995 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(JSTOOLS_LIB)]} {
  set jstools_library $env(JSTOOLS_LIB)
} else {
  set jstools_library /usr/local/lib/jstools
}

# add the jstools library to the library search path:

set auto_path [concat [list $jstools_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 jstools libraries.

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

## end boiler_header

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

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

global J_PREFS			;# user preferences

global buttonBackground
global buttonForeground

j:jstools_init			;# 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
  }
  bigmonth $yyyy $mm
}

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

proc smallprev {yyyy mm} {
  incr mm -1
  if {$mm < 1} {
    incr yyyy -1
    set mm 12
  }
  bigmonth $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
  bigmonth $currentyyyy $currentmm
}
  
###################################################################

proc smallmonth {yyyy mm} {
  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.next -text ">>" -command "smallnext $yyyy $mm"
  pack append $tl.b \
    $tl.b.prev {left} \
    $tl.b.close {left expand fillx} \
    $tl.b.next {left}
  pack append $tl $tl.b {top expand fillx}
  
  for {set dd 1} {$dd < 32} {incr dd 1} {
    set fr $tl.date$dd
    set day $fr.day
    set text $fr.text
    
    frame $fr
    label $day -width 6 -font -*-clean-medium-r-normal--6-*-*-*-*-*-*-* \
      -text "[date2dayname $yyyy $mm $dd] $dd"
    text $text \
      -width 40 -font -*-clean-medium-r-normal--6-*-*-*-*-*-*-* \
      -height 1 -borderwidth 1 -relief sunken -wrap none
    pack append $fr $day {left} $text {left expand fill}
    pack append $tl $fr {top expand fill}
  }
  fillmonth $yyyy $mm
}

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

proc fillmonth {yyyy mm} {
  global HOME
  
  set tl .$yyyy-$mm
  
  if {! [winfo exists $tl]} {
    return 0
  }
  for {set dd 1} {$dd < 32} {incr dd 1} {
    set fr $tl.date$dd
    set text $fr.text

    $text delete 0.0 end
    $text configure -height 1
    
    set filename [format "$HOME/Calendar/xc%d%s%d" $dd [monthname $mm] $yyyy]
    if [file exists $filename] {
      $text insert end [j:fileio:read $filename]
      
      set height [lindex [split [$text index end] .] 0]
      $text configure -height $height
    }
  }
}

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

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 \[j: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 \
    [j:filler $tl.b] {top} \
    [j:filler $tl.b] {bottom} \
    [j:filler $tl.b] {right} \
    $tl.b.next {right} \
    [j:filler $tl.b] {right} \
    $tl.b.prev {right} \
    [j:filler $tl.b] {right} \
    $tl.b.small {right} \
    [j:filler $tl.b] {right} \
    $tl.b.quit {right} \
    [j:filler $tl.b] {right} \
    $tl.b.postscript {right} \
    [j: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 {j:fileio:read $appointmentfile} foo
    $tl.c create text $x [expr {$y + 12}] -anchor nw \
      -tag appointments-$i \
      -width $APPTWIDTH \
      -text [readappts $yyyy $mm $i] \
      -font -*-times-medium-r-normal--8-80-*
    $tl.c bind appointments-$i <1> "
      after 1 \{
        exec jedit ${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



