|
#Copyright (C) 1999 - 2000 ACME Rocket Supply, Inc. All rights reserved.
#This program is free software; you can redistribute it and/or modify it under
#the same terms as Perl itself.
#!/usr/local/bin/perl -w
#
# tkphone - Phone another X Display and have a line-mode conversation.
#
# Usage: see POD for details.
use Tk;
use subs qw/beep phone pconfig/;
use strict;
$ENV{DISPLAY} ||= ':0'; $ARGV[0] ||= $ENV{DISPLAY};
my $title = "$ENV{DISPLAY} phoning $ARGV[0]";
my $lmw = MainWindow->new(-title => $title);
my $rmw = MainWindow->new(-title => $title, -screen => $ARGV[0]);
my($le, $lt) = phone $lmw;
my($re, $rt) = phone $rmw;
pconfig $le, $lt, $re, $rt;
pconfig $re, $rt, $le, $lt; $rmw->bell;
MainLoop;
sub phone {
# Create the menubar and the phone text entry/display area.
my($screen) = @_;
my $menubar = $screen->Menu;
$screen->configure(-menu => $menubar);
my $file = $menubar->cascade(-label => '~File');
$file->command(-label => "Close", -command => [$screen => 'destroy']);
$file->command(-label => "Exit", -command => \&exit);
my $e = $screen->Entry->pack(qw/-fill x -expand 1/);
$e->focus;
my $t = $screen->Text(qw/-height 10/)->pack;
($e, $t);
}
sub pconfig {
# Configure local callbacks to talk to the remote party.
my($le, $lt, $re, $rt) = @_;
$le->bind('<Return>' => [sub {
my($le, $lt, $re, $rt) = @_;
$rt->tagConfigure(qw/blue -underline 1/);
my $input = $le->get . "\n";
$le->delete(0, 'end');
$lt->insert('end' => $input);
$rt->insert('end' => $input, 'blue');
}, $lt, $re, $rt]);
}
__END__
=head1 NAME
tkphone - Phone another X Display and have a line-mode conversation.
=head1 SYNOPSIS
B<tkphone> [I<display>]
=head1 DESCRIPTION
This program opens two MainWindows and arranges callbacks so they can
talk to each other. It expects a single command line argument, the
remote
DISPLAY
specification
(defaults to :0 so you can phone yourself).
=head1 COPYRIGHT
Copyright (C) 1999 - 2000 ACME Rocket Supply, Inc. All rights reserved.
This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
|