# strip everything before this and feed to /bin/sh # # patch -p1 -N <<'__END_OF_PATCH__' Index: Change.log --- Tk804.025_beta2/Change.log 2003-10-10 18:52:36.000000000 +0100 +++ Tk-804.025_beta3/Change.log 2003-10-20 21:08:21.000000000 +0100 @@ -1,3 +1,29 @@ +Change 2950 on 2003/10/20 by nick@llama + + Avoid poking our noses in the internals of objects. + Catch simple case of recursive lists. + +Change 2949 on 2003/10/20 by nick@llama + + Allow empty -background on bitmaps. + +Change 2948 on 2003/10/20 by nick@llama + + Part fix for problem found by Petr Pajas . + Avoid stringify of config options to test for emptiness: + Use LangNull for ObjctIsEmpty in _new_ config code. + Enhance LangNull to return true for string "". + Fix _old_ config code to avoid NULL for non-optional + options for which LangNull() now returns true. + +Change 2946 on 2003/10/20 by nick@llama + + Selection was off-by-1 as pointed out by Simon.Lux@etas.de + +Change 2944 on 2003/10/10 by nick@llama + + Update change log + Change 2943 on 2003/10/10 by nick@llama Suggestions from Tom.Horsley@ccur.com Index: Entry/Entry.pm --- Tk804.025_beta2/Entry/Entry.pm 2003-08-04 19:57:58.000000000 +0100 +++ Tk-804.025_beta3/Entry/Entry.pm 2003-10-20 18:40:42.000000000 +0100 @@ -12,7 +12,7 @@ # This program is free software; you can redistribute it and/or use vars qw($VERSION); -$VERSION = sprintf '4.%03d',q$Revision: #15 $ =~ /#(\d+)/; +$VERSION = sprintf '4.%03d',q$Revision: #16 $ =~ /#(\d+)/; # modify it under the same terms as Perl itself, subject # to additional disclaimer in license.terms due to partial @@ -522,7 +522,7 @@ $str = $show x length($str) if (defined $show); my $s = $w->index('sel.first'); my $e = $w->index('sel.last'); - return substr($str,$s,$e+1-$s); + return substr($str,$s,$e-$s); } 1; Index: mkdist --- Tk804.025_beta2/mkdist 2003-10-10 18:47:15.000000000 +0100 +++ Tk-804.025_beta3/mkdist 2003-10-20 21:06:14.000000000 +0100 @@ -58,13 +58,13 @@ $opt_sfx = '_'.$opt_sfx if (length($opt_sfx) && $opt_sfx !~ /^_/); -my @files = map("$dir$version$opt_sfx/$_",sort(keys %$files)); +my @files = map("$dir-$version$opt_sfx/$_",sort(keys %$files)); chdir(".."); -unlink("$dir$version$opt_sfx") if (-l "$dir$version$opt_sfx"); -symlink($path,"$dir$version$opt_sfx") || die "Cannot link $dir $dir$version$opt_sfx:$!"; +unlink("$dir-$version$opt_sfx") if (-l "$dir-$version$opt_sfx"); +symlink($path,"$dir-$version$opt_sfx") || die "Cannot link $dir $dir-$version$opt_sfx:$!"; -$dir .= $version.$opt_sfx; +$dir .= "-$version$opt_sfx"; system("mv","$dir.tar.gz","$dir.tar.gz%") if (-e "$dir.tar.gz"); Index: objGlue.c --- Tk804.025_beta2/objGlue.c 2003-10-10 13:08:38.000000000 +0100 +++ Tk-804.025_beta3/objGlue.c 2003-10-20 20:14:11.000000000 +0100 @@ -129,10 +129,12 @@ { SV *el = *svp; int temp = 0; - if (SvROK(el) && SvTYPE(SvRV(el)) == SVt_PVAV) + if (SvROK(el) && !SvOBJECT(SvRV(el)) && SvTYPE(SvRV(el)) == SVt_PVAV) { el = newSVpv("",0); temp = 1; + if ((AV *) SvRV(*svp) == av) + abort(); Scalarize(aTHX_ el,(AV *) SvRV(*svp)); } Tcl_DStringAppendElement(&ds,Tcl_GetString(el)); @@ -163,7 +165,7 @@ } else { - if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVAV) + if (SvROK(sv) && !SvOBJECT(SvRV(sv)) && SvTYPE(SvRV(sv)) == SVt_PVAV) { /* Callbacks and lists often get stringified by mistake due to Tcl/Tk's string fixation - don't change the real value @@ -405,76 +407,80 @@ LangString(SV *sv) { dTHX; - STRLEN na; if (!sv) return ""; if (SvGMAGICAL(sv)) mg_get(sv); if (SvPOK(sv)) - return SvPV(sv, na); + { + if (!SvUTF8(sv)) + sv_utf8_upgrade(sv); + return SvPV_nolen(sv); + } else { if (SvROK(sv)) { SV *rv = SvRV(sv); - if (SvTYPE(rv) == SVt_PVCV || SvTYPE(rv) == SVt_PVAV) - return SvPV(sv, na); - else + STRLEN len; + char *s; + if (SvOBJECT(rv)) { - if (SvOBJECT(rv)) + /* Special case "our" objects and certainb legacy hacks ... */ + if (SvTYPE(rv) == SVt_PVHV) { - if (SvTYPE(rv) == SVt_PVHV) + SV **p = hv_fetch((HV *) rv,"_TkValue_",9,0); + if (p) { - SV **p = hv_fetch((HV *) rv,"_TkValue_",9,0); - if (p) - { - return SvPV(*p,na); - } - else - { - Lang_CmdInfo *info = WindowCommand(sv, NULL, 0); - if (info) - { - if (info->tkwin) - { - char *val = Tk_PathName(info->tkwin); - hv_store((HV *) rv,"_TkValue_",9,Tcl_NewStringObj(val,strlen(val)),0); - return val; - } - if (info->image) - { - return SvPV(info->image,na); - } - } - } - } - else if (SvPOK(rv)) - { -#ifdef SvUTF8 - if (!SvUTF8(rv)) - sv_utf8_upgrade(rv); -#endif - return SvPV(rv,na); + return SvPV_nolen(*p); } else { - if (!mg_find(rv,PERL_MAGIC_qr)) + Lang_CmdInfo *info = WindowCommand(sv, NULL, 0); + if (info) { - LangDumpVec("Odd object type", 1, &rv); + if (info->tkwin) + { + char *val = Tk_PathName(info->tkwin); + hv_store((HV *) rv,"_TkValue_",9,Tcl_NewStringObj(val,strlen(val)),0); + return val; + } + if (info->image) + { + return SvPV_nolen(info->image); + } } } } + else if (SvPOK(rv)) + { + /* ref to string is special cased for some reason ? */ + if (!SvUTF8(rv)) + sv_utf8_upgrade(rv); + return SvPV_nolen(rv); + } + } /* Object */ + s = SvPV(sv, len); + if (!is_utf8_string(s,len)) + { + sv_setpvn(sv,s,len); + sv_utf8_upgrade(sv); + s = SvPV(sv, len); } - } - if (SvOK(sv)) + if (!is_utf8_string(s,len)) + { + LangDebug("%s @ %d not utf8 '%.*s'\n",__FUNCTION__,__LINE__,(int) len, s); + sv_dump(sv); + abort(); + } + return s; + } /* reference */ + else if (SvOK(sv)) { -#ifdef SvUTF8 if (SvROK(sv) && SvPOK(SvRV(sv)) && !SvUTF8(SvRV(sv))) sv_utf8_upgrade(SvRV(sv)); - else - if (!SvUTF8(sv)) + else if (!SvUTF8(sv)) sv_utf8_upgrade(sv); -#endif - return SvPV(sv, na); + return SvPV_nolen(sv); } else return ""; @@ -483,7 +489,6 @@ void utf8Whoops(pTHX_ SV *objPtr) { - sv_utf8_upgrade(objPtr); sv_dump(objPtr); } @@ -495,8 +500,9 @@ { dTHX; char *s; - if ((SvROK(objPtr) && SvTYPE(SvRV(objPtr)) == SVt_PVAV) || - (SvTYPE(objPtr) == SVt_PVAV)) + if ((SvROK(objPtr) && !SvOBJECT(SvRV(objPtr)) + && SvTYPE(SvRV(objPtr)) == SVt_PVAV) || + (SvTYPE(objPtr) == SVt_PVAV)) objPtr = ForceScalar(aTHX_ objPtr); if (SvPOK(objPtr)) { @@ -537,7 +543,7 @@ { LangDebug("%s @ %d not utf8\n",__FUNCTION__,__LINE__); sv_dump(objPtr); - /*// abort();*/ + abort(); } #endif if (lengthPtr) Index: pTk/mTk/generic/tkConfig.c --- Tk804.025_beta2/pTk/mTk/generic/tkConfig.c 2003-10-10 16:04:17.000000000 +0100 +++ Tk-804.025_beta3/pTk/mTk/generic/tkConfig.c 2003-10-20 16:28:19.000000000 +0100 @@ -1075,8 +1075,12 @@ return (objPtr->length == 0); } #endif +#if 0 Tcl_GetStringFromObj(objPtr, &length); return (length == 0); +#else + return LangNull(objPtr); +#endif } /* Index: pTk/mTk/generic/tkImgBmap.c --- Tk804.025_beta2/pTk/mTk/generic/tkImgBmap.c 2003-07-27 17:44:09.000000000 +0100 +++ Tk-804.025_beta3/pTk/mTk/generic/tkImgBmap.c 2003-10-20 17:06:59.000000000 +0100 @@ -114,7 +114,7 @@ static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_UID, "-background", (char *) NULL, (char *) NULL, - "", Tk_Offset(BitmapMaster, bgUid), 0}, + "", Tk_Offset(BitmapMaster, bgUid), TK_CONFIG_NULL_OK}, {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL, (char *) NULL, Tk_Offset(BitmapMaster, dataString), TK_CONFIG_NULL_OK}, {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL, @@ -355,7 +355,7 @@ * form into an internal form appropriate for instancePtr. */ - if (*masterPtr->bgUid != 0) { + if ((masterPtr->bgUid != NULL) && (masterPtr->bgUid[0] != '\0')) { colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin, masterPtr->bgUid); if (colorPtr == NULL) { @@ -1252,7 +1252,7 @@ * encloses the bitmap. If there is a background mask, then only apply * color to the bits specified by the mask. */ - if ((masterPtr->bgUid != NULL) && (masterPtr->bgUid[0] != '\000')) { + if ((masterPtr->bgUid != NULL) && (masterPtr->bgUid[0] != '\0')) { XColor color; XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), masterPtr->bgUid, &color); Index: pTk/mTk/generic/tkOldConfig.c --- Tk804.025_beta2/pTk/mTk/generic/tkOldConfig.c 2003-09-18 21:24:06.000000000 +0100 +++ Tk-804.025_beta3/pTk/mTk/generic/tkOldConfig.c 2003-10-20 16:59:43.000000000 +0100 @@ -226,7 +226,7 @@ LangSetDefault(&value,specPtr->defValue); else LangSetString(&value,specPtr->defValue); - if (!LangNull(value) && !(specPtr->specFlags + if ((value != NULL) && !(specPtr->specFlags & TK_CONFIG_DONT_SET_DEFAULT)) { if (DoConfig(interp, tkwin, specPtr, value, 0, widgRec) != TCL_OK) { Index: tkGlue.c --- Tk804.025_beta2/tkGlue.c 2003-10-09 19:34:57.000000000 +0100 +++ Tk-804.025_beta3/tkGlue.c 2003-10-20 18:44:55.000000000 +0100 @@ -286,7 +286,7 @@ Tcl_Obj * sv; { STRLEN len = 0; - if (!sv || !SvOK(sv) /* || (SvPOK(sv) && !*SvPV(sv,len) && !len) */) + if (!sv || !SvOK(sv) || (SvPOK(sv) && !SvCUR(sv))) return 1; return 0; } @@ -908,18 +908,18 @@ dTHX; SV *sv = *sp; do_watch(); + if (!s) + { + /* tkOldConfig uses LangSetString when TK_CONFIG_NULL_OK is _NOT_ set + we must set something. + */ + s = ""; + } if (sv) { - if (!s /* || SvREADONLY(sv) */) - { - Decrement(sv, "LangSetString"); - } - else - { - sv_setpv(sv, s); - SvSETMAGIC(sv_maybe_utf8(sv)); - return; - } + sv_setpv(sv, s); + SvSETMAGIC(sv_maybe_utf8(sv)); + return; } *sp = Tcl_NewStringObj(s, -1); } __END_OF_PATCH__