1#!/usr/bin/env perl
2#
3# tkdict - a Perl/Tk DICT client, for accessing network dictionary servers
4#
5# Neil Bowers <neil@bowers.com>
6# Copyright (C) 2001-2002, Neil Bowers
7#
8
9use strict;
10use warnings;
11
12use Tk;
13use Tk::Dialog;
14use Net::Dict;
15use AppConfig::Std;
16
17use vars qw($PROGRAM $VERSION);
18$VERSION = sprintf("%d.%d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
19
20my $warn_dialog;
21my $dict_server;
22my $word;
23my $text_window;
24my $bgcolor;
25my $mw;
26my $config;
27my $help;
28my ($info_top, $info_text, $info_title);
29my $ht;
30my %helpString;
31my $dict;
32my ($lookup_mode, $modeDisplay);
33my $mbDefine;
34my ($sframe, $strat_menu, $strategy, $strategyDisplay);
35my ($db_frame, $db_menu, $db, $dbDisplay);
36my $bar3;
37
38main();
39exit 0;
40
41
42#=======================================================================
43#
44# main()
45#
46# This is the main body of tkdict
47#
48#=======================================================================
49sub main
50{
51    initialise();
52    create_gui();
53    if ($config->host)
54    {
55        $dict_server = $config->host;
56        select_server();
57    }
58    $mw->protocol('WM_DELETE_WINDOW', \&tkdict_exit);
59    MainLoop();
60}
61
62#=======================================================================
63#
64# initialise()
65#
66# check config file and command-line
67#
68#=======================================================================
69sub initialise
70{
71    #-------------------------------------------------------------------
72    # Initialise misc global variables
73    #-------------------------------------------------------------------
74    $PROGRAM = "TkDict";
75    $lookup_mode = "define";
76
77    #-------------------------------------------------------------------
78    # Create AppConfig::Std, define parameters, and parse command-line
79    #-------------------------------------------------------------------
80    $config = AppConfig::Std->new()
81        || die "failed to create AppConfig::Std: $!\n";
82
83    $config->define('host',       { ARGCOUNT => 1, ALIAS => 'h' });
84    $config->define('port',       { ARGCOUNT => 1, ALIAS => 'p',
85                                    DEFAULT => 2628 });
86    $config->define('client',     { ARGCOUNT => 1, ALIAS => 'c',
87				    DEFAULT => "$PROGRAM $VERSION ".
88				"[using Net::Dict $Net::Dict::VERSION]",
89				  });
90
91    $config->args(\@ARGV)
92        || die "run \"$PROGRAM -help\" to see valid options\n";
93
94    #-------------------------------------------------------------------
95    # Consistency checking, ensure we have required options, etc.
96    #-------------------------------------------------------------------
97}
98
99#=======================================================================
100#
101# select_server()
102#
103# connect to the server, and get information needed to
104# configure the user interface.
105#
106#=======================================================================
107sub select_server
108{
109
110    if (not defined $dict_server || $dict_server eq '')
111    {
112	configure_dict_gui();
113	return;
114    }
115
116    $word = '';
117
118    #-------------------------------------------------------------------
119    # Create connection to DICT server
120    #-------------------------------------------------------------------
121    $dict = Net::Dict->new($dict_server,
122                           Port   => $config->port,
123                           Client => $config->client,
124			   Debug  => $config->debug,
125                          );
126    if (not defined $dict)
127    {
128	tkd_warn("Failed to connect to DICT server $dict_server");
129	configure_dict_gui();
130	return;
131    }
132
133    configure_dict_gui();
134}
135
136#=======================================================================
137#
138# configure_dict_gui()
139#
140# Configure the relevant bits of the GUI according to
141# the current DICT connection.
142#
143#=======================================================================
144sub configure_dict_gui
145{
146    my @dbs;
147    my %dbhash;
148    my @strats;
149    my %shash;
150
151    $text_window->delete('0.0', 'end');
152    if (not defined $dict)
153    {
154	$bar3->packForget();
155	$db_frame->packForget();
156    }
157    else
158    {
159	$bar3->pack(-side => 'top', -fill => 'x');
160
161	%dbhash = $dict->dbs();
162	@dbs = map { [$dbhash{$_}, $_] } sort keys %dbhash;
163	unshift(@dbs, ['search all databases', '*'],
164			['search all, stop after 1st match', '!']);
165	$db_menu->configure(-options => \@dbs);
166
167	%shash = $dict->strategies();
168	@strats = map { [$shash{$_}, $_] } sort keys %shash;
169	$strat_menu->configure(-options => \@strats);
170
171	$db_frame->pack(-side => 'left');
172    }
173}
174
175#=======================================================================
176#
177# create_gui()
178#
179# This procedure creates the widgets for the tkdict GUI
180#
181#=======================================================================
182sub create_gui
183{
184    my $bar2;
185    my $menu_bar;
186    my $mbFile;
187    my $mbView;
188    my $mbHelp;
189    my $server_entry;
190    my $word_entry;
191
192    $mw = MainWindow->new(-title => "$PROGRAM $VERSION");
193
194    $bgcolor = $mw->cget(-bg);
195
196    #---------------------------------------------------------------------
197    # menu bar
198    #---------------------------------------------------------------------
199    $menu_bar = $mw->Frame(-relief => 'raised', -bd => 2);
200    $menu_bar->pack(-side => 'top', -fill => 'x');
201
202    #---------------------------------------------------------------------
203    # Menu: File
204    #
205    # Create the File menu and the entries on the menu
206    #---------------------------------------------------------------------
207
208    $mbFile = $menu_bar->Menubutton(
209                       -text => 'File',
210                       -underline => 0,
211		       -tearoff => 0,
212		       -menuitems => [
213                                      '-',
214                                      ['command' => 'Exit',
215                                       -underline => 1,
216                                       -command => \&tkdict_exit]
217                                     ]);
218    $mbFile->pack(-side => 'left');
219
220    #---------------------------------------------------------------------
221    # Menu: View
222    #
223    # Create the View menu and the entries on the menu
224    #---------------------------------------------------------------------
225    $mbView = $menu_bar->Menubutton(
226			-text => 'View', -underline => 0,
227			-tearoff => 0,
228			-menuitems => [ ['command' => 'Server Information',
229					-command => [\&show_info, 'server']],
230					['command' => 'Database Information',
231					-command => [\&show_info, 'db']],
232					]);
233    $mbView->pack(-side => 'left');
234
235
236    #---------------------------------------------------------------------
237    # Menu: Help
238    #
239    # Create the Help menu and the entries on the menu
240    #---------------------------------------------------------------------
241    $mbHelp = $menu_bar->Menubutton(
242			-text      => 'Help',
243			-underline => 0,
244			-tearoff   => 0,
245			-menuitems => [
246				['command' => 'Overview',
247					-command => [\&show_help, 'overview']],
248				['command' => 'ToDo List',
249					-command => [\&show_help, 'todo']],
250				'-',
251				['command' => 'About TkDict ...',
252					-command => [\&show_help, 'about']],
253					]);
254    $mbHelp->pack(-side => 'right');
255
256    #---------------------------------------------------------------------
257    # bar which has the entries for specifying server and select a dict
258    #---------------------------------------------------------------------
259    $bar2 = $mw->Frame(-relief => 'raised', -bd => 2);
260    $bar2->pack(-side => 'top', -fill => 'x');
261
262    $bar2->Label(-text => 'Server: ')->pack(-side => 'left');
263    $server_entry = $bar2->Entry(-relief => 'sunken',
264			   -textvariable => \$dict_server,
265			   -width => 16)->pack(-side => 'left', -fill => 'x');
266    $server_entry->bind('<Return>', \&select_server);
267    $server_entry->bind('<FocusIn>',
268                        sub { $server_entry->configure(-bg => 'white'); });
269    $server_entry->bind('<FocusOut>',
270                        sub { $server_entry->configure(-bg => "$bgcolor"); });
271
272    $db_frame = $bar2->Frame();
273
274    $db_frame->Label(-text => 'Dictionary: ')->pack(-side => 'left');
275    $db_menu = $db_frame->Optionmenu(-variable => \$db,
276			-textvariable => \$dbDisplay,
277			-options => [],
278			    )->pack(-side => 'left');
279
280    #-------------------------------------------------------------------
281    # Bar which has the entry for entering the word to be defined
282    #-------------------------------------------------------------------
283    $bar3 = $mw->Frame(-relief => 'raised', -bd => 2);
284    $bar3->pack(-side => 'top', -fill => 'x');
285    # $bar3->Label(-text => 'Define word:')->pack(-side => 'left');
286    $mbDefine = $bar3->Optionmenu(
287			-textvariable => \$modeDisplay,
288			-variable => \$lookup_mode,
289			-command => \&set_mode,
290			-options => [ ['Define word', 'define'],
291					['Match pattern', 'match'],
292					],
293					);
294    $mbDefine->pack(-side => 'left');
295
296    $word_entry = $bar3->Entry(-relief => 'sunken',
297			   -textvariable => \$word,
298			   -width => 16)->pack(-side => 'left');
299    $word_entry->bind('<Return>', \&lookup_word);
300    $word_entry->bind('<FocusIn>',
301                      sub { $word_entry->configure(-bg => 'white'); });
302    $word_entry->bind('<FocusOut>',
303                      sub { $word_entry->configure(-bg => "$bgcolor"); });
304
305    $sframe = $bar3->Frame();
306    $sframe->Label(-text => 'Strategy')->pack(-side => 'left');
307    $strat_menu = $sframe->Optionmenu(-variable => \$strategy,
308			-textvariable => \$strategyDisplay,
309			-options => [],
310			    )->pack(-side => 'left');
311    $sframe->pack(-side => 'left');
312
313    $bar3->packForget();
314
315    #-------------------------------------------------------------------
316    # Bar which has the entry for entering the word to be defined
317    #-------------------------------------------------------------------
318    $text_window = $mw->Scrolled('Text',
319                                 -bg => 'white', -fg => 'black',
320                                 -width => 72, -height => 16,
321                                -scrollbars => 'osoe');
322    $text_window->pack(-side => 'bottom', -fill => 'both', -expand => 1);
323
324
325    #-- accelerators ---------------------------------------------
326    $mw->bind('<Control-x><Control-c>', \&tkdict_exit);
327
328    set_mode();
329
330    $mw->update;
331}
332
333#=======================================================================
334#
335# set_mode()
336#
337# Configure the GUI according to the lookup mode selected.
338# If 'match', then show the menu for selecting the match strategy.
339# If 'define', then hide the strategy selection menu.
340#
341#=======================================================================
342sub set_mode
343{
344
345    if ($lookup_mode eq 'match')
346    {
347	$sframe->pack();
348    }
349    else
350    {
351	$sframe->packForget();
352    }
353}
354
355#=======================================================================
356#
357# lookup_word()
358#
359# Look up the word entered by the user.
360# This will either be a match or a define operation.
361#
362#=======================================================================
363sub lookup_word
364{
365    my $string = '';
366    my $eref;
367
368    if (!defined($word) || length($word) == 0)
369    {
370	tkd_warn("You need to type something first!");
371	return;
372    }
373
374    #-------------------------------------------------------------------
375    # clear out any help text which might be displayed
376    #-------------------------------------------------------------------
377    $text_window->delete('0.0', 'end');
378
379    if ($lookup_mode eq 'define')
380    {
381        #---------------------------------------------------------------
382        # Word definitions requested. We get back a list ref:
383        #    [  [db,definition], [db,definition], ... ]
384        #---------------------------------------------------------------
385	$eref = $dict->define($word, $db);
386	if (@$eref == 0)
387	{
388	    $string = "no definition found for \"$word\"\n";
389	}
390	else
391	{
392	    foreach my $entry (@$eref)
393	    {
394		$string .= "--- ".$dict->dbTitle($entry->[0])." ---\n";
395                $string .= $entry->[1]."\n\n";
396	    }
397	}
398
399    }
400    else
401    {
402        #---------------------------------------------------------------
403        # List of matching words requested.
404        #---------------------------------------------------------------
405        my %dbwords;
406        my ($dbname, $match);
407
408        $eref = $dict->match($word, $strategy);
409        if (@$eref == 0)
410        {
411            $string = "no words matched :-(\n";
412        }
413        else
414        {
415            foreach my $entry (@$eref)
416            {
417                ($dbname, $match) = @$entry;
418                $dbwords{$dbname} = [] if not exists $dbwords{$dbname};
419                push(@{ $dbwords{$dbname }}, $match);
420            }
421            foreach $dbname (sort keys %dbwords)
422            {
423                my @words;
424                $string .= $dict->dbTitle($dbname).":\n";
425                $string .= join(', ', @{ $dbwords{$dbname}});
426                $string .= "\n\n";
427            }
428        }
429    }
430
431    #-------------------------------------------------------------------
432    # display the resulting string in the scrolling text window
433    #-------------------------------------------------------------------
434    $text_window->insert('end', $string);
435}
436
437
438#=======================================================================
439#
440# tkdict_exit()
441#
442# quit from TkDict. In the future there might be
443# more to do here, hence the function.
444#
445#=======================================================================
446sub tkdict_exit
447{
448    exit 0;
449}
450
451#=======================================================================
452#
453# show_info()
454#
455# Display information which is retrieved from the server.
456# An argument is passed to identify which piece of info:
457#
458#    server: information about the server
459#    db    : information about the selected DB (dictionary)
460#
461#=======================================================================
462sub show_info
463{
464    my $topic = shift;
465
466
467    if ($topic eq 'server' && !$dict_server)
468    {
469        tkd_warn("You have to connect to a server first!");
470        return;
471    }
472    if ($topic eq 'db' && (!$db || $db eq '*' || $db eq '!'))
473    {
474        tkd_warn("You must select a specific database first");
475        return;
476    }
477
478    if (not Exists($info_top))
479    {
480        $info_top = $mw->Toplevel(-class => 'TkDictInfo');
481        $info_top->title("$PROGRAM Info");
482        $info_title = $info_top->Label();
483        $info_title->pack(-side => 'top', -fill => 'x');
484
485        $info_text = $info_top->Scrolled('Text',
486                                 -bg => 'white', -fg => 'black',
487                              -width => 60, -height => 12,
488                              -scrollbars => 'osoe',
489                             )->pack(-side => 'top', -fill => 'both',
490                                     -expand => 1);
491
492        $info_top->Button(-text => "Close",
493                -command => sub {$info_top->withdraw})->pack(-side => 'bottom');
494    } else {
495        $info_top->deiconify();
496        $info_top->raise();
497    }
498
499    $info_text->delete('0.0', 'end');
500
501    if ($topic eq 'server')
502    {
503        $info_title->configure(-text => "Server: $dict_server");
504        $info_text->insert('end', $dict->serverInfo());
505    }
506    else
507    {
508        $info_title->configure(-text => "Database: ".$dict->dbTitle($db));
509        foreach my $line ($dict->dbInfo($db))
510        {
511            $info_text->insert('end', $line);
512        }
513    }
514}
515
516#=======================================================================
517# show_help() - display a selected help message
518#       $topic - the identifier for the topic to display
519#
520# This procedure is used to display a help message. An identifying
521# string is passed in, which is used to index the associative array
522# holding the help text.
523#=======================================================================
524sub show_help
525{
526    my $topic = shift;
527
528
529    #-- create the help display toplevel, if needed --------------
530    if (not Exists($help))
531    {
532	$help = $mw->Toplevel(-class => 'TkDictHelp');
533	$help->title("$PROGRAM Help");
534
535	$ht = $help->Scrolled('Text',
536                              -bg => 'white', -fg => 'black',
537			      -width => 60, -height => 12,
538			      -scrollbars => 'osoe',
539			     )->pack(-side => 'top', -fill => 'both',
540                                     -expand => 1);
541
542	$help->Button(-text => "Close",
543		-command => sub {$help->withdraw})->pack(-side => 'bottom');
544	initialise_help();
545    } else {
546	$help->deiconify();
547	$help->raise();
548    }
549
550    #-- clear out any help text which might be displayed ---------
551    $ht->delete('0.0', 'end');
552
553    #-- insert the selected help message in text widget ----------
554    $ht->insert('end', $helpString{$topic});
555}
556
557#=======================================================================
558#
559# tkd_warn()
560#
561# Display a warning message in a dialog, then wait for the
562# user to acknowledge it.
563#
564#=======================================================================
565sub tkd_warn
566{
567    my $message = shift;
568
569    my $choice;
570
571
572    if (not Exists($warn_dialog))
573    {
574	$warn_dialog = $mw->Dialog(
575				-title		=> "Warning",
576				-text		=> $message,
577				-bitmap		=> 'warning',
578				-default_button => "OK",
579			);
580    }
581    else
582    {
583	$warn_dialog->configure(-text => $message);
584    }
585
586    $choice = $warn_dialog->Show(-global);
587}
588
589
590#=======================================================================
591# initialise_help() - initialize the help strings
592#
593# This procedure initializes the global array helpString, which holds
594# the text for the different help messages. The array is indexed by
595# single word identifiers.
596#=======================================================================
597sub initialise_help
598{
599    $helpString{about} = <<EOFABOUT;
600
601                     $PROGRAM v$VERSION
602
603$PROGRAM is a DICT client, used to access network dictionary
604servers which support the protocol defined in RFC 2229.
605
606This client is using Perl module Net::Dict $Net::Dict::VERSION.
607
608Neil Bowers <neil\@bowers.com>
609Copyright (C) 2001-2002, Neil Bowers
610EOFABOUT
611
612    $helpString{overview} = <<EOFENTRY;
613
614              $PROGRAM $VERSION - Overview
615
616$PROGRAM is a simple Tk tool for looking up entries
617in dictionaries which are accessed using the DICT protocol.
618
619First you must specify a Server (and press RETURN).
620A good one to try is dict.org - it has a number of dictionaries.
621You should get a menu for selecting dictionaries,
622and a text box for entering a word.
623
624Enter a word and press return. By default $PROGRAM will check
625all dictionaries, so you might get a number of definitions.
626
627EOFENTRY
628
629    $helpString{todo} = <<EOFTODO;
630
631            $PROGRAM v$VERSION - ToDo List
632
633    *   better formatting of results
634    *   more user-oriented user interface
635    *   have the inline pod available on Help menu
636    *   show one definition at a time
637        with some sort of NEXT and PREV interface
638    *   option to specify whether to stay connect or not
639    *   haven't done anything to handle connnection timing out
640    *   status line at the bottom of the main window
641
642EOFTODO
643}
644
645
646#=======================================================================
647#
648# show_db_info()
649#
650# Query the server for information about the specified database,
651# and display the results.
652#
653# The information is typically several pages of text,
654# describing the contents of the dictionary, where it came from,
655# credits, etc.
656#
657#=======================================================================
658sub show_db_info
659{
660    my $db  = shift;
661    my %dbs = $dict->dbs();
662
663
664    if (not exists $dbs{$config->info})
665    {
666        print "  dictionary \"$db\" not known\n";
667        return;
668    }
669
670    print $dict->dbInfo($config->info);
671}
672
673__END__
674
675=head1 NAME
676
677tkdict - a perl client for accessing network dictionary servers
678
679=head1 SYNOPSIS
680
681tkdict [OPTIONS]
682
683=head1 DESCRIPTION
684
685B<tkdict> is a Perl/Tk client for the Dictionary server protocol (DICT),
686which is used to query natural dictionaries hosted on a remote machine.
687
688At the moment it's not very user oriented, since I've just been
689creating an interface to the protocol.
690
691There is more information available in the B<Help> menu
692when running B<tkdict>.
693
694=head1 OPTIONS
695
696=over 4
697
698=item B<-h> I<server> or B<-host> I<server>
699
700The hostname for the DICT server.
701
702=item B<-p> I<port> or B<-port> I<port>
703
704Specify the port for connections (default is 2628, from RFC 2229).
705
706=item B<-c> I<string> or B<-client> I<string>
707
708Specify the CLIENT identification string sent to the DICT server.
709
710=item B<-help>
711
712Display a short help message including command-line options.
713
714=item B<-doc>
715
716Display the full documentation for B<tkdict>.
717
718=item B<-version>
719
720Display the version of B<tkdict>
721
722=item B<-verbose>
723
724Display verbose information as B<tkdict> runs.
725
726=item B<-debug>
727
728Display debugging information as B<tkdict> runs.
729Useful mainly for developers.
730
731=back
732
733=head1 KNOWN BUGS AND LIMITATIONS
734
735=over 4
736
737=item *
738
739B<tkdict> doesn't know how to handle firewalls.
740
741=item *
742
743The authentication aspects of RFC 2229 aren't currently supported.
744
745=item *
746
747See the B<ToDo> page under the B<Help> menu.
748
749=back
750
751=head1 SEE ALSO
752
753=over 4
754
755=item www.dict.org
756
757The DICT home page, with all sorts of useful information.
758There are a number of other DICT clients available.
759
760=item dict
761
762The C dict client written by Rik Faith;
763the options are pretty much lifted from Rik's client.
764
765=item RFC 2229
766
767The document which defines the DICT network protocol.
768
769http://www.cis.ohio-state.edu/htbin/rfc/rfc2229.html
770
771=item Net::Dict
772
773The perl module which implements the client API for RFC 2229.
774It includes a command-line perl client, B<dict>,
775as well as B<tkdict>.
776
777=back
778
779=head1 VERSION
780
781$Revision: 1.1.1.1 $
782
783=head1 AUTHOR
784
785Neil Bowers <neil@bowers.com>
786
787=head1 COPYRIGHT
788
789Copyright (C) 2001-2002 Neil Bowers. All rights reserved.
790
791This script is free software; you can redistribute it and/or modify
792it under the same terms as Perl itself.
793
794=cut
795
796