#!/usr/local/bin/dpwish -f
#
#if {[lindex $argv 0] == "-god"} {
#  #puts "setting god=1"
#  set god 1
#} else {
#  set god 0
#}
set debug 0
set god   0
foreach arg $argv {
  switch -- $arg {
    "-god"	{set god 1; puts "god=1"}
    "-debug"	{set debug 1; puts "debug=1"}
  }
}
# first, get rid of main window
#set color_model [tk colormodel .]	# gone with V4.0
set color_model "color"
wm withdraw .
#
#########################################################################
# define procedures
#########################################################################
proc Connect {} {
  global server username rpc_port server_name
  
  if {[catch {set server [dp_MakeRPCClient $server_name $rpc_port]}]} {
    return 0
  }
  return 1
}

proc AnyCmd {cmd} {
  uplevel { $cmd }
}

proc TestFont {font} {
  global top_win

  toplevel $top_win.testfont
  set result 1
  if {[catch {button ${top_win}.testfont.b -font $font}]} {
    set result 0
  }
  destroy ${top_win}.testfont
  return $result
}

proc Dialog {w title text bitmap default args} {
  global dialog_button top_win prop_font
  
  toplevel $w -class Dialog
  wm geometry $w +400+400
  wm title $w $title
  wm iconname $w Dialog
  frame $w.top -relief raised -bd 1
  pack $w.top -side top -fill both
  frame $w.bot -relief raised -bd 1
  pack $w.bot -side bottom -fill both

  message $w.top.msg -width 3i -text $text -font $prop_font
  pack $w.top.msg -side right -expand 1 -fill both -padx 5m -pady 5m
  if {$bitmap != ""} {
    label $w.top.bitmap -bitmap $bitmap
    pack $w.top.bitmap -side left -padx 5m -pady 5m
  }
  set i 0
  foreach but $args {
    button $w.bot.button$i -text $but -command "set dialog_button $i"
    if {$i == $default} {
      frame $w.bot.default -relief sunken -bd 1
      pack $w.bot.default -side left -expand 1 -padx 5m -pady 2m
      pack $w.bot.button$i -in $w.bot.default -side left \
        -padx 3m -pady 3m -ipadx 2m -ipady 1m
    } else {
      pack $w.bot.button$i -side left -expand 1 \
        -padx 5m -pady 5m -ipadx 2m -ipady 1m
    }
    incr i
  }
  if {$default > 0} {
    bind $w <Return> "$w.bot.button$default flash; set dialog_button $default"
  }
  set oldFocus "[focus]"
  #puts "DEBUG: oldFocus=$oldFocus"
  tkwait visibility $w
  grab $w
  #puts "DEBUG: \$w = $w"
  focus $w
  #puts "after focus $w"
  tkwait variable dialog_button
  #puts "after: tkwait variable dialog_button"
  # wait for user to respond
  destroy $w
  #puts "after: destroy $w"
  if {$oldFocus != ""} { focus $oldFocus }
  #puts "after: focus $oldFocus"
  return $dialog_button
}

proc ShowHoliday {w title text bitmap default args} {
  global dialog_button top_win last_display resconf_geometry prop_font
  
  toplevel $w -class Dialog
  set last_display $w
  wm geometry $w +400+400
  wm title $w $title
  wm iconname $w Dialog
  frame $w.top -relief raised -bd 1
  pack $w.top -side top -fill both
  frame $w.bot -relief raised -bd 1
  pack $w.bot -side bottom -fill both

  bind $w <Configure> "rc_set_geom \[wm geom $w\]"
  wm geom $w $resconf_geometry

  message $w.top.msg -width 3i -text $text -font $prop_font
  pack $w.top.msg -side right -expand 1 -fill both -padx 5m -pady 5m
  if {$bitmap != ""} {
    label $w.top.bitmap -bitmap $bitmap
    pack $w.top.bitmap -side left -padx 5m -pady 5m
  }
  set i 0
  foreach but $args {
    button $w.bot.button$i -text $but -command "set dialog_button $i"
    if {$i == $default} {
      frame $w.bot.default -relief sunken -bd 1
      pack $w.bot.default -side left -expand 1 -padx 5m -pady 2m
      pack $w.bot.button$i -in $w.bot.default -side left \
        -padx 3m -pady 3m -ipadx 2m -ipady 1m
    } else {
      pack $w.bot.button$i -side left -expand 1 \
        -padx 5m -pady 5m -ipadx 2m -ipady 1m
    }
    incr i
  }
  if {$default > 0} {
    bind $w <Return> "$w.bot.button$default flash; set dialog_button $default"
  }
  set oldFocus "[focus]"
  #puts "DEBUG: oldFocus=$oldFocus"
  tkwait visibility $w
  focus $w
  tkwait variable dialog_button
  # wait for user to respond
  catch {destroy $w}
  set last_display ""
  if {$oldFocus != ""} { focus $oldFocus }
  return $dialog_button
}

proc SetSelectMark {x y} {
  global mc_x1 mc_x2 mc_y1 mc_y2 ygap xgap starty people ignore_request
  global biglist armed_person select_start_half selected_person top_win
  global debug

  #if {$debug} {puts "SetSelectMark: x=$x, y=$y"}
  if {$ignore_request} {set ignore_request 0}
  if {$y < $starty} {return}
  set orig_x $x
  set orig_y $y
  set x [expr int([$top_win.c canvasx $x])]
  set y [expr int([$top_win.c canvasy $y])]
  #if {$debug} {puts "	newx=$x, newy=$y"}
  set mc_y1 [expr ($y / $ygap) * $ygap + 1]
  set selected_person [lindex $people [expr int(($mc_y1 - $starty) / $ygap)]]
  #puts "$selected_person: $x $y"
  set mc_y2 [expr $mc_y1 + $ygap - 2]
  set mc_x1 [expr ($x / $xgap) * $xgap]
  set start_cell [expr $mc_x1 / $xgap]
  if {[expr $x % $xgap] < 8} {
    set mc_x2 $mc_x1
    set half 0
  } else {
    set mc_x2 [expr (($x / $xgap) + 1) * $xgap]
    set half 1
  }
  #if {$debug} {puts "   mc_x1=$mc_x1, mc_y1=$mc_y1, mc_x2=$mc_x2, mc_y2=$mc_y2"}
  set ret [lindex $biglist($selected_person) [expr ($start_cell*2)+$half]]
  if {($ret == "") || ($ret > 0)} {
    set ignore_request 1
    EditReservation $orig_x $orig_y
  } else {
    $top_win.c delete select_box
    # DrawSelectBox $x $y
    DrawSelectBox $orig_x $orig_y
    set select_start_half [expr $mc_x1 / $xgap * 2 + (($mc_x2 - $mc_x1)/$xgap)]
    #if {$debug} {puts "   select_start_half=$select_start_half"}
  }
}

proc DrawSelectBox {x y} {
  global mc_x1 mc_x2 mc_x3 mc_x4 mc_x2 mc_y1 mc_y2 xgap starty top_win
  global ignore_request selectbox_color num_cells select_start_half debug
  global num_halfcells selected_person biglist num_scroll_cells auto_scroll

  #if {$debug} {puts "DrawSelectBox: x=$x, y=$y"}
  if {$ignore_request} {return}
  if {$y < $starty} {return}
  set save_x $x
  set x [expr int([$top_win.c canvasx $x])]
  if {$x < $mc_x1} {set x $mc_x1}
  set mc_x3 [expr (($x / $xgap) + 1) * $xgap]
  if {[expr $x % $xgap] >= 8} {
    set mc_x4 $mc_x3
  } else {
    set mc_x4 [expr $mc_x3 - $xgap]
  }
  # HACK_START
  # ehc == end_half_cell
  set ehc [expr $mc_x3 / $xgap * 2 - 1 - (($mc_x3 - $mc_x4)/$xgap)]
  #if {$debug} {puts "  A: x3=$mc_x3, x4=$mc_x4, ehc=$ehc"}
  for {set i $select_start_half} {$i <= $ehc} {incr i} {
    if {[lindex $biglist($selected_person) $i] != 0} {
      set ehc [expr $i - 1]
      set select_start_half $ehc
      set tmp [expr $ehc/2 * $xgap]
      set mc_x3 [expr $tmp + $xgap]
      set mc_x4 [expr $tmp + ($ehc % 2) * $xgap]
      break
    }
  }
  #if {$debug} {puts "  B: x3=$mc_x3, x4=$mc_x4, ehc=$ehc"}
  if {$ehc >= $num_halfcells} {
    set ehc [expr $num_halfcells - 1]
    set tmp [expr $ehc/2 * $xgap]
    set mc_x3 [expr $tmp + $xgap]
    set mc_x4 [expr $tmp + ($ehc % 2) * $xgap]
  }
  #if {$debug} {puts "  C: x3=$mc_x3, x4=$mc_x4, ehc=$ehc"}
  # HACK_END
  if {($mc_x2 != $mc_x3) || ($mc_x1 != $mc_x4)} {
    $top_win.c delete select_box
    $top_win.c addtag select_box withtag\
      [$top_win.c create poly $mc_x1 $mc_y2 $mc_x2 $mc_y1 \
      $mc_x3 $mc_y1 $mc_x4 $mc_y2 -fill $selectbox_color]
  }
  ################
  set win_wid [winfo width $top_win.c]
  #puts "DEBUG: save_x=$save_x, win_wid=$win_wid"
  if {$save_x >= $win_wid} {
    set scroll_info [$top_win.hscroll get]
    if {[lindex $scroll_info 3] < $num_cells} {
      #set scroll_inc [expr $xgap * int(($save_x - $win_wid)/10 + 1)]
      set scroll_inc "0.02"
      set auto_scroll 1
      #$top_win.c xview [expr [lindex $scroll_info 2] + $scroll_inc]
      $top_win.c xview moveto [expr [lindex $scroll_info 0] + $scroll_inc]
      after 200 "AutoScroll $scroll_inc"
    } else {
      set auto_scroll 0
    }
  } else {
    set auto_scroll 0
  }
}

