#!/usr/local/bin/wish -f
# jpeople - manage database of people, including Mail, elm, and MH aliases
# 
# Copyright 1993-1994 by Jay Sekora.  All rights reserved, except 
# that this file may be freely redistributed in whole or in part 
# for nonprofit, noncommercial use.

## begin boiler_header

global VERSION
set VERSION {3.6/3.0}

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

######################################################################
# BASIC INITIALISATION - VARIABLES AND USER CONFIGURATION
######################################################################

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

global J_PREFS JPEOPLE_PREFS	;# user preferences

j:jstools_init			;# prefs, libraries, bindings...

# read in (shared) preferences:
j:read_global_prefs
switch -exact $J_PREFS(bindings) {
  basic {
    j:eb:basic_bind Entry
    j:tb:basic_bind Text
  }
  emacs {
    j:eb:emacs_bind Entry
    j:tb:emacs_bind Text
  }
  vi {
    j:eb:basic_bind Entry
    j:tb:vi_bind Text
  }
}
# read in people browser prefs:
j:read_prefs -array JPEOPLE_PREFS -file jpeople-defaults {
  {datafile ~/.people}
  {mailaliases 0}
  {elmaliases 0}
  {mhaliases 0}
  {mailfile ~/.mailrc}
  {elmfile ~/.elm/aliases.text}
  {mhfile ~/Mail/aliases}
}
j:read_prefs -array JPEOPLE_PREFS -prefix tag -file jpeople-tags {
  {0 {}}
  {1 {}}
  {2 {}}
  {3 {}}
  {4 {}}
  {5 {}}
  {6 {}}
  {7 {Alternate}}
}

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

wm withdraw .

global mkglobals
set mkglobals {
  global ALIAS EMAIL FIRST LAST BIRTHDATE PHONE ADDRESS COMMENT TAGS
  global alias email first last phone address birthdate comment tags
  global env HOME USER J_PREFS JPEOPLE_PREFS LIMITPATTERN
}
eval $mkglobals

######################################################################
# PROCEDURE DEFINITIONS
######################################################################

# person id list - enter a person into the list.  usage is:
# person Jay_Sekora {
#   alias     {js jay sekora jays}
#   email     js@it.bu.edu
#   first     Jay
#   last      Sekora
#   phone     617/397-6653
#   address   {33 Park Street #44; Malden, MA 02148}
#   birthdate 1966.08.26
#   comment   {author of the jpeople program}
#   tags      {0 3 4 7}
# }
# ...but no checking is currently done on the first word of each pair.
#   
proc person {id list} {
  global mkglobals
  eval $mkglobals
  
  set ALIAS($id) [lindex $list 1]
  set EMAIL($id) [lindex $list 3]
  set FIRST($id) [lindex $list 5]
  set LAST($id) [lindex $list 7]
  set PHONE($id) [lindex $list 9]
  set ADDRESS($id) [lindex $list 11]
  set BIRTHDATE($id) [lindex $list 13]
  set COMMENT($id) [lindex $list 15]
  for {set i 0} {$i < 8} {incr i} {
    set TAGS($id,$i) 0
  }
  if {[llength $list] > 16} {
    foreach i [lindex $list 17] {
      set TAGS($id,$i) 1
    }
  }
}

######################################################################
# merge ?filename? - merge in a file (specified or $JPEOPLE_PREFS(datafile))
######################################################################

proc merge {{filename {}}} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  if {$filename == {}} {
    set filename $JPEOPLE_PREFS(datafile)
  }

  if {![file exists $filename]} then {
    return -1
  } else {
    source $filename
  }
  updatelist
}

######################################################################
# save ?filename? - write native-format output
#  (default to $JPEOPLE_PREFS(datafile))
######################################################################

