view release on metacpan or  search on metacpan

Multi/Frame.pm  view on Meta::CPAN

# Copyright (c) 1997-1998 Dominique Dumont. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Tk::Multi::Frame ;

use strict;

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

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

$VERSION = sprintf "%d.%03d", q$Revision: 1.4 $ =~ /(\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('MultiFrame');

# 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::Frame;

    $cw->{_printCmdRef} = \$printCmd ;

    my $title = $cw ->{'title'} = delete $args->{'-title'} || 'anonymous';
    $args->{-label} = [ -text => $title ]; # for TFrame;
    $cw->{printSub} = delete $args->{-print};

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

    $menu->command(-label=>'print...', -command => [$cw, 'print' ]) 
      if defined $cw->{printSub};

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

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

    $cw -> bind('<Button-3>', $subref);

    $cw->ConfigSpecs(
                     '-borderwidth' => [$cw, undef, undef, 2 ],
                     -relief => [$cw, undef, undef,'groove'],
                     'DEFAULT' => [$cw]
                    ) ;

    $cw->Delegates('-command' => $menu, 
                   DEFAULT => $cw) ;

    $cw->SUPER::Populate($args);
  }

sub resetPrintCmd
  {
    my $cw=shift ;
    $printCmd=$defaultPrintCmd ;