proc AutoScroll {scroll_inc} {
  global auto_scroll num_cells as_busy top_win

  if {(!$auto_scroll)||($as_busy)} {return}
  set as_busy 1
  set scroll_info [$top_win.hscroll get]
  if {[lindex $scroll_info 3] < $num_cells} {
    #$top_win.c xview [expr [lindex $scroll_info 2] + $scroll_inc]
    $top_win.c xview moveto [expr [lindex $scroll_info 0] + $scroll_inc]
    after 200 "AutoScroll $scroll_inc"
  }
  set as_busy 0
}
proc ReservePerson {x y} {
  global mc_x1 mc_x2 mc_x3 mc_x4 mc_x2 mc_y1 people starty
  global ygap xgap username auto_scroll
  global ignore_request armed_person_change server
  global resconf_sonst resconf_cust resconf_user resconf_fone busy_cb

  set auto_scroll 0
  if {$ignore_request} {set ignore_request 0; return}
  if {$y < $starty} {return}
  set person [lindex $people [expr ($mc_y1 - $starty) / $ygap]]

  set start_halfcell [expr $mc_x1 / $xgap * 2 + (($mc_x2 - $mc_x1)/$xgap)]

  set end_halfcell [expr $mc_x3 / $xgap * 2 - 1 - (($mc_x3 - $mc_x4)/$xgap)]
  if {$mc_x3 != $mc_x4} {set end_half morning}
  if {[ReserveConfirm confirm $person $start_halfcell $end_halfcell {}] > 0} {
    set armed_person_change 1
    # for the secretaries...
    NotifyQuery confirm $person $start_halfcell $end_halfcell
  }
  ExecRPC LogIt "{$username reserved person $person}\
      {\tfrom [Convert nicedate $start_halfcell]}\
      {\tto [Convert nicedate $end_halfcell]}\
      {\tcustomer : $resconf_cust}\
      {\ttelephone: $resconf_fone}\
      {\tsonstiges: $resconf_sonst}\
      {\tbusy     : $busy_cb}"
}

proc DeleteReservation {x y} {
  global people biglist starty xgap ygap signon armed_person
  global resconf_sonst resconf_cust resconf_user resconf_fone
  global person_reservations server top_win busy_cb
  global armed_person_change dialog_button username

  if {$y < $starty} {return}
  set x [expr int([$top_win.c canvasx $x])]
  set person [lindex $people [expr ($y - $starty) / $ygap]]
  if {$person != $armed_person} {
    Dialog .dialog {ERROR}\
      "You can only delete reservations for person $armed_person"\
      error -1 OK
    return
  }
  set halfcell [expr $x / $xgap * 2 + [expr $x % $xgap >= 8]]
  #puts "halfcell=$halfcell, person=$person"
  if {[lindex $biglist($person) $halfcell] == 0} {
    #puts -nonewline "\007"
    #flush stdout
    return
  }
  set tag [lindex $biglist($person) $halfcell]
  set found 0
  set index 0
  foreach ent $person_reservations($person) {
    if {[lindex $ent 0] == $tag} {
      set start [lindex $ent 1]
      set end [lindex $ent 2]
      set resconf_cust [lindex $ent 3]
      set resconf_sonst [lindex $ent 4]
      set resconf_fone [lindex $ent 5]
      set found 1
      break
    }
    incr index
  }
  # consistency check:
  if {!$found} {
    Dialog .dialog {KILLER} {DeleteReservation inconsistent, bailing}\
      error -1 OK
    QuitApp force
  }
  if {[ReserveConfirm delete $person $start $end $tag] > 0} {
    if {$person != $username} {
      Dialog .dialog {Warning} "This entry is for $person. $person is NOT\
        you! Are you absolutely sure you want to delete it????\n\n(A mail\
        will be sent to $person if you continue)" warning -1 Continue\
        Abort
      if {$dialog_button == 1} {return}
      ExecRPC Mail $person "abwesenheit entry deleted"\
        "$username deleted your entry from [Convert nicedate\
        $start] to [Convert nicedate $end]"
      set log_comment "(made by $person) "
    } else {set log_comment ""}
    #puts "DBG: person_reservations = $person_reservations($person)"
    #puts "    biglist = $biglist($person)"
    set newlist [lreplace $person_reservations($person) $index $index]
    set person_reservations($person) $newlist
    ZeroPersonBits $person $start $end
    UpdatePersonDisplay $person
    #puts "DBG: person_reservations = $person_reservations($person)"
    #puts "    biglist = $biglist($person)"
    set armed_person_change 1
    ExecRPC LogIt\
        "{$username deleted reservation ${log_comment}for $person}\
         {\tfrom [Convert nicedate $start]}\
         {\tto [Convert nicedate $end]}\
         {\tcustomer : $resconf_cust}\
         {\ttelephone: $resconf_fone}\
         {\tsonstiges: $resconf_sonst}\
         {\tbusy     : $busy_cb}"
    NotifyQuery delete $person $start $end
  }
}

proc EditReservation {x y} {
  global people xgap ygap starty armed_person biglist person_reservations
  global top_win armed_person_change username

  set person [lindex $people [expr int(($y - $starty) / $ygap)]]
  if {$person != $armed_person} {
    Dialog .d {Verboten!} "You can only reserve $armed_person." {error} -1 OK
    return
  }
  #SetSelectMark $x $y
  set x [expr int([$top_win.c canvasx $x])]
  set y [expr int([$top_win.c canvasy $y])]
  set halfcell [expr $x / $xgap * 2 + [expr $x % $xgap >= 8]]
  if {[lindex $biglist($person) $halfcell] == 0} {
    return
  }
  set tag [lindex $biglist($person) $halfcell]
  set found 0
  set index 0
  foreach ent $person_reservations($person) {
    if {[lindex $ent 0] == $tag} {
      set start [lindex $ent 1]
      set end [lindex $ent 2]
      set cust [lindex $ent 3]
      set sonst [lindex $ent 4]
      set fone [lindex $ent 5]
      set found 1
      break
    }
    incr index
  }
  if {!$found} {
    Dialog .dialog {KILLER} {DeleteReservation inconsistent, bailing}\
      error -1 OK
    QuitApp force
  }
  set busy [expr $tag/1000]
  set list [EditWin $person $start $end $cust $sonst $fone $busy]
  if {$list == ""}  {return}
  set armed_person_change 1
  set new_start	[lindex $list 0]
  set new_end	[lindex $list 1]
  set new_cust	[lindex $list 2]
  set new_sonst	[lindex $list 3]
  set new_fone	[lindex $list 4]
  set new_busy	[lindex $list 5]

  ZeroPersonBits $person $start $end
  set newlist [lreplace $person_reservations($person) $index $index]
  set person_reservations($person) $newlist
  ReserveBits $person $new_start $new_end "$new_cust" "$new_sonst"\
    "$new_fone" $new_busy
  UpdatePersonDisplay $person
  ExecRPC LogIt\
      "{$username edited reservation for $person. new values:}\
       {\tfrom [Convert nicedate $new_start]}\
       {\tto [Convert nicedate $new_end]}\
       {\tcustomer : $new_cust}\
       {\ttelephone: $new_fone}\
       {\tsonstiges: $new_sonst}\
       {\tbusy     : $new_busy}"
}