proc save {{filename {}}} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  if {$filename == {}} {
    set filename $JPEOPLE_PREFS(datafile)
  }
  
  set file [open $filename {w}]
  foreach id [lsort [array names ALIAS]] {
    puts $file "# $id"
    puts $file [list set ALIAS($id) $ALIAS($id)]
    puts $file [list set EMAIL($id) $EMAIL($id)]
    puts $file [list set FIRST($id) $FIRST($id)]
    puts $file [list set LAST($id) $LAST($id)]
    puts $file [list set PHONE($id) $PHONE($id)]
    puts $file [list set ADDRESS($id) $ADDRESS($id)]
    puts $file [list set BIRTHDATE($id) $BIRTHDATE($id)]
    puts $file [list set COMMENT($id) $COMMENT($id)]
    
    for {set i 0} {$i < 8} {incr i} {
      if $TAGS($id,$i) {
        puts $file [list set TAGS($id,$i) 1]
      } else {
        puts $file [list set TAGS($id,$i) 0]
      }
    }
  }
  close $file
  
  # keep alias files up-to-date if user wishes:
  
  if $JPEOPLE_PREFS(mailaliases) {
    writemail
  }
  if $JPEOPLE_PREFS(elmaliases) {
    writeelm
  }
  if $JPEOPLE_PREFS(mhaliases) {
    writemh
  }
}

######################################################################
# load_prompt - prompt for a file to load
######################################################################

proc load_prompt {} {
  set filename [j:fs]

  if {![file exists $filename]} then {
    return -1
  } else {
    source $filename
  }
  updatelist
}

######################################################################
# save_prompt - write native-format output
######################################################################

proc save_prompt {} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  set filename [j:fs]
  
  set file [open $filename {w}]
  foreach id [lsort [array names ALIAS]] {
    puts $file "person $id {"
    puts $file "  [list alias:::: $ALIAS($id)]"
    puts $file "  [list email:::: $EMAIL($id)]"
    puts $file "  [list first:::: $FIRST($id)]"
    puts $file "  [list last::::: $LAST($id)]"
    puts $file "  [list phone:::: $PHONE($id)]"
    puts $file "  [list address:: $ADDRESS($id)]"
    puts $file "  [list birthdate $BIRTHDATE($id)]"
    puts $file "  [list comment:: $COMMENT($id)]"
    
    set taglist ""
    for {set i 0} {$i < 8} {incr i} {
      if $TAGS($id,$i) {lappend taglist $i}
    }
    puts $file "  [list tags::::: $taglist]"
 
    puts $file "}\n"
  }
  close $file
}

######################################################################
# writeelm - write elm alias format
######################################################################

proc writeelm {} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  set filename $JPEOPLE_PREFS(elmfile)
  
  set file [open $filename {w}]
  foreach id [lsort [array names ALIAS]] {
    foreach i_alias [lsort $ALIAS($id)] {
      puts $file \
        "$i_alias = [untex $LAST($id)]; [untex $FIRST($id)] = $EMAIL($id)"
    }
  }
  close $file
}

######################################################################
# filter - return all ids matching a set of tag criteria
######################################################################

proc filter {} {
  global mkglobals
  eval $mkglobals
  global exclude
  global filter_list
  global filter_include
  set filter_include 0
  
  toplevel .filter
  frame .filter.mode
  radiobutton .filter.mode.exclude \
    -text "Exclude entries with these tags" \
    -relief flat -anchor w \
    -variable filter_include -value 0
  radiobutton .filter.mode.include \
    -text "Only include entries with these tags" \
    -relief flat -anchor w \
    -variable filter_include -value 1
  pack .filter.mode.exclude .filter.mode.include -fill x
  frame .filter.tags
  
  for {set i 0} {$i < 8} {incr i} {
    set exclude($i) 0
    if {"x$JPEOPLE_PREFS(tag,$i)" != "x"} {
      checkbutton .filter.tags.b$i \
        -relief flat -text $JPEOPLE_PREFS(tag,$i) -variable exclude($i)
      pack .filter.tags.b$i -side left -padx 5
    }
  }
  j:buttonbar .filter.b -default ok -buttons {
    {ok OK {
        set filter_list ""
        foreach filterid [array names LAST] {
          if {$filter_include} { ;# _only_ include entries with a match
            set include 0
            for {set i 0} {$i < 8} {incr i} {
              if { ( $exclude($i) && $TAGS($filterid,$i) ) } {
                set include 1
                break
              }
            }
          } else { ;# include _all but_ entries with a match
            set include 1
            for {set i 0} {$i < 8} {incr i} {
              if { ( $exclude($i) && $TAGS($filterid,$i) ) } {
                set include 0
                break
              }
            }
          }
          if $include {
            lappend filter_list $filterid
          }
        }
        destroy .filter
      }
    }
    {cancel Cancel {
        set filter_list {}
        destroy .filter
      }
    }
  }
  pack \
    .filter.mode \
    .filter.tags \
    [j:rule .filter] \
    .filter.b \
    -side top -fill x
  tkwait window .filter

  return [lsort -command sort_by_name $filter_list]
}

######################################################################
# compare_ids id1 id2 - return -1, 0, 1 comparing two ids by last name
######################################################################

proc sort_by_name {id1 id2} {
  global mkglobals
  eval $mkglobals
  
  set name1 "$LAST($id1) $FIRST($id1)"
  set name2 "$LAST($id2) $FIRST($id2)"
  
  return [string compare $name1 $name2]
}

######################################################################
# writemh - write in mh alias format
######################################################################

proc writemh {} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  set filename $JPEOPLE_PREFS(mhfile)
  
  set file [open $filename {w}]
  foreach id [lsort [array names ALIAS]] {
    foreach i_alias [lsort $ALIAS($id)] {
      puts $file \
        "$i_alias: $EMAIL($id) ([untex $FIRST($id)] [untex $LAST($id)])"
    }
  }
  close $file
}

######################################################################
# writemail - write in (ucb) Mail alias format
######################################################################

proc writemail {} {
  # should do error checking
  global mkglobals
  eval $mkglobals
  
  set filename $JPEOPLE_PREFS(mailfile)
  
  if [file isfile $filename] {
    set fullpath [glob -nocomplain $filename]
    exec mv $fullpath ${fullpath}.bak	;# save a copy
    # 					delete any existing aliases:
    exec grep -v {^alias } < ${fullpath}.bak > $fullpath
  } else {
    close [open $filename {w}]	;# make sure it exists:
  }
  set file [open $filename {a}]
  foreach id [lsort [array names ALIAS]] {
    foreach i_alias [lsort $ALIAS($id)] {
      puts $file "alias $i_alias $EMAIL($id)"
    }
  }
  close $file
}

######################################################################
# readelm - write from elm alias format
######################################################################

