#!/bin/sh -- # A comment mentioning perl, indented bash's sake.
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;

#############################################################################
# hack for speed caching of wish code:
if ( @ARGV == 0 ) {
	$Save_It = 'wish';
} elsif ( @ARGV == 1 && $ARGV[0] eq '-v' ) {
	$Save_It = 'wish-v';
} else {
	$Save_It = '';
}

if ( $Save_It && $ENV{USER} =~ /runge/ && -x "$0.$Save_It" ) {
	my $mtime_wish = (stat(_))[9];
	my $cmd = "$0.$Save_It";
	my ($mtime_modems, $mtime_this, $mtime_db);
	my $home = "/home/runge";
	if ( -f "$0" ) {
		$mtime_this = (stat(_))[9];
	}
	if ( -f "$home/.modems" ) {
		$mtime_modems = (stat(_))[9];
	}
	if ( -f "$home/.people" ) {
		$mtime_db = (stat(_))[9];
	}
	my $ok = 1;
	if ( $ENV{PEOPLE_MODEM_LIST} ne '' ) {
		$Save_It = '';
		$ok = 0;
	} elsif ( $mtime_modems && $mtime_modems > $mtime_wish ) {
		#print STDERR "$home/.modem: ", $mtime_modems - $mtime_wish, " secs\n";
		$ok = 0;
	} elsif ( ! $mtime_db || $mtime_db > $mtime_wish ) {
		#print STDERR "$home/.people: ", $mtime_db - $mtime_wish, " secs\n";
		$ok = 0;
	} elsif ( ! $mtime_this || $mtime_this > $mtime_wish ) {
		#print STDERR "$0: ", $mtime_this - $mtime_wish, " secs\n";
		$ok = 0;
	}
	if ( $ok ) {
		print STDERR "using $cmd....\n";
		exec $cmd;
		exit 1;
	}
}

#############################################################################
# real start...
if ( $ENV{PEOPLE_GEOMETRY} ne '' ) {
	$geometry = "-geometry " . $ENV{PEOPLE_GEOMETRY};
} else {
	chop($geometry = "-geometry " . `ran_geom`);
}

chop($Program = `basename '$0'`);

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

$ENV{PEOPLE_COMMAND} = "$0 " . join(' ', @ARGV);

$Debug = 0;

$List_Only = 0;
$Self_Contained = 0;

$Add_Timeout = 0;

$Dump_Addresses = 0;
$Dump_Wish_Code = '';
$Fax_Only = 0; 
$Scrub_Only = 0; 
$To_Stdout = 0;
$PostScript = '';
$Print_Name = 0;
$Verbose = 0;
$ShutoffVerbose = 0;
$Vcard = 0;
$Mime = 0;
$Stanza_Height = '6';
$Stanza_Sep = '-----';

$Plus_Number = 0;

$PS_cols = 4;
$PS_font = 'Courier4';

$Mailto_Cmd   = 'mail5';
$Host_Cmd   = 'xterm -T "%HOSTNAME" -geometry +250+150 -e host_wrap %HOSTNAME';
$Url_Cmd      = 'url';
$Map_Cmd      = 'map';
$YP_Cmd      = 'yp_people -x';
$Map2_Cmd     = 'map2';
$Envelope_Cmd = 'envelope -x -t "%TO"';
#############################################################################

$Usage = <<"END";

$Program: People''s addresses and phone numbers and etc.

Features:
	- auto dialing
	- multiple phone numbers
	- send fax
	- send email
	- create envelope
	- goto home page
	- ping, vnc, etc. hostname
	- find map

Usage: $Program <options> <item>

Options: 
	-v	Show all entries in database.
	-t <type>   <type> is a list of attribute types to match.
	-c <class>  A "," separated list of classes to match.
	-f <file>	Use <file> as people database

	-V,-vcard Print a vcard to stdout
	-mime	Mime multipart for vcard
	-ps	Create a tiny printable version of the database.
		(you preview/print while in gv(1))
		Also use -ps ncol:font for enscript args of number
		of columns and font. If font=<n> => Courier<n>
		default: -ps $PS_cols:$PS_font

	-l	Print all info to stdout (2), multiline. Also -L
	-ls	Print names and primary phone number to stdout (1 line output)
	-la	Print names and primary phone number and primary
		address to stdout (3). Both are 1 line per item.
	-stdout	Print primary phone number to stdout instead of dialing it.
	-name   Print name to stdout when number is clicked.

	-palm	Dump addresses as in Palm OS CSV format.
	-addr1	Dump primary addresses 1 per line : separated.
	-addrs	Dump a primaryddresses in equal sized stanzas
	-H <n>	Set stanza height to <n> (default: $Stanza_Height)

	-plus	Phone numbers are put out in +1234567890 notation.
	-scrub	Scrub a number (trim out cruft and adjust areacode)
	-fax	Show primary fax numbers only. Useful with -stdout to get
		a users reply.
	-A	Launch a A-Z table
	-ypf	Use full name in YP searching.
	-geometry <geom>  Set geometry.

	-add <n> Add an entry with number <n> (use "1" for new)
	-add_timeout <n>  times out after <n> secs
	-e <str> Edit name matching <str>

	-d 	Debug
	-wish <file> 	Dump wish code to <file>

	-self_dump	dump a self contained program (run with -self)
	-self	use a self contained version of the database

Notes:
	Requires: perl, wish.
	Programs that may be called:
		xterm, xwit, ping, enscript, vi, ls, tail, kill, dirname,
		basename, wc, hostname,
	Homebrew programs that may be called:
		autodial, url, map, map2, yp_people, mail5, faxcover, efax,
		envelope, xvi, ran_geom, vcard, tktty

	Stanzas are separated by: $Stanza_Sep

	See also vcard (for people -> vcard -> netscape pab translation)

Database format:

\@AREA_CODE: 603
#
# Format:
# <attributes>:<NAME>; TAG=val; ...;
# Lines may be spread out over multi lines as long as they don't match
# <attributes>:.
#
# If a <NAME> begins with SERVICE or MEDICAL they are grouped together
# in the rolodex list. This should have been done by attributes...
#
# Lines basically start with ":" optionally preceded by some attributes.
# attributes are labeled by a single letter followed optionally by numbers.
# For example xmas cards would be "x:" See list below.
#
# TEL[:label]=nnn-nnn-nnnn[xnnn];
# FAX[:label]=nnn-nnn-nnnn[xnnn];
# ADR[:label]=POB,EXTENDED,STREET,CITY,STATE,ZIP,COUNTRY;
# or
# ADR[:label]=POB,EXTENDED,STREET,LOCALITY,REGION,POSTALCODE,COUNTRY;
# URL[:label]=<url>;
# EMAIL[:label]=<mailto>;
# BDAY[:label]=<nnnn/nn/nn[,nn:nn:nn]>;
# SSN[:label]=<nnnnnnnnnn>;
# HOSTNAME[:label]=<fqhn>
# NOTE[:label]=...
#
# Directives start lines with \@ and are currently:
#
# default area code for dialing (used for trimming for "local" calls).
# \@AREACODE: <nnn>
#
# A long string to attach to a block of people. E.g. "Volleyball team"
# \@CLASS:<string>
#  <entries>
# \@CLASS:   shuts off class.
#
# Can apply a attribute block via:
# \@ATTRIB:<string>
#  <entries>
# \@ATTRIB:  shuts off attribute.
#
##########################################################
# Notes:
# Currently used attributes: 
#       v       only use the entry when in verbose mode.
#       x       xmas card to {fullname}
#       X       xmas card to "The {lastname}s"   
#       X1      xmas card to "The {lastname}"    (plural names, e.g. Peters)
#       X2      xmas card to "The {lastname}'s"  (' for odd names)
##########################################################
#

END

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

$Do_add = '';
$Do_edit = 0;
$Edit_match = '';
$Do_alpha = 0;
$Match_type = '';
$Match_class = '';

LOOP:	
while (@ARGV) {
    $_ = shift;
    CASE: {
	/^-d$/ && ($Debug = 1, last CASE);
	/^-add$/ && ($Do_add = shift, last CASE);
	/^-add_timeout$/ && ($Add_Timeout = shift, last CASE);
	/^-e$/ && ($Do_edit = 1, $Edit_match = shift, last CASE);
	/^-t$/ && ($Match_type .= shift, last CASE);
	/^-c$/ && ($Match_class .= ',' , shift, last CASE);
	/^-fax$/ && ($Fax_Only = 1, last CASE);
	/^-f$/ && ($ENV{PEOPLE_DB} = shift, last CASE);
	/^-addr1$/ && ($Dump_Addresses = 1, last CASE);
	/^-addrs$/ && ($Dump_Addresses = 2, last CASE);
	/^-plus$/ && ($Plus_Number = 1, last CASE);
	/^-wish$/ && ($Dump_Wish_Code = shift, last CASE);
	/^-self$/ && ($Self_Contained = 1, last CASE);
	/^-self_dump$/ && ($Self_Contained = 2, last CASE);
	/^-H$/ && ($Stanza_Height = shift, last CASE);
	/^-scrub$/ && ($Scrub_Only = 1, last CASE);
	/^-v$/ && ($Verbose = 1, last CASE);
	/^-nv$/ && ($ShutoffVerbose = 1, last CASE);
	/^(-ls|-1)$/ && ($List_Only = 1, $Verbose = 1, last CASE);
	/^(-L|-l)$/ && ($List_Only = 2, $Verbose = 1, last CASE);
	/^-la$/ && ($List_Only = 3, $Verbose = 1, last CASE);
	/^-ypf$/ && ($ENV{PEOPLE_YPF} = 1, last CASE);
	/^-stdout$/ && ($To_Stdout = 1, last CASE);
	/^-ps$/ && ($PostScript = ' ' . shift, last CASE);
	/^(-name)$/ &&  ($Print_Name = 1, last CASE);
	/^(-V|-vcard)$/ &&  ($List_Only = 1, $Vcard = 1, last CASE);
	/^-palm$/ &&  ($List_Only = 1, $Palm_CSV = 1, last CASE);
	/^-mime$/ &&  ($Mime = 1, last CASE);
	/^-geometry$/ && ($geometry = "-geometry " . shift, last CASE);
	/^-A$/ && ($Do_alpha = 1, last CASE);
	/^-(-.*)$/ && (unshift(@ARGV, $1), last CASE);
	/^(-h|-help)$/ && ((&help), exit 0, last CASE);
	if ( /^-(..+)$/ ) {	# split bundled switches:
		my($y, $x) = ($1, '');
		foreach $x (reverse(split(//, $y))) { unshift(@ARGV,"-$x") };
		last CASE;
	}
	/^-/ && ((print STDERR "Invalid arg: $_\n", &help), exit 1, last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

#############################################################################
if ( $PostScript ne '' ) {
	$tmp = "/tmp/people.$$.ps";
	#$cols = 3;
	#$font = 'Courier5';
	$cols = $PS_cols;
	$font = $PS_font;
	if ( $PostScript =~ /^\s*(\d+):/ ) {
		$cols = $1;
		$font = $';
		$font = "Courier$font" if $font =~ /^\d+$/;
	}
	print STDERR "$Program: Creating PostScript cols=$cols",
			" font=$font in $tmp.\n"; 
	print STDERR "$Program: Print it from ghostscript if it looks ok.\n";
	$enscript = "enscript -B -r --columns=$cols -f $font -p -";
	$out = ':VCARD|VERSION|^N:';
	if ( $ENV{GV} ne '' ) {
		$gv =  $ENV{GV};
	} else {
		$gv = 'gv -geometry +0+0';
	}
	system("$Program -vcard -v | egrep -v '$out' | $enscript > $tmp; $gv $tmp; rm -f $tmp");
	exit 0;	# EXIT
}

if ( $List_Only ) {
	my $match = $ARGV[0];
	if ( $match =~ /^[-\d()[\]]+$/ ) {
		$match =~ s/\D//g;
		$match = join('.*', split(//, $match));
		open(LIST, "$0 -la |") || die "$!";
		while (<LIST>) {
			if ( /$match/o ) {
				print $_;
			}
		}
		close(LIST);
		exit 0; # EXIT
	}
}

#############################################################################
$Edit_match = '.' if $Do_edit && $Edit_match eq '';
$Edit_match =~ s/([\(\)])/\\$1/g;

if ( $ENV{PEOPLE_DB} ne '' ) {
	$DB = $ENV{PEOPLE_DB};
} else {
	$DB = "$ENV{HOME}/.people";
}

$rcfile = "$ENV{HOME}/.peoplerc";
if ( -e $rcfile ) {
	require "$rcfile";
}

if ( ! -f $DB ) {
	chop($DB = `dirname '$0'`);
	$DB = "$DB/../.people";
}
if ( ! -f $DB ) {
	chop($DB = `dirname '$0'`);
	$DB = "/home/runge/.people";
}

$ENV{PEOPLE_DB} = $DB;

if ( $ENV{PEOPLE_MODEM_LIST} ne '' || $Scrub_Only ) {
	;
} else {
	system("type autodial 1>/dev/null 2>&1");
	if ( $? == 0 ) {
	    if ( $ENV{PEOPLE_MODEM_LIST} eq '' 
	      && open(MODEM_LIST, "autodial -v -list|") ) {
		while (<MODEM_LIST>) {
			chop;
			$_ =~ s/\s+NOTE:\S+$//;
			$_ =~ s/\s+AT\S+$//;
			$_ =~ s/\s+\d+$//;
			$ENV{PEOPLE_MODEM_LIST} .= "$_,";
		}
		close(MODEM_LIST);
		$ENV{PEOPLE_MODEM_LIST} =~ s/,+$//;
		if ( $ENV{PEOPLE_MODEM_PREFER} ne '' ) {
			$ENV{PEOPLE_MODEM_LIST} = $ENV{PEOPLE_MODEM_PREFER} .
				"," . $ENV{PEOPLE_MODEM_LIST};
		}
	    }
	} else {
		$ENV{PEOPLE_MODEM_LIST} = "";
	}
}

if ( $To_Stdout ) {
	$ENV{PEOPLE_TO_STDOUT} = 1;
}
if ( $Print_Name ) {
	$ENV{PEOPLE_NAME_TO_STDOUT} = 1;
}
if ( $Fax_Only ) {
	$ENV{PEOPLE_FAX_ONLY} = 1;
	$Do_alpha = 0;
}

#############################################################################
if ( $Do_add ne '' ) {

	$Read_Input = 0;
	sub timeout {
		print STDERR "\ngot sig: $_[0]\n";
		if ( ! $Read_Input ) {
			exit 0;
		}
		alarm(0);
	}

	if ( $Add_Timeout ) {
		print STDOUT "(window times out in $Add_Timeout secs)\n";
	}
	
	print STDOUT <<"END";

:Karl J. Runge;
        TEL=603-444-4444;
        FAX=603-444-4444;
        TEL:2=603-444-4444;
        ADR=,,  11 Intosh Lane,
                Medford, NH, 44444, USA;
        EMAIL=moo\@example.com;
        URL=http://www.someplace.com/~username;
        BDAY=1944/04/04;
        NOTE=woo

END

	print STDOUT "(to append to $DB, V for vCard, ^C to quit)\n"; 

	if ( $Add_Timeout ) {
		alarm($Add_Timeout);
		$SIG{ALRM} = 'timeout';
	}
	if ( $Do_add =~ /^\s*$/ || $Do_add eq '1' ) {
		print STDOUT "\nEnter Number: ";
		chop($Do_add = <STDIN>);
		$Read_Input++; alarm(0);
	}
	if ( $ENV{EDITOR} ne '' ) {
		$editor = $ENV{EDITOR};
	} else {
		$editor = 'vi';
	}

	if ( $Do_add =~ /^V$/i ) {
		print STDOUT "\nPaste in vCard, then press ^D:\n\n";
		$vcard = '';
		while (<STDIN>) {
			if ( ! $Read_Input ) {
				$Read_Input++; alarm(0);
			}
			if ( $_ =~ /^\s*TEL\s*;/ ) {
				# change (603) to 603-
				$_ =~ s/\((\d\d\d)\)/${1}-/g;
				$_ =~ s/-+/-/g;
			}
			$vcard .= $_;
		}
		$tmp = "/tmp/$Program.$$";
		open(TMP, ">$tmp") || die "$!";
		print TMP $vcard;
		close(TMP);

		$vcard = `vcard -p '$tmp'`;
		unlink($tmp);

		open(DB, ">>$DB") || die "$!";
		print DB $vcard;
		close(DB);
		chomp($line = `wc -l '$DB' | awk '{print \$1}'`);
		$line = $line + 1 - scalar(split(/\n/, $vcard));
		
		$editor .= " +$line $DB";
		print STDOUT "\nPopping into Editor to check new entry:\n\n";
		sleep 2;
		system($editor);

		exit 0;	# EXIT
	}

	print STDOUT "\nAdding number $Do_add to $DB,\n\n",
					"Enter Name (blank to quit): ";
	chop($name = <STDIN>);
	if ( ! $Read_Input ) {
		$Read_Input++; alarm(0);
	}
	exit 0 if $name =~ /^\s*$/;
	print STDOUT "Enter Street: ";
	chop($street = <STDIN>);
	$csz = ",, $street, ";
	foreach $case (qw(City State Zip Country)) {
		print STDOUT "Enter $case: ";
		chop($tmp = <STDIN>);
		$tmp =~ s/[;,]/ /g;
		$csz .= "$tmp, ";
		$csz =~ s/, $// if $case eq 'Country';
	}

	foreach $type (qw(FAX EMAIL URL BDAY SSN HOSTNAME))  {
				
		print STDOUT "Enter $type: ";
		chop($x = <STDIN>);	$x = &trim($x);
		if ( $x ne '' ) {
			if ( $type eq 'FAX' ) {
				$Do_add .= ";\n\t$type=$x";	
			} else {
				$csz .= ";\n\t$type=$x";	
			}
		}
	}

	print STDOUT "Enter note or addl info (end with \".\"):\n";
	$info = '';
	while (<STDIN>) {
		last if $_ eq ".\n";
		$info .= "\t" . $_;
	}
	chomp($line = `wc -l '$DB' | awk '{print \$1}'`);
	$line += 2;
	open(DB, ">>$DB") || die "$!";
	print DB "\n:$name;\n\tTEL=$Do_add;\n\tADR=$csz;\n\tNOTE=$info\n";
	close(DB);
	print STDOUT "\nAdded:\n";
	system("tail +$line '$DB'");

	$editor .= " +$line $DB";
	print STDOUT "\nPopping into Editor to check new entry:\n\n";
	sleep 1;
	system($editor);

	exit 0;	# EXIT
}

#############################################################################
if ($ARGV[0] && ! $List_Only && ! $Scrub_Only) {
	$Match = shift;
	$Match0 = "\\[$Match\\]";
	if ( $Match =~ /^\w$/ ) {
		$Match = "(?i)^$Match";
	} elsif ( $Match =~ m,^/([^/]+), ) {
		$Match0 = "\\[$1\\]";
		$Verbose = 1;
	} else {
		$Match = "/" . $Match;
		$Verbose = 1;
	}
}

$Verbose = 0 if $ShutoffVerbose;

$db_lines = '';
close(DB);
if ( $Self_Contained == 1 ) {
	$db_lines = unpack("u", &pdata());
} else {
	open(DB, "<$DB") || die "$!";
}

$fcount1 = 0;
while (<DB>) {
	$fcount1++; 
	last if /^__END__/;
	if ( $_ =~ /^#include\s+/ ) {
		# handle 1 level of #include's
		$infile = $';
		$infile =~ s/\s*$//;
		next if $infile eq $DB;
		
		$fcount2 = 0;
		if ( open(INCFILE, "<$infile") ) {
		    while ($line = <INCFILE>) {
			$fcount2++;
			last if $line =~ /^__END__/;
			$db_lines .= $line;
			if ( $Do_edit && $line =~ /$Edit_match/io ) {
				$Edit{file} = $infile;
				$Edit{line} = $fcount2;
				last;
			}
		    }
		    close(INCFILE);
		}
		next;
	} elsif ( $Do_edit && $_ =~ /$Edit_match/io ) {
		$Edit{file} = $DB;
		$Edit{line} = $fcount1;
		last;
	}
	$db_lines .= $_;
}
close(DB);

if ( $Self_Contained == 2 ) {
	open(THIS, "<$0") || die "$!";
	my $code;
	# sanitize db_lines a bit:
	$db_lines =~ s/SSN.*?;//g;
	while (<THIS>) {
		if ( /^%PDATA/ ) {
			print pack("u", $db_lines);
		} elsif ( /^\$Self_Contained = 0;/ ) {
			print '$Self_Contained = 1;', "\n";
		} else {
			print;
		}
	}
	close(THIS);
	exit 1;
}

#############################################################################
if ( $Do_edit ) {
	if ( ! -f $Edit{file} ) {
		print STDERR "No file to edit. $Edit{file}, $!\n";
		exit 1;
	}
	if ( $ENV{EDITOR} ne '' ) {
		$editor = $ENV{EDITOR};
	} else {
		$editor = 'vi';
	}
	if ( $Edit{line} =~ /^\d+$/ ) {
		$editor .= " +$Edit{line}";
	}
	$editor .= " $Edit{file}";
	print STDERR "\nRunning: $editor ...\n";
	system($editor);
	exit $?; # EXIT
}

#############################################################################
@lines = ();
$current = '';

$ENV{PEOPLE_VERBOSE} = 1 if $Verbose;

$Class = '';
$Attrib = '';

foreach (split(/\n/, $db_lines)) {
	if ($_ =~ /^\@AREA_CODE:\s*/ ) {
		$Area_Code = &trim($');
		last if $Scrub_Only;
		next;
	} elsif ( $_ =~ /^\@CLASS:\s*/ )  {
		$Class = &trim($');
		next;
	} elsif ( $_ =~ /^\@ATTRIB:\s*/ )  {
		$Attrib = &trim($');
		next;
	}
	next if /^\s*#/;
	next if /^\s*$/;

	# no whitespace before the :
	if ( /^(\w*):/i ) {
		$tmp = $' . "\n";
		$attr = $1;
		if ( $attr eq '' ) {
			$attr = $Attrib;
		}
		$tmp = "$attr,$Class:$tmp";
		push(@lines, $current) unless $current =~ /^\s*$/;
		$current = $tmp;
		next;
	}
	$_ =~ s/^\t*//;
	$current .= $_ . "\n";
}
push(@lines, $current);

#############################################################################
$Match_type =~ s/([A-Z])/,$1/ig;
$Match_type =~ s/^,+//;
@Match_types = split(/,/, $Match_type);

foreach $t (@Match_types) {
	$Match_type{$t} = 1;
}

@Match_classes = split(/,/, $Match_classes);

if ( ! $Scrub_Only ) {
	
    foreach $line (@lines) {

	$Line_Count++;
	# print STDERR "line: $line\n";

	($attr, $rest)  = split(/:/, $line, 2);
	($name, $rest)  = split(/;/, $rest, 2);
	($attr, $class) = split(/,/, $attr);

	$name  =~ s/\n/ /g;
	$name  =~ s/\s+/ /g; 
	$name  = &trim($name);
	$attr  = &trim($attr);
	$class = &trim($class);

	if (@Match_types) {
		next if $attr eq '';

		# with a lot of entries this will need to be sped up.
		$ok = 0;
		$atmp = $attr;
		$atmp =~ s/([A-Z])/,$1/ig;
		$atmp =~ s/^,+//;
		foreach $t (split(/,/, $atmp)) {
			next if $t eq '';
			$ok++ if $Match_type{$t};
		}
		if ( ! $ok ) {
			foreach $t (@Match_types) {
			    if ( $t =~ /\*/ ) {
				$char = $`;
				foreach $t2 (split(/,/, $atmp)) {
					next if $t2 eq '';
					$t2 = substr($t2, 0, length($char));
					$ok++ if $char eq $t2;
				}
			    }
			}
		}
		next unless $ok;

	} elsif (@Match_classes) {
		$ok = 0;
		foreach $t (@Match_classes) {
			next if $t eq '';
			$ok++ if $t eq $class;
		}
		next unless $ok;

	} elsif ( $attr =~ /v/i && ! $Verbose && ! $Do_alpha && ! $Match ) {
		next;
	}

	$id = "$name -- $Line_Count";

	$Ids[$Line_Count] = $id;

	$rest =~ s/\\;/__SEMI_COLON__/g;
	foreach $item (split(/;/, $rest)) {
		$item =~ s/__SEMI_COLON__/;/g;
		$item = &trim($item);

		next if $item eq '';

		push(@{$Item{$id}{'__ITEMS__'}}, $item);

		if ( $item =~ /^([^:=]+):*([^=]*)=/i ) {
			$type  = $1;
			$sub   = $2;
			$val = &trim($');
			$sub = 'PRIMARY' if $sub eq '';
			$type =~ y/a-z/A-Z/;

			if ( $type !~ /^(TEL|FAX|EMAIL|URL|ADR|BDAY|SSN|HOSTNAME|NOTE)$/ ) {
				print STDERR "UNKNOWN_ITEM: $type %%%%%%%%",
						" $item %%%%%%%% $line\n";
				exit 1;
			}

			if ( $type =~ /^(TEL|FAX)$/ ) {
				$val =~ s/\n/ /g;
				$val = &trim($val);
				$val = &plus_number($val) if $Plus_Number;
			}

			if ( ! defined $Item{$id}{$type}{$sub} ) {
				if ( $sub eq 'PRIMARY' ) {
					unshift(@{$Item{$id}{$type}{'__LIST__'}}, $sub);
				} else {
					push(   @{$Item{$id}{$type}{'__LIST__'}}, $sub);
				}
				$Item{$id}{$type}{$sub} = $val;
			} else {
				print STDERR "WARNING: DUPLICATE: $id, $type,",
						" $sub -> $val\n";
			}
		}
	}

	if ( $name =~ /\s(\S+)$/ ) {
		$last_name = $1;
	} else {
		$last_name = $name;
	}
	if ( $name =~ /^\s*(\S+)/ ) {
		$first_name = $1;
	} else {
		$first_name = $name;
	}

	if ( ! $Do_alpha ) {
		if ( $first_name eq 'SERVICE' ) {
			$last_name = "zz$name";
		}
		if ( $first_name eq 'MEDICAL' ) {
			$last_name = "zy$name";
		}
	}

	$name =~ s/SERVICE/\\[S\\]/g;
	$name =~ s/MEDICAL/\\[M\\]/g;
	$Serv_Match = '^(SERVICE|MEDICAL)$';
	$Serv_Lmatch = '\[(S|M)\]';

	my($l);
	if ( $first_name =~ /$Serv_Match/o ) {
		$Lasts{'#'} = 1;
		
	} elsif ( $last_name =~ /^./ ) {
		$l = $&;
		$l =~ y/a-z/A-Z/;
		# print STDERR "lasts: $l\n";
		$Lasts{$l} = 1;
	}

	if ( $Match ) {
		if ( $Match =~ /\#/ ) {
			next unless $first_name =~ /$Serv_Match/o;
		} elsif ( $Match =~ m,^/([^/]+), ) {
			my($mat) = $1;
			if ( $first_name !~ /$mat/oi 
			    && $last_name !~ /$mat/oi ) {
				next;
			}
		} else {
			# not used?
			next if $first_name =~ /$Serv_Match/o;
			next unless $last_name =~ /$Match/o;
		}
	}

	$n = length($name);
	$Width{name} = $n if $n > $Width{name};

	$Item{$id}{'__NAME__'} = $name;
	$Item{$id}{'__FIRST_NAME__'} = $first_name;
	$Item{$id}{'__LAST_NAME__'}  = $last_name;

	$Item{$id}{'__STANZA__'} = $line;

	$sub = $Item{$id}{'TEL'}{'__LIST__'}->[0];
	if ( $sub ne '' ) {
		$number = $Item{$id}{'TEL'}{$sub};	
		$n = length($number);
		$Width{number} = $n if $n > $Width{number};
	}

	$Item{$id}{'__ATTRIB__'} = $attr;
	$Item{$id}{'__CLASS__'}	 = $class;
	$Sort{$last_name} .= "$id;;";

	$Items++;
    }
}

if ( $ENV{AREACODE} ) {
	$Area_Code = $ENV{AREACODE};
}

$Area_Code = '999' unless $Area_Code;

#############################################################################
if ( $Scrub_Only ) {
	if (! @ARGV ) {
		while (<STDIN>) {
			chop;
			&scrubone($_);
		}
	} else {
		foreach $n (@ARGV) {
			&scrubone($n);
		}
	}
	exit 0; # EXIT
}

sub scrubone {
	my($n) = @_;

	# need a better algorithm
	# 1) trim out non \d?
	# 2) length = 10 => /^603//
	# 3) length = 11 => /^1603//
	# 4) length = 10 => 1.$n 
	# copy to tcl/tk area

	# What about ,,,, sleep shims?
	# BEGIN_DUPLICATED:
	$n =~ s/\D//g;

	if ( length($n) == 10 ) {
		$n =~ s/^$Area_Code//;
	}
	if ( length($n) == 11 ) {
		$n =~ s/^1$Area_Code//;
	}
	if ( length($n) == 10 ) {
		$n = "1$n";
	}
	# END_DUPLICATED:

	print STDOUT "$n\n";
}

#############################################################################
sub address_split {
	my ($line) = @_;

	# ADR[:label]=POB,EXTENDED,STREET,LOCALITY,REGION,POSTALCODE,COUNTRY;
	my ($pob, $ext, $street, $locality, $region, $postalcode, $country);

	$line = &trim($line);
	$line =~ s/\\,/__COMMA__/g;
	my (@array, $a);

	@array = split(/,/, $line);
	foreach $a (@array) {
		$a = &trim($a);
		$a =~ s/__COMMA__/,/g;
	}

	($pob, $ext, $street, $locality, $region, $postalcode, $country)
		= @array;
		
	return ($pob, $ext, $street, $locality, $region, $postalcode, $country);

}

sub First_Item {
	my ($id, $type) = @_;
	my ($return, $sub);
	
	$return = '';
	$sub = $Item{$id}{$type}{'__LIST__'}->[0];
	if ( $sub ne '' ) {
		$return = $Item{$id}{$type}{$sub};
	}
	return $return;
}

sub All_Item {
	my ($id, $type) = @_;
	my ($return, $sub);
	
	$return = '';
	foreach $sub (@{$Item{$id}{$type}{'__LIST__'}}) {
		$return .= "__SEP__" if $return ne '';
		$return .= "$sub=" . $Item{$id}{$type}{$sub};
	}

	$return =~ s/\n/__NL__/g;
	$return =~ s/\"/__DQ__/g;

	return $return;
}

if ( $List_Only || $Dump_Addresses ) {
	if ( $Mime ) {
		chop($mime_tag = time . `hostname`);
		$mime_tag = '--' . $mime_tag . '--';
		print "<HEAD><META HTTP-EQUIV=\"Content-type\" CONTENT=\"multipart/x-mixed-replace;boundary=$mime_tag\"></HEAD>\n\n";
	}
	my ($pob, $ext, $street, $locality, $region, $postalcode, $country);

	foreach $last_name (sort keys %Sort) {
	   foreach $id (split(/;;/, $Sort{$last_name})) {
		$name = $Item{$id}{'__NAME__'};
		$name =~ s/\\//g;
		if ( $ARGV[0] ne '' ) {
			next unless $name =~ /$ARGV[0]/io;
		}

		$address = '';
		$street = '';
		$citystatezip = '';

		$address = &First_Item($id, 'ADR');

		if ( $address ne '' ) {
			($pob, $ext, $street, $locality, $region, $postalcode, $country)
				= &address_split($address);
			$citystatezip = "$locality, $region, $postalcode";
			$citystatezip =~ s/,\s*,/,/g;
			$citystatezip =~ s/^\s*,+//;
			$citystatezip =~ s/,+\s*$//;
		}

		$number = &First_Item($id, 'TEL');
		$fax    = &First_Item($id, 'FAX');

		if ( $Fax_Only ) {
			next if $fax eq '';
			$number = "$fax (FAX)";
		}
		if ( $Mime ) {
			print "$mime_tag\n";
		}
		if ( $Vcard ) {
			#### VCARD ####
			if ( $Mime ) {
				print "Content-type: text/x-vcard\n\n";
			}
			$vcard  = "BEGIN:VCARD\n";
			$vcard .= "VERSION:2.1\n";

			$name = &trim($name);
			$name =~ s/\s+and\s+/&/g;

			($n1, $n2, $n3) = split(/\s+/, $name, 3);
			$service = 0;
			if ( $n1 =~ /^${Serv_Lmatch}$/o ) {
				$service = 1;
				$name = "$n2 $n3";
				$fn = "$n2 $n3";
			} else {
				$fn = $name;
				if ( $n3 eq '' ) {
					$n3 = $n2;
					$n2 = '';
				}
				if ( $n3 ne '' ) {
					$vcard .= "N:$n3;";
					$vcard .= "$n1;" if $n1 ne '';
					$vcard .= "$n2;" if $n2 ne '';
					$vcard =~ s/;$//;
					$vcard .= "\n";
				}
			}
			$fn =~ s/\s+/ /g;
			$vcard .= "FN:$fn\n";

			if ( defined($Item{$id}{'TEL'}) ) {
				$number = $Item{$id}{'TEL'}{'PRIMARY'};
				if ( $number ne '' ) {
					if ( $service ) {
						$vcard .= "TEL;WORK:" . &plus($number) . "\n";
					} else {
						$vcard .= "TEL;HOME:" . &plus($number) . "\n";
					}
				}
				foreach $tel (@{$Item{$id}{'TEL'}{'__LIST__'}}) {
					next if $tel eq 'PRIMARY';
					$number = $Item{$id}{'TEL'}{$tel};
					$tel = "a-$tel" if $tel !~ /^[a-z]/i;
					$vcard .= "TEL;$tel:" . &plus($number) . "\n";
				}
			}
			if ( defined($Item{$id}{'FAX'}) ) {
				$number = $Item{$id}{'FAX'}{'PRIMARY'};
				if ( $number ne '' ) {
					if ( $service ) {
						$vcard .= "TEL;FAX;WORK:" . &plus($number) . "\n";
					} else {
						$vcard .= "TEL;FAX;HOME:" . &plus($number) . "\n";
					}
				}
				foreach $tel (@{$Item{$id}{'FAX'}{'__LIST__'}}) {
					next if $tel eq 'PRIMARY';
					$number = $Item{$id}{'FAX'}{$tel};
					$vcard .= "TEL;FAX;$tel:" . &plus($number) . "\n";
				}
			}
			foreach $type (sort keys %{$Item{$id}}) {
				next if $type =~ /^__.*__$/;
				next if $type =~ /^(TEL|FAX|URL)$/;

				foreach $sub (@{$Item{$id}{$type}{'__LIST__'}}) {
					$val = $Item{$id}{$type}{$sub};
					$val =~ s/\n/\n   /g;
					$val = &trim($val);
					if ( $type eq 'BDAY' ) {
						($year, $mon, $day) = split(/\//, $val);
						if ( $mon =~ /^\d$/ ) {
							$mon = "0$mon";
						}
						if ( $day =~ /^\d$/ ) {
							$day = "0$day";
						}
						$val = "$year-$mon-$day";
					} elsif ( $type eq 'EMAIL' ) {
						if ( $sub eq 'PRIMARY' ) {
							$sub = "INTERNET";
						} else {
							$sub = "INTERNET;$sub";
						}
					} elsif ( $type eq 'ADR' ) {
						$val =~ s/\n/ /g;
						$val =~ s/\\,/__COMMA__/g;
						$val =~ s/,/;/g;
						$val =~ s/\s*;\s*/;/g;
						$val =~ s/__COMMA__/,/g;
					}
					if ( $sub eq 'PRIMARY' ) {
						$val = "$type:$val\n";
					} else {
						$val = "$type;$sub:$val\n";
					}
					$vcard .= $val;
				}
			}
			# put after NOTE for gnomecard. hmmmm...
			if ( defined($Item{$id}{'URL'}) ) {
				$type = 'URL';
				foreach $sub (@{$Item{$id}{'URL'}{'__LIST__'}}) {
					$val = $Item{$id}{'URL'}{$sub};
					$val =~ s/\n/\n   /g;
					$val = &trim($val);
					if ( $sub eq 'PRIMARY' ) {
						$val = "$type:$val\n";
					} else {
						$val = "$type;$sub:$val\n";
					}
					$vcard .= $val;
				}
			}
			$vcard .= "END:VCARD\n";
			print STDOUT $vcard, "\n";
		} elsif ( $Palm_CSV ) {
			#### Palm CSV ####
			# Lastname,Firstname,Title,Company,Work#,Home#,Fax#,Cell#,Email,Address,City,State,Zip,???,Pager#,HomeURL,WorkURL,???,Note,???
			$palm_card = '"%%Lastname","%%Firstname","%%Title","%%Company","%%Work#","%%Home#","%%Fax#","%%Cell#","%%Email","%%Address","%%City","%%State","%%Zip","%%Country","%%Pager#","%%HomeURL","%%WorkURL","%%???","%%Note","%%???"';
			$palm_card =~ s/,/___COMMA___/g;
			$palm_card =~ s/"/___QUOTE___/g;

			$name =~ s/\s+and\s+/&/g;

			($n1, $n2, $n3) = split(/\s+/, $name, 3);
			$service = 0;
			if ( $n1 =~ /^${Serv_Lmatch}$/o ) {
				$service = 1;
				$palm_card =~ s/%%Lastname/$n2-$n3/;
			} else {
				if ( $n3 eq '' ) {
					$n3 = $n2;
					$n2 = '';
				}
				if ( $n3 ne '' ) {
					$palm_card =~ s/%%Lastname/$n3/;
					$palm_card =~ s/%%Firstname/$n1/;
				}
			}

			if ( defined($Item{$id}{'TEL'}) ) {
				$number = $Item{$id}{'TEL'}{'PRIMARY'};
				if ( $number ne '' ) {
					if ( $service ) {
						$palm_card =~ s/%%Work#/$number/;
					} else {
						$palm_card =~ s/%%Home#/$number/;
					}
				}
				foreach $tel (@{$Item{$id}{'TEL'}{'__LIST__'}}) {
					next if $tel eq 'PRIMARY';
					$number = $Item{$id}{'TEL'}{$tel};
					if ( $tel =~ /^work$/i ) {
						$palm_card =~ s/%%Work#/$number/;
					} elsif ( $tel =~ /^home$/i ) {
						$palm_card =~ s/%%Home#/$number/;
					} elsif ( $tel =~ /^cell$/i ) {
						$palm_card =~ s/%%Cell#/$number/;
					} elsif ( $tel =~ /^pager$/i ) {
						$palm_card =~ s/%%Pager#/$number/;
					}
				}
			}
			if ( defined($Item{$id}{'FAX'}) ) {
				$number = $Item{$id}{'FAX'}{'PRIMARY'};
				if ( $number ne '' ) {
					$palm_card =~ s/%%Fax#/$number/;
				}
				foreach $tel (@{$Item{$id}{'FAX'}{'__LIST__'}}) {
					next if $tel eq 'PRIMARY';
					$number = $Item{$id}{'FAX'}{$tel};
					$palm_card =~ s/%%Fax#/$number/;
				}
			}
			foreach $type (sort keys %{$Item{$id}}) {
			    next if $type =~ /^__.*__$/;
			    next if $type =~ /^(TEL|FAX)$/;

			    foreach $sub (@{$Item{$id}{$type}{'__LIST__'}}) {
				$val = $Item{$id}{$type}{$sub};
				$val =~ s/\n/\n   /g;
				$val = &trim($val);
				if ( $type eq 'BDAY' ) {
					;
				} elsif ( $type eq 'EMAIL' ) {
					if ( $sub eq 'PRIMARY' ) {
						$palm_card =~ s/%%Email/$val/;
					}
				} elsif ( $type eq 'ADR' ) {
					$val =~ s/\n/ /g;
					$val =~ s/\\,/__COMMA__/g;
					$val =~ s/,/;/g;
					$val =~ s/\s*;\s*/;/g;
					$val =~ s/__COMMA__/,/g;
					($j1, $j2, $ad, $ci, $st, $zi, $cn) = split(/;/, $val);
					if ( $sub eq 'PRIMARY' ) {
						$palm_card =~ s/%%Address/$ad/;
						$palm_card =~ s/%%City/$ci/;
						$palm_card =~ s/%%State/$st/;
						$palm_card =~ s/%%Zip/$zi/;
						$palm_card =~ s/%%Country/$cn/;
					}
				} elsif ( $type eq 'URL' ) {
					if ( $sub eq 'PRIMARY' ) {
						$palm_card =~ s/%%HomeURL/$val/;
					} elsif ( $sub =~ /WORK/i ) {
						$palm_card =~ s/%%WorkURL/$val/;
					}
				} elsif ( $type eq 'NOTE' ) {
					if ( $sub eq 'PRIMARY' ) {
						$val = substr($val, 0, 500);
						$palm_card =~ s/%%Note/$val/;
					}
				}
			    }
			}
			$palm_card =~ s/,/;/g;
			$palm_card =~ s/"/''/g;
			#$palm_card =~ s/([",])/\\$1/g;
			$palm_card =~ s/___COMMA___/,/g;
			$palm_card =~ s/___QUOTE___/"/g;
			$palm_card =~ s/\%\%[^"]*//g;
			$palm_card .= "\n";
			$palm_card =~ s/\r//g;
			$palm_card =~ s/\n/\r\n/g;
			print STDOUT $palm_card;


		} elsif ( $List_Only ) {
			#### LIST ONLY ####
			if ( $List_Only == 3 ) {
				$number .= "\t$street\t$citystatezip";
			} elsif ( $List_Only == 2 ) {
				print STDOUT '-' x 40, "\n";
				print STDOUT &Add($id). "\n";
				next;
			}
			print STDOUT "$name\t$number\n";

		} elsif ( $Dump_Addresses ) {
			#### DUMP ADDRESSES ####
			$name =~ s/${Serv_Lmatch}\s*//o;
			$citystatezip =~ s/,\s+([\d-]+)$/  $1/;
			if ( $Dump_Addresses == 1 ) {
				$name =~ s/:/-/g;
				$street =~ s/:/-/g;
				$citystatezip =~ s/:/-/g;
				print STDOUT "$name:$street:$citystatezip\n";
			} elsif ( $Dump_Addresses == 2 ) {
				my($out, $item, @items, $cnt, $n);
				$out = '';
				foreach $item ($name, $street, $citystatezip) {
					if ( length($item) > 30 ) {
						$item =~ s/,/\n/g;
					}
					push(@items, (split(/\n+/, $item)));
				}
				$cnt = 0;
				foreach $item (@items) {
					next if $item =~ /^\s*$/;
					$item = &trim($item);
					$out .= $item . "\n";
					if ( ++$cnt > $Stanza_Height ) {
						die "MAX HEIGHT EXCEEDED: $name:$street:$citystatezip\n"; 
					}
				}
				$n = $Stanza_Height - scalar(@items);
				$out .= "\n" x $n;
				print STDOUT "$Stanza_Sep$Item{$id}{__ATTRIB__},$Item{$id}{__CLASS__}\n", $out;
			}
		}
	    }
	}
	if ( $Mime ) {
		print "$mime_tag" . "--\n";
	}
	exit 0;	# EXIT
}

#############################################################################
if ( $Do_alpha ) {
	&launch_alpha();
	exit 0;	# EXIT
}

#############################################################################
$Code = '';

$Code .= &TopCode();


#############################################################################
if ( ! $Do_alpha && ! $Match && ! $Fax_Only && ! $To_Stdout ) {
	
$Code .= <<"END";

frame .topf -bd 0;

button .topf.balpha -pady 1 -text "A-Z"		-relief groove \\
	-command "set env(PEOPLE_GEOMETRY) {}; exec $0 -A &; after 200; exec true"
button .topf.ball  -pady 1 -text "All"	-relief groove \\
	-command "catch {unset Posted}; set env(PEOPLE_GEOMETRY) {}; exec $0 -v &; after 200; exec true"
button .topf.bmodem -pady 1 -text "Modem & etc..."	-relief groove 
bind .topf.bmodem <B1-ButtonRelease> ".modem_list post %X %Y; focus .modem_list"
bind .topf.bmodem <B2-ButtonRelease> ".modem_list post %X %Y; focus .modem_list"
bind .topf.bmodem <B3-ButtonRelease> ".modem_list post %X %Y; focus .modem_list"

if [info exists env(PEOPLE_VERBOSE)] {
	if { "\$env(PEOPLE_VERBOSE)" != "" } {
		.topf.ball configure -state disabled	
	}
}
pack .topf.balpha .topf.ball .topf.bmodem -side left 

pack .topf -side top -fill x
END

}

#############################################################################
if ( ! $Do_alpha && (! $Match || $Items > 12) ) {
	
$Code .= <<"END";

frame .cf -bd 0;
scrollbar .cf.sy -orient v -command ".cf.c yview"
canvas .cf.c -yscrollcommand ".cf.sy set"
frame .cf.c.holder -bd 0;

pack .cf.c.holder -fill both -expand 1 -side top
pack .cf.sy -fill y -side right
pack .cf.c -fill both -expand 1 -side left
pack .cf -fill both -expand 1 -side top

bind . <Down>	".cf.c yview scroll  1 units"
bind . <Up>	".cf.c yview scroll -1 units"
bind . <Next>	".cf.c yview scroll  1 pages"
bind . <Prior>	".cf.c yview scroll -1 pages"

END

	$Canvas = ".cf.c.holder";

} else {
	$Canvas = "";
}

$Code .= <<"END";

global canvas 
set canvas "$Canvas"

END

foreach $last_name (sort keys %Sort) {
	foreach $person (split(/;;/, $Sort{$last_name})) {
		&Add($person);
	}
}

$Code .= &BotCode();

if ( $Canvas && $N) {

	my($n) = $N + 1;
	$Code .= <<"END";

.cf.c create window 0 0 -window .cf.c.holder -anchor nw
set fud1 .cf.c.holder.f1.b1
set fud2 .cf.c.holder.f1.b2
set rw1 [winfo reqwidth  \$fud1]
set rw2 [winfo reqwidth  \$fud2]
set rw [expr \$rw1 + \$rw2]
set rh [winfo reqheight \$fud1]
set rh [expr $n * \$rh]
set rw [expr \$rw + 2]
set rh [expr \$rh + 2]
set rhmax 500

if {\$rh < \$rhmax} {
	set rhmax \$rh
}

##puts "rw \$rw"
##puts "rh \$rh"

.cf.c config -scrollregion "0 0 \$rw \$rh" -width \$rw -height \$rhmax
	
END
}

#############################################################################
if ( $Debug) {
	open(CODE, ">/tmp/wishcode") || die "$!";
	print CODE $Code;
	close(CODE);
}

if ( $geometry =~ /-geometry / ) {
	$geom_tmp = $';
} else {
	$geom_tmp = "+0+0";
	$geometry = "-geometry $geom_tmp";
}

$Outcode  = "#!/bin/sh\n";
$Outcode .= "# the next line restarts using wish \\\n";
$Outcode .= "PEOPLE_GEOMETRY=\"$geom_tmp\" ";
foreach $e (keys(%ENV)) {
	if ( $e eq 'PEOPLE_COMMAND' ) {
		$ENV{$e} =~ s/-wish \S+//;
		$ENV{$e} = &trim($ENV{$e});
	}
	if ( $e =~ /PEOPLE/ ) {
		$Outcode .= "$e=\"$ENV{$e}\" ";
	}
}
$Outcode .= "exec wish $geometry < " . '"$0"' . "\n\n";
$Outcode .= $Code;

if ( $Dump_Wish_Code ) {
	open(CODE, ">$Dump_Wish_Code") || die "$!";
	print CODE $Outcode;
	close(CODE);
	system("ls -l '$Dump_Wish_Code'");
	exit 0;
}

#############################################################################
if ( $To_Stdout ) {
	;
} else {
	if (fork) {
		wait;
		exit 0
	} else {
		unless(fork) {
			setpgrp(0,0);
		} else {
			exit 0;
		}
	}
}

if ( $Save_It && open(COMPILED, ">$0.$Save_It") ) {
	print COMPILED $Outcode;
	close COMPILED;
	chmod 0755, "$0.$Save_It";
}

open(WISH, "|wish $geometry") || die "$!";

select(WISH); $| = 1;

print WISH $Code, "\n"; 
close(WISH);
exit 0;	# EXIT
#############################################################################
########################### END MAIN ########################################
#############################################################################

#############################################################################
sub Add {
	my($id) = @_;
	my($name, $number, $tel, $addr, $email, $hostname, $url, $fax);
	my($note, $x, $x2, $y, $text, $text0);
	my($val, $sub);
	$name  = $Item{$id}{'__NAME__'};
	# ADR BDAY EMAIL FAX NOTE SSN HOSTNAME TEL URL
	#     ^^^^           ^^^^ ^^^ ^^^^^^^^
	$addr  = &All_Item($id, 'ADR');
	$email = &All_Item($id, 'EMAIL');
	$fax   = &All_Item($id, 'FAX');
	$tel   = &All_Item($id, 'TEL');
	$url   = &All_Item($id, 'URL');
	$hostname   = &All_Item($id, 'HOSTNAME');

	foreach $x (qw(NOTE BDAY SSN))  {
		$x2 = $x;
		$x2 =~ y/A-Z/a-z/;
		foreach $y ( split(/^/, &All_Item($id, $x)) ) {
			if ( $y =~ /^[^=]+=/ ) {
				$y2 = $';
				$note .= "$x2: " . $y2 . "\n" unless $y2 =~ /^\s*$/;
			}
		}
	}
	$note =~ s/\n/__NL__/g;
	$note =~ s/\"/__DQ__/g;

	$text = $name . "\n\n";

	foreach $sub (@{ $Item{$id}{'ADR'}{'__LIST__'} }) {
		$val = $Item{$id}{'ADR'}{$sub};
		if ( $sub ne 'PRIMARY' ) {
			$text .= "($sub)\n";
		}
		$text .= &Pretty_Address($val) . "\n";
	}

	$x = 0;
	foreach $y ('TEL', 'FAX') {
		foreach $sub (@{ $Item{$id}{$y}{'__LIST__'} }) {
			$val = $Item{$id}{$y}{$sub};
			if ( $y eq 'FAX' ) {
				if ( $sub eq 'PRIMARY' ) {
					$sub = "FAX"
				} else {
					$sub = "FAX:$sub"
				}
			}
			if ( $sub eq 'PRIMARY' ) {
				$text .= $val . "\n";
			} else {
				$text .= $val . "\t($sub)\n";
			}
			$x++;
		}
	}
	$text .=  "\n" if $x;
	
	foreach $y (qw(EMAIL URL HOSTNAME)) {
		$x = 0;
		foreach $sub (@{ $Item{$id}{$y}{'__LIST__'} }) {
			$val = $Item{$id}{$y}{$sub};
			$text .= "mailto:" if $y eq 'EMAIL';
			$text .= "url:" if $y eq 'URL';
			$text .= "hostname:" if $y eq 'HOSTNAME';
			if ( $sub eq 'PRIMARY' ) {
				$text .= $val . "\n";
			} else {
				$text .= $val . "\t($sub)\n";
			}
			$x++;
		}
		$text .=  "\n" if $x;
	}

	$x = $note;
	$x =~ s/__NL__/\n\t/g;
	$x =~ s/__DQ__/"/g;
	if ( $x ne '' && $x !~ /^note:/ ) {
		$x = "note: $x";
	}
	$x =~ s/note: /note:\t/;
	$text .= $x if $x ne '';

	$text =~ s/\s*$//;
	$text .= "\n";

	$text0 = $text;	# this will be return value.
	$text0 =~ s/\\\[/[/g;
	$text0 =~ s/\\\]/]/g;

	$text =~ s/\n/__NL__/g;
	$text =~ s/\"/__DQ__/g;

	$name	=~ s/\$/\\\$/g;
	$addr	=~ s/\$/\\\$/g;
	$email	=~ s/\$/\\\$/g;
	$fax	=~ s/\$/\\\$/g;
	$tel	=~ s/\$/\\\$/g;
	$url	=~ s/\$/\\\$/g;
	$note	=~ s/\$/\\\$/g;
	$text	=~ s/\$/\\\$/g;

	if ( $Fax_Only ) {
		return if $fax eq '';
	}

	$N++;
	$Code .= "\naddbutton $N \"$name\" \"$addr\" \"$email\" \"$hostname\" \"$fax\" \"$tel\" \"$url\" \"$note\" \"$text\";\n";

	return $text0;
}

sub Pretty_Address {
	my ($adr) = @_;
	my $str;
	
	$adr =~ s/\n//g;
	my ($pob, $ext, $street, $city, $state, $zip, $country)
		= split(/\s*,\s*/, $adr);
	
	$pob	=~ s/__COMMA__/,/g;
	$ext	=~ s/__COMMA__/,/g;
	$street	=~ s/__COMMA__/,/g;
	$city	=~ s/__COMMA__/,/g;
	$state	=~ s/__COMMA__/,/g;
	$zip	=~ s/__COMMA__/,/g;
	$country=~ s/__COMMA__/,/g;

	$str .= "$pob" . "\n"		if $pob ne '';
	$str .= "$ext" . "\n"		if $ext ne '';
	$str .= "$street" . "\n"	if $street ne '';
	$str .= "$city" . ", "		if $city ne '';
	$str .= "$state" . "  "		if $state ne '';
	$str .= "$zip" . "  "		if $zip ne '';
	$str .= "$country"		if $country ne '';
	$str .= "\n"			if "$city$state$zip$country" ne '';

	return $str;
}

 
#############################################################################
sub trim {
	my($x) = @_;
	$x =~ s/^\s*//;
	$x =~ s/\s*$//;
	return $x;
}

sub plus_number {
	my($x) = @_;
	$x =~ s/\D//g;
	if ( length($x) == 10 ) {
		$x = "1" . $x;
	}
	$x = "+" . $x;
	return $x;
}

sub plus {
	my($x) = @_;
	if ($x eq '' ) {
		return ''
	} elsif ($x =~ /^1\b/ ) {
		return "+" . $x;
	} elsif ($x !~ /\+/ ) {
		return "+1-" . $x;
	} else {
		return $x;
	}
}
###### HACK FOR A-Z ########
sub launch_alpha {

	my($code);

	$code = &TopCode();

	$code .= <<'END';
if [info exists env(PEOPLE_FAX_ONLY)] {
	wm title . "FAX numbers \[A-Z]";	# ever hit?
} else {
	wm title . "People \[A-Z]"
}
set env(PEOPLE_GEOMETRY) ""
END

	my($letter, $letters, $count, $rows, $frame, $framecnt) ;

	$letters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ#";

	$framecnt = 0;
	$count = 0;
	$rows  = 0;

	my $pady = 4;
	my $padx = 8;	# added for dpi 100 font issue


	foreach $letter (split(//, $letters)) {
		next if $letter eq '';

		if ( $count % 6 == 0 ) {
			$frame = ".frame$framecnt";
			$code .= "frame $frame -bd 1; pack $frame -side top -fill x;\n";
			$framecnt++;
		}
		$count++;

		$b = "$frame.b$count";
		$code .= "button $b -text $letter -padx $padx -pady $pady -width 1 -command {exec $0 -geometry +400+400 $letter &; after 200; exec true}; pack $b -side left\n";

		if ( ! $Lasts{$letter} ) {
			$code .= "$b configure -foreground white;\n";
		}
	}

	$code .= &BotCode();

	if ( ! $To_Stdout ) {
		if (fork) {
			wait;
			exit 0
		} else {
			unless(fork) {
				setpgrp(0,0);
			} else {
				exit 0;
			}
		}
	}

	$pid = open(WISH, "|wish $geometry") || die "$!";
	print STDERR "wish pid: $pid\n" if $Debug;

	select(WISH); $| = 1;

	print WISH $code, "\n"; 
	close(WISH);
	exit 0;
}

#############################################################################
sub help {
        if ( $ENV{'PAGER'} ne '' && open(PAGER, "|$ENV{'PAGER'}") ) {
                print PAGER "$Usage";
                close(PAGER);
        } elsif ( open(LESS, "|less") ) {
                print LESS "$Usage";
                close(LESS);
        } elsif ( open(MORE, "|more") ) {    # open pipeline to "more"
                print MORE "$Usage";
                close(MORE);
        } else {
                print STDOUT "$Usage";
        }
}
#############################################################################
sub BotCode {

	my($bot_code);
	$bot_code = <<'END';

global entryVar Xmode Map2mode
if [info exists env(PEOPLE_XMODE)] {
	set Xmode $env(PEOPLE_XMODE);
} else {
	set Xmode xterm
}

set Map2mode 0

bind Entry <Control-u> {%W delete 0 end};
bind Entry <B3-Motion> {%W scan dragto %x};
bind Entry <B2-Motion> {};
bind Entry <Right> { %W icursor [expr "[%W index insert] + 1"]};
bind Entry <Left>  { %W icursor [expr "[%W index insert] - 1"]};
frame .entry -bd 1;
global Entrybox
set Entrybox ".entry.e"; #"
entry $Entrybox -relief sunken -textvariable entryVar -font $font -width 12;
button .entry.l -text "Dial/Find:" -font $font -pady 1 \
		-command "dial \[.entry.e get\]" -relief groove

if [info exists env(PEOPLE_MODEM_LIST)] {
	set m .modem_list
	menu $m -takefocus 1 -tearoff 0 -font $font
	set idx0 0
	$m add command -label "Set modem and etc:" -command ""
	incr idx0
	$m add sep
	incr idx0

	bind .entry.l <B3-ButtonRelease> "$m post %X %Y; focus $m"

	set idx $idx0
	set gotit ""
	foreach line [split $env(PEOPLE_MODEM_LIST) ","] {
		if {$line == ""} {
			continue
		}
		set m_line [lindex [split $line] 0]
		set m_host [lindex [split $line] 1]
		set lab $line
		if [regexp {:} $m_line] {
			set h1 [lindex [split $m_line ":"] 0]
			set l1 [lindex [split $m_line ":"] 1]
			regsub {^[^ ]+ } $lab {} lab;
			regsub {^[^ ]+ } $lab {} lab;
			set lab "$l1 $h1 $lab"
			set m_host $h1
		}
		$m add radio -variable Modem -label $lab \
			-command "set env(AUTODIAL_MODEM) $m_line; set env(MODEM_HOST) $m_host"
		if {[info exists env(AUTODIAL_MODEM)] && \
					$m_line == $env(AUTODIAL_MODEM)} {
			set Modem $env(AUTODIAL_MODEM);
			set gotit $idx
		}
		incr idx
	}
	if {$gotit == ""} {
		eval $m invoke $idx0
	} else {
		eval $m invoke $gotit
	}
	$m add sep
	$m add radio -label tktty -variable Xmode \
			-value "tktty" -command "set env(PEOPLE_XMODE) tktty"
	$m add radio -label xterm -variable Xmode \
			-value "xterm" -command "set env(PEOPLE_XMODE) xterm"
	$m add sep

	$m add check -label map2 -variable Map2mode

	$m add sep
	$m add command -label "Find (use Dial/Find: /pattern/)" -underline 0 \
		-command "$Entrybox delete 0 end; $Entrybox insert 0 //; $Entrybox icursor 1; focus $Entrybox"
	$m add command -label "Add"  -underline 0 \
		-command "exec xterm -geometry +350+350 -e people -add 1; restart"
	$m add command -label "Edit" -underline 0 \
		-command "exec xterm -geometry +200+200 -T Edit -e people -e; restart"
	if [info exists env(PEOPLE_COMMAND)] {
		$m add command -label Restart -underline 0 -command "restart"
	}
	$m add sep
	$m add command -label "Dismiss" -command ""
}  

proc restart {} {
	global env Posted

	if ![info exists env(PEOPLE_COMMAND)] {
		bell
		return
	}

	set str ""
	if ![array exists Posted] {
		set Posted(NONE) 0
	}
	foreach n [array names Posted] {
		if {$n != "NONE"} {
			if {$Posted($n)} {
				if {$str == ""} {
					set str "$n"
				} else {
					set str "$str $n"
				}
			}
		}
	}
	# forget it...
	# set env(PEOPLE_POSTED) $str

	set g [wm geometry .]
	regsub {[0-9]+x[0-9]+} $g "" g
	if {$g != ""} {
		set env(PEOPLE_GEOMETRY) $g
	}
	wm title . "Restarting..."
	update
	eval exec $env(PEOPLE_COMMAND) &
	after 200
	exec true
	after 1300
	destroy .
}

global Posted
set Posted(NONE) 0

pack .entry.l -side left;
pack .entry.e -side left -expand 1 -fill x;
bind .entry.e <Return> "dial \[.entry.e get\]";
bind .entry.e <Enter> "focus .entry.e";
focus .entry.e;

button .bok -pady 1 -font $font -text Dismiss \
		-command "destroy ." -relief groove
pack .bok -side bottom -fill x
pack .entry -side bottom -fill x

global UpdateIt
set UpdateIt 1
if [info exists env(PEOPLE_POSTED)] {
	set UpdateIt 0
	foreach n [split $env(PEOPLE_POSTED)] {
		popup $n
		after 100
	}
	set UpdateIt 1
}
END

	return $bot_code;
}

#############################################################################
sub tty_pipe_Code {
	my($tktty_code);
	$tktty_code = `tktty --s`;
	return $tktty_code;
}

#############################################################################
sub DialCode {

my($dial_code);

$dial_code = <<'END';

proc dial {n} {
	global Name Address Email Hostname Fax Tel Url Note Text
	global Tel2Name Tel2Phone
	global Local_Areacode env
	global Xmode

##puts stdout "dial: n=\"$n\""

	set n [string trim $n]

	if [regexp {^[ 	]*$} $n] {
		bell
		return
	}

	if {[regexp {^/} $n] || [regexp {^[A-z ]*$} $n]} {
		stop_watch "on"
		regsub -all {[][$!&*();`?]} $n "" n; #`
		exec people "$n" &
		after 750
		stop_watch "off"
		return
	}

	if [info exists Name($n)] {
		set name $Name($n);
	} elseif [info exists Tel2Name($n)] {
		set name $Tel2Name($n);
	} else {
		set name "unknown"; 
	}

	if [info exists env(PEOPLE_FAX_ONLY)] {
		if [info exists Fax($n)] {
			set first [first_item $Fax($n)]
			if { $first != "" } {
				set phone $first
			} else {
				set phone $n;
			}
		} else {
			set phone $n;
		}
	} else {
		if [info exists Tel($n)] {
			set first [first_item $Tel($n)]
			if { $first != "" } {
				set phone $first
			} else {
				set phone $n;
			}
		} else {
			set phone $n;
		}
	}

	set phone [lindex [number_diddle $phone] 0]

	if [info exists env(PEOPLE_TO_STDOUT)] {
		puts stdout $phone
		if [info exists env(PEOPLE_NAME_TO_STDOUT)] {
			puts stdout "NAME:$name"
			if [info exists Tel($n)] {
				set first [first_item $Tel($n)]
				if { $first != "" } {
					set phone $first
				} else {
					set phone $n;
				}
				puts stdout "PHONE:$first"; #"
			} elseif [info exists Tel2Phone($n)] {
				puts stdout "PHONE:$Tel2Phone($n)"; #"
			} else {
				puts stdout "PHONE:unknown"
			}
		}
		if [info exists env(PEOPLE_ALPHA_PID)] {
			after 200
			exec kill $env(PEOPLE_ALPHA_PID);
		}
		after 200
		exit 0
	} else {
		if {$Xmode == "xterm"} {
			set cmd "autodial -X -n $phone"
		} elseif {$Xmode == "tktty"} {
			set handle [tty_pipe "autodial" "autodial -n $phone" "mywatcher"]

			set tty		[tty_handle "tty" $handle]
			util_center_window $tty 1
			update
			
			return
		} else {
			puts stderr "unknown Xmode: $Xmode"
			bell
			return
		}
	}
	eval exec $cmd &
	after 200; exec true
}

proc first_item {str} {
	set ret ""
	foreach item [split_sep $str] {
		if [regexp {^[ 	]*$} $item] {
			continue
		}
		set ret $item
		break
	}
	regsub {^[^=]*=} $ret {} ret
	return $ret
}

proc mywatcher {handle line} {

	if [regexp -nocase {pick up the phone} $line] {
		set b [tty_handle "quit_button" $handle]
		# puts stderr "b: $b"
		set tty	[tty_handle "tty" $handle]
		wm deiconify $tty
		update
		if [winfo exists $b] {
			# puts stderr {trying: exec xwit -root -warp [expr [winfo rootx $b]+30] [expr [winfo rooty $b]+12]}
			catch {exec xwit -root -warp [expr [winfo rootx $b]+30] [expr [winfo rooty $b]+12] &}
		} else {
			# puts stderr {skipping: exec xwit -root -warp [expr [winfo rootx $b]+30] [expr [winfo rooty $b]+12]}
		}
	}
}

proc do_map {addr} {
	global Map2mode map2_cmd map_cmd
	# puts stdout "addr: $addr"
	if {$Map2mode} {
		regsub {[ 	]*[0-9\-]*$} $addr {} addr
		exec $map2_cmd "$addr" &
		#"
	} else {
		exec $map_cmd "$addr" &
		#"
	}
}

proc do_ypsearch {person} {
	global yp_cmd
	eval exec $yp_cmd "$person" &
}

END

	return $dial_code;
}

#############################################################################
sub TopCode {

my($w1) = $Width{name}   + 1;
my($w2) = $Width{number} + 1;

if ( $Fax_Only )  {
	$w2 += 5;
}

	my($top_code) = '';

$top_code = <<"END";
global font env anchor width1 width2 tcount Local_Areacode 
global mailto_cmd host_cmd envelope_cmd url_cmd map_cmd yp_cmd
set font "fixed";
set tinyfont "5x7";
set anchor "w"
set width1 $w1
set width2 $w2
set mailto_cmd "$Mailto_Cmd"; #"
set host_cmd {$Host_Cmd};
set envelope_cmd {$Envelope_Cmd}
set url_cmd "$Url_Cmd"
set map_cmd "$Map_Cmd"; #"
set yp_cmd "$YP_Cmd";
set map2_cmd "$Map2_Cmd"; #"
set tcount 0
set Local_Areacode $Area_Code

option add      *Button*padY 1
option add      *Button*padX 1m
option add      *Button*highlightThickness 0


bind . <Control-e> {exec xvi -geometry 100x35+300+300 \$env(PEOPLE_DB) &; after 200; exec true}
bind . <Escape> "destroy ."


if [info exists env(PEOPLE_FAX_ONLY)] {
	set title "FAX numbers $Match0"; #"
} else {
	set title "People $Match0"; #"
}
regsub {[ 	]*\$} \$title {} title
wm title . \$title
#wm resizable . 0 1 
wm resizable . 0 0 


END


$top_code .= &DialCode();

$top_code .= &tty_pipe_Code();

$top_code .= <<'END';

proc stop_watch {x} {

	global Entrybox;
	if { $x == "on" } {
		. config -cursor {watch}
		$Entrybox config -cursor {watch}
		update
	} else {
		. config -cursor {}
		$Entrybox config -cursor {}
		update
	}
}


proc popup {n} {
	global tcount font mailto_cmd host_cmd envelope_cmd url_cmd
	global Name Address Email Hostname Fax Tel Url Note Text
	global Tel2Name Tel2Phone
	global Posted
	global env

	set top ".top$n"

	catch {destroy $top}

	toplevel $top

	set Posted($n) 1

	bind $top <Escape> "destroy $top"
	bind $top <Button-3> "destroy $top"

	set packlist ""

	set scrollit 0

	if {!$scrollit} {
		set butts "$top"
	} else {
		set contain "$top.contain"

		frame $contain -bd 0;
		scrollbar $contain.sy -orient v -command "$contain.c yview"
		canvas $contain.c -yscrollcommand "$contain.sy set"

		frame $contain.c.holder -bd 0;
		set butts $contain.c.holder

		bind $top <Down>	"$contain.c yview scroll  1 units"
		bind $top <Up>		"$contain.c yview scroll -1 units"
		bind $top <Next>	"$contain.c yview scroll  1 pages"
		bind $top <Prior>	"$contain.c yview scroll -1 pages"
	}

	set bcnt 0

	if [info exists Name($n)] {
		wm title $top "Address \[$Name($n)]"
	} else {
		wm title $top "Address "
	}

	set first_tel ""
	set first_yp 1
	foreach mode {Tel Fax Email Hostname Url Map Address YP} {

	    set str ""
	    if { $mode == "Map" || $mode == "YP" } {
		catch {set str $Address($n)}
	    } else {
		eval "catch {set str \$$mode\(\$n\)}"
	    }
	    if {$str == ""} {
		continue
	    }
	    foreach item [split_sep $str] {
		if [regexp {^[ 	]*$} $item] {
			continue
		}
		if { $mode == "YP" } {
			if {$first_yp} {
				set first_yp 0
			} else {
				continue
			}
		}
		set valu $item
		set type $item
		regsub {^[^=]*=} $valu {} valu
		regsub {=.*$}    $type {} type

		if [regexp {^[ 	]*$} $valu] {
			continue
		}
		if [regexp {^[ 	,]*$} $valu] {
			# empty Address...
			continue
		}

		if {$mode == "Tel" && $first_tel == ""} {
			set first_tel $valu
		}
		if {$mode == "Tel" || $mode == "Fax"} {
			set valu1 "1-$valu"
			set Tel2Name($valu)   $Name($n)
			set Tel2Name($valu1)  $Name($n)
			set Tel2Phone($valu)  $first_tel
			set Tel2Phone($valu1) $first_tel
##puts stdout "Tel2Name   $valu -> $Name($n) "
##puts stdout "Tel2Name  1-$valu -> $Name($n) "
##puts stdout $Tel2Name($valu)
##puts stdout $Tel2Name($valu1)
##puts stdout "Tel2Phone   $valu -> $first_tel "
##puts stdout "Tel2Phone 1-$valu -> $first_tel "
##puts stdout $Tel2Phone($valu)
##puts stdout $Tel2Phone($valu1)
		}
		
		set lab ""
		if {$type != "PRIMARY"} {
			set lab "$type"
		}

		incr bcnt; set B "$butts.button$bcnt"; append packlist " $B"

		if {$mode == "Tel"} {
			button $B -pady 1 -font $font -text "Dial $lab" \
				-command "dial $valu"
		} elseif {$mode == "Fax"} {
			set fnum  [lindex [number_diddle $valu] 0]
			set fnum2 [lindex [number_diddle $valu] 1]
			set args "-fax_number \"$fnum2\""
			if {$first_tel != ""} {
				set args "$args -phone_number \"$first_tel\""
			}
			if {$Name($n) != ""} {
				set tname $Name($n)
				regsub -all {\[(S|M)\][ 	]*} $tname "" tname
				set args "$args -name \"$tname\""
			}

			# puts stdout "args: $args";
			# puts stdout "lab : $lab";
			# puts stdout "fnum2: $fnum2";
							
			if [info exists env(PEOPLE_TO_STDOUT)] {
				button $B -pady 1 -font $font -text "Send FAX $lab" \
					-command "dial $fnum2"
				set Tel2Name($fnum2)   $Name($n)
				set Tel2Phone($fnum2)  $first_tel
			} else {
				button $B -pady 1 -font $font -text "Send FAX $lab" \
					-command "exec xterm -geometry 80x40+300+150 -e faxcover -s $args &; after 200; exec true"
			}
			
		} elseif {$mode == "Url"} {
			button $B -pady 1 -font $font -text "URL $lab" \
				-command "exec $url_cmd $valu &"
		} elseif {$mode == "Email"} {
			button $B -pady 1 -font $font -text "Mailto $lab" \
				-command "exec $mailto_cmd $valu >/dev/null 2>&1 &"
		} elseif {$mode == "Hostname"} {
			set tmp $host_cmd
			regsub -all {%HOSTNAME} $tmp $valu tmp
			button $B -pady 1 -font $font -text "Ping/Video $lab" \
				-command "exec $tmp &"
		} elseif {$mode == "Address" || $mode == "Map" || $mode == "YP"} {
			regsub -all {__NL__} $valu {}  valu
			regsub -all {__DQ__} $valu {"} valu; #"
			regsub -all {__COMMA__} $valu {} valu
			set list [split $valu ","]
			set pob    [lindex $list 0]
			set ext    [lindex $list 1]
			set street [lindex $list 2]
			set city   [lindex $list 3]
			set state  [lindex $list 4]
			set zip    [lindex $list 5]
			set cntry  [lindex $list 6]
			foreach var {pob ext street city state zip cntry} {
				eval "set str \$$var" 
				set $var [string trim $str]
			}

			if {$mode == "Map"} {
				set map "$street, $city $state $zip"; #"
				regsub -all {[ 	]*$}  $map "" map
				regsub -all {^[ 	]*}  $map "" map

				button $B -pady 1 -font $font -text "Map $lab" \
					-command "do_map {$map}"

			} elseif {$mode == "YP"} {
				set to "$Name($n)"
				regsub -all {\[(S|M)\][ 	]*} $to "" to
				global env
				if [info exists env(PEOPLE_YPF)] {
					;
				} else {
					regsub {^.*[ 	]} $to {} to
				}
				set yp "$to, $city $state"; #"
				regsub -all {[ 	]*$}  $yp "" yp
				regsub -all {^[ 	]*}  $yp "" yp

				button $B -pady 1 -font $font -text "YP Search" \
					-command "do_ypsearch {$yp}"
			} else {
				set to "$Name($n)"
				regsub -all {\[(S|M)\][ 	]*} $to "" to
				if ![regexp {^[ 	]*$} $pob] {
					set to "${to}:$pob"
				}
				if ![regexp {^[ 	]*$} $ext] {
					set to "${to}:$ext"
				}
				if ![regexp {^[ 	]*$} $street] {
					set to "${to}:$street"; #"
				}
				if ![regexp {^[, 	]*$} "$city, $state $zip $cntry"] {
					set to "${to}:$city, $state   $zip $cntry"
				}
				regsub -all {["']} $to "" to; #"
			
				set tmp $envelope_cmd
				regsub {%TO} $tmp [quote_meta $to] tmp
				# regsub -all {[&]} $tmp {and} tmp
				# set tmp [quote_meta $tmp]
				button $B -pady 1 -font $font -text "Envelope $lab" -command "exec $tmp &"
			}
		}
	    }
	}
	if { $Name($n) != ""} {
		set name $Name($n)
		# SERVICE MEDICAL
		regsub -all {\[(S|M)\][ 	]*} $name "" name

		incr bcnt; set B "$butts.button$bcnt"; append packlist " $B"
		button $B -pady 1 -font $font -text "vCard" \
			-command "show_vcard \"$name\""

		incr bcnt; set B "$butts.button$bcnt"; append packlist " $B"

		button $B -pady 1 -font $font -text "Edit" \
			-command "exec xterm -geometry +200+200 -T Edit -e people -e \"$name\"; restart"
	}

	incr bcnt; set B "$butts.button$bcnt"; append packlist " $B"

	button $B -pady 1 -font $font -text "Dismiss" \
		-command "set Posted($n) 0; destroy $top"

	set text "$Text($n)"; #"
	regsub -all {__NL__} $text "\n" text
	regsub -all {__DQ__} $text "\"" text;

	set tw  $top.text
	set text2 "\n"
	set h 0
	set w 0

	foreach line [split $text "\n"] {
		incr h
		set text2 "$text2 $line \n"; #"
		if [regexp "\t" $line] {
			set n0 [tab_length $line]
		} else {
			set n0 [string length $line]
		}
		if {$n0 > $w} {
			set w $n0
		}
	}
	incr h -1;	# text ends in \n

	set text2 "$text2\n"; #"
	set w [expr "$w + 2"];
	set twidth $w

	
	set myfont $font
	if {$h > 23} {
		global tinyfont
		set myfont $tinyfont
		# 5 pt / 6 pt:
		set twidth [expr "int(0.86 * $twidth)"]
	}

	incr h 2

	text $tw -font $myfont -width $w -height $h -relief ridge -bd 4
	$tw insert 1.0 $text2
	bind $top <Control-s> "$tw tag add sel 1.0 end"

	pack $tw -side top -fill both -expand 0;	# -expand ??

	if {!$scrollit} {	# needed up here?
		if {$packlist != ""} {
			eval pack $packlist -side top -fill x
		}
	}

	set wmax 0
	foreach b [winfo children $butts] {
		if [regexp {\.text$} $b] {
			continue	
		}
		set lab [$b cget -text]
		set n [string length $lab]
		if {$n > $wmax} {
			set wmax $n
		}
	}
	set shift [expr "($twidth - $wmax)/2 - 1"]

	if {$shift > 0} {
		set spaces ""
		for {set i 0} {$i < $shift} {incr i} {
			append spaces " "
		}
		foreach b [winfo children $butts] {
			if [regexp {\.text$} $b] {
				continue	
			}
			set lab [$b cget -text]
			$b configure -anchor w
			$b configure -text "${spaces}${lab}"
		}
	}
	
	if {$scrollit} {

		pack $contain.sy -fill y -side right
		pack $contain.c -fill both -expand 1 -side left
		pack $contain -fill both -expand 1 -side top
		pack $contain.c.holder -fill both -side top

		if {$packlist != ""} {
			eval pack $packlist -side top -fill x
		}

		$contain.c create window 0 0 -window $contain.c.holder -anchor nw

		set fud1 $contain.c.holder.button1
		set rw [winfo reqwidth  $tw]
#		set rw [winfo reqwidth  $fud1]
		set rh [winfo reqheight $fud1]
#		set rh [expr $bcnt * $rh / 2]
		set rh [expr $bcnt * $rh / 2]
		set rw [expr $rw + 2]
		set rh [expr $rh + 2]
		set rhmax 500

		if {$rh < $rhmax} {
			set rhmax $rh
		}

		puts "rw $rw"
		puts "rh $rh"

		$contain.c config -scrollregion "0 0 $rw $rh" -width $rw -height $rhmax
	}

	util_center_window $top

	return;
}

proc show_vcard {name} {
	global font show_vcard_count

	if ![info exists show_vcard_count] {
		set show_vcard_count 0
	} else {
		incr show_vcard_count
	}
	set match $name
	regsub -all {[^A-z0-9_]} $match {\\&} match; #`

	# puts "exec people -vV $match"
	set text [exec people -vV $match 2>/dev/null]
	if [regexp {^[ 	\n]*$} $text] {
		return
	}

	set top ".vcard$show_vcard_count"

	catch {destroy $top}

	toplevel $top

	wm title $top "\[$name]"

	set bkill	$top.kill
	set bsel	$top.sel

	bind $top <Escape> "destroy $top"
	bind $top <Button-3> "destroy $top"

	set h 0
	set w 0

	set text2 "\n"
	foreach line [split $text "\n"] {
		incr h
		set text2 "$text2$line \n"; #"
		set n0 [string length $line]
		if {$n0 > $w} {
			set w $n0
		}
	}
	set w [expr "$w + 1"];
	set twidth $w
	incr h 1
	
	set t "$top.text"
	text $t   -font $font -width $w -height $h -relief ridge -bd 4
	$t insert 1.0 $text2
	bind $top <Control-s> "$t tag add sel 1.0 end"

	button $bsel	-pady 1 -font $font -text "Select" \
		-command "$t tag add sel 1.0 end"
	button $bkill	-pady 1 -font $font -text "Dismiss" \
		-command "destroy $top"

	pack $t $bsel $bkill -side top -fill x 

	util_center_window $top
}

proc addbutton {n name addr email hostname fax tel url note text} {
	
	# $Code .= "addbutton $N \"$name\" \"$addr\" \"$email\" \"$hostname\" \"$fax\" \"$tel\" \"$url\" \"$note\" \"$text\"";

	global env canvas font anchor width1 width2 
	global Name Address Email Hostname Fax Tel Url Note Text
	set f ${canvas}.f$n
	set b1 $f.b1
	set b2 $f.b2

	set Name($n)    $name
	set Address($n) $addr
	set Email($n)	$email
	set Hostname($n)	$hostname
	set Fax($n)	$fax
	set Tel($n)	$tel
	set Url($n)	$url
	set Note($n)    $note
	set Text($n)    $text

	if [info exists env(PEOPLE_FAX_ONLY)] {
		set phone [lindex [split_sep $fax] 0]
	} else {
		set phone [lindex [split_sep $tel] 0]
	}
	regsub {^[^=]*=} $phone {} phone
	if [regexp {^[ 	]*$} $phone] {
		set phone "N/A"
	}

	set pady 1
	set padx 4;	# added for dpi 100 font issue

	frame $f -bd 0
	button $b1 -text "$name"  -width $width1 \
		-font $font -anchor $anchor -pady $pady -padx $padx -command "popup $n"

	if [info exists env(PEOPLE_FAX_ONLY)] {
		set lab "$phone (FAX)"
	} else {
		set lab $phone
	}
	button $b2 -text "$lab" -width $width2 \
		-font $font -anchor $anchor -pady $pady -padx $padx -command "dial $n";	# was dial $phone at one point

	if [regexp -nocase {(N/A)} $lab] {
		$b2 configure -state disabled
	}

	pack $b1 $b2 -side left
	pack $f -side top -fill x
}

proc number_diddle {num} {
	
	global Local_Areacode

	set num2 $num

	# remove extension number:
	regsub -nocase {x.*$} $num {} num

	# BEGIN_DUPLICATED:
	regsub -all -- {[^0-9]} $num {} num
	if {[string length $num] == 10} {
		regsub "^$Local_Areacode" $num {} num
		regsub "^$Local_Areacode\[-\]*" $num2 {} num2
	}
	if {[string length $num] == 11} {
		regsub "^1$Local_Areacode" $num  {} num
		regsub "^1$Local_Areacode\[-\]*" $num2 {} num2
	}
	if {[string length $num] == 10} {
		set num "1$num"
		set num2 "1-$num2"
	}
	# END_DUPLICATED:

	lappend list $num
	lappend list $num2

	return $list
}

proc tab_length {str} {

	set n 0
	foreach c [split $str ""] {
		incr n
		if {$c == "\t"} {
			set nt [expr "int($n / 8)"]
			set n  [expr "($nt + 1) * 8"];
		}
	}
	return $n
}
	
proc split_sep {str} {
	set sep "__SEP__"
	return [perl_split $sep $str]
}

proc perl_split {sep str} {
	set c 0
	while {1} {
		set n [string first $sep $str]
		if {$n == -1} {
			lappend list $str
			break
		} else {
			set m [expr "$n - 1"]; 
			set match [string range $str 0 $m]
			set str [string range $str $n end]
			regsub "$sep" $str {} str
			lappend list $match
		}
		set c [expr "$c + 1"]
		if {$c > 50} {
			puts stderr "FOUL!"
			break;
		}
	}
	return $list
}

proc quote_meta {str} {
	regsub -all {[&]} $str {\\&} str
	# others?
	
	return $str
}

proc util_center_window {w {icon "0"}} {

	global UpdateIt
        wm withdraw $w

	if {$UpdateIt} {
        	update idletasks
	}
        set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 ]
        if {$w != "."} {
                set x [expr "$x - [winfo vrootx [winfo parent $w]]"]; #"
        }
        set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 ]
        if {$w != "."} {
                set y [expr "$y - [winfo vrooty [winfo parent $w]]"]; #"
        }
        wm geom $w +$x+$y
	if {$icon} {
        	wm iconify $w
	} else {
        	wm deiconify $w
	}
}

proc util_center_window_orig {w} {

	global UpdateIt

        wm withdraw $w
	if {$UpdateIt} {
        	update idletasks
	}
        set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
                - [winfo vrootx [winfo parent $w]]]
        set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
                - [winfo vrooty [winfo parent $w]]]
        wm geom $w +$x+$y
        wm deiconify $w
}

END

	return $top_code;
}

sub pdata {
	
$pdata = <<'THE_END_OF_DATA';
%PDATA
THE_END_OF_DATA

	return $pdata;
}