view release on metacpan or  search on metacpan

Multi/Text.pm  view on Meta::CPAN

package Tk::Multi::Text ;

use strict;

use vars qw($printCmd $defaultPrintCmd $VERSION);

use base qw(Tk::Derived Tk::Frame Tk::Multi::Any);

$VERSION = sprintf "%d.%03d", q$Revision: 2.5 $ =~ /(\d+)\.(\d+)/;

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

$printCmd = $defaultPrintCmd = 'lp -ol70 -otl66 -o12 -olm10' ;

Tk::Widget->Construct('MultiText');

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

sub Populate
  {
    my ($cw,$args) = @_ ;
    Tk::Multi::Any::normalize($cw,$args) ;

    require Tk::Label;
    require Tk::ROText;

    $cw->{_printCmdRef} = \$printCmd ;
    my $data = delete $args->{'-data'} ;

    my $title = $cw ->{'title'} = delete $args->{'-title'} || 'anonymous';

    my $menu = delete $args->{'-menu_button'};
    die "Multi window $title: missing menu_button argument\n" 
      unless defined $menu ;

    my $subref = sub {$menu->Popup(-popover => 'cursor', -popanchor => 'nw')};

    #$cw->bind ('<Button-3>', $subref);
    #$slaveWindow->bind ('<Button-3>', $subref);
    #Tk::bind($cw, '<Button-3>', $subref);

    my $titleLabel = $cw->Label(-text => $title.' display')-> pack(qw/-fill x/) ;
    $titleLabel -> bind('<Button-3>', $subref);

    $menu->command(-label=>'print...', -command => [$cw, 'print' ]) ;
    $menu->command(-label=>'clear', -command => [$cw, 'clear' ]);

    # print stuff
    $cw->{_printToFile} = 0;
    $cw->{_printFile} = '';

    my $slaveWindow = $cw -> Scrolled ('ROText')
      -> pack(qw/-fill both -expand 1/) ;

    $cw->Advertise('text' => $slaveWindow) ;

    $cw->ConfigSpecs(
                     '-relief' => [$cw],
                     '-borderwidth' => [$cw],
                     '-scrollbars'=> [$slaveWindow, undef, undef,'osoe'],
                     '-width' => [$slaveWindow, undef, undef, 80],
                     '-height' => [$slaveWindow, undef, undef, 5],
                     'DEFAULT' => [$slaveWindow]