proc EditWin {person start end cust sonst fone busy} {
  global ew_from ew_to ew_cust ew_fone ew_sonst prop_font ew_result
  global ew_fromhalf ew_tohalf ew_busy error_msg_fg biglist
  set ew_cust $cust
  set ew_fone $fone
  set ew_sonst $sonst
  set ew_busy $busy

  #puts "EditWin: start=$start end=$end"
  # sort out start and end dates
  set tmp "[Convert file_format $start]"
  regexp {^([0-9]+/[0-9]+/[0-9]+)/([0-9]+)$} $tmp junk ew_from ew_fromhalf
  if {$ew_fromhalf} {set start_str "Afternoon"} else {set start_str "Morning"}
  #puts "start file_format: $tmp, ew_fromhalf = $ew_fromhalf"

  set tmp "[Convert file_format $end]"
  regexp {^([0-9]+/[0-9]+/[0-9]+)/([0-9]+)$} $tmp junk ew_to ew_tohalf
  if {$ew_tohalf} {set end_str "Afternoon"} else {set end_str "Morning"}
  #puts "end file_format: $tmp, ew_tohalf = $ew_tohalf, end_str=$end_str"


  if {$ew_busy} {
    set busy_str "In office, but BUSY"
  } else {
    set busy_str "Out of office"
  }
  set w .editwin
  toplevel $w

  ##########
  # window banner
  message $w.msg -aspect 1000 -font $prop_font -text {Edit A Reservation}
  pack $w.msg -side top -expand 1 -fill x

  ##########
  # from
  frame $w.from
  pack $w.from -side top -expand 1 -fill x
  label $w.from.lab1 -text "From" -width 10 -relief raised
  entry $w.from.entry -width 15 -textvar ew_from

  menubutton $w.from.mb -text $start_str -menu $w.from.mb.m -rel raised
  menu $w.from.mb.m
  $w.from.mb.m add command -label "Morning" -command "
    $w.from.mb config -text Morning
    set ew_fromhalf 0
  "
  $w.from.mb.m add command -label "Afternoon" -command "
    $w.from.mb config -text Afternoon
    set ew_fromhalf 1
  "
  pack $w.from.lab1 $w.from.entry $w.from.mb -side left

  ##########
  # to
  frame $w.to
  pack $w.to -side top -expand 1 -fill x
  label $w.to.lab1 -text "To" -width 10 -relief raised
  entry $w.to.entry -width 15 -textvar ew_to
  menubutton $w.to.mb -text $end_str -menu $w.to.mb.m -rel raised
  menu $w.to.mb.m
  $w.to.mb.m add command -label "Morning" -command "
    $w.to.mb config -text Morning
    set ew_tohalf 0
  "
  $w.to.mb.m add command -label "Afternoon" -command "
    $w.to.mb config -text Afternoon
    set ew_tohalf 1
  "
  pack $w.to.lab1 $w.to.entry $w.to.mb -side left

  ##########
  # customer
  frame $w.cust
  pack $w.cust -side top -expand 1 -fill x
  label $w.cust.lab1 -text "Cust/Desc" -width 10 -relief raised
  entry $w.cust.entry -width 40 -textvar ew_cust
  pack $w.cust.lab1 $w.cust.entry -side left

  ##########
  # telephone
  frame $w.fone
  pack $w.fone -side top -expand 1 -fill x
  label $w.fone.lab1 -text "Fone" -width 10 -relief raised
  entry $w.fone.entry -width 40 -textvar ew_fone
  pack $w.fone.lab1 $w.fone.entry -side left

  ##########
  # other (sonst)
  frame $w.sonst
  pack $w.sonst -side top -expand 1 -fill x
  label $w.sonst.lab1 -text "Other" -width 10 -relief raised
  entry $w.sonst.entry -width 40 -textvar ew_sonst
  pack $w.sonst.lab1 $w.sonst.entry -side left

  ##########
  # busy
  frame $w.busy
  pack $w.busy -side top -expand 1 -fill x
  menubutton $w.busy.mb -text $busy_str -menu $w.busy.mb.m -rel raised
  pack $w.busy.mb -side left
  menu $w.busy.mb.m
  $w.busy.mb.m add command -label "Out of office" -command "
    set ew_busy 0
    $w.busy.mb config -text {Out of office}
  "
  $w.busy.mb.m add command -label "In office, but BUSY" -command "
    set ew_busy 1
    $w.busy.mb config -text {In office, but BUSY}
  "

  ##########
  # message
  message $w.message -text "" -aspect 1000 -font $prop_font -fg $error_msg_fg
  pack $w.message -side top
  
  ##########
  # buttons
  frame $w.buttons
  pack $w.buttons -side top
  button $w.buttons.cancel -text "Cancel" -command "set ew_result 0"
  button $w.buttons.save -text "Save" -command "set ew_result 1"
  pack $w.buttons.cancel $w.buttons.save -side left -padx 20 

  ##########################################
  # done setting up, now wait for something
  ##########################################
  set done 0
  set ew_result ""
  tkwait visibility $w
  grab $w
  while {!$done} {
    tkwait variable ew_result
    #puts "\nafter tkwait"
    if {!$ew_result} {
      set ret_str ""
      set done 1
      break
    }
    set start_hc [ConvertFromFileDate "$ew_from/$ew_fromhalf"]
    if {($start_hc == -1)||($start_hc == "")} {
      $w.message config -text "start date invalid"
      after 900 "$w.message config -text {}"
      continue
    }
    #puts "start_hc = $start_hc"
    set end_hc [ConvertFromFileDate "$ew_to/$ew_tohalf"]
    if {($end_hc == -1)||($end_hc == "")} {
      $w.message config -text "end date invalid"
      after 900 "$w.message config -text {}"
      continue
    }
    #puts "end_hc = $end_hc"

    if {$start_hc > $end_hc} {
      $w.message config -text "Start after End"
      after 900 "$w.message config -text {}"
      continue
    }
    # check start
    #puts "start=$start"
    if {$start_hc < $start} {
      # if start half-cell has been moved left...
      set ok 1
      for {set ind $start_hc} {$ind < $start} {incr ind} {
        #puts "check start: looking at $ind"
        if {[lindex $biglist($person) $ind] != 0} {
          $w.message config -text "Start would overlap another reservation"
          after 900 "$w.message config -text {}"
          set ok 0
          #puts "check start: stopped at cell $ind"
          break
        }
        incr ind
      }
      if {!$ok} {continue}
    }

    # check end
    #puts "end=$end"
    if {$end_hc > $end} {
      # if ending half-cell has been moved right...
      set ok 1
      for {set ind [expr $end + 1]} {$ind <= $end_hc} {incr end} {
        #puts "check end: looking at $ind"
        if {[lindex $biglist($person) $ind] != 0} {
          $w.message config -text "end would overlap another reservation"
          after 900 "$w.message config -text {}"
          set ok 0
          #puts "check end: stopped at cell $ind"
          break
        }
        incr ind
      }
      if {!$ok} {continue}
    }
    
    set ret_str "$start_hc $end_hc {$ew_cust} {$ew_sonst} {$ew_fone} $ew_busy"
    set done 1
  }
  destroy $w
  #puts "EditWin: returns \"$ret_str\""
  return $ret_str
}

proc DisplayReservation {x y} {
  global people biglist starty xgap ygap username armed_person
  global resconf_sonst resconf_cust resconf_user person_reservations
  global armed_person_change resconf_fone holiday_list messe_list
  global server top_win signon last_display

  if {$y < $starty} {return}
  set x [expr int([$top_win.c canvasx $x])]
  set person [lindex $people [expr ($y - $starty) / $ygap]]
  set halfcell [expr $x / $xgap * 2+ [expr $x % $xgap >= 8]]
  set tag [lindex $biglist($person) $halfcell]

  if {$last_display != ""} {
    destroy $last_display
    set last_display ""
  }
  if {$tag == 0} {
    set cell [expr $x / $xgap]
    if {[lsearch $holiday_list "_${cell}_"] != -1} {
      set tmp [ExecRPC GetHoliday $cell]
      set hol_name [lindex $tmp 0]
      set hol_type [lindex $tmp 1]
      ShowHoliday .dialog {Holiday} "$hol_type $hol_name" {} -1 OK
      return
    } elseif {[lsearch $messe_list "_${cell}_"] != -1} {
      ShowHoliday .dialog {Messe} "messe: [ExecRPC GetMesse $cell]" {} -1 OK
      return
    }
    return
  }
  set found 0
  set index 0
  foreach ent $person_reservations($person) {
    if {[lindex $ent 0] == $tag} {
      set start [lindex $ent 1]
      set end [lindex $ent 2]
      set resconf_cust [lindex $ent 3]
      set resconf_sonst [lindex $ent 4]
      set resconf_fone [lindex $ent 5]
      #puts "DispRes: ent=$ent"
      #puts "DispRes: resconf_fone=$resconf_fone"
      set found 1
      break
    }
    incr index
  }
  # consistency check:
  if {!$found} {
    Dialog .dialog {KILLER} {DisplayReservation inconsistent, bailing}\
      error -1 OK
    QuitApp force
  }
  ReserveConfirm display $person $start $end $tag
}

proc rc_set_geom {new_geom} {
  global resconf_geometry

  regsub {^[0-9]+x[0-9]+} $new_geom {} resconf_geometry
}

proc ReserveConfirm {op person start end tag} {
  global people username cell_binding resconf_button fone_cb resconf_fone
  global resconf_cust resconf_sonst resconf_user resconf_tablist busy_cb
  global prop_font error_msg_fg top_win debug resconf_geometry
  global last_display
 
  if {$tag > 999} {set busy_cb 1} else {set busy_cb 0}

  set from "[Convert nicedate $start]"
  set to "[Convert nicedate $end]"
  set w $top_win.resconf
  catch {destroy $w}
  set resconf_tablist "$w.customer.entry $w.fone.entry $w.sonst.entry"
  toplevel $w
  bind $w <Configure> "rc_set_geom \[wm geom $w\]"
  wm geom $w $resconf_geometry
  if {$op == "confirm"} {
    wm iconname $w "Confirm"
    wm title $w "Confirm Absence"
    set msg_text "Confirm Absence"
    set resconf_cust ""
    set resconf_sonst ""
    set resconf_fone ""
    set fone_cb 0
    set state "-state normal"
    set user_lab "Username:"
    set wid_cmd "entry"
    set text_arg "-textvariable"
    set width_arg "-width 40"
    set fone_width_arg "-width 15"
    set ent_relief "sunken"
    set dollar ""
  } elseif {$op == "display"} {
    wm iconname $w "Display"
    set last_display $w
    wm title $w "Display Absence"
    set msg_text "Display Absence"
    set state "-state disabled"
    set user_lab "Made by:"
    set wid_cmd "label"
    set text_arg "-text"
    set width_arg ""
    set fone_width_arg ""
    set ent_relief "flat"
    set dollar "\$"
  } elseif {$op == "delete"} {
    wm iconname $w "Delete"
    wm title $w "Delete"
    set msg_text "Really DELETE??"
    set state "-state disabled"
    set user_lab "Made by:"
    set wid_cmd "label"
    set text_arg "-text"
    set width_arg ""
    set fone_width_arg ""
    set ent_relief "flat"
    set dollar "\$"
  } else {
    #puts "ReserveConfirm: unknown operator: $op, bailing..."
    QuitApp force
  }
  set lab_relief "raised"
  set state ""
  message $w.msg -font $prop_font -width 3i -text $msg_text
  ####
  frame $w.person -bd 1m
  label $w.person.label -text "Person:" -width 10 -relief $lab_relief
  label $w.person.person -text "$person"
  pack $w.person.label -side left
  pack $w.person.person -side left
  ####
  frame $w.from -bd 1m
  label $w.from.label -text "From:" -width 10 -relief $lab_relief
  label $w.from.from -text "$from"
  pack $w.from.label -side left
  pack $w.from.from -side left
  ####
  frame $w.to -bd 1m
  label $w.to.label -text "To:" -width 10 -relief $lab_relief
  label $w.to.to -text "$to"
  pack $w.to.label -side left
  pack $w.to.to -side left
  ####
  frame $w.customer -bd 1m
  label $w.customer.label -text "Cust/Desc:" -width 10 -relief $lab_relief
  eval $wid_cmd $w.customer.entry -rel sunk $width_arg $text_arg \
    "${dollar}resconf_cust" $state -relief $ent_relief
  pack $w.customer.label -side left
  pack $w.customer.entry -side left
  ####
  frame $w.fone -bd 1m
  label $w.fone.label -text "Telephone at Customer:" -width 22 -relief\
    $lab_relief
  eval $wid_cmd $w.fone.entry -rel sunk $fone_width_arg $text_arg \
    "${dollar}resconf_fone" $state -relief $ent_relief
  pack $w.fone.label $w.fone.entry -side left
  if {$op == "confirm"} {
    checkbutton $w.fone.fone_cb -text "I refuse to provide a fone number"\
      -rel raised
    pack $w.fone.fone_cb -side left
  } else {
    set fone_cb 1
  }
  ####
  frame $w.sonst -bd 1m
  label $w.sonst.label -text "Other info:" -width 10 -relief $lab_relief
  eval $wid_cmd $w.sonst.entry -rel sunk $width_arg $text_arg\
    "${dollar}resconf_sonst" $state -relief $ent_relief
  pack $w.sonst.label -side left
  pack $w.sonst.entry -side left
  ####
  # busy but not absent
  ####
  checkbutton $w.busy_cb -text "Busy but not absent" -rel raised
  ####
  message $w.message -bd 1m -font $prop_font -width 4i -aspect 800
  ####
  frame $w.buttons -bd 1m -rel groove
  if {$op != "display"} {
    button $w.buttons.ok -text "Confirm" -command {set resconf_button\
      "confirm"}
    pack $w.buttons.ok -side left -expand 1 -padx 5m
  }
  button $w.buttons.cancel -text "Cancel" -command \
    {set resconf_button "cancel"}
  pack $w.buttons.cancel -side left -expand 1 -padx 5m

  #########
  foreach foo "$w.customer.entry $w.fone.entry $w.sonst.entry" {
    bind $foo <Tab> "Tab \$resconf_tablist"
    bind $foo <Return> "Tab \$resconf_tablist"
  }

  pack $w.msg -fill x
  pack $w.person -fill x
  pack $w.from -fill x
  pack $w.to -fill x
#  pack $w.user -fill x
  pack $w.customer -fill x
  pack $w.fone -fill x
  pack $w.sonst -fill x
  if {(($op == "display") && ($busy_cb)) || ($op != "display")} {
    pack $w.busy_cb
  }
  pack $w.message -fill x
  pack $w.buttons -fill x
  set old_focus [focus]
  tkwait visibility $w
  update
  if {$op != "display"} {
    grab $w
  }
  focus $w
  set done 0
  while {!$done} {
    tkwait variab resconf_button
    if {$resconf_button == "cancel"} {
      $top_win.c delete select_box
      set ret_val -1
      set done 1
      break
    } elseif {$op == "confirm"} {
      if {($resconf_fone != "")||($fone_cb)||($busy_cb)} {
        if {$debug} {puts "calling ReserveBits with busy_cb=$busy_cb"}
        ReserveBits $person $start $end "$resconf_cust" "$resconf_sonst"\
          "$resconf_fone" $busy_cb
        set ret_val 1
        set done 1
      } else {
        $w.message config -text "You must supply a telephone number"\
          -fg $error_msg_fg
        after 900 "$w.message config -text {}"
      }
    } else {
      set ret_val 1
      set done 1
    }
  }
  catch {destroy $w}
  set last_display ""
  focus $old_focus
  $top_win.c delete select_box
  if {$op != "display"} {UpdatePersonDisplay $person}
  return $ret_val
}

proc Quickie {message delay} {
  global quickie_var top_win prop_font

  catch {destroy $top_win.quickie}
  set quickie_var ""
  set w $top_win.quickie
  toplevel $w
  wm geometry $w +400+400
  message $w.msg -width 7c -text $message -font $prop_font
  pack $w.msg -expand 1 -fill both -padx 5m -pady 5m
  tkwait visibility $w
#  grab $w
  after [expr $delay * 1000] {set quickie_var foo}
  tkwait variable quickie_var
  # wait for user to respond
  catch {destroy $w}
}
#Quickie {\"reserve\" coming up...} 30

proc ArmPerson {person} {
  global armed_person armed_person_color_bg armed_person_color_ab
  global armed_person_change alarm_minutes armed_person_fg armed_person_color_af
  global username top_win lock_serial

  if {$armed_person != ""} {
    DisarmPerson $armed_person
  }
  UpdateIfChanged $person
  # ClientRequestLock calls Dialog himself if something goes wrong
  if {[ClientRequestLock "$person"]} {
    # got request lock for person
    $top_win.names.$person config -bg $armed_person_color_bg\
      -activebackground $armed_person_color_ab -command "DisarmPerson $person"\
      -foreground $armed_person_fg -activeforeground $armed_person_color_af
    set armed_person "$person"
    #alarm [expr $alarm_minutes * 60]
    bind $top_win.c <ButtonRelease-1> "ReservePerson %x %y"
    bind $top_win.c <B1-Motion> "DrawSelectBox %x %y"
    bind $top_win.c <1> "VerifyClick %x %y"
    #bind $top_win.c <Shift-1> "EditReservation %x %y"
    bind $top_win.c <3> "DeleteReservation %x %y"
    bind $top_win.c <2> "DeleteReservation %x %y"
    bind $top_win.c <Shift-ButtonRelease-1> {set foo 1}
    bind $top_win.c <Shift-B1-Motion> {set foo 1}
    set armed_person_change 0
    Quickie "you now have 2 minutes to modify ${person}'s schedule" 2
    incr lock_serial
    after 120000 "LockTimeout $person $lock_serial"
    #after 20000 "LockTimeout $person $lock_serial"
  }
}

