diff options
Diffstat (limited to 'Master/tlpkg/tlperl.old/lib/Tk/Panedwindow.pm')
-rw-r--r-- | Master/tlpkg/tlperl.old/lib/Tk/Panedwindow.pm | 221 |
1 files changed, 0 insertions, 221 deletions
diff --git a/Master/tlpkg/tlperl.old/lib/Tk/Panedwindow.pm b/Master/tlpkg/tlperl.old/lib/Tk/Panedwindow.pm deleted file mode 100644 index d984b648897..00000000000 --- a/Master/tlpkg/tlperl.old/lib/Tk/Panedwindow.pm +++ /dev/null @@ -1,221 +0,0 @@ -package Tk::Panedwindow; -use strict; - -use vars qw/$VERSION/; -$VERSION = sprintf '4.%03d', q$Revision: #3 $ =~ /#(\d+)/; - -# A Panedwindow widget (similar to Adjuster). - -use Tk qw/Ev/; -use base qw/Tk::Widget/; - -Construct Tk::Widget 'Panedwindow'; - -sub Tk_cmd { \&Tk::panedwindow } - -Tk::Methods('add', 'forget', 'identify', 'proxy', 'sash', 'panes'); - -use Tk::Submethods ( - 'proxy' => [qw/coord forget place/], - 'sash' => [qw/coord mark place/], -); - -sub ClassInit { - - my ($class,$mw) = @_; - - $class->SUPER::ClassInit($mw); - - $mw->bind($class, '<Button-1>' => ['MarkSash' => Ev('x'), Ev('y'), 1]); - $mw->bind($class, '<Button-2>' => ['MarkSash' => Ev('x'), Ev('y'), 0]); - $mw->bind($class, '<B1-Motion>' => ['DragSash' => Ev('x'), Ev('y'), 1]); - $mw->bind($class, '<B2-Motion>' => ['DragSash' => Ev('x'), Ev('y'), 0]); - $mw->bind($class, '<ButtonRelease-1>' => ['ReleaseSash' => 1]); - $mw->bind($class, '<ButtonRelease-2>' => ['ReleaseSash' => 0]); - $mw->bind($class, '<Motion>' => ['Motion' => Ev('x'), Ev('y')]); - $mw->bind($class, '<Leave>' => ['Leave']); - - return $class; - -} # end ClassInit - -sub MarkSash { - - # MarkSash - # - # Handle marking the correct sash for possible dragging - # - # Arguments: - # w the widget - # x widget local x coord - # y widget local y coord - # proxy whether this should be a proxy sash - # Results: - # None - - my ($w, $x, $y, $proxy) = @_; - - my @what = $w->identify($x, $y); - if ( @what == 2 ) { - my ($index, $which) = @what[0 .. 1]; - if (not $Tk::strictMotif or $which eq 'handle') { - $w->sashMark($index, $x, $y) if not $proxy; - $w->{_sash} = $index; - my ($sx, $sy) = $w->sashCoord($index); - $w->{_dx} = $sx - $x; - $w->{_dy} = $sy - $y; - } - } - -} # end MarkSash - -sub DragSash { - - # DragSash - # - # Handle dragging of the correct sash - # - # Arguments: - # w the widget - # x widget local x coord - # y widget local y coord - # proxy whether this should be a proxy sash - # Results: - # Moves sash - - my ($w, $x, $y, $proxy) = @_; - - if ( exists $w->{_sash} ) { - if ($proxy) { - $w->proxyPlace($x + $w->{_dx}, $y + $w->{_dy}); - } else { - $w->sashPlace($w->{_sash}, $x + $w->{_dx}, $y + $w->{_dy}); - } - } - -} # end DragSash - -sub ReleaseSash { - - # ReleaseSash - # - # Handle releasing of the sash - # - # Arguments: - # w the widget - # proxy whether this should be a proxy sash - # Results: - # Returns ... - - my ($w, $proxy) = @_; - - if ( exists $w->{_sash} ) { - if ($proxy) { - my ($x, $y) = $w->proxyCoord; - $w->sashPlace($w->{_sash}, $x, $y); - $w->proxyForget; - } - delete $w->{'_sash', '_dx', '_dy'}; - } - -} # end ReleaseSash - -sub Motion { - - # Motion - # - # Handle motion on the widget. This is used to change the cursor - # when the user moves over the sash area. - # - # Arguments: - # w the widget - # x widget local x coord - # y widget local y coord - # Results: - # May change the cursor. Sets up a timer to verify that we are still - # over the widget. - - my ($w, $x, $y) = @_; - - my @id = $w->identify($x, $y); - if ( (@id == 2) and - (not $Tk::strictMotif or $id[1] eq 'handle') ) { - if ( not exists $w->{_panecursor} ) { - $w->{_panecursor} = $w->cget(-cursor); - if ( not defined $w->cget(-sashcursor) ) { - if ( $w->cget(-orient) eq 'horizontal' ) { - $w->configure(-cursor => 'sb_h_double_arrow'); - } else { - $w->configure(-cursor => 'sb_v_double_arrow'); - } - } else { - $w->configure(-cursor => $w->cget(-sashcursor)); - } - if ( exists $w->{_pwAfterId} ) { - $w->afterCancel($w->{_pwAfterId}); - } - $w->{_pwAfterId} = $w->after(150 => ['Cursor' => $w]); - } - return - } - if ( exists $w->{_panecursor} ) { - $w->configure(-cursor => $w->{_panecursor}); - delete $w->{_panecursor}; - } - -} # end Motion - -sub Cursor { - - # Cursor - # - # Handles returning the normal cursor when we are no longer over the - # sash area. This needs to be done this way, because the panedwindow - # won't see Leave events when the mouse moves from the sash to a - # paned child, although the child does receive an Enter event. - # - # Arguments: - # w the widget - # Results: - # May restore the default cursor, or schedule a timer to do it. - - my ($w) = @_; - - if ( exists $w->{_panecursor} ) { - if ( $w->containing($w->pointerx, $w->pointery) == $w ) { - $w->{_pwAfterId} = $w->after(150 => ['Cursor' => $w]); - } else { - $w->configure(-cursor => $w->{_panecursor}); - delete $w->{_panecursor}; - if ( exists $w->{_pwAfterId} ) { - $w->afterCancel($w->{_pwAfterId}); - delete $w->{_pwAfterId}; - } - } - } - -} # end Cursor - -sub Leave { - - # Leave - # - # Return to default cursor when leaving the pw widget. - # - # Arguments: - # w the widget - # Results: - # Restores the default cursor - - my ($w) = @_; - - if ( exists $w->{_panecursor} ) { - $w->configure(-cursor => $w->{_panecursor}); - delete $w->{_panecursor}; - } - -} # end Leave - - -1; -__END__ |