pTk 8.4.24 widget patch #1 - widget demo and friends bug fixes/modernizations 
Author Message
 pTk 8.4.24 widget patch #1 - widget demo and friends bug fixes/modernizations

--Apple-Mail-4--848631014
Content-Transfer-Encoding: 7bit
Content-Type: text/plain;
        charset=US-ASCII;
        format=flowed

Nick, please find attached patches for widget et.al., approximately 1/3
of the way through, so more patches shall follow.  Currently have 2
demos giving bus errors until I look sideways at them .... thanks, Steve

--Apple-Mail-4--848631014
Content-Disposition: attachment;
        filename=widget1.patch
Content-Transfer-Encoding: 7bit
Content-Type: application/octet-stream;
        x-unix-mode=0644;
        name="widget1.patch"

--- Tk804.024/demos/widget.orig Sun Nov 17 18:07:22 2002

 #!/usr/local/bin/perl -w

-require 5.004;
-
+use 5.005_03;
 use Tk 800.000;
 use lib Tk->findINC('demos/widget_lib');

     -default_button => 'OK',
     -buttons        => ['OK'],
     -text           => "         widget\n\nPerl Version $]" .
-                      "\nTk Version $Tk::VERSION\n\n      2000/07/07",
+                      "\nTk Version $Tk::VERSION\n\n      2002/11/17",
 );
 $help->cget(-menu)->entryconfigure('About',


  #     Remove inswt() from widget and styles.pl to show the proper Perl/Tk
  #     idiom for inserting Text tags.  Various and sundry cleanups.

+ #     Update for Tk 8.4.x.

 =head1 AUTHOR



 =cut
--- Tk804.024/demos/demos/widget_lib/arrows.pl.orig     Sun Nov 17 18:52:49 2002


-    my $i = $c->create(qw/text .6i .1i -anchor n -text/ => "Range error!");
+    my $i = $c->createText(qw/.6i .1i -anchor n -text/ => "Range error!");
     $c->after(4000, sub { $c->delete($i) });


     # Create the arrow and outline.

     $c->delete('all');
-    $c->create('line', $v->{x1}, $v->{'y'}, $v->{x2}, $v->{'y'},
+    $c->createLine($v->{x1}, $v->{'y'}, $v->{x2}, $v->{'y'},
               -width => 10*$v->{width},
               -arrowshape => [10*$v->{a}, 10*$v->{b}, 10*$v->{c}],

     my $xtip = $v->{x2}-10*$v->{b};
     my $deltaY =  10*$v->{c}+5*$v->{width};
-    $c->create('line', $v->{x2}, $v->{'y'}, $xtip, $v->{'y'}+$deltaY,
+    $c->createLine($v->{x2}, $v->{'y'}, $xtip, $v->{'y'}+$deltaY,
               $v->{x2}-10*$v->{a}, $v->{'y'}, $xtip, $v->{'y'}-$deltaY,
               $v->{x2}, $v->{'y'}, -width => 2, -capstyle => 'round',
               -joinstyle => 'round');

     # Create the boxes for reshaping the line and arrowhead.

-    $c->create('rectangle', $v->{x2}-10*$v->{a}-5, $v->{'y'}-5,
+    $c->createRectangle($v->{x2}-10*$v->{a}-5, $v->{'y'}-5,

               -tags => ['box1', 'box']);
-    $c->create('rectangle', $xtip-5, $v->{'y'}-$deltaY-5, $xtip+5,
+    $c->createRectangle($xtip-5, $v->{'y'}-$deltaY-5, $xtip+5,

               -tags => ['box2', 'box']);
-    $c->create('rectangle', $v->{x1}-5, $v->{'y'}-5*$v->{width}-5,
+    $c->createRectangle($v->{x1}-5, $v->{'y'}-5*$v->{width}-5,

               -tags => ['box3', 'box']);

     # Create three arrows in actual size with the same parameters

-    $c->create('line', $v->{x2}+50, 0, $v->{x2}+50, 1000, -width => 2);
+    $c->createLine($v->{x2}+50, 0, $v->{x2}+50, 1000, -width => 2);
     my $tmp = $v->{x2}+100;
-    $c->create('line', $tmp, $v->{'y'}-125, $tmp, $v->{'y'}-75,
+    $c->createLine($tmp, $v->{'y'}-125, $tmp, $v->{'y'}-75,
               -width => $v->{width}, -arrow => 'both',
               -arrowshape => [$v->{a}, $v->{b}, $v->{c}]);
-    $c->create('line', $tmp-25, $v->{'y'}, $tmp+25, $v->{'y'},
+    $c->createLine($tmp-25, $v->{'y'}, $tmp+25, $v->{'y'},
               -width => $v->{width}, -arrow => 'both',
               -arrowshape =>[$v->{a}, $v->{b}, $v->{c}]);
-    $c->create('line', $tmp-25, $v->{'y'}+75, $tmp+25, $v->{'y'}+125,
+    $c->createLine($tmp-25, $v->{'y'}+75, $tmp+25, $v->{'y'}+125,
               -width => $v->{width}, -arrow => 'both',
               -arrowshape => [$v->{a}, $v->{b}, $v->{c}]);

     # dimensions.

     $tmp = $v->{x2}+10;
-    $c->create('line', $tmp, $v->{'y'}-5*$v->{width}, $tmp, $v->{'y'}-$deltaY,
+    $c->createLine($tmp, $v->{'y'}-5*$v->{width}, $tmp, $v->{'y'}-$deltaY,
               -arrow => 'both', -arrowshape => $v->{smallTips});
-    $c->create('text', $v->{x2}+15, $v->{'y'}-$deltaY+5*$v->{c},
+    $c->createText($v->{x2}+15, $v->{'y'}-$deltaY+5*$v->{c},
               -text => $v->{c}, -anchor => 'w');
     $tmp =  $v->{x1}-10;
-    $c->create('line', $tmp, $v->{'y'}-5*$v->{width}, $tmp,
+    $c->createLine($tmp, $v->{'y'}-5*$v->{width}, $tmp,
               $v->{'y'}+5*$v->{width}, -arrow => 'both',
               -arrowshape => $v->{smallTips});
-    $c->create('text', $v->{x1}-15, $v->{'y'}, -text => $v->{width},
+    $c->createText($v->{x1}-15, $v->{'y'}, -text => $v->{width},
               -anchor => 'e');
     $tmp = $v->{'y'}+5*$v->{width}+10*$v->{c}+10;
-    $c->create('line', $v->{x2}-10*$v->{a}, $tmp, $v->{x2}, $tmp,
+    $c->createLine($v->{x2}-10*$v->{a}, $tmp, $v->{x2}, $tmp,
               -arrow => 'both', -arrowshape => $v->{smallTips});
-    $c->create('text', $v->{x2}-5*$v->{a}, $tmp+5, -text => $v->{a},
+    $c->createText($v->{x2}-5*$v->{a}, $tmp+5, -text => $v->{a},
               -anchor => 'n');
     $tmp = $tmp+25;
-    $c->create('line', $v->{x2}-10*$v->{b}, $tmp, $v->{x2}, $tmp,
+    $c->createLine($v->{x2}-10*$v->{b}, $tmp, $v->{x2}, $tmp,
               -arrow => 'both', -arrowshape => $v->{smallTips});
-    $c->create('text', $v->{x2}-5*$v->{b}, $tmp+5, -text => $v->{b},
+    $c->createText($v->{x2}-5*$v->{b}, $tmp+5, -text => $v->{b},
               -anchor => 'n');

-    $c->create('text', $v->{x1}, 310, -text => "-width =>  $v->{width}",
+    $c->createText($v->{x1}, 310, -text => "-width =>  $v->{width}",
               -anchor => 'w',
               -font => '-*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-*');
-    $c->create('text', $v->{x1}, 330,
+    $c->createText($v->{x1}, 330,
               -text => "-arrowshape =>  [$v->{a}, $v->{b}, $v->{c}]",
               -anchor => 'w',
               -font => '-*-Helvetica-Medium-R-Normal--*-180-*-*-*-*-*-*');
--- Tk804.024/demos/demos/widget_lib/bind.pl.orig       Sun Nov 17 19:02:04 2002

     $t->insert('end', '6. A grid that demonstrates how canvases can be scrolled.', 'd6');

     foreach $tag (qw(d1 d2 d3 d4 d5 d6)) {
-       $t->tag('bind', $tag, '<Any-Enter>' =>

+       $t->tagBind($tag, '<Any-Enter>' =>

         );
-       $t->tag('bind', $tag, '<Any-Leave>' =>

+       $t->tagBind($tag, '<Any-Leave>' =>

         );
     }
-    $t->tag(qw/bind d1 <1>/ => sub {&items('items')});
-    $t->tag(qw/bind d2 <1>/ => sub {&plot('plot')});
-    $t->tag(qw/bind d3 <1>/ => sub {&ctext('ctext')});
-    $t->tag(qw/bind d4 <1>/ => sub {&arrows('arrows')});
-    $t->tag(qw/bind d5 <1>/ => sub {&ruler('ruler')});
-    $t->tag(qw/bind d6 <1>/ => sub {&cscroll('cscroll')});
+    $t->tagBind(qw/d1 <1>/ => sub {&items('items')});
+    $t->tagBind(qw/d2 <1>/ => sub {&plot('plot')});
+    $t->tagBind(qw/d3 <1>/ => sub {&ctext('ctext')});
+    $t->tagBind(qw/d4 <1>/ => sub {&arrows('arrows')});
+    $t->tagBind(qw/d5 <1>/ => sub {&ruler('ruler')});
+    $t->tagBind(qw/d6 <1>/ => sub {&cscroll('cscroll')});

     $t->mark(qw/set insert 0.0/);

--- Tk804.024/demos/demos/widget_lib/form.pl.orig       Sun Nov 17 18:45:43 2002

     foreach ('Name:', 'Address:', '', '', 'Phone:') {
        my $e = $f->Entry(qw/-relief sunken -width 40/);
        my $l = $f->Label(-text => $_, -anchor => 'e', -justify => 'right');
-        Tk::grid( $l, -row => $row, -column => 0, -sticky => 'e');
-        Tk::grid( $e, -row => $row++, -column => 1,-sticky => 'ew');
+        $l->grid(-row => $row, -column => 0, -sticky => 'e');
+        $e->grid(-row => $row++, -column => 1,-sticky => 'ew');
         $f->gridRowconfigure(1,-weight => 1);
        $e->focus if $_ eq 'Name:';
     }
--- Tk804.024/demos/demos/widget_lib/hscale.pl.orig     Sun Nov 17 19:22:58 2002

     my $canvas = $frame->Canvas(
         qw/width 50 -height 50 -bd 0 -highlightthickness 0/);
-    $canvas->create(qw/polygon 0 0 1 1 2 2 -fill DeepSkyBlue3 -tags poly/);
-    $canvas->create(qw/line 0 0 1 1 2 2 0 0 -fill black -tags line/);
+    $canvas->createPolygon(qw/0 0 1 1 2 2 -fill DeepSkyBlue3 -tags poly/);
+    $canvas->createLine (qw/0 0 1 1 2 2 0 0 -fill black -tags line/);

     my $scale = $frame->Scale(qw/-orient horizontal -length 284 -from 0
         -to 250 -tickinterval 50 -command/ => [\&hscale_width, $canvas]);
--- Tk804.024/demos/demos/widget_lib/Plot.pm.orig       Sun Nov 17 19:06:35 2002

 #
 # Advertised Plot widgets:  canvas, entry, postscript_button, view_button.

-require 5.002;
+require 5.005_03;


 $VERSION = '4.002'; # $Id: //depot/Tkutf8/demos/demos/widget_lib/Plot.pm#2 $

 use Tk::Frame;
-use base  qw(Tk::Frame);
+use base  qw/Tk::Frame/;
 Construct Tk::Widget 'Plot';
 use strict;
-
-# Plot Virtual Methods
-#
-#      $plot =
...

read more »



Fri, 06 May 2005 11:40:33 GMT  
 pTk 8.4.24 widget patch #1 - widget demo and friends bug fixes/modernizations

Quote:

> --- Tk804.024/demos/widget.orig    Sun Nov 17 18:07:22 2002
> +++ Tk804.024/demos/widget Sun Nov 17 21:29:06 2002

>  #!/usr/local/bin/perl -w

> -require 5.004;
> -
> +use 5.005_03;

  ^^^^^^^^^^^^^
This won't work --- use $VERSION only works since 5.6.0. I think for
versions it's anyway better to stick with require.

[...]

Quote:
> --- Tk804.024/demos/demos/widget_lib/WidgetDemo.pm.orig    Sun Nov 17 18:13:05 2002
> +++ Tk804.024/demos/demos/widget_lib/WidgetDemo.pm Sun Nov 17 18:25:00 2002

>  package WidgetDemo;

> -use 5.004;
> +use 5.005_03;

   ^^^^^^^^^^^^
Same here.

Quote:
> +use Tk 800.000;
>  use Carp;



Regards,
        Slaven

--

    tkrevdiff - graphical display of diffs between revisions (RCS or CVS)
    http://ptktools.sourceforge.net/#tkrevdiff
-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the



Fri, 06 May 2005 17:34:05 GMT  
 pTk 8.4.24 widget patch #1 - widget demo and friends bug fixes/modernizations

Slaven Rezic said:

Quote:

>> --- Tk804.024/demos/widget.orig        Sun Nov 17 18:07:22 2002
>> +++ Tk804.024/demos/widget     Sun Nov 17 21:29:06 2002

>>  #!/usr/local/bin/perl -w

>> -require 5.004;
>> -
>> +use 5.005_03;
>   ^^^^^^^^^^^^^
> This won't work --- use $VERSION only works since 5.6.0. I think for
> versions it's anyway better to stick with require.

As I recall, it's worked since 5.000.

And use vs require is a matter of stlye about which I will not comment ;-)

--

http://www.pjcj.net

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the



Fri, 06 May 2005 19:14:01 GMT  
 pTk 8.4.24 widget patch #1 - widget demo and friends bug fixes/modernizations

Slaven Rezic said:

Quote:

>> Slaven Rezic said:

>> >> --- Tk804.024/demos/widget.orig       Sun Nov 17 18:07:22 2002
>> >> +++ Tk804.024/demos/widget    Sun Nov 17 21:29:06 2002

>> >>  #!/usr/local/bin/perl -w

>> >> -require 5.004;
>> >> -
>> >> +use 5.005_03;
>> >   ^^^^^^^^^^^^^
>> > This won't work --- use $VERSION only works since 5.6.0. I think for
>> versions it's anyway better to stick with require.

>> As I recall, it's worked since 5.000.

>> And use vs require is a matter of stlye about which I will not comment
>> ;-)

> No:

> $ perl5.00404 -e 'use 5.004'
> syntax error at -e line 1, at EOF
> Execution of -e aborted due to compilation errors.

> $ perl5.00503 -e 'use 5.005'
> syntax error at -e line 1, at EOF
> Execution of -e aborted due to compilation errors.

> $ perl5.6.0 -e 'use 5.006'
> [no error]

> Regards,
>    Slaven

> --

>     tktimex - project time manager
>     http://sourceforge.net/projects/ptktools/

--

http://www.pjcj.net

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the



Fri, 06 May 2005 20:36:55 GMT  
 pTk 8.4.24 widget patch #1 - widget demo and friends bug fixes/modernizations

Quote:

> Slaven Rezic said:

> >> --- Tk804.024/demos/widget.orig   Sun Nov 17 18:07:22 2002
> >> +++ Tk804.024/demos/widget        Sun Nov 17 21:29:06 2002

> >>  #!/usr/local/bin/perl -w

> >> -require 5.004;
> >> -
> >> +use 5.005_03;
> >   ^^^^^^^^^^^^^
> > This won't work --- use $VERSION only works since 5.6.0. I think for
> > versions it's anyway better to stick with require.

> As I recall, it's worked since 5.000.

> And use vs require is a matter of stlye about which I will not comment ;-)

No:

$ perl5.00404 -e 'use 5.004'
syntax error at -e line 1, at EOF
Execution of -e aborted due to compilation errors.

$ perl5.00503 -e 'use 5.005'
syntax error at -e line 1, at EOF
Execution of -e aborted due to compilation errors.

$ perl5.6.0 -e 'use 5.006'
[no error]

Regards,
        Slaven

--

    tktimex - project time manager
    http://sourceforge.net/projects/ptktools/
-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the



Fri, 06 May 2005 20:36:27 GMT  
 pTk 8.4.24 widget patch #1 - widget demo and friends bug fixes/modernizations

Quote:

> Slaven Rezic said:

>>> --- Tk804.024/demos/widget.orig    Sun Nov 17 18:07:22 2002
>>> +++ Tk804.024/demos/widget Sun Nov 17 21:29:06 2002

>>>  #!/usr/local/bin/perl -w

>>> -require 5.004;
>>> -
>>> +use 5.005_03;
>>   ^^^^^^^^^^^^^
>> This won't work --- use $VERSION only works since 5.6.0. I think for
>> versions it's anyway better to stick with require.

> As I recall, it's worked since 5.000.

> And use vs require is a matter of stlye about which I will not comment
> ;-)

I'm unclear on this (now) - shortly after I sent the patch I saw a p5p
note saying that it might mean 5.5.30, or some such... hmmmm.  I'll
monitor things (;

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the



Fri, 06 May 2005 21:17:29 GMT  
 pTk 8.4.24 widget patch #1 - widget demo and friends bug fixes/modernizations
[ Apologies if anyone receives this message, or parts of it more than
once.  It's this funny web mail thing that's not mutt ;-) ]

Slaven Rezic said:

Quote:

>> Slaven Rezic said:

>> >> --- Tk804.024/demos/widget.orig       Sun Nov 17 18:07:22 2002
>> >> +++ Tk804.024/demos/widget    Sun Nov 17 21:29:06 2002

>> >>  #!/usr/local/bin/perl -w

>> >> -require 5.004;
>> >> -
>> >> +use 5.005_03;
>> >   ^^^^^^^^^^^^^
>> > This won't work --- use $VERSION only works since 5.6.0. I think for
>> versions it's anyway better to stick with require.

>> As I recall, it's worked since 5.000.

>> And use vs require is a matter of stlye about which I will not comment
>> ;-)

> No:

> $ perl5.00404 -e 'use 5.004'
> syntax error at -e line 1, at EOF
> Execution of -e aborted due to compilation errors.

> $ perl5.00503 -e 'use 5.005'
> syntax error at -e line 1, at EOF
> Execution of -e aborted due to compilation errors.

> $ perl5.6.0 -e 'use 5.006'
> [no error]

Ah, but I think that's something different :-)

Try adding a semi colon:

  perl5.00503 -e 'use 5.005;'

--

http://www.pjcj.net

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the



Fri, 06 May 2005 22:47:14 GMT  
 
 [ 7 post ] 

 Relevant Pages 

1. pTk 8.4.24 patch - widget demo floor.pl bug fixes and modernizations

2. pTk 8.4.24 patch - Trace.pm, move methods into Tk::Widget

3. pTk 8.4.24 patch - ErrorDialog.pm, complements previous Error.pod patch

4. pTk 8.4.24 patch - DialogBox.pm, document advertised subwidgets

5. pTk 8.4.24 patch - Dialog.pm, document advertised subwidgets

6. pTk 8.4.24 patch - document Popup(), make dialogs use Popup()

7. pTk 8.4.24 patch - implement afterInfo() and $repeat_id->time($new_repeat_delay)

8. pTk 8.4.24 bug reminder #1 ...

9. pTk 8.4.24 patch - ErrorDialog (was Re: Using Tk:ErrorDialog;)

10. Transparent Bitmap [was Re: pTk 8.4.24 bug reminder #1 ...]

11. minor bug in items.pl demo (and fix)

12. Tk widget demo crash

 

 
Powered by phpBB® Forum Software