proc LockTimeout {person serial} {
  global armed_person username lock_serial top_win

  set msg "."
  if {($armed_person == "") || ($lock_serial != $serial)} {return}
  # consistency check...
  if {$armed_person != $person} {
    puts "whoah! there's something wierd going on here..."
    QuitApp force
  }
  if {[info commands $top_win.resconf] == "$top_win.resconf"} {
    $top_win.resconf.buttons.cancel invoke
    set msg ", however your last change was thrown away."
  }
  if {[info command $top_win.addperson] == "$top_win.addperson"} {
    $top_win.addperson.buttons.cancel invoke
    set msg ", however any changed to person ${person}'s Stammdaten were\
      lost"
  }
  if {[info command .editwin] == ".editwin"} {
    .editwin.buttons.cancel invoke
    set msg "$msg and any changes to data in the open edit window were lost"
  }
  DisarmPerson $armed_person
  Dialog .dialog {timeout} "Your time ran out. Your changes to person\
    $person were saved$msg" warning -1 OK
}

proc VerifyClick {x y} {
  global armed_person starty ygap people ignore_request debug

  #if {$debug} {puts "VerifyClick: VerifyClick: x=$x, y=$y"}
  # call SetSelectMark after check
  if {[CheckDate]} {return}
  set person [lindex $people [expr int(($y - $starty) / $ygap)]]
  if {$person != $armed_person} {
    set ignore_request 1
    Dialog .d {Verboten!} "You can only reserve $armed_person." {error} -1 OK
    return
  } else {
    SetSelectMark $x $y
  }
}


proc DisarmPerson {person} {
  # first thing, turn off alarm
  #alarm 0
  global armed_person disarmed_person_color_bg disarmed_person_color_ab
  global data_dir lock_file_extension armed_person_change disarmed_person_fg
  global username server top_win person_reservations person_info signon
  global ignore_next_change

  if {$person != $armed_person} {
    Dialog .dialog {Really Fucked} "something really went wrong: trying to\
      disarm person $person but, armed_person set to $armed_person" {} -1 OK
    QuitApp force
  }
  if {$armed_person_change} {
    # something was changed
    # pass the new list back to server
    set ret [ExecRPC ServerUpdatePerson $person "$person_info($person)"\
      "$person_reservations($person)" $signon]
    if {$ret != "success"} {
      Dialog .dialog {Error Occurred} "got error \"$ret\" while trying to\
        update data for $person on server (tell Rob)" error -1 {EXIT}
      QuitApp force
    }
    set ignore_next_change "$armed_person"
  }
  set armed_person ""
  $top_win.names.$person config -bg $disarmed_person_color_bg\
    -activebackground $disarmed_person_color_ab -command "ArmPerson $person"\
    -foreground $disarmed_person_fg
  # get rid of lock
  set ret [ExecRPC ReleaseLock $person $signon]
  if {[lindex $ret 0] != "success"} {
    Dialog .dialog {Error} "Error occurred while trying to release lock: $ret"\
      {} -1 OK
    dp_RCP $server SignOff $signon
    QuitApp force
  }
  bind $top_win.c <ButtonRelease-1> {}
  bind $top_win.c <B1-Motion> {}
  bind $top_win.c <1> "DisplayReservation %x %y"
  bind $top_win.c <Shift-1> {}
  bind $top_win.c <3> {}
  bind $top_win.c <2> {}
}

proc BuildMenu {} {
  global lib_dir top_win god

  catch {destroy $top_win.menu}
  frame $top_win.menu -relief raised -borderwidth 1
  pack $top_win.menu -side top -fill x
  # File Catagory
  menubutton $top_win.menu.file -text "File" -menu $top_win.menu.file.m -under 0
  menu $top_win.menu.file.m
  $top_win.menu.file.m add command -label "Quit" -command "QuitApp {}" -under 0
#  .menu.file.m add command -label "Reload" -command "source $lib_dir/abwesenheit"

  # People catagory
  menubutton $top_win.menu.people -text "People" -menu $top_win.menu.people.m\
	-under 0
  menu $top_win.menu.people.m
  $top_win.menu.people.m add command -label "Add" -command "AddPerson" -under 0
  if {$god} {
    $top_win.menu.people.m add command -label "Delete" -command "DeletePerson"\
	-under 0
  }
  $top_win.menu.people.m add command -label "Change" -command "ChangePerson"\
	-under 0
  $top_win.menu.people.m add command -label "Display" -command "DisplayPerson"\
	-under 0

  # GOD
  if {$god} {
    menubutton $top_win.menu.god -text "God" -menu $top_win.menu.god.m
    menu $top_win.menu.god.m
    $top_win.menu.god.m add command -label "Kill Clients" -command KillClients
    $top_win.menu.god.m add command -label "Shutdown Server" -command\
      ShutdownServer
    $top_win.menu.god.m add command -label "Force Init" -command\
      ClientForceInit
    $top_win.menu.god.m add command -label "Client Cmd" -command ClientCmd
  }

  # Help 
  menubutton $top_win.menu.help -text "Help" -menu $top_win.menu.help.m
  menu $top_win.menu.help.m
  $top_win.menu.help.m add command -label "Help" -command {HelpDiagram; HelpHints}

  pack $top_win.menu.file $top_win.menu.people -side left
  if {$god} {pack $top_win.menu.god -side left}
  pack $top_win.menu.help -side right
  tk_menuBar $top_win.menu $top_win.menu.file $top_win.menu.people $top_win.menu.help
}

proc DeletePerson {} {
  set person [ListboxPeople]
  if {[Dialog .dialog {Are You Sure???} "Are you SURE you want to delete this\
	person from system???" warning -1 NO YES]} {
    if {$person != ""} {
      ExecRPC ServerDeletePerson $person
    }
  }
}

proc ClientCmd {} {
  global top_win client_cmd_var cc_change server

  set w $top_win.cc
  toplevel $w
  message $w.msg -text "Command to execute:" -aspect 800
  entry $w.entry -textvar client_cmd_var -width 40 -rel sunk
  button $w.but -text "Cancel" -command {set cc_change -1}
  pack $w.msg $w.entry $w.but
  bind $w.entry <Return> {set cc_change 1}

  tkwait variab cc_change
  if {$cc_change > 0} {
    if {$client_cmd_var != ""} {
      #ExecRPC ServerAnyCmd "$client_cmd_var"
      dp_RPC $server ServerAnyCmd "$client_cmd_var"
    }
  }
  destroy $w
}

proc KillClients {} {
  ExecRPC KillClients
}

proc ShutdownServer {} {
  ExecRPC Shutdown
}

proc ClientForceInit {} {
  global server

  #ExecRPC ForceInit
  dp_RPC $server ForceInit
}

proc NextColor {col} {
  set col_list {black white orange pink darkorange3 red violet}
  set tmp [lsearch $col_list $col]
  if {$tmp == [expr [llength $col_list] - 1]} {
    return [lindex $col_list 0]
  } else {
    return [lindex $col_list [expr $tmp + 1]]
  }
}

proc ModElement {x y} {
  global xgap ygap
  #puts "x=$x y=$y"
  set real_x [$top_win.c canvasx $x]
  set obj [$top_win.c find closest $real_x $y]
  puts "OBJ=$obj"
  set color [lindex [lindex [$top_win.c itemconfig $obj] 0] 4]
  set nextcolor [NextColor $color]
  $top_win.c itemconfig $obj -fill $nextcolor
}

proc BuildMisc {} {
  global mc_height people_bg top_win

  catch {destroy $top_win.hscroll}
  catch {destroy $top_win.names}
  # now for the canvas for the people
  canvas $top_win.names -width 2c -height $mc_height;	# -bg red
  pack $top_win.names -side left -fill y
  label $top_win.names.corner -text "people" -bg $people_bg -rel raised
  $top_win.names create window 0 0 -win $top_win.names.corner -width 2c -height 60 -anch nw
  scrollbar $top_win.hscroll -relief sunk -orient horiz -command "$top_win.c xview"
  pack $top_win.hscroll -side bottom -fill x
}

proc MakeHeader {} {
  global month_names monthday_num year_num
  global xgap cwidth_pix month_num week_num weekday_num
  global ygap starty kw_bg kw_fg top_win tk_default_bg

  set year $year_num
  set font1 {-adobe-helvetica-medium-r-normal--*-100-*}
  set font2 {-bigelow & holmes-menu-medium-r-normal--13-*}
  if {[TestFont $font2]} {
    set lab_font $font2
  } else {
    set lab_font $font1
  }
  $top_win.c create rect 0 0 $cwidth_pix 60 -fill $tk_default_bg
  # now for the labels at the top of the canvas...
  $top_win.c create line 0 20 $cwidth_pix 20
  $top_win.c create line 0 40 $cwidth_pix 40
  #
  set xline [expr ([MonthDays $month_num $year] - $monthday_num + 1) * $xgap]
  $top_win.c create line $xline 0 $xline 60
  if {$xline > 90} {
    $top_win.c create text [expr $xline / 2] 0 -anch n\
      -text [lindex $month_names $month_num]
  }
  ########################################################################
  # the following makes the month labels between y=0 and y=20
  ########################################################################
  set disp $xline
  set month [expr "{$month_num} == {12} ? {1} : [expr {$month_num} + {1}]"]
  while {$disp < $cwidth_pix} {
    set tmp [expr [MonthDays $month $year] * $xgap]
    set xline [expr $tmp + $disp]
    if {$xline < $cwidth_pix} {
      $top_win.c create line $xline 0 $xline 60
      $top_win.c create text [expr $disp + (($xline - $disp)/2)] 0 -anch n \
        -text [lindex $month_names $month] -tag [lindex $month_names $month]
    }
    set disp $xline
    incr month
    if {$month > 12} {set month 1; incr year}
  }
  incr month -1
  if {$month < 1} {set month 12; incr year -1 }
  
  if {[expr $cwidth_pix - ($disp - $tmp)] > $xgap} {
    set tmp2 [expr $disp - $tmp]
    $top_win.c create text [expr ($cwidth_pix - $tmp2)/2 + $tmp2] 0 -anch n \
      -text [lindex $month_names $month] -tag [lindex $month_names $month]
  }
  #update
  ########################################################################
  # the following creates the "KW xx" labels between y=20 and y=40 and 
  # the "xx.yy - xx.yy" labels between y=40 and y=60
  ########################################################################
  set year $year_num
  set num 0
  set find_end 0
  set curr_month $month_num
  set curr_day_of_month $monthday_num
  while {[expr $num * $xgap] < $cwidth_pix} {
    #set kw [fmtclock [convertclock "$curr_month/$curr_day_of_month/$year"] %W]
    set kw [getkw $curr_day_of_month $curr_month $year]
    set wd_num [expr ($weekday_num + $num) % 7]
    set curr_date "$curr_day_of_month.$curr_month"
    if {$find_end == 0} {
      if {$wd_num == 1} {
        set find_end 1
        set lab_start [expr $num * $xgap]
        set date_start $curr_date
      }
    } else {
      if {$wd_num == 5} {
        set lab_width [expr ($num + 1) * $xgap - $lab_start]
        # create "KW .." label
        label $top_win.c.kw$kw -text "CW $kw" -bg $kw_bg -fg $kw_fg
        $top_win.c create window $lab_start 21 -window $top_win.c.kw$kw \
	  -width $lab_width -height [expr $ygap - 1] -anch nw
        # create 'mon xx - mon yy' label
        #puts "DEBUG: MakeHeader: CW: $kw, text: ${date_start}-${curr_date}"
        label $top_win.c.date$kw -text "${date_start}-${curr_date}" -font $lab_font
        $top_win.c create window $lab_start 41 -window $top_win.c.date$kw \
          -width $lab_width -height [expr $ygap - 1] -anch nw
        set find_end 0
      }
    }
    incr num
    incr curr_day_of_month
    if {$curr_day_of_month > [MonthDays $curr_month $year]} {
      if {$curr_month == 12} {
        set curr_month 1
        incr year
      } else {
        incr curr_month
      }
      set curr_day_of_month 1
    }
    #update
  }
  if {$find_end == 1} {
    set lab_width [expr ($num - 1) * $xgap - $lab_start]
    # create "CW .." label 
    label $top_win.c.kw$kw -text "CW $kw" -bg $kw_bg -fg $kw_fg
    $top_win.c create window $lab_start 21 -window $top_win.c.kw$kw -width $lab_width \
      -height [expr $ygap - 1] -anch nw
    # create 'mon xx - mon yy' label
    label $top_win.c.date$kw -text "$date_start - $curr_date"
    $top_win.c create window $lab_start 41 -window $top_win.c.date$kw -width $lab_width \
      -height [expr $ygap - 1] -anch nw
  }
  set prev_date $curr_date
}

proc BuildCanvas {} {
  global mc_height xgap c_scroll_width cwidth_pix top_win free_person_color
  #global num_cells

  catch {destroy $top_win.c}
  BuildMisc
  #puts "BuildCanvas: num_cells=$num_cells, cwidth_pix=$cwidth_pix"
  canvas $top_win.c -scrollregion "0c 0c $cwidth_pix $mc_height"\
    -width $c_scroll_width -height $mc_height\
    -xscrollcommand "$top_win.hscroll set"\
    -background $free_person_color
  pack $top_win.c -expand yes; # -fill both
  bind $top_win.c <1> "DisplayReservation %x %y"
}

proc ChangeColor {tag} {
  set color [lindex [lindex [$top_win.c itemconfig $tag] 0] 4]
  set nextcolor [NextColor $color]
  $top_win.c itemconfig $tag -fill $nextcolor
}

proc MakeMatrix {} {
  global people xgap ygap cwidth_pix weekday_num starty
  global week_end_color free_person_color lib_dir
  global button_bg gc_compiled_once top_win holiday_list messe_list

  # create person buttons
  set y $starty
  foreach person $people {
    set general_tag "gen_$person"
    catch {destroy $top_win.names.$person}
    button $top_win.names.$person -text "$person" -relief raised -bg\
      $button_bg -command "ArmPerson $person"
    $top_win.names create window 0 $y -anch nw -width 2c -height ${ygap} \
      -window $top_win.names.$person
    set y [expr $y + $ygap]
  }
  set top_y $starty
  set bot_y [expr [llength $people] * 20 + 60]
  set num 0
  set lab 0
  set x 0
  set prev_type ""
  set begin_x 0
  set loop_end [expr $cwidth_pix + 15]
  while {[expr $x + ${xgap}] <= $loop_end} {
    set tmp [expr ($weekday_num + $num) % 7]
    if {($tmp > 0) && ($tmp < 6)} {
      if {[lsearch $holiday_list "_${num}_"] != -1} {
        set type "holiday"
      } elseif {[lsearch $messe_list "_${num}_"] != -1} {
        set type "messe"
      } else {
        set type "weekday"
      }
    } else {
      set type "weekend"
      #$top_win.c create rect $x $y [expr $x + $xgap] [expr $y + $ygap - 1]\
        #-fill $week_end_color -stipple @${lib_dir}/diag_stripe_thick.bm
    }
    if {$type != $prev_type} {
      #puts "num=$num, x=$x, prev_type=$prev_type, type=$type"
      if {$prev_type != "weekday"} {
        if {$x != 0} {
          set id [$top_win.c create rect $begin_x $top_y $x $bot_y\
            -fill [GetColor $prev_type]]
          if {$prev_type == "weekend"} {
            $top_win.c itemconfig $id
              #-stipple @${lib_dir}/diag_stripe_thick.bm
          }
          update
        }
      }
      set begin_x $x
    }
    incr num
    set x [expr $x + $xgap]
    incr lab
    if {$lab > 9} {set lab 0}
    set prev_type $type
  }
  set x 0
  while {[expr $x + ${xgap}] <= $cwidth_pix} {
    $top_win.c create line $x $top_y $x $bot_y -width 1
    set x [expr $x + $xgap]
  }
  set iter [llength $people]
  for {set ind 1} {$ind < $iter} {incr ind} {
    set y [expr $ind * $ygap + 60]
    $top_win.c create line 0 $y $cwidth_pix $y -width 1.5
  }
}

proc GetColor {type} {
  global reserved_person_color free_person_color holiday_color messe_color\
  global week_end_color 

  switch $type {
    holiday {return $holiday_color}
    messe   {return $messe_color}
    weekend {return $week_end_color}
    weekday {return blue}
  }
}

proc UpdateDisplay {} {
  global people
  foreach person $people {
    UpdatePersonDisplay $person
  }
}  

proc UpdatePersonDisplay {person} {
  global polygons num_cells biglist top_win
  global free_person_color week_end_color

  UpdatePersonList $person
  #puts "UpdatePersonDisplay: person=$person"
  set looking 0
  # get rid of polygons...
  set list ""
  catch {set list $polygons($person)}
  #puts "UpdatePersonDisplay: list=$list"
  foreach foo $list {
    #puts "UPD: $top_win.c delete $foo"
    $top_win.c delete $foo
  }
  catch {unset polygons($person)}
  set halfcell 0
  while {$halfcell < [expr $num_cells * 2]} {
    set tag [lindex $biglist($person) $halfcell]
    if {!$looking} {
      if {$tag} {
        set looking 1
        set this_tag $tag
        #puts "setting start_halfcell to $halfcell"
        set start_halfcell $halfcell
      }
    } else {
      # looking for end of sequence
      if {(!$tag)||($tag != $this_tag)} {
        DrawPolygon $person $this_tag $start_halfcell [expr $halfcell - 1]
        if {$tag} {
          set this_tag $tag
          set start_halfcell $halfcell
        } else {
          set looking 0
        }
      }
    }
    incr halfcell
  }
  if {$looking} {
    DrawPolygon $person $this_tag $start_halfcell [expr $num_cells * 2 - 1]
  }
}

