Home > Archive > PerlTk > April 2004 > DnD Bug ?
You are viewing an archived Text-only version of the thread.
To view this thread in it's original format and/or if you want to reply to
this thread please [click here]
|
|
| $_@_.%_ 2004-04-06, 9:47 am |
|
The subroutine for the dragdrop event never fires off.
Also is there a way to get rid of or change the 'Widget' label
while dragging something?
Here is the minimal example:
#!
use strict;
use warnings;
use Tk;
use Tk::Tree;
use Tk::ROText;
use Tk::DragDrop;
use Tk::DropSite;
use Tk::ItemStyle;
use Tk::ResizeButton;
#Declarations#
#Main#
my $mw = MainWindow->new(-relief => 'ridge', -bd => 2,);
$mw->geometry('790x560+5+5'); &a_gui(); &Tk::MainLoop();
#Subroutines#
sub a_gui #-------------------------------------------------------------
{
#Widgit Initialization#
my $f1 = $mw->Frame(-relief => 'raised', -bd => 2,);
my $f2 = $mw->Frame;
my $pw1 = $mw->Panedwindow(-relief => 'groove', -bd => 2,);
our $tr1 = $pw1->Scrolled('Tree', -scrollbars => 'osoe',
-fg => '#000000', -bg => '#ffffff',
-selectbackground => '#ffffff',
-selectforeground => 'blue',
-selectborderwidth => 0,
-selectmode => 'single',
-width => 14, -separator => '~',);
my $pw2 = $pw1->Panedwindow(-orient => 'vertical',);
our $lb1 = $pw2->Scrolled('HList', -scrollbars => 'ose',
-columns => 4, -header => 1,
-bg => '#ffffff', -fg => '#000000',
-selectbackground => '#000000',
-selectforeground => '#fff000',
-selectmode => 'extended', -height => 7,
-highlightbackground => '#ffffff',
-highlightthickness => 0,
-takefocus => 1,);
my $dd1 = $lb1->DragDrop(-sitetypes => ['Local'],
-event => '<B1-Motion>',);
$lb1->DropSite(-droptypes => ['Local'],
-dropcommand => sub {print "\a";});# <--Bug Here?
our $lb1_s1 = $lb1->ItemStyle('text', -anchor => 'w',
-bg => '#ffffff', -fg => '#000000',
-selectforeground => '#fff000',
-font => '{Arial} 8',);
our $lb1_s2 = $lb1->ItemStyle('text', -anchor => 'e',
-bg => '#ffffff', -fg => '#000000',
-selectforeground => '#fff000',
-font => '{Arial} 8',);
my $h1 = $lb1->ResizeButton(-text => 'Subject',
-relief => 'flat',
-font => '{Ariel} 8',
-bd => 0,
-command => sub {},
-widget => \$lb1,
-column => 0, -anchor => 'w',
-takefocus => 0,);
our $h2 = $lb1->ResizeButton(-text => 'Sender',
-relief => 'flat',
-font => '{Ariel} 8',
-bd => 0,
-command => sub {},
-widget => \$lb1,
-column => 1, -anchor => 'w',
-takefocus => 0,);
our $h3 = $lb1->ResizeButton(-text => 'Time/Date',
-relief => 'flat',
-font => '{Ariel} 8',
-bd => 0,
-command => sub {},
-widget => \$lb1,
-column => 2, -anchor => 'w',
-takefocus => 0,);
our $tx1 = $pw2->Scrolled('ROText', -scrollbars => 'se',
-wrap => 'none',
-height => 23, -width => 30,
-bg => '#ffffff', -fg => '#000000',
-selectbackground => '#000000',
-selectforeground => '#fff000',
-insertontime => 0,);
$tx1->menu(undef);
my $tx1_l1 = $tx1->Label(-text => " Headers\t\t\t\t\t\t\t".
" Attachments",
-font => '{Ariel} 8', -bd => 0,
-bg => '#ffffff', -fg => 'blue',
-cursor => 'left_ptr',);
$tx1->windowCreate('end', -window => $tx1_l1);
$tx1->insert('end', "\n ");
our $tx1_tx = $tx1->Scrolled('ROText', -scrollbars => 'oe',
-width => 55, -height => 4,
-bg => '#ffffff', -fg => '#000000',
-selectbackground => '#000000',
-selectforeground => '#fff000',
-insertontime => 0, -wrap => 'none',
-takefocus => 1,);
$tx1_tx->menu(undef);
$tx1->windowCreate('end', -window => $tx1_tx);
our $tx1_lb = $tx1->Scrolled('HList', -scrollbars => 'osoe',
-width => 30, -height => 0,
-highlightbackground => '#ffffff',
-highlightthickness => 0,
-bg => '#ffffff', -fg => '#000000',
-selectbackground => '#000000',
-selectforeground => '#fff000',
-selectmode => 'single',
-cursor => 'left_ptr',
-takefocus => 1,);
$tx1->insert('end', " ");
$tx1->windowCreate('end', -window => $tx1_lb);
$tx1->insert('end', "\n ");
my $tx1_l2 = $tx1->Label(-text => ' 'x614,
-font => '{Ariel} 1',
-relief => 'raised', -bd => .5,
-bg => '#ffffff', -fg => '#ffffff',);
$tx1->windowCreate('end', -window => $tx1_l2);
$tx1->insert('end', "\n\n");
#Bindings#
#Widget configuration#
$pw1 ->add($tr1, $pw2,);
$pw2 ->add($lb1, $tx1,);
$lb1 ->columnWidth (0, -char => '53');
$lb1 ->columnWidth (1, -char => '25');
$lb1 ->columnWidth (2, -char => '25');
$lb1 ->columnWidth (3, -char => '');
$lb1 ->header('create', 0, -itemtype => 'window',
-widget => $h1, -borderwidth => 1,);
$lb1 ->header('create', 1, -itemtype => 'window',
-widget => $h2, -borderwidth => 1,);
$lb1 ->header('create', 2, -itemtype => 'window',
-widget => $h3, -borderwidth => 1,);
$lb1 ->header('create', 3, -borderwidth => 1,);
$tx1_tx ->Subwidget("yscrollbar")
->configure(-cursor => 'left_ptr',);
$tx1_tx ->Subwidget("xscrollbar")
->configure(-cursor => 'left_ptr',);
#Widget Placement#
$f1 ->grid(-in => $mw, -columnspan => '1',
-column => '1', -rowspan => '2',
-row => '1', -sticky => 'snew');
$f2 ->grid(-in => $f1, -columnspan => '11',
-column => '1', -rowspan => '1',
-row => '6', -sticky => 'snew');
$pw1 ->grid(-in => $f1, -columnspan => '11',
-column => '1', -rowspan => '1',
-row => '5', -sticky => 'snew');
#Grid Configuration#
$mw->gridRowconfigure(1, -minsize => 8, -weight => 1,);
$mw->gridColumnconfigure(1, -minsize => 8, -weight => 1,);
$f1->gridRowconfigure(1, -minsize => 2,);
$f1->gridRowconfigure(2, -minsize => 2,);
$f1->gridRowconfigure(3, -minsize => 8,);
$f1->gridRowconfigure(4, -minsize => 4,);
$f1->gridRowconfigure(5, -minsize => 505, -weight => 1,);
$f1->gridRowconfigure(6, -minsize => 16,);
$f1->gridColumnconfigure(1, -minsize => 8,);
$f1->gridColumnconfigure(2, -minsize => 8,);
$f1->gridColumnconfigure(3, -minsize => 4,);
$f1->gridColumnconfigure(4, -minsize => 8,);
$f1->gridColumnconfigure(5, -minsize => 8,);
$f1->gridColumnconfigure(6, -minsize => 8,);
$f1->gridColumnconfigure(7, -minsize => 4,);
$f1->gridColumnconfigure(8, -minsize => 8,);
$f1->gridColumnconfigure(9, -minsize => 8,);
$f1->gridColumnconfigure(10, -minsize => 8,);
$f1->gridColumnconfigure(11, -minsize => 401, -weight => 1,);
$f2->gridRowconfigure(1, -minsize => 8, -weight => 1,);
$f2->gridColumnconfigure(1, -minsize => 8, -weight => 1,);
$f2->gridColumnconfigure(2, -minsize => 8,);
#Defaults#
#Callbacks#
}
| |
| Chris Whiting 2004-04-06, 1:36 pm |
| $_@_.%,
Isn't this the same problem that was reported last w using Windows and
'Local' drops? I believe that I just saw postings that indicated that there
are patches available.
Chris
<$_@_.%_> wrote in message news:19wcc.683$Ne3.511@nwrdny02.gnilink.net...
>
> The subroutine for the dragdrop event never fires off.
> Also is there a way to get rid of or change the 'Widget' label
> while dragging something?
>
> Here is the minimal example:
>
> #!
> use strict;
> use warnings;
> use Tk;
> use Tk::Tree;
> use Tk::ROText;
> use Tk::DragDrop;
> use Tk::DropSite;
> use Tk::ItemStyle;
> use Tk::ResizeButton;
>
> #Declarations#
>
> #Main#
> my $mw = MainWindow->new(-relief => 'ridge', -bd => 2,);
> $mw->geometry('790x560+5+5'); &a_gui(); &Tk::MainLoop();
>
> #Subroutines#
> sub a_gui #-------------------------------------------------------------
> {
> #Widgit Initialization#
> my $f1 = $mw->Frame(-relief => 'raised', -bd => 2,);
> my $f2 = $mw->Frame;
> my $pw1 = $mw->Panedwindow(-relief => 'groove', -bd => 2,);
> our $tr1 = $pw1->Scrolled('Tree', -scrollbars => 'osoe',
> -fg => '#000000', -bg => '#ffffff',
> -selectbackground => '#ffffff',
> -selectforeground => 'blue',
> -selectborderwidth => 0,
> -selectmode => 'single',
> -width => 14, -separator => '~',);
> my $pw2 = $pw1->Panedwindow(-orient => 'vertical',);
> our $lb1 = $pw2->Scrolled('HList', -scrollbars => 'ose',
> -columns => 4, -header => 1,
> -bg => '#ffffff', -fg => '#000000',
> -selectbackground => '#000000',
> -selectforeground => '#fff000',
> -selectmode => 'extended', -height => 7,
> -highlightbackground => '#ffffff',
> -highlightthickness => 0,
> -takefocus => 1,);
> my $dd1 = $lb1->DragDrop(-sitetypes => ['Local'],
> -event => '<B1-Motion>',);
> $lb1->DropSite(-droptypes => ['Local'],
> -dropcommand => sub {print "\a";});#
<--Bug Here?
> our $lb1_s1 = $lb1->ItemStyle('text', -anchor => 'w',
> -bg => '#ffffff', -fg => '#000000',
> -selectforeground => '#fff000',
> -font => '{Arial} 8',);
> our $lb1_s2 = $lb1->ItemStyle('text', -anchor => 'e',
> -bg => '#ffffff', -fg => '#000000',
> -selectforeground => '#fff000',
> -font => '{Arial} 8',);
> my $h1 = $lb1->ResizeButton(-text => 'Subject',
> -relief => 'flat',
> -font => '{Ariel} 8',
> -bd => 0,
> -command => sub {},
> -widget => \$lb1,
> -column => 0, -anchor => 'w',
> -takefocus => 0,);
> our $h2 = $lb1->ResizeButton(-text => 'Sender',
> -relief => 'flat',
> -font => '{Ariel} 8',
> -bd => 0,
> -command => sub {},
> -widget => \$lb1,
> -column => 1, -anchor => 'w',
> -takefocus => 0,);
> our $h3 = $lb1->ResizeButton(-text => 'Time/Date',
> -relief => 'flat',
> -font => '{Ariel} 8',
> -bd => 0,
> -command => sub {},
> -widget => \$lb1,
> -column => 2, -anchor => 'w',
> -takefocus => 0,);
> our $tx1 = $pw2->Scrolled('ROText', -scrollbars => 'se',
> -wrap => 'none',
> -height => 23, -width => 30,
> -bg => '#ffffff', -fg => '#000000',
> -selectbackground => '#000000',
> -selectforeground => '#fff000',
> -insertontime => 0,);
> $tx1->menu(undef);
> my $tx1_l1 = $tx1->Label(-text => " Headers\t\t\t\t\t\t\t".
> " Attachments",
> -font => '{Ariel} 8', -bd => 0,
> -bg => '#ffffff', -fg => 'blue',
> -cursor => 'left_ptr',);
> $tx1->windowCreate('end', -window => $tx1_l1);
> $tx1->insert('end', "\n ");
> our $tx1_tx = $tx1->Scrolled('ROText', -scrollbars => 'oe',
> -width => 55, -height => 4,
> -bg => '#ffffff', -fg => '#000000',
> -selectbackground => '#000000',
> -selectforeground => '#fff000',
> -insertontime => 0, -wrap => 'none',
> -takefocus => 1,);
> $tx1_tx->menu(undef);
> $tx1->windowCreate('end', -window => $tx1_tx);
> our $tx1_lb = $tx1->Scrolled('HList', -scrollbars => 'osoe',
> -width => 30, -height => 0,
> -highlightbackground => '#ffffff',
> -highlightthickness => 0,
> -bg => '#ffffff', -fg => '#000000',
> -selectbackground => '#000000',
> -selectforeground => '#fff000',
> -selectmode => 'single',
> -cursor => 'left_ptr',
> -takefocus => 1,);
> $tx1->insert('end', " ");
> $tx1->windowCreate('end', -window => $tx1_lb);
> $tx1->insert('end', "\n ");
> my $tx1_l2 = $tx1->Label(-text => ' 'x614,
> -font => '{Ariel} 1',
> -relief => 'raised', -bd => .5,
> -bg => '#ffffff', -fg => '#ffffff',);
> $tx1->windowCreate('end', -window => $tx1_l2);
> $tx1->insert('end', "\n\n");
>
> #Bindings#
>
> #Widget configuration#
> $pw1 ->add($tr1, $pw2,);
> $pw2 ->add($lb1, $tx1,);
> $lb1 ->columnWidth (0, -char => '53');
> $lb1 ->columnWidth (1, -char => '25');
> $lb1 ->columnWidth (2, -char => '25');
> $lb1 ->columnWidth (3, -char => '');
> $lb1 ->header('create', 0, -itemtype => 'window',
> -widget => $h1, -borderwidth => 1,);
> $lb1 ->header('create', 1, -itemtype => 'window',
> -widget => $h2, -borderwidth => 1,);
> $lb1 ->header('create', 2, -itemtype => 'window',
> -widget => $h3, -borderwidth => 1,);
> $lb1 ->header('create', 3, -borderwidth => 1,);
> $tx1_tx ->Subwidget("yscrollbar")
> ->configure(-cursor => 'left_ptr',);
> $tx1_tx ->Subwidget("xscrollbar")
> ->configure(-cursor => 'left_ptr',);
>
> #Widget Placement#
> $f1 ->grid(-in => $mw, -columnspan => '1',
> -column => '1', -rowspan => '2',
> -row => '1', -sticky => 'snew');
> $f2 ->grid(-in => $f1, -columnspan => '11',
> -column => '1', -rowspan => '1',
> -row => '6', -sticky => 'snew');
> $pw1 ->grid(-in => $f1, -columnspan => '11',
> -column => '1', -rowspan => '1',
> -row => '5', -sticky => 'snew');
>
> #Grid Configuration#
> $mw->gridRowconfigure(1, -minsize => 8, -weight => 1,);
> $mw->gridColumnconfigure(1, -minsize => 8, -weight => 1,);
> $f1->gridRowconfigure(1, -minsize => 2,);
> $f1->gridRowconfigure(2, -minsize => 2,);
> $f1->gridRowconfigure(3, -minsize => 8,);
> $f1->gridRowconfigure(4, -minsize => 4,);
> $f1->gridRowconfigure(5, -minsize => 505, -weight => 1,);
> $f1->gridRowconfigure(6, -minsize => 16,);
> $f1->gridColumnconfigure(1, -minsize => 8,);
> $f1->gridColumnconfigure(2, -minsize => 8,);
> $f1->gridColumnconfigure(3, -minsize => 4,);
> $f1->gridColumnconfigure(4, -minsize => 8,);
> $f1->gridColumnconfigure(5, -minsize => 8,);
> $f1->gridColumnconfigure(6, -minsize => 8,);
> $f1->gridColumnconfigure(7, -minsize => 4,);
> $f1->gridColumnconfigure(8, -minsize => 8,);
> $f1->gridColumnconfigure(9, -minsize => 8,);
> $f1->gridColumnconfigure(10, -minsize => 8,);
> $f1->gridColumnconfigure(11, -minsize => 401, -weight => 1,);
> $f2->gridRowconfigure(1, -minsize => 8, -weight => 1,);
> $f2->gridColumnconfigure(1, -minsize => 8, -weight => 1,);
> $f2->gridColumnconfigure(2, -minsize => 8,);
>
> #Defaults#
>
> #Callbacks#
>
> }
>
>
| |
| $_@_.%_ 2004-04-06, 10:31 pm |
|
"Chris Whiting" <chrisremovethis@removethis.riverslime.com> wrote in message-id:
<4072dfa1$1_6@news.athenanews.com>
>
>$_@_.%,
>
>Isn't this the same problem that was reported last w using Windows and
>'Local' drops?
Uncertain
>I believe that I just saw postings that indicated that there
>are patches available.
>
>Chris
I think this is the patched version.
C:\>ppm query Tk
Querying target 1 (ActivePerl 5.8.0.806)
1. Tk [804.026] Tk *patched version* - a Graphical User Interface ~
C:\>ver
Microsoft Windows 2000 [Version 5.00.2195]
[color=darkred]
>
>
><$_@_.%_> wrote in message news:19wcc.683$Ne3.511@nwrdny02.gnilink.net...
><--Bug Here?
| |
| $_@_.%_ 2004-04-10, 6:31 am |
|
$_@_.%_ wrote in message-id:
<uDIcc.7331$1y1.3121@nwrdny03.gnilink.net>[color=darkred]
>
>
>"Chris Whiting" <chrisremovethis@removethis.riverslime.com> wrote in message-id:
><4072dfa1$1_6@news.athenanews.com>
>
>Uncertain
>
>
>I think this is the patched version.
>C:\>ppm query Tk
>Querying target 1 (ActivePerl 5.8.0.806)
> 1. Tk [804.026] Tk *patched version* - a Graphical User Interface ~
>
>C:\>ver
>
>Microsoft Windows 2000 [Version 5.00.2195]
>
Bug or no? Have I made a mistake here? If there is a patch.. where can it
be downloaded and how can it be installed? -tyia
| |
| $_@_.%_ 2004-04-10, 2:31 pm |
|
$_@_.%_ wrote in message-id:
<19wcc.683$Ne3.511@nwrdny02.gnilink.net>
>
>
>The subroutine for the dragdrop event never fires off.
>Also is there a way to get rid of or change the 'Widget' label
>while dragging something?
>
>Here is the minimal example:
[snip]
Here is the version information:
C:\>ppm query Tk
Querying target 1 (ActivePerl 5.8.0.806)
1. Tk [804.026] Tk *patched version* - a Graphical User Interface ~
C:\>ver
Microsoft Windows 2000 [Version 5.00.2195]
| |
| Chris Whiting 2004-04-12, 3:31 pm |
|
<$_@_.%_> wrote in message news:AmPdc.6734$QQ6.4667@nwrdny02.gnilink.net...
>
> $_@_.%_ wrote in message-id:
> <uDIcc.7331$1y1.3121@nwrdny03.gnilink.net>
message-id:[color=darkred]
and[color=darkred]
Interface ~[color=darkred]
news:19wcc.683$Ne3.511@nwrdny02.gnilink.net...[color=darkred]
#-------------------------------------------------------------[color=darkred]
>
> Bug or no? Have I made a mistake here? If there is a patch.. where can
it
> be downloaded and how can it be installed? -tyia
>
On 3/38 Nick wrote:
---
There is a composite patch of my sources relative to Tk804.026 at
http://www.ni-s.u-net.com/upload/Tk-804.026-patches.gz
I am waiting for a few confirmations that fixes work before making
a .027
---
However, I see that Nick just uploaded a new version yesterday:
http://search.cpan.org/~ni-s/Tk-804.027/
>
| |
| $_@_.%_ 2004-04-12, 4:32 pm |
|
"Chris Whiting" <chrisremovethis@removethis.riverslime.com> wrote in message-id:
<407add04_1@news.athenanews.com>
[snipped lots of text]
>
>However, I see that Nick just uploaded a new version yesterday:
>http://search.cpan.org/~ni-s/Tk-804.027/
>
Yes this works well. Thanks very much Chris, much appreciated.
|
|
|
|
|