93 lines
2.3 KiB
Perl
93 lines
2.3 KiB
Perl
|
#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
|