proc DrawPolygon {person tag_num start end} {
#  puts "ShowSequence: person: $person, start: $start, end: $end"
  global people starty ygap xgap reserved_person_color
  global polygons top_win busy_color debug

  #if {$debug} {puts "DrawPolygon: tag=$tag_num"}
  if {$tag_num > 999} {
    set color $busy_color
  } else {
    set color $reserved_person_color
  }
  set tag "${person}_poly${tag_num}"
  set person_ind [lsearch $people $person]
  set y1 [expr $person_ind * $ygap + $starty + 1]
  set y2 [expr $y1 + $ygap - 2]
  set cell [expr $start / 2]
  set x1 [expr $cell * $xgap + 1]
  set x2 [expr ($cell + ($start % 2)) * $xgap + 1]
  set x3 [expr (($end/2) + 1) * $xgap - 1]
  set x4 [expr (($end/2) + ($end % 2)) * $xgap - 1]
  $top_win.c addtag $tag withtag [$top_win.c create poly $x1 $y2 $x2 $y1 $x3 $y1 $x4 $y2\
      -fill $color]
  lappend polygons($person) $tag
}
    
proc odd {int} {
  if {[expr $int % 2]} {
    return 1
  }
  return 0
}

proc AddPerson {} {
  global add_change people person_info armed_person_change server username

  set add_change(person) ""
  set add_change(phone) ""
  set add_change(address) ""
  if {[AddChangePerson add] > 0} {
    set person $add_change(person)
    if {[lsearch $people $add_change(person)] == -1} {
      lappend people $person
      set people [lsort $people]
      set person_info($person) "{$person} {$add_change(phone)}\
        {$add_change(address)}"
      #WritePersonFile $person chgrp
      ExecRPC ServerAddPerson $person_info($person)
      WinInit
      ExecRPC LogIt "{$username added new person $person}"
    } else {
      Dialog .dialog {Error} "Person $person is already in the system." {error}\
        -1 OK
    }
  }
}

proc ListboxPeople {} {
  global top_win people

  set person ""
  set w $top_win.listboxpeople
  catch {destroy $w}
  toplevel $w
  wm geometry $w +400+400
  wm title $w "Display Person Information"
  wm iconname $w "Display"
  wm minsize $w 1 1
  message $w.msg -text "Choose a person" -aspect 600
  frame $w.frame -bd 5
  button $w.ok -text OK -command "set change_person_selection foo"
  pack $w.msg -side top -fill x
  pack $w.frame -side top -expand yes -fill y
  pack $w.ok -side bottom -fill x

  scrollbar $w.frame.scroll -rel sunken -command "$w.frame.list yview"
  listbox $w.frame.list -relief sunken -setgrid 1 -yscroll "$w.frame.scroll set"
  pack $w.frame.scroll -side right -fill y
  pack $w.frame.list -side left -expand yes -fill both
  eval "$w.frame.list insert 0 $people"
  #tk_listboxSingleSelect $w.frame.list
  bind $w.frame.list <Double-1> "set change_person_selection foo"
  tkwait variab change_person_selection
  set selected [$w.frame.list curselect]
  if {$selected == ""} {
    destroy $w
    return ""
  }
  set person [lindex $people $selected]
#  puts "person=$person"
  destroy $w
  return $person
}

proc DisplayPerson {} {
  global people change_person_selection person_info add_change armed_person
  global top_win

  set person [ListboxPeople]
  if {$person == ""} {
    return
  } else {
    set list $person_info($person)
    set add_change(person) [lindex $list 0]
    set add_change(phone) [lindex $list 1]
    set add_change(address) [lindex $list 2]
    AddChangePerson display
  }
}

proc AddChangePerson {op} {
  global people addchange_tablist add_change add_change_button
  global username error_msg_fg kw_bg top_win prop_font

  set w "$top_win.addperson"
  set addchange_tablist "$w.name.hn $w.phone.entry $w.address.text"
  catch {destroy $w}
  toplevel $w
  wm geometry $w +400+400
  wm iconname $w "Add"
  if {$op == "add"} {
    wm title $w "New Person"
    set msg_text "Add a new person to system"
  } elseif {$op == "change"} {
    wm title $w "Change Person"
    set msg_text "Change person information"
  } else {
    wm title $w "Display Person"
    set msg_text "Information about..."
  }
  message $w.msg -font $prop_font -width 3i -text $msg_text
  frame $w.name -bd 1m
  if {$op == "add"} {
    set add_change(person) $username
    entry $w.name.hn -relief sunk -width 16 -textvariable add_change(person)
    bind $w.name.hn <KeyPress> "EntryInput $w.name.hn %A %K"
  } else {
    label $w.name.hn -relief flat -width 16 -text $add_change(person)\
      -bg $kw_bg
  }
  bind $w.name.hn <Tab> "Tab \$addchange_tablist"
  bind $w.name.hn <Return> "Tab \$addchange_tablist"
  bind $w.name.hn <FocusOut> "CheckUsername $w \$add_change(person)"
  label $w.name.label -text "Person:" -width 11
  label $w.name.lab2 -text "Username im System" -rel raised
  pack $w.name.label $w.name.hn $w.name.lab2 -side left
  ####
  frame $w.info -bd 1m
  label $w.info.label -text "Address & Telephone" -rel groove -width 11
  pack $w.info.label -fill x
  ####
  frame $w.phone -bd 1m
  entry $w.phone.entry -rel sunk -width 16 -textvariable add_change(phone)
  bind $w.phone.entry <KeyPress> "EntryInput $w.phone.entry %A %K"
  if {$op == "display"} {
    $w.phone.entry config -state disabled
  }
  bind $w.phone.entry <Tab> "Tab \$addchange_tablist"
  bind $w.phone.entry <Return> "Tab \$addchange_tablist"
  label $w.phone.label -text "Telephone:" -width 11
  label $w.phone.lab2 -text "at home (voluntary!)" -rel raised
  pack $w.phone.label $w.phone.entry $w.phone.lab2 -side left
  ####
  frame $w.address -bd 1m
  frame $w.address.lframe
  label $w.address.lframe.label -text "Address:" -width 11
  pack $w.address.lframe -side left -fill y
  pack $w.address.lframe.label -side top
  #bind Text <Delete> {}
  bind Text <Delete> {%W delete insert-1c}
  #bind Text <Tab> {}
  text $w.address.text -relief sunk -bd 2 -height 3 -width 40 -wrap word
  #bind $w.address.text <KeyPress> "TextInput %W %A %K"
  #bind $w.address.text <KeyPress> {}
  bind $w.address.text <Tab> "Tab \$addchange_tablist"
  pack $w.address.text -side left
  if {($op == "change")||($op == "display")} {
    regsub -all {\\n} $add_change(address) "\n" tmp
    $w.address.text insert 0.0 $tmp
  }
  if {$op == "display"} {
    $w.address.text config -state disabled
  }
  ####
  frame $w.message -bd 1m
  label $w.message.label
  pack $w.message.label -fill x
  ####
  frame $w.buttons -bd 1m -rel groove
  button $w.buttons.ok -text OK -command {set add_change_button "ok"}
  button $w.buttons.cancel -text "cancel" -command \
    {set add_change_button "cancel"}
  pack $w.buttons.ok -side left -expand 1 -padx 5m
  pack $w.buttons.cancel -side left -expand 1 -padx 5m
  
  #######

  pack $w.msg -fill x
  pack $w.name -fill x
  pack $w.info -fill x
  pack $w.phone -fill x
  pack $w.address
  pack $w.message -fill x
  pack $w.buttons -pady 3m -ipady 2m -fill x
  set done 0
  while {!$done} {
    tkwait variab add_change_button
    if {$add_change_button == "ok"} {
      if {[CheckUsername $w $add_change(person)]} {
        set done 1
      } else {
        $w.message.label config -text "$add_change(person) invalid username"\
          -fg $error_msg_fg
        after 1000 "$w.message.label config -text {}"
      }
    } else {set done 1}
  }
  if {($add_change_button == "cancel")||($add_change(person) == "")} {
    destroy $w
    return -1
  }
  regsub -all "\n" [$w.address.text get 0.0 end] {\n} tmp
  set add_change(address) "$tmp"
  destroy $w
  return 1
}

proc ACP_Message {msg args} {
  global error_msg_fg

  if {$args != ""} {
    set duration $args
  } else {
    set duration 1000
  }
  $w.message.label config -text "$msg" -fg $error_msg_fg
  after $duration "$w.message.label config -text {}"
}

proc CheckUsername {w un} {
  global server

  #if {![ExecRPC UsernameExists $un]} {}
  if {![dp_RPC $server UsernameExists $un]} {
    ACP_Message "$un is not a valid username"
    focus $w.name.hn
    return 0
  }
  return 1
}

proc EntryInput {win char keysym} {
  if {([regexp {[a-zA-Z0-9]} $char])||([regexp {[ ~`!@#$%^&*()]} $char])||
      ([regexp {[-+=]} $char])||([regexp {[|"';:?/.><,]} $char])||
      ([regexp {[][_]} $char])} {
    #$win insert insert $char
  } else {
    switch $keysym {
      #Delete {
      #  $win delete [expr [$win index insert] - 1]
      #}
      Left "$win icursor [expr [$win index insert] - 1]"
      Right "$win icursor [expr [$win index insert] + 1]"
      braceleft -
      braceright {ACP_Message "YOU aren't allowed to type that char!" 2000}
    }
  }
}

proc TextInput {w char keysym} {
  global username
  #puts "TextInput: char = $char, keysym = $keysym"
  switch $keysym {
    Delete {$w delete insert-1c}
    #Up {$w mark set insert insert-1l}
    #Down {$w mark set insert insert+1l}
    #Right {$w mark set insert insert+1c}
    #Left {$w mark set insert insert-1c}
  }
}

proc Tab {list} {
  set i [lsearch $list [focus]]
  if {$i < 0} {
    set i 0
  } else {
    incr i
    if {$i >= [llength $list]} {
      set i 0
    }
  }
  focus [lindex $list $i]
}

proc WinInit {} {
  global people mc_height ygap starty cwidth_cm top_win num_cells xgap
  global main_geometry lib_dir main_state

  catch {
    set main_geometry [wm geometry $top_win]
    regsub {^[0-9]+x[0-9]+} $main_geometry {} main_geometry
  }
  catch {set main_state [wm state $top_win]}
  catch {destroy $top_win}
  toplevel $top_win
  wm geometry $top_win $main_geometry
  if {$main_state == "iconic"} {wm iconify $top_win}
  wm title $top_win "Abwesenheit"
  wm iconbitmap $top_win @${lib_dir}/icon.bm
  set cwidth_cm [expr ($num_cells * $xgap) / [winfo fpix $top_win 1c]]
  set mc_height [expr [llength $people] * $ygap + $starty]
  BuildMenu
  BuildCanvas
  MakeHeader
  MakeMatrix
  ReadAllPeople
  UpdateLists
  UpdateDisplay
}
  
proc Init {} {
  global people mc_height ygap starty num_cells cwidth_pix xgap server
  global holiday_list messe_list cell_binding people
  global num_halfcells debug

  SetDateVars
  LoadHolidays
  LoadMessen
  CellBind
  InitVirginBiglist
  #FindPeople
  set people [ExecRPC set people]
  if {$debug} {puts "findpeople: $people"}
  set mc_height [expr [llength $people] * $ygap + $starty]
  # window stuff
  WinInit
}

proc RequestUpdates {} {
  global server debug armed_person person_info person_reservations username
  global debug signon ignore_next_change god

  if {$armed_person != ""} {
    after 15000 RequestUpdates
    return
  }
  set list [ExecRPC ServerRequestUpdates $signon]
  #set list [dp_RPC $server ServerRequestUpdates $signon]
  set arg0 [lindex $list 0]
  set arg1 [lindex $list 1]
  set arg2 [lindex $list 2]
  if {$arg0 != ""} {
    if {[lsearch $arg0 "die"] != -1} {
      if {!$god} {
        Dialog .dialog {bye bye} {This client has been requested to shut down.}\
          warning -1 {Exit Program}
        QuitApp {}
      } else {
        if {[Dialog .dialog {die instruction} {Ignore "die"?}\
              warning -1 {Yes} {No}]} {
          QuitApp {}
        }
      }
    }
    if {[lsearch $arg0 "init"] != -1} {
      if {$debug} {puts "server told me to init..."}
      Init
      after 15000 RequestUpdates
      return
    }
    if {[lsearch $arg0 "messe_holiday"] != -1} {
      if {$debug} {puts "change to messe/holiday file..."}
      LoadHolidays
      LoadMessen
      WinInit
    }
  }
  if {$arg1 != ""} {
    foreach person $arg1 {
      if {$ignore_next_change == "$person"} {
        set ignore_next_change {}
        if {$debug} {puts "ignoring changes to $person ..."}
        continue
      }
      if {$debug} {puts "RequestUpdates: $person changed ..."}
      if {$armed_person != "$person"} {
        #if {$debug} {puts "oldPR=$person_reservations($person)"}
        set person_reservations($person)\
          [ExecRPC set person_reservations($person)]
        #if {$debug} {puts "newPR=$person_reservations($person)"}
        set person_info($person) [ExecRPC set person_info($person)]
        UpdatePersonDisplay $person
      } else {
        puts "something very weird happened.. but I overwrote it!"
      }
    }
  }
  if {$arg2 != ""} {
    AnyCmd $arg2
  }
  after 15000 RequestUpdates
}

#########################################################################
# initialize global variables
#########################################################################

#set debug 1
#set debug 0

######## *EDIT* ##########
set lib_dir /usr/local/lib/abwesenheit
source $lib_dir/config.tcl
#
# make connection to server
#
set thishost [exec /bin/hostname]
if {![Connect]} {
  puts "Error: no server running"
  exit
}
set data_dir [dp_RPC $server GetDataDir]


source $lib_dir/res_help.tcl
source $lib_dir/utils.tcl
set signon [dp_RPC $server SignOn $username]

set top_win ".top"
#toplevel $top_win
#puts "DEBUG: color_file = $color_file"
#puts "DEBUG: argv0 = $argv0"

# get display info ...
if {$color_model == "color"} {
  # set default colors
  set kw_bg "salmon"
  set kw_fg black
  set button_bg "DeepSkyBlue2"
  set people_bg "skyblue"
  set error_msg_fg "red"

  set tk_default_bg #ffe4c4
  set disarmed_person_color_bg deepskyblue3
  set disarmed_person_color_ab #eed5b7
  set disarmed_person_fg black
  set armed_person_color_bg deeppink1
  set armed_person_color_ab deeppink3
  set armed_person_color_af black
  set armed_person_fg black
  set reserved_person_color red
  set busy_color blue
  set free_person_color darkorange3
  set holiday_color green
  set messe_color orange
  set week_end_color black
  set selectbox_color yellow
  if {[file exists $color_file]} {
    set fid [open $color_file "r"]
    while {[gets $fid line] != -1} {
      if {![regexp {^#} $line]} {
        set [lindex $line 0] [lindex $line 1]
      }
    }
    close $fid
  }
} else {
  set kw_bg black
  set kw_fg white
  set button_bg "white"
  set people_bg "white"
  set error_msg_fg "black"

  set disarmed_person_color_bg white
  set disarmed_person_color_ab black
  set disarmed_person_fg black
  set armed_person_color_bg black
  set armed_person_color_ab white
  set armed_person_color_af black
  set armed_person_fg white
  set reserved_person_color black
  set busy_color black
  set free_person_color white
  set holiday_color black
  set messe_color black
  set week_end_color black
  set selectbox_color black
}
#

# for the main canvas...
# for select-box
set mc_x1 0
set mc_x2 0
set mc_x3 0
set mc_x4 0
set mc_y1 0
set mc_y2 0
set starty 60
#
#########
######### If you have PC users in the group with crummy X-servers, you
######### can enter them here, and they get smaller windows (and therefore
######### better performance).
#########
if {($username != "temmel")&&($username != "ewo")} {
  set num_scroll_cells 50
} else {
  set num_scroll_cells 20
}
set ygap 20
set xgap 15
set num_cells [ExecRPC set num_cells]
set num_halfcells [ExecRPC set num_halfcells]
set c_scroll_width [expr $num_scroll_cells * $xgap]
set cwidth_pix [expr $num_cells * $xgap]
set autoscroll 0
set as_busy 0
set gc_compiled_once 0
set lock_serial 1
set postponed_update {}
set ignore_next_change {}
set main_geometry "+0+0"
set resconf_geometry "+400+400"
set main_state "normal"
set last_display ""
#
#########################################################################
after 15000 RequestUpdates

#########################################################################
# change Text & Entry class bindings
#########################################################################
bind Text <Delete> {%W delete insert-1c}
bind Entry <Delete> {%W delete [expr [%W index insert] - 1]}
bind Entry <Control-u> {%W delete 0 end}

Init
