[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / Pane.pm

# Tk::Pane.pm
#
# Copyright (c) 1997-1998 Graham Barr <gbarr@pobox.com>. 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::Pane;

use vars qw($VERSION);
$VERSION = '3.008'; # $Id: //depot/Tk8/Tk/Pane.pm#8 $

use Tk;
use Tk::Widget;
use Tk::Derived;
use Tk::Frame;

use strict;

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

Construct Tk::Widget 'Pane';

sub ClassInit {
    my ($class,$mw) = @_;
    $mw->bind($class,'<Configure>',['QueueLayout',4]);
    $mw->bind($class,'<FocusIn>',  'NoOp');
    return $class;
}

sub Populate {
    my $pan = shift;

    my $frame    = $pan->Component(Frame => "frame");

    $pan->afterIdle(['Manage',$pan,$frame]);
    $pan->afterIdle(['QueueLayout',$pan,1]);

    $pan->Delegates(
	DEFAULT => $frame,
	# FIXME
	# These are a hack to avoid an existing bug in Tk::Widget::DelegateFor
	# which has been reported and should be fixed in the next Tk release
	see	=> $pan,
	xview	=> $pan,
	yview	=> $pan,
    );

    $pan->ConfigSpecs(
	DEFAULT		=> [$frame],
	-sticky		=> [PASSIVE	=> undef, undef, undef],
	-gridded	=> [PASSIVE	=> undef, undef, undef],
	-xscrollcommand => [CALLBACK	=> undef, undef, undef],
	-yscrollcommand => [CALLBACK	=> undef, undef, undef],
    );


    $pan;
}


sub grid {
    my $w = shift;
    $w = $w->Subwidget('frame')
	if (@_ && $_[0] =~ /^(?: bbox
				|columnconfigure
				|location
				|propagate
				|rowconfigure
				|size
				|slaves)$/x);
    $w->SUPER::grid(@_);
}

sub slave {
    my $w = shift;
    $w->Subwidget('frame');
}

sub pack {
    my $w = shift;
    $w = $w->Subwidget('frame')
	if (@_ && $_[0] =~ /^(?:propagate|slaves)$/x);
    $w->SUPER::pack(@_);
}

sub QueueLayout {
    shift if ref $_[1];
    my($m,$why) = @_;
    $m->afterIdle(['Layout',$m]) unless ($m->{LayoutPending});
    $m->{LayoutPending} |= $why;
}

sub AdjustXY {
    my($w,$Wref,$X,$st,$scrl,$getx) = @_;
    my $W = $$Wref;

    if($w >= $W) {
	my $v = 0;
	if($getx) {
	    $v |= 1 if $st =~ /[Ww]/;
	    $v |= 2 if $st =~ /[Ee]/;
	}
	else {
	    $v |= 1 if $st =~ /[Nn]/;
	    $v |= 2 if $st =~ /[Ss]/;
	}

	if($v == 0) {
	    $X = int(($w - $W) / 2);
	}
	elsif($v == 1) {
	    $X = 0;
	}
	elsif($v == 2) {
	    $X = int($w - $W);
	}
	else {
	    $X = 0;
	    $$Wref = $w;
	}
	$scrl->Call(0,1)
	    if $scrl;
    }
    elsif($scrl) {
	$X = 0
	    if $X > 0;
	$X = $w - $W
	    if(($X + $W) < $w);
	$scrl->Call(-$X / $W,(-$X + $w) / $W);
    }
    else {
	$X = 0;
	$$Wref = $w;
    }

    return $X;
}

sub Layout {
    my $pan = shift;
    my $why = $pan->{LayoutPending};

    my $slv = $pan->Subwidget('frame');

    return unless $slv;

    my $H = $slv->ReqHeight;
    my $W = $slv->ReqWidth;
    my $X = $slv->x;
    my $Y = $slv->y;
    my $w = $pan->width;
    my $h = $pan->height;
    my $yscrl = $pan->{Configure}{'-yscrollcommand'};
    my $xscrl = $pan->{Configure}{'-xscrollcommand'};

    $yscrl = undef
	if(defined($yscrl) && UNIVERSAL::isa($yscrl, 'SCALAR') && !defined($$yscrl));
    $xscrl = undef
	if(defined($xscrl) && UNIVERSAL::isa($xscrl, 'SCALAR') && !defined($$xscrl));

    if($why & 1) {
	$h = $pan->{Configure}{'-height'} || 0
	    unless($h > 1);
	$w = $pan->{Configure}{'-width'} || 0
	    unless($w > 1);

	$h = $H
	    unless($h > 1 || defined($yscrl));
	$w = $W
	    unless($w > 1 || defined($xscrl));

	$w = 100 if $w <= 1;
	$h = 100 if $h <= 1;

	$pan->GeometryRequest($w,$h);
    }

    my $st = $pan->{Configure}{'-sticky'} || '';

    $pan->{LayoutPending} = 0;

    $slv->MoveResizeWindow(
	AdjustXY($w,\$W,$X,$st,$xscrl,1),
	AdjustXY($h,\$H,$Y,$st,$yscrl,0),
	$W,$H
    );
}

sub SlaveGeometryRequest {
    my ($m,$s) = @_;
    $m->QueueLayout(1);
}

sub LostSlave {
    my($m,$s) = @_;
    $m->{Slave} = undef;
}

sub Manage {
    my $m = shift;
    my $s = shift;

    $m->{Slave} = $s;
    $m->ManageGeometry($s);
    $s->MapWindow;
    $m->QueueLayout(2);
}

sub xview {
    my $pan = shift;

    unless(@_) {
    	my $scrl = $pan->{Configure}{'-xscrollcommand'};
	return (0,1) unless $scrl;
	my $slv = $pan->Subwidget('frame');
	my $sw  = $slv->ReqWidth;
	my $ldx = $pan->rootx - $slv->rootx;
	my $rdx = $ldx + $pan->width;
	$ldx = $ldx <= 0   ? 0 : $ldx / $sw;
	$rdx = $rdx >= $sw ? 1 : $rdx / $sw;
	return( $ldx , $rdx);
    }
    elsif(@_ == 1) {
	my $widget = shift;
	my $slv = $pan->Subwidget('frame');
	xyview(1,$pan,
		moveto => ($widget->rootx - $slv->rootx) / $slv->ReqWidth);
    }
    else {
	xyview(1,$pan,@_);
    }
}

sub yview {
    my $pan = shift;

    unless(@_) {
	my $scrl = $pan->{Configure}{'-yscrollcommand'};
	return (0,1) unless $scrl;
	my $slv = $pan->Subwidget('frame');
	my $sh  = $slv->ReqHeight;
	my $tdy = $pan->rooty - $slv->rooty;
	my $bdy = $tdy + $pan->height;
	$tdy = $tdy <= 0   ? 0 : $tdy / $sh;
	$bdy = $bdy >= $sh ? 1 : $bdy / $sh;
	return( $tdy, $bdy);
    }
    elsif(@_ == 1) {
	my $widget = shift;
	my $slv = $pan->Subwidget('frame');
	xyview(0,$pan,
		moveto => ($widget->rooty - $slv->rooty) / $slv->ReqHeight);
    }
    else {
	xyview(0,$pan,@_);
    }
}

sub xyview {
    my($horz,$pan,$cmd,$val,$mul) = @_;
    my $slv = $pan->Subwidget('frame');
    return unless $slv;

    my($XY,$WH,$wh,$scrl,@a);

    if($horz) {
	$XY   = $slv->x;
	$WH   = $slv->ReqWidth;
	$wh   = $pan->width;
	$scrl = $pan->{Configure}{'-xscrollcommand'};
    }
    else {
	$XY   = $slv->y;
	$WH   = $slv->ReqHeight;
	$wh   = $pan->height;
	$scrl = $pan->{Configure}{'-yscrollcommand'};
    }

    $scrl = undef
	if(UNIVERSAL::isa($scrl, 'SCALAR') && !defined($$scrl));

    if($WH < $wh) {
	$scrl->Call(0,1);
	return;
    }

    if($cmd eq 'scroll') {
	my $dxy = 0;

	my $gridded = $pan->{Configure}{'-gridded'} || '';
	my $do_gridded = ($gridded eq 'both'
				|| (!$horz == ($gridded ne 'x'))) ? 1 : 0;

	if($do_gridded && $mul eq 'pages') {
	    my $ch = ($slv->children)[0];
	    if(defined($ch) && $ch->manager eq 'grid') {
		@a = $horz
			? (1-$XY,int($slv->width / 2))
			: (int($slv->height / 2),1-$XY);
		my $rc = ($slv->gridLocation(@a))[$horz ? 0 : 1];
		my $mrc = ($slv->gridSize)[$horz ? 0 : 1];
		$rc += $val;
		$rc = 0 if $rc < 0;
		$rc = $mrc if $rc > $mrc;
		my $gsl;
		while($rc >= 0 && $rc < $mrc) {
		    $gsl = ($slv->gridSlaves(-row => $rc))[0];
		    last
			if defined $gsl;
		    $rc += $val;
		}
		if(defined $gsl) {
		    @a = $horz ? ($rc,0) : (0,$rc);
		    $XY = 0 - ($slv->gridBbox(@a))[$horz ? 0 : 1];
		}
		else {
		    $XY = $val > 0 ? $wh - $WH : 0;
		}
		$dxy = $val; $val = 0;
	    }
	}
	$dxy = $mul eq 'pages' ? ($horz ? $pan->width : $pan->height) : 10
	    unless $dxy;
	$XY -= $dxy * $val;
    }
    elsif($cmd eq 'moveto') {
	$XY = -int($WH * $val);
    }

    $XY = $wh - $WH
	if($XY < ($wh - $WH));
    $XY = 0
	if $XY > 0;

    @a = $horz
	? ( $XY, $slv->y)
	: ($slv->x, $XY);

    $slv->MoveWindow(@a);

    $scrl->Call(-$XY / $WH,(-$XY + $wh) / $WH);
}

sub see {
    my $pan = shift;
    my $widget = shift;
    my %opt = @_;
    my $slv = $pan->Subwidget('frame');

    my $anchor = defined $opt{'-anchor'} ? $opt{'-anchor'} : "";
    
    if($pan->{Configure}{'-yscrollcommand'}) {
	my $yanchor = lc(($anchor =~ /([NnSs]?)/)[0] || "");
	my $pty = $pan->rooty;
	my $ph  = $pan->height;
	my $pby = $pty + $ph;
	my $ty  = $widget->rooty;
	my $wh  = $widget->height;
	my $by  = $ty + $wh;
	my $h   = $slv->ReqHeight;

	if($yanchor eq 'n' || ($yanchor ne 's' && ($wh >= $h || $ty < $pty))) {
	    my $y = $ty - $slv->rooty;
	    $pan->yview(moveto => $y / $h);
	}
	elsif($yanchor eq 's' || $by > $pby) {
	    my $y = $by - $ph - $slv->rooty;
	    $pan->yview(moveto => $y / $h);
	}
    }

    if($pan->{Configure}{'-xscrollcommand'}) {
	my $xanchor = lc(($anchor =~ /([WwEe]?)/)[0] || "");
	my $ptx = $pan->rootx;
	my $pw  = $pan->width;
	my $pbx = $ptx + $pw;
	my $tx  = $widget->rootx;
	my $ww  = $widget->width;
	my $bx  = $tx + $ww;
	my $w   = $slv->ReqWidth;

	if($xanchor eq 'w' || ( $xanchor ne 'e' && ($ww >= $w || $tx < $ptx))) {
	    my $x = $tx - $slv->rootx;
	    $pan->xview(moveto => $x / $w);
	}
	elsif($xanchor eq 'e' || $bx > $pbx) {
	    my $x = $bx - $pw - $slv->rootx;
	    $pan->xview(moveto => $x / $w);
	}
    }
}

1;

__END__

=head1 NAME

Tk::Pane - A window panner

=for category Derived Widgets

=head1 SYNOPSIS

    use Tk::Pane;
    
    $pane = $mw->Scrolled(Pane, Name => 'fred',
	-scrollbars => 'soe',
	-sticky => 'we',
	-gridded => 'y'
    );

    $pane->Frame;

    $pane->pack;

=head1 DESCRIPTION

B<Tk::Pane> provides a scrollable frame widget. Once created it can be
treated as a frame, except it is scrollable.

=head1 OPTIONS

=over 4

=item B<-gridded> =E<gt> I<direction>

Specifies if the top and left edges of the pane should snap to a
grid column. This option is only useful if the widgets in the pane
are managed by the I<grid> geometry manager. Possible values are
B<x>, B<y> and B<xy>.

=item B<-sticky> =E<gt> I<style>

If Pane is larger than its requested dimensions, this option may be used to
position (or stretch) the slave within its cavity. I<Style> is a string that
contains zero or more of the characters n, s, e or w. The string can optionally
contains spaces or commas, but they are ignored. Each letter refers to a side
(north, south, east, or west) that the slave will "stick" to. If both n and s
(or e and w) are specified, the slave will be stretched to fill the entire
height (or width) of its cavity. 

=back

=head1 METHODS

=over 4

=item I<$pane>-E<gt>B<see>(I<$widget> ?,I<options>?)

Adjusts the view so that I<$widget> is visable. Aditional parameters in
I<options-value> pairs can be passed, each I<option-value> pair must be
one of the following

=over 8

=item B<-anchor> =E<gt> I<anchor>

Specifies how to make the widget visable. If not given then as much of
the widget as possible is made visable.

Possible values are B<n>, B<s>, B<w>, B<e>, B<nw>, B<ne>, B<sw> and B<se>.
This will cause an edge on the widget to be aligned with the corresponding
edge on the pane. for example B<nw> will cause the top left of the widget
to be placed at the top left of the pane. B<s> will cause the bottom of the
widget to be placed at the bottom of the pane, and as much of the widget
as possible made visable in the x direction.

=back

=item I<$pane>-E<gt>B<xview>

Returns a list containing two elements, both of which are real fractions
between 0 and 1. The first element gives the position of  the left of the
window, relative to the Pane as a whole (0.5 means it is halfway through the
Pane, for example). The second element gives the position of the right of the
window, relative to the Pane as a whole.

=item I<$pane>-E<gt>B<xview>(I<$widget>)

Adjusts the view in the window so that I<widget> is displayed at the left of
the window. 

=item I<$pane>-E<gt>B<xview>(B<moveto> =E<gt> I<fraction>)

Adjusts the view in the window so that I<fraction> of the total width of the
Pane is off-screen to the left. fraction must be a fraction between 0 and 1.

=item I<$pane>-E<gt>B<xview>(B<scroll> =E<gt> I<number>, I<what>)

This command shifts the view in the window left or right according to I<number>
and I<what>. I<Number> must be an integer. I<What> must be either B<units> or
B<pages> or an abbreviation of one of these. If I<what> is B<units>, the view
adjusts left or right by I<number>*10 screen units on the display; if it is
B<pages> then the view adjusts by number screenfuls. If number is negative then
widgets farther to the left become visible; if it is positive then widgets
farther to the right become visible. 

=item I<$pane>-E<gt>B<yview>

Returns a list containing two elements, both of which are real fractions
between 0 and 1. The first element gives the position of  the top of the
window, relative to the Pane as a whole (0.5 means it is halfway through the
Pane, for example). The second element gives the position of the bottom of the
window, relative to the Pane as a whole.

=item I<$pane>-E<gt>B<yview>(I<$widget>)

Adjusts the view in the window so that I<widget> is displayed at the top of the
window. 

=item I<$pane>-E<gt>B<yview>(B<moveto> =E<gt> I<fraction>)

Adjusts the view in the window so that I<fraction> of the total width of the
Pane is off-screen to the top. fraction must be a fraction between 0 and 1.

=item I<$pane>-E<gt>B<yview>(B<scroll> =E<gt> I<number>, I<what>)

This command shifts the view in the window up or down according to I<number>
and I<what>. I<Number> must be an integer. I<What> must be either B<units> or
B<pages> or an abbreviation of one of these. If I<what> is B<units>, the view
adjusts up or down by I<number>*10 screen units on the display; if it is
B<pages> then the view adjusts by number screenfuls. If number is negative then
widgets farther up become visible; if it is positive then widgets farther down
become visible. 

=back

=head1 AUTHOR

Graham Barr E<lt>F<gbarr@pobox.com>E<gt>

=head1 COPYRIGHT

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

=cut
Commit	Line	Data
86530b38 AT	1	# Tk::Pane.pm
	2	#
	3	# Copyright (c) 1997-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
	4	# This program is free software; you can redistribute it and/or
	5	# modify it under the same terms as Perl itself.
	6
	7	package Tk::Pane;
	8
	9	use vars qw($VERSION);
	10	$VERSION = '3.008'; # $Id: //depot/Tk8/Tk/Pane.pm#8 $
	11
	12	use Tk;
	13	use Tk::Widget;
	14	use Tk::Derived;
	15	use Tk::Frame;
	16
	17	use strict;
	18
	19	use base qw(Tk::Derived Tk::Frame);
	20
	21	Construct Tk::Widget 'Pane';
	22
	23	sub ClassInit {
	24	my ($class,$mw) = @_;
	25	$mw->bind($class,'<Configure>',['QueueLayout',4]);
	26	$mw->bind($class,'<FocusIn>', 'NoOp');
	27	return $class;
	28	}
	29
	30	sub Populate {
	31	my $pan = shift;
	32
	33	my $frame = $pan->Component(Frame => "frame");
	34
	35	$pan->afterIdle(['Manage',$pan,$frame]);
	36	$pan->afterIdle(['QueueLayout',$pan,1]);
	37
	38	$pan->Delegates(
	39	DEFAULT => $frame,
	40	# FIXME
	41	# These are a hack to avoid an existing bug in Tk::Widget::DelegateFor
	42	# which has been reported and should be fixed in the next Tk release
	43	see => $pan,
	44	xview => $pan,
	45	yview => $pan,
	46	);
	47
	48	$pan->ConfigSpecs(
	49	DEFAULT => [$frame],
	50	-sticky => [PASSIVE => undef, undef, undef],
	51	-gridded => [PASSIVE => undef, undef, undef],
	52	-xscrollcommand => [CALLBACK => undef, undef, undef],
	53	-yscrollcommand => [CALLBACK => undef, undef, undef],
	54	);
	55
	56
	57	$pan;
	58	}
	59
	60
	61	sub grid {
	62	my $w = shift;
	63	$w = $w->Subwidget('frame')
	64	if (@_ && $_[0] =~ /^(?: bbox
65	\|columnconfigure
66	\|location
67	\|propagate
68	\|rowconfigure
69	\|size
70	\|slaves)$/x);
71	$w->SUPER::grid(@_);
72	}
73
74	sub slave {
75	my $w = shift;
76	$w->Subwidget('frame');
77	}
78
79	sub pack {
80	my $w = shift;
81	$w = $w->Subwidget('frame')
82	if (@_ && $_[0] =~ /^(?:propagate\|slaves)$/x);
83	$w->SUPER::pack(@_);
84	}
85
86	sub QueueLayout {
87	shift if ref $_[1];
88	my($m,$why) = @_;
89	$m->afterIdle(['Layout',$m]) unless ($m->{LayoutPending});
90	$m->{LayoutPending} \|= $why;
91	}
92
93	sub AdjustXY {
94	my($w,$Wref,$X,$st,$scrl,$getx) = @_;
95	my $W = $$Wref;
96
97	if($w >= $W) {
98	my $v = 0;
99	if($getx) {
100	$v \|= 1 if $st =~ /[Ww]/;
101	$v \|= 2 if $st =~ /[Ee]/;
102	}
103	else {
104	$v \|= 1 if $st =~ /[Nn]/;
105	$v \|= 2 if $st =~ /[Ss]/;
106	}
107
108	if($v == 0) {
109	$X = int(($w - $W) / 2);
110	}
111	elsif($v == 1) {
112	$X = 0;
113	}
114	elsif($v == 2) {
115	$X = int($w - $W);
116	}
117	else {
118	$X = 0;
119	$$Wref = $w;
120	}
121	$scrl->Call(0,1)
122	if $scrl;
123	}
124	elsif($scrl) {
125	$X = 0
126	if $X > 0;
127	$X = $w - $W
128	if(($X + $W) < $w);
129	$scrl->Call(-$X / $W,(-$X + $w) / $W);
130	}
131	else {
132	$X = 0;
133	$$Wref = $w;
134	}
135
136	return $X;
137	}
138
139	sub Layout {
140	my $pan = shift;
141	my $why = $pan->{LayoutPending};
142
143	my $slv = $pan->Subwidget('frame');
144
145	return unless $slv;
146
147	my $H = $slv->ReqHeight;
148	my $W = $slv->ReqWidth;
149	my $X = $slv->x;
150	my $Y = $slv->y;
151	my $w = $pan->width;
152	my $h = $pan->height;
153	my $yscrl = $pan->{Configure}{'-yscrollcommand'};
154	my $xscrl = $pan->{Configure}{'-xscrollcommand'};
155
156	$yscrl = undef
157	if(defined($yscrl) && UNIVERSAL::isa($yscrl, 'SCALAR') && !defined($$yscrl));
158	$xscrl = undef
159	if(defined($xscrl) && UNIVERSAL::isa($xscrl, 'SCALAR') && !defined($$xscrl));
160
161	if($why & 1) {
162	$h = $pan->{Configure}{'-height'} \|\| 0
163	unless($h > 1);
164	$w = $pan->{Configure}{'-width'} \|\| 0
165	unless($w > 1);
166
167	$h = $H
168	unless($h > 1 \|\| defined($yscrl));
169	$w = $W
170	unless($w > 1 \|\| defined($xscrl));
171
172	$w = 100 if $w <= 1;
173	$h = 100 if $h <= 1;
174
175	$pan->GeometryRequest($w,$h);
176	}
177
178	my $st = $pan->{Configure}{'-sticky'} \|\| '';
179
180	$pan->{LayoutPending} = 0;
181
182	$slv->MoveResizeWindow(
183	AdjustXY($w,\$W,$X,$st,$xscrl,1),
184	AdjustXY($h,\$H,$Y,$st,$yscrl,0),
185	$W,$H
186	);
187	}
188
189	sub SlaveGeometryRequest {
190	my ($m,$s) = @_;
191	$m->QueueLayout(1);
192	}
193
194	sub LostSlave {
195	my($m,$s) = @_;
196	$m->{Slave} = undef;
197	}
198
199	sub Manage {
200	my $m = shift;
201	my $s = shift;
202
203	$m->{Slave} = $s;
204	$m->ManageGeometry($s);
205	$s->MapWindow;
206	$m->QueueLayout(2);
207	}
208
209	sub xview {
210	my $pan = shift;
211
212	unless(@_) {
213	my $scrl = $pan->{Configure}{'-xscrollcommand'};
214	return (0,1) unless $scrl;
215	my $slv = $pan->Subwidget('frame');
216	my $sw = $slv->ReqWidth;
217	my $ldx = $pan->rootx - $slv->rootx;
218	my $rdx = $ldx + $pan->width;
219	$ldx = $ldx <= 0 ? 0 : $ldx / $sw;
220	$rdx = $rdx >= $sw ? 1 : $rdx / $sw;
221	return( $ldx , $rdx);
222	}
223	elsif(@_ == 1) {
224	my $widget = shift;
225	my $slv = $pan->Subwidget('frame');
226	xyview(1,$pan,
227	moveto => ($widget->rootx - $slv->rootx) / $slv->ReqWidth);
228	}
229	else {
230	xyview(1,$pan,@_);
231	}
232	}
233
234	sub yview {
235	my $pan = shift;
236
237	unless(@_) {
238	my $scrl = $pan->{Configure}{'-yscrollcommand'};
239	return (0,1) unless $scrl;
240	my $slv = $pan->Subwidget('frame');
241	my $sh = $slv->ReqHeight;
242	my $tdy = $pan->rooty - $slv->rooty;
243	my $bdy = $tdy + $pan->height;
244	$tdy = $tdy <= 0 ? 0 : $tdy / $sh;
245	$bdy = $bdy >= $sh ? 1 : $bdy / $sh;
246	return( $tdy, $bdy);
247	}
248	elsif(@_ == 1) {
249	my $widget = shift;
250	my $slv = $pan->Subwidget('frame');
251	xyview(0,$pan,
252	moveto => ($widget->rooty - $slv->rooty) / $slv->ReqHeight);
253	}
254	else {
255	xyview(0,$pan,@_);
256	}
257	}
258
259	sub xyview {
260	my($horz,$pan,$cmd,$val,$mul) = @_;
261	my $slv = $pan->Subwidget('frame');
262	return unless $slv;
263
264	my($XY,$WH,$wh,$scrl,@a);
265
266	if($horz) {
267	$XY = $slv->x;
268	$WH = $slv->ReqWidth;
269	$wh = $pan->width;
270	$scrl = $pan->{Configure}{'-xscrollcommand'};
271	}
272	else {
273	$XY = $slv->y;
274	$WH = $slv->ReqHeight;
275	$wh = $pan->height;
276	$scrl = $pan->{Configure}{'-yscrollcommand'};
277	}
278
279	$scrl = undef
280	if(UNIVERSAL::isa($scrl, 'SCALAR') && !defined($$scrl));
281
282	if($WH < $wh) {
283	$scrl->Call(0,1);
284	return;
285	}
286
287	if($cmd eq 'scroll') {
288	my $dxy = 0;
289
290	my $gridded = $pan->{Configure}{'-gridded'} \|\| '';
291	my $do_gridded = ($gridded eq 'both'
292	\|\| (!$horz == ($gridded ne 'x'))) ? 1 : 0;
293
294	if($do_gridded && $mul eq 'pages') {
295	my $ch = ($slv->children)[0];
296	if(defined($ch) && $ch->manager eq 'grid') {
297	@a = $horz
298	? (1-$XY,int($slv->width / 2))
299	: (int($slv->height / 2),1-$XY);
300	my $rc = ($slv->gridLocation(@a))[$horz ? 0 : 1];
301	my $mrc = ($slv->gridSize)[$horz ? 0 : 1];
302	$rc += $val;
303	$rc = 0 if $rc < 0;
304	$rc = $mrc if $rc > $mrc;
305	my $gsl;
306	while($rc >= 0 && $rc < $mrc) {
307	$gsl = ($slv->gridSlaves(-row => $rc))[0];
308	last
309	if defined $gsl;
310	$rc += $val;
311	}
312	if(defined $gsl) {
313	@a = $horz ? ($rc,0) : (0,$rc);
314	$XY = 0 - ($slv->gridBbox(@a))[$horz ? 0 : 1];
315	}
316	else {
317	$XY = $val > 0 ? $wh - $WH : 0;
318	}
319	$dxy = $val; $val = 0;
320	}
321	}
322	$dxy = $mul eq 'pages' ? ($horz ? $pan->width : $pan->height) : 10
323	unless $dxy;
324	$XY -= $dxy * $val;
325	}
326	elsif($cmd eq 'moveto') {
327	$XY = -int($WH * $val);
328	}
329
330	$XY = $wh - $WH
331	if($XY < ($wh - $WH));
332	$XY = 0
333	if $XY > 0;
334
335	@a = $horz
336	? ( $XY, $slv->y)
337	: ($slv->x, $XY);
338
339	$slv->MoveWindow(@a);
340
341	$scrl->Call(-$XY / $WH,(-$XY + $wh) / $WH);
342	}
343
344	sub see {
345	my $pan = shift;
346	my $widget = shift;
347	my %opt = @_;
348	my $slv = $pan->Subwidget('frame');
349
350	my $anchor = defined $opt{'-anchor'} ? $opt{'-anchor'} : "";
351
352	if($pan->{Configure}{'-yscrollcommand'}) {
353	my $yanchor = lc(($anchor =~ /([NnSs]?)/)[0] \|\| "");
354	my $pty = $pan->rooty;
355	my $ph = $pan->height;
356	my $pby = $pty + $ph;
357	my $ty = $widget->rooty;
358	my $wh = $widget->height;
359	my $by = $ty + $wh;
360	my $h = $slv->ReqHeight;
361
362	if($yanchor eq 'n' \|\| ($yanchor ne 's' && ($wh >= $h \|\| $ty < $pty))) {
363	my $y = $ty - $slv->rooty;
364	$pan->yview(moveto => $y / $h);
365	}
366	elsif($yanchor eq 's' \|\| $by > $pby) {
367	my $y = $by - $ph - $slv->rooty;
368	$pan->yview(moveto => $y / $h);
369	}
370	}
371
372	if($pan->{Configure}{'-xscrollcommand'}) {
373	my $xanchor = lc(($anchor =~ /([WwEe]?)/)[0] \|\| "");
374	my $ptx = $pan->rootx;
375	my $pw = $pan->width;
376	my $pbx = $ptx + $pw;
377	my $tx = $widget->rootx;
378	my $ww = $widget->width;
379	my $bx = $tx + $ww;
380	my $w = $slv->ReqWidth;
381
382	if($xanchor eq 'w' \|\| ( $xanchor ne 'e' && ($ww >= $w \|\| $tx < $ptx))) {
383	my $x = $tx - $slv->rootx;
384	$pan->xview(moveto => $x / $w);
385	}
386	elsif($xanchor eq 'e' \|\| $bx > $pbx) {
387	my $x = $bx - $pw - $slv->rootx;
388	$pan->xview(moveto => $x / $w);
389	}
390	}
391	}
392
393	1;
394
395	__END__
396
397	=head1 NAME
398
399	Tk::Pane - A window panner
400
401	=for category Derived Widgets
402
403	=head1 SYNOPSIS
404
405	use Tk::Pane;
406
407	$pane = $mw->Scrolled(Pane, Name => 'fred',
408	-scrollbars => 'soe',
409	-sticky => 'we',
410	-gridded => 'y'
411	);
412
413	$pane->Frame;
414
415	$pane->pack;
416
417	=head1 DESCRIPTION
418
419	B<Tk::Pane> provides a scrollable frame widget. Once created it can be
420	treated as a frame, except it is scrollable.
421
422	=head1 OPTIONS
423
424	=over 4
425
426	=item B<-gridded> =E<gt> I<direction>
427
428	Specifies if the top and left edges of the pane should snap to a
429	grid column. This option is only useful if the widgets in the pane
430	are managed by the I<grid> geometry manager. Possible values are
431	B<x>, B<y> and B<xy>.
432
433	=item B<-sticky> =E<gt> I<style>
434
435	If Pane is larger than its requested dimensions, this option may be used to
436	position (or stretch) the slave within its cavity. I<Style> is a string that
437	contains zero or more of the characters n, s, e or w. The string can optionally
438	contains spaces or commas, but they are ignored. Each letter refers to a side
439	(north, south, east, or west) that the slave will "stick" to. If both n and s
440	(or e and w) are specified, the slave will be stretched to fill the entire
441	height (or width) of its cavity.
442
443	=back
444
445	=head1 METHODS
446
447	=over 4
448
449	=item I<$pane>-E<gt>B<see>(I<$widget> ?,I<options>?)
450
451	Adjusts the view so that I<$widget> is visable. Aditional parameters in
452	I<options-value> pairs can be passed, each I<option-value> pair must be
453	one of the following
454
455	=over 8
456
457	=item B<-anchor> =E<gt> I<anchor>
458
459	Specifies how to make the widget visable. If not given then as much of
460	the widget as possible is made visable.
461
462	Possible values are B<n>, B<s>, B<w>, B<e>, B<nw>, B<ne>, B<sw> and B<se>.
463	This will cause an edge on the widget to be aligned with the corresponding
464	edge on the pane. for example B<nw> will cause the top left of the widget
465	to be placed at the top left of the pane. B<s> will cause the bottom of the
466	widget to be placed at the bottom of the pane, and as much of the widget
467	as possible made visable in the x direction.
468
469	=back
470
471	=item I<$pane>-E<gt>B<xview>
472
473	Returns a list containing two elements, both of which are real fractions
474	between 0 and 1. The first element gives the position of the left of the
475	window, relative to the Pane as a whole (0.5 means it is halfway through the
476	Pane, for example). The second element gives the position of the right of the
477	window, relative to the Pane as a whole.
478
479	=item I<$pane>-E<gt>B<xview>(I<$widget>)
480
481	Adjusts the view in the window so that I<widget> is displayed at the left of
482	the window.
483
484	=item I<$pane>-E<gt>B<xview>(B<moveto> =E<gt> I<fraction>)
485
486	Adjusts the view in the window so that I<fraction> of the total width of the
487	Pane is off-screen to the left. fraction must be a fraction between 0 and 1.
488
489	=item I<$pane>-E<gt>B<xview>(B<scroll> =E<gt> I<number>, I<what>)
490
491	This command shifts the view in the window left or right according to I<number>
492	and I<what>. I<Number> must be an integer. I<What> must be either B<units> or
493	B<pages> or an abbreviation of one of these. If I<what> is B<units>, the view
494	adjusts left or right by I<number>*10 screen units on the display; if it is
495	B<pages> then the view adjusts by number screenfuls. If number is negative then
496	widgets farther to the left become visible; if it is positive then widgets
497	farther to the right become visible.
498
499	=item I<$pane>-E<gt>B<yview>
500
501	Returns a list containing two elements, both of which are real fractions
502	between 0 and 1. The first element gives the position of the top of the
503	window, relative to the Pane as a whole (0.5 means it is halfway through the
504	Pane, for example). The second element gives the position of the bottom of the
505	window, relative to the Pane as a whole.
506
507	=item I<$pane>-E<gt>B<yview>(I<$widget>)
508
509	Adjusts the view in the window so that I<widget> is displayed at the top of the
510	window.
511
512	=item I<$pane>-E<gt>B<yview>(B<moveto> =E<gt> I<fraction>)
513
514	Adjusts the view in the window so that I<fraction> of the total width of the
515	Pane is off-screen to the top. fraction must be a fraction between 0 and 1.
516
517	=item I<$pane>-E<gt>B<yview>(B<scroll> =E<gt> I<number>, I<what>)
518
519	This command shifts the view in the window up or down according to I<number>
520	and I<what>. I<Number> must be an integer. I<What> must be either B<units> or
521	B<pages> or an abbreviation of one of these. If I<what> is B<units>, the view
522	adjusts up or down by I<number>*10 screen units on the display; if it is
523	B<pages> then the view adjusts by number screenfuls. If number is negative then
524	widgets farther up become visible; if it is positive then widgets farther down
525	become visible.
526
527	=back
528
529	=head1 AUTHOR
530
531	Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
532
533	=head1 COPYRIGHT
534
535	Copyright (c) 1997-1998 Graham Barr. All rights reserved.
536	This program is free software; you can redistribute it and/or modify it
537	under the same terms as Perl itself.
538
539	=cut