tlperl 5.22.1 from siep

git-svn-id: svn://tug.org/texlive/trunk@40252 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 0 insertions, 278 deletions

diff --git a/Master/tlpkg/tlperl/lib/Tk/Scale.pm b/Master/tlpkg/tlperl/lib/Tk/Scale.pm
deleted file mode 100644
index 57c7bb11aa1..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/Scale.pm
+++ /dev/null
@@ -1,278 +0,0 @@
-# Converted from scale.tcl --
-#
-# This file defines the default bindings for Tk scale widgets.
-#
-# @(#) scale.tcl 1.3 94/12/17 16:05:23
-#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
-package Tk::Scale;
-
-use vars qw($VERSION);
-$VERSION = '4.004'; # $Id: //depot/Tkutf8/Scale/Scale.pm#4 $
-
-use Tk qw($XS_VERSION);
-use AutoLoader;
-
-use base  qw(Tk::Widget);
-
-Construct Tk::Widget 'Scale';
-
-bootstrap Tk::Scale;
-
-sub Tk_cmd { \&Tk::scale }
-
-Tk::Methods('coords','get','identify','set');
-
-
-import Tk qw(Ev);
-
-#
-# Bind --
-# This procedure below invoked the first time the mouse enters a
-# scale widget or a scale widget receives the input focus. It creates
-# all of the class bindings for scales.
-#
-# Arguments:
-# event - Indicates which event caused the procedure to be invoked
-# (Enter or FocusIn). It is used so that we can carry out
-# the functions of that event in addition to setting up
-# bindings.
-sub ClassInit
-{
- my ($class,$mw) = @_;
-
- $mw->bind($class,'<Enter>',['Enter',Ev('x'),Ev('y')]);
- $mw->bind($class,'<Motion>',['Activate',Ev('x'),Ev('y')]);
- $mw->bind($class,'<Leave>','Leave');
-
- $mw->bind($class,'<1>',['ButtonDown',Ev('x'),Ev('y')]);
- $mw->bind($class,'<B1-Motion>',['Drag',Ev('x'),Ev('y')]);
- $mw->bind($class,'<B1-Leave>','NoOp');
- $mw->bind($class,'<B1-Enter>','NoOp');
- $mw->bind($class,'<ButtonRelease-1>',['ButtonUp',Ev('x'),Ev('y')]);
-
- $mw->bind($class,'<2>',['ButtonDown',Ev('x'),Ev('y')]);
- $mw->bind($class,'<B2-Motion>',['Drag',Ev('x'),Ev('y')]);
- $mw->bind($class,'<B2-Leave>','NoOp');
- $mw->bind($class,'<B2-Enter>','NoOp');
- $mw->bind($class,'<ButtonRelease-2>',['ButtonUp',Ev('x'),Ev('y')]);
-
- $mw->bind($class,'<Control-1>',['ControlPress',Ev('x'),Ev('y')]);
-
- $mw->bind($class,'<Up>',['Increment','up','little','noRepeat']);
- $mw->bind($class,'<Down>',['Increment','down','little','noRepeat']);
- $mw->bind($class,'<Left>',['Increment','up','little','noRepeat']);
- $mw->bind($class,'<Right>',['Increment','down','little','noRepeat']);
-
- $mw->bind($class,'<Control-Up>',['Increment','up','big','noRepeat']);
- $mw->bind($class,'<Control-Down>',['Increment','down','big','noRepeat']);
- $mw->bind($class,'<Control-Left>',['Increment','up','big','noRepeat']);
- $mw->bind($class,'<Control-Right>',['Increment','down','big','noRepeat']);
-
- $mw->bind($class,'<Home>',['set',Ev('cget','-from')]);
- $mw->bind($class,'<End>',['set',Ev('cget','-to')]);
- return $class;
-}
-
-1;
-
-__END__
-
-# Activate --
-# This procedure is invoked to check a given x-y position in the
-# scale and activate the slider if the x-y position falls within
-# the slider.
-#
-# Arguments:
-# w - The scale widget.
-# x, y - Mouse coordinates.
-sub Activate
-{
- my $w = shift;
- my $x = shift;
- my $y = shift;
- return if ($w->cget('-state') eq 'disabled');
- my $ident = $w->identify($x,$y);
- if (defined($ident) && $ident eq 'slider')
-  {
-   $w->configure(-state => 'active')
-  }
- else
-  {
-   $w->configure(-state => 'normal')
-  }
-}
-
-sub Leave
-{
- my ($w) = @_;
- $w->configure('-activebackground',$w->{'activeBg'}) if ($Tk::strictMotif);
- $w->configure('-state','normal')  if ($w->cget('-state') eq 'active');
-}
-
-sub Enter
-{
- my ($w,$x,$y) = @_;
- if ($Tk::strictMotif)
-  {
-   $w->{'activeBg'} = $w->cget('-activebackground');
-   $w->configure('-activebackground',$w->cget('-background'));
-  }
- $w->Activate($x,$y);
-}
-
-sub ButtonUp
-{
- my ($w,$x,$y) = @_;
- $w->CancelRepeat();
- $w->EndDrag();
- $w->Activate($x,$y)
-}
-
-
-# ButtonDown --
-# This procedure is invoked when a button is pressed in a scale. It
-# takes different actions depending on where the button was pressed.
-#
-# Arguments:
-# w - The scale widget.
-# x, y - Mouse coordinates of button press.
-sub ButtonDown
-{
- my $w = shift;
- my $x = shift;
- my $y = shift;
- $Tk::dragging = 0;
- $el = $w->identify($x,$y);
- return unless ($el);
- if ($el eq 'trough1')
-  {
-   $w->Increment('up','little','initial')
-  }
- elsif ($el eq 'trough2')
-  {
-   $w->Increment('down','little','initial')
-  }
- elsif ($el eq 'slider')
-  {
-   $Tk::dragging = 1;
-   my @coords = $w->coords();
-   $Tk::deltaX = $x-$coords[0];
-   $Tk::deltaY = $y-$coords[1];
-  }
-}
-# Drag --
-# This procedure is called when the mouse is dragged with
-# mouse button 1 down. If the drag started inside the slider
-# (i.e. the scale is active) then the scale's value is adjusted
-# to reflect the mouse's position.
-#
-# Arguments:
-# w - The scale widget.
-# x, y - Mouse coordinates.
-sub Drag
-{
- my $w = shift;
- my $x = shift;
- my $y = shift;
- if (!$Tk::dragging)
-  {
-   return;
-  }
- $w->set($w->get($x-$Tk::deltaX,$y-$Tk::deltaY))
-}
-# EndDrag --
-# This procedure is called to end an interactive drag of the
-# slider.  It just marks the drag as over.
-# Arguments:
-# w - The scale widget.
-sub EndDrag
-{
- my $w = shift;
- if (!$Tk::dragging)
-  {
-   return;
-  }
- $Tk::dragging = 0;
-}
-# Increment --
-# This procedure is invoked to increment the value of a scale and
-# to set up auto-repeating of the action if that is desired. The
-# way the value is incremented depends on the "dir" and "big"
-# arguments.
-#
-# Arguments:
-# w - The scale widget.
-# dir - "up" means move value towards -from, "down" means
-# move towards -to.
-# big - Size of increments: "big" or "little".
-# repeat - Whether and how to auto-repeat the action: "noRepeat"
-# means don't auto-repeat, "initial" means this is the
-# first action in an auto-repeat sequence, and "again"
-# means this is the second repetition or later.
-sub Increment
-{
- my $w = shift;
- my $dir = shift;
- my $big = shift;
- my $repeat = shift;
- my $inc;
- if ($big eq 'big')
-  {
-   $inc = $w->cget('-bigincrement');
-   if ($inc == 0)
-    {
-     $inc = abs(($w->cget('-to')-$w->cget('-from')))/10.0
-    }
-   if ($inc < $w->cget('-resolution'))
-    {
-     $inc = $w->cget('-resolution')
-    }
-  }
- else
-  {
-   $inc = $w->cget('-resolution')
-  }
- if (($w->cget('-from') > $w->cget('-to')) ^ ($dir eq 'up'))
-  {
-   $inc = -$inc
-  }
- $w->set($w->get()+$inc);
- if ($repeat eq 'again')
-  {
-   $w->RepeatId($w->after($w->cget('-repeatinterval'),'Increment',$w,$dir,$big,'again'));
-  }
- elsif ($repeat eq 'initial')
-  {
-   $w->RepeatId($w->after($w->cget('-repeatdelay'),'Increment',$w,$dir,$big,'again'));
-  }
-}
-# ControlPress --
-# This procedure handles button presses that are made with the Control
-# key down. Depending on the mouse position, it adjusts the scale
-# value to one end of the range or the other.
-#
-# Arguments:
-# w - The scale widget.
-# x, y - Mouse coordinates where the button was pressed.
-sub ControlPress
-{
- my ($w,$x,$y) = @_;
- my $el = $w->identify($x,$y);
- return unless ($el);
- if ($el eq 'trough1')
-  {
-   $w->set($w->cget('-from'))
-  }
- elsif ($el eq 'trough2')
-  {
-   $w->set($w->cget('-to'))
-  }
-}
-
-