view release on metacpan or search on metacpan
DragDrop/DragDrop.pm view on Meta::CPAN
$token->{'Over'} = $site;
}
$site->Motion($token,$e) if (defined $site)
}
return $site;
}
sub Mapped
{
my ($token) = @_;
my $e = $token->parent->XEvent;
$token = $token->toplevel;
$token->grabGlobal;
$token->focus;
if (defined $e)
{
my $X = $e->X;
my $Y = $e->Y;
$token->MoveToplevelWindow($X+OFFSET,$Y+OFFSET);
$token->NewDrag;
$token->FindSite($X,$Y,$e);
DragDrop/DragDrop/XDNDDrop.pm view on Meta::CPAN
my $token = $site->{token};
# printf "XdndFinished $site\n",
$token->Done;
}
sub XdndStatus
{
my ($site) = @_;
my $token = $site->{token};
my $w = $token->parent;
my $event = $w->XEvent;
my ($tid,$flags,$xy,$wh,$action) = unpack('LLLLL',$event->A);
$action = $w->GetAtomName($action) if $action;
$site->{flags} = $flags;
$site->{'X'} = $xy >> 16;
$site->{'Y'} = $xy & 0xFFFF;
$site->{'width'} = $wh >> 16;
$site->{'height'} = $wh & 0xFFFF;
#printf "XdndStatus $site targ=%x flags=%08X x=%d y=%d w=%d h=%d a=%s\n",
# $tid,$flags,$xy >> 16, $xy & 0xFFFF, $wh >> 16, $wh & 0xFFFF,$action;
if ($flags & 1)
DragDrop/DragDrop/XDNDSite.pm view on Meta::CPAN
Tk::DropSite->Type('XDND');
sub InitSite
{my ($class,$site) = @_;
my $w = $site->widget;
}
sub XdndEnter
{
my ($t,$sites) = @_;
my $event = $t->XEvent;
my ($src,$flags,@types) = unpack('LLLLL',$event->A);
my $ver = ($flags >> 24) & 0xFF;
if ($flags & 1)
{
my @prop;
Tk::catch { @prop = $t->property('get','XdndTypeList',$src) };
@types = @prop if (!$@ && shift(@prop) eq 'ATOM');
}
else
{
$t->MakeAtom(@types);
}
# print "XdndEnter $src $ver @types\n";
$t->{"XDND$src"} = { ver => $ver, types => \@types };
}
sub XdndLeave
{
my ($t,$sites) = @_;
my $event = $t->XEvent;
my ($src,$flags,@types) = unpack('LLLLL',$event->A);
# print "XdndLeave $src\n";
my $info = $t->{"XDND$src"};
if ($info)
{
my $over = $info->{site};
if ($over)
{
my $X = $info->{X};
my $Y = $info->{Y};
$over->Apply(-entercommand => $X, $Y, 0)
}
}
delete $t->{"XDND$src"};
}
sub XdndPosition
{
my ($t,$sites) = @_;
my $event = $t->XEvent;
my ($src,$flags,$xy,$time,$action) = unpack('LLLLL',$event->A);
$t->MakeAtom($action);
my $X = $xy >> 16;
my $Y = $xy & 0xFFFF;
my $info = $t->{"XDND$src"};
$info->{X} = $X;
$info->{Y} = $Y;
$info->{action} = $action;
$info->{t} = $time;
my ($id) = $t->wrapper;
TkToMainWindow(tkwin)
TkToWidget(tkwin,pinterp)
WidgetRef(interp, path)
WindowCommand(sv, hv_ptr)
XS(BindClientMessage)
XS(DoWhenIdle)
XS(FreeAbstract)
XS(ManageGeometry)
XS(SelectionGet)
XS(XEventInfo)
XS(XStoBind)
XS(XStoSubCmd)
XS(XStoTk)
XS(XStoWidget)
do_watch(void)
handle_generic(clientData, eventPtr)
handle_idle(clientData)
SetTclResult(interp,count)
HList/HList.pm view on Meta::CPAN
return $class;
}
sub Control_ButtonRelease_1
{
}
sub ButtonRelease_1
{
my $w = shift;
my $Ev = $w->XEvent;
$w->CancelRepeat
if($w->cget('-selectmode') ne 'dragdrop');
$w->ButtonRelease1($Ev);
}
sub Control_B1_Motion
{
}
sub B1_Enter
{
my $w = shift;
my $Ev = $w->XEvent;
$w->CancelRepeat
if($w->cget('-selectmode') ne 'dragdrop');
}
sub Button1
{
my $w = shift;
my $Ev = $w->XEvent;
delete $w->{'shiftanchor'};
delete $w->{tixindicator};
$w->focus() if($w->cget('-takefocus'));
my $mode = $w->cget('-selectmode');
if ($mode eq 'dragdrop')
{
pTk/mTk/tclUnix/tclConfig.sh.in
pTk/mTk/tclUnix/tclLoadAix.c
pTk/mTk/tclUnix/tclLoadAout.c
pTk/mTk/tclUnix/tclLoadDl.c
pTk/mTk/tclUnix/tclLoadDld.c
pTk/mTk/tclUnix/tclLoadDyld.c
pTk/mTk/tclUnix/tclLoadNext.c
pTk/mTk/tclUnix/tclLoadOSF.c
pTk/mTk/tclUnix/tclLoadShl.c
pTk/mTk/tclUnix/tclUnixChan.c
pTk/mTk/tclUnix/tclUnixEvent.c
pTk/mTk/tclUnix/tclUnixFCmd.c
pTk/mTk/tclUnix/tclUnixFile.c
pTk/mTk/tclUnix/tclUnixInit.c
pTk/mTk/tclUnix/tclUnixNotfy.c
pTk/mTk/tclUnix/tclUnixPipe.c
pTk/mTk/tclUnix/tclUnixPort.h
pTk/mTk/tclUnix/tclUnixSock.c
pTk/mTk/tclUnix/tclUnixTest.c
pTk/mTk/tclUnix/tclUnixThrd.c
pTk/mTk/tclUnix/tclUnixThrd.h
PNG/libpng/contrib/gregbook/rpng-x.c view on Meta::CPAN
#ifdef sgi
char tmpline[80];
#endif
char *p;
int rc, alen, flen;
int error = 0;
int have_bg = FALSE;
double LUT_exponent; /* just the lookup table */
double CRT_exponent = 2.2; /* just the monitor */
double default_display_exponent; /* whole display system */
XEvent e;
KeySym k;
displayname = (char *)NULL;
filename = (char *)NULL;
/* First set the default value for our display-system exponent, i.e.,
* the product of the CRT exponent and the exponent corresponding to
* the frame-buffer's lookup table (LUT), if any. This is not an
Scrollbar/Scrollbar.pm view on Meta::CPAN
}
1;
__END__
sub Enter
{
my $w = shift;
my $e = $w->XEvent;
if ($Tk::strictMotif)
{
my $bg = $w->cget('-background');
$activeBg = $w->cget('-activebackground');
$w->configure('-activebackground' => $bg);
}
$w->activate($w->identify($e->x,$e->y));
}
sub Leave
Text/Text.pm view on Meta::CPAN
sub unselectAll
{
my ($w) = @_;
$w->tagRemove('sel','1.0','end');
}
sub adjustSelect
{
my ($w) = @_;
my $Ev = $w->XEvent;
$w->ResetAnchor($Ev->xy);
$w->SelectTo($Ev->xy,'char')
}
sub selectLine
{
my ($w) = @_;
my $Ev = $w->XEvent;
$w->SelectTo($Ev->xy,'line');
Tk::catch { $w->markSet('insert','sel.first') };
}
sub selectWord
{
my ($w) = @_;
my $Ev = $w->XEvent;
$w->SelectTo($Ev->xy,'word');
Tk::catch { $w->markSet('insert','sel.first') }
}
sub ClassInit
{
my ($class,$mw) = @_;
$class->SUPER::ClassInit($mw);
$class->bindRdOnly($mw);
TextList/TextList.pm view on Meta::CPAN
my $w=shift;
$w->SUPER::mark('previous', @_);
}
sub ButtonRelease_1
{
my $w = shift;
my $Ev = $w->XEvent;
$w->CancelRepeat;
$w->activate($Ev->xy);
}
sub Cntrl_Home
{
my $w = shift;
my $Ev = $w->XEvent;
$w->activate(0);
$w->see(0);
$w->selectionClear(0,'end');
$w->selectionSet(0)
}
sub Cntrl_End
{
my $w = shift;
my $Ev = $w->XEvent;
$w->activate('end');
$w->see('end');
$w->selectionClear(0,'end');
$w->selectionSet('end')
}
sub Cntrl_backslash
{
my $w = shift;
my $Ev = $w->XEvent;
if ($w->cget('-selectmode') ne 'browse')
{
$w->selectionClear(0,'end');
}
}
# BeginSelect --
#
# This procedure is typically invoked on button-1 presses. It begins
# the process of making a selection in the listbox. Its exact behavior
my $mess = shift;
my $w = $Tk::widget;
# Note that if a __DIE__ handler returns it re-dies up the chain.
return unless defined($w) && Exists($w);
# This special message is for exit() as an exception see pTkCallback.c
return if $mess =~/^_TK_EXIT_\(\d+\)/;
return if $w->_backTrace;
# Not in an eval - should not happen
}
sub XEvent::xy { shift->Info('xy') }
sub XEvent::AUTOLOAD
{
my ($meth) = $XEvent::AUTOLOAD =~ /(\w)$/;
no strict 'refs';
*{$XEvent::AUTOLOAD} = sub { shift->Info($meth) };
goto &$XEvent::AUTOLOAD;
}
sub NoOp { }
sub Ev
{
if (@_ == 1)
{
my $arg = $_[0];
return bless (((ref $arg) ? $arg : \$arg), 'Tk::Ev');
# Must re-grab even if the grab window hasn't changed, in order
# to release the implicit grab from the button press.
$menu->grabGlobal if ($Tk::platform eq 'unix');
}
}
sub Enter
{
my $w = shift;
my $ev = $w->XEvent;
$Tk::window = $w;
if ($w->cget('-type') eq 'tearoff')
{
if ($ev->m ne 'NotifyUngrab')
{
$w->SetFocus if ($Tk::platform eq 'unix');
}
}
$w->Motion($ev->x, $ev->y, $ev->s);
}
Tk/MsgBox.pm view on Meta::CPAN
# if {$underIdx >= 0} {
# set key [string index [$w.$name cget -text] $underIdx]
# bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
# bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
# }
}
$w->bind('<Alt-Key>', [sub { $w->AltKeyInDialog($_[1]) }, Ev('%A')]);
if ($w->cget(-default) ne "") {
$w->bind('<FocusIn>', sub {
my $e = shift->XEvent;
my $w = $e->W;
if ($w->isa('Tk::Button')) {
$w->configure(qw(-default active));
}
});
$w->bind('<FocusOut>', sub {
my $e = shift->XEvent;
my $w = $e->W;
if ($w->isa('Tk::Button')) {
$w->configure(qw(-default normal));
}
});
}
# 6. Create bindings for <Return>, <Escape> and <Destroy> on the dialog
$w->bind('<Return>' => sub {
my $e = shift->XEvent;
my $w = $e->W;
if ($w->isa('Tk::Button')) {
$w->invoke;
}
});
# Invoke the designated cancelling operation
$w->bind('<Escape>' => sub { $w->Subwidget($w->{Cancel})->invoke });
# At <Destroy> the buttons have vanished, so must do this directly.
Tk/Toplevel.pm view on Meta::CPAN
# within the same focus toplevel. Each toplevel can have only
# one focus group, which is identified by the name of the
# toplevel widget.
#
sub FG_Create {
my $t = shift;
unless (exists $t->{'_fg'}) {
$t->{'_fg'} = 1;
$t->bind('<FocusIn>', sub {
my $w = shift;
my $Ev = $w->XEvent;
$t->FG_In($w, $Ev->d);
}
);
$t->bind('<FocusOut>', sub {
my $w = shift;
my $Ev = $w->XEvent;
$t->FG_Out($w, $Ev->d);
}
);
$t->bind('<Destroy>', sub {
my $w = shift;
my $Ev = $w->XEvent;
$t->FG_Destroy($w);
}
);
# <Destroy> is not sufficient to break loops if never mapped.
$t->OnDestroy([$t,'FG_Destroy']);
}
}
# tkFocusGroup_BindIn --
#
Tk/Widget.pm view on Meta::CPAN
my $t = shift;
return Tk::After->new($w,$t,'repeat',@_);
}
sub FindMenu
{
# default FindMenu is that there is no menu.
return undef;
}
sub XEvent { shift->{'_XEvent_'} }
sub propertyRoot
{
my $w = shift;
return $w->property(@_,'root');
}
# atom, atomname, containing, interps, pathname
# don't work this way - there is no window arg
# So we pretend there was an call the C versions from Tk.xs
demos/demos/widget_lib/Ball.pm view on Meta::CPAN
# Ball.pm, a class module that allows concurrent simulation (canvas) instances.
#
# This is simply a class module, nothing fancy like a derived widget or
# composite widget. It has two virtual methods, new() and move_one_ball().
# There are two static methods, get_canvas_hash() and move_all_balls().
#
# Essentially, move_all_balls() is invoked to move all of the balls in a
# simulation's @BALLS list once - from their current to their new postion.
# After moving one ball a call to DoOneEvent() is made to handle pending
# XEvents. The *user* of this module, in this case bounce.pl, has their
# own main loop which also calls DoOneEvent() and move_all_balls() to keep
# the simulation active.
#
# Gurusamy Sarathy (gsar@engin.umich.edu)
# Tidied up by SOL.
use vars qw/$VERSION/;
$VERSION = '4.005'; # $Id: //depot/Tkutf8/demos/demos/widget_lib/Ball.pm#4 $
use Tk::Canvas;
view all matches for this distributionview release on metacpan - search on metacpan