#!/usr/local/bin/wish4.0
# jpeople - manage database of people, including Mail, elm, and MH aliases
#
######################################################################
# Copyright 1992-1995 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################
## begin boiler_header

if {[info exists env(JSTOOLS_LIB)]} {
  set jstools_library $env(JSTOOLS_LIB)
} else {
  set jstools_library /usr/local/lib/jstools
}

# add the jstools library to the library search path:

set auto_path [concat [list $jstools_library] $auto_path]

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

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

## end boiler_header

######################################################################
# 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 jpeople		;# 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 PS
}
eval $mkglobals

set PS(preamble) {%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% PostScript prologue for address printing
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/inches {72 mul} def

/TM 8 inches def	% top margin
/BM 0.75 inches def	% bottom margin
/LM 0.75 inches def	% left margin
/RM 5.0 inches def	% right margin

/currentcolumn 0 def	% 0 = left-hand; 1 = right-hand

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/namefont	/GillSans		def
/birthdatefont	/GillSans		def
/notefont       /GillSans-Italic	def
/phonefont      /GillSans-Bold		def
/addressfont	/GillSans		def
/emailfont	/GillSans		def

/fontsize       8                    def
/linespacing    10                   def
/addlspacing    4                    def	% additional between entries


/ModifiedLatin1Encoding 256 array def
ModifiedLatin1Encoding 0 [
  /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  /.notdef /.notdef /.notdef /.notdef
  
  /space
  /exclam
  /quotedbl
  /numbersign
  /dollar
  /percent
  /ampersand
  /quoteright
  /parenleft
  /parenright
  /asterisk
  /plus
  /comma
  /hyphen
  /period
  /slash
  /zero /one /two /three /four /five /six /seven /eight /nine
  /colon
  /semicolon
  /guilsinglleft
  /equal
  /guilsinglright
  /question
  /at
  /A /B /C /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W
  /X /Y /Z
  /bracketleft
  /backslash
  /bracketright
  /asciicircum
  /underscore
  /quoteleft
  /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s /t /u /v /w
  /x /y /z
  /braceleft
  /bar
  /braceright
  /asciitilde
  
  /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
  /.notdef /.notdef /.notdef
  /dotlessi
  /grave
  /acute
  /circumflex
  /tilde
  /macron
  /breve
  /dotaccent
  /dieresis
  /.notdef
  /ring
  /cedilla
  /.notdef
  /hungarumlaut
  /ogonek
  /caron
  
  /space
  /exclamdown
  /cent
  /sterling
  /currency
  /yen
  /brokenbar
  /section
  /dieresis
  /copyright
  /ordfeminine
  /guillemotleft
  /logicalnot
  /hyphen
  /registered
  /macron
  /degree
  /plusminus
  /twosuperior
  /threesuperior
  /acute
  /mu
  /paragraph
  /periodcentered
  /cedilla
  /onesuperior
  /ordmasculine
  /guillemotright
  /onequarter
  /onehalf
  /threequarters
  /questiondown
  /Agrave
  /Aacute
  /Acircumflex
  /Atilde
  /Adieresis
  /Aring
  /AE
  /Ccedilla
  /Egrave
  /Eacute
  /Ecircumflex
  /Edieresis
  /Igrave
  /Iacute
  /Icircumflex
  /Idieresis
  /Eth
  /Ntilde
  /Ograve
  /Oacute
  /Ocircumflex
  /Otilde
  /Odieresis
  /multiply
  /Oslash
  /Ugrave
  /Uacute
  /Ucircumflex
  /Udieresis
  /Yacute
  /Thorn
  /germandbls
  /agrave
  /aacute
  /acircumflex
  /atilde
  /adieresis
  /aring
  /ae
  /ccedilla
  /egrave
  /eacute
  /ecircumflex
  /edieresis
  /igrave
  /iacute
  /icircumflex
  /idieresis
  /eth
  /ntilde
  /ograve
  /oacute
  /ocircumflex
  /otilde
  /odieresis
  /divide
  /oslash
  /ugrave
  /uacute
  /ucircumflex
  /udieresis
  /yacute
  /thorn
  /ydieresis
] putinterval

% This is based on reencodeISO from the a2ps prologue, 
%% Copyright (c) 1992, 1993, Miguel Santana, santana@imag.fr
%% a2ps 4.2
% Set up ISO Latin 1 character encoding (modified)
/reencodeISOmod {
  dup dup findfont dup length 1 add dict begin
  { 1 index /FID ne { def }{ pop pop } ifelse
  } forall
  /Encoding ModifiedLatin1Encoding def
  % make the ISO-8859-1 accents non-spacing (violates standard, so sue me! :-)
  currentdict end
% metrics that prevent accents from spacing
10 dict begin
  [/dieresis /macron /acute /cedilla
  ] {0 def} forall
  dup /Metrics currentdict put  
end
  definefont
} def
[
  namefont
  birthdatefont
  notefont
  phonefont
  addressfont
  emailfont
] {
  reencodeISOmod def
} forall

/usefont {findfont fontsize scalefont setfont} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

/startprinting {
  0 inches 11 inches translate
  -90 rotate
  gsave
  topofpage
} def

/topofpage {
  grestore
  LM TM moveto
  gsave
} def

/newpage {
  showpage
  /currentcolumn 0 def
  topofpage
} def

/secondcolumn {
  5.5 inches 0 inches translate
  LM TM moveto
} def

/finishprinting {
  showpage
  grestore
} def

/newcolumn {
  currentcolumn 0 eq {
    /currentcolumn 1 def
    secondcolumn
  } {
    newpage
  } ifelse
} def

/newline {
  currentpoint		% stack: x y
  linespacing sub	% stack: x y'
  exch pop		% stack: y'
  LM			% stack: y' LM
  exch			% stack: LM y'
  moveto
} def

/maybebreak {
  currentpoint		% stack: x y
  BM lt {
    newcolumn
  } if
  pop
} def

/morespace {
  currentpoint		% stack: x y
  addlspacing sub	% stack: x y'
  exch pop		% stack: y'
  LM			% stack: y' LM
  exch			% stack: LM y'
  moveto
} def

/justify {
  dup			% stack: string string
  currentpoint exch	% stack: string string y x
  pop RM		% stack: string string y RM
  3 -1 roll		% stack: string y RM string
  stringwidth		% stack: string y RM wx wy
  pop			% stack: string y RM wx
  sub			% stack: string y x'
  exch			% stack: string x' qy
  moveto show
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


% stack:
%  email
%  address
%  phone
%  note
%  birthdate
%  name

/showperson {
  namefont usefont show
  
  birthdatefont usefont show
    
  notefont usefont ( ) show show
  
  phonefont usefont justify
  
  newline
  
  addressfont usefont show
  
  emailfont usefont justify
  
  newline morespace maybebreak
} def

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
}

######################################################################
# 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
###     }
###   }
### }

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

j:command:register jpeople:cmd:merge {Merge}
proc jpeople:cmd:merge { w } {
  # should do error checking
  global mkglobals
  eval $mkglobals

  set filename $JPEOPLE_PREFS(datafile)

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

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

proc jpeople:save {w {filename {}}} {
  # should do error checking
  global mkglobals
  eval $mkglobals
  set save_aliases 0
  
  if {$filename == {}} {
    set save_aliases 1
    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, ONLY if we're saving
  #   to the default file:
  
  if $save_aliases {
    if $JPEOPLE_PREFS(mailaliases) {
      jpeople:cmd:write_mail $w
    }
    if $JPEOPLE_PREFS(elmaliases) {
      jpeople:cmd:write_elm $w
    }
    if $JPEOPLE_PREFS(mhaliases) {
      jpeople:cmd:write_mh $w
    }
  }
}

######################################################################
# jpeople:cmd:save - save to default file
######################################################################

j:command:register jpeople:cmd:save Save
proc jpeople:cmd:save { w } {
  jpeople:save $w {}
}

######################################################################
# jpeople:cmd:load_prompt - prompt for a file to load
######################################################################

j:command:register jpeople:cmd:load_prompt {Merge/Load...}
proc jpeople:cmd:load_prompt { w } {
  set filename [j:fs]

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

######################################################################
# jpeople:cmd:save_prompt - write native-format output
######################################################################

j:command:register jpeople:cmd:save_prompt {Save...}
proc jpeople:cmd:save_prompt { w } {
  # should do error checking
  global mkglobals
  eval $mkglobals

  set filename [j:fs]
  
  if [string length $filename] {
    jpeople:save $w $filename
  }
}

######################################################################
# jpeople:cmd:write_elm - write elm alias format
######################################################################

j:command:register jpeople:cmd:write_elm {Write Elm}
proc jpeople:cmd:write_elm { w } {
  # 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 =  $LAST($id); $FIRST($id) = $EMAIL($id)"
    }
  }
  close $file
}

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

proc jpeople: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 jpeople:sort_by_name $filter_list]
}

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

proc jpeople: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]
}

######################################################################
# jpeople:cmd:write_mh - write in mh alias format
######################################################################

j:command:register jpeople:cmd:write_mh {Write MH}
proc jpeople:cmd:write_mh { w } {
  # 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) ($FIRST($id) $LAST($id))"
    }
  }
  close $file
}

######################################################################
# jpeople:cmd:write_mail - write in (ucb) Mail alias format
######################################################################

j:command:register jpeople:cmd:write_mail {Write UCB Mail}
proc jpeople:cmd:write_mail { w } {
  # 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:
    catch [list 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
}

######################################################################
# jpeople:cmd:read_elm - write from elm alias format
######################################################################

j:command:register jpeople:cmd:read_elm {Read Elm}
proc jpeople:cmd:read_elm { w } {
  # 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) {}
    }
  jpeople:updatelist
  }
}

######################################################################
# jpeople:ps_string - escape PostScript special characters
######################################################################

proc jpeople:ps_string { string } {
  regsub -all {[(\)]} $string {\\&} string
  return "($string)"
}

######################################################################
# jpeople:cmd:write_ps_addrs - write PostScript organiser pages
######################################################################

j:command:register jpeople:cmd:write_ps_addrs {Write PS Organiser Pages...}
proc jpeople:cmd:write_ps_addrs { w } {
  # should do error checking
  global mkglobals
  eval $mkglobals

  set filename [j:fs]
  
  set file [open $filename {w}]
  puts $file "$PS(preamble)\nstartprinting\n"
  foreach id [jpeople:filter] {
    jpeople:ps_entry $file $id
  }
  puts $file "\nfinishprinting\n"
  close $file
}

######################################################################
# jpeople:ps_entry file - write one entry to PostScript organiser pages
######################################################################

proc jpeople:ps_entry {{file stdout} id} {
  # should do error checking
  global mkglobals
  eval $mkglobals

  puts $file "% $id"
  if [string length $EMAIL($id)] {
    puts $file [jpeople:ps_string "<$EMAIL($id)>"]
  } else {
    puts $file "()"
  }
  puts $file [jpeople:ps_string $ADDRESS($id)]
  puts $file [jpeople:ps_string $PHONE($id)]
  puts $file [jpeople:ps_string $COMMENT($id)]
  if [string length $BIRTHDATE($id)] {
    puts $file [jpeople:ps_string ", b. $BIRTHDATE($id)"]
  } else {
    puts $file "()"
  }
  if [string length $FIRST($id)] {
    puts $file [jpeople:ps_string "$LAST($id), $FIRST($id)"]
  } else {
    puts $file [jpeople:ps_string $LAST($id)]
  }
  puts $file "showperson\n"
}

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

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

######################################################################
# jpeople:cmd:write_tex_addrs - write TeX source file for address list
######################################################################

j:command:register jpeople:cmd:write_tex_addrs {Write TeX Addresses...}
proc jpeople:cmd:write_tex_addrs { w } {
  # should do error checking
  global mkglobals
  eval $mkglobals

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

######################################################################
# jpeople:cmd:write_tex_phones - write TeX source file for telephone list
######################################################################

j:command:register jpeople:cmd:write_tex_phones {Write TeX Phone Numbers...}
proc jpeople:cmd:write_tex_phones { w } {
  # should do error checking
  global mkglobals
  eval $mkglobals

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

######################################################################
# jpeople:tex_entry file - write one entry to TeX source file
######################################################################

proc jpeople:tex_entry {{file stdout} id} {
  # should do error checking
  global mkglobals
  eval $mkglobals

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

### ######################################################################
### # jpeople: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 jpeople: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  
### }

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

proc jpeople:updatelist {} {
  global mkglobals
  eval $mkglobals

  # save current scroll value (to prevent jumping to top):
  j:tk3 {
    set oldyview [lindex [.people.select.sb get] 2]
  }
  j:tk4 {
    set oldfraction [lindex [.people.select.sb get] 0]
  }
  
  .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):
  j:tk3 {
    .people.select.lb yview $oldyview
  }
  j:tk4 {
    .people.select.lb yview moveto $oldfraction
  }
  
  update
}

######################################################################
# jpeople:cmd:finger - finger the currently-displayed person
######################################################################

j:command:register jpeople:cmd:finger {Finger}
proc jpeople:cmd:finger { w } {
  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
}

######################################################################
# jpeople:cmd:ph - ph the currently-displayed person
######################################################################

j:command:register jpeople:cmd:ph {Ph}
proc jpeople:cmd:ph { w } {
  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
}

######################################################################
# jedit:cmd:add_change id -
#   add or change an alias, based on current entry contents
######################################################################

j:command:register jpeople:cmd:add_change {Add/Change}
proc jpeople:cmd:add_change { w } {
  global mkglobals
  eval $mkglobals
  
  global id
  
  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)
  }
  jpeople:cmd:clear $w
  jpeople:updatelist
}

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

j:command:register jpeople:cmd:clear {Clear}
proc jpeople:cmd:clear { w } {
  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
}

######################################################################
# jpeople:cmd:ok - add_change and then clear
######################################################################

j:command:register jpeople:cmd:ok {OK}
proc jpeople:cmd:ok { w } {
  jpeople:cmd:add_change $w
  jpeople:cmd:clear $w
}

######################################################################
# jpeople:delete id - delete an alias
######################################################################

proc jpeople:delete { w 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)
  jpeople:cmd:clear $w
  jpeople:updatelist
}

######################################################################
# jpeople:cmd:delete id - delete the current alias
######################################################################

j:command:register jpeople:cmd:delete {Delete}
proc jpeople:cmd:delete { w } {
  global id
  
  jpeople:delete $w $id
}

######################################################################
# jpeople:cmd:delete_all - delete all aliases
######################################################################

j:command:register jpeople:cmd:delete_all {Delete All}
proc jpeople:cmd:delete_all { w } {
  global mkglobals
  eval $mkglobals

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

######################################################################
# jpeople:cmd:delete_work - delete all aliases tagged `Work'
######################################################################

j:command:register jpeople:cmd:delete_work {Delete Work}
proc jpeople:cmd:delete_work { w } {
  global mkglobals
  eval $mkglobals

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

######################################################################
# jpeople:cmd:quit - exit the application
######################################################################

j:command:register jpeople:cmd:quit Quit
proc jpeople:cmd:quit { w } {
  if [j:confirm -priority 100 \
    -text [j:ldb "Save before quitting?"] \
    -yesbutton [j:ldb Yes] -nobutton [j:ldb No]] {
    jpeople:save $w {}
  }
  exit 0
}

######################################################################
# jpeople:cmd:about - create an about box
######################################################################

j:command:register jpeople:cmd:about {About jpeople...}
proc jpeople:cmd:about { w } {
  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
##############################################################################

j:command:register jpeople:cmd:people_prefs {People Preferences...}
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"
}


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

proc jpeople: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 sunken \
      -yscroll "$parent.select.sb set"
    
    scrollbar $parent.select.sb -relief sunken \
      -command "$parent.select.lb yview"
    frame $parent.select.b
    label $parent.select.b.l -anchor e -text [j:ldb {Limit:}]
    entry $parent.select.b.e -relief sunken -width 15 \
      -textvariable LIMITPATTERN
    
    bind $parent.select.lb <1> {
      j:tk3 {
        %W select from [%W nearest %y]
      }
      j:tk4 {
        %W selection clear 0 end
        %W selection set [%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)
      }
    }
    
    j:tk4 {
      bind $parent.select.b.e <Return> {jpeople:updatelist; break}
    }
    j:tk3 {
      bind $parent.select.b.e <Return> {jpeople: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} \
      $parent.select.sb {left filly}
  }
  
  return $parent.select
}

######################################################################
# jpeople:mkentry - handle creating each field
######################################################################

proc jpeople: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

jpeople:mklist .people		;# makes, fills frame

frame .people.menu -relief raised -borderwidth 2
menubutton .people.menu.people \
  -text [j:ldb menu:people {People}] \
  -underline [j:ldb:underline menu:people] \
  -menu .people.menu.people.m
menubutton .people.menu.file \
  -text [j:ldb menu:file {File}] \
  -underline [j:ldb:underline menu:file] \
  -menu .people.menu.file.m
menubutton .people.menu.person \
  -text [j:ldb menu:person {Person}] \
  -underline [j:ldb:underline menu:person] \
  -menu .people.menu.person.m

menu .people.menu.people.m
j:menu:commands .people.menu.people.m . {
  jpeople:cmd:about
  jpeople:cmd:people_prefs
  -
  j:cmd:prompt_tcl
  j:cmd:prompt_unix
  -
  jpeople:cmd:quit
}

menu .people.menu.file.m
j:menu:commands .people.menu.file.m . {
  jpeople:cmd:merge
  jpeople:cmd:save
  jpeople:cmd:load_prompt
  jpeople:cmd:save_prompt
  -
  jpeople:cmd:read_elm
  jpeople:cmd:write_mail
  jpeople:cmd:write_elm
  jpeople:cmd:write_mh
  -
  jpeople:cmd:write_ps_addrs
  -
  jpeople:cmd:write_tex_addrs
  jpeople:cmd:write_tex_phones
  -
  jpeople:cmd:delete_all
  jpeople:cmd:delete_work
}

menu .people.menu.person.m
j:menu:commands .people.menu.person.m . {
  jpeople:cmd:add_change
  jpeople:cmd:delete
  jpeople:cmd:clear
  -
  jpeople:cmd:finger
  jpeople:cmd: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

jpeople:mkentry first [j:ldb {First Name:}] last
jpeople:mkentry last [j:ldb {Last Name:}] id
jpeople:mkentry id [j:ldb {ID:}] alias
j:tk4 {
  bind .people.id.e <space> {.people.id.e insert insert {_}; break}
}
j:tk3 {
  bind .people.id.e <space> {.people.id.e insert insert {_}}
}
jpeople:mkentry alias [j:ldb {Alias(es):}] email
jpeople:mkentry email [j:ldb {Email Address:}] phone
jpeople:mkentry phone [j:ldb {Telephone:}] address
jpeople:mkentry address [j:ldb {Address:}] birthdate
jpeople:mkentry birthdate [j:ldb {Birthdate:}] comment
jpeople:mkentry comment [j:ldb {Comment:}] first

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:command:buttonbar -default jpeople:cmd:ok .people.b . {
  {jpeople:cmd:ok}
  {jpeople:cmd:delete}
  {jpeople:cmd:clear}
  {jpeople:cmd:save}
  {jpeople: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

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 \
  .people.select.b.e

j:default_button .people.b.jpeople:cmd:ok \
  .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
# \
  .people.select.b.e

bind Entry <Meta-q> {jpeople:cmd:quit}

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

jpeople:cmd:merge .		;# defaults to $JPEOPLE_PREFS(datafile)

j:tk3 {
  tk_menuBar .people.menu \
    .people.menu.people \
    .people.menu.file \
    .people.menu.person
  tk_bindForTraversal Entry
}

j:command:bind Entry . [j:command:list]

