diff --git a/Canvas/Canvas.xs b/Canvas/Canvas.xs index c69d821d..e8193922 100644 --- a/Canvas/Canvas.xs +++ b/Canvas/Canvas.xs @@ -28,7 +28,7 @@ void canvas(...) CODE: { - XSRETURN(XSTkCommand(cv,1,Tk_CanvasObjCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,1,Tk_CanvasObjCmd,items,&ST(0))); } diff --git a/Change.log b/Change.log index e9059d6d..d194f2be 100644 --- a/Change.log +++ b/Change.log @@ -1,3 +1,53 @@ +Change 3032 on 2003/12/10 by nick@llama + + Makefile generation tweaks: + Perl's %Config can have leading/trailing spaces + Try propagating perl's values to CFLAGs for JPEG/jpeg/configure + +Change 3031 on 2003/12/10 by nick@llama + + Steve's patch for slaves with test etc. + (In respnse to report from Christoph Fuchs ) + +Change 3030 on 2003/12/10 by nick@llama + + Re-engineer TkFontGet(Points|Pixels) to take a Screen * + rather an a tkwin. Tk_Font has one of those, and is all they + need. So now Tk_PostscriptFontName() can return points correctly + without help or change to public Tk_Xxx API. + +Change 3029 on 2003/12/10 by nick@llama + + Slaven's test fixes for font issues. + +Change 3028 on 2003/12/10 by nick@llama + + Slaven's FBox as directory chooser patch (thanks) + +Change 3027 on 2003/12/10 by nick@llama + + Spelling of dependencies patch from RT. + +Change 3026 on 2003/12/09 by nick@llama + + Fix XSRETURN(Function()) properly + +Change 3025 on 2003/12/09 by nick@llama + + Specimen XSRETURN(Functtion()) that was segfulting on + Steve's G5. 'grep' shows More to come ... + +Change 3024 on 2003/12/08 by nick@llama + + Slaven's patches: + TkTest.pm and use in listbox.t for float epsilon + Add ->geometry to all test files. + ProgressBar fix + +Change 3023 on 2003/12/07 by nick@llama + + Update Change.log + Change 3019 on 2003/12/06 by nick@camel MinGW libpng makefile was not checked in or in MANIFEST diff --git a/Entry/Entry.xs b/Entry/Entry.xs index d1b5def9..ef182186 100644 --- a/Entry/Entry.xs +++ b/Entry/Entry.xs @@ -24,14 +24,14 @@ void entry(...) CODE: { - XSRETURN(XSTkCommand(cv,0,Tk_EntryObjCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,0,Tk_EntryObjCmd,items,&ST(0))); } void spinbox(...) CODE: { - XSRETURN(XSTkCommand(cv,0,Tk_SpinboxObjCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,0,Tk_SpinboxObjCmd,items,&ST(0))); } PROTOTYPES: DISABLE diff --git a/HList/HList.xs b/HList/HList.xs index ae0ae8de..f8531329 100644 --- a/HList/HList.xs +++ b/HList/HList.xs @@ -31,7 +31,7 @@ void hlist(...) CODE: { - XSRETURN(XSTkCommand(cv,1,Tix_HListCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,1,Tix_HListCmd,items,&ST(0))); } BOOT: diff --git a/INSTALL b/INSTALL index b73a1d64..736575c2 100644 --- a/INSTALL +++ b/INSTALL @@ -30,7 +30,7 @@ separately: perl Makefile.PL X11INC=/usr/local/share/X11R5/include X11LIB=/usr/local/arch/X11R5/lib -'make test' is a little tedious as it re-checks all the dependancies. +'make test' is a little tedious as it re-checks all the dependencies. perl -Mblib demos/widget diff --git a/InputO/InputO.xs b/InputO/InputO.xs index 4fa59315..b3da8966 100644 --- a/InputO/InputO.xs +++ b/InputO/InputO.xs @@ -31,7 +31,7 @@ void inputo(...) CODE: { - XSRETURN(XSTkCommand(cv,1,Tix_InputOnlyCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,1,Tix_InputOnlyCmd,items,&ST(0))); } BOOT: diff --git a/JPEG/jpeg/Makefile.maybe b/JPEG/jpeg/Makefile.maybe index 5f113bca..a3752aa6 100644 --- a/JPEG/jpeg/Makefile.maybe +++ b/JPEG/jpeg/Makefile.maybe @@ -31,6 +31,7 @@ if ($^O eq 'MSWin32') else { $ENV{CC} = $Config{cc}; + local $ENV{CFLAGS} = "$Config{ccflags} $Config{cccdlflags}"; system("./configure"); } 1; diff --git a/Listbox/Listbox.xs b/Listbox/Listbox.xs index 5398d7bd..7e7c13aa 100644 --- a/Listbox/Listbox.xs +++ b/Listbox/Listbox.xs @@ -27,7 +27,7 @@ void listbox(...) CODE: { - XSRETURN(XSTkCommand(cv,0,Tk_ListboxObjCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,0,Tk_ListboxObjCmd,items,&ST(0))); } BOOT: diff --git a/MANIFEST b/MANIFEST index 3e3eb6fd..a22092b3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1859,6 +1859,7 @@ t/regexp.t t/Require.t t/Trace.t t/trace1.t +t/slaves.t t/widget.t t/wm-time.t t/X.t diff --git a/Menubutton/Menubutton.xs b/Menubutton/Menubutton.xs index e6fb7896..f5ce7791 100644 --- a/Menubutton/Menubutton.xs +++ b/Menubutton/Menubutton.xs @@ -26,7 +26,7 @@ void menubutton(...) CODE: { - XSRETURN(XSTkCommand(cv,0,Tk_MenubuttonObjCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,0,Tk_MenubuttonObjCmd,items,&ST(0))); } BOOT: diff --git a/NBFrame/NBFrame.xs b/NBFrame/NBFrame.xs index 00885a24..1bc98487 100644 --- a/NBFrame/NBFrame.xs +++ b/NBFrame/NBFrame.xs @@ -31,7 +31,7 @@ void nbframe(...) CODE: { - XSRETURN(XSTkCommand(cv,1,Tix_NoteBookFrameCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,1,Tix_NoteBookFrameCmd,items,&ST(0))); } diff --git a/Scale/Scale.xs b/Scale/Scale.xs index f523541c..0f1a868b 100644 --- a/Scale/Scale.xs +++ b/Scale/Scale.xs @@ -26,7 +26,7 @@ void scale(...) CODE: { - XSRETURN(XSTkCommand(cv,0,Tk_ScaleObjCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,0,Tk_ScaleObjCmd,items,&ST(0))); } BOOT: diff --git a/Scrollbar/Scrollbar.xs b/Scrollbar/Scrollbar.xs index b78b8d54..402f194b 100644 --- a/Scrollbar/Scrollbar.xs +++ b/Scrollbar/Scrollbar.xs @@ -30,7 +30,7 @@ void scrollbar(...) CODE: { - XSRETURN(XSTkCommand(cv,1,Tk_ScrollbarCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,1,Tk_ScrollbarCmd,items,&ST(0))); } BOOT: diff --git a/TList/TList.xs b/TList/TList.xs index a015d781..256aa5d3 100644 --- a/TList/TList.xs +++ b/TList/TList.xs @@ -31,7 +31,7 @@ void tlist(...) CODE: { - XSRETURN(XSTkCommand(cv,1,Tix_TListCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,1,Tix_TListCmd,items,&ST(0))); } BOOT: diff --git a/Text/Text.xs b/Text/Text.xs index 4d7e1699..c72ea89b 100644 --- a/Text/Text.xs +++ b/Text/Text.xs @@ -26,7 +26,7 @@ void text(...) CODE: { - XSRETURN(XSTkCommand(cv,1,Tk_TextCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,1,Tk_TextCmd,items,&ST(0))); } BOOT: diff --git a/TixGrid/TixGrid.xs b/TixGrid/TixGrid.xs index c3ab981b..35c3e572 100644 --- a/TixGrid/TixGrid.xs +++ b/TixGrid/TixGrid.xs @@ -31,7 +31,7 @@ void tixGrid(...) CODE: { - XSRETURN(XSTkCommand(cv,1,Tix_GridCmd,items,&ST(0))); + TKXSRETURN(XSTkCommand(cv,1,Tix_GridCmd,items,&ST(0))); } diff --git a/Tk.xs b/Tk.xs index cf3a15aa..5e64ab44 100644 --- a/Tk.xs +++ b/Tk.xs @@ -461,7 +461,7 @@ SV * name; CODE: { Lang_CmdInfo *info = WindowCommand(widget, NULL, 1); - XSRETURN(Call_Tk(info, items, &ST(0))); + TKXSRETURN(Call_Tk(info, items, &ST(0))); } void diff --git a/Tk/FBox.pm b/Tk/FBox.pm index 03dd1d49..2d21dda0 100644 --- a/Tk/FBox.pm +++ b/Tk/FBox.pm @@ -39,7 +39,7 @@ require Tk::Toplevel; use strict; use vars qw($VERSION $updirImage $folderImage $fileImage); -$VERSION = sprintf '4.%03d', q$Revision: #16 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #17 $ =~ /\D(\d+)\s*$/; use base qw(Tk::Toplevel); @@ -106,7 +106,7 @@ EOF $dirMenu->pack(-expand => 'yes', -fill => 'both', -padx => 4); $w->{'icons'} = my $icons = - $w->IconList(-command => ['OkCmd', $w], + $w->IconList(-command => ['OkCmd', $w, 'iconlist'], ); $icons->bind('<>' => [$w, 'ListBrowse']); @@ -441,8 +441,10 @@ sub Update { } else { $flt = _rx_to_glob($flt); } + my $type_dir = $w->cget(-type) eq 'dir'; foreach my $f (sort $sortcmd readdir(FDIR)) { next if $f eq '.' or $f eq '..'; + next if $type_dir && ! -d "$cwd/$f"; # XXX use File::Spec? if ($fltcb) { next if !$fltcb->($w, $f, $cwd); } else { @@ -786,13 +788,16 @@ sub TclFileSplit { # sub OkCmd { my $w = shift; + my $from = shift || "button"; my $filenames = []; for my $item ($w->{'icons'}->Curselection) { push @$filenames, $w->{'icons'}->Get($item); } - if ((@$filenames && !$w->cget('-multiple')) || + if ($w->cget('-type') eq 'dir' && $from ne "iconlist") { + $w->Done($w->{'selectPath'}); + } elsif ((@$filenames && !$w->cget('-multiple')) || ($w->cget('-multiple') && @$filenames == 1)) { my $filename = $filenames->[0]; my $file = JoinFile($w->{'selectPath'}, $filename); @@ -800,8 +805,6 @@ sub OkCmd { $w->ListInvoke($filename); return; } - } elsif ($w->cget('-type') eq 'dir') { - $w->Done($w->{'selectPath'}); } $w->ActivateEnt; diff --git a/Tk/MMutil.pm b/Tk/MMutil.pm index 03dc1e7e..f882926a 100644 --- a/Tk/MMutil.pm +++ b/Tk/MMutil.pm @@ -9,7 +9,7 @@ use Carp; use File::Basename; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #19 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #20 $ =~ /\D(\d+)\s*$/; # warn __FILE__." $VERSION\n"; @@ -60,13 +60,13 @@ sub mTk_postamble my ($self) = @_; my $dep = "config :: \$(C_FILES) \$(H_FILES)\n\t$self->{NOECHO}\$(NOOP)\n"; my $mTk = $self->{'MTK'}; - $dep .= "# Begin Munging dependancies\n"; + $dep .= "# Begin Munging dependencies\n"; foreach my $file (sort keys %$mTk) { $dep .= "$file : ".$mTk->{$file}." \$(TKDIR)/pTk/Tcl-pTk\n"; $dep .= "\t\$(PERL) \$(TKDIR)/pTk/Tcl-pTk ".$mTk->{$file}." $file\n"; } - $dep .= "# End Munging dependancies\n\n"; + $dep .= "# End Munging dependencies\n\n"; return $dep; } diff --git a/Tk/MakeDepend.pm b/Tk/MakeDepend.pm index f42156cb..9c407e3d 100644 --- a/Tk/MakeDepend.pm +++ b/Tk/MakeDepend.pm @@ -11,7 +11,7 @@ $SIG{__DIE__} = \&Carp::confess; use vars qw($VERSION); -$VERSION = sprintf '4.%03d', q$Revision: #10 $ =~ /\D(\d+)\s*$/; +$VERSION = sprintf '4.%03d', q$Revision: #12 $ =~ /\D(\d+)\s*$/; sub scan_file; @@ -211,7 +211,9 @@ sub command_line { unshift(@files,pop(@_)); } - foreach (@_, split(/\s+/,$Config{ccflags})) + my $flags = $Config{ccflags}; + $flags =~ s/^\s+|\s+$//g; + foreach (@_, split(/\s+/,$flags)) { if (/^-I(.*)$/) { @@ -254,7 +256,7 @@ sub command_line my $base = $1; my $file = $_; my %dep; - warn "Finding dependancies for $file\n"; + warn "Finding dependencies for $file\n"; scan_file($_,\%dep); my $str = "\n$base\$(OBJ_EXT) : $base.c"; delete $dep{$file}; diff --git a/Tk/ProgressBar.pm b/Tk/ProgressBar.pm index 5b04b5d9..206d843e 100644 --- a/Tk/ProgressBar.pm +++ b/Tk/ProgressBar.pm @@ -1,10 +1,11 @@ package Tk::ProgressBar; use vars qw($VERSION); -$VERSION = '4.008'; # $Id: //depot/Tkutf8/Tk/ProgressBar.pm#9 $ +$VERSION = sprintf '4.%03d', q$Revision: #10 $ =~ /\D(\d+)\s*$/; use Tk; use Tk::Canvas; +use Tk::Trace; use Carp; use strict; @@ -296,27 +297,27 @@ sub value { sub variable { my $c = shift; - my $val = \$c->{'-variable'}; - my $old = $$val; + my $oldvarref = $c->{'-variable'}; + my $oldval = $$oldvarref if $oldvarref; if(@_) { - my $value = shift; - if (ref $old) + my $varref = shift; + if ($oldvarref) { - $c->{'-value'} = $$old; - untie $$old if tied($$old); + $c->traceVdelete($oldvarref); } - tie $$value,'Tk::Configure',$c,'-value'; - $$val = $value; + $c->{'-variable'} = $varref; + $c->traceVariable($varref, 'w', sub { $c->value($_[1]) }); + $$varref = $oldval; _layoutRequest($c,2); } - $old; + $oldval; } sub Destroyed { my $c = shift; my $var = delete $c->{'-variable'}; - untie $$var if (defined($var) && ref($var)) + $c->traceVdelete($var); } 1; diff --git a/demos/demos/widget_lib/trace2.pl b/demos/demos/widget_lib/trace2.pl index 91bd5e9b..1366d4de 100644 --- a/demos/demos/widget_lib/trace2.pl +++ b/demos/demos/widget_lib/trace2.pl @@ -21,7 +21,7 @@ sub Populate { $self->OnDestroy( sub { my $vref = $self->{_vref}; - $self->traceVdelete ( $self->{_vref} ) if defined $vref; + $self->traceVdelete ( $vref ) if defined $vref; } ); } # end Populate @@ -168,7 +168,7 @@ =head1 ADVERTISED SUBWIDGETS =head1 EXAMPLE - $thumb = $mw->TraceText( -textvariabel => \$scalar ); + my $tt = $mw->TraceText( -textvariable => \$scalar ); =head1 AUTHOR diff --git a/pTk/Makefile.PL b/pTk/Makefile.PL index 12ece5f0..529a1780 100644 --- a/pTk/Makefile.PL +++ b/pTk/Makefile.PL @@ -20,7 +20,7 @@ Tk::MMutil::TkExtMakefile( sub MY::top_targets { my ($self) = @_; local $_ = $self->MM::top_targets; - s/^(\$\(O_FILES\)\s*:.*)$/# Explicit dependancies provided\n# $1/m; + s/^(\$\(O_FILES\)\s*:.*)$/# Explicit dependencies provided\n# $1/m; return $_; } diff --git a/pTk/mTk/generic/tkFont.c b/pTk/mTk/generic/tkFont.c index 947c156c..b09938a4 100644 --- a/pTk/mTk/generic/tkFont.c +++ b/pTk/mTk/generic/tkFont.c @@ -1163,7 +1163,7 @@ Tk_AllocFontFromObj(interp, tkwin, objPtr) descent = fontPtr->fm.descent; fontPtr->underlinePos = descent / 2; - fontPtr->underlineHeight = TkFontGetPixels(tkwin, fontPtr->fa.size) / 10; + fontPtr->underlineHeight = TkFontGetPixels(Tk_Screen(tkwin), fontPtr->fa.size) / 10; if (fontPtr->underlineHeight == 0) { fontPtr->underlineHeight = 1; } @@ -1724,7 +1724,7 @@ Tk_PostscriptFontName(tkfont, dsPtr) } } - return fontPtr->fa.size; + return TkFontGetPoints(fontPtr->screen, fontPtr->fa.size); } /* @@ -3547,8 +3547,8 @@ FieldSpecified(field) */ int -TkFontGetPixels(tkwin, size) - Tk_Window tkwin; /* For point->pixel conversion factor. */ +TkFontGetPixels(screen, size) + Screen *screen; /* For point->pixel conversion factor. */ int size; /* Font size. */ { double d; @@ -3558,8 +3558,8 @@ TkFontGetPixels(tkwin, size) } d = size * 25.4 / 72.0; - d *= WidthOfScreen(Tk_Screen(tkwin)); - d /= WidthMMOfScreen(Tk_Screen(tkwin)); + d *= WidthOfScreen(screen); + d /= WidthMMOfScreen(screen); return (int) (d + 0.5); } @@ -3581,8 +3581,8 @@ TkFontGetPixels(tkwin, size) */ int -TkFontGetPoints(tkwin, size) - Tk_Window tkwin; /* For pixel->point conversion factor. */ +TkFontGetPoints(screen, size) + Screen *screen; /* For pixel->point conversion factor. */ int size; /* Font size. */ { double d; @@ -3592,8 +3592,8 @@ TkFontGetPoints(tkwin, size) } d = -size * 72.0 / 25.4; - d *= WidthMMOfScreen(Tk_Screen(tkwin)); - d /= WidthOfScreen(Tk_Screen(tkwin)); + d *= WidthMMOfScreen(screen); + d /= WidthOfScreen(screen); return (int) (d + 0.5); } diff --git a/pTk/mTk/generic/tkFont.h b/pTk/mTk/generic/tkFont.h index cc57167d..fe633a1d 100644 --- a/pTk/mTk/generic/tkFont.h +++ b/pTk/mTk/generic/tkFont.h @@ -199,15 +199,15 @@ EXTERN int TkFontParseXLFD _ANSI_ARGS_((CONST char *string, TkFontAttributes *faPtr, TkXLFDAttributes *xaPtr)); EXTERN char ** TkFontGetAliasList _ANSI_ARGS_((CONST char *faceName)); EXTERN char *** TkFontGetFallbacks _ANSI_ARGS_((void)); -EXTERN int TkFontGetPixels _ANSI_ARGS_((Tk_Window tkwin, +EXTERN int TkFontGetPixels _ANSI_ARGS_((Screen *screen, int size)); -EXTERN int TkFontGetPoints _ANSI_ARGS_((Tk_Window tkwin, +EXTERN int TkFontGetPoints _ANSI_ARGS_((Screen *screen, int size)); EXTERN char ** TkFontGetGlobalClass _ANSI_ARGS_((void)); EXTERN char ** TkFontGetSymbolClass _ANSI_ARGS_((void)); /* - * Low-level API exported by platform-specific code to generic code. + * Low-level API exported by platform-specific code to generic code. */ EXTERN void TkpDeleteFont _ANSI_ARGS_((TkFont *tkFontPtr)); diff --git a/pTk/mTk/generic/tkGrid.c b/pTk/mTk/generic/tkGrid.c index bb23d89b..255bf2cc 100644 --- a/pTk/mTk/generic/tkGrid.c +++ b/pTk/mTk/generic/tkGrid.c @@ -1173,9 +1173,11 @@ GridSlavesCommand(tkwin, interp, objc, objv) slavePtr->row+slavePtr->numRows-1 < row)) { continue; } - Tcl_ListObjAppendElement(interp, res, - Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin), -1)); - } + /*Tcl_ListObjAppendElement(interp, res, + Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin), -1));*/ + Tcl_ListObjAppendElement(interp, res, + LangWidgetObj(interp,slavePtr->tkwin)); + } Tcl_SetObjResult(interp, res); return TCL_OK; } diff --git a/pTk/mTk/generic/tkPlace.c b/pTk/mTk/generic/tkPlace.c index 6494888e..a7537fbc 100644 --- a/pTk/mTk/generic/tkPlace.c +++ b/pTk/mTk/generic/tkPlace.c @@ -349,8 +349,10 @@ Tk_PlaceObjCmd(clientData, interp, objc, objv) listPtr = Tcl_NewObj(); for (slavePtr = masterPtr->slavePtr; slavePtr != NULL; slavePtr = slavePtr->nextPtr) { - Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin),-1)); + /*Tcl_ListObjAppendElement(interp, listPtr, + Tcl_NewStringObj(Tk_PathName(slavePtr->tkwin),-1));*/ + Tcl_ListObjAppendElement(interp, listPtr, + LangWidgetObj(interp,slavePtr->tkwin)); } Tcl_SetObjResult(interp, listPtr); } diff --git a/pTk/mTk/tclWin/makefile.vc b/pTk/mTk/tclWin/makefile.vc index 83e39bbc..9fb89a6e 100644 --- a/pTk/mTk/tclWin/makefile.vc +++ b/pTk/mTk/tclWin/makefile.vc @@ -52,7 +52,7 @@ the environment. Jump to this line to read the new instructions. # as the root of the install tree. # tidy/clean/hose -- varying levels of cleaning. # genstubs -- Rebuilds the Stubs table and support files (dev only). -# depend -- Generates an accurate set of source dependancies for this +# depend -- Generates an accurate set of source dependencies for this # makefile. Helpful to avoid problems when the sources are # refreshed and you rebuild, but can "overbuild" when common # headers like tclInt.h just get small changes. @@ -635,7 +635,7 @@ $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c ### The following objects are part of the stub library and should not -### be built as DLL objects. -Zl is used to avoid a dependancy on any +### be built as DLL objects. -Zl is used to avoid a dependency on any ### specific c-runtime. $(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c diff --git a/pTk/mTk/tixGeneric/tixForm.c b/pTk/mTk/tixGeneric/tixForm.c index 5c61eb62..e21e93e5 100644 --- a/pTk/mTk/tixGeneric/tixForm.c +++ b/pTk/mTk/tixGeneric/tixForm.c @@ -361,7 +361,9 @@ static int TixFm_Slaves(clientData, interp, argc, argv) } for (clientPtr = masterPtr->client; clientPtr; clientPtr=clientPtr->next) { - Tcl_AppendElement(interp, Tk_PathName(clientPtr->tkwin)); + /*Tcl_AppendElement(interp, Tk_PathName(clientPtr->tkwin));*/ + Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp), + LangWidgetObj(interp,clientPtr->tkwin)); } return TCL_OK; } diff --git a/pTk/mTk/unix/tkUnixFont.c b/pTk/mTk/unix/tkUnixFont.c index 87c3ca62..00fa4d7c 100644 --- a/pTk/mTk/unix/tkUnixFont.c +++ b/pTk/mTk/unix/tkUnixFont.c @@ -1339,7 +1339,7 @@ CreateClosestFont(tkwin, faPtr, xaPtr) if (want.fa.family == NULL) { want.fa.family = Tk_GetUid("fixed"); } - want.fa.size = -TkFontGetPixels(tkwin, faPtr->size); + want.fa.size = -TkFontGetPixels(Tk_Screen(tkwin), faPtr->size); if (want.xa.charset == NULL || *want.xa.charset == '\0') { want.xa.charset = Tk_GetUid("iso8859-1"); /* locale. */ } @@ -1494,10 +1494,10 @@ InitFont(tkwin, fontStructPtr, fontPtr) faPtr = &fontPtr->font.fa; faPtr->family = fa.fa.family; #if 0 - faPtr->size = TkFontGetPoints(tkwin, fa.fa.size); + faPtr->size = TkFontGetPoints(Tk_Screen(tkwin), fa.fa.size); #else /* Actuals are in pixels - says NI-S */ - faPtr->size = -TkFontGetPixels(tkwin, fa.fa.size); + faPtr->size = -TkFontGetPixels(Tk_Screen(tkwin), fa.fa.size); #endif faPtr->weight = fa.fa.weight; faPtr->slant = fa.fa.slant; @@ -1511,7 +1511,7 @@ InitFont(tkwin, fontStructPtr, fontPtr) fmPtr->fixed = fixed; fontPtr->display = display; - fontPtr->pixelSize = TkFontGetPixels(tkwin, fa.fa.size); + fontPtr->pixelSize = TkFontGetPixels(Tk_Screen(tkwin), fa.fa.size); fontPtr->xa = fa.xa; fontPtr->numSubFonts = 1; diff --git a/pTk/mTk/win/makefile.vc b/pTk/mTk/win/makefile.vc index 2b803836..28ec555c 100644 --- a/pTk/mTk/win/makefile.vc +++ b/pTk/mTk/win/makefile.vc @@ -51,7 +51,7 @@ the environment. Jump to this line to read the new instructions. # clean -- removes the contents of $(TMP_DIR) # hose -- removes the contents of $(TMP_DIR) and $(OUT_DIR) # genstubs -- rebuilds the Stubs table and support files (dev only). -# depend -- Generates an accurate set of source dependancies for this +# depend -- Generates an accurate set of source dependencies for this # makefile. Helpful to avoid problems when the sources are # refreshed and you rebuild, but can "overbuild" when common # headers like tkInt.h just get small changes. diff --git a/pTk/mTk/win/tkWinFont.c b/pTk/mTk/win/tkWinFont.c index 31753c19..72f2387e 100644 --- a/pTk/mTk/win/tkWinFont.c +++ b/pTk/mTk/win/tkWinFont.c @@ -398,7 +398,7 @@ TkpGetFontFromAttributes( found: ReleaseDC(hwnd, hdc); - hFont = GetScreenFont(faPtr, faceName, TkFontGetPixels(tkwin, faPtr->size)); + hFont = GetScreenFont(faPtr, faceName, TkFontGetPixels(Tk_Screen(tkwin), faPtr->size)); if (tkFontPtr == NULL) { fontPtr = (WinFont *) ckalloc(sizeof(WinFont)); } else { @@ -1097,7 +1097,7 @@ InitFont( faPtr = &fontPtr->font.fa; faPtr->family = Tk_GetUid(Tcl_DStringValue(&faceString)); #if 0 - faPtr->size = TkFontGetPoints(tkwin, -(tm.tmHeight - tm.tmInternalLeading)); + faPtr->size = TkFontGetPoints(Tk_Screen(tkwin), -(tm.tmHeight - tm.tmInternalLeading)); #else faPtr->size = -(tm.tmHeight - tm.tmInternalLeading); #endif diff --git a/pTk/mkVFunc b/pTk/mkVFunc index f08925fb..b8b32df2 100755 --- a/pTk/mkVFunc +++ b/pTk/mkVFunc @@ -322,7 +322,7 @@ sub Vfunc print VMACRO "#endif /* _${gard}_VM */\n"; close(VMACRO); print VFUNC "#endif /* _$gard */\n"; - close(VFUNC); # Close this last - Makefile dependancy + close(VFUNC); # Close this last - Makefile dependency unlink($mdef) unless $opt{'m'}; unlink($fdef) unless $opt{'t'}; diff --git a/t/JP.t b/t/JP.t index 40f2088d..eae4aeb3 100644 --- a/t/JP.t +++ b/t/JP.t @@ -2,6 +2,7 @@ use Test::More (tests => 294); use Tk; use Tk::widgets qw(Text); my $mw = MainWindow->new; +$mw->geometry("+10+10"); #my $font = 'Times'; my $font = 'fixed'; $font = shift(@ARGV) if @ARGV; diff --git a/t/KR.t b/t/KR.t index c085ebe7..91eebe06 100644 --- a/t/KR.t +++ b/t/KR.t @@ -2,6 +2,7 @@ use Test::More (tests => 271); use Tk; use Tk::widgets qw(Text); my $mw = MainWindow->new; +$mw->geometry("+10+10"); my $font = 'Times'; #my $font = 'fixed'; my $t = $mw->Scrolled(Text => -font => [$font => 12, 'normal'])->pack( -fill => 'both', -expand => 1); diff --git a/t/browseentry-grabtest.t b/t/browseentry-grabtest.t index 462496f4..cbab6b30 100644 --- a/t/browseentry-grabtest.t +++ b/t/browseentry-grabtest.t @@ -30,7 +30,9 @@ BEGIN { plan tests => 1 } if (!defined $ENV{BATCH}) { $ENV{BATCH} = 1 } my $mw = tkinit; +$mw->geometry("+10+10"); my $t = $mw->Toplevel; +$t->geometry("+20+20"); $mw->Label(-text => "disabled")->pack; $mw->Entry->pack; diff --git a/t/browseentry-subclassing.t b/t/browseentry-subclassing.t index 75851465..25a8c85a 100644 --- a/t/browseentry-subclassing.t +++ b/t/browseentry-subclassing.t @@ -34,6 +34,7 @@ if (!defined $ENV{BATCH}) { $ENV{BATCH} = 1 } } my $mw = my $top = tkinit; +$mw->geometry("+10+10"); my $ne = $mw->SpinboxBrowseEntry(-from => -10, -to => +10, -choices => [-6,-3,0,3,6], @@ -81,7 +82,7 @@ if (!$ENV{BATCH}) { } else { $mw->update; - $top->after(4000); + $top->after(500); } __END__ diff --git a/t/browseentry2.t b/t/browseentry2.t index 2fbc6c70..ead0e724 100644 --- a/t/browseentry2.t +++ b/t/browseentry2.t @@ -28,7 +28,7 @@ BEGIN { plan tests => 6 } if (!defined $ENV{BATCH}) { $ENV{BATCH} = 1 } my $top = new MainWindow; - +$top->geometry("+10+10"); my $var; my $robe = $top->BrowseEntry ( diff --git a/t/entry.t b/t/entry.t index 51e2b597..42f68dc0 100644 --- a/t/entry.t +++ b/t/entry.t @@ -31,7 +31,7 @@ BEGIN { } } -BEGIN { plan tests => 336, todo => [181,207] } +BEGIN { plan tests => 335, todo => [181] } my $mw = Tk::MainWindow->new(); $mw->geometry('+10+10'); @@ -63,9 +63,27 @@ $mw->option("add", "*Entry.highlightThickness", 2); $mw->option("add", "*Entry.font", $Xft ? '{Adobe Helvetica} -12' : "Helvetica -12"); my $e = $mw->Entry(qw(-bd 2 -relief sunken))->pack; - $mw->update; +my $skip_font_test; +if (!$Xft) { # XXX Is this condition necessary? + my %fa = $mw->fontActual($e->cget(-font)); + my %expected = ( + "-weight" => "normal", + "-underline" => 0, + "-family" => "helvetica", + "-slant" => "roman", + "-size" => -12, + "-overstrike" => 0, + ); + while(my($k,$v) = each %expected) { + if ($v ne $fa{$k}) { + $skip_font_test = "font-related tests"; + last; + } + } +} + my $i; use constant SKIP_CGET => 5; @@ -701,40 +719,40 @@ eval { $e->destroy }; $e = $mw->Entry(-font => $big, qw(-bd 3 -relief raised -width 5))->pack; $e->insert(qw(end), "01234567"); $e->update; -ok($e->reqwidth, 77); -ok($e->reqheight, 39); +skip($skip_font_test, $e->reqwidth, 77); +skip($skip_font_test, $e->reqheight, 39); eval { $e->destroy }; $e = $mw->Entry(-font => $big, qw(-bd 3 -relief raised -width 0))->pack; $e->insert(qw(end), "01234567"); $e->update; -ok($e->reqwidth, 116); -ok($e->reqheight, 39); +skip($skip_font_test, $e->reqwidth, 116); +skip($skip_font_test, $e->reqheight, 39); eval { $e->destroy }; $e = $mw->Entry(-font => $big, qw(-bd 3 -relief raised -width 0 -highlightthickness 2))->pack; $e->update; -ok($e->reqwidth, 25); -ok($e->reqheight, 39); +skip($skip_font_test, $e->reqwidth, 25); +skip($skip_font_test, $e->reqheight, 39); eval { $e->destroy }; $e = $mw->Entry(qw(-bd 1 -relief raised -width 0 -show .))->pack; $e->insert(0, "12345"); $e->update; -ok($e->reqwidth, 23); +skip($skip_font_test, $e->reqwidth, 23); $e->configure(-show => 'X'); -ok($e->reqwidth, 53); +skip($skip_font_test, $e->reqwidth, 53); #$e->configure(-show => ''); -#ok($e->reqwidth, 43); +#skip($skip_font_test, $e->reqwidth, 43); eval { $e->destroy }; $e = $mw->Entry(qw(-bd 1 -relief raised -width 0 -show .), -font => 'helvetica 12')->pack; $e->insert(0, "12345"); $e->update; -ok($e->reqwidth, 8+5*$mw->fontMeasure("helvetica 12", ".")); +skip($skip_font_test, $e->reqwidth, 8+5*$mw->fontMeasure("helvetica 12", ".")); $e->configure(-show => 'X'); -ok($e->reqwidth, 8+5*$mw->fontMeasure("helvetica 12", "X")); +skip($skip_font_test, $e->reqwidth, 8+5*$mw->fontMeasure("helvetica 12", "X")); #$e->configure(-show => ''); #ok($e->reqwidth, 8+$mw->fontMeasure("helvetica 12", "12345")); @@ -1133,8 +1151,7 @@ if ($^O ne 'MSWin32') { # selection range is reset. eval { $e->index("sel.first") }; - ok($@ =~ /selection isn\'t in widget/, 1, $@); - skip(1,1); + skip("Test only for MSWin32", $@ =~ /selection isn\'t in widget/, 1, $@); } else { # On mac and pc, when selection is cleared, entry widget remembers @@ -1175,8 +1192,8 @@ $e = $mw->Entry(-show => "."); $e->insert(qw(0 XXXYZZY)); $e->pack; $e->update; -ok($e->index('@7'), 0); -ok($e->index('@8'), 1); +skip($skip_font_test, $e->index('@7'), 0); +skip($skip_font_test, $e->index('@8'), 1); # XXX Still need to write tests for EntryScanTo and EntrySelectTo. @@ -1225,7 +1242,7 @@ $e->update; $e->delete(qw(0 end)); $e->insert(qw(0 .............................)); -ok(join(" ", map { substr($_, 0, 8) } $e->xview), "0 0.827586"); +skip($skip_font_test, join(" ", map { substr($_, 0, 8) } $e->xview), "0 0.827586"); $e->delete(qw(0 end)); $e->insert(qw(0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX)); @@ -1239,7 +1256,7 @@ ok(join(" ", map { substr($_, 0, 8) } $e->xview), $Xw); $e->configure(-show => '.'); $e->delete(qw(0 end)); $e->insert(qw(0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXX)); -ok(join(" ", map { substr($_, 0, 8) } $e->xview), "0 0.827586"); +skip($skip_font_test, join(" ", map { substr($_, 0, 8) } $e->xview), "0 0.827586"); $e->configure(-show => ""); $e->delete(qw(0 end)); diff --git a/t/font.t b/t/font.t index b5bd53e3..e51a5ff9 100644 --- a/t/font.t +++ b/t/font.t @@ -4,11 +4,10 @@ use Test; use Tk; use Tk::Font; -BEGIN { plan tests => 13, - todo => [10] - }; +BEGIN { plan tests => 13 }; my $mw = Tk::MainWindow->new; +$mw->geometry("+10+10"); ## ## if there's only one (fixed) or no font family @@ -73,11 +72,12 @@ my $mw = Tk::MainWindow->new; } my @fam = $mw->fontFamilies; -foreach my $fam ($mw->fontFamilies) +foreach my $fam (@fam) { print "# $fam\n"; } +my $skip_times = (grep { /^times$/i } @fam) ? undef : "Times not available"; $mw->optionAdd('*Listbox.font','Times -12 bold'); my $lb = $mw->Listbox()->pack; $lb->insert(end => '0',"\xff","\x{20ac}","\x{0289}"); @@ -90,7 +90,7 @@ my %expect = (-family => 'Times', foreach my $key (sort keys %expect) { my $val = $mw->fontActual($lf,$key); - ok($val,qr/$expect{$key}/i,"Value of $key"); + skip($skip_times, $val,qr/$expect{$key}/i,"Value of $key"); } my @subfonts = $mw->fontSubfonts($lf); diff --git a/t/listbox.t b/t/listbox.t index 8b848806..eb477fc2 100644 --- a/t/listbox.t +++ b/t/listbox.t @@ -21,6 +21,10 @@ use Tk; use Tk::Config (); my $Xft = $Tk::Config::xlib =~ /-lXft\b/; +use FindBin; +use lib "$FindBin::RealBin"; +use TkTest; + BEGIN { $Listbox = "Listbox"; #$Listbox = "TextList"; @@ -40,16 +44,13 @@ BEGIN { } } -BEGIN { plan tests => 427, todo => [79,82,83,85..87, 89..91, - 176, 264, 269,271,273, - 265, 266, 275,277,291..294, - 326..329, 333, 338] } +BEGIN { plan tests => 427 , todo => [264 .. 266] } my $partial_top; my $partial_lb; my $mw = new MainWindow; -$mw->geometry(''); +$mw->geometry('+10+10'); $mw->raise; my $fixed = $Xft ? '{Adobe Courier} -12' : 'Courier -12'; ok(Tk::Exists($mw), 1); @@ -66,6 +67,48 @@ ok(Tk::Exists($lb), 1); ok($lb->isa("Tk::$Listbox"), 1); $lb->update; +my $skip_font_test; +if (!$Xft) { # XXX Is this condition necessary? + my %fa = $mw->fontActual($lb->cget(-font)); + my %expected = ( + "-weight" => "bold", + "-underline" => 0, + "-family" => "helvetica", + "-slant" => "roman", + "-size" => -12, + "-overstrike" => 0, + ); + while(my($k,$v) = each %expected) { + if ($v ne $fa{$k}) { + $skip_font_test = "font-related tests"; + last; + } + } +} + +my $skip_fixed_font_test; +{ + my $fixed_lb = $mw->$Listbox(-font => $fixed); + if (!$Xft) { # XXX Is this condition necessary? + my %fa = $mw->fontActual($fixed_lb->cget(-font)); + my %expected = ( + "-weight" => "normal", + "-underline" => 0, + "-family" => "courier", + "-slant" => "roman", + "-size" => -12, + "-overstrike" => 0, + ); + while(my($k,$v) = each %expected) { + if ($v ne $fa{$k}) { + $skip_fixed_font_test = "font-related tests (fixed font)"; + last; + } + } + $fixed_lb->destroy; + } +} + resetGridInfo(); foreach my $test @@ -217,21 +260,21 @@ ok($@, '', "wrong error message"); $lb->yview(3); $lb->update; -ok(join(" ", $lb->bbox(3)), "7 7 17 14"); +skip($skip_font_test, join(" ", $lb->bbox(3)), "7 7 17 14"); ok(scalar @{[$lb->bbox(3)]}, 4); -ok(($lb->bbox(3))[0], 7); -ok(($lb->bbox(3))[-1], 14); -ok(join(" ", $lb->bbox(4)), "7 26 17 14"); +skip($skip_font_test, ($lb->bbox(3))[0], 7); +skip($skip_font_test, ($lb->bbox(3))[-1], 14); +skip($skip_font_test, join(" ", $lb->bbox(4)), "7 26 17 14"); $lb->yview(0); $lb->update; ok($lb->bbox(-1), undef); -ok(join(" ", $lb->bbox(0)), "7 7 17 14"); +skip($skip_font_test, join(" ", $lb->bbox(0)), "7 7 17 14"); $lb->yview("end"); $lb->update; -ok(join(" ", $lb->bbox(17)), "7 83 24 14"); -ok(join(" ", $lb->bbox("end")), "7 83 24 14"); +skip($skip_font_test, join(" ", $lb->bbox(17)), "7 83 24 14"); +skip($skip_font_test, join(" ", $lb->bbox("end")), "7 83 24 14"); ok($lb->bbox(18), undef); { @@ -245,13 +288,13 @@ ok($lb->bbox(18), undef); $lb->pack; $lb->update; $lb->xview(moveto => 0.2); - ok(join(" ", $lb->bbox(2)), '-72 39 393 14'); + skip($skip_font_test, join(" ", $lb->bbox(2)), '-72 39 393 14'); $t->destroy; } mkPartial(); -ok(join(" ", $partial_lb->bbox(3)), "5 56 24 14"); -ok(join(" ", $partial_lb->bbox(4)), "5 73 23 14"); +skip($skip_font_test, join(" ", $partial_lb->bbox(3)), "5 56 24 14"); +skip($skip_font_test, join(" ", $partial_lb->bbox(4)), "5 73 23 14"); eval { $lb->cget }; ok($@,qr/wrong \# args: should be \"\.listbox.* cget option\"/, @@ -569,10 +612,12 @@ ok($Tk::VERSION < 803 $lb->scan("mark", 100, 140); $lb->scan("dragto", 90, 137); $lb->update; - ok(join(",",$lb->xview) ,qr/^0\.24936.*,0\.42748.*$/, - join(",",$lb->xview)); - ok(join(",",$lb->yview) ,qr/^0\.071428.*,0\.428571.*$/, - join(",",$lb->yview)); + skip($skip_font_test, + join(",",$lb->xview) ,qr/^0\.24936.*,0\.42748.*$/, + join(",",$lb->xview)); + skip($skip_font_test, + join(",",$lb->yview) ,qr/^0\.071428.*,0\.428571.*$/, + join(",",$lb->yview)); $t->destroy; } @@ -746,7 +791,7 @@ $lb->pack; $lb->update; $lb->xview(4); -ok(join(",",$lb->xview), "0.08,0.28"); +ok_float(join(",",$lb->xview), "0.08,0.28"); eval { $lb->xview("foo") }; ok($@ ,qr/\'foo\' isn\'t numeric/, @@ -759,25 +804,25 @@ ok($@ ,qr/unknown option \"zoom\": must be moveto or scroll/, $lb->xview(0); $lb->xview(moveto => 0.4); $lb->update; -ok(($lb->xview)[0], 0.4); -ok(($lb->xview)[1], 0.6); +ok_float(($lb->xview)[0], 0.4); +ok_float(($lb->xview)[1], 0.6); $lb->xview(0); $lb->xview(scroll => 2, "units"); $lb->update; -ok("@{[ $lb->xview ]}", '0.04 0.24'); +ok_float("@{[ $lb->xview ]}", '0.04 0.24'); $lb->xview(30); $lb->xview(scroll => -1, "pages"); $lb->update; -ok("@{[ $lb->xview ]}", '0.44 0.64'); +ok_float("@{[ $lb->xview ]}", '0.44 0.64'); $lb->configure(-width => 1); $lb->update; $lb->xview(30); $lb->xview("scroll", -4, "pages"); $lb->update; -ok("@{[ $lb->xview ]}", '0.52 0.54'); +ok_float("@{[ $lb->xview ]}", '0.52 0.54'); eval { $lb->destroy }; $lb = $mw->$Listbox->pack; @@ -800,8 +845,8 @@ $lb->pack; $lb->update; $lb->yview(4); $lb->update; -ok(($lb->yview)[0], 0.2); -ok(($lb->yview)[1], 0.45); +ok_float(($lb->yview)[0], 0.2); +ok_float(($lb->yview)[1], 0.45); mkPartial(); ok(($partial_lb->yview)[0], 0); @@ -818,21 +863,21 @@ ok($@ ,qr/unknown option \"foo\": must be moveto or scroll/, $lb->yview(0); $lb->yview(moveto => 0.31); -ok("@{[ $lb->yview ]}", "0.3 0.55"); +ok_float("@{[ $lb->yview ]}", "0.3 0.55"); $lb->yview(2); $lb->yview(scroll => 2 => "pages"); -ok("@{[ $lb->yview ]}", "0.4 0.65"); +ok_float("@{[ $lb->yview ]}", "0.4 0.65"); $lb->yview(10); $lb->yview(scroll => -3 => "units"); -ok("@{[ $lb->yview ]}", "0.35 0.6"); +ok_float("@{[ $lb->yview ]}", "0.35 0.6"); $lb->configure(-height => 2); $lb->update; $lb->yview(15); $lb->yview(scroll => -4 => "pages"); -ok("@{[ $lb->yview ]}", "0.55 0.65"); +ok_float("@{[ $lb->yview ]}", "0.55 0.65"); # No tests for DestroyListbox: I can't come up with anything to test # in this procedure. @@ -1027,37 +1072,37 @@ my @x = qw/a b c d/; Tk::catch { $lb->destroy if Tk::Exists($lb) }; $lb = $mw->$Listbox(-font => $fixed, -width => 15, -height => 20)->pack; -ok($lb->reqwidth, 115); -ok($lb->reqheight, 328); +skip($skip_fixed_font_test, $lb->reqwidth, 115); +skip($skip_fixed_font_test, $lb->reqheight, 328); eval { $lb->destroy }; $lb = $mw->$Listbox(-font => $fixed, -width => 0, -height => 10)->pack; $lb->update; -ok($lb->reqwidth, 17); -ok($lb->reqheight, 168); +skip($skip_fixed_font_test, $lb->reqwidth, 17); +skip($skip_fixed_font_test, $lb->reqheight, 168); eval { $lb->destroy }; $lb = $mw->$Listbox(-font => $fixed, -width => 0, -height => 10, -bd => 3)->pack; $lb->insert(0, "Short", "Really much longer", "Longer"); $lb->update; -ok($lb->reqwidth, 138); -ok($lb->reqheight, 170); +skip($skip_fixed_font_test, $lb->reqwidth, 138); +skip($skip_fixed_font_test, $lb->reqheight, 170); eval { $lb->destroy }; $lb = $mw->$Listbox(-font => $fixed, -width => 10, -height => 0, )->pack; $lb->update; -ok($lb->reqwidth, 80); -ok($lb->reqheight, 24); +skip($skip_fixed_font_test, $lb->reqwidth, 80); +skip($skip_fixed_font_test, $lb->reqheight, 24); eval { $lb->destroy }; $lb = $mw->$Listbox(-font => $fixed, -width => 10, -height => 0, -highlightthickness => 0)->pack; $lb->insert(0, "Short", "Really much longer", "Longer"); $lb->update; -ok($lb->reqwidth, 76); -ok($lb->reqheight, 52); +skip($skip_fixed_font_test, $lb->reqwidth, 76); +skip($skip_fixed_font_test, $lb->reqheight, 52); eval { $lb->destroy }; # If "0" in selected font had 0 width, caused divide-by-zero error. @@ -1145,11 +1190,11 @@ ok("$log[1]", qr/x 0 \d[\d\.]*/); { my $l2 = $mw->$Listbox(-width => 0, -height => 0)->pack(-side => "top"); $l2->insert(0, "a", "b", "two words", "c", "d"); - ok($l2->reqwidth, 80); - ok($l2->reqheight, 93); + skip($skip_font_test, $l2->reqwidth, 80); + skip($skip_font_test, $l2->reqheight, 93); $l2->insert(0, "much longer entry"); - ok($l2->reqwidth, 122); - ok($l2->reqheight, 110); + skip($skip_font_test, $l2->reqwidth, 122); + skip($skip_font_test, $l2->reqheight, 110); $l2->destroy; } @@ -1313,11 +1358,11 @@ ok($log[1], "x 0 1"); { my $l2 = $mw->$Listbox(-width => 0, -height => 0)->pack(-side => "top"); $l2->insert(0, "a", "b", "two words", qw/c d e f g/); - ok($l2->reqwidth, 80); - ok($l2->reqheight, 144); + skip($skip_font_test, $l2->reqwidth, 80); + skip($skip_font_test, $l2->reqheight, 144); $l2->delete(2, 4); - ok($l2->reqwidth, 17); - ok($l2->reqheight, 93); + skip($skip_font_test, $l2->reqwidth, 17); + skip($skip_font_test, $l2->reqheight, 93); $l2->destroy; } @@ -1348,8 +1393,8 @@ $lb->pack; $lb->update; $lb->place(qw/-width 50 -height 80/); $lb->update; -ok(join(" ", $lb->xview), qr/^0 0\.2222/); -ok(join(" ", $lb->yview), qr/^0 0\.3333/); +skip($skip_font_test, join(" ", $lb->xview), qr/^0 0\.2222/); +skip($skip_font_test, join(" ", $lb->yview), qr/^0 0\.3333/); map { $_->destroy } $mw->children; my $l1 = $mw->$Listbox(-bg => "#543210"); @@ -1361,12 +1406,12 @@ $l2->destroy; my $top = $mw->Toplevel; $top->geometry("+0+0"); my $top_lb = $top->$Listbox(-setgrid => 1, - -width => 20, - -height => 10)->pack; + -width => 20, + -height => 10)->pack; $top_lb->update; ok($top->geometry, qr/20x10\+\d+\+\d+/); $top_lb->destroy; -ok($top->geometry, qr/150x178\+\d+\+\d+/); +skip($skip_font_test, $top->geometry, qr/150x178\+\d+\+\d+/); $lb = $mw->$Listbox->pack; $lb->delete(0, "end"); @@ -1460,8 +1505,8 @@ $lb->update; @log = (); $lb->yview(qw/2/); $lb->update; -ok("@{[ $lb->yview ]}", "0.2 0.7"); -ok($log[0], "y 0.2 0.7"); +ok_float("@{[ $lb->yview ]}", "0.2 0.7"); +ok_float($log[0], "y 0.2 0.7"); $lb->destroy; $lb = $mw->$Listbox(qw/-height 5 -yscrollcommand/, [qw/record y/])->pack; @@ -1470,8 +1515,8 @@ $lb->update; @log = (); $lb->yview(qw/8/); $lb->update; -ok("@{[ $lb->yview ]}", "0.5 1"); -ok($log[0], "y 0.5 1"); +ok_float("@{[ $lb->yview ]}", "0.5 1"); +ok_float($log[0], "y 0.5 1"); $lb->destroy; $lb = $mw->$Listbox(qw/-height 5 -yscrollcommand/, [qw/record y/])->pack; @@ -1481,7 +1526,7 @@ $lb->update; @log = (); $lb->yview(qw/3/); $lb->update; -ok("@{[ $lb->yview ]}", "0.3 0.8"); +ok_float("@{[ $lb->yview ]}", "0.3 0.8"); ok(scalar @log, 0); mkPartial(); @@ -1499,23 +1544,23 @@ $lb->update; @log = (); $lb->xview(qw/99/); $lb->update; -ok("@{[ $lb->xview ]}", "0.9 1"); -ok(($lb->xview)[0], 0.9); +ok_float("@{[ $lb->xview ]}", "0.9 1"); +ok_float(($lb->xview)[0], 0.9); ok(($lb->xview)[1], 1); -ok($log[0], "x 0.9 1"); +ok_float($log[0], "x 0.9 1"); @log = (); $lb->xview(qw/moveto -.25/); $lb->update; -ok("@{[ $lb->xview ]}", "0 0.1"); -ok($log[0], "x 0 0.1"); +ok_float("@{[ $lb->xview ]}", "0 0.1"); +ok_float($log[0], "x 0 0.1"); $lb->xview(qw/10/); $lb->update; @log = (); $lb->xview(qw/10/); $lb->update; -ok("@{[ $lb->xview ]}", "0.1 0.2"); +ok_float("@{[ $lb->xview ]}", "0.1 0.2"); ok(scalar @log, 0); $lb->destroy; @@ -1531,52 +1576,52 @@ $lb->xview(qw/0/); $lb->scan(qw/mark 10 20/); $lb->scan(qw/dragto/, 10-$width, 20-$height); $lb->update; -ok("@{[ $lb->xview ]}", "0.2 0.4"); -ok("@{[ $lb->yview ]}", "0.5 0.75"); +ok_float("@{[ $lb->xview ]}", "0.2 0.4"); +ok_float("@{[ $lb->yview ]}", "0.5 0.75"); $lb->yview(qw/5/); $lb->xview(qw/10/); $lb->scan(qw/mark 10 20/); $lb->scan(qw/dragto 20 40/); $lb->update; -ok("@{[ $lb->xview ]}", "0 0.2"); -ok("@{[ $lb->yview ]}", "0 0.25"); +ok_float("@{[ $lb->xview ]}", "0 0.2"); +ok_float("@{[ $lb->yview ]}", "0 0.25"); $lb->scan(qw/dragto/, 20-$width, 40-$height); $lb->update; -ok("@{[ $lb->xview ]}", "0.2 0.4"); -ok(join(':',$lb->xview), "0.2:0.4"); # just to prove it is a list -ok("@{[ $lb->yview ]}", "0.5 0.75"); -ok(join(':',$lb->yview), "0.5:0.75"); # just to prove it is a list +ok_float("@{[ $lb->xview ]}", "0.2 0.4"); +ok_float(join(',',$lb->xview), "0.2,0.4"); # just to prove it is a list +ok_float("@{[ $lb->yview ]}", "0.5 0.75"); +ok_float(join(',',$lb->yview), "0.5,0.75"); # just to prove it is a list $lb->yview(qw/moveto 1.0/); $lb->xview(qw/moveto 1.0/); $lb->scan(qw/mark 10 20/); $lb->scan(qw/dragto 5 10/); $lb->update; -ok("@{[ $lb->xview ]}", "0.8 1"); -ok("@{[ $lb->yview ]}", "0.75 1"); +ok_float("@{[ $lb->xview ]}", "0.8 1"); +ok_float("@{[ $lb->yview ]}", "0.75 1"); $lb->scan(qw/dragto/, 5+$width, 10+$height); $lb->update; -ok("@{[ $lb->xview ]}", "0.64 0.84"); -ok("@{[ $lb->yview ]}", "0.25 0.5"); +ok_float("@{[ $lb->xview ]}", "0.64 0.84"); +ok_float("@{[ $lb->yview ]}", "0.25 0.5"); mkPartial(); ok($partial_lb->nearest($partial_lb->height), 4); $lb->destroy; $lb = $mw->$Listbox(-font => $fixed, - -width => 20, - -height => 10); + -width => 20, + -height => 10); $lb->insert(qw/0 a b c d e f g h i j k l m n o p q r s t/); $lb->yview(qw/4/); $lb->pack; $lb->update; -ok($lb->index(q/@50,0/), 4); +skip($skip_fixed_font_test, $lb->index(q/@50,0/), 4); -ok($lb->index(q/@50,35/), 5); -ok($lb->index(q/@50,36/), 6); +skip($skip_fixed_font_test, $lb->index(q/@50,35/), 5); +skip($skip_fixed_font_test, $lb->index(q/@50,36/), 6); ok($lb->index(q/@50,200/), qr/^\d+/); @@ -1701,7 +1746,7 @@ $lb->update; $lb->delete(qw/0 end/); $lb->update; ok($log[0], "y 0 1"); -ok($log[1], "y 0 0.625"); +ok_float($log[1], "y 0 0.625"); ok($log[2], "y 0 1"); mkPartial(); @@ -1709,7 +1754,7 @@ $partial_lb->configure(-yscrollcommand => ["record", "y"]); @log = (); $partial_lb->yview(3); $partial_lb->update; -ok($log[0], qr/^y 0\.2 0\.\d+/); +ok($log[0], qr/^y 0\.2(0000+\d+)? 0\.\d+/); @x = (); diff --git a/t/slaves.t b/t/slaves.t new file mode 100644 index 00000000..a3bf8de1 --- /dev/null +++ b/t/slaves.t @@ -0,0 +1,27 @@ +BEGIN { $|=1; $^W=1; } +use Test; +use Tk; + +plan test => 12; + +my $mw = MainWindow->new; + +$x=$y=0; +foreach $geom ( qw/ pack place grid form / ) { + $f=$mw->Toplevel(qw/-bd 4 -relief solid /); + $f->title($geom); + foreach ( 1 .. 3 ) { + @p = (); + if ($geom eq 'place') { + $x+=20; + $y=$x; + @p=('-x', $x, '-y', $y); + } + $f->Label(-text => $_)->$geom(@p); + } + $s="${geom}Slaves"; + #print "$geom slaves=", join(' ', $f->$s), "!\n"; + foreach $s ($f->$s) { + ok( sub { return ( ref( $s ) ) ? 1 : 0 }, 1, "$geom slave '$s' not a reference."); + } +} diff --git a/t/trace1.t b/t/trace1.t index dbae2246..3860c9a7 100644 --- a/t/trace1.t +++ b/t/trace1.t @@ -7,6 +7,7 @@ use strict; plan test => 17; my $mw = MainWindow->new; +$mw->geometry("+10+10"); my $v = 0; my $e = $mw->Entry(-textvariable => \$v)->pack; diff --git a/tkGlue.c b/tkGlue.c index ace24bed..de4adda7 100644 --- a/tkGlue.c +++ b/tkGlue.c @@ -2357,7 +2357,7 @@ XS(XS_Tk__MainWindow_Create) #if !defined(WIN32) && !defined(__PM__) && !(defined(OS2) && defined(__WIN32__)) TkCreateXEventSource(); #endif - XSRETURN(Return_Results(interp,items,offset)); + TKXSRETURN(Return_Results(interp,items,offset)); } @@ -2609,7 +2609,7 @@ XS(XStoWidget) Lang_CmdInfo *info = WindowCommand(ST(0), NULL, 1); do_watch(); items = InsertArg(mark,1,XSANY.any_ptr); - XSRETURN(Call_Tk(info, items, &ST(0))); + TKXSRETURN(Call_Tk(info, items, &ST(0))); } static SV * @@ -2751,7 +2751,7 @@ XS(XStoSubCmd) PUTBACK; /* and reset the global */ } ST(0) = name; /* Fill in command name */ - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } static @@ -2789,7 +2789,7 @@ XS(XStoEvent) } } ST(0) = name; /* Fill in command name */ - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } @@ -2813,7 +2813,7 @@ XS(XStoAfterSub) items = InsertArg(mark,posn,ST(0)); ST(0) = name; /* Fill in command name */ Tcl_GetCommandInfo(info.interp,Tcl_GetString(name),&info.Tk); - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } static @@ -2837,7 +2837,7 @@ XS(XStoGrid) #if 0 LangDumpVec("grid", items, &ST(0)); #endif - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } @@ -2862,7 +2862,7 @@ XS(XStoDisplayof) mark = sp-items; items = InsertArg(mark,posn,ST(0)); ST(0) = name; /* Fill in command name */ - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } static @@ -2883,7 +2883,7 @@ XS(XStoTk) items = InsertArg(mark,0,name); } ST(0) = name; /* Fill in command name */ - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } static @@ -2904,7 +2904,7 @@ XS(XStoOption) items = InsertArg(mark,2,ST(0)); } ST(0) = name; /* Fill in command name */ - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } static @@ -2932,7 +2932,7 @@ XS(XStoImage) #if 0 LangDumpVec("Image",items,&ST(0)); #endif - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } static @@ -2963,7 +2963,7 @@ XS(XStoFont) #if 0 LangDumpVec("Font Post",items,&ST(0)); #endif - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } int @@ -3004,14 +3004,14 @@ static XS(XStoTclCmd) { dXSARGS; - XSRETURN(XSTkCommand(cv,1,(Tcl_ObjCmdProc *) XSANY.any_ptr, items, &ST(0))); + TKXSRETURN(XSTkCommand(cv,1,(Tcl_ObjCmdProc *) XSANY.any_ptr, items, &ST(0))); } static XS(XStoTclCmdNull) { dXSARGS; - XSRETURN(XSTkCommand(cv,0,(Tcl_ObjCmdProc *) XSANY.any_ptr, items, &ST(0))); + TKXSRETURN(XSTkCommand(cv,0,(Tcl_ObjCmdProc *) XSANY.any_ptr, items, &ST(0))); } static @@ -3032,7 +3032,7 @@ XS(XStoNoWindow) ST(0) = name; /* Fill in command name */ else items = InsertArg(mark,0,name); - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } static CV * @@ -3132,7 +3132,7 @@ XS(XStoBind) } #endif } - XSRETURN(Call_Tk(&info, items, &ST(0))); + TKXSRETURN(Call_Tk(&info, items, &ST(0))); } diff --git a/tkGlue.def b/tkGlue.def index 29e36e51..2f1662c7 100644 --- a/tkGlue.def +++ b/tkGlue.def @@ -4,6 +4,12 @@ #define XSdec(x) void x() #endif +#define TKXSRETURN(off) \ + STMT_START { \ + IV ptkAdj = (off); \ + XSRETURN(ptkAdj); \ + } STMT_END + #ifndef PATCHLEVEL #include #endif