#!/usr/bin/env perl
#
# tkdict - a Perl/Tk DICT client, for accessing network dictionary servers
#
# Neil Bowers <neil@bowers.com>
# Copyright (C) 2001-2002, Neil Bowers
#
use strict;
use warnings;
use Tk;
use Tk::Dialog;
use Net::Dict;
use AppConfig::Std;
use vars qw($PROGRAM $VERSION);
$VERSION = sprintf("%d.%d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
my $warn_dialog;
my $dict_server;
my $word;
my $text_window;
my $bgcolor;
my $mw;
my $config;
my $help;
my ($info_top, $info_text, $info_title);
my $ht;
my %helpString;
my $dict;
my ($lookup_mode, $modeDisplay);
my $mbDefine;
my ($sframe, $strat_menu, $strategy, $strategyDisplay);
my ($db_frame, $db_menu, $db, $dbDisplay);
my $bar3;
main();
exit 0;
#=======================================================================
#
# main()
#
# This is the main body of tkdict
#
#=======================================================================
sub main
{
initialise();
create_gui();
if ($config->host)
{
$dict_server = $config->host;
select_server();
}
$mw->protocol('WM_DELETE_WINDOW', \&tkdict_exit);
MainLoop();
}
#=======================================================================
#
# initialise()
#
# check config file and command-line
#
#=======================================================================
sub initialise
{
#-------------------------------------------------------------------
# Initialise misc global variables
#-------------------------------------------------------------------
$PROGRAM = "TkDict";
$lookup_mode = "define";
#-------------------------------------------------------------------
# Create AppConfig::Std, define parameters, and parse command-line
#-------------------------------------------------------------------
$config = AppConfig::Std->new()
|| die "failed to create AppConfig::Std: $!\n";
$config->define('host', { ARGCOUNT => 1, ALIAS => 'h' });
$config->define('port', { ARGCOUNT => 1, ALIAS => 'p',
DEFAULT => 2628 });
$config->define('client', { ARGCOUNT => 1, ALIAS => 'c',
DEFAULT => "$PROGRAM $VERSION ".
"[using Net::Dict $Net::Dict::VERSION]",
});
$config->args(\@ARGV)
|| die "run \"$PROGRAM -help\" to see valid options\n";
#-------------------------------------------------------------------
# Consistency checking, ensure we have required options, etc.
#-------------------------------------------------------------------
}
#=======================================================================
#
# select_server()
#
# connect to the server, and get information needed to
# configure the user interface.
#
#=======================================================================
sub select_server
{
if (not defined $dict_server || $dict_server eq '')
{
configure_dict_gui();
return;
}
$word = '';
#-------------------------------------------------------------------
# Create connection to DICT server
#-------------------------------------------------------------------
$dict = Net::Dict->new($dict_server,
Port => $config->port,
Client => $config->client,
Debug => $config->debug,
);
if (not defined $dict)
{
tkd_warn("Failed to connect to DICT server $dict_server");
configure_dict_gui();
return;
}
configure_dict_gui();
}
#=======================================================================
#
# configure_dict_gui()
#
# Configure the relevant bits of the GUI according to
# the current DICT connection.
#
#=======================================================================
sub configure_dict_gui
{
my @dbs;
my %dbhash;
my @strats;
my %shash;
$text_window->delete('0.0', 'end');
if (not defined $dict)
{
$bar3->packForget();
$db_frame->packForget();
}
else
{
$bar3->pack(-side => 'top', -fill => 'x');
%dbhash = $dict->dbs();
@dbs = map { [$dbhash{$_}, $_] } sort keys %dbhash;
unshift(@dbs, ['search all databases', '*'],
['search all, stop after 1st match', '!']);
$db_menu->configure(-options => \@dbs);
%shash = $dict->strategies();
@strats = map { [$shash{$_}, $_] } sort keys %shash;
$strat_menu->configure(-options => \@strats);
$db_frame->pack(-side => 'left');
}
}
#=======================================================================
#
# create_gui()
#
# This procedure creates the widgets for the tkdict GUI
#
#=======================================================================
sub create_gui
{
my $bar2;
my $menu_bar;
my $mbFile;
my $mbView;
my $mbHelp;
my $server_entry;
my $word_entry;
$mw = MainWindow->new(-title => "$PROGRAM $VERSION");
$bgcolor = $mw->cget(-bg);
#---------------------------------------------------------------------
# menu bar
#---------------------------------------------------------------------
$menu_bar = $mw->Frame(-relief => 'raised', -bd => 2);
$menu_bar->pack(-side => 'top', -fill => 'x');
#---------------------------------------------------------------------
# Menu: File
#
# Create the File menu and the entries on the menu
#---------------------------------------------------------------------
$mbFile = $menu_bar->Menubutton(
-text => 'File',
-underline => 0,
-tearoff => 0,
-menuitems => [
'-',
['command' => 'Exit',
-underline => 1,
-command => \&tkdict_exit]
]);
$mbFile->pack(-side => 'left');
#---------------------------------------------------------------------
# Menu: View
#
# Create the View menu and the entries on the menu
#---------------------------------------------------------------------
$mbView = $menu_bar->Menubutton(
-text => 'View', -underline => 0,
-tearoff => 0,
-menuitems => [ ['command' => 'Server Information',
-command => [\&show_info, 'server']],
['command' => 'Database Information',
-command => [\&show_info, 'db']],
]);
$mbView->pack(-side => 'left');
#---------------------------------------------------------------------
# Menu: Help
#
# Create the Help menu and the entries on the menu
#---------------------------------------------------------------------
$mbHelp = $menu_bar->Menubutton(
-text => 'Help',
-underline => 0,
-tearoff => 0,
-menuitems => [
['command' => 'Overview',
-command => [\&show_help, 'overview']],
['command' => 'ToDo List',
-command => [\&show_help, 'todo']],
'-',
['command' => 'About TkDict ...',
-command => [\&show_help, 'about']],
]);
$mbHelp->pack(-side => 'right');
#---------------------------------------------------------------------
# bar which has the entries for specifying server and select a dict
#---------------------------------------------------------------------
$bar2 = $mw->Frame(-relief => 'raised', -bd => 2);
$bar2->pack(-side => 'top', -fill => 'x');
$bar2->Label(-text => 'Server: ')->pack(-side => 'left');
$server_entry = $bar2->Entry(-relief => 'sunken',
-textvariable => \$dict_server,
-width => 16)->pack(-side => 'left', -fill => 'x');
$server_entry->bind('<Return>', \&select_server);
$server_entry->bind('<FocusIn>',
sub { $server_entry->configure(-bg => 'white'); });
$server_entry->bind('<FocusOut>',
sub { $server_entry->configure(-bg => "$bgcolor"); });
$db_frame = $bar2->Frame();
$db_frame->Label(-text => 'Dictionary: ')->pack(-side => 'left');
$db_menu = $db_frame->Optionmenu(-variable => \$db,
-textvariable => \$dbDisplay,
-options => [],
)->pack(-side => 'left');
#-------------------------------------------------------------------
# Bar which has the entry for entering the word to be defined
#-------------------------------------------------------------------
$bar3 = $mw->Frame(-relief => 'raised', -bd => 2);
$bar3->pack(-side => 'top', -fill => 'x');
# $bar3->Label(-text => 'Define word:')->pack(-side => 'left');
$mbDefine = $bar3->Optionmenu(
-textvariable => \$modeDisplay,
-variable => \$lookup_mode,
-command => \&set_mode,
-options => [ ['Define word', 'define'],
['Match pattern', 'match'],
],
);
$mbDefine->pack(-side => 'left');
$word_entry = $bar3->Entry(-relief => 'sunken',
-textvariable => \$word,
-width => 16)->pack(-side => 'left');
$word_entry->bind('<Return>', \&lookup_word);
$word_entry->bind('<FocusIn>',
sub { $word_entry->configure(-bg => 'white'); });
$word_entry->bind('<FocusOut>',
sub { $word_entry->configure(-bg => "$bgcolor"); });
$sframe = $bar3->Frame();
$sframe->Label(-text => 'Strategy')->pack(-side => 'left');
$strat_menu = $sframe->Optionmenu(-variable => \$strategy,
-textvariable => \$strategyDisplay,
-options => [],
)->pack(-side => 'left');
$sframe->pack(-side => 'left');
$bar3->packForget();
#-------------------------------------------------------------------
# Bar which has the entry for entering the word to be defined
#-------------------------------------------------------------------
$text_window = $mw->Scrolled('Text',
-bg => 'white', -fg => 'black',
-width => 72, -height => 16,
-scrollbars => 'osoe');
$text_window->pack(-side => 'bottom', -fill => 'both', -expand => 1);
#-- accelerators ---------------------------------------------
$mw->bind('<Control-x><Control-c>', \&tkdict_exit);
set_mode();
$mw->update;
}
#=======================================================================
#
# set_mode()
#
# Configure the GUI according to the lookup mode selected.
# If 'match', then show the menu for selecting the match strategy.
# If 'define', then hide the strategy selection menu.
#
#=======================================================================
sub set_mode
{
if ($lookup_mode eq 'match')
{
$sframe->pack();
}
else
{
$sframe->packForget();
}
}
#=======================================================================
#
# lookup_word()
#
# Look up the word entered by the user.
# This will either be a match or a define operation.
#
#=======================================================================
sub lookup_word
{
my $string = '';
my $eref;
if (!defined($word) || length($word) == 0)
{
tkd_warn("You need to type something first!");
return;
}
#-------------------------------------------------------------------
# clear out any help text which might be displayed
#-------------------------------------------------------------------
$text_window->delete('0.0', 'end');
if ($lookup_mode eq 'define')
{
#---------------------------------------------------------------
# Word definitions requested. We get back a list ref:
# [ [db,definition], [db,definition], ... ]
#---------------------------------------------------------------
$eref = $dict->define($word, $db);
if (@$eref == 0)
{
$string = "no definition found for \"$word\"\n";
}
else
{
foreach my $entry (@$eref)
{
$string .= "--- ".$dict->dbTitle($entry->[0])." ---\n";
$string .= $entry->[1]."\n\n";
}
}
}
else
{
#---------------------------------------------------------------
# List of matching words requested.
#---------------------------------------------------------------
my %dbwords;
my ($dbname, $match);
$eref = $dict->match($word, $strategy);
if (@$eref == 0)
{
$string = "no words matched :-(\n";
}
else
{
foreach my $entry (@$eref)
{
($dbname, $match) = @$entry;
$dbwords{$dbname} = [] if not exists $dbwords{$dbname};
push(@{ $dbwords{$dbname }}, $match);
}
foreach $dbname (sort keys %dbwords)
{
my @words;
$string .= $dict->dbTitle($dbname).":\n";
$string .= join(', ', @{ $dbwords{$dbname}});
$string .= "\n\n";
}
}
}
#-------------------------------------------------------------------
# display the resulting string in the scrolling text window
#-------------------------------------------------------------------
$text_window->insert('end', $string);
}
#=======================================================================
#
# tkdict_exit()
#
# quit from TkDict. In the future there might be
# more to do here, hence the function.
#
#=======================================================================
sub tkdict_exit
{
exit 0;
}
#=======================================================================
#
# show_info()
#
# Display information which is retrieved from the server.
# An argument is passed to identify which piece of info:
#
# server: information about the server
# db : information about the selected DB (dictionary)
#
#=======================================================================
sub show_info
{
my $topic = shift;
if ($topic eq 'server' && !$dict_server)
{
tkd_warn("You have to connect to a server first!");
return;
}
if ($topic eq 'db' && (!$db || $db eq '*' || $db eq '!'))
{
tkd_warn("You must select a specific database first");
return;
}
if (not Exists($info_top))
{
$info_top = $mw->Toplevel(-class => 'TkDictInfo');
$info_top->title("$PROGRAM Info");
$info_title = $info_top->Label();
$info_title->pack(-side => 'top', -fill => 'x');
$info_text = $info_top->Scrolled('Text',
-bg => 'white', -fg => 'black',
-width => 60, -height => 12,
-scrollbars => 'osoe',
)->pack(-side => 'top', -fill => 'both',
-expand => 1);
$info_top->Button(-text => "Close",
-command => sub {$info_top->withdraw})->pack(-side => 'bottom');
} else {
$info_top->deiconify();
$info_top->raise();
}
$info_text->delete('0.0', 'end');
if ($topic eq 'server')
{
$info_title->configure(-text => "Server: $dict_server");
$info_text->insert('end', $dict->serverInfo());
}
else
{
$info_title->configure(-text => "Database: ".$dict->dbTitle($db));
foreach my $line ($dict->dbInfo($db))
{
$info_text->insert('end', $line);
}
}
}
#=======================================================================
# show_help() - display a selected help message
# $topic - the identifier for the topic to display
#
# This procedure is used to display a help message. An identifying
# string is passed in, which is used to index the associative array
# holding the help text.
#=======================================================================
sub show_help
{
my $topic = shift;
#-- create the help display toplevel, if needed --------------
if (not Exists($help))
{
$help = $mw->Toplevel(-class => 'TkDictHelp');
$help->title("$PROGRAM Help");
$ht = $help->Scrolled('Text',
-bg => 'white', -fg => 'black',
-width => 60, -height => 12,
-scrollbars => 'osoe',
)->pack(-side => 'top', -fill => 'both',
-expand => 1);
$help->Button(-text => "Close",
-command => sub {$help->withdraw})->pack(-side => 'bottom');
initialise_help();
} else {
$help->deiconify();
$help->raise();
}
#-- clear out any help text which might be displayed ---------
$ht->delete('0.0', 'end');
#-- insert the selected help message in text widget ----------
$ht->insert('end', $helpString{$topic});
}
#=======================================================================
#
# tkd_warn()
#
# Display a warning message in a dialog, then wait for the
# user to acknowledge it.
#
#=======================================================================
sub tkd_warn
{
my $message = shift;
my $choice;
if (not Exists($warn_dialog))
{
$warn_dialog = $mw->Dialog(
-title => "Warning",
-text => $message,
-bitmap => 'warning',
-default_button => "OK",
);
}
else
{
$warn_dialog->configure(-text => $message);
}
$choice = $warn_dialog->Show(-global);
}
#=======================================================================
# initialise_help() - initialize the help strings
#
# This procedure initializes the global array helpString, which holds
# the text for the different help messages. The array is indexed by
# single word identifiers.
#=======================================================================
sub initialise_help
{
$helpString{about} = <<EOFABOUT;
$PROGRAM v$VERSION
$PROGRAM is a DICT client, used to access network dictionary
servers which support the protocol defined in RFC 2229.
This client is using Perl module Net::Dict $Net::Dict::VERSION.
Neil Bowers <neil\@bowers.com>
Copyright (C) 2001-2002, Neil Bowers
EOFABOUT
$helpString{overview} = <<EOFENTRY;
$PROGRAM $VERSION - Overview
$PROGRAM is a simple Tk tool for looking up entries
in dictionaries which are accessed using the DICT protocol.
First you must specify a Server (and press RETURN).
A good one to try is dict.org - it has a number of dictionaries.
You should get a menu for selecting dictionaries,
and a text box for entering a word.
Enter a word and press return. By default $PROGRAM will check
all dictionaries, so you might get a number of definitions.
EOFENTRY
$helpString{todo} = <<EOFTODO;
$PROGRAM v$VERSION - ToDo List
* better formatting of results
* more user-oriented user interface
* have the inline pod available on Help menu
* show one definition at a time
with some sort of NEXT and PREV interface
* option to specify whether to stay connect or not
* haven't done anything to handle connnection timing out
* status line at the bottom of the main window
EOFTODO
}
#=======================================================================
#
# show_db_info()
#
# Query the server for information about the specified database,
# and display the results.
#
# The information is typically several pages of text,
# describing the contents of the dictionary, where it came from,
# credits, etc.
#
#=======================================================================
sub show_db_info
{
my $db = shift;
my %dbs = $dict->dbs();
if (not exists $dbs{$config->info})
{
print " dictionary \"$db\" not known\n";
return;
}
print $dict->dbInfo($config->info);
}
__END__
=head1 NAME
tkdict - a perl client for accessing network dictionary servers
=head1 SYNOPSIS
tkdict [OPTIONS]
=head1 DESCRIPTION
B<tkdict> is a Perl/Tk client for the Dictionary server protocol (DICT),
which is used to query natural dictionaries hosted on a remote machine.
At the moment it's not very user oriented, since I've just been
creating an interface to the protocol.
There is more information available in the B<Help> menu
when running B<tkdict>.
=head1 OPTIONS
=over 4
=item B<-h> I<server> or B<-host> I<server>
The hostname for the DICT server.
=item B<-p> I<port> or B<-port> I<port>
Specify the port for connections (default is 2628, from RFC 2229).
=item B<-c> I<string> or B<-client> I<string>
Specify the CLIENT identification string sent to the DICT server.
=item B<-help>
Display a short help message including command-line options.
=item B<-doc>
Display the full documentation for B<tkdict>.
=item B<-version>
Display the version of B<tkdict>
=item B<-verbose>
Display verbose information as B<tkdict> runs.
=item B<-debug>
Display debugging information as B<tkdict> runs.
Useful mainly for developers.
=back
=head1 KNOWN BUGS AND LIMITATIONS
=over 4
=item *
B<tkdict> doesn't know how to handle firewalls.
=item *
The authentication aspects of RFC 2229 aren't currently supported.
=item *
See the B<ToDo> page under the B<Help> menu.
=back
=head1 SEE ALSO
=over 4
=item www.dict.org
The DICT home page, with all sorts of useful information.
There are a number of other DICT clients available.
=item dict
The C dict client written by Rik Faith;
the options are pretty much lifted from Rik's client.
=item RFC 2229
The document which defines the DICT network protocol.
http://www.cis.ohio-state.edu/htbin/rfc/rfc2229.html
=item Net::Dict
The perl module which implements the client API for RFC 2229.
It includes a command-line perl client, B<dict>,
as well as B<tkdict>.
=back
=head1 VERSION
$Revision: 1.1.1.1 $
=head1 AUTHOR
Neil Bowers <neil@bowers.com>
=head1 COPYRIGHT
Copyright (C) 2001-2002 Neil Bowers. All rights reserved.
This script is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut