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