# strip everything before this and feed to /bin/sh # # touch t/dash.t chmod 0444 t/dash.t patch -p1 -N <<'__END_OF_PATCH__' Index: Canvas/Canvas.pm --- Tk800.021/Canvas/Canvas.pm Fri Dec 24 09:41:43 1999 +++ Tk800.022/Canvas/Canvas.pm Sat May 13 10:22:29 2000 @@ -1,6 +1,6 @@ package Tk::Canvas; use vars qw($VERSION); -$VERSION = '3.016'; # $Id: //depot/Tk8/Canvas/Canvas.pm#16 $ +$VERSION = '3.018'; # $Id: //depot/Tk8/Canvas/Canvas.pm#18 $ use Tk qw($XS_VERSION); @@ -16,7 +16,7 @@ 'index','insert','itemcget','itemconfigure','lower','move', 'postscript','raise','scale','scan','select','type','xview','yview'); -use Tk::Submethods ( 'create' => [qw(arc bitmap grid image line oval +use Tk::Submethods ( 'create' => [qw(arc bitmap grid group image line oval polygon rectangle text window)], 'scan' => [qw(mark dragto)], 'select' => [qw(from clear item to)], Index: Change.log --- Tk800.021/Change.log Fri Apr 21 10:08:52 2000 +++ Tk800.022/Change.log Sat May 13 10:17:05 2000 @@ -1,3 +1,115 @@ +Change 1860 on 2000/05/13 by nick@bactrian + + Avoid goto xError which upsets one compiler. + +Change 1859 on 2000/05/13 by nick@bactrian + + Doc patch for progress bar + +Change 1857 on 2000/05/02 by nick@bactrian + + FileSelect -regexp enhancement from Helmut Jarausch + +Change 1856 on 2000/05/02 by nick@pluto + + See end on tied Text if yview is appropriate. + +Change 1855 on 2000/05/02 by nick@pluto + + Allow createGroup in Canvas + +Change 1853 on 2000/05/01 by nick@bactrian + + Tidy MANIFEST for patch posting + +Change 1851 on 2000/04/30 by nick@bactrian + + More -offset default fallout. + +Change 1849 on 2000/04/30 by nick@bactrian + + Checkin -MO=Script (B::Script) based version of script-to-exec tool + +Change 1848 on 2000/04/29 by nick@bactrian + + Do not rely on 'use base' to load XS modules - it is booled by static linked + XS code. + +Change 1847 on 2000/04/29 by nick@bactrian + + Fix -offset defaults to match new parse code. + +Change 1846 on 2000/04/29 by nick@bactrian + + Slaven's patches and suggestions. + HList Double binding + BrowseEntry hash tolerance + -dash bug fix + +Change 1845 on 2000/04/29 by nick@bactrian + + Increment to 800.022 + +Change 1844 on 2000/04/29 by nick@bactrian + + More pseudo-compile tweaks + +Change 1843 on 2000/04/29 by nick@bactrian + + Correct octal escape, allow perl command line flags + +Change 1842 on 2000/04/28 by nick@bactrian + + Use writemain() and avoid using B::* to try and get load file name. + (Works with 5.005_03, 5.6.0 and ithreaded 5.6.0.) + +Change 1841 on 2000/04/28 by nick@pluto + + More tweaks for pseudo-compile + +Change 1840 on 2000/04/28 by nick@pluto + + Preload and bootstrap support + +Change 1839 on 2000/04/28 by nick@bactrian + + Add 1st pass script2c + +Change 1838 on 2000/04/27 by nick@pluto + + Add Serial.pm to depot. + +Change 1837 on 2000/04/27 by nick@bactrian + + VERSION edits (p4 client on work machine will not run add_version script). + +Change 1836 on 2000/04/27 by nick@pluto + + Tweaks for "compile" to flat script: + Avoid "use base qw(Tk::Clipboard ...)" calling Tk::Clipboard() ! + Don't AUTOLOAD ClassInit subs + require a few modules a compile time. + +Change 1835 on 2000/04/23 by nick@bactrian + + LabFrame tinkering + +Change 1834 on 2000/04/23 by nick@bactrian + + Make NoteBook.pm match the tidied up C code. + +Change 1829 on 2000/04/21 by nick@bactrian + + Final(?) VERSION update for 800.021 + +Change 1828 on 2000/04/21 by nick@linux + + Perl5.00404 noise abatement due to non-autoquote. + +Change 1827 on 2000/04/21 by nick@bactrian + + Release prep for 800.021 + Change 1826 on 2000/04/21 by nick@bactrian A few more sprintf's converted to return int SVs directly Index: Changes --- Tk800.021/Changes Fri Apr 21 10:18:56 2000 +++ Tk800.022/Changes Sat May 13 10:21:55 2000 @@ -4,6 +4,13 @@ Change.log is generated from perforce database, it is therefore complete, but short on detail. +Changes in Tk800.022 + Fixes for NoteBook and LabFrame + Various tweaks for "compile" to flat script (tool not released yet) + Doc patches + Slaven's -offset fixes and associated need to change compiled-in defaults. + Feature suggestions from the list. + Changes in Tk800.021 Steve's patches for fileevent and -labelXxxxx Fixed the 'Delagate' bug introduced trying to make AUTOLOAD clean. Index: Entry/Entry.pm --- Tk800.021/Entry/Entry.pm Fri Apr 7 16:44:29 2000 +++ Tk800.022/Entry/Entry.pm Thu Apr 27 15:41:04 2000 @@ -12,15 +12,14 @@ # This program is free software; you can redistribute it and/or use vars qw($VERSION); -$VERSION = '3.033'; # $Id: //depot/Tk8/Entry/Entry.pm#33 $ +$VERSION = '3.035'; # $Id: //depot/Tk8/Entry/Entry.pm#35 $ # modify it under the same terms as Perl itself, subject # to additional disclaimer in license.terms due to partial # derivation from Tk4.0 sources. -require Tk::Widget; -require Tk::Clipboard; - +use Tk::Widget (); +use Tk::Clipboard (); use base qw(Tk::Clipboard Tk::Widget); import Tk qw(Ev $XS_VERSION); Index: Event/Event.pm --- Tk800.021/Event/Event.pm Sun Apr 2 13:45:18 2000 +++ Tk800.022/Event/Event.pm Sat Apr 29 10:36:41 2000 @@ -1,8 +1,8 @@ package Tk::Event; use vars qw($VERSION $XS_VERSION @EXPORT_OK); END { CleanupGlue() } -$VERSION = '3.022'; # $Id: //depot/Tk8/Event/Event.pm#22 $ -$XS_VERSION = '800.021'; +$VERSION = '3.023'; # $Id: //depot/Tk8/Event/Event.pm#23 $ +$XS_VERSION = '800.022'; require DynaLoader; use base qw(Exporter DynaLoader); @EXPORT_OK = qw($XS_VERSION DONT_WAIT WINDOW_EVENTS FILE_EVENTS Index: HList/HList.pm --- Tk800.021/HList/HList.pm Sat Apr 1 14:00:58 2000 +++ Tk800.022/HList/HList.pm Sat Apr 29 10:51:59 2000 @@ -1,7 +1,7 @@ package Tk::HList; use vars qw($VERSION); -$VERSION = '3.034'; # $Id: //depot/Tk8/HList/HList.pm#34 $ +$VERSION = '3.035'; # $Id: //depot/Tk8/HList/HList.pm#35 $ use Tk qw(Ev $XS_VERSION); @@ -50,6 +50,7 @@ $mw->bind($class,'',[ 'ShiftButton1' ] ); $mw->bind($class,'','Control_ButtonRelease_1'); $mw->bind($class,'','ButtonRelease_1'); + $mw->bind($class,'','NoOp'); $mw->bind($class,'',[ 'Button1Motion' ] ); $mw->bind($class,'',[ 'AutoScan' ] ); Index: Listbox/Listbox.pm --- Tk800.021/Listbox/Listbox.pm Sat Feb 19 14:26:22 2000 +++ Tk800.022/Listbox/Listbox.pm Thu Apr 27 15:41:04 2000 @@ -13,10 +13,10 @@ package Tk::Listbox; use vars qw($VERSION); -$VERSION = '3.029'; # $Id: //depot/Tk8/Listbox/Listbox.pm#29 $ +$VERSION = '3.031'; # $Id: //depot/Tk8/Listbox/Listbox.pm#31 $ use Tk qw(Ev $XS_VERSION); -require Tk::Clipboard; +use Tk::Clipboard (); use AutoLoader; use base qw(Tk::Clipboard Tk::Widget); @@ -65,30 +65,6 @@ } } - - -1; -__END__ - -# -# Bind -- -# This procedure is invoked the first time the mouse enters a listbox -# widget or a listbox widget receives the input focus. It creates -# all of the class bindings for listboxes. -# -# 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 xyIndex -{ - my $w = shift; - my $Ev = $w->XEvent; - return $w->index($Ev->xy); -} - sub ClassInit { my ($class,$mw) = @_; @@ -130,6 +106,28 @@ $mw->bind($class,'<2>',['scan','mark',Ev('x'),Ev('y')]); $mw->bind($class,'',['scan','dragto',Ev('x'),Ev('y')]); return $class; +} + +1; +__END__ + +# +# Bind -- +# This procedure is invoked the first time the mouse enters a listbox +# widget or a listbox widget receives the input focus. It creates +# all of the class bindings for listboxes. +# +# 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 xyIndex +{ + my $w = shift; + my $Ev = $w->XEvent; + return $w->index($Ev->xy); } sub ButtonRelease_1 Index: MANIFEST --- Tk800.021/MANIFEST Fri Apr 21 10:24:25 2000 +++ Tk800.022/MANIFEST Mon May 1 21:14:25 2000 @@ -1409,6 +1409,7 @@ t/balloon.t t/browseentry.t t/create.t +t/dash.t t/fbox.t t/fileevent.t t/fileselect.t Index: Makefile.PL --- Tk800.021/Makefile.PL Sun Apr 2 13:43:23 2000 +++ Tk800.022/Makefile.PL Sat Apr 29 10:28:28 2000 @@ -6,7 +6,7 @@ { $IsWin32 = ($^O eq 'MSWin32' || $Config{'ccflags'} =~ /-D_?WIN32_?/); - $VERSION = '800.021'; + $VERSION = '800.022'; $win_arch = shift @ARGV if @ARGV and $ARGV[0] =~ /^(open32|pm|x|MSWin32)$/; require('fix_4_os2.pl'), OS2_massage() if $^O eq 'os2'; Index: README --- Tk800.021/README Fri Apr 21 10:25:25 2000 +++ Tk800.022/README Sat May 13 10:16:39 2000 @@ -7,9 +7,10 @@ derived from those of the orignal Tix4.1.0 or Tk8.0 sources. See doc/license.html for details of this license. -Hopefully Tk800.021 should be production worthy. +Tk800.022 is supposed to be production worthy. +It has minimal changes from Tk800.021 apart from bug fixes. -(Consider Tk800.016..Tk800.019 its beta releases, previous stable +(Consider Tk800.016..Tk800.021 its beta releases, previous stable release being Tk800.015.) For questions on this package try news:comp.lang.perl.tk or e-mail @@ -24,14 +25,14 @@ But does work with perl5.6.0 - although this required a couple of work-rounds for perl5.6.0 ->isa bug. -This version (Tk800.021) requires perl5.005 or later on Win32 +This version (Tk800.022) requires perl5.005 or later on Win32 and 5.004_04 or later on UNIX. This version also contains re-worked Image code based on tcl/tk Img extension (version img1.2.3) by Jan Nijtmans: http://members1.chello.nl/~j.nijtmans/ Jan's "dash" patch is also merged. -Tk800.021 should build and run on Windows NT using Visual C++, Borland, +Tk800.022 should build and run on Windows NT using Visual C++, Borland, or with the Mingw32 port of GCC with perl5.005 or later. Can be built using ActiveState's binrary distribution (see README-ActiveState.txt). Index: Scrollbar/Scrollbar.pm --- Tk800.021/Scrollbar/Scrollbar.pm Sat Mar 11 16:50:29 2000 +++ Tk800.022/Scrollbar/Scrollbar.pm Thu Apr 27 15:41:04 2000 @@ -5,7 +5,7 @@ use AutoLoader; use vars qw($VERSION); -$VERSION = '3.012'; # $Id: //depot/Tk8/Scrollbar/Scrollbar.pm#12 $ +$VERSION = '3.014'; # $Id: //depot/Tk8/Scrollbar/Scrollbar.pm#14 $ use base qw(Tk::Widget); @@ -28,10 +28,6 @@ } -1; - -__END__ - sub ClassInit { my ($class,$mw) = @_; @@ -72,6 +68,10 @@ return $class; } + +1; + +__END__ sub Enter { Index: Text/Text.pm --- Tk800.021/Text/Text.pm Fri Apr 21 10:56:19 2000 +++ Tk800.022/Text/Text.pm Sat May 6 13:32:02 2000 @@ -20,7 +20,7 @@ use Text::Tabs; use vars qw($VERSION); -$VERSION = '3.042'; # $Id: //depot/Tk8/Text/Text.pm#42 $ +$VERSION = '3.043'; # $Id: //depot/Tk8/Text/Text.pm#43 $ use Tk qw(Ev $XS_VERSION); use base qw(Tk::Clipboard Tk::Widget); @@ -1359,10 +1359,22 @@ sub PRINT { my $w = shift; + # Find out whether 'end' is displayed at the moment + # Retrieve the position of the bottom of the window as + # a fraction of the entire contents of the Text widget + my $yview = ($w->yview)[1]; + + # If $yview is 1.0 this means that 'end' is visible in the window + my $update = 0; + $update = 1 if $yview == 1.0; + + # Loop over all input strings while (@_) { $w->insert('end',shift); } + # Move the window to see the end of the text if required + $w->see('end') if $update; } sub PRINTF Index: Tixish/BrowseEntry.pm --- Tk800.021/Tixish/BrowseEntry.pm Mon Apr 10 11:30:34 2000 +++ Tk800.022/Tixish/BrowseEntry.pm Sat Apr 29 10:51:59 2000 @@ -4,7 +4,7 @@ package Tk::BrowseEntry; use vars qw($VERSION); -$VERSION = '3.027'; # $Id: //depot/Tk8/Tixish/BrowseEntry.pm#27 $ +$VERSION = '3.028'; # $Id: //depot/Tk8/Tixish/BrowseEntry.pm#28 $ use Tk qw(Ev); use Carp; @@ -26,8 +26,10 @@ if (not defined $lpack) { $lpack = [-side => 'left', -anchor => 'e']; } + my $var = ""; my $e = $w->LabEntry(-labelPack => $lpack, - -label => delete $args->{-label}); + -label => delete $args->{-label}, + -textvariable => \$var,); my $b = $w->Button(-bitmap => '@' . Tk->findINC('cbxarrow.xbm')); $w->Advertise('entry' => $e); $w->Advertise('arrow' => $b); Index: Tixish/LabFrame.pm --- Tk800.021/Tixish/LabFrame.pm Mon Mar 27 11:41:23 2000 +++ Tk800.022/Tixish/LabFrame.pm Thu Apr 27 15:41:04 2000 @@ -5,7 +5,7 @@ package Tk::LabFrame; use vars qw($VERSION); -$VERSION = '3.019'; # $Id: //depot/Tk8/Tixish/LabFrame.pm#19 $ +$VERSION = '3.021'; # $Id: //depot/Tk8/Tixish/LabFrame.pm#21 $ use Tk; require Tk::Frame; @@ -36,10 +36,11 @@ $ph = 0; } $label->form(-top => 0, -left => 4, -padx => 6, -pady => 2); + # $label->place('-y' => 2, '-x' => 10); $border->form(-top => $y, -bottom => -1, -left => 0, -right => -1, -padx => 2, -pady => 2); $pad->form(-left => 0, -right => -1, -top => 0, -bottom => $ph); $f->form(-top => $pad, -bottom => -1, -left => 0, -right => -1); - $cw->Delegates('pack' => $cw); + # $cw->Delegates('pack' => $cw); } else { $f = $cw->Frame(-relief => 'groove', -bd => 2, %{$args}); $label = $cw->Label(-text => $ltext); Index: Tixish/NoteBook.pm --- Tk800.021/Tixish/NoteBook.pm Sat Dec 18 19:57:53 1999 +++ Tk800.022/Tixish/NoteBook.pm Sun Apr 23 13:19:10 2000 @@ -9,7 +9,7 @@ use vars qw($VERSION); -$VERSION = '3.023'; # $Id: //depot/Tk8/Tixish/NoteBook.pm#23 $ +$VERSION = '3.024'; # $Id: //depot/Tk8/Tixish/NoteBook.pm#24 $ require Tk::NBFrame; use base qw(Tk::Derived Tk::NBFrame); @@ -378,7 +378,7 @@ return unless Tk::Exists($w) && $w->{'nWindows'} && $w->{'resize'}; - my ($tW, $tH) = split(' ', $w->geometryinfo); + my ($tW, $tH) = $w->geometryinfo; $w->{'pad-x1'} = 2; $w->{'pad-x2'} = 2; $w->{'pad-y1'} = $tH + (defined $w->{'-ipadx'} ? $w->{'-ipadx'} : 0) + 1; Index: Tk.pm --- Tk800.021/Tk.pm Sun Apr 2 13:45:18 2000 +++ Tk800.022/Tk.pm Sat Apr 29 10:36:41 2000 @@ -42,12 +42,12 @@ # is created, $VERSION is checked by bootstrap $Tk::version = '8.0'; $Tk::patchLevel = '8.0'; -$Tk::VERSION = '800.021'; +$Tk::VERSION = '800.022'; $Tk::XS_VERSION = $Tk::VERSION; $Tk::strictMotif = 0; {($Tk::library) = __FILE__ =~ /^(.*)\.pm$/;} -$Tk::library = Tk->findINC('.') unless (-d $Tk::library); +$Tk::library = Tk->findINC('.') unless (defined($Tk::library) && -d $Tk::library); $Tk::widget = undef; $Tk::event = undef; @@ -356,6 +356,25 @@ return $_; } +sub findINC +{ + my $file = join('/',@_); + my $dir; + $file =~ s,::,/,g; + foreach $dir (@INC) + { + my $path; + return $path if (-e ($path = "$dir/$file")); + } + return undef; +} + +sub idletasks +{ + shift->update('idletasks'); +} + + 1; __END__ @@ -605,11 +624,13 @@ croak "Use Selection\u$cmd()"; } -sub Clipboard -{my $w = shift; - my $cmd = shift; - croak "Use clipboard\u$cmd()"; -} +# If we have sub Clipboard in Tk then use base qw(Tk::Clipboard ....) +# calls it when it does its eval "require $base" +#sub Clipboard +#{my $w = shift; +# my $cmd = shift; +# croak "Use clipboard\u$cmd()"; +#} sub Receive { @@ -623,11 +644,6 @@ die "_TK_BREAK_\n"; } -sub idletasks -{ - shift->update('idletasks'); -} - sub updateWidgets { my ($w) = @_; @@ -651,19 +667,6 @@ { my $w = shift; return $w->winfo('interps','-displayof'); -} - -sub findINC -{ - my $file = join('/',@_); - my $dir; - $file =~ s,::,/,g; - foreach $dir (@INC) - { - my $path; - return $path if (-e ($path = "$dir/$file")); - } - return undef; } sub lsearch Index: Tk/Derived.pm --- Tk800.021/Tk/Derived.pm Fri Mar 31 13:09:33 2000 +++ Tk800.022/Tk/Derived.pm Thu Apr 27 15:41:04 2000 @@ -8,7 +8,7 @@ use Carp; use vars qw($VERSION); -$VERSION = '3.044'; # $Id: //depot/Tk8/Tk/Derived.pm#44 $ +$VERSION = '3.046'; # $Id: //depot/Tk8/Tk/Derived.pm#46 $ $Tk::Derived::Debug = 0; @@ -280,8 +280,6 @@ my %changed = (); my ($opt,$val); my $config = $cw->TkHash('Configure'); - - $cw->labelPack([]) if grep /^-label\w+/, keys %args; while (($opt,$val) = each %args) { Index: Tk/FileSelect.pm --- Tk800.021/Tk/FileSelect.pm Sat Mar 25 09:08:48 2000 +++ Tk800.022/Tk/FileSelect.pm Sat May 13 10:22:29 2000 @@ -1,7 +1,7 @@ package Tk::FileSelect; use vars qw($VERSION @EXPORT_OK); -$VERSION = '3.045'; # $Id: //depot/Tk8/Tk/FileSelect.pm#45 $ +$VERSION = '3.047'; # $Id: //depot/Tk8/Tk/FileSelect.pm#47 $ @EXPORT_OK = qw(glob_to_re); use Tk qw(Ev); @@ -237,7 +237,7 @@ -filelistlabel => [ 'PASSIVE', undef, undef, 'Files' ], -filter => [ 'METHOD', undef, undef, undef ], -defaultextension => [ 'METHOD', undef, undef, undef ], - -regexp => [ 'PASSIVE', undef, undef, undef ], + -regexp => [ 'METHOD', undef, undef, undef ], -dirlistlabel => [ 'PASSIVE', undef, undef, 'Directories'], -dirlabel => [ 'PASSIVE', undef, undef, 'Directory'], '-accept' => [ 'CALLBACK',undef,undef, undef ], @@ -284,7 +284,24 @@ { $val = '*' unless defined $val; $$var = $val; - $cw->{'match'} = glob_to_re($val); + $cw->{'match'} = glob_to_re($val) unless defined $cw->{'match'}; + unless ($cw->{'reread'}++) + { + $cw->Busy; + $cw->afterIdle(['reread',$cw,$cw->cget('-directory')]) + } + } + return $$var; +} + +sub regexp +{ + my ($cw,$val) = @_; + my $var = \$cw->{Configure}{'-regexp'}; + if (@_ > 1) + { + $$var = $val; + $cw->{'match'} = sub { shift =~ m|^${val}$| }; unless ($cw->{'reread'}++) { $cw->Busy; @@ -333,7 +350,7 @@ unless (Tk::tainting()) { my $pwd = Cwd::getcwd(); - if (chdir($dir)) + if (chdir( (defined($dir) ? $dir : '') ) ) { my $new = Cwd::getcwd(); if ($new) Index: Tk/Frame.pm --- Tk800.021/Tk/Frame.pm Fri Apr 21 10:56:19 2000 +++ Tk800.022/Tk/Frame.pm Thu Apr 27 15:41:04 2000 @@ -14,7 +14,7 @@ use vars qw($VERSION); -$VERSION = '3.028'; # $Id: //depot/Tk8/Tk/Frame.pm#28 $ +$VERSION = '3.030'; # $Id: //depot/Tk8/Tk/Frame.pm#30 $ sub Tk_cmd { \&Tk::frame } @@ -90,6 +90,7 @@ $cw->ConfigSpecs('-labelPack' => [ 'METHOD', undef, undef, undef]); $cw->ConfigSpecs('-labelVariable' => [ 'METHOD', undef, undef, undef]); $cw->ConfigSpecs('-label' => [ 'METHOD', undef, undef, undef]); + $cw->labelPack([]) if grep /^-label\w+/, keys %$args; } sub Menubar Index: Tk/Menu.pm --- Tk800.021/Tk/Menu.pm Mon Mar 13 15:54:26 2000 +++ Tk800.022/Tk/Menu.pm Thu Apr 27 15:41:04 2000 @@ -17,10 +17,11 @@ require Tk::Widget; require Tk::Wm; require Tk::Derived; +require Tk::Menu::Item; use vars qw($VERSION); -$VERSION = '3.043'; # $Id: //depot/Tk8/Tk/Menu.pm#43 $ +$VERSION = '3.045'; # $Id: //depot/Tk8/Tk/Menu.pm#45 $ use strict; @@ -71,7 +72,6 @@ sub AddItems { - require Tk::Menu::Item; my $menu = shift; ITEM: while (@_) Index: Tk/ProgressBar.pm --- Tk800.021/Tk/ProgressBar.pm Sun Dec 19 15:49:44 1999 +++ Tk800.022/Tk/ProgressBar.pm Sat May 13 10:22:29 2000 @@ -1,7 +1,7 @@ package Tk::ProgressBar; use vars qw($VERSION); -$VERSION = '3.012'; # $Id: //depot/Tk8/Tk/ProgressBar.pm#12 $ +$VERSION = '3.014'; # $Id: //depot/Tk8/Tk/ProgressBar.pm#14 $ use Tk; use Tk::Canvas; @@ -334,7 +334,8 @@ $progress = $parent->ProgressBar( -width => 200, - -height => 20, + -length => 20, + -anchor => 's', -from => 0, -to => 100, -blocks => 10, @@ -342,6 +343,7 @@ -variable => \$percent_done ); + $progress->value($position); =head1 DESCRIPTION @@ -350,31 +352,85 @@ =head1 STANDARD OPTIONS -B<-padx -pady -troughcolor -highlightthickness -borderwidth -relief> +The following standard widget options are supported: +=over 4 + +=item B<-borderwidth> + +=item B<-highlightthickness> + +Defaults to 0. + +=item B<-padx> + +Defaults to 0. + +=item B<-pady> + +Defaults to 0. + +=item B<-relief> + +Defaults to C + +=item B<-troughcolor> + +The color to be used for the background (trough) of the progress bar. +Default is to use grey55. + +=back =head1 WIDGET-SPECIFIC OPTIONS =over 4 -=item -width +=item B<-anchor> + +This can be used to position the start point of the bar. Default +is 'w' (horizontal bar starting from the left). A vertical bar can be +configured by using either 's' or 'n'. -Specifies the desired narrow dimension of the ProgressBar in screen units (i.e. -any of the forms acceptable to Tk_GetPixels). For vertical ProgressBars this is -the ProgressBars width; for horizontal bars this is the ProgressBars height. +=item B<-blocks> +This controls the number of blocks to be used to construct the progress +bar. The default is to break the bar into 10 blocks. -=item -length +=item B<-colors> -Specifies the desired long dimension of the ProgressBar in screen units (i.e. any -of the forms acceptable to Tk_GetPixels). For vertical ProgressBars this is the -ProgressBars height; for horizontal scales it is the ProgressBars width. +Controls the colors to be used for different positions of the progress bar. +The colors should be supplied as a reference to an array containing pairs +of positions and colors. -=item -colors + -colors => [ 0, 'green', 50, 'red' ] -=item -blocks +means that for the range 0 to 50 the progress bar should be green +and for higher values it should be red. -=item -resolution + +=item B<-from> + +This sets the lower limit of the progress bar. If the bar is set to a +value below the lower limt no bar will be displayed. Defaults to 0. +See the C<-to> description for more information. + +=item B<-gap> + +This is the spacing (in pixels) between each block. Defaults to 1. +Use 0 to get a continuous bar. + + +=item B<-length> + +Specifies the desired long dimension of the ProgressBar in screen +units (i.e. any of the forms acceptable to Tk_GetPixels). For vertical +ProgressBars this is the ProgressBars height; for horizontal scales it +is the ProgressBars width. The default length is calculated from the +values of C<-padx>, C<-borderwidth>, C<-highlightthickness> and the +difference between C<-from> and C<-to>. + + +=item B<-resolution> A real value specifying the resolution for the scale. If this value is greater than zero then the scale's value will always be rounded to an even multiple of @@ -382,19 +438,34 @@ less than zero then no rounding occurs. Defaults to 1 (i.e., the value will be integral). -=item -anchor +=item B<-to> + +This sets the upper limit of the progress bar. If a value is specified +(for example, using the C method) that lies above this value the +full progress bar will be displayed. Defaults to 100. + -=item -variable + +=item B<-variable> Specifies the reference to a scalar variable to link to the ProgressBar. Whenever the value of the variable changes, the ProgressBar will upate to reflect this value. (See also the B method below.) -=item -from +=item B<-value> + +The can be used to set the current position of the progress bar +when used in conjunction with the standard C. It is +usually recommended to use the B method instead. + -=item -to +=item B<-width> -=item -gap +Specifies the desired narrow dimension of the ProgressBar in screen +units (i.e. any of the forms acceptable to Tk_GetPixels). For +vertical ProgressBars this is the ProgressBars width; for horizontal +bars this is the ProgressBars height. The default width is derived +from the values of C<-borderwidth> and C<-pady> and C<-highlightthickness>. =back @@ -402,7 +473,7 @@ =over 4 -=item I<$ProgressBar>->B(?I?) +=item I<$ProgressBar>-EB(?I?) If I is omitted, returns the current value of the ProgressBar. If I is given, the value of the ProgressBar is set. If I<$value> is Index: Tk/ROText.pm --- Tk800.021/Tk/ROText.pm Sat Oct 2 17:44:27 1999 +++ Tk800.022/Tk/ROText.pm Sat Apr 29 16:24:42 2000 @@ -1,14 +1,14 @@ # Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -require Tk; package Tk::ROText; -require Tk::Text; use vars qw($VERSION); -$VERSION = '3.023'; # $Id: //depot/Tk8/Tk/ROText.pm#23 $ +$VERSION = '3.024'; # $Id: //depot/Tk8/Tk/ROText.pm#24 $ +use Tk::Text; use base qw(Tk::Text); + Construct Tk::Widget 'ROText'; sub clipEvents Index: Tk/TextUndo.pm --- Tk800.021/Tk/TextUndo.pm Fri Apr 21 10:56:19 2000 +++ Tk800.022/Tk/TextUndo.pm Sat Apr 29 16:24:42 2000 @@ -6,12 +6,13 @@ package Tk::TextUndo; use vars qw($VERSION $DoDebug); -$VERSION = '3.047'; # $Id: //depot/Tk8/Tk/TextUndo.pm#47 $ +$VERSION = '3.048'; # $Id: //depot/Tk8/Tk/TextUndo.pm#48 $ $DoDebug = 0; use Tk qw (Ev); use AutoLoader; +use Tk::Text (); use base qw(Tk::Text); Construct Tk::Widget 'TextUndo'; Index: Tk/Widget.pm --- Tk800.021/Tk/Widget.pm Thu Mar 30 14:23:21 2000 +++ Tk800.022/Tk/Widget.pm Sat Apr 29 10:36:41 2000 @@ -3,7 +3,7 @@ # modify it under the same terms as Perl itself. package Tk::Widget; use vars qw($VERSION @DefaultMenuLabels); -$VERSION = '3.074'; # $Id: //depot/Tk8/Tk/Widget.pm#74 $ +$VERSION = '3.078'; # $Id: //depot/Tk8/Tk/Widget.pm#78 $ require Tk; use AutoLoader; @@ -39,7 +39,7 @@ sub import { my $package = shift; - carp 'use Tk::Widget () to pre-load widgets is deprecated' if (@_ && $^W); + carp 'use Tk::Widget () to pre-load widgets is deprecated' if (@_); my $need; foreach $need (@_) { @@ -263,6 +263,8 @@ return $what; } +require UNIVERSAL; + sub AUTOLOAD { # Take a copy into a 'my' variable so we can recurse @@ -320,7 +322,6 @@ if (!defined(&$what) && $method =~ /^[A-Z]\w+$/) { # Use ->can as ->isa is broken in perl5.6.0 - require UNIVERSAL; my $sub = UNIVERSAL::can($_[0],'_AutoloadTkWidget'); if ($sub) { @@ -472,10 +473,10 @@ # This is supposed to replicate Tk::after behaviour, # but does auto-cancel when widget is deleted. +require Tk::After; sub afterIdle { - require Tk::After; my $w = shift; return Tk::After->new($w,'idle','once',@_); } Index: basic_demo --- Tk800.021/basic_demo Sat Mar 25 15:02:47 2000 +++ Tk800.022/basic_demo Thu Apr 27 15:38:55 2000 @@ -13,8 +13,8 @@ # use Tk::Xrm; use Tk::widgets qw(Button Label Menu Photo Optionmenu Pixmap Balloon); -#use Tk::widgets qw(ErrorDialog Checkbutton Radiobutton Entry Message Listbox); -use Tk::widgets qw(Scrollbar Checkbutton Radiobutton Entry Message Listbox); +use Tk::widgets qw(Scrollbar Checkbutton Radiobutton Entry + Message BrowseEntry Listbox); use Config; @@ -155,7 +155,6 @@ sub menubar {my $top = shift; - require Tk::Menubar; my $menu = $top->Menubar; my $file = $menu->Menubutton("-text" => "File","-underline" => 0, -bg => 'ivory', -tearoff => 0 Index: pTk/mTk/generic/tkButton.c --- Tk800.021/pTk/mTk/generic/tkButton.c Wed Mar 22 12:12:33 2000 +++ Tk800.022/pTk/mTk/generic/tkButton.c Sat Apr 29 14:10:45 2000 @@ -164,7 +164,7 @@ {TK_CONFIG_LANGARG, "-offvalue", "offValue", "Value", DEF_BUTTON_OFF_VALUE, Tk_Offset(TkButton, offValue), CHECK_BUTTON_MASK}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(TkButton, tsoffset),ALL_MASK|TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_LANGARG, "-onvalue", "onValue", "Value", Index: pTk/mTk/generic/tkCanvArc.c --- Tk800.021/pTk/mTk/generic/tkCanvArc.c Sat Dec 4 23:13:38 1999 +++ Tk800.022/pTk/mTk/generic/tkCanvArc.c Sun Apr 30 20:25:11 2000 @@ -179,12 +179,12 @@ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(ArcItem, fillColor), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL, - "0,0", Tk_Offset(ArcItem, tsoffset), + "0 0", Tk_Offset(ArcItem, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL, "black", Tk_Offset(ArcItem, outline.color), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-outlineoffset", (char *) NULL, (char *) NULL, - "0,0", Tk_Offset(ArcItem, outline.tsoffset), + "0 0", Tk_Offset(ArcItem, outline.tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(ArcItem, outline.stipple), Index: pTk/mTk/generic/tkCanvLine.c --- Tk800.021/pTk/mTk/generic/tkCanvLine.c Sat Dec 4 23:13:38 1999 +++ Tk800.022/pTk/mTk/generic/tkCanvLine.c Sun Apr 30 20:25:31 2000 @@ -220,7 +220,7 @@ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL, "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL, - "0,0", Tk_Offset(LineItem, outline.tsoffset), + "0 0", Tk_Offset(LineItem, outline.tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_CUSTOM, "-smooth", (char *) NULL, (char *) NULL, "0", Tk_Offset(LineItem, smooth), Index: pTk/mTk/generic/tkCanvPoly.c --- Tk800.021/pTk/mTk/generic/tkCanvPoly.c Sat Dec 4 23:13:38 1999 +++ Tk800.022/pTk/mTk/generic/tkCanvPoly.c Sun Apr 30 20:25:59 2000 @@ -145,13 +145,13 @@ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL, "round", Tk_Offset(PolygonItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL, - "0,0", Tk_Offset(PolygonItem, tsoffset), + "0 0", Tk_Offset(PolygonItem, tsoffset), TK_CONFIG_NULL_OK, &offsetOption}, {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PolygonItem, outline.color), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-outlineoffset", (char *) NULL, (char *) NULL, - "0,0", Tk_Offset(PolygonItem, outline.tsoffset), + "0 0", Tk_Offset(PolygonItem, outline.tsoffset), TK_CONFIG_NULL_OK, &offsetOption}, {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(PolygonItem, outline.stipple), Index: pTk/mTk/generic/tkCanvText.c --- Tk800.021/pTk/mTk/generic/tkCanvText.c Sat Dec 4 23:13:38 1999 +++ Tk800.022/pTk/mTk/generic/tkCanvText.c Sun Apr 30 20:26:15 2000 @@ -127,7 +127,7 @@ "left", Tk_Offset(TextItem, justify), TK_CONFIG_DONT_SET_DEFAULT}, {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL, - "0,0", Tk_Offset(TextItem, tsoffset), + "0 0", Tk_Offset(TextItem, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_CUSTOM, "-state", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(Tk_Item, state), TK_CONFIG_NULL_OK, Index: pTk/mTk/generic/tkCanvas.c --- Tk800.021/pTk/mTk/generic/tkCanvas.c Fri Mar 24 16:43:24 2000 +++ Tk800.022/pTk/mTk/generic/tkCanvas.c Sat Apr 29 14:12:58 2000 @@ -184,7 +184,7 @@ DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0}, {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(TkCanvas, tsoffset),TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", Index: pTk/mTk/generic/tkEntry.c --- Tk800.021/pTk/mTk/generic/tkEntry.c Wed Nov 24 17:51:10 1999 +++ Tk800.022/pTk/mTk/generic/tkEntry.c Sat Apr 29 14:13:17 2000 @@ -312,7 +312,7 @@ #endif /* ENTRY_VALIDATE */ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", DEF_ENTRY_JUSTIFY, Tk_Offset(Entry, justify), 0}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(Entry, tsoffset),TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", DEF_ENTRY_RELIEF, Tk_Offset(Entry, relief), 0}, Index: pTk/mTk/generic/tkFrame.c --- Tk800.021/pTk/mTk/generic/tkFrame.c Sat Nov 20 19:32:59 1999 +++ Tk800.022/pTk/mTk/generic/tkFrame.c Sat Apr 29 14:14:36 2000 @@ -164,7 +164,7 @@ {TK_CONFIG_LANGARG, "-menu", "menu", "Menu", DEF_TOPLEVEL_MENU, Tk_Offset(Frame, menuName), TOPLEVEL|TK_CONFIG_NULL_OK}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(Frame, tsoffset),BOTH|TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", Index: pTk/mTk/generic/tkMenu.c --- Tk800.021/pTk/mTk/generic/tkMenu.c Sat Mar 18 13:59:28 2000 +++ Tk800.022/pTk/mTk/generic/tkMenu.c Sat Apr 29 14:15:51 2000 @@ -167,7 +167,7 @@ {TK_CONFIG_LANGARG, "-menu", (char *) NULL, (char *) NULL, DEF_MENU_ENTRY_MENU, Tk_Offset(TkMenuEntry, name), CASCADE_MASK|TK_CONFIG_NULL_OK}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(TkMenuEntry, tsoffset), COMMAND_MASK|CHECK_BUTTON_MASK| RADIO_BUTTON_MASK|CASCADE_MASK|TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, @@ -259,7 +259,7 @@ DEF_MENU_FONT, Tk_Offset(TkMenu, tkfont), 0}, {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground", DEF_MENU_FG, Tk_Offset(TkMenu, fg), 0}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(TkMenu, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_CALLBACK, "-postcommand", "postCommand", "Command", Index: pTk/mTk/generic/tkMenubutton.c --- Tk800.021/pTk/mTk/generic/tkMenubutton.c Sat Nov 20 19:34:32 1999 +++ Tk800.022/pTk/mTk/generic/tkMenubutton.c Sat Apr 29 14:16:13 2000 @@ -136,7 +136,7 @@ DEF_MENUBUTTON_PADX, Tk_Offset(TkMenuButton, padX), 0}, {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", DEF_MENUBUTTON_PADY, Tk_Offset(TkMenuButton, padY), 0}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(TkMenuButton, tile),TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", Index: pTk/mTk/generic/tkRectOval.c --- Tk800.021/pTk/mTk/generic/tkRectOval.c Fri Mar 24 16:41:37 2000 +++ Tk800.022/pTk/mTk/generic/tkRectOval.c Sun Apr 30 20:27:16 2000 @@ -129,12 +129,12 @@ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(RectOvalItem, fillColor), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-offset", (char *) NULL, (char *) NULL, - "0,0", Tk_Offset(RectOvalItem, tsoffset), + "0 0", Tk_Offset(RectOvalItem, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL, "black", Tk_Offset(RectOvalItem, outline.color), TK_CONFIG_NULL_OK}, {TK_CONFIG_CUSTOM, "-outlineoffset", (char *) NULL, (char *) NULL, - "0,0", Tk_Offset(RectOvalItem, outline.tsoffset), + "0 0", Tk_Offset(RectOvalItem, outline.tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(RectOvalItem, outline.stipple), Index: pTk/mTk/generic/tkScale.c --- Tk800.021/pTk/mTk/generic/tkScale.c Sat Nov 20 19:32:18 1999 +++ Tk800.022/pTk/mTk/generic/tkScale.c Sat Apr 29 14:16:36 2000 @@ -113,7 +113,7 @@ DEF_SCALE_LABEL, Tk_Offset(TkScale, label), TK_CONFIG_NULL_OK}, {TK_CONFIG_PIXELS, "-length", "length", "Length", DEF_SCALE_LENGTH, Tk_Offset(TkScale, length), 0}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(TkScale, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_CUSTOM, "-orient", "orient", "Orient", Index: pTk/mTk/generic/tkScrollbar.c --- Tk800.021/pTk/mTk/generic/tkScrollbar.c Sat Nov 20 19:36:03 1999 +++ Tk800.022/pTk/mTk/generic/tkScrollbar.c Sat Apr 29 14:15:10 2000 @@ -105,7 +105,7 @@ {TK_CONFIG_CUSTOM, "-tile", "tile", "Tile", (char *) NULL, Tk_Offset(TkScrollbar, tile), TK_CONFIG_DONT_SET_DEFAULT, &tileOption}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(TkScrollbar, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background", Index: pTk/mTk/generic/tkText.c --- Tk800.021/pTk/mTk/generic/tkText.c Sun Dec 12 13:58:37 1999 +++ Tk800.022/pTk/mTk/generic/tkText.c Sat Apr 29 14:13:51 2000 @@ -118,7 +118,7 @@ DEF_TEXT_INSERT_ON_TIME, Tk_Offset(TkText, insertOnTime), 0}, {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", DEF_TEXT_INSERT_WIDTH, Tk_Offset(TkText, insertWidth), 0}, - {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0,0", + {TK_CONFIG_CUSTOM, "-offset", "offset", "Offset", "0 0", Tk_Offset(TkText, tsoffset), TK_CONFIG_DONT_SET_DEFAULT, &offsetOption}, {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", Index: pTk/mTk/generic/tkUtil.c --- Tk800.021/pTk/mTk/generic/tkUtil.c Wed Dec 1 18:21:24 1999 +++ Tk800.022/pTk/mTk/generic/tkUtil.c Sat Apr 29 13:28:04 2000 @@ -346,8 +346,8 @@ if (Tcl_ListObjGetElements(NULL,ovalue,&argc,&args) != TCL_OK) { goto badTSOffset; } - if (argc == 1) { - char *value = LangString(args[1]); + if (argc > 0) { + value = LangString(args[0]); } if ((value == NULL) || (*value == 0)) { tsoffset.flags = TK_OFFSET_CENTER|TK_OFFSET_MIDDLE; Index: pTk/tkProperty.c --- Tk800.021/pTk/tkProperty.c Sun Dec 12 13:58:37 1999 +++ Tk800.022/pTk/tkProperty.c Sat May 13 10:06:52 2000 @@ -284,14 +284,17 @@ { XDeleteProperty(Tk_Display(tkwin), xid, atom); if (result != TCL_OK) - goto xError; + { + Tcl_SprintfResult(interp, "XError in XDeleteProperty()"); + goto done; + } } else { long unsigned int size = 0; int format = PropertyExists(tkwin, xid, atom, &size); if (result != TCL_OK) - Tcl_SprintfResult(interp, "XError occured"); + Tcl_SprintfResult(interp, "XError in occured"); else if (c == 'e') { Tcl_IntResults(interp, 1, 0, format); @@ -417,7 +420,4 @@ if (errorHandler) Tk_DeleteErrorHandler(errorHandler); return result; - xError: - Tcl_SprintfResult(interp, "XError occured"); - goto done; } Index: ptked --- Tk800.021/ptked Mon Mar 27 15:56:00 2000 +++ Tk800.022/ptked Sat Apr 29 09:20:31 2000 @@ -6,7 +6,7 @@ use Cwd; use vars qw($VERSION $portfile); -$VERSION = '3.006'; # $Id: //depot/Tk8/ptked#22 $ +$VERSION = '3.006'; # $Id: //depot/Tk8/ptked#23 $ my %opt; INIT @@ -53,7 +53,7 @@ use Tk; use Tk::DropSite qw(XDND KDE Sun); use Tk::DragDrop qw(XDND KDE Sun); -use Tk::widgets qw(TextUndo Scrollbar); +use Tk::widgets qw(TextUndo Scrollbar Menu); use Getopt::Std; # use Tk::ErrorDialog; Index: t/browseentry.t --- Tk800.021/t/browseentry.t Sat Mar 25 11:07:58 2000 +++ Tk800.022/t/browseentry.t Sat Apr 29 10:48:10 2000 @@ -5,7 +5,7 @@ BEGIN { - plan test => 13; + plan test => 15; }; eval { require Tk }; @@ -55,6 +55,13 @@ ok($browsecmd[0]->isa('Tk::BrowseEntry'), 1, "wrong 1st argument in -browsecmd"); ok($browsecmd[1], 1, "wrong 2nd argument in -browsecmd"); + +my $be2 = $mw->BrowseEntry(-choices => [qw/a b c d e/], + -textvariable => \$bla, + -state => "normal", + )->pack; +ok($@, "", "can't create BrowseEntry"); +ok(Tk::Exists($be2), 1, "BrowseEntry creation failed"); #&Tk::MainLoop; Index: t/dash.t --- /dev/null Sat Jun 19 13:46:56 1999 +++ Tk800.022/t/dash.t Sat Apr 29 10:42:23 2000 @@ -0,0 +1,34 @@ +BEGIN { $^W = 1; $| = 1;} +use strict; +use Test; +use Tk; +use Tk::Photo; + + +my $mw = MainWindow->new(); +$mw->geometry('+100+100'); + +plan tests => 8; + +my $c = $mw->Canvas->pack; +my $p = $mw->Photo(-height => 10, -width => 10); + +$c->configure(-offset => "ne"); +ok($c->cget(-offset), "ne", "-offset wrong (anchor)"); + +$c->configure(-offset => [10,20]); +my $a = $c->cget(-offset); +ok($a->[0], 10, "-offset wrong (x value)"); +ok($a->[1], 20, "-offset wrong (y value)"); + +$c->configure(-offset => ['#',10,20]); +$a = $c->cget(-offset); +ok($a->[0], '#', "-offset wrong (relative)"); +ok($a->[1], 10, "-offset wrong (x value)"); +ok($a->[2], 20, "-offset wrong (y value)"); + +eval { $c->configure(-offset => "wrong") }; +ok($@ =~ /bad offset/, 1, "no error detected"); + +eval { $c->configure(-tile => $p) }; +ok($@, '', "cannot set -tile"); __END_OF_PATCH__