#!/afs/athena/contrib/perl/p
###############################################################################
#
# File:         th
# RCS:          $Header: /afs/sipb/project/sipbsrc/src/Roget/RCS/th,v 1.6 1995/05/08 18:59:35 nocturne Exp $
# Description:  A program to access the thesaurus database.
# Author:       Darryl Okahata
# Created:      Tue Dec 17 15:26:46 1991
# Modified:     Wed Dec 18 16:46:52 1991 (Darryl Okahata) darrylo@hpsrdmo
# Language:     Perl
# Package:      N/A
#
###############################################################################
##
## *******************************************************
## ***** THIS IS AN ALPHA TEST VERSION (Version 0.1) *****
## *******************************************************
##
## th -- A program to access the thesaurus database.
## Copyright (C) 1991 Darryl Okahata (darrylo@sr.hp.com)
## 
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 1, or (at your option)
## any later version.
## 
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
## GNU General Public License for more details.
## 
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##
###############################################################################
##
## Usage:
##
##	th <word> [<word> ...]
##		Search the thesaurus for all entries that begin with
##		"<word>".
##
##	th -V <word> [<word> ...]
##		Search the thesaurus for all entries that begin with
##		"<word>".  All displayed entries are separated by a line
##		of dashes.
##
##	th -W <word> [<word> ...]
##		Search the thesaurus for the entry that contains
##		"<word>" exactly.
##
##	th -w <word> [<word> ...]
##		Display all words in the thesaurus that begin with
##		"<word>".
##
##	th -w -v <word> [<word> ...]
##		Display all words in the thesaurus that begin with
##		"<word>".  Alongside each word, the numbers of the
##		entries that contain the word are displayed.
##
##	th -n <number>
##		Display thesaurus entry number "<number>".  Unlike a
##		word, only one number can be specified.
##
##
###############################################################################

$thesaurus_dir = "/mit/sipb/lib/Roget/\@sys";
###############################################################################

$thesaurus = "$thesaurus_dir/roget.txt";
$index_file = "$thesaurus_dir/offsets";
$word_index = "$thesaurus_dir/word-index";

###############################################################################
require "pwd.pl";
require 'look.pl';
require 'getopts.pl';

&initpwd;

sub usage {
	local ($th) = $0;   
	print STDERR <<EOT;
Usage:

	$th <word> [<word> ...]
		Search the thesaurus for all entries that begin with
		"<word>".

	$th -V <word> [<word> ...]
		Search the thesaurus for all entries that begin with
		"<word>".  All displayed entries are separated by a line
		of dashes.

	$th -W <word> [<word> ...]
		Search the thesaurus for the entry that contains
		"<word>" exactly.

	$th -w <word> [<word> ...]
		Display all words in the thesaurus that begin with
		"<word>".

	$th -w -v <word> [<word> ...]
		Display all words in the thesaurus that begin with
		"<word>".  Alongside each word, the numbers of the
		entries that contain the word are displayed.

	$th -n <number>
		Display thesaurus entry number "<number>".  Unlike a
		word, only one number can be specified.
EOT
	exit 1;
}

&usage if $#ARGV == -1; 
&Getopts('wWn:vV') || &usage;

###############################################################################
open (INPUT, "<$thesaurus") || die "Can't open \"$thesaurus\": $!\n";

open (WORDS, "<$word_index") || die "Can't open \"$word_index\": $!\n";

dbmopen(%indices, "$index_file", undef ) ||
    die "Can't open \"$index_file\": $!\n";

if ($opt_n) {
    &lookup($opt_n);
    exit (0);
}

foreach $word (@ARGV) {
    &look(*WORDS, $word, 0, 1);
    while (<WORDS>) {
	if ($opt_W) {
	    last if (!/^$word\b/i);
	} else {
	    last if (!/^$word/i);
	}
	next if (!/^(.+):(.+)$/);
	$real_word = $1;
	$numbers = $2;
	if ($opt_w) {
	    if ($opt_v) {
		print "$_";
	    } else {
		print "$real_word\n";
	    }
	} else {
	    @entries = ();
	    foreach $num (split(/[ \t]+/, $numbers)) {
		next if (!$num);
		for ($i = 0; $i < $#entries; ++$i) {
		    last if ($entries[$i] == $num);
		}
		if ($i >= $#entries) {
		    push(@entries, $num);
		}
	    }
	    if (@entries) {
		if ($opt_V) {
		    print "-------------------------------------------------------------------------------\n";
		}
		print "***** Word: $real_word\n\n";
		foreach $num (sort bynumber @entries) {
		    &lookup($num);
		}
	    }
	}
    }
}

dbmclose(%indices) || die "$!";

exit (0);


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

sub lookup
{
    local($entry) = @_;
    local($location);

    $location = $indices{$entry};
    seek(INPUT, $location, 0) || die "$!";
    while (<INPUT>) {
	print $_;
	last if (/^[ \t]*$/);
    }
}


sub bynumber
{
    $a <=> $b;
}


#
# Local Variables:
# mode: perl
# perl-indent-level:			 4
# perl-continued-statement-offset:	 4
# perl-continued-brace-offset:		 0
# perl-brace-offset:			-4
# perl-brace-imaginary-offset:		 0
# perl-label-offset:			-4
# End:
#