#!/usr/bin/wish

#
# pui-addressbook
# 
# THIS IS SAMPLE CODE ONLY
#
# Copyright (c) 1996, Scotter <scotter@iname.com>
#
# This is free software, licensed under the GNU Public License V2.
#

set labellist [list Work Home Fax Other E-mail Main Pager Mobile]

proc initrec { record } {
  upvar $record r
  
  set r(lastname) ""
  set r(firstname) ""
  set r(company) ""
  set r(phone1) ""
  set r(phone2) ""
  set r(phone3) ""
  set r(phone4) ""
  set r(phone5) ""
  set r(address) ""
  set r(city) ""
  set r(state) ""
  set r(zip) ""
  set r(country) ""
  set r(title) ""
  set r(custom1) ""
  set r(custom2) ""
  set r(custom3) ""
  set r(custom4) ""
  set r(note) ""
  set r(whichphone) 1
  set r(phonelabel1) 0
  set r(phonelabel2) 1
  set r(phonelabel3) 2
  set r(phonelabel4) 3
  set r(phonelabel5) 4
}

proc setrec { varname } {
  global editrec
  global labellist
  upvar $varname vrnm

  # Throw everything from the given record into the displayed "edit" record
  # Use to use "array names" but now using actual list.
  foreach name {lastname firstname company phone1 phone2 phone3 phone4 phone5 address city state zip country title custom1 custom2 custom3 custom4 note} {
    set editrec($name) $vrnm($name)
  }

  # Convert numberic phonelabel indices to words
  foreach label {phonelabel1 phonelabel2 phonelabel3 phonelabel4 phonelabel5} {
    set editrec($label) [lindex $labellist $vrnm($label)]
  }
}

# return 1 if changed 0 if unchanged

proc getrec { varname } {
  global editrec
  global labellist
  upvar $varname vrnm

  # Compare records, copying new data from entry fields into record

  set different 0
  foreach name {lastname firstname company phone1 phone2 phone3 phone4 phone5 address city state zip country title custom1 custom2 custom3 custom4 note} {
    set x [string compare $editrec($name) $vrnm($name)]
    if {$x != 0} {
      set vrnm($name) $editrec($name)
      set different 1
    }
  }
  # Convert alphabetic phonelabels to indices
  foreach label {phonelabel1 phonelabel2 phonelabel3 phonelabel4 phonelabel5} {
    set index [lsearch -exact $labellist $editrec($label)]
    if {$index != $vrnm($label)} {
      set vrnm($label) $index
      set different 1
    }
  }
  return $different
}

proc addone {parent child fieldname } {
  global editrec

  label .${child}l -text "${fieldname}:" -anchor e
  entry .${child}e -relief sunken -bd 2 -textvariable editrec($child)
  grid $parent .${child}l .${child}e -sticky ew
}

proc phoneaddone {parent childlabel child fieldname } {
  global editrec

  tk_optionMenu .${child}l editrec($childlabel) Work Home Fax Other E-mail Main Pager Mobile
  .${child}l configure -anchor e
  entry .${child}e -relief sunken -bd 2 -textvariable editrec($child)
  grid $parent .${child}l .${child}e -sticky ew
}

proc editaddr { parent } {
  addone $parent lastname "Last name"
  addone $parent firstname "First name"
  addone $parent title "Title"
  addone $parent company "Company"
  phoneaddone $parent phonelabel1 phone1 "Phone1"
  phoneaddone $parent phonelabel2 phone2 "Phone2"
  phoneaddone $parent phonelabel3 phone3 "Phone3"
  phoneaddone $parent phonelabel4 phone4 "Phone4"
  phoneaddone $parent phonelabel5 phone5 "Phone5"
  addone $parent address "Address"
  addone $parent city "City"
  addone $parent state "State"
  addone $parent zip "Zip"
  addone $parent country "Country"
  addone $parent custom1 "Custom 1"
  addone $parent custom2 "Custom 2"
  addone $parent custom3 "Custom 3"
  addone $parent custom4 "Custom 4"
  addone $parent note "Note"
}


proc closerec {} {
  global idlist
  global currentid
  global puidb
  global rec

  if {[getrec rec] == 1} {
    puts "Recording changed entry"
    set newid [puiWrite $puidb $currentid rec]
    if {$newid != $currentid} {
      puts "Ooh! This is a new one!"
      lappend idlist $newid
    }
  }
}

proc openrec {} {
  global currentid
  global puidb
  global rec

  puiRead $puidb $currentid rec
  setrec rec
}

proc newcard {} {
  global currenti
  global currentid
  global rec

  closerec

  set currentid 0
  initrec rec
  setrec rec
}

proc previous {} {
  global idlist
  global currenti
  global currentid

  closerec

  incr currenti -1
  if {$currenti == -1} {
    incr currenti [llength $idlist]
  }
  set currentid [lindex $idlist $currenti]

  openrec
}

proc next {} {
  global idlist
  global currenti
  global currentid

  closerec

  incr currenti
  if {$currenti == [llength $idlist]} {
    set currenti 0
  }
  set currentid [lindex $idlist $currenti]

  openrec
}

proc delete {} {
  global currentid
  global currenti
  global puidb
  global idlist

  closerec
  puiDelete $puidb $currentid
  set idlist [puiList $puidb]
  if {$currenti == [llength $idlist]} {
    set currenti 0
  }
  set currentid [lindex $idlist $currenti]
  openrec
}

proc byebye {} {
  global puidb

  closerec
  puiClose $puidb
  exit
}

proc setup {} {
  global rec
  initrec rec
  setrec rec

  frame .world
  frame .entries
  frame .control
  editaddr .entries
  button .new -text "New" -command newcard
  button .prev -text "Prev" -command previous
  button .next -text "Next" -command next
  button .del -text "Delete" -command delete
  button .quit -text "Quit" -command byebye
  pack .new .prev .next .del .quit -in .control -side left -fill both -expand yes
  grid .world .entries .control
}

# Execution begins here.

global rec
global editrec

if {[llength $argv] != 1} {
  puts "Usage: addressbook addressbook.pui"
  puts "Allows simple browsing and editing of address book data."
  exit -1
}

load tclpui.so

setup

# Open file for writing.
set puidb [puiOpen [lindex $argv 0] w]
set name [puiName $puidb]
if {"$name" != "AddressDB"} {
  puts "Error: Not AddressDB"
  puts "Error: File [lindex $argv 0] is of type $name."
  exit -1
}
set idlist [puiList $puidb]
set currenti 0
set currentid [lindex $idlist $currenti]

puiRead $puidb $currentid rec
setrec rec

