# strip everything before this # cd to your version of Tk-804.026 # and feed this file to /bin/sh # # rm -f grepc rm -f grepperl rm -f grept touch t/fork.t chmod 0444 t/fork.t patch -p1 -N <<'__END_OF_PATCH__' Index: Canvas/Canvas.pm --- Tk-804.026/Canvas/Canvas.pm 2004-02-28 17:21:22.000000000 +0000 +++ Tk-804.027/Canvas/Canvas.pm 2004-03-27 12:57:13.000000000 +0000 @@ -1,6 +1,6 @@ package Tk::Canvas; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #11 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #12 $ =~ /\D(\d+)\s*$/; use Tk qw($XS_VERSION); @@ -1134,11 +1134,17 @@ { for (my $j = 0; $j < 8; $j++) { -# set enc [encoding convertfrom $encoding [format %c [expr {$i+$j}]]] -# if {[catch {format %04X [scan $enc %c]} hexcode]} {set hexcode {}} - my $ch = chr($i+$j); - my $hexcode = sprintf("%04X",ord($ch)); - $result .= '/'.((exists $Tk::psglyphs->{$hexcode}) ? $Tk::psglyphs->{$hexcode} : 'space'); + my $ch; + Tk::catch { $ch = $encoding->decode(chr($i+$j),1) }; + if ($@) + { + $result .= '/space'; + } + else + { + my $hexcode = sprintf("%04X",ord($ch)); + $result .= '/'.((exists $Tk::psglyphs->{$hexcode}) ? $Tk::psglyphs->{$hexcode} : 'space'); + } } $result .= "\n"; } @@ -1149,11 +1155,11 @@ # precalculate entire prolog when this file is loaded # (to speed things up) $Tk::ps_preamable = "%%BeginProlog\n". - CreatePostscriptEncoding('system'). <<'END'; + CreatePostscriptEncoding(Tk::SystemEncoding()). <<'END'; 50 dict begin % This is a standard prolog for Postscript generated by Tk's canvas % widget. -% RCS: @(#) $Id: //depot/Tkutf8/Canvas/Canvas.pm#11 $ +% RCS: @(#) $Id: //depot/Tkutf8/Canvas/Canvas.pm#12 $ % The definitions below just define all of the variables used in % any of the procedures here. This is needed for obscure reasons Index: Change.log --- Tk-804.026/Change.log 2004-03-18 21:44:26.000000000 +0000 +++ Tk-804.027/Change.log 2004-04-11 19:39:42.000000000 +0100 @@ -1,3 +1,142 @@ +Change 3278 on 2004/04/11 by nick@llama + + Change VERSION to 804.027 + +Change 3277 on 2004/04/08 by nick@camel + + Win32 cannot do CORE::exit. + +Change 3276 on 2004/04/08 by nick@llama + + Forgot to add fork.t test to perforce + +Change 3275 on 2004/04/08 by nick@llama + + XS variant of Slaven's fix for + [cpan #5783] fork/CORE::exit does not work anymore + +Change 3273 on 2004/04/03 by nick@camel + + Tidy up the simple minded Win32Site stuff to + it follows current DragDrop calling conventions etc. + +Change 3271 on 2004/04/03 by nick@camel + + Avoid vtable mess of LangWinChildProc and possible + hInstance issues by having Tk define an CS_OWNDC window + class for Tk::GLX to use. + +Change 3270 on 2004/04/03 by nick@dromedary + + Avoid perl-ish comment in comment looking like pragma + +Change 3267 on 2004/04/02 by nick@ElixentWinXP + + #include path wasn't right after install + +Change 3263 on 2004/03/31 by nick@camel + + Update .t/.m + +Change 3262 on 2004/03/31 by nick@camel + + Add a LangWinChildProc() wrapper on the special + TkWinChildProc() + +Change 3259 on 2004/03/28 by nick@llama + + JPEG fix for SPARC-64 etc. where LDFLAGs are needed. + +Change 3251 on 2004/03/27 by nick@camel + + Reinstate wm imageicon on Win32 + +Change 3250 on 2004/03/27 by nick@camel + + Now we use PoitToWindow for Drag&Drop we need + a Win32 version that works. + +Change 3249 on 2004/03/27 by nick@camel + + Dummy 'wm wrapper' command for Win32 + +Change 3248 on 2004/03/27 by nick@camel + + Missing dTHX for non GCC + +Change 3247 on 2004/03/27 by nick@llama + + Drop LIB="$(LIB)" from PASTHRU - it breaks cygwin + which inherits LIB from environment, and is not used + anywhere in Tk. + +Change 3245 on 2004/03/27 by nick@llama + + Revert to using system encoding in PostScript, + but make sure we set up CurrentEncoding. + +Change 3244 on 2004/03/27 by nick@llama + + REFCNT issue with SystemEncoding + +Change 3243 on 2004/03/27 by nick@llama + + Fix PostScript text being function of locale when Font encoding + isn't. Also makes it match %%DocumentData: Clean7Bit claim. + +Change 3242 on 2004/03/27 by nick@llama + + Add more ->geometry calls (shown up by make test in Xvnc) + to make tests non-interactive. + +Change 3241 on 2004/03/26 by nick@llama + + MaxSize patch to re-enable Maximize button on KDE3.2 + from https://sourceforge.net/tracker/index.php?func=detail&aid=915350&group_id=12997&atid=112997 + +Change 3240 on 2004/03/26 by nick@llama + + This patch by Ondrej Koala Vacha (via Slaven) forwards the + -font option also to the Listbox portion of Tk::BrowseEntry. + +Change 3239 on 2004/03/24 by nick@llama + + Use different arg reordering to allow Win32 users + to have as many -topmost (sic) windows as they like. + +Change 3238 on 2004/03/24 by nick@llama + + Tweak the Scrolled test + +Change 3232 on 2004/03/23 by nick@llama + + More safety still for SystemEncoding() + +Change 3231 on 2004/03/23 by nick@llama + + Extra safety in SystemEncoding() detection. + Skip JP.t and KR.t unless locale can represent key codepoints. + +Change 3227 on 2004/03/22 by nick@llama + + Move grep* util scripts out of Tk + +Change 3223 on 2004/03/21 by nick@llama + + Fix for non-GCC threaded/multiplicity builds. + +Change 3221 on 2004/03/21 by nick@llama + + Cancelled afters can have repeat called too. + +Change 3217 on 2004/03/19 by nick@llama + + New YML + +Change 3215 on 2004/03/18 by nick@llama + + Tk-804.026 Release Preparation + Change 3214 on 2004/03/18 by nick@llama Bump version to Tk804.026 Index: DragDrop/Win32Site/Win32Site.pm --- Tk-804.026/DragDrop/Win32Site/Win32Site.pm 2004-01-10 17:48:14.000000000 +0000 +++ Tk-804.027/DragDrop/Win32Site/Win32Site.pm 2004-04-03 18:57:54.000000000 +0100 @@ -1,7 +1,7 @@ package Tk::DragDrop::Win32Site; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #7 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #8 $ =~ /\D(\d+)\s*$/; use Tk qw($XS_VERSION); require DynaLoader; @@ -23,7 +23,6 @@ my $w = $site->widget; $w->BindClientMessage(WM_DROPFILES,[\&Win32Drop,$site]); DragAcceptFiles($w,1); - warn "Enable $w"; } sub Win32Drop @@ -32,7 +31,7 @@ my ($w,$site,$msg,$wParam,$lParam) = @_; my ($x,$y,@files) = DropInfo($wParam); my $cb = $site->{'-dropcommand'}; - $site->Apply(-entercommand => $x, $y, 0); + $site->Apply(-entercommand => $x, $y, 1); if ($cb) { foreach my $file (@files) @@ -40,10 +39,10 @@ # print "$file @ $x,$y\n"; $w->clipboardClear; $w->clipboardAppend('--',$file); - $cb->Call('CLIPBOARD',$x,$y); + $cb->Call('CLIPBOARD',Win32Drop => ['STRING'],$x,$y); } } - $site->Apply(-entercommand => $x, $y, 1); + $site->Apply(-entercommand => $x, $y, 0); return 0; } Index: DragDrop/site_test --- Tk-804.026/DragDrop/site_test 2004-03-17 21:15:39.000000000 +0000 +++ Tk-804.027/DragDrop/site_test 2004-04-03 18:57:54.000000000 +0100 @@ -97,7 +97,7 @@ sub ShowTargets { - my ($ld,$seln,$action,$targ,$x,$y) = @_; + my ($lb,$seln,$action,$targ,$x,$y) = @_; my $own = $lb->SelectionExists('-selection'=>$seln); unless ($targ && @$targ) { @@ -136,13 +136,13 @@ } else { + $STRING = $string; $string =~ s/([^\x20-\x7e\xa0-\xff])/sprintf("\\x{%x}",ord($1))/ge; if (length($string) > MAX_LEN()) { substr($string,MAX_LEN()-3) = "..." } print "$_:$string\n"; - $STRING = $string; } } } Index: Event/Event.pm --- Tk-804.026/Event/Event.pm 2004-03-18 21:15:30.000000000 +0000 +++ Tk-804.027/Event/Event.pm 2004-04-11 19:38:23.000000000 +0100 @@ -1,8 +1,8 @@ package Tk::Event; use vars qw($VERSION $XS_VERSION @EXPORT_OK); END { CleanupGlue() } -$VERSION = sprintf '4.%03d', q$Revision: #14 $ =~ /\D(\d+)\s*$/; -$XS_VERSION = '804.026'; +$VERSION = sprintf '4.%03d', q$Revision: #15 $ =~ /\D(\d+)\s*$/; +$XS_VERSION = '804.027'; use base qw(Exporter); use XSLoader; @EXPORT_OK = qw($XS_VERSION DONT_WAIT WINDOW_EVENTS FILE_EVENTS Index: Event/Event.xs --- Tk-804.026/Event/Event.xs 2004-03-17 15:38:21.000000000 +0000 +++ Tk-804.027/Event/Event.xs 2004-04-09 10:13:37.000000000 +0100 @@ -20,6 +20,8 @@ extern void TclInitSubsystems(CONST char *argv0); +static int parent_pid = 0; + static SV * FindVarName(pTHX_ char *varName,int flags) { @@ -1237,13 +1239,30 @@ #define pTk_exit(status) TclpExit(status) -#define pTk_END() Tcl_Finalize() +#define IsParentProcess() (PerlProc_getpid() == parent_pid) + +void pTk_END() +{ + dTHX; + if (IsParentProcess()) + { + Tcl_Finalize(); + } +} MODULE = Tk PACKAGE = Tk PREFIX = pTk_ PROTOTYPES: ENABLE void +pTk_IsParentProcess(...) +CODE: + { + ST(0) = (IsParentProcess()) ? &PL_sv_yes : &PL_sv_no; + XSRETURN(1); + } + +void pTk_END() void @@ -1524,6 +1543,7 @@ install_vtab(aTHX_ "TkeventVtab",TkeventVGet(),sizeof(TkeventVtab)); sv_setiv(FindVarName(aTHX_ "LangDebug",GV_ADD|GV_ADDMULTI),1); TclInitSubsystems(SvPV_nolen(get_sv("0",FALSE))); + parent_pid = PerlProc_getpid(); } Index: Event/pTkCallback.c --- Tk-804.026/Event/pTkCallback.c 2004-03-17 20:31:38.000000000 +0000 +++ Tk-804.027/Event/pTkCallback.c 2004-03-21 21:53:15.000000000 +0000 @@ -99,9 +99,14 @@ LangCopyCallback(sv) SV *sv; { - dTHXs; if (sv) - SvREFCNT_inc(sv); + { +#if !defined(__GNUC__) || defined(__STRICT_ANSI__) || defined(PERL_GCC_PEDANTIC) + /* Unless using GCC extensions we need PL_Sv */ + dTHX; +#endif + SvREFCNT_inc(sv); + } return sv; } Index: JPEG/jpeg/Makefile.maybe --- Tk-804.026/JPEG/jpeg/Makefile.maybe 2003-12-23 10:57:15.000000000 +0000 +++ Tk-804.027/JPEG/jpeg/Makefile.maybe 2004-03-26 22:47:27.000000000 +0000 @@ -32,6 +32,7 @@ { $ENV{CC} = $Config{cc}; local $ENV{CFLAGS} = "$Config{ccflags} $Config{cccdlflags}"; + local $ENV{LDFLAGS} = "$Config{ccflags} $Config{ldflags}"; system(sh => "./configure"); } 1; Index: JPEG/t/Read.t --- Tk-804.026/JPEG/t/Read.t 2003-08-24 17:46:53.000000000 +0100 +++ Tk-804.027/JPEG/t/Read.t 2004-03-27 10:28:26.000000000 +0000 @@ -6,6 +6,7 @@ my $file = (@ARGV) ? shift : 'jpeg/testimg.jpg'; my $mw = MainWindow->new; +$mw->geometry('+10+10'); my $image = $mw->Photo('-format' => 'jpeg', -file => $file); $mw->Label(-image => $image)->pack; $mw->update; Index: JPEG/t/more.t --- Tk-804.026/JPEG/t/more.t 2003-08-24 17:46:53.000000000 +0100 +++ Tk-804.027/JPEG/t/more.t 2004-03-27 10:29:00.000000000 +0000 @@ -1,8 +1,8 @@ #!/usr/local/bin/perl -w use strict; use Test; -use Tk; -use Tk::Photo; +use Tk; +use Tk::Photo; my @writeopt = ([],[-grayscale],[-progressive],[-quality => 13],[-smooth => 12]); @@ -15,6 +15,7 @@ my $file = (@ARGV) ? shift : 'jpeg/testimg.jpg'; my $mw = MainWindow->new; +$mw->geometry('+10+10'); my $image; eval {$image = $mw->Photo('-format' => 'jpeg', -file => $file)}; ok($@,'',"Error $@"); @@ -31,18 +32,18 @@ { unlink("testout.jpg") if -f "testout.jpg"; eval { $image->write("testout.jpg", -format => ['jpeg',@$opt]) }; - ok($@,'',"Error $@"); + ok($@,'',"Error $@"); my $ok = (-s "testout.jpg") ? 1 : 0; ok($ok,1,"File has no size"); eval {$image2 = $mw->Photo('-format' => 'jpeg', -file => "testout.jpg")}; - ok($@,'',"Error $@"); + ok($@,'',"Error $@"); ok($image2->width,227,"Wrong width"); ok($image2->height,149,"Wrong height"); - - $l->configure(-image => $image2); - $mw->update; - ok($l->width,227,"Wrong width"); + + $l->configure(-image => $image2); + $mw->update; + ok($l->width,227,"Wrong width"); ok($l->height,149,"Wrong height"); } @@ -50,7 +51,7 @@ $mw->after(1000,[destroy => $mw]); MainLoop; -END +END { unlink "testout.jpg" if -f "testout.jpg"; } Index: MANIFEST --- Tk-804.026/MANIFEST 2004-03-18 13:55:42.000000000 +0000 +++ Tk-804.027/MANIFEST 2004-04-08 12:16:50.000000000 +0100 @@ -266,9 +266,6 @@ generate geo_mgr geom -grepc -grepperl -grept grid_adj grid_test gridbug @@ -1845,6 +1842,7 @@ t/fileevent.t t/fileselect.t t/font.t +t/fork.t t/geomgr.t t/iso8859-1.t t/JP.dat Index: PNG/t/basic.t --- Tk-804.026/PNG/t/basic.t 2003-11-29 11:39:32.000000000 +0000 +++ Tk-804.027/PNG/t/basic.t 2004-03-27 10:27:00.000000000 +0000 @@ -1,6 +1,6 @@ -#!perl -BEGIN -{ +#!perl +BEGIN +{ $| = 1; print "1..4\n"; } @@ -8,6 +8,7 @@ use Tk::PNG; print "ok 1\n"; my $mw = MainWindow->new; +$mw->geometry('+10+10'); my $img = $mw->Photo(-format => "png", -file => "pngtest.png"); print "not " unless $img; print "ok 2\n"; Index: README --- Tk-804.026/README 2004-03-08 10:15:17.000000000 +0000 +++ Tk-804.027/README 2004-04-11 19:29:38.000000000 +0100 @@ -7,7 +7,7 @@ derived from those of the orignal Tix4.1.3 or Tk8.4.* sources. See doc/license.html for details of this license. -Tk804.026 is now considered production worthy. +Tk804.027 is now considered production worthy. (Previous stable release being Tk800.025.) This a re-port of a perl interface to Tk8.4. @@ -20,7 +20,7 @@ The goal of this release is Unicode support via perl's and core-tk's use of UTF-8. -Tk804.026 builds and loads into a threaded perl but is NOT +Tk804.027 builds and loads into a threaded perl but is NOT yet thread safe. This Tk804 is only likely to work with perl5.8.0 or later. Index: Tixish/BrowseEntry.pm --- Tk-804.026/Tixish/BrowseEntry.pm 2003-12-21 20:45:05.000000000 +0000 +++ Tk-804.027/Tixish/BrowseEntry.pm 2004-03-26 21:49:12.000000000 +0000 @@ -8,7 +8,7 @@ package Tk::BrowseEntry; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #12 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #13 $ =~ /\D(\d+)\s*$/; use Tk qw(Ev); use Carp; @@ -96,6 +96,7 @@ $w->{'_BE_popped'} = 0; $w->Delegates(get => $sl, DEFAULT => $e); $w->ConfigSpecs( + -font => [qw/DESCENDANTS font Font/], -listwidth => [qw/PASSIVE listWidth ListWidth/, undef], -listheight => [{-height => $sl}, qw/listHeight ListHeight/, undef], -listcmd => [qw/CALLBACK listCmd ListCmd/, undef], Index: Tk.pm --- Tk-804.026/Tk.pm 2004-03-18 21:44:27.000000000 +0000 +++ Tk-804.027/Tk.pm 2004-04-11 19:39:43.000000000 +0100 @@ -62,13 +62,13 @@ use Carp; # Record author's perforce depot record -$Tk::CHANGE = q$Change: 3215 $; +$Tk::CHANGE = q$Change: 3279 $; # $tk_version and $tk_patchLevel are reset by pTk when a mainwindow # is created, $VERSION is checked by bootstrap $Tk::version = '8.4'; $Tk::patchLevel = '8.4'; -$Tk::VERSION = '804.026'; +$Tk::VERSION = '804.027'; $Tk::XS_VERSION = $Tk::VERSION; $Tk::strictMotif = 0; Index: Tk.xs --- Tk-804.026/Tk.xs 2004-03-17 15:38:01.000000000 +0000 +++ Tk-804.027/Tk.xs 2004-03-28 20:50:55.000000000 +0100 @@ -83,14 +83,38 @@ { Display *dpy = Tk_Display(tkwin); Window root = RootWindowOfScreen(Tk_Screen(tkwin)); - Window win; + Window win = None; if (dest == None) dest = root; +#ifdef WIN32 + { + HWND hwnd = (HWND) Tk_GetHWND(dest); + RECT r; + if (GetWindowRect(hwnd,&r)) + { + POINT pt; + HWND child; + pt.x = x - r.left; + pt.y = y - r.top; + child = ChildWindowFromPoint(hwnd, pt); + if (child != hwnd) + { + TkWindow *winPtr = (TkWindow *) Tk_HWNDToWindow(child); + if (winPtr) + { + win = winPtr->window; + } + } + } + return (IV) win; + } +#else if (!XTranslateCoordinates(dpy, root, dest, x, y, &x, &y, &win)) { win = None; } return (IV) win; +#endif } static SV * Index: Tk/After.pm --- Tk-804.026/Tk/After.pm 2004-03-17 20:33:56.000000000 +0000 +++ Tk-804.027/Tk/After.pm 2004-03-21 17:58:17.000000000 +0000 @@ -5,7 +5,7 @@ use Carp; use vars qw($VERSION); -$VERSION = '4.007'; # $Id: //depot/Tkutf8/Tk/After.pm#10 $ +$VERSION = '4.007'; # $Id: //depot/Tkutf8/Tk/After.pm#11 $ sub _cancelAll { @@ -20,6 +20,7 @@ } sub Tk::After::Cancelled::once { } +sub Tk::After::Cancelled::repeat { } sub submit { Index: Tk/MMutil.pm --- Tk-804.026/Tk/MMutil.pm 2003-12-10 19:49:23.000000000 +0000 +++ Tk-804.027/Tk/MMutil.pm 2004-03-27 14:55:55.000000000 +0000 @@ -9,7 +9,7 @@ use File::Basename; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #20 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #21 $ =~ /\D(\d+)\s*$/; # warn __FILE__." $VERSION\n"; @@ -220,8 +220,13 @@ my $str = $self->MM::pasthru; if ($str =~ s/^\s+INC=.*\n//m) { - return "\n#Do NOT pasthru INC for Tk - it is computed by subdir\n".$str; + $str = "# - Do NOT pasthru INC for Tk - it is computed by subdir\n$str" } + if ($str =~ s/\bLIB="\$\(LIB\)"//) + { + $str = qq[# - Drop LIB="\$(LIB)" - not used\n$str]; + } + $str = "#Tk::MMutil pasthru\n$str"; return $str; } Index: Tk/MainWindow.pm --- Tk-804.026/Tk/MainWindow.pm 2003-12-23 10:49:37.000000000 +0000 +++ Tk-804.027/Tk/MainWindow.pm 2004-04-08 12:42:17.000000000 +0100 @@ -8,7 +8,7 @@ use strict; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #11 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #12 $ =~ /\D(\d+)\s*$/; use Tk::CmdLine; use Tk qw(catch); @@ -153,7 +153,7 @@ END { - if ($pid == $$) + if (Tk::IsParentProcess()) { foreach my $top (values %Windows) { Index: TkXSUB.def --- Tk-804.026/TkXSUB.def 2003-07-25 22:50:34.000000000 +0100 +++ Tk-804.027/TkXSUB.def 2004-03-24 15:29:49.000000000 +0000 @@ -6,7 +6,7 @@ MkXSUB("Tk::itemstyle", XS_Tk_itemstyle, XStoTclCmd, Tix_ItemStyleCmd) MkXSUB("Tk::winfo", XS_Tk_winfo, XStoSubCmd, Tk_WinfoObjCmd) MkXSUB("Tk::font", XS_Tk_font, XStoFont, Tk_FontObjCmd) -MkXSUB("Tk::wm", XS_Tk_wm, XStoSubCmd, Tk_WmObjCmd) +MkXSUB("Tk::wm", XS_Tk_wm, XStoAfterSub, Tk_WmObjCmd) MkXSUB("Tk::grab", XS_Tk_grab, XStoSubCmd, Tk_GrabObjCmd) MkXSUB("Tk::focus", XS_Tk_focus, XStoSubCmd, Tk_FocusObjCmd) MkXSUB("Tk::event", XS_Tk_event, XStoEvent, Tk_EventObjCmd) Index: encGlue.c --- Tk-804.026/encGlue.c 2004-03-18 20:34:01.000000000 +0000 +++ Tk-804.027/encGlue.c 2004-03-28 20:50:55.000000000 +0100 @@ -541,12 +541,16 @@ { if (!system_encoding) { - char *codeset = "iso8859-1"; + char *codeset = NULL; /* This assumes perl's Configure probe stuff is #include-d above */ #if defined(HAS_NL_LANGINFO) && defined(CODESET) codeset = nl_langinfo(CODESET); #endif + if (!codeset) + codeset = "iso8859-1"; system_encoding = Tcl_GetEncoding(NULL,codeset); + if (!system_encoding) + system_encoding = Tcl_GetEncoding(NULL,"iso8859-1"); } return system_encoding; } @@ -556,7 +560,8 @@ SV * Lang_SystemEncoding(void) { - return PerlEncObj(GetSystemEncoding()); + dTHX; + return SvREFCNT_inc(PerlEncObj(GetSystemEncoding())); } Tcl_Encoding Index: pTk/mTk/generic/tkFont.c --- Tk-804.026/pTk/mTk/generic/tkFont.c 2004-01-25 14:27:01.000000000 +0000 +++ Tk-804.027/pTk/mTk/generic/tkFont.c 2004-03-27 12:48:19.000000000 +0000 @@ -2833,7 +2833,7 @@ p +=(charsize= Tcl_UtfToUniChar(p,&ch)); Tcl_UtfToExternal(interp,NULL,last_p,charsize,0,NULL,one_char,4, NULL,&bytecount,NULL); - if (bytecount == 1) { + if (bytecount == 1) { c = UCHAR(one_char[0]); /* c = UCHAR( ch & 0xFF) */; if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20) Index: pTk/mTk/unix/tkUnixWm.c --- Tk-804.026/pTk/mTk/unix/tkUnixWm.c 2003-12-30 11:52:17.000000000 +0000 +++ Tk-804.027/pTk/mTk/unix/tkUnixWm.c 2004-03-26 22:03:02.000000000 +0000 @@ -2424,6 +2424,13 @@ wmPtr->maxWidth = width; wmPtr->maxHeight = height; wmPtr->flags |= WM_UPDATE_SIZE_HINTS; + + if (width <= 0 && height <= 0) { + wmPtr->sizeHintsFlags &= ~PMaxSize; + } else { + wmPtr->sizeHintsFlags |= PMaxSize; + } + WmUpdateGeom(wmPtr, winPtr); return TCL_OK; } @@ -4379,7 +4386,7 @@ hintsPtr->max_aspect.x = wmPtr->maxAspect.x; hintsPtr->max_aspect.y = wmPtr->maxAspect.y; hintsPtr->win_gravity = wmPtr->gravity; - hintsPtr->flags = wmPtr->sizeHintsFlags | PMinSize | PMaxSize; + hintsPtr->flags = wmPtr->sizeHintsFlags | PMinSize; /* * If the window isn't supposed to be resizable, then set the Index: pTk/mTk/win/tkWinInt.h --- Tk-804.026/pTk/mTk/win/tkWinInt.h 2004-01-12 21:31:32.000000000 +0000 +++ Tk-804.027/pTk/mTk/win/tkWinInt.h 2004-04-03 18:57:55.000000000 +0100 @@ -124,6 +124,7 @@ #define TK_WIN_TOPLEVEL_CLASS_NAME "TkTopLevel" #define TK_WIN_CHILD_CLASS_NAME "TkChild" +#define TK_WIN_OWNDC_CLASS_NAME "TkOwnDC" /* * The following variable is a translation table between X gc functions and Index: pTk/mTk/win/tkWinWm.c --- Tk-804.026/pTk/mTk/win/tkWinWm.c 2004-01-12 21:31:33.000000000 +0000 +++ Tk-804.027/pTk/mTk/win/tkWinWm.c 2004-03-28 20:50:56.000000000 +0100 @@ -546,6 +546,9 @@ static int WmWithdrawCmd _ANSI_ARGS_((Tk_Window tkwin, TkWindow *winPtr, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static int WmWrapperCmd _ANSI_ARGS_((Tk_Window tkwin, + TkWindow *winPtr, Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static void WmUpdateGeom _ANSI_ARGS_((WmInfo *wmPtr, TkWindow *winPtr)); @@ -2447,7 +2450,7 @@ "iconwindow", "maxsize", "minsize", "overrideredirect", "positionfrom", "protocol", "resizable", "sizefrom", "stackorder", "state", "title", "transient", - "withdraw", (char *) NULL }; + "withdraw", "wrapper", (char *) NULL }; enum options { WMOPT_ASPECT, WMOPT_ATTRIBUTES, WMOPT_CLIENT, WMOPT_COLORMAPWINDOWS, WMOPT_COMMAND, WMOPT_DEICONIFY, WMOPT_FOCUSMODEL, WMOPT_FRAME, @@ -2456,7 +2459,7 @@ WMOPT_ICONWINDOW, WMOPT_MAXSIZE, WMOPT_MINSIZE, WMOPT_OVERRIDEREDIRECT, WMOPT_POSITIONFROM, WMOPT_PROTOCOL, WMOPT_RESIZABLE, WMOPT_SIZEFROM, WMOPT_STACKORDER, WMOPT_STATE, WMOPT_TITLE, WMOPT_TRANSIENT, - WMOPT_WITHDRAW }; + WMOPT_WITHDRAW, WMOPT_WRAPPER }; int index, length; char *argv1; TkWindow *winPtr; @@ -2573,6 +2576,8 @@ return WmTransientCmd(tkwin, winPtr, interp, objc, objv); case WMOPT_WITHDRAW: return WmWithdrawCmd(tkwin, winPtr, interp, objc, objv); + case WMOPT_WRAPPER: + return WmWrapperCmd(tkwin, winPtr, interp, objc, objv); } /* This should not happen */ @@ -7205,39 +7210,60 @@ TkWindow *winPtr; { WmInfo *wmPtr = winPtr->wmInfoPtr; - Pixmap old = wmPtr->hints.icon_pixmap; - int lWidth = GetSystemMetrics(SM_CXICON); - int lHeight = GetSystemMetrics(SM_CYICON); - ICONINFO info; - HICON icon; - info.fIcon = TRUE; - info.xHotspot = 0; - info.yHotspot = 0; - if (wmPtr->hints.icon_pixmap) - { - info.hbmColor = TkWinGetHBITMAP(wmPtr->hints.icon_pixmap); - if (wmPtr->hints.icon_mask) - { - info.hbmMask = TkWinGetHBITMAP(wmPtr->hints.icon_mask); - } - else - { - int size = (lWidth+7)/8*lHeight; - char *bits = ckalloc(size); - memset(bits,0,size); - info.hbmMask = CreateBitmap(lWidth,lHeight,1,1,bits); - ckfree(bits); - } - icon = CreateIconIndirect(&info); - SendMessage(wmPtr->wrapper, WM_SETICON, (WPARAM) ICON_BIG, (LPARAM) icon); - if (!wmPtr->hints.icon_mask) - { - DeleteObject(info.hbmMask); - } + Pixmap pixmap= wmPtr->hints.icon_pixmap; + Tcl_Interp *interp = 0; + if (pixmap){ + int lWidth = GetSystemMetrics(SM_CXICON); + int lHeight = GetSystemMetrics(SM_CYICON); + ICONINFO info; + HICON hIcon; + SIZE size; + WinIconPtr titlebaricon; + BlockOfIconImagesPtr lpIR; + TkWinDrawable* twdPtr = (TkWinDrawable*) pixmap; + + info.fIcon = TRUE; + info.xHotspot = 0; + info.yHotspot = 0; + info.hbmColor = TkWinGetHBITMAP(pixmap); + if (wmPtr->hints.icon_mask) { + info.hbmMask = TkWinGetHBITMAP(wmPtr->hints.icon_mask); + } + else { + int size = (lWidth+7)/8*lHeight; + char *bits = ckalloc(size); + memset(bits,0,size); + info.hbmMask = CreateBitmap(lWidth,lHeight,1,1,bits); + ckfree(bits); + } + hIcon = CreateIconIndirect(&info); + lpIR = (BlockOfIconImagesPtr) ckalloc(sizeof(BlockOfIconImages)); + if (lpIR == NULL) { + DestroyIcon(hIcon); + return; + } + lpIR->nNumImages = 1; + lpIR->IconImages[0].Width = lWidth; + lpIR->IconImages[0].Height = lHeight; + lpIR->IconImages[0].Colors = 1 << twdPtr->bitmap.depth; + lpIR->IconImages[0].hIcon = hIcon; + /* These fields are ignored */ + lpIR->IconImages[0].lpBits = 0; + lpIR->IconImages[0].dwNumBytes = 0; + lpIR->IconImages[0].lpXOR = 0; + lpIR->IconImages[0].lpAND = 0; + titlebaricon = (WinIconPtr) ckalloc(sizeof(WinIconInstance)); + titlebaricon->iconBlock = lpIR; + titlebaricon->refCount = 1; + if (WinSetIcon(interp, titlebaricon, (Tk_Window) winPtr) != TCL_OK) { + /* We didn't use the titlebaricon after all */ + DecrIconRefCount(titlebaricon); + titlebaricon = NULL; + } } else { - SendMessage(wmPtr->wrapper, WM_SETICON, (WPARAM) ICON_BIG, (LPARAM) 0); + WinSetIcon(interp, NULL, (Tk_Window) winPtr); } } @@ -7339,8 +7365,7 @@ } if (objc == 3) { if (wmPtr->hints.flags & IconPixmapHint && wmPtr->iconImage) { - interp->result = Tk_NameOfBitmap(winPtr->display, - wmPtr->hints.icon_pixmap); + Tcl_SetResult(interp, (char *) Tk_NameOfBitmap(winPtr->display, wmPtr->hints.icon_pixmap),TCL_STATIC); } return TCL_OK; } @@ -7374,3 +7399,17 @@ } +static int +WmWrapperCmd(tkwin, winPtr, interp, objc, objv) +Tk_Window tkwin; +TkWindow *winPtr; +Tcl_Interp *interp; +int objc; +Tcl_Obj *CONST objv[]; +{ + register WmInfo *wmPtr = winPtr->wmInfoPtr; + + Tcl_IntResults(interp,2,0,wmPtr->wrapper,0); + return TCL_OK; + +} \ No newline at end of file Index: pTk/mTk/win/tkWinX.c --- Tk-804.026/pTk/mTk/win/tkWinX.c 2003-12-19 11:55:05.000000000 +0000 +++ Tk-804.027/pTk/mTk/win/tkWinX.c 2004-04-03 18:57:55.000000000 +0100 @@ -86,6 +86,7 @@ static HINSTANCE tkInstance = NULL; /* Application instance handle. */ static int childClassInitialized; /* Registered child class? */ static WNDCLASS childClass; /* Window class for child windows. */ +static WNDCLASS ownDCClass; /* Window class for child windows with private DC. */ static int tkPlatformId = 0; /* version of Windows platform */ static Tcl_Encoding keyInputEncoding = NULL;/* The current character * encoding for keyboard input */ @@ -309,6 +310,13 @@ panic("Unable to register TkChild class"); } + ownDCClass = childClass; + ownDCClass.lpszClassName = TK_WIN_OWNDC_CLASS_NAME; + ownDCClass.style = CS_HREDRAW | CS_VREDRAW | CS_OWNDC; + if (!RegisterClass(&ownDCClass)) { + panic("Unable to register TkOwnDC class"); + } + /* * Make sure we cleanup on finalize. */ @@ -343,6 +351,7 @@ if (childClassInitialized) { childClassInitialized = 0; UnregisterClass(TK_WIN_CHILD_CLASS_NAME, hInstance); + UnregisterClass(TK_WIN_OWNDC_CLASS_NAME, hInstance); } if (unicodeEncoding != NULL) { Index: pTk/mTk/xlib/X11/Xlib.h --- Tk-804.026/pTk/mTk/xlib/X11/Xlib.h 2003-12-19 11:55:05.000000000 +0000 +++ Tk-804.027/pTk/mTk/xlib/X11/Xlib.h 2004-04-03 18:57:55.000000000 +0100 @@ -1203,7 +1203,7 @@ -#include "../../tkIntXlibDecls.h" +#include "../pTk/tkIntXlibDecls.h" _XFUNCPROTOEND Index: t/JP.t --- Tk-804.026/t/JP.t 2003-12-08 21:02:10.000000000 +0000 +++ Tk-804.027/t/JP.t 2004-03-23 17:22:27.000000000 +0000 @@ -1,5 +1,17 @@ -use Test::More (tests => 294); use Tk; +use Encode qw(FB_CROAK); +BEGIN +{ + my $enc = Tk::SystemEncoding(); + eval { $enc->encode("\x{30C8}",FB_CROAK) }; + if ($@) + { + my $err = "$@"; + print "1..0 # Skipped: locale's '",$enc->name,"' cannot represent Japanese.\n"; + CORE::exit(0); + } +} +use Test::More (tests => 294); use Tk::widgets qw(Text); my $mw = MainWindow->new; $mw->geometry("+10+10"); Index: t/KR.t --- Tk-804.026/t/KR.t 2003-12-08 21:02:11.000000000 +0000 +++ Tk-804.027/t/KR.t 2004-03-23 17:29:35.000000000 +0000 @@ -1,5 +1,17 @@ -use Test::More (tests => 271); use Tk; +use Encode qw(FB_CROAK); +BEGIN +{ + my $enc = Tk::SystemEncoding(); + eval { $enc->encode("\x{AC00}",FB_CROAK) }; + if ($@) + { + my $err = "$@"; + print "1..0 # Skipped: locale's '",$enc->name,"' cannot represent Korean.\n"; + CORE::exit(0); + } +} +use Test::More (tests => 271); use Tk::widgets qw(Text); my $mw = MainWindow->new; $mw->geometry("+10+10"); Index: t/fileevent.t --- Tk-804.026/t/fileevent.t 2003-07-30 07:09:05.000000000 +0100 +++ Tk-804.027/t/fileevent.t 2004-03-27 10:21:15.000000000 +0000 @@ -145,6 +145,7 @@ $MW->title('ipadm - Administer IP Nodes'); $MW->iconname('ipadm'); $MW->minsize(50, 50); + $MW->geometry("+100+50"); $MW->protocol('WM_DELETE_WINDOW' => \&fini); # Create the menubar and friends. Index: t/fork.t --- /dev/null 2003-09-23 18:59:22.000000000 +0100 +++ Tk-804.027/t/fork.t 2004-04-09 10:13:37.000000000 +0100 @@ -0,0 +1,23 @@ +#!/usr/bin/perl -w + +use strict; +use Test; +use Tk; + +plan tests => 1; + +my $mw = tkinit; + +if ($^O ne 'MSWin32' && fork == 0) { + print "# Child $$\n"; + CORE::exit(); +} +else { + print "# Parent $$\n"; +} +# Pause to allow child to exit +select undef, undef, undef, 0.5; +$mw->update; +ok(1); + +__END__ Index: t/pixmap.t --- Tk-804.026/t/pixmap.t 2003-12-23 18:27:55.000000000 +0000 +++ Tk-804.027/t/pixmap.t 2004-03-27 10:19:42.000000000 +0000 @@ -26,6 +26,7 @@ END use Tk; my $mw = tkinit; +$mw->geometry("+20+20"); my $label = $mw->Label(-image=>$mw->Pixmap(-data=>$icon))->pack; $mw->after(1000,[destroy => $mw]); MainLoop; Index: t/wm-time.t --- Tk-804.026/t/wm-time.t 2003-10-26 18:08:19.000000000 +0000 +++ Tk-804.027/t/wm-time.t 2004-03-27 10:24:42.000000000 +0000 @@ -32,6 +32,7 @@ $mw->update; my $t = $mw->Toplevel(-width => 100, -height => 100); +$t->geometry("-0+0"); my $l2 = $t->Label(-text => 'Content')->pack; $t->bind($event,[\&mapped,"Popup"]); #$l2->bind($event,[\&mapped,"Popup"]); Index: t/zzScrolled.t --- Tk-804.026/t/zzScrolled.t 2003-12-23 10:43:47.000000000 +0000 +++ Tk-804.027/t/zzScrolled.t 2004-03-24 14:14:49.000000000 +0000 @@ -17,7 +17,7 @@ eval { $scrl = $mw->Scrolled('Text', -scrollbars=>'sw', -setgrid=>1); }; ok($@, "", "Problem creating Scrolled('Text')"); ok( Tk::Exists($scrl) ); - eval { $scrl->grid; }; + eval { $scrl->grid(-sticky => 'nw'); }; ok($@, "", 'Problem managing Scrolled Text with grid'); eval { $scrl->update; }; ok($@, "", 'Problem with update'); @@ -98,6 +98,9 @@ ok($@, "", "Sizechg: Error reset update configure $opt"); eval { $newgeo = $scrl->geometry; }; ok($@, "", "Sizechk: reset geometry $opt"); + # Next one often fails - window stays same size but moves + # e.g. expect 589x341+0+32 get 589x341+17+32 + # tried changing -sticky above as a fix? ok($newgeo, $oldgeo, "Sizechk: geometry has not changed not reset" . " for $opt => $oldsize+($chg)" ); Index: tkGlue.c --- Tk-804.026/tkGlue.c 2004-03-17 23:01:13.000000000 +0000 +++ Tk-804.027/tkGlue.c 2004-04-03 18:57:55.000000000 +0100 @@ -1654,7 +1654,7 @@ if ($object->can('_Tk_passWidget') && $object->_Tk_passWidget($widget) { - # proceed as if it wasn't an object + proceed_as_non_object(); } */ if (!sv_isobject(sv)) @@ -4522,7 +4522,9 @@ SV *data = struct_sv(NULL, sizeof(EventAndKeySym)); EventAndKeySym *info = (EventAndKeySym *) SvPVX(data); int result; +#if 0 LangDebug("%s %d '%s'\n",Tk_PathName(tkwin), message,SvPV(sv,na)); +#endif info->keySym = 0; info->interp = interp; info->window = w; Index: tkfontsel --- Tk-804.026/tkfontsel 2003-09-07 22:19:38.000000000 +0100 +++ Tk-804.027/tkfontsel 2004-03-24 14:29:32.000000000 +0000 @@ -24,10 +24,22 @@ ); my $text = $mw->Scrolled(Text => -font => $font, -width => 40, -height => 20)->grid(-sticky => 'nsew', -columnspan => 6); -$text->insert('end',<<"END"); -Example Text - list -\x{20ac}40 Only. -END + +my $l = ''; +for my $ch (0x20..0x7E,0xa0..0xff) + { + $l .= chr($ch); + if (length($l) == 16) + { + $text->insert(end => "$l\n"); + $l = ''; + } + } + +#$text->insert('end',<<"END"); +#Example Text - list +#\x{20ac}40 Only. +#END MainLoop; __END_OF_PATCH__