#!/usr/local/bin/tclsh7.4
# jperson - command-line interface to jpeople database
#
######################################################################
# 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			;# user preferences

set J_PREFS(tag,0) "Work"
set J_PREFS(tag,1) ""
set J_PREFS(tag,2) ""
set J_PREFS(tag,3) ""
set J_PREFS(tag,4) ""
set J_PREFS(tag,5) ""
set J_PREFS(tag,6) ""
set J_PREFS(tag,7) "Alternate"

set NAME $env(USER)
set HOME $env(HOME)

set J_PREFS(rcfile) $HOME/.people

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

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 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 people.tk 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 $J_PREFS(rcfile))
######################################################################

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

  if {$filename == {}} {
    set filename $J_PREFS(rcfile)
  }

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

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

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

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

merge					;# defaults to $J_PREFS(rcfile)

foreach id [ids_by_name] {
  foreach arg $argv {
    if [expr {[string match $arg $id] ||
              [string match $arg [lindex $ALIAS($id) 0]]}] {
      puts stdout ""
      puts stdout "               ID: $id"
      puts stdout ""
      puts stdout "       First Name: $FIRST($id)"
      puts stdout "        Last Name: $LAST($id)"
      if {$PHONE($id) != {}} {
        puts stdout "  Phone Number(s): $PHONE($id)"
      }
      if {$ADDRESS($id) != {}} {
        puts stdout "   Postal Address: $ADDRESS($id)"
      }
      if {$EMAIL($id) != {}} {
        puts stdout "    Email Address: $EMAIL($id)"
        puts stdout "   Mail Alias(es): $ALIAS($id)"
      }
      if {$COMMENT($id) != {}} {
        puts stdout "          Comment: $COMMENT($id)"
      }
      if {$BIRTHDATE($id) != {}} {
        puts stdout "        Birthdate: $BIRTHDATE($id)"
      }
      puts stdout ""
    }
  }
}