proc readelm {} {
  # reads in my ~/.elm/aliases.text file and parses it.
  # assumes no group aliases
  # assumes no blank lines or comments
  global mkglobals
  eval $mkglobals

  set filename $JPEOPLE_PREFS(elmfile)

  if {![file exists $filename]} then {
    return -1
  } else {
    set file [open $filename {r}]
    foreach line [split [read $file] "\n"] {
      if [regexp {^#} $line] then {break}
      if [regexp {^[ 	]*$} $line] then {break}
      # strip space around equals signs:
      regsub -all { *= *} $line {=} line
      set topfields [split $line {=}]
      #
      set aliases [lindex $topfields 0]      
      set fullname [lindex $topfields 1]
      set email [lindex $topfields 2]
      #
      regsub -all { *; *} $fullname {;} fullname
      set names [split $fullname {;}]
      set last [lindex $names 0]
      set first [lindex $names 1]
      #
      set id "$first $last"
      regsub -all { } $id {_} id
      #
      regsub -all {[, ][, ]*} $aliases { } aliases
      append ALIAS($id) {}
      set ALIAS($id) [concat $ALIAS($id) $aliases]
      set EMAIL($id) $email
      set FIRST($id) $first
      set LAST($id) $last
      append BIRTHDATE($id) {}
      append PHONE($id) {}
      append ADDRESS($id) {}
      append COMMENT($id) {}
    }
  updatelist
  }
}

######################################################################
# fixtex - escape TeX special characters
#  NOTE:  this can NOT handle backslashes or braces!
######################################################################

proc fixtex {string} {
  regsub -all {[#$%&_]} $string {\\&} string
  return $string
}

######################################################################
# untex - convert TeX accents to ASCII
######################################################################

proc untex {string} {
  regsub -all {\\i} $string {i} string		;# \i -> i
  regsub -all {\\.} $string {} string		;# \c{c} -> {c}
  regsub -all {[\{\}]} $string {} string	;# Ay{s}e -> Ayse
  return $string
}

######################################################################
# texaddresses - write TeX source file for address list
######################################################################

proc texaddresses {} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  set filename [j:fs]
  
  set file [open $filename {w}]
  puts $file {\input addresslist.def}
  foreach id [filter] {
    texentry $file $id
  }
  puts $file {\bye}
  close $file
}

######################################################################
# texphones - write TeX source file for telephone list
######################################################################

proc texphones {} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  set filename [j:fs]
  
  set file [open $filename {w}]
  puts $file {\input telephones.def}
  foreach id [filter] {
    texentry $file $id
  }
  puts $file {\bye}
  close $file
}

######################################################################
# texentry file - write one entry to TeX source file
######################################################################

proc texentry {{file stdout} id} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  puts $file "% $id"
  puts $file {\\}
  puts $file [format {ln{%s}} [fixtex $LAST($id)]]
  puts $file [format {fn{%s}} [fixtex $FIRST($id)]]
  puts $file [format {ph{%s}} [fixtex $PHONE($id)]]
  puts $file [format {ad{%s}} [fixtex $ADDRESS($id)]]
  puts $file [format {em{%s}} [fixtex $EMAIL($id)]]
  puts $file [format {co{%s}} [fixtex $COMMENT($id)]]
}

######################################################################
# ids_by_name - return list of all ID's, sorted by last+first name
######################################################################

# Methodology: form a list of lists, where each sublist consists of
# the name and the corresponding id.  sort
# these.  return a list formed from the second element (id) of each
# list.
# Bugs: only considers the first word of each last name.

proc ids_by_name {} {
  global mkglobals
  eval $mkglobals

  set biglist {}
  set returnlist {}
  
  foreach id [lsort [array names LAST]] {
    lappend biglist [list [concat $LAST($id) $FIRST($id)] $id]
  }
  foreach pair [lsort $biglist] {
    lappend returnlist [lindex $pair 1]
  }
  return $returnlist  
}

######################################################################
# updatelist - update the listbox with all current information
######################################################################

proc updatelist {} {
  global mkglobals
  eval $mkglobals

  # save current scroll value (to prevent jumping to top):
  set oldyview [lindex [.people.select.sb get] 2]

  .people.select.lb delete 0 end
  foreach i [lsort [array names EMAIL]] {
    if [regexp $LIMITPATTERN $i] {
      .people.select.lb insert end $i
    }
  }

  # restore old scroll value (to prevent jumping to top):
  .people.select.lb yview $oldyview

  update
}

######################################################################
# finger - finger the currently-displayed person
######################################################################

proc finger {} {
  global mkglobals
  eval $mkglobals

  set email [.people.email.e get]
  set fingeroutput [exec finger $email]
  # deal with pesky CR-LF combination for networked finger:
  regsub -all "\r" $fingeroutput {} fingeroutput
  j:more -title "finger information for $email" -text $fingeroutput
  update
}

######################################################################
# ph - ph the currently-displayed person
######################################################################

proc ph {} {
  global mkglobals
  eval $mkglobals

  set first [.people.first.e get]
  set last [.people.last.e get]
  catch {exec ph "$first* $last" < /dev/null} fingeroutput
#  # deal with pesky CR-LF combination for networked finger:
#  regsub -all "\r" $fingeroutput {} fingeroutput
  j:more -title "ph information for $first $last" -text $fingeroutput
  update
}

######################################################################
# addchange id - add or change an alias, based on current entry contents
######################################################################

proc addchange {id} {
  global mkglobals
  eval $mkglobals
  
  if {$id == ""} {return 0}
  
  set ALIAS($id) $alias
  set EMAIL($id) $email
  set FIRST($id) $first
  set LAST($id) $last
  set PHONE($id) $phone
  set ADDRESS($id) $address
  set BIRTHDATE($id) $birthdate
  set COMMENT($id) $comment
  for {set i 0} {$i < 8} {incr i} {
    set TAGS($id,$i) $tags($i)
  }
  updatelist
}

######################################################################
# clear - clear the entries (by setting corresponding variables to {})
######################################################################

proc clear {} {
  global mkglobals
  eval $mkglobals
  global id

  set alias {}
  set email {}
  set first {}
  set last {}
  set phone {}
  set address {}
  set birthdate {}
  set comment {}
  set id {}
  for {set i 0} {$i < 8} {incr i} {
    set tags($i) 0
  }
  
  focus .people.first.e
}

######################################################################
# delete id - delete an alias
######################################################################

proc delete {id} {
  global mkglobals
  eval $mkglobals

  unset ALIAS($id)
  unset EMAIL($id)
  unset FIRST($id)
  unset LAST($id)
  unset PHONE($id)
  unset ADDRESS($id)
  unset BIRTHDATE($id)
  unset COMMENT($id)
  clear
  updatelist
}

######################################################################
# deleteall - delete all aliases
######################################################################

proc deleteall {} {
  global mkglobals
  eval $mkglobals

  foreach id [lsort [array names LAST]] {
    delete $id
  }
}

######################################################################
# deletework - delete all aliases tagged `Work'
######################################################################

proc deletework {} {
  global mkglobals
  eval $mkglobals

  foreach id [lsort [array names LAST]] {
    if {$TAGS($id,0)} {
      delete $id
    }
  }
}

######################################################################
# cmd_quit - exit the application
######################################################################

proc cmd_quit {} {
  if [j:confirm -priority 100 \
    -text "Save before quitting?" \
    -yesbutton Yes -nobutton No] {
    save
  }
  exit 0
}

######################################################################
# cmd_about - create an about box
######################################################################

proc cmd_about {} {
  global VERSION
  set about_people [format {
    j:rt:hl "jpeople"
    j:rt:cr
    j:rt:rm "by Jay Sekora, "
    j:rt:tt "js@princeton.edu"
    j:rt:par
    j:rt:rm "An address-book for X Windows."
    j:rt:cr
    j:rt:rm "Version %s."
    j:rt:par
    j:rt:rm "Copyright \251 1993-1994 by Jay Sekora.  "
    j:rt:rm "All rights reserved, except that this file may be freely "
    j:rt:rm "redistributed in whole or in part for non\255profit, "
    j:rt:rm "noncommercial use."
    j:rt:par
    j:rt:rm "If you find bugs or have suggestions for improvement, "
    j:rt:rm "please let me know.  "
    j:rt:rm "Feel free to use bits of this code in your own "
    j:rt:tt "wish"
    j:rt:rm " scripts."
  } $VERSION]
  j:about .about $about_people
  j:about:button .about {About jpeople} $about_people
  j:about:button .about {About the Author} [j:about_jay]
  j:about:button .about {About Tk and Tcl} [j:about_tktcl]
}

##############################################################################
# jpeople:cmd:people_prefs - preferences panel
##############################################################################

proc jpeople:cmd:people_prefs { args } {
  global JPEOPLE_PREFS
  j:parse_args { {title "People Preferences"} }
  
  set w .people_prefs
  toplevel $w
  wm title $w $title
  
  j:variable_entry $w.datafile \
    -label {Data file:} \
    -variable JPEOPLE_PREFS(datafile)
  
  frame $w.aliases
  frame $w.aliases.mail
  frame $w.aliases.elm
  frame $w.aliases.mh
  
  checkbutton $w.aliases.mail.c -relief flat -anchor w -width 26 \
    -text {Write UCB Mail aliases in } \
    -variable JPEOPLE_PREFS(mailaliases)
  checkbutton $w.aliases.elm.c -relief flat -anchor w -width 26 \
    -text {Write Elm aliases in } \
    -variable JPEOPLE_PREFS(elmaliases)
  checkbutton $w.aliases.mh.c -relief flat -anchor w -width 26 \
    -text {Write MH aliases in } \
    -variable JPEOPLE_PREFS(mhaliases)
  
  entry $w.aliases.mail.e -width 40 -relief sunken \
    -textvariable JPEOPLE_PREFS(mailfile)
  entry $w.aliases.elm.e -width 40 -relief sunken \
    -textvariable JPEOPLE_PREFS(elmfile)
  entry $w.aliases.mh.e -width 40 -relief sunken \
    -textvariable JPEOPLE_PREFS(mhfile)
  
  pack $w.aliases.mail.c -side left -fill both
  pack $w.aliases.elm.c -side left -fill both
  pack $w.aliases.mh.c -side left -fill both
  pack $w.aliases.mail.e -side left -fill both
  pack $w.aliases.elm.e -side left -fill both
  pack $w.aliases.mh.e -side left -fill both
  pack [j:filler $w.aliases.mail] -side left
  pack [j:filler $w.aliases.elm] -side left
  pack [j:filler $w.aliases.mh] -side left
  
  pack $w.aliases.mail -fill x
  pack $w.aliases.elm -fill x
  pack $w.aliases.mh -fill x
  
  frame $w.tags
  j:variable_entry $w.tags.tag0 -label {Tag 0:} -variable JPEOPLE_PREFS(tag,0)
  j:variable_entry $w.tags.tag1 -label {Tag 1:} -variable JPEOPLE_PREFS(tag,1)
  j:variable_entry $w.tags.tag2 -label {Tag 2:} -variable JPEOPLE_PREFS(tag,2)
  j:variable_entry $w.tags.tag3 -label {Tag 3:} -variable JPEOPLE_PREFS(tag,3)
  j:variable_entry $w.tags.tag4 -label {Tag 4:} -variable JPEOPLE_PREFS(tag,4)
  j:variable_entry $w.tags.tag5 -label {Tag 5:} -variable JPEOPLE_PREFS(tag,5)
  j:variable_entry $w.tags.tag6 -label {Tag 6:} -variable JPEOPLE_PREFS(tag,6)
  j:variable_entry $w.tags.tag7 -label {Tag 7:} -variable JPEOPLE_PREFS(tag,7)
  
  pack \
    $w.tags.tag0 \
    $w.tags.tag1 \
    $w.tags.tag2 \
    $w.tags.tag3 \
    $w.tags.tag4 \
    $w.tags.tag5 \
    $w.tags.tag6 \
    $w.tags.tag7 \
    -fill x -padx 5
  
  j:buttonbar $w.b -default save -buttons [format {
    { 
      save Save {
        j:write_prefs -array JPEOPLE_PREFS -file jpeople-defaults
        j:write_prefs -array JPEOPLE_PREFS -prefix tag -file jpeople-tags
        destroy %s
      }
    } {
      done Done {
        destroy %s
      }
    }
  } $w $w]
  

  pack \
    $w.datafile \
    -in $w -side top -fill x -padx 10 -pady 5
  pack \
    [j:rule $w] \
    -in $w -side top -fill x
  pack \
    $w.aliases \
    -in $w -side top -fill x -padx 10 -pady 5
  pack \
    [j:rule $w] \
    -in $w -side top -fill x
  pack \
    $w.tags \
    -in $w -side top -fill x -padx 10 -pady 5
  pack \
    [j:rule $w] \
    $w.b \
    -in $w -side top -fill x

  j:dialogue $w		;# position in centre of screen

  focus $w
  j:default_button $w.b.save \
    $w \
    $w.datafile.e \
    $w.aliases.mail.e \
    $w.aliases.elm.e \
    $w.aliases.mh.e \
    $w.tags.tag0.e \
    $w.tags.tag1.e \
    $w.tags.tag2.e \
    $w.tags.tag3.e \
    $w.tags.tag4.e \
    $w.tags.tag5.e \
    $w.tags.tag6.e \
    $w.tags.tag7.e
  j:tab_ring \
    $w.datafile.e \
    $w.aliases.mail.e \
    $w.aliases.elm.e \
    $w.aliases.mh.e \
    $w.tags.tag0.e \
    $w.tags.tag1.e \
    $w.tags.tag2.e \
    $w.tags.tag3.e \
    $w.tags.tag4.e \
    $w.tags.tag5.e \
    $w.tags.tag6.e \
    $w.tags.tag7.e
  bind $w <Key-Tab> "focus $w.datafile.e"
}


######################################################################
# mklist - create the listbox if it doesn't exist
######################################################################

proc mklist { {parent {}} } {
  global mkglobals
  eval $mkglobals

  if {! [winfo exists $parent.select]} {
    frame $parent.select
    # following is so it'll work in both tk 4.0 and 3.6
    option add $parent.select.lb.Geometry 15x15
    option add $parent.select.lb.Width 15
    option add $parent.select.lb.Height 15
    listbox $parent.select.lb -relief flat \
      -yscroll "$parent.select.sb set"
    
    scrollbar $parent.select.sb -relief flat -command "$parent.select.lb yview"
    frame $parent.select.b
    label $parent.select.b.l -anchor e -text {Limit:}
    entry $parent.select.b.e -relief sunken -width 15 \
      -textvariable LIMITPATTERN
    
    bind $parent.select.lb <1> {
      %W select from [%W nearest %y]
      set id [%W get [%W curselection]]
      set alias $ALIAS($id)
      set email $EMAIL($id)
      set first $FIRST($id)
      set last $LAST($id)
      set phone $PHONE($id)
      set address $ADDRESS($id)
      set birthdate $BIRTHDATE($id)
      set comment $COMMENT($id)
      for {set i 0} {$i < 8} {incr i} {
        set tags($i) $TAGS($id,$i)
      }
    }
    
    bind $parent.select.b.e <Return> {updatelist}

    pack append $parent.select.b \
      $parent.select.b.l {left pady 10} \
      $parent.select.b.e {left fillx pady 10} \
      [j:filler $parent.select.b] {left}
    pack append $parent.select \
      $parent.select.b {top} \
      [j:rule $parent.select] {top fillx} \
      $parent.select.lb {left expand fill} \
      [j:rule $parent.select] {left filly} \
      $parent.select.sb {left filly}
  }
  
  return $parent.select
}

######################################################################
# mkentry - handle creating each field
######################################################################

proc mkentry {{tag {}} {text {Entry:}} {next {}} {parent {}}} {
  frame $parent.people.$tag
  label $parent.people.$tag.l -anchor e -width 15 -text $text
  entry $parent.people.$tag.e -width 35 -relief sunken -textvariable $tag
  
  pack append $parent.people.$tag \
    $parent.people.$tag.l {left} \
    $parent.people.$tag.e {left expand fillx} \
    [j:filler $parent.people.$tag] {left}
  
  j:default_button .people.b.ok $parent.people.$tag.e
  
### bind $parent.people.$tag.e <Return> {addchange $id}

#  bind $parent.people.$tag.e <Tab> "focus $parent.people.$next.e"
}

######################################################################
# END OF PROCEDURE DEFINITIONS
######################################################################

toplevel .people

mklist .people			;# makes, fills frame

frame .people.menu -relief raised -borderwidth 2
menubutton .people.menu.people -text {People} -menu .people.menu.people.m
menubutton .people.menu.file -text {File} -menu .people.menu.file.m
menubutton .people.menu.person -text {Person} -menu .people.menu.person.m

menu .people.menu.people.m
.people.menu.people.m add command -label {About jpeople . . .} \
  -command {cmd_about}
.people.menu.people.m add command -label {Global Preferences . . .} \
  -command {j:global_pref_panel}
.people.menu.people.m add command -label {People Preferences . . .} \
  -command {jpeople:cmd:people_prefs}
.people.menu.people.m add command -label {Issue Tcl Command . . .} \
  -command {j:prompt_tcl}
.people.menu.people.m add separator
.people.menu.people.m add command -label {Quit} -accelerator {[q]} \
  -command {destroy .}

menu .people.menu.file.m
.people.menu.file.m add command -label {Merge} -command {merge}
.people.menu.file.m add command -label {Save} -command {save}
.people.menu.file.m add command -label {Merge/Load . . .} -command {load_prompt}
.people.menu.file.m add command -label {Save . . .} -command {save_prompt}
.people.menu.file.m add separator
######################################################################
# .people.menu.file.m add command -label {Read Elm } -command {readelm}
# .people.menu.file.m add separator
# .people.menu.file.m add command -label {Write Mail} -command {writemail}
# .people.menu.file.m add command -label {Write Elm} -command {writeelm}
# .people.menu.file.m add command -label {Write MH} -command {writemh}
# .people.menu.file.m add separator
######################################################################
.people.menu.file.m add command -label {Write TeX Addresses . . .} -command {
  texaddresses
}
.people.menu.file.m add command -label {Write TeX Phone Numbers . . .} \
  -command {texphones}
.people.menu.file.m add separator
.people.menu.file.m add command -label {Delete All} -command {deleteall}
.people.menu.file.m add command -label {Delete Work} -command {deletework}

menu .people.menu.person.m
.people.menu.person.m add command -label {Add/Change} -command {
  addchange $id
  clear
}
.people.menu.person.m add command -label {Delete} -command {
  delete $id
}
.people.menu.person.m add command -label {Clear} -command {
  clear
}
.people.menu.person.m add separator
.people.menu.person.m add command -label {Finger} -command {finger}
.people.menu.person.m add command -label {Ph} -command {ph}

pack append .people.menu .people.menu.people left
pack append .people.menu .people.menu.file left
pack append .people.menu .people.menu.person left

mkentry first {First Name:} last
mkentry last {Last Name:} id
mkentry id {ID:} alias
bind .people.id.e <space> {.people.id.e insert insert {_}}
mkentry alias {Alias(es):} email
mkentry email {Email Address:} phone
mkentry phone {Telephone:} address
mkentry address {Address:} birthdate
mkentry birthdate {Birthdate:} comment
mkentry comment {Comment:} first

j:tab_ring \
  .people.first.e \
  .people.last.e \
  .people.id.e \
  .people.alias.e \
  .people.email.e \
  .people.phone.e \
  .people.address.e \
  .people.birthdate.e \
  .people.comment.e

frame .people.tags
frame .people.tags.filler
pack append .people.tags .people.tags.filler {left expand fillx}
for {set i 0} {$i < 8} {incr i} {
  checkbutton .people.tags.$i \
    -relief flat -text $JPEOPLE_PREFS(tag,$i) -variable tags($i)
  if {"x$JPEOPLE_PREFS(tag,$i)" != "x"} {
    pack append .people.tags .people.tags.$i {left padx 5}
  }
}

j:buttonbar .people.b -default ok -buttons {
  { ok     OK     {addchange $id; clear} }
  { delete Delete {delete $id} }
  { clear  Clear  {clear} }
  { save   Save   {save} }
  { quit   Quit   {cmd_quit} }
}

pack append .people \
  .people.select {left filly} \
  [j:rule .people] {left filly} \
  .people.menu {top fillx} \
  [j:filler .people] {top fillx} \
  .people.first {top expand fillx} \
  .people.last {top expand fillx} \
  .people.id {top expand fillx} \
  .people.alias {top expand fillx} \
  .people.email {top expand fillx} \
  .people.phone {top expand fillx} \
  .people.address {top expand fillx} \
  .people.birthdate {top expand fillx} \
  .people.comment {top expand fillx} \
  .people.tags {top expand fillx} \
  [j:rule .people] {top fillx} \
  .people.b {top expand fillx}

wm minsize .people 100 100
wm maxsize .people 3000 3000

focus .people.first.e

bind Entry <Meta-q> {cmd_quit}

# read in user's configuration file:
j:source_config jpeoplerc.tcl
				;# destroying the .people toplevel quits
wm protocol .people WM_DELETE_WINDOW {cmd_quit}

merge				;# defaults to $JPEOPLE_PREFS(datafile)
