tkphone - Phone another X Display and have a line-mode conversation : MainWindow « GUI « Perl

1. Perl
2. GUI
3. MainWindow

tkphone - Phone another X Display and have a line-mode conversation

   


#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

   
    
    
  

Related examples in the same category