#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('' => [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 [I] =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