diff options
Diffstat (limited to 'generic')
50 files changed, 1986 insertions, 1504 deletions
diff --git a/generic/tk.decls b/generic/tk.decls index 9ceb3af..a8d0c58 100644 --- a/generic/tk.decls +++ b/generic/tk.decls @@ -326,7 +326,7 @@ declare 75 { declare 76 { void Tk_FreeTextLayout(Tk_TextLayout textLayout) } -declare 77 { +declare 77 {deprecated {function does nothing, call can be removed}} { void Tk_FreeXId(Display *display, XID xid) } declare 78 { @@ -564,12 +564,12 @@ declare 143 { Tk_Window tkwin, int *argcPtr, CONST84 char **argv, const Tk_ArgvInfo *argTable, int flags) } -declare 144 { +declare 144 {deprecated {function signature changed}} { void Tk_PhotoPutBlock_NoComposite(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height) } -declare 145 { +declare 145 {deprecated {function signature changed}} { void Tk_PhotoPutZoomedBlock_NoComposite(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, @@ -581,13 +581,13 @@ declare 146 { declare 147 { void Tk_PhotoBlank(Tk_PhotoHandle handle) } -declare 148 { +declare 148 {deprecated {function signature changed}} { void Tk_PhotoExpand_Panic(Tk_PhotoHandle handle, int width, int height ) } declare 149 { void Tk_PhotoGetSize(Tk_PhotoHandle handle, int *widthPtr, int *heightPtr) } -declare 150 { +declare 150 {deprecated {function signature changed}} { void Tk_PhotoSetSize_Panic(Tk_PhotoHandle handle, int width, int height) } declare 151 { @@ -943,12 +943,12 @@ declare 244 { declare 245 { void Tk_SetCaretPos(Tk_Window tkwin, int x, int y, int height) } -declare 246 { +declare 246 {deprecated {function signature changed}} { void Tk_PhotoPutBlock_Panic(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule) } -declare 247 { +declare 247 {deprecated {function signature changed}} { void Tk_PhotoPutZoomedBlock_Panic(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, diff --git a/generic/tk.h b/generic/tk.h index a6e3726..da58023 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -17,8 +17,8 @@ #define _TK #include <tcl.h> -#if (TCL_MAJOR_VERSION != 8) || (TCL_MINOR_VERSION < 6) -# error Tk 8.6 must be compiled with tcl.h from Tcl 8.6 or better +#if (TCL_MAJOR_VERSION < 8) || (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 6) +# error Tk 8.7 must be compiled with tcl.h from Tcl 8.6 or better #endif #ifndef CONST84 @@ -59,8 +59,8 @@ extern "C" { * and update the version numbers: * * library/tk.tcl (1 LOC patch) - * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch) - * win/configure.in (as above) + * unix/configure.ac (2 LOC Major, 2 LOC minor, 1 LOC patch) + * win/configure.ac (as above) * README (sections 0 and 1) * macosx/Tk-Common.xcconfig (not patchlevel) 1 LOC * win/README (not patchlevel) @@ -73,12 +73,12 @@ extern "C" { */ #define TK_MAJOR_VERSION 8 -#define TK_MINOR_VERSION 6 -#define TK_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TK_RELEASE_SERIAL 7 +#define TK_MINOR_VERSION 7 +#define TK_RELEASE_LEVEL TCL_ALPHA_RELEASE +#define TK_RELEASE_SERIAL 2 -#define TK_VERSION "8.6" -#define TK_PATCH_LEVEL "8.6.7" +#define TK_VERSION "8.7" +#define TK_PATCH_LEVEL "8.7a2" /* * A special definition used to allow this header file to be included from @@ -105,6 +105,10 @@ extern "C" { #ifdef BUILD_tk #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifndef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLIMPORT +# endif #endif /* @@ -414,7 +418,9 @@ typedef enum { #define TK_CONFIG_COLOR_ONLY (1 << 1) #define TK_CONFIG_MONO_ONLY (1 << 2) #define TK_CONFIG_DONT_SET_DEFAULT (1 << 3) -#define TK_CONFIG_OPTION_SPECIFIED (1 << 4) +#if !defined(TK_NO_DEPRECATED) || defined(BUILD_tk) +# define TK_CONFIG_OPTION_SPECIFIED (1 << 4) +#endif #define TK_CONFIG_USER_BIT 0x100 #endif /* __NO_OLD_CONFIG */ @@ -746,9 +752,10 @@ typedef XActivateDeactivateEvent XDeactivateEvent; (((Tk_FakeWin *) (tkwin))->flags & TK_WM_MANAGEABLE) #define Tk_ReqWidth(tkwin) (((Tk_FakeWin *) (tkwin))->reqWidth) #define Tk_ReqHeight(tkwin) (((Tk_FakeWin *) (tkwin))->reqHeight) -/* Tk_InternalBorderWidth is deprecated */ +#ifndef TK_NO_DEPRECATED #define Tk_InternalBorderWidth(tkwin) \ (((Tk_FakeWin *) (tkwin))->internalBorderLeft) +#endif /* !TK_NO_DEPRECATED */ #define Tk_InternalBorderLeft(tkwin) \ (((Tk_FakeWin *) (tkwin))->internalBorderLeft) #define Tk_InternalBorderRight(tkwin) \ @@ -1559,12 +1566,13 @@ typedef int (Tk_SelectionProc) (ClientData clientData, int offset, *---------------------------------------------------------------------- * * Allow users to say that they don't want to alter their source to add extra - * arguments to Tk_PhotoPutBlock() et al; DO NOT DEFINE THIS WHEN BUILDING TK. + * arguments to Tk_PhotoPutBlock() et al. * * This goes after the inclusion of the stubbed-decls so that the declarations * of what is actually there can be correct. */ +#if !defined(TK_NO_DEPRECATED) && !defined(BUILD_tk) #ifdef USE_COMPOSITELESS_PHOTO_PUT_BLOCK # ifdef Tk_PhotoPutBlock # undef Tk_PhotoPutBlock @@ -1597,6 +1605,7 @@ typedef int (Tk_SelectionProc) (ClientData clientData, int offset, # endif # define Tk_PhotoSetSize Tk_PhotoSetSize_Panic #endif /* USE_PANIC_ON_PHOTO_ALLOC_FAILURE */ +#endif /* !TK_NO_DEPRECATED && !BUILD_tk */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT diff --git a/generic/tkBind.c b/generic/tkBind.c index 285b3f7..e0cc1ca 100644 --- a/generic/tkBind.c +++ b/generic/tkBind.c @@ -3975,7 +3975,7 @@ ParseEventDescription( p = GetField(p, field, FIELD_SIZE); } if (*field != '\0') { - if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) { + if ((*field >= '1') && (*field <= '9') && (field[1] == '\0')) { if (eventFlags == 0) { patPtr->eventType = ButtonPress; eventMask = ButtonPressMask; diff --git a/generic/tkCmds.c b/generic/tkCmds.c index 6196b17..93c1fb0 100644 --- a/generic/tkCmds.c +++ b/generic/tkCmds.c @@ -2068,14 +2068,13 @@ TkGetDisplayOf( * present. */ { const char *string; - int length; if (objc < 1) { return 0; } - string = Tcl_GetStringFromObj(objv[0], &length); - if ((length >= 2) && - (strncmp(string, "-displayof", (unsigned) length) == 0)) { + string = Tcl_GetString(objv[0]); + if ((objv[0]->length >= 2) && + (strncmp(string, "-displayof", objv[0]->length) == 0)) { if (objc < 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "value for \"-displayof\" missing", -1)); diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 9c159e6..093bd35 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -91,7 +91,7 @@ typedef struct TkOption { */ typedef struct OptionTable { - int refCount; /* Counts the number of uses of this table + size_t refCount; /* Counts the number of uses of this table * (the number of times Tk_CreateOptionTable * has returned it). This can be greater than * 1 if it is shared along several option @@ -103,7 +103,7 @@ typedef struct OptionTable { * templates, this points to the table * corresponding to the next template in the * chain. */ - int numOptions; /* The number of items in the options array + size_t numOptions; /* The number of items in the options array * below. */ Option options[1]; /* Information about the individual options in * the table. This must be the last field in @@ -177,7 +177,7 @@ Tk_CreateOptionTable( OptionTable *tablePtr; const Tk_OptionSpec *specPtr, *specPtr2; Option *optionPtr; - int numOptions, i; + size_t numOptions, i; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); @@ -330,10 +330,9 @@ Tk_DeleteOptionTable( { OptionTable *tablePtr = (OptionTable *) optionTable; Option *optionPtr; - int count; + size_t count; - tablePtr->refCount--; - if (tablePtr->refCount > 0) { + if (tablePtr->refCount-- > 1) { return; } @@ -978,7 +977,7 @@ GetOption( Option *bestPtr, *optionPtr; OptionTable *tablePtr2; const char *p1, *p2; - int count; + size_t count; /* * Search through all of the option tables in the chain to find the best @@ -1539,7 +1538,7 @@ Tk_FreeConfigOptions( { OptionTable *tablePtr; Option *optionPtr; - int count; + size_t count; Tcl_Obj **oldPtrPtr, *oldPtr; char *oldInternalPtr; const Tk_OptionSpec *specPtr; @@ -1733,7 +1732,7 @@ Tk_GetOptionInfo( Tcl_Obj *resultPtr; OptionTable *tablePtr = (OptionTable *) optionTable; Option *optionPtr; - int count; + size_t count; /* * If information is only wanted for a single configuration spec, then @@ -2096,9 +2095,9 @@ TkDebugConfig( if (tablePtr == (OptionTable *) Tcl_GetHashValue(hashEntryPtr)) { for ( ; tablePtr != NULL; tablePtr = tablePtr->nextPtr) { Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewIntObj(tablePtr->refCount)); + Tcl_NewWideIntObj(tablePtr->refCount)); Tcl_ListObjAppendElement(NULL, objPtr, - Tcl_NewIntObj(tablePtr->numOptions)); + Tcl_NewWideIntObj(tablePtr->numOptions)); Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewStringObj( tablePtr->options[0].specPtr->optionName, -1)); } diff --git a/generic/tkConsole.c b/generic/tkConsole.c index a6a8cbf..7a74344 100644 --- a/generic/tkConsole.c +++ b/generic/tkConsole.c @@ -24,7 +24,7 @@ typedef struct ConsoleInfo { Tcl_Interp *consoleInterp; /* Interpreter displaying the console. */ Tcl_Interp *interp; /* Interpreter controlled by console. */ - int refCount; + size_t refCount; } ConsoleInfo; /* @@ -223,7 +223,7 @@ Tk_InitConsoleChannels( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return; } @@ -456,7 +456,7 @@ Tk_CreateConsoleWindow( if (mainWindow) { Tk_DeleteEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc, info); - if (--info->refCount <= 0) { + if (info->refCount-- <= 1) { ckfree(info); } } @@ -596,7 +596,7 @@ ConsoleClose( ConsoleInfo *info = data->info; if (info) { - if (--info->refCount <= 0) { + if (info->refCount-- <= 1) { /* * Assuming the Tcl_Interp * fields must already be NULL. */ @@ -885,7 +885,7 @@ InterpDeleteProc( Tcl_DeleteThreadExitHandler(DeleteConsoleInterp, info->consoleInterp); info->consoleInterp = NULL; } - if (--info->refCount <= 0) { + if (info->refCount-- <= 1) { ckfree(info); } } @@ -916,7 +916,7 @@ ConsoleDeleteProc( if (info->consoleInterp) { Tcl_DeleteInterp(info->consoleInterp); } - if (--info->refCount <= 0) { + if (info->refCount-- <= 1) { ckfree(info); } } @@ -953,7 +953,7 @@ ConsoleEventProc( Tcl_EvalEx(consoleInterp, "tk::ConsoleExit", -1, TCL_EVAL_GLOBAL); } - if (--info->refCount <= 0) { + if (info->refCount-- <= 1) { ckfree(info); } } diff --git a/generic/tkDecls.h b/generic/tkDecls.h index 64c32cd..8ba2f44 100644 --- a/generic/tkDecls.h +++ b/generic/tkDecls.h @@ -17,6 +17,14 @@ #define TCL_STORAGE_CLASS DLLEXPORT #endif +#if !defined(BUILD_tk) +# define TK_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg) +#elif defined(TK_NO_DEPRECATED) +# define TK_DEPRECATED(msg) MODULE_SCOPE +#else +# define TK_DEPRECATED(msg) EXTERN +#endif + /* * WARNING: This file is automatically generated by the tools/genStubs.tcl * script. Any modifications to the function declarations below should be made @@ -281,7 +289,8 @@ EXTERN void Tk_FreePixmap(Display *display, Pixmap pixmap); /* 76 */ EXTERN void Tk_FreeTextLayout(Tk_TextLayout textLayout); /* 77 */ -EXTERN void Tk_FreeXId(Display *display, XID xid); +TK_DEPRECATED("function does nothing, call can be removed") +void Tk_FreeXId(Display *display, XID xid); /* 78 */ EXTERN GC Tk_GCForColor(XColor *colorPtr, Drawable drawable); /* 79 */ @@ -471,11 +480,13 @@ EXTERN int Tk_ParseArgv(Tcl_Interp *interp, Tk_Window tkwin, int *argcPtr, CONST84 char **argv, const Tk_ArgvInfo *argTable, int flags); /* 144 */ -EXTERN void Tk_PhotoPutBlock_NoComposite(Tk_PhotoHandle handle, +TK_DEPRECATED("function signature changed") +void Tk_PhotoPutBlock_NoComposite(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height); /* 145 */ -EXTERN void Tk_PhotoPutZoomedBlock_NoComposite( +TK_DEPRECATED("function signature changed") +void Tk_PhotoPutZoomedBlock_NoComposite( Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, @@ -486,13 +497,15 @@ EXTERN int Tk_PhotoGetImage(Tk_PhotoHandle handle, /* 147 */ EXTERN void Tk_PhotoBlank(Tk_PhotoHandle handle); /* 148 */ -EXTERN void Tk_PhotoExpand_Panic(Tk_PhotoHandle handle, +TK_DEPRECATED("function signature changed") +void Tk_PhotoExpand_Panic(Tk_PhotoHandle handle, int width, int height); /* 149 */ EXTERN void Tk_PhotoGetSize(Tk_PhotoHandle handle, int *widthPtr, int *heightPtr); /* 150 */ -EXTERN void Tk_PhotoSetSize_Panic(Tk_PhotoHandle handle, +TK_DEPRECATED("function signature changed") +void Tk_PhotoSetSize_Panic(Tk_PhotoHandle handle, int width, int height); /* 151 */ EXTERN int Tk_PointToChar(Tk_TextLayout layout, int x, int y); @@ -776,11 +789,13 @@ EXTERN void Tk_SetMinimumRequestSize(Tk_Window tkwin, EXTERN void Tk_SetCaretPos(Tk_Window tkwin, int x, int y, int height); /* 246 */ -EXTERN void Tk_PhotoPutBlock_Panic(Tk_PhotoHandle handle, +TK_DEPRECATED("function signature changed") +void Tk_PhotoPutBlock_Panic(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); /* 247 */ -EXTERN void Tk_PhotoPutZoomedBlock_Panic(Tk_PhotoHandle handle, +TK_DEPRECATED("function signature changed") +void Tk_PhotoPutZoomedBlock_Panic(Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); @@ -953,7 +968,7 @@ typedef struct TkStubs { void (*tk_FreeOptions) (const Tk_ConfigSpec *specs, char *widgRec, Display *display, int needFlags); /* 74 */ void (*tk_FreePixmap) (Display *display, Pixmap pixmap); /* 75 */ void (*tk_FreeTextLayout) (Tk_TextLayout textLayout); /* 76 */ - void (*tk_FreeXId) (Display *display, XID xid); /* 77 */ + TCL_DEPRECATED_API("function does nothing, call can be removed") void (*tk_FreeXId) (Display *display, XID xid); /* 77 */ GC (*tk_GCForColor) (XColor *colorPtr, Drawable drawable); /* 78 */ void (*tk_GeometryRequest) (Tk_Window tkwin, int reqWidth, int reqHeight); /* 79 */ Tk_3DBorder (*tk_Get3DBorder) (Tcl_Interp *interp, Tk_Window tkwin, Tk_Uid colorName); /* 80 */ @@ -1020,13 +1035,13 @@ typedef struct TkStubs { Tk_Window (*tk_NameToWindow) (Tcl_Interp *interp, const char *pathName, Tk_Window tkwin); /* 141 */ void (*tk_OwnSelection) (Tk_Window tkwin, Atom selection, Tk_LostSelProc *proc, ClientData clientData); /* 142 */ int (*tk_ParseArgv) (Tcl_Interp *interp, Tk_Window tkwin, int *argcPtr, CONST84 char **argv, const Tk_ArgvInfo *argTable, int flags); /* 143 */ - void (*tk_PhotoPutBlock_NoComposite) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height); /* 144 */ - void (*tk_PhotoPutZoomedBlock_NoComposite) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY); /* 145 */ + TCL_DEPRECATED_API("function signature changed") void (*tk_PhotoPutBlock_NoComposite) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height); /* 144 */ + TCL_DEPRECATED_API("function signature changed") void (*tk_PhotoPutZoomedBlock_NoComposite) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY); /* 145 */ int (*tk_PhotoGetImage) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr); /* 146 */ void (*tk_PhotoBlank) (Tk_PhotoHandle handle); /* 147 */ - void (*tk_PhotoExpand_Panic) (Tk_PhotoHandle handle, int width, int height); /* 148 */ + TCL_DEPRECATED_API("function signature changed") void (*tk_PhotoExpand_Panic) (Tk_PhotoHandle handle, int width, int height); /* 148 */ void (*tk_PhotoGetSize) (Tk_PhotoHandle handle, int *widthPtr, int *heightPtr); /* 149 */ - void (*tk_PhotoSetSize_Panic) (Tk_PhotoHandle handle, int width, int height); /* 150 */ + TCL_DEPRECATED_API("function signature changed") void (*tk_PhotoSetSize_Panic) (Tk_PhotoHandle handle, int width, int height); /* 150 */ int (*tk_PointToChar) (Tk_TextLayout layout, int x, int y); /* 151 */ int (*tk_PostscriptFontName) (Tk_Font tkfont, Tcl_DString *dsPtr); /* 152 */ void (*tk_PreserveColormap) (Display *display, Colormap colormap); /* 153 */ @@ -1122,8 +1137,8 @@ typedef struct TkStubs { void (*tk_SetInternalBorderEx) (Tk_Window tkwin, int left, int right, int top, int bottom); /* 243 */ void (*tk_SetMinimumRequestSize) (Tk_Window tkwin, int minWidth, int minHeight); /* 244 */ void (*tk_SetCaretPos) (Tk_Window tkwin, int x, int y, int height); /* 245 */ - void (*tk_PhotoPutBlock_Panic) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); /* 246 */ - void (*tk_PhotoPutZoomedBlock_Panic) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); /* 247 */ + TCL_DEPRECATED_API("function signature changed") void (*tk_PhotoPutBlock_Panic) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int compRule); /* 246 */ + TCL_DEPRECATED_API("function signature changed") void (*tk_PhotoPutZoomedBlock_Panic) (Tk_PhotoHandle handle, Tk_PhotoImageBlock *blockPtr, int x, int y, int width, int height, int zoomX, int zoomY, int subsampleX, int subsampleY, int compRule); /* 247 */ int (*tk_CollapseMotionEvents) (Display *display, int collapse); /* 248 */ Tk_StyleEngine (*tk_RegisterStyleEngine) (const char *name, Tk_StyleEngine parent); /* 249 */ Tk_StyleEngine (*tk_GetStyleEngine) (const char *name); /* 250 */ @@ -1721,12 +1736,25 @@ extern const TkStubs *tkStubsPtr; #undef Tk_SafeInit #undef Tk_CreateConsoleWindow +#undef Tk_FreeXId +#define Tk_FreeXId(display,xid) + #if defined(_WIN32) && defined(UNICODE) # define Tk_MainEx Tk_MainExW EXTERN void Tk_MainExW(int argc, wchar_t **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); #endif + +#ifdef TK_NO_DEPRECATED +#undef Tk_PhotoPutBlock_NoComposite +#undef Tk_PhotoPutZoomedBlock_NoComposite +#undef Tk_PhotoExpand_Panic +#undef Tk_PhotoPutBlock_Panic +#undef Tk_PhotoPutZoomedBlock_Panic +#undef Tk_PhotoSetSize_Panic +#endif /* TK_NO_DEPRECATED */ + #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 9e25bed..acfdd31 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -1176,13 +1176,15 @@ ConfigureEntry( if (entryPtr->type == TK_SPINBOX) { if (sbPtr->fromValue > sbPtr->toValue) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-to value must be greater than -from value", - -1)); - Tcl_SetErrorCode(interp, "TK", "SPINBOX", "RANGE_SANITY", - NULL); - continue; - } + /* + * Swap -from and -to values. + */ + + double tmpFromTo = sbPtr->fromValue; + + sbPtr->fromValue = sbPtr->toValue; + sbPtr->toValue = tmpFromTo; + } if (sbPtr->reqFormat && (oldFormat != sbPtr->reqFormat)) { /* diff --git a/generic/tkFont.c b/generic/tkFont.c index 86fdd87..fbf5445 100644 --- a/generic/tkFont.c +++ b/generic/tkFont.c @@ -41,7 +41,7 @@ typedef struct TkFontInfo { */ typedef struct NamedFont { - int refCount; /* Number of users of named font. */ + size_t refCount; /* Number of users of named font. */ int deletePending; /* Non-zero if font should be deleted when * last reference goes away. */ TkFontAttributes fa; /* Desired attributes for named font. */ @@ -1434,8 +1434,7 @@ Tk_FreeFont( */ nfPtr = Tcl_GetHashValue(fontPtr->namedHashPtr); - nfPtr->refCount--; - if ((nfPtr->refCount == 0) && nfPtr->deletePending) { + if ((nfPtr->refCount-- <= 1) && nfPtr->deletePending) { Tcl_DeleteHashEntry(fontPtr->namedHashPtr); ckfree(nfPtr); } @@ -1715,15 +1714,11 @@ Tk_PostscriptFontName( upper = 1; } src += TkUtfToUniChar(src, &ch); - if (ch <= 0xffff) { - if (upper) { - ch = Tcl_UniCharToUpper(ch); - upper = 0; - } else { - ch = Tcl_UniCharToLower(ch); - } - } else { + if (upper) { + ch = Tcl_UniCharToUpper(ch); upper = 0; + } else { + ch = Tcl_UniCharToLower(ch); } dest += TkUniCharToUtf(ch, dest); } diff --git a/generic/tkGC.c b/generic/tkGC.c index c424e30..55e5774 100644 --- a/generic/tkGC.c +++ b/generic/tkGC.c @@ -23,7 +23,7 @@ typedef struct { GC gc; /* Graphics context. */ Display *display; /* Display to which gc belongs. */ - int refCount; /* Number of active uses of gc. */ + size_t refCount; /* Number of active uses of gc. */ Tcl_HashEntry *valueHashPtr;/* Entry in valueTable (needed when deleting * this structure). */ } TkGC; @@ -312,8 +312,7 @@ Tk_FreeGC( Tcl_Panic("Tk_FreeGC received unknown gc argument"); } gcPtr = Tcl_GetHashValue(idHashPtr); - gcPtr->refCount--; - if (gcPtr->refCount == 0) { + if (gcPtr->refCount-- <= 1) { XFreeGC(gcPtr->display, gcPtr->gc); Tcl_DeleteHashEntry(gcPtr->valueHashPtr); Tcl_DeleteHashEntry(idHashPtr); diff --git a/generic/tkImgBmap.c b/generic/tkImgBmap.c index 0906673..1a9a86e 100644 --- a/generic/tkImgBmap.c +++ b/generic/tkImgBmap.c @@ -49,7 +49,7 @@ typedef struct BitmapMaster { */ typedef struct BitmapInstance { - int refCount; /* Number of instances that share this data + size_t refCount; /* Number of instances that share this data * structure. */ BitmapMaster *masterPtr; /* Pointer to master for image. */ Tk_Window tkwin; /* Window in which the instances will be @@ -951,8 +951,7 @@ ImgBmapFree( BitmapInstance *instancePtr = clientData; BitmapInstance *prevPtr; - instancePtr->refCount--; - if (instancePtr->refCount > 0) { + if (instancePtr->refCount-- > 1) { return; } diff --git a/generic/tkImgListFormat.c b/generic/tkImgListFormat.c new file mode 100644 index 0000000..90bd3f8 --- /dev/null +++ b/generic/tkImgListFormat.c @@ -0,0 +1,1141 @@ +/* + * tkImgListFormat.c -- + * + * Implements the default image data format. I.e. the format used for + * [imageName data] and [imageName put] if no other format is specified. + * + * The default format consits of a list of scan lines (rows) with each + * list element being itself a list of pixels (or columns). For details, + * see the manpage photo.n + * + * This image format cannot read/write files, it is meant for string + * data only. + * + * + * Copyright (c) 1994 The Australian National University. + * Copyright (c) 1994-1997 Sun Microsystems, Inc. + * Copyright (c) 2002-2003 Donal K. Fellows + * Copyright (c) 2003 ActiveState Corporation. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * Authors: + * Paul Mackerras (paulus@cs.anu.edu.au), + * Department of Computer Science, + * Australian National University. + * + * Simon Bachmann (simonbachmann@bluewin.ch) + */ + + +#include "tkImgPhoto.h" + +/* + * Message to generate when an attempt to allocate memory for an image fails. + */ + +#define TK_PHOTO_ALLOC_FAILURE_MESSAGE \ + "not enough free memory for image buffer" + + +/* + * Color name length limit: do not attempt to parse as color strings that are + * longer than this limit + */ + +#define TK_PHOTO_MAX_COLOR_CHARS 99 + +/* + * Symbols for the different formats of a color string. + */ + +enum ColorFormatType { + COLORFORMAT_TKCOLOR, + COLORFORMAT_EMPTYSTRING, + COLORFORMAT_LIST, + COLORFORMAT_RGB1, + COLORFORMAT_RGB2, + COLORFORMAT_RGBA1, + COLORFORMAT_RGBA2 +}; + +/* + * Names for the color format types above. + * Order must match the one in enum ColorFormatType + */ + +static const char *const colorFormatNames[] = { + "tkcolor", + "emptystring", + "list", + "rgb-short", + "rgb", + "rgba-short", + "rgba", + NULL +}; + +/* + * The following data structure is used to return information from + * ParseFormatOptions: + */ + +struct FormatOptions { + int options; /* Individual bits indicate which options were + * specified - see below. */ + Tcl_Obj *formatName; /* Name specified without an option. */ + enum ColorFormatType colorFormat; + /* The color format type given with the + * -colorformat option */ +}; + +/* + * Bit definitions for use with ParseFormatOptions: each bit is set in the + * allowedOptions parameter on a call to ParseFormatOptions if that option + * is allowed for the current photo image subcommand. On return, the bit is + * set in the options field of the FormatOptions structure if that option + * was specified. + * + * OPT_COLORFORMAT: Set if -alpha option allowed/specified. + */ + +#define OPT_COLORFORMAT 1 + +/* + * List of format option names. The order here must match the order of + * declarations of the FMT_OPT_* constants above. + */ + +static const char *const formatOptionNames[] = { + "-colorformat", + NULL +}; + +/* + * Forward declarations + */ + +static int ParseFormatOptions(Tcl_Interp *interp, int allowedOptions, + int objc, Tcl_Obj *const objv[], int *indexPtr, + struct FormatOptions *optPtr); +static Tcl_Obj *GetBadOptMsg(const char *badValue, int allowedOpts); +static int StringMatchDef(Tcl_Obj *data, Tcl_Obj *formatString, + int *widthPtr, int *heightPtr, Tcl_Interp *interp); +static int StringReadDef(Tcl_Interp *interp, Tcl_Obj *data, + Tcl_Obj *formatString, Tk_PhotoHandle imageHandle, + int destX, int destY, int width, int height, + int srcX, int srcY); +static int StringWriteDef(Tcl_Interp *interp, + Tcl_Obj *formatString, + Tk_PhotoImageBlock *blockPtr); +static int ParseColor(Tcl_Interp *interp, Tcl_Obj *specObj, + Display *display, Colormap colormap, unsigned char *redPtr, + unsigned char *greenPtr, unsigned char *bluePtr, + unsigned char *alphaPtr); +static int ParseColorAsList(Tcl_Interp *interp, const char *colorString, + int colorStrLen, unsigned char *redPtr, + unsigned char *greenPtr, unsigned char *bluePtr, + unsigned char *alphaPtr); +static int ParseColorAsHex(Tcl_Interp *interp, const char *colorString, + int colorStrLen, Display *display, Colormap colormap, + unsigned char *redPtr, unsigned char *greenPtr, + unsigned char *bluePtr, unsigned char *alphaPtr); +static int ParseColorAsStandard(Tcl_Interp *interp, + const char *colorString, int colorStrLen, + Display *display, Colormap colormap, + unsigned char *redPtr, unsigned char *greenPtr, + unsigned char *bluePtr, unsigned char *alphaPtr); + +/* + * The format record for the default image handler + */ + +Tk_PhotoImageFormat tkImgFmtDefault = { + "default", /* name */ + NULL, /* fileMatchProc: format doesn't support file ops */ + StringMatchDef, /* stringMatchProc */ + NULL, /* fileReadProc: format doesn't support file read */ + StringReadDef, /* stringReadProc */ + NULL, /* fileWriteProc: format doesn't support file write */ + StringWriteDef /* stringWriteProc */ +}; + +/* + *---------------------------------------------------------------------- + * + * ParseFormatOptions -- + * + * Parse the options passed to the image format handler. + * + * Results: + * On success, the structure pointed to by optPtr is filled with the + * values passed or with the defaults and TCL_OK returned. + * If an error occurs, leaves an error message in interp and returns + * TCL_ERROR. + * + * Side effects: + * The value in *indexPtr is updated to the index of the fist + * element in argv[] that does not look like an option/value, or to + * argc if parsing reached the end of argv[]. + * + *---------------------------------------------------------------------- + */ +static int +ParseFormatOptions( + Tcl_Interp *interp, /* For error messages */ + int allowedOptions, /* Bitfield specifying which options are + * to be considered allowed */ + int objc, /* Number of elements in argv[] */ + Tcl_Obj *const objv[], /* The arguments to parse */ + int *indexPtr, /* Index giving the first element to + * parse. The value is updated to the + * index where parsing ended */ + struct FormatOptions *optPtr) /* Parsed option values are written to + * this struct */ + +{ + int index, optIndex, typeIndex, first; + const char *option; + + first = 1; + + /* + * Fill in default values + */ + optPtr->options = 0; + optPtr->formatName = NULL; + optPtr->colorFormat = COLORFORMAT_RGB2; + for (index = *indexPtr; index < objc; *indexPtr = ++index) { + int optionExists; + + /* + * The first value can be the format handler's name. It goes to + * optPtr->name. + */ + option = Tcl_GetString(objv[index]); + if (option[0] != '-') { + if (first) { + optPtr->formatName = objv[index]; + first = 0; + continue; + } else { + break; + } + } + first = 0; + + /* + * Check if option is known and allowed + */ + + optionExists = 1; + if (Tcl_GetIndexFromObj(NULL, objv[index], formatOptionNames, + "format option", 0, &optIndex) != TCL_OK) { + optionExists = 0; + } + if (!optionExists || !((1 << optIndex) & allowedOptions)) { + Tcl_SetObjResult(interp, GetBadOptMsg(Tcl_GetString(objv[index]), + allowedOptions)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; + } + + /* + * Option-specific checks + */ + + switch (1 << optIndex) { + case OPT_COLORFORMAT: + *indexPtr = ++index; + if (index >= objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("the \"%s\" option " + "requires a value", Tcl_GetString(objv[index - 1]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "MISSING_VALUE", NULL); + return TCL_ERROR; + } + if (Tcl_GetIndexFromObj(NULL, objv[index], colorFormatNames, "", + TCL_EXACT, &typeIndex) != TCL_OK + || (typeIndex != COLORFORMAT_LIST + && typeIndex != COLORFORMAT_RGB2 + && typeIndex != COLORFORMAT_RGBA2) ) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad color format " + "\"%s\": must be rgb, rgba, or list", + Tcl_GetString(objv[index]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "BAD_COLOR_FORMAT", NULL); + return TCL_ERROR; + } + optPtr->colorFormat = typeIndex; + break; + default: + Tcl_Panic("ParseFormatOptions: unexpected switch fallthrough"); + } + + /* + * Add option to bitfield in optPtr + */ + optPtr->options |= (1 << optIndex); + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * GetBadOptMsg -- + * + * Build a Tcl_Obj containing an error message in the form "bad option + * "xx": must be y, or z", based on the bits set in allowedOpts. + * + * Results: + * A Tcl Object containig the error message. + * + * Side effects: + * None + *---------------------------------------------------------------------- + */ +static Tcl_Obj * +GetBadOptMsg( + const char *badValue, /* the erroneous option */ + int allowedOpts) /* bitfield specifying the allowed options */ +{ + int i, bit; + Tcl_Obj *resObj = Tcl_ObjPrintf("bad format option \"%s\": ", badValue); + + if (allowedOpts == 0) { + Tcl_AppendToObj(resObj, "no options allowed", -1); + } else { + Tcl_AppendToObj(resObj, "must be ", -1); + bit = 1; + for (i = 0; formatOptionNames[i] != NULL; i++) { + if (allowedOpts & bit) { + if (allowedOpts & (bit -1)) { + /* + * not the first option + */ + if (allowedOpts & ~((bit << 1) - 1)) { + /* + * not the last option + */ + Tcl_AppendToObj(resObj, ", ", -1); + } else { + Tcl_AppendToObj(resObj, ", or ", -1); + } + } + Tcl_AppendToObj(resObj, formatOptionNames[i], -1); + } + bit <<=1; + } + } + return resObj; +} + +/* + *---------------------------------------------------------------------- + * + * StringMatchDef -- + * + * Default string match function. Test if image data in string form + * appears to be in the default list-of-list-of-pixel-data format + * accepted by the "<img> put" command. + * + * Results: + * If thte data is in the default format, writes the size of the image + * to widthPtr and heightPtr and returns 1. Otherwise, leaves an error + * message in interp (if not NULL) and returns 0. + * Note that this function does not parse all data points. A return + * value of 1 does not guarantee that the data can be read without + * errors. + * + * Side effects: + * None + *---------------------------------------------------------------------- + */ +static int +StringMatchDef( + Tcl_Obj *data, /* The data to check */ + Tcl_Obj *formatString, /* Value of the -format option, not used here */ + int *widthPtr, /* Width of image is written to this location */ + int *heightPtr, /* Height of image is written to this location */ + Tcl_Interp *interp) /* Error messages are left in this interpreter */ +{ + int y, rowCount, colCount, curColCount; + unsigned char dummy; + Tcl_Obj **rowListPtr, *pixelData; + + /* + * See if data can be parsed as a list, if every element is itself a valid + * list and all sublists have the same length. + */ + + if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr) + != TCL_OK) { + return 0; + } + if (rowCount == 0) { + /* + * empty list is valid data + */ + + *widthPtr = 0; + *heightPtr = 0; + return 1; + } + colCount = -1; + for (y = 0; y < rowCount; y++) { + if (Tcl_ListObjLength(interp, rowListPtr[y], &curColCount) != TCL_OK) { + return 0; + } + if (colCount < 0) { + colCount = curColCount; + } else if (curColCount != colCount) { + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid row # %d: " + "all rows must have the same number of elements", y)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID_DATA", NULL); + } + return 0; + } + } + + /* + * Data in base64 encoding (or even binary data), might actually pass + * these tests. To avoid parsing it as list of lists format, check one + * pixel for validity. + */ + if (Tcl_ListObjIndex(interp, rowListPtr[0], 0, &pixelData) != TCL_OK) { + return 0; + } + if (Tcl_GetCharLength(pixelData) > TK_PHOTO_MAX_COLOR_CHARS) { + return 0; + } + if (ParseColor(interp, pixelData, Tk_Display(Tk_MainWindow(interp)), + Tk_Colormap(Tk_MainWindow(interp)), &dummy, &dummy, &dummy, &dummy) + != TCL_OK) { + return 0; + } + + /* + * Looks like we have valid data for this format. + * We do not check any pixel values - that's the job of ImgStringRead() + */ + + *widthPtr = colCount; + *heightPtr = rowCount; + + return 1; + +} + +/* + *---------------------------------------------------------------------- + * + * StringReadDef -- + * + * String read function for default format. (see manpage for details on + * the format). + * + * Results: + * A standard Tcl result. + * + * Side effects: + * If the data has valid format, write it to the image identified by + * imageHandle. + * If the image data cannot be parsed, an error message is left in + * interp. + * + *---------------------------------------------------------------------- +*/ + +static int +StringReadDef( + Tcl_Interp *interp, /* leave error messages here */ + Tcl_Obj *data, /* the data to parse */ + Tcl_Obj *formatString, /* value of the -format option */ + Tk_PhotoHandle imageHandle, /* write data to this image */ + int destX, int destY, /* start writing data at this point + * in destination image*/ + int width, int height, /* dimensions of area to write to */ + int srcX, int srcY) /* start reading source data at these + * coordinates */ +{ + Tcl_Obj **rowListPtr, **colListPtr; + Tcl_Obj **objv; + int objc; + unsigned char *curPixelPtr; + int x, y, rowCount, colCount, curColCount; + Tk_PhotoImageBlock srcBlock; + Display *display; + Colormap colormap; + struct FormatOptions opts; + int optIndex; + + /* + * Parse format suboptions + * We don't use any format suboptions, but we still need to provide useful + * error messages if suboptions were specified. + */ + + memset(&opts, 0, sizeof(opts)); + if (formatString != NULL) { + if (Tcl_ListObjGetElements(interp, formatString, &objc, &objv) + != TCL_OK) { + return TCL_ERROR; + } + optIndex = 0; + if (ParseFormatOptions(interp, 0, objc, objv, &optIndex, &opts) + != TCL_OK) { + return TCL_ERROR; + } + if (optIndex < objc) { + Tcl_SetObjResult(interp, + GetBadOptMsg(Tcl_GetString(objv[optIndex]), 0)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; + } + } + + /* + * Check input data + */ + + if (Tcl_ListObjGetElements(interp, data, &rowCount, &rowListPtr) + != TCL_OK ) { + return TCL_ERROR; + } + if ( rowCount > 0 && Tcl_ListObjLength(interp, rowListPtr[0], &colCount) + != TCL_OK) { + return TCL_ERROR; + } + if (width <= 0 || height <= 0 || rowCount == 0 || colCount == 0) { + /* + * No changes with zero sized input or zero sized output region + */ + + return TCL_OK; + } + if (srcX < 0 || srcY < 0 || srcX >= rowCount || srcY >= colCount) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("source coordinates out of range")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "COORDINATES", NULL); + return TCL_ERROR; + } + + /* + * Memory allocation overflow protection. + * May not be able to trigger/ demo / test this. + */ + + if (colCount > (int)(UINT_MAX / 4 / rowCount)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "photo image dimensions exceed Tcl memory limits")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "OVERFLOW", NULL); + return TCL_OK; + } + + /* + * Read data and put it to imageHandle + */ + + srcBlock.width = colCount - srcX; + srcBlock.height = rowCount - srcY; + srcBlock.pixelSize = 4; + srcBlock.pitch = srcBlock.width * 4; + srcBlock.offset[0] = 0; + srcBlock.offset[1] = 1; + srcBlock.offset[2] = 2; + srcBlock.offset[3] = 3; + srcBlock.pixelPtr = attemptckalloc(srcBlock.pitch * srcBlock.height); + if (srcBlock.pixelPtr == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf(TK_PHOTO_ALLOC_FAILURE_MESSAGE)); + Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL); + return TCL_ERROR; + } + curPixelPtr = srcBlock.pixelPtr; + display = Tk_Display(Tk_MainWindow(interp)); + colormap = Tk_Colormap(Tk_MainWindow(interp)); + for (y = srcY; y < rowCount; y++) { + /* + * We don't test the length of row, as that's been done in + * ImgStringMatch() + */ + + if (Tcl_ListObjGetElements(interp, rowListPtr[y], &curColCount, + &colListPtr) != TCL_OK) { + goto errorExit; + } + for (x = srcX; x < colCount; x++) { + if (ParseColor(interp, colListPtr[x], display, colormap, + curPixelPtr, curPixelPtr + 1, curPixelPtr + 2, + curPixelPtr + 3) != TCL_OK) { + goto errorExit; + } + curPixelPtr += 4; + } + } + + /* + * Write image data to destHandle + */ + if (Tk_PhotoPutBlock(interp, imageHandle, &srcBlock, destX, destY, + width, height, TK_PHOTO_COMPOSITE_SET) != TCL_OK) { + goto errorExit; + } + + ckfree(srcBlock.pixelPtr); + + return TCL_OK; + + errorExit: + ckfree(srcBlock.pixelPtr); + + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * StringWriteDef -- + * + * String write function for default image data format. See the user + * documentation for details. + * + * Results: + * The converted data is set as the result of interp. Returns a standard + * Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +StringWriteDef( + Tcl_Interp *interp, /* For the result and errors */ + Tcl_Obj *formatString, /* The value of the -format option */ + Tk_PhotoImageBlock *blockPtr) /* The image data to convert */ +{ + int greenOffset, blueOffset, alphaOffset, hasAlpha; + Tcl_Obj *result, **objv = NULL; + int objc, allowedOpts, optIndex; + struct FormatOptions opts; + + /* + * Parse format suboptions + */ + if (Tcl_ListObjGetElements(interp, formatString, &objc, &objv) + != TCL_OK) { + return TCL_ERROR; + } + allowedOpts = OPT_COLORFORMAT; + optIndex = 0; + if (ParseFormatOptions(interp, allowedOpts, objc, objv, &optIndex, &opts) + != TCL_OK) { + return TCL_ERROR; + } + if (optIndex < objc) { + Tcl_SetObjResult(interp, + GetBadOptMsg(Tcl_GetString(objv[optIndex]), allowedOpts)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", NULL); + return TCL_ERROR; + } + + greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; + blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; + + /* + * A negative alpha offset signals that the image is fully opaque. + * That's not really documented anywhere, but it's the way it is! + */ + + if (blockPtr->offset[3] < 0) { + hasAlpha = 0; + alphaOffset = 0; + } else { + hasAlpha = 1; + alphaOffset = blockPtr->offset[3] - blockPtr->offset[0]; + } + + if ((blockPtr->width > 0) && (blockPtr->height > 0)) { + int row, col; + Tcl_DString data, line; + char colorBuf[11]; + unsigned char *pixelPtr; + unsigned char alphaVal = 255; + + Tcl_DStringInit(&data); + for (row=0; row<blockPtr->height; row++) { + pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] + + row * blockPtr->pitch; + Tcl_DStringInit(&line); + for (col=0; col<blockPtr->width; col++) { + if (hasAlpha) { + alphaVal = pixelPtr[alphaOffset]; + } + + /* + * We don't build lines as a list for #RGBA and #RGB. Since + * these color formats look like comments, the first element + * of the list would get quoted with an additional {} . + * While this is not a problem if the data is used as + * a list, it would cause problems if someone decides to parse + * it as a string (and it looks kinda strange) + */ + + switch (opts.colorFormat) { + case COLORFORMAT_RGB2: + sprintf(colorBuf, "#%02x%02x%02x ", pixelPtr[0], + pixelPtr[greenOffset], pixelPtr[blueOffset]); + Tcl_DStringAppend(&line, colorBuf, -1); + break; + case COLORFORMAT_RGBA2: + sprintf(colorBuf, "#%02x%02x%02x%02x ", + pixelPtr[0], pixelPtr[greenOffset], + pixelPtr[blueOffset], alphaVal); + Tcl_DStringAppend(&line, colorBuf, -1); + break; + case COLORFORMAT_LIST: + Tcl_DStringStartSublist(&line); + sprintf(colorBuf, "%d", pixelPtr[0]); + Tcl_DStringAppendElement(&line, colorBuf); + sprintf(colorBuf, "%d", pixelPtr[greenOffset]); + Tcl_DStringAppendElement(&line, colorBuf); + sprintf(colorBuf, "%d", pixelPtr[blueOffset]); + Tcl_DStringAppendElement(&line, colorBuf); + sprintf(colorBuf, "%d", alphaVal); + Tcl_DStringAppendElement(&line, colorBuf); + Tcl_DStringEndSublist(&line); + break; + default: + Tcl_Panic("unexpected switch fallthrough"); + } + pixelPtr += blockPtr->pixelSize; + } + if (opts.colorFormat != COLORFORMAT_LIST) { + /* + * For the #XXX formats, we need to remove the last + * whitespace. + */ + + *(Tcl_DStringValue(&line) + Tcl_DStringLength(&line) - 1) + = '\0'; + } + Tcl_DStringAppendElement(&data, Tcl_DStringValue(&line)); + Tcl_DStringFree(&line); + } + result = Tcl_NewStringObj(Tcl_DStringValue(&data), -1); + Tcl_DStringFree(&data); + } else { + result = Tcl_NewObj(); + } + + Tcl_SetObjResult(interp, result); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ParseColor -- + * + * This function extracts color and alpha values from a string. It + * understands standard Tk color formats, alpha suffixes and the color + * formats specific to photo images, which include alpha data. + * + * Results: + * On success, writes red, green, blue and alpha values to the + * corresponding pointers. If the color spec contains no alpha + * information, 255 is taken as transparency value. + * If the input cannot be parsed, leaves an error message in + * interp. Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +ParseColor( + Tcl_Interp *interp, /* error messages go there */ + Tcl_Obj *specObj, /* the color data to parse */ + Display *display, /* display of main window, needed to parse + * standard Tk colors */ + Colormap colormap, /* colormap of current display */ + unsigned char *redPtr, /* the result is written to these pointers */ + unsigned char *greenPtr, + unsigned char *bluePtr, + unsigned char *alphaPtr) +{ + const char *specString; + int charCount; + + /* + * Find out which color format we have + */ + + specString = Tcl_GetStringFromObj(specObj, &charCount); + + if (charCount == 0) { + /* Empty string */ + *redPtr = *greenPtr = *bluePtr = *alphaPtr = 0; + return TCL_OK; + } + if (charCount > TK_PHOTO_MAX_COLOR_CHARS) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid color")); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID_COLOR", NULL); + return TCL_ERROR; + } + if (specString[0] == '#') { + return ParseColorAsHex(interp, specString, charCount, display, + colormap, redPtr, greenPtr, bluePtr, alphaPtr); + } + if (ParseColorAsList(interp, specString, charCount, + redPtr, greenPtr, bluePtr, alphaPtr) == TCL_OK) { + return TCL_OK; + } + + /* + * Parsing the color as standard Tk color always is the last option tried + * because TkParseColor() is very slow with values it cannot parse. + */ + + Tcl_ResetResult(interp); + return ParseColorAsStandard(interp, specString, charCount, display, + colormap, redPtr, greenPtr, bluePtr, alphaPtr); + +} + +/* + *---------------------------------------------------------------------- + * + * ParseColorAsList -- + * + * This function extracts color and alpha values from a list of 3 or 4 + * integers (the list color format). + * + * Results: + * On success, writes red, green, blue and alpha values to the + * corresponding pointers. If the color spec contains no alpha + * information, 255 is taken as transparency value. + * Returns a standard Tcl result. + * + * Side effects: + * Does *not* leave error messages in interp. The reason is that + * it is not always possible to tell if the list format was even + * intended and thus it is hard to return meaningful messages. + * A general error message from the caller is probably the best + * alternative. + * + *---------------------------------------------------------------------- + */ +static int +ParseColorAsList( + Tcl_Interp *interp, /* not used */ + const char *colorString, /* the color data to parse */ + int colorStrLen, /* length of the color string */ + unsigned char *redPtr, /* the result is written to these pointers */ + unsigned char *greenPtr, + unsigned char *bluePtr, + unsigned char *alphaPtr) +{ + + /* + * This is kinda ugly. The code would be certainly nicer if it + * used Tcl_ListObjGetElements() and Tcl_GetIntFromObj(). But with + * strtol() it's *much* faster. + */ + + const char *curPos; + int values[4]; + int i; + + curPos = colorString; + i = 0; + + /* + * strtol can give false positives with a sequence of space chars. + * To avoid that, avance the pointer to the next non-blank char. + */ + + while(isspace(*curPos)) { + ++curPos; + } + while (i < 4 && *curPos != '\0') { + values[i] = strtol(curPos, (char **)&curPos, 0); + if (values[i] < 0 || values[i] > 255) { + return TCL_ERROR; + } + while(isspace(*curPos)) { + ++curPos; + } + ++i; + } + + if (i < 3 || *curPos != '\0') { + return TCL_ERROR; + } + if (i < 4) { + values[3] = 255; + } + + *redPtr = (unsigned char) values[0]; + *greenPtr = (unsigned char) values[1]; + *bluePtr = (unsigned char) values[2]; + *alphaPtr = (unsigned char) values[3]; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * ParseColorAsHex -- + * + * This function extracts color and alpha values from a string + * starting with '#', followed by hex digits. It undestands both + * the #RGBA form and the #RBG (with optional suffix) + * + * Results: + * On success, writes red, green, blue and alpha values to the + * corresponding pointers. If the color spec contains no alpha + * information, 255 is taken as transparency value. + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +ParseColorAsHex( + Tcl_Interp *interp, /* error messages are left here */ + const char *colorString, /* the color data to parse */ + int colorStrLen, /* length of the color string */ + Display *display, /* display of main window */ + Colormap colormap, /* colormap of current display */ + unsigned char *redPtr, /* the result is written to these pointers */ + unsigned char *greenPtr, + unsigned char *bluePtr, + unsigned char *alphaPtr) +{ + int i; + unsigned long int colorValue = 0; + + if (colorStrLen - 1 != 4 && colorStrLen - 1 != 8) { + return ParseColorAsStandard(interp, colorString, colorStrLen, + display, colormap, redPtr, greenPtr, bluePtr, alphaPtr); + } + for (i = 1; i < colorStrLen; i++) { + if (!isxdigit(UCHAR(colorString[i]))) { + /* + * There still is a chance that this is a Tk color with + * an alpha suffix + */ + + return ParseColorAsStandard(interp, colorString, colorStrLen, + display, colormap, redPtr, greenPtr, bluePtr, alphaPtr); + } + } + + colorValue = strtoul(colorString + 1, NULL, 16); + switch (colorStrLen - 1) { + case 4: + /* #RGBA format */ + *redPtr = (unsigned char) ((colorValue >> 12) * 0x11); + *greenPtr = (unsigned char) (((colorValue >> 8) & 0xf) * 0x11); + *bluePtr = (unsigned char) (((colorValue >> 4) & 0xf) * 0x11); + *alphaPtr = (unsigned char) ((colorValue & 0xf) * 0x11); + return TCL_OK; + case 8: + /* #RRGGBBAA format */ + *redPtr = (unsigned char) (colorValue >> 24); + *greenPtr = (unsigned char) ((colorValue >> 16) & 0xff); + *bluePtr = (unsigned char) ((colorValue >> 8) & 0xff); + *alphaPtr = (unsigned char) (colorValue & 0xff); + return TCL_OK; + default: + Tcl_Panic("unexpected switch fallthrough"); + } + + /* Shouldn't get here */ + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * ParseColorAsStandard -- + * + * This function tries to split a color stirng in a color and a + * suffix part and to extract color and alpha values from them. The + * color part is treated as regular Tk color. + * + * Results: + * On success, writes red, green, blue and alpha values to the + * corresponding pointers. If the color spec contains no alpha + * information, 255 is taken as transparency value. + * Returns a standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +ParseColorAsStandard( + Tcl_Interp *interp, /* error messages are left here */ + const char *specString, /* the color data to parse */ + int specStrLen, /* length of the color string */ + Display *display, /* display of main window */ + Colormap colormap, /* colormap of current display */ + unsigned char *redPtr, /* the result is written to these pointers */ + unsigned char *greenPtr, + unsigned char *bluePtr, + unsigned char *alphaPtr) +{ + XColor parsedColor; + const char *suffixString, *colorString; + char colorBuffer[TK_PHOTO_MAX_COLOR_CHARS + 1]; + char *tmpString; + double fracAlpha; + unsigned int suffixAlpha; + int i; + + /* + * Split color data string in color and suffix parts + */ + + if ((suffixString = strrchr(specString, '@')) == NULL + && ((suffixString = strrchr(specString, '#')) == NULL + || suffixString == specString)) { + suffixString = specString + specStrLen; + colorString = specString; + } else { + strncpy(colorBuffer, specString, suffixString - specString); + colorBuffer[suffixString - specString] = '\0'; + colorString = (const char*)colorBuffer; + } + + /* + * Try to parse as standard Tk color. + * + * We don't use Tk_GetColor() et al. here, as those functions + * migth return a color that does not exaxtly match the given name + * if the colormap is full. Also, we don't really want the color to be + * added to the colormap. + */ + + if ( ! TkParseColor(display, colormap, colorString, &parsedColor)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid color name \"%s\"", specString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID_COLOR", NULL); + return TCL_ERROR; + } + + /* + * parse the Suffix + */ + + switch (suffixString[0]) { + case '\0': + suffixAlpha = 255; + break; + case '@': + fracAlpha = strtod(suffixString + 1, &tmpString); + if (*tmpString != '\0') { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha " + "suffix \"%s\": expected floating-point value", + suffixString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID COLOR", NULL); + return TCL_ERROR; + } + if (fracAlpha < 0 || fracAlpha > 1) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid alpha suffix" + " \"%s\": value must be in the range from 0 to 1", + suffixString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID_COLOR", NULL); + return TCL_ERROR; + } + suffixAlpha = (unsigned int) floor(fracAlpha * 255 + 0.5); + break; + case '#': + if (strlen(suffixString + 1) < 1 || strlen(suffixString + 1)> 2) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid alpha suffix \"%s\"", suffixString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID_COLOR", NULL); + return TCL_ERROR; + } + for (i = 1; i <= (int)strlen(suffixString + 1); i++) { + if ( ! isxdigit(UCHAR(suffixString[i]))) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid alpha suffix \"%s\": expected hex digit", + suffixString)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "INVALID_COLOR", NULL); + return TCL_ERROR; + } + } + if (strlen(suffixString + 1) == 1) { + sscanf(suffixString, "#%1x", &suffixAlpha); + suffixAlpha *= 0x11; + } else { + sscanf(suffixString, "#%2x", &suffixAlpha); + } + break; + default: + Tcl_Panic("unexpected switch fallthrough"); + } + + *redPtr = (unsigned char) (parsedColor.red >> 8); + *greenPtr = (unsigned char) (parsedColor.green >> 8); + *bluePtr = (unsigned char) (parsedColor.blue >> 8); + *alphaPtr = (unsigned char) suffixAlpha; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TkDebugStringMatchDef -- + * + * Debugging function for StringMatchDef. Basically just an alias for + * that function, intended to expose it directly to tests, as + * StirngMatchDef cannot be sufficiently tested otherwise. + * + * Results: + * See StringMatchDef. + * + * Side effects: + * None + *---------------------------------------------------------------------- + */ +int +TkDebugPhotoStringMatchDef( + Tcl_Interp *interp, /* Error messages are left in this interpreter */ + Tcl_Obj *data, /* The data to check */ + Tcl_Obj *formatString, /* Value of the -format option, not used here */ + int *widthPtr, /* Width of image is written to this location */ + int *heightPtr) /* Height of image is written to this location */ +{ + return StringMatchDef(data, formatString, widthPtr, heightPtr, interp); +} + + +/* Local Variables: */ +/* mode: c */ +/* fill-column: 78 */ +/* c-basic-offset: 4 */ +/* tab-width: 8 */ +/* indent-tabs-mode: nil */ +/* End: */ diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index cb46c41..d0371b5 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -48,6 +48,7 @@ struct SubcommandOptions { * set in the options field of the SubcommandOptions structure if that option * was specified. * + * OPT_ALPHA: Set if -alpha option allowed/specified. * OPT_BACKGROUND: Set if -format option allowed/specified. * OPT_COMPOSITE: Set if -compositingrule option allowed/spec'd. * OPT_FORMAT: Set if -format option allowed/specified. @@ -56,18 +57,21 @@ struct SubcommandOptions { * OPT_SHRINK: Set if -shrink option allowed/specified. * OPT_SUBSAMPLE: Set if -subsample option allowed/spec'd. * OPT_TO: Set if -to option allowed/specified. + * OPT_WITHALPHA: Set if -withalpha option allowed/specified. * OPT_ZOOM: Set if -zoom option allowed/specified. */ -#define OPT_BACKGROUND 1 -#define OPT_COMPOSITE 2 -#define OPT_FORMAT 4 -#define OPT_FROM 8 -#define OPT_GRAYSCALE 0x10 -#define OPT_SHRINK 0x20 -#define OPT_SUBSAMPLE 0x40 -#define OPT_TO 0x80 -#define OPT_ZOOM 0x100 +#define OPT_ALPHA 1 +#define OPT_BACKGROUND 2 +#define OPT_COMPOSITE 4 +#define OPT_FORMAT 8 +#define OPT_FROM 0x10 +#define OPT_GRAYSCALE 0x20 +#define OPT_SHRINK 0x40 +#define OPT_SUBSAMPLE 0x80 +#define OPT_TO 0x100 +#define OPT_WITHALPHA 0x200 +#define OPT_ZOOM 0x400 /* * List of option names. The order here must match the order of declarations @@ -75,6 +79,7 @@ struct SubcommandOptions { */ static const char *const optionNames[] = { + "-alpha", "-background", "-compositingrule", "-format", @@ -83,6 +88,7 @@ static const char *const optionNames[] = { "-shrink", "-subsample", "-to", + "-withalpha", "-zoom", NULL }; @@ -182,9 +188,6 @@ static int ImgPhotoConfigureMaster(Tcl_Interp *interp, static int ToggleComplexAlphaIfNeeded(PhotoMaster *mPtr); static int ImgPhotoSetSize(PhotoMaster *masterPtr, int width, int height); -static int ImgStringWrite(Tcl_Interp *interp, - Tcl_Obj *formatString, - Tk_PhotoImageBlock *blockPtr); static char * ImgGetPhoto(PhotoMaster *masterPtr, Tk_PhotoImageBlock *blockPtr, struct SubcommandOptions *optPtr); @@ -402,12 +405,10 @@ ImgPhotoCmd( }; PhotoMaster *masterPtr = clientData; - int result, index, x, y, width, height, dataWidth, dataHeight, listObjc; + int result, index, x, y, width, height; struct SubcommandOptions options; - Tcl_Obj **listObjv, **srcObjv; unsigned char *pixelPtr; Tk_PhotoImageBlock block; - Tk_Window tkwin; Tk_PhotoImageFormat *imageFormat; size_t length; int imageWidth, imageHeight, matched, oldformat = 0; @@ -659,7 +660,8 @@ ImgPhotoCmd( return result; case PHOTO_DATA: { - char *data; + char *data = NULL; + Tcl_Obj *freeObj = NULL; /* * photo data command - first parse and check any options given. @@ -667,7 +669,7 @@ ImgPhotoCmd( Tk_ImageStringWriteProc *stringWriteProc = NULL; - index = 2; + index = 1; memset(&options, 0, sizeof(options)); options.name = NULL; options.format = NULL; @@ -678,7 +680,7 @@ ImgPhotoCmd( &index, objc, objv) != TCL_OK) { return TCL_ERROR; } - if ((options.name != NULL) || (index < objc)) { + if ((options.name == NULL) || (index < objc)) { Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?"); return TCL_ERROR; } @@ -700,50 +702,50 @@ ImgPhotoCmd( options.fromX2 = masterPtr->width; options.fromY2 = masterPtr->height; } + if (!(options.options & OPT_FORMAT)) { + options.format = Tcl_NewStringObj("default", -1); + freeObj = options.format; + } /* * Search for an appropriate image string format handler. */ - if (options.options & OPT_FORMAT) { - matched = 0; - for (imageFormat = tsdPtr->formatList; imageFormat != NULL; - imageFormat = imageFormat->nextPtr) { - if ((strncasecmp(Tcl_GetString(options.format), - imageFormat->name, strlen(imageFormat->name)) == 0)) { - matched = 1; - if (imageFormat->stringWriteProc != NULL) { - stringWriteProc = imageFormat->stringWriteProc; - break; - } - } - } - if (stringWriteProc == NULL) { - oldformat = 1; - for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL; - imageFormat = imageFormat->nextPtr) { - if ((strncasecmp(Tcl_GetString(options.format), - imageFormat->name, - strlen(imageFormat->name)) == 0)) { - matched = 1; - if (imageFormat->stringWriteProc != NULL) { - stringWriteProc = imageFormat->stringWriteProc; - break; - } - } - } + matched = 0; + for (imageFormat = tsdPtr->formatList; imageFormat != NULL; + imageFormat = imageFormat->nextPtr) { + if ((strncasecmp(Tcl_GetString(options.format), + imageFormat->name, strlen(imageFormat->name)) == 0)) { + matched = 1; + if (imageFormat->stringWriteProc != NULL) { + stringWriteProc = imageFormat->stringWriteProc; + break; + } } - if (stringWriteProc == NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "image string format \"%s\" is %s", - Tcl_GetString(options.format), - (matched ? "not supported" : "unknown"))); - Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", - Tcl_GetString(options.format), NULL); - return TCL_ERROR; + } + if (stringWriteProc == NULL) { + oldformat = 1; + for (imageFormat = tsdPtr->oldFormatList; imageFormat != NULL; + imageFormat = imageFormat->nextPtr) { + if ((strncasecmp(Tcl_GetString(options.format), + imageFormat->name, + strlen(imageFormat->name)) == 0)) { + matched = 1; + if (imageFormat->stringWriteProc != NULL) { + stringWriteProc = imageFormat->stringWriteProc; + break; + } + } } - } else { - stringWriteProc = ImgStringWrite; + } + if (stringWriteProc == NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "image string format \"%s\" is %s", + Tcl_GetString(options.format), + (matched ? "not supported" : "unknown"))); + Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", + Tcl_GetString(options.format), NULL); + goto dataErrorExit; } /* @@ -780,7 +782,22 @@ ImgPhotoCmd( if (data) { ckfree(data); } + if (freeObj != NULL) { + Tcl_DecrRefCount(freeObj); + } return result; + + dataErrorExit: + if (options.background) { + Tk_FreeColor(options.background); + } + if (data) { + ckfree(data); + } + if (freeObj != NULL) { + Tcl_DecrRefCount(freeObj); + } + return TCL_ERROR; } case PHOTO_GET: { @@ -788,12 +805,24 @@ ImgPhotoCmd( * photo get command - first parse and check parameters. */ - Tcl_Obj *channels[3]; - - if (objc != 4) { - Tcl_WrongNumArgs(interp, 2, objv, "x y"); + Tcl_Obj *channels[4]; + int channelCount = 3; + + index = 3; + memset(&options, 0, sizeof(options)); + options.name = NULL; + if (ParseSubcommandOptions(&options, interp, OPT_WITHALPHA, + &index, objc, objv) != TCL_OK) { + return TCL_ERROR; + } + if (options.name == NULL || index < objc) { + Tcl_WrongNumArgs(interp, 2, objv, "x y ?-withalpha?"); return TCL_ERROR; } + if (options.options & OPT_WITHALPHA) { + channelCount = 4; + } + if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { return TCL_ERROR; @@ -809,25 +838,29 @@ ImgPhotoCmd( } /* - * Extract the value of the desired pixel and format it as a string. + * Extract the value of the desired pixel and format it as a list. */ pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4; channels[0] = Tcl_NewIntObj(pixelPtr[0]); channels[1] = Tcl_NewIntObj(pixelPtr[1]); channels[2] = Tcl_NewIntObj(pixelPtr[2]); - Tcl_SetObjResult(interp, Tcl_NewListObj(3, channels)); + channels[3] = Tcl_NewIntObj(pixelPtr[3]); + Tcl_SetObjResult(interp, Tcl_NewListObj(channelCount, channels)); return TCL_OK; } - case PHOTO_PUT: + case PHOTO_PUT: { + Tcl_Obj *format, *data; + /* - * photo put command - first parse the options and colors specified. + * photo put command - first parse the options. */ index = 2; memset(&options, 0, sizeof(options)); options.name = NULL; + options.format = NULL; if (ParseSubcommandOptions(&options, interp, OPT_TO|OPT_FORMAT, &index, objc, objv) != TCL_OK) { return TCL_ERROR; @@ -837,174 +870,50 @@ ImgPhotoCmd( return TCL_ERROR; } - if (MatchStringFormat(interp, options.name ? objv[2]:NULL, - options.format, &imageFormat, &imageWidth, - &imageHeight, &oldformat) == TCL_OK) { - Tcl_Obj *format, *data; - - if (!(options.options & OPT_TO) || (options.toX2 < 0)) { - options.toX2 = options.toX + imageWidth; - options.toY2 = options.toY + imageHeight; - } - if (imageWidth > options.toX2 - options.toX) { - imageWidth = options.toX2 - options.toX; - } - if (imageHeight > options.toY2 - options.toY) { - imageHeight = options.toY2 - options.toY; - } - format = options.format; - data = objv[2]; - if (oldformat) { - if (format) { - format = (Tcl_Obj *) Tcl_GetString(format); - } - data = (Tcl_Obj *) Tcl_GetString(data); - } - if (imageFormat->stringReadProc(interp, data, format, - (Tk_PhotoHandle) masterPtr, options.toX, options.toY, - imageWidth, imageHeight, 0, 0) != TCL_OK) { - return TCL_ERROR; - } - masterPtr->flags |= IMAGE_CHANGED; - return TCL_OK; - } - if (options.options & OPT_FORMAT) { - return TCL_ERROR; - } - Tcl_ResetResult(interp); - if (Tcl_ListObjGetElements(interp, options.name, - &dataHeight, &srcObjv) != TCL_OK) { + /* + * See if there's a format that can read the data + */ + + if (MatchStringFormat(interp, objv[2], options.format, &imageFormat, + &imageWidth, &imageHeight, &oldformat) != TCL_OK) { return TCL_ERROR; } - tkwin = Tk_MainWindow(interp); - block.pixelPtr = NULL; - dataWidth = 0; - pixelPtr = NULL; - for (y = 0; y < dataHeight; ++y) { - if (Tcl_ListObjGetElements(interp, srcObjv[y], - &listObjc, &listObjv) != TCL_OK) { - break; - } - if (y == 0) { - if (listObjc == 0) { - /* - * Lines must be non-empty... - */ - - break; - } - dataWidth = listObjc; - /* - * Memory allocation overflow protection. - * May not be able to trigger/ demo / test this. - */ - - if (dataWidth > (int)((UINT_MAX/3) / dataHeight)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "photo image dimensions exceed Tcl memory limits", -1)); - Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", - "OVERFLOW", NULL); - break; - } - - pixelPtr = ckalloc(dataWidth * dataHeight * 3); - block.pixelPtr = pixelPtr; - } else if (listObjc != dataWidth) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "all elements of color list must have the same" - " number of elements", -1)); - Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", - "NON_RECTANGULAR", NULL); - break; - } - - for (x = 0; x < dataWidth; ++x) { - const char *colorString = Tcl_GetString(listObjv[x]); - XColor color; - int tmpr, tmpg, tmpb; - - /* - * We do not use Tk_GetColorFromObj() because we absolutely do - * not want to invoke the fallback code. - */ - - if (colorString[0] == '#') { - if (isxdigit(UCHAR(colorString[1])) && - isxdigit(UCHAR(colorString[2])) && - isxdigit(UCHAR(colorString[3]))) { - if (colorString[4] == '\0') { - /* Got #rgb */ - sscanf(colorString+1, "%1x%1x%1x", - &tmpr, &tmpg, &tmpb); - *pixelPtr++ = tmpr * 0x11; - *pixelPtr++ = tmpg * 0x11; - *pixelPtr++ = tmpb * 0x11; - continue; - } else if (isxdigit(UCHAR(colorString[4])) && - isxdigit(UCHAR(colorString[5])) && - isxdigit(UCHAR(colorString[6])) && - colorString[7] == '\0') { - /* Got #rrggbb */ - sscanf(colorString+1, "%2x%2x%2x", - &tmpr, &tmpg, &tmpb); - *pixelPtr++ = tmpr; - *pixelPtr++ = tmpg; - *pixelPtr++ = tmpb; - continue; - } - } - } - - if (!TkParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), - colorString, &color)) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't parse color \"%s\"", colorString)); - Tcl_SetErrorCode(interp, "TK", "VALUE", "COLOR", NULL); - break; - } - *pixelPtr++ = color.red >> 8; - *pixelPtr++ = color.green >> 8; - *pixelPtr++ = color.blue >> 8; - } - if (x < dataWidth) { - break; - } + if (!(options.options & OPT_TO) || (options.toX2 < 0)) { + options.toX2 = options.toX + imageWidth; + options.toY2 = options.toY + imageHeight; } - if (y < dataHeight || dataHeight == 0 || dataWidth == 0) { - if (block.pixelPtr != NULL) { - ckfree(block.pixelPtr); - } - if (y < dataHeight) { - return TCL_ERROR; + if (imageWidth > options.toX2 - options.toX) { + imageWidth = options.toX2 - options.toX; + } + if (imageHeight > options.toY2 - options.toY) { + imageHeight = options.toY2 - options.toY; + } + format = options.format; + data = objv[2]; + if (oldformat) { + if (format) { + format = (Tcl_Obj *) Tcl_GetString(format); } - return TCL_OK; + data = (Tcl_Obj *) Tcl_GetString(data); } + if (imageFormat->stringReadProc(interp, data, format, + (Tk_PhotoHandle) masterPtr, options.toX, options.toY, + options.toX2 - options.toX, + options.toY2 - options.toY, 0, 0) != TCL_OK) { + return TCL_ERROR; + } /* - * Fill in default values for the -to option, then copy the block in - * using Tk_PhotoPutBlock. + * SB: is the next line really needed? The stringReadProc + * writes image data with Tk_PhotoPutBlock(), which in turn + * takes care to notify the changed image and to set/unset the + * IMAGE_CHANGED bit. */ - - if (!(options.options & OPT_TO) || (options.toX2 < 0)) { - options.toX2 = options.toX + dataWidth; - options.toY2 = options.toY + dataHeight; - } - block.width = dataWidth; - block.height = dataHeight; - block.pitch = dataWidth * 3; - block.pixelSize = 3; - block.offset[0] = 0; - block.offset[1] = 1; - block.offset[2] = 2; - block.offset[3] = 0; - result = Tk_PhotoPutBlock(interp, masterPtr, &block, - options.toX, options.toY, options.toX2 - options.toX, - options.toY2 - options.toY, - TK_PHOTO_COMPOSITE_SET); - ckfree(block.pixelPtr); - return result; - + masterPtr->flags |= IMAGE_CHANGED; + + return TCL_OK; + } case PHOTO_READ: { Tcl_Obj *format; @@ -1174,17 +1083,40 @@ ImgPhotoCmd( switch ((enum transOptions) index) { case PHOTO_TRANS_GET: { - XRectangle testBox; - TkRegion testRegion; + int boolMode; - if (objc != 5) { - Tcl_WrongNumArgs(interp, 3, objv, "x y"); + /* + * parse fixed args and option + */ + + if (objc > 6 || objc < 5) { + Tcl_WrongNumArgs(interp, 3, objv, "x y ?-option?"); return TCL_ERROR; } if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) { return TCL_ERROR; } + + index = 4; + memset(&options, 0, sizeof(options)); + if (ParseSubcommandOptions(&options, interp, + OPT_ALPHA, &index, objc, objv) != TCL_OK) { + return TCL_ERROR; + } + if (index < objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be -alpha", + Tcl_GetString(objv[index]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", + NULL); + return TCL_ERROR; + } + boolMode = 1; + if (options.options & OPT_ALPHA) { + boolMode = 0; + } + if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1195,36 +1127,55 @@ ImgPhotoCmd( return TCL_ERROR; } - testBox.x = x; - testBox.y = y; - testBox.width = 1; - testBox.height = 1; - /* What a way to do a test! */ - testRegion = TkCreateRegion(); - TkUnionRectWithRegion(&testBox, testRegion, testRegion); - TkIntersectRegion(testRegion, masterPtr->validRegion, testRegion); - TkClipBox(testRegion, &testBox); - TkDestroyRegion(testRegion); - - Tcl_SetObjResult(interp, Tcl_NewBooleanObj( - testBox.width==0 && testBox.height==0)); + /* + * Extract and return the desired value + */ + pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4; + if (boolMode) { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj( ! pixelPtr[3])); + } else { + Tcl_SetObjResult(interp, Tcl_NewIntObj(pixelPtr[3])); + } return TCL_OK; } case PHOTO_TRANS_SET: { - int transFlag; + int newVal, boolMode; XRectangle setBox; + TkRegion modRegion; - if (objc != 6) { - Tcl_WrongNumArgs(interp, 3, objv, "x y boolean"); + /* + * Parse args and option, check for valid values + */ + + if (objc < 6 || objc > 7) { + Tcl_WrongNumArgs(interp, 3, objv, "x y newVal ?-option?"); return TCL_ERROR; } if ((Tcl_GetIntFromObj(interp, objv[3], &x) != TCL_OK) - || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK) - || (Tcl_GetBooleanFromObj(interp, objv[5], - &transFlag) != TCL_OK)) { + || (Tcl_GetIntFromObj(interp, objv[4], &y) != TCL_OK)) { return TCL_ERROR; } + + index = 5; + memset(&options, 0, sizeof(options)); + if (ParseSubcommandOptions(&options, interp, + OPT_ALPHA, &index, objc, objv) != TCL_OK) { + return TCL_ERROR; + } + if (index < objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unknown option \"%s\": must be -alpha", + Tcl_GetString(objv[index]))); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "BAD_OPTION", + NULL); + return TCL_ERROR; + } + boolMode = 1; + if (options.options & OPT_ALPHA) { + boolMode = 0; + } + if ((x < 0) || (x >= masterPtr->width) || (y < 0) || (y >= masterPtr->height)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -1235,38 +1186,53 @@ ImgPhotoCmd( return TCL_ERROR; } + if (boolMode) { + if (Tcl_GetBooleanFromObj(interp, objv[5], &newVal) != TCL_OK) { + return TCL_ERROR; + } + } else { + if (Tcl_GetIntFromObj(interp, objv[5], &newVal) != TCL_OK) { + return TCL_ERROR; + } + if (newVal < 0 || newVal > 255) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "invalid alpha value \"%d\": " + "must be integer between 0 and 255", newVal)); + Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", + "BAD_VALUE", NULL); + return TCL_ERROR; + } + } + + /* + * Set new alpha value for the pixel + */ + + pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4; + if (boolMode) { + pixelPtr[3] = newVal ? 0 : 255; + } else { + pixelPtr[3] = newVal; + } + + /* + * Update the validRegion of the image + */ + setBox.x = x; setBox.y = y; setBox.width = 1; setBox.height = 1; - pixelPtr = masterPtr->pix32 + (y * masterPtr->width + x) * 4; - - if (transFlag) { - /* - * Make pixel transparent. - */ - - TkRegion clearRegion = TkCreateRegion(); - - TkUnionRectWithRegion(&setBox, clearRegion, clearRegion); - TkSubtractRegion(masterPtr->validRegion, clearRegion, + modRegion = TkCreateRegion(); + TkUnionRectWithRegion(&setBox, modRegion, modRegion); + if (pixelPtr[3]) { + TkUnionRectWithRegion(&setBox, masterPtr->validRegion, masterPtr->validRegion); - TkDestroyRegion(clearRegion); - - /* - * Set the alpha value correctly. - */ - - pixelPtr[3] = 0; } else { - /* - * Make pixel opaque. - */ - - TkUnionRectWithRegion(&setBox, masterPtr->validRegion, + TkSubtractRegion(masterPtr->validRegion, modRegion, masterPtr->validRegion); - pixelPtr[3] = 255; } + TkDestroyRegion(modRegion); /* * Inform the generic image code that the image @@ -1468,13 +1434,18 @@ GetExtension( * * This function is invoked to process one of the options which may be * specified for the photo image subcommands, namely, -from, -to, -zoom, - * -subsample, -format, -shrink, and -compositingrule. + * -subsample, -format, -shrink, -compositingrule, -alpha, -boolean and + * -withalpha. + * Parsing starts at the index in *optIndexPtr and stops at the end of + * objv[] or at the first value that does not belong to an option. * * Results: * A standard Tcl result. * * Side effects: - * Fields in *optPtr get filled in. + * Fields in *optPtr get filled in. The value of optIndexPtr is updated + * to contain the index of the first element in argv[] that was not + * parsed, or argc if the end of objv[] was reached. * *---------------------------------------------------------------------- */ @@ -1599,7 +1570,8 @@ ParseSubcommandOptions( return TCL_ERROR; } *optIndexPtr = index; - } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) { + } else if (bit == OPT_TO || bit == OPT_FROM + || bit == OPT_SUBSAMPLE || bit == OPT_ZOOM) { const char *val; maxValues = ((bit == OPT_FROM) || (bit == OPT_TO)) ? 4 : 2; @@ -2555,7 +2527,7 @@ MatchStringFormat( int *oldformat) /* Returns 1 if the old image API is used. */ { int matched = 0, useoldformat = 0; - Tk_PhotoImageFormat *formatPtr; + Tk_PhotoImageFormat *formatPtr, *defaultFormatPtr = NULL; ThreadSpecificData *tsdPtr = Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); const char *formatString = NULL; @@ -2571,6 +2543,16 @@ MatchStringFormat( for (formatPtr = tsdPtr->formatList; formatPtr != NULL; formatPtr = formatPtr->nextPtr) { + /* + * To keep the behaviour of older versions (Tk <= 8.6), the default + * list-of-lists string format is checked last. Remember its position. + */ + + if (strncasecmp("default", formatPtr->name, strlen(formatPtr->name)) + == 0) { + defaultFormatPtr = formatPtr; + } + if (formatObj != NULL) { if (strncasecmp(formatString, formatPtr->name, strlen(formatPtr->name)) != 0) { @@ -2586,6 +2568,16 @@ MatchStringFormat( return TCL_ERROR; } } + + /* + * If this is the default format, and it was not passed as -format + * option, skip the stringMatchProc test. It'll be done later + */ + + if (formatObj == NULL && formatPtr == defaultFormatPtr) { + continue; + } + if ((formatPtr->stringMatchProc != NULL) && (formatPtr->stringReadProc != NULL) && formatPtr->stringMatchProc(data, formatObj, @@ -2623,23 +2615,46 @@ MatchStringFormat( } } } + if (formatPtr == NULL) { - if ((formatObj != NULL) && !matched) { + /* + * Try the default format as last resort (only if no -format option + * was passed). + */ + + if ( formatObj == NULL && defaultFormatPtr == NULL) { + Tcl_Panic("default image format handler not registered"); + } + if ( formatObj == NULL + && defaultFormatPtr->stringMatchProc != NULL + && defaultFormatPtr->stringReadProc != NULL + && defaultFormatPtr->stringMatchProc(data, formatObj, + widthPtr, heightPtr, interp) != 0) { + useoldformat = 0; + formatPtr = defaultFormatPtr; + } else if ((formatObj != NULL) && !matched) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "image format \"%s\" is not supported", formatString)); Tcl_SetErrorCode(interp, "TK", "LOOKUP", "PHOTO_FORMAT", formatString, NULL); + return TCL_ERROR; } else { Tcl_SetObjResult(interp, Tcl_NewStringObj( "couldn't recognize image data", -1)); Tcl_SetErrorCode(interp, "TK", "IMAGE", "PHOTO", "UNRECOGNIZED_DATA", NULL); + return TCL_ERROR; } - return TCL_ERROR; } *imageFormatPtr = formatPtr; *oldformat = useoldformat; + + /* + * Some stringMatchProc might have left error messages and error codes in + * interp. Clear them before return. + */ + Tcl_ResetResult(interp); return TCL_OK; } @@ -3931,57 +3946,6 @@ ImgGetPhoto( /* *---------------------------------------------------------------------- * - * ImgStringWrite -- - * - * Default string write function. The data is formatted in the default - * format as accepted by the "<img> put" command. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * See the user documentation. - * - *---------------------------------------------------------------------- - */ - -static int -ImgStringWrite( - Tcl_Interp *interp, - Tcl_Obj *formatString, - Tk_PhotoImageBlock *blockPtr) -{ - int greenOffset, blueOffset; - Tcl_Obj *data; - - greenOffset = blockPtr->offset[1] - blockPtr->offset[0]; - blueOffset = blockPtr->offset[2] - blockPtr->offset[0]; - - data = Tcl_NewObj(); - if ((blockPtr->width > 0) && (blockPtr->height > 0)) { - int row, col; - - for (row=0; row<blockPtr->height; row++) { - Tcl_Obj *line = Tcl_NewObj(); - unsigned char *pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] - + row * blockPtr->pitch; - - for (col=0; col<blockPtr->width; col++) { - Tcl_AppendPrintfToObj(line, "%s#%02x%02x%02x", - col ? " " : "", *pixelPtr, - pixelPtr[greenOffset], pixelPtr[blueOffset]); - pixelPtr += blockPtr->pixelSize; - } - Tcl_ListObjAppendElement(NULL, data, line); - } - } - Tcl_SetObjResult(interp, data); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * Tk_PhotoGetImage -- * * This function is called to obtain image data from a photo image. This @@ -4024,7 +3988,7 @@ Tk_PhotoGetImage( /* *-------------------------------------------------------------- * - * TkPostscriptPhoto -- + * ImgPostscriptPhoto -- * * This function is called to output the contents of a photo image in * Postscript by calling the Tk_PostscriptPhoto function. @@ -4069,7 +4033,7 @@ ImgPhotoPostscript( * *---------------------------------------------------------------------- */ - +#ifndef TK_NO_DEPRECATED void Tk_PhotoPutBlock_NoComposite( Tk_PhotoHandle handle, @@ -4155,11 +4119,13 @@ Tk_PhotoSetSize_Panic( Tcl_Panic(TK_PHOTO_ALLOC_FAILURE_MESSAGE); } } +#endif /* TK_NO_DEPRECATED */ /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 + * tab-width: 8 * End: */ diff --git a/generic/tkImgPhoto.h b/generic/tkImgPhoto.h index 36bc6cb..45fac88 100644 --- a/generic/tkImgPhoto.h +++ b/generic/tkImgPhoto.h @@ -201,7 +201,7 @@ struct PhotoInstance { * this particular colormap. */ PhotoInstance *nextPtr; /* Pointer to the next instance in the list of * instances associated with this master. */ - int refCount; /* Number of instances using this structure. */ + size_t refCount; /* Number of instances using this structure. */ Tk_Uid palette; /* Palette for these particular instances. */ double gamma; /* Gamma value for these instances. */ Tk_Uid defaultPalette; /* Default palette to use if a palette is not diff --git a/generic/tkInt.decls b/generic/tkInt.decls index a13d8d7..c8f5775 100644 --- a/generic/tkInt.decls +++ b/generic/tkInt.decls @@ -634,6 +634,13 @@ declare 184 { Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle) } + +# Debugging / testing functions for photo images +declare 185 { + int TkDebugPhotoStringMatchDef(Tcl_Interp *inter, Tcl_Obj *data, + Tcl_Obj *formatString, int *widthPtr, int *heightPtr) +} + ############################################################################## diff --git a/generic/tkInt.h b/generic/tkInt.h index a28cae4..ed22fc3 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -478,7 +478,7 @@ typedef struct TkDisplay { #endif /* TK_USE_INPUT_METHODS */ Tcl_HashTable winTable; /* Maps from X window ids to TkWindow ptrs. */ - int refCount; /* Reference count of how many Tk applications + size_t refCount; /* Reference count of how many Tk applications * are using this display. Used to clean up * the display when we no longer have any Tk * applications using it. */ @@ -582,7 +582,7 @@ typedef struct TkEventHandler { */ typedef struct TkMainInfo { - int refCount; /* Number of windows whose "mainPtr" fields + size_t refCount; /* Number of windows whose "mainPtr" fields * point here. When this becomes zero, can * free up the structure (the reference count * is zero because windows can get deleted in @@ -945,6 +945,7 @@ MODULE_SCOPE const Tk_SmoothMethod tkBezierSmoothMethod; MODULE_SCOPE Tk_ImageType tkBitmapImageType; MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtGIF; MODULE_SCOPE void (*tkHandleEventProc) (XEvent* eventPtr); +MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtDefault; MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPNG; MODULE_SCOPE Tk_PhotoImageFormat tkImgFmtPPM; MODULE_SCOPE TkMainInfo *tkMainWindowList; diff --git a/generic/tkIntDecls.h b/generic/tkIntDecls.h index b8addbd..0ffe157 100644 --- a/generic/tkIntDecls.h +++ b/generic/tkIntDecls.h @@ -550,6 +550,10 @@ EXTERN void TkDrawAngledChars(Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle); +/* 185 */ +EXTERN int TkDebugPhotoStringMatchDef(Tcl_Interp *inter, + Tcl_Obj *data, Tcl_Obj *formatString, + int *widthPtr, int *heightPtr); typedef struct TkIntStubs { int magic; @@ -767,6 +771,7 @@ typedef struct TkIntStubs { void (*tkUnderlineAngledTextLayout) (Display *display, Drawable drawable, GC gc, Tk_TextLayout layout, int x, int y, double angle, int underline); /* 182 */ int (*tkIntersectAngledTextLayout) (Tk_TextLayout layout, int x, int y, int width, int height, double angle); /* 183 */ void (*tkDrawAngledChars) (Display *display, Drawable drawable, GC gc, Tk_Font tkfont, const char *source, int numBytes, double x, double y, double angle); /* 184 */ + int (*tkDebugPhotoStringMatchDef) (Tcl_Interp *inter, Tcl_Obj *data, Tcl_Obj *formatString, int *widthPtr, int *heightPtr); /* 185 */ } TkIntStubs; extern const TkIntStubs *tkIntStubsPtr; @@ -1139,6 +1144,8 @@ extern const TkIntStubs *tkIntStubsPtr; (tkIntStubsPtr->tkIntersectAngledTextLayout) /* 183 */ #define TkDrawAngledChars \ (tkIntStubsPtr->tkDrawAngledChars) /* 184 */ +#define TkDebugPhotoStringMatchDef \ + (tkIntStubsPtr->tkDebugPhotoStringMatchDef) /* 185 */ #endif /* defined(USE_TK_STUBS) */ diff --git a/generic/tkIntXlibDecls.h b/generic/tkIntXlibDecls.h index de44068..67b7c39 100644 --- a/generic/tkIntXlibDecls.h +++ b/generic/tkIntXlibDecls.h @@ -23,6 +23,10 @@ # include <tcl.h> #endif +#ifndef EXTERN +# define EXTERN extern TCL_STORAGE_CLASS +#endif + /* Some (older) versions of X11/Xutil.h have a wrong signature of those two functions, so move them out of the way temporarly. */ #define XOffsetRegion _XOffsetRegion @@ -32,8 +36,12 @@ #undef XUnionRegion #ifdef BUILD_tk -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT +# undef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLEXPORT +#else +# ifndef TCL_STORAGE_CLASS +# define TCL_STORAGE_CLASS DLLIMPORT +# endif #endif typedef int (*XAfterFunction) ( /* WARNING, this type not in Xlib spec */ diff --git a/generic/tkMain.c b/generic/tkMain.c index 1b21223..87a3cf7 100644 --- a/generic/tkMain.c +++ b/generic/tkMain.c @@ -196,7 +196,7 @@ Tk_MainEx( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { abort(); } else { diff --git a/generic/tkMenu.c b/generic/tkMenu.c index d24516f..7f5389c 100644 --- a/generic/tkMenu.c +++ b/generic/tkMenu.c @@ -38,7 +38,7 @@ * implemented using menu clones. Menu clones are full menus in their own * right; they have a Tk window and pathname associated with them; they have a * TkMenu structure and array of entries. However, they are linked with the - * original menu that they were cloned from. The reflect the attributes of the + * original menu that they were cloned from. They reflect the attributes of the * original, or "master", menu. So if an item is added to a menu, and that * menu has clones, then the item must be added to all of its clones also. * Menus are cloned when a menu is torn-off or when a menu is assigned as a diff --git a/generic/tkObj.c b/generic/tkObj.c index 7c09656..90fedbc 100644 --- a/generic/tkObj.c +++ b/generic/tkObj.c @@ -153,8 +153,19 @@ GetTypeCache(void) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); if (tsdPtr->doubleTypePtr == NULL) { - tsdPtr->doubleTypePtr = Tcl_GetObjType("double"); - tsdPtr->intTypePtr = Tcl_GetObjType("int"); + /* Smart initialization of doubleTypePtr/intTypePtr without + * hash-table lookup or creating complete Tcl_Obj's */ + Tcl_Obj obj; + obj.length = 3; + obj.bytes = (char *)"0.0"; + obj.typePtr = NULL; + Tcl_GetDoubleFromObj(NULL, &obj, &obj.internalRep.doubleValue); + tsdPtr->doubleTypePtr = obj.typePtr; + obj.bytes += 2; + obj.length = 1; + obj.typePtr = NULL; + Tcl_GetLongFromObj(NULL, &obj, &obj.internalRep.longValue); + tsdPtr->intTypePtr = obj.typePtr; } return tsdPtr; } diff --git a/generic/tkPack.c b/generic/tkPack.c index 88a4b2d..8257b43 100644 --- a/generic/tkPack.c +++ b/generic/tkPack.c @@ -122,8 +122,10 @@ static int ConfigureSlaves(Tcl_Interp *interp, Tk_Window tkwin, int objc, Tcl_Obj *const objv[]); static void DestroyPacker(void *memPtr); static Packer * GetPacker(Tk_Window tkwin); +#ifndef TK_NO_DEPRECATED static int PackAfter(Tcl_Interp *interp, Packer *prevPtr, Packer *masterPtr, int objc,Tcl_Obj *const objv[]); +#endif /* !TK_NO_DEPRECATED */ static void PackStructureProc(ClientData clientData, XEvent *eventPtr); static void Unlink(Packer *packPtr); @@ -197,11 +199,14 @@ Tk_PackObjCmd( Tk_Window tkwin = clientData; const char *argv2; static const char *const optionStrings[] = { - /* after, append, before and unpack are deprecated */ +#ifndef TK_NO_DEPRECATED "after", "append", "before", "unpack", +#endif /* !TK_NO_DEPRECATED */ "configure", "forget", "info", "propagate", "slaves", NULL }; enum options { +#ifndef TK_NO_DEPRECATED PACK_AFTER, PACK_APPEND, PACK_BEFORE, PACK_UNPACK, +#endif /* !TK_NO_DEPRECATED */ PACK_CONFIGURE, PACK_FORGET, PACK_INFO, PACK_PROPAGATE, PACK_SLAVES }; int index; @@ -219,6 +224,7 @@ Tk_PackObjCmd( if (Tcl_GetIndexFromObjStruct(interp, objv[1], optionStrings, sizeof(char *), "option", 0, &index) != TCL_OK) { +#ifndef TK_NO_DEPRECATED /* * Call it again without the deprecated ones to get a proper error * message. This works well since there can't be any ambiguity between @@ -228,11 +234,13 @@ Tk_PackObjCmd( Tcl_ResetResult(interp); Tcl_GetIndexFromObjStruct(interp, objv[1], &optionStrings[4], sizeof(char *), "option", 0, &index); +#endif /* TK_NO_DEPRECATED */ return TCL_ERROR; } argv2 = Tcl_GetString(objv[2]); switch ((enum options) index) { +#ifndef TK_NO_DEPRECATED case PACK_AFTER: { Packer *prevPtr; Tk_Window tkwin2; @@ -297,6 +305,7 @@ Tk_PackObjCmd( } return PackAfter(interp, prevPtr, masterPtr, objc-3, objv+3); } +#endif /* !TK_NO_DEPRECATED */ case PACK_CONFIGURE: if (argv2[0] != '.') { Tcl_SetObjResult(interp, Tcl_ObjPrintf( @@ -458,6 +467,7 @@ Tk_PackObjCmd( Tcl_SetObjResult(interp, resultObj); break; } +#ifndef TK_NO_DEPRECATED case PACK_UNPACK: { Tk_Window tkwin2; Packer *packPtr; @@ -481,6 +491,7 @@ Tk_PackObjCmd( } break; } +#endif /* !TK_NO_DEPRECATED */ } return TCL_OK; @@ -1087,6 +1098,7 @@ GetPacker( *------------------------------------------------------------------------ */ +#ifndef TK_NO_DEPRECATED static int PackAfter( Tcl_Interp *interp, /* Interpreter for error reporting. */ @@ -1307,6 +1319,7 @@ PackAfter( } return TCL_OK; } +#endif /* !TK_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/generic/tkPanedWindow.c b/generic/tkPanedWindow.c index 17e2b4a..e1a7d97 100644 --- a/generic/tkPanedWindow.c +++ b/generic/tkPanedWindow.c @@ -1484,10 +1484,10 @@ DisplayPanedWindow( */ if (horizontal) { - sashHeight = Tk_Height(tkwin) - (2 * Tk_InternalBorderWidth(tkwin)); + sashHeight = Tk_Height(tkwin) - (2 * Tk_InternalBorderLeft(tkwin)); sashWidth = pwPtr->sashWidth; } else { - sashWidth = Tk_Width(tkwin) - (2 * Tk_InternalBorderWidth(tkwin)); + sashWidth = Tk_Width(tkwin) - (2 * Tk_InternalBorderLeft(tkwin)); sashHeight = pwPtr->sashWidth; } @@ -1754,7 +1754,7 @@ ArrangePanes( */ paneDynSize = paneDynMinSize = 0; - internalBW = Tk_InternalBorderWidth(pwPtr->tkwin); + internalBW = Tk_InternalBorderLeft(pwPtr->tkwin); pwHeight = Tk_Height(pwPtr->tkwin) - (2 * internalBW); pwWidth = Tk_Width(pwPtr->tkwin) - (2 * internalBW); x = y = internalBW; @@ -2200,7 +2200,7 @@ ComputeGeometry( pwPtr->flags |= REQUESTED_RELAYOUT; - x = y = internalBw = Tk_InternalBorderWidth(pwPtr->tkwin); + x = y = internalBw = Tk_InternalBorderLeft(pwPtr->tkwin); reqWidth = reqHeight = 0; /* @@ -2906,7 +2906,7 @@ PanedWindowProxyCommand( return TCL_ERROR; } - internalBW = Tk_InternalBorderWidth(pwPtr->tkwin); + internalBW = Tk_InternalBorderLeft(pwPtr->tkwin); if (pwPtr->orient == ORIENT_HORIZONTAL) { if (x < 0) { x = 0; @@ -2915,10 +2915,10 @@ PanedWindowProxyCommand( if (x > pwWidth) { x = pwWidth; } - y = Tk_InternalBorderWidth(pwPtr->tkwin); + y = Tk_InternalBorderLeft(pwPtr->tkwin); sashWidth = pwPtr->sashWidth; sashHeight = Tk_Height(pwPtr->tkwin) - - (2 * Tk_InternalBorderWidth(pwPtr->tkwin)); + (2 * Tk_InternalBorderLeft(pwPtr->tkwin)); } else { if (y < 0) { y = 0; @@ -2927,10 +2927,10 @@ PanedWindowProxyCommand( if (y > pwHeight) { y = pwHeight; } - x = Tk_InternalBorderWidth(pwPtr->tkwin); + x = Tk_InternalBorderLeft(pwPtr->tkwin); sashHeight = pwPtr->sashWidth; sashWidth = Tk_Width(pwPtr->tkwin) - - (2 * Tk_InternalBorderWidth(pwPtr->tkwin)); + (2 * Tk_InternalBorderLeft(pwPtr->tkwin)); } if (sashWidth < 1) { @@ -3069,7 +3069,7 @@ PanedWindowIdentifyCoords( } else { sashHeight = Tk_ReqHeight(pwPtr->tkwin); } - sashHeight -= 2 * Tk_InternalBorderWidth(pwPtr->tkwin); + sashHeight -= 2 * Tk_InternalBorderLeft(pwPtr->tkwin); if (pwPtr->showHandle && pwPtr->handleSize > pwPtr->sashWidth) { sashWidth = pwPtr->handleSize; lpad = (pwPtr->handleSize - pwPtr->sashWidth) / 2; @@ -3097,7 +3097,7 @@ PanedWindowIdentifyCoords( } else { sashWidth = Tk_ReqWidth(pwPtr->tkwin); } - sashWidth -= 2 * Tk_InternalBorderWidth(pwPtr->tkwin); + sashWidth -= 2 * Tk_InternalBorderLeft(pwPtr->tkwin); lpad = rpad = 0; } diff --git a/generic/tkScrollbar.c b/generic/tkScrollbar.c index 5017d30..9c1ceb8 100644 --- a/generic/tkScrollbar.c +++ b/generic/tkScrollbar.c @@ -179,10 +179,12 @@ Tk_ScrollbarObjCmd( scrollPtr->sliderLast = 0; scrollPtr->activeField = 0; scrollPtr->activeRelief = TK_RELIEF_RAISED; +#ifndef TK_NO_DEPRECATED scrollPtr->totalUnits = 0; scrollPtr->windowUnits = 0; scrollPtr->firstUnit = 0; scrollPtr->lastUnit = 0; +#endif /* TK_NO_DEPRECATED */ scrollPtr->firstFraction = 0.0; scrollPtr->lastFraction = 0.0; scrollPtr->cursor = None; @@ -377,10 +379,13 @@ ScrollbarWidgetObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "get"); goto error; } +#ifndef TK_NO_DEPRECATED if (scrollPtr->flags & NEW_STYLE_COMMANDS) { +#endif /* TK_NO_DEPRECATED */ resObjs[0] = Tcl_NewDoubleObj(scrollPtr->firstFraction); resObjs[1] = Tcl_NewDoubleObj(scrollPtr->lastFraction); Tcl_SetObjResult(interp, Tcl_NewListObj(2, resObjs)); +#ifndef TK_NO_DEPRECATED } else { resObjs[0] = Tcl_NewIntObj(scrollPtr->totalUnits); resObjs[1] = Tcl_NewIntObj(scrollPtr->windowUnits); @@ -388,6 +393,7 @@ ScrollbarWidgetObjCmd( resObjs[3] = Tcl_NewIntObj(scrollPtr->lastUnit); Tcl_SetObjResult(interp, Tcl_NewListObj(4, resObjs)); } +#endif /* TK_NO_DEPRECATED */ break; } case COMMAND_IDENTIFY: { @@ -413,8 +419,6 @@ ScrollbarWidgetObjCmd( break; } case COMMAND_SET: { - int totalUnits, windowUnits, firstUnit, lastUnit; - if (objc == 4) { double first, last; @@ -438,8 +442,10 @@ ScrollbarWidgetObjCmd( } else { scrollPtr->lastFraction = last; } +#ifndef TK_NO_DEPRECATED scrollPtr->flags |= NEW_STYLE_COMMANDS; } else if (objc == 6) { + int totalUnits, windowUnits, firstUnit, lastUnit; if (Tcl_GetIntFromObj(interp, objv[2], &totalUnits) != TCL_OK) { goto error; } @@ -477,10 +483,9 @@ ScrollbarWidgetObjCmd( scrollPtr->lastFraction = ((double) (lastUnit+1))/totalUnits; } scrollPtr->flags &= ~NEW_STYLE_COMMANDS; +#endif /* !TK_NO_DEPRECATED */ } else { Tcl_WrongNumArgs(interp, 1, objv, "set firstFraction lastFraction"); - Tcl_AppendResult(interp, " or \"", Tcl_GetString(objv[0]), - " set totalUnits windowUnits firstUnit lastUnit\"", NULL); goto error; } TkpComputeScrollbarGeometry(scrollPtr); diff --git a/generic/tkScrollbar.h b/generic/tkScrollbar.h index b0cd085..66b12b8 100644 --- a/generic/tkScrollbar.h +++ b/generic/tkScrollbar.h @@ -96,6 +96,7 @@ typedef struct TkScrollbar { * the NEW_STYLE_COMMANDS flag is 0. */ +#ifndef TK_NO_DEPRECATED int totalUnits; /* Total dimension of application, in units. * Valid only if the NEW_STYLE_COMMANDS flag * isn't set. */ @@ -108,6 +109,9 @@ typedef struct TkScrollbar { int lastUnit; /* Index of last unit visible in window. * Valid only if the NEW_STYLE_COMMANDS flag * isn't set. */ +#else + int dummy1,dummy2,dummy3,dummy4; /* sizeof(TkScrollbar) should not depend on TK_NO_DEPRECATED */ +#endif /* TK_NO_DEPRECATED */ double firstFraction; /* Position of first visible thing in window, * specified as a fraction between 0 and * 1.0. */ @@ -153,7 +157,9 @@ typedef struct TkScrollbar { */ #define REDRAW_PENDING 1 +#ifndef TK_NO_DEPRECATED #define NEW_STYLE_COMMANDS 2 +#endif /* TK_NO_DEPRECATED */ #define GOT_FOCUS 4 /* diff --git a/generic/tkSelect.c b/generic/tkSelect.c index d763411..4c3bbfd 100644 --- a/generic/tkSelect.c +++ b/generic/tkSelect.c @@ -26,7 +26,7 @@ typedef struct { int charOffset; /* The offset of the next char to retrieve. */ int byteOffset; /* The expected byte offset of the next * chunk. */ - char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character + char buffer[4]; /* A buffer to hold part of a UTF character * that is split across chunks. */ char command[1]; /* Command to invoke. Actual space is * allocated as large as necessary. This must diff --git a/generic/tkStubInit.c b/generic/tkStubInit.c index 9411c26..a491622 100644 --- a/generic/tkStubInit.c +++ b/generic/tkStubInit.c @@ -38,6 +38,26 @@ MODULE_SCOPE const TkStubs tkStubs; */ #undef Tk_MainEx +#undef Tk_FreeXId + + +#ifdef TK_NO_DEPRECATED +#define Tk_FreeXId 0 +#define Tk_PhotoPutBlock_NoComposite 0 +#define Tk_PhotoPutZoomedBlock_NoComposite 0 +#define Tk_PhotoExpand_Panic 0 +#define Tk_PhotoPutBlock_Panic 0 +#define Tk_PhotoPutZoomedBlock_Panic 0 +#define Tk_PhotoSetSize_Panic 0 +#else +static void +doNothing(void) +{ + /* dummy implementation, no need to do anything */ +} + +#define Tk_FreeXId ((void (*)(Display *, XID)) doNothing) +#endif #ifdef _WIN32 @@ -453,6 +473,7 @@ static const TkIntStubs tkIntStubs = { TkUnderlineAngledTextLayout, /* 182 */ TkIntersectAngledTextLayout, /* 183 */ TkDrawAngledChars, /* 184 */ + TkDebugPhotoStringMatchDef, /* 185 */ }; static const TkIntPlatStubs tkIntPlatStubs = { diff --git a/generic/tkTest.c b/generic/tkTest.c index fa9e073..483fc0d 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -192,6 +192,9 @@ static void CustomOptionFree(ClientData clientData, static int TestpropObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]); +static int TestprintfObjCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); #if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) static int TestwrapperObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, @@ -203,6 +206,9 @@ static int TrivialConfigObjCmd(ClientData dummy, Tcl_Obj * const objv[]); static void TrivialEventProc(ClientData clientData, XEvent *eventPtr); +static int TestPhotoStringMatchCmd(ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj * const objv[]); /* *---------------------------------------------------------------------- @@ -227,7 +233,7 @@ Tktest_Init( { static int initialized = 0; - if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) { @@ -239,7 +245,7 @@ Tktest_Init( */ if (Tcl_PkgProvideEx(interp, "Tktest", TK_PATCH_LEVEL, NULL) == TCL_ERROR) { - return TCL_ERROR; + return TCL_ERROR; } Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL); @@ -263,8 +269,12 @@ Tktest_Init( (ClientData) Tk_MainWindow(interp), NULL); Tcl_CreateObjCommand(interp, "testprop", TestpropObjCmd, (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testprintf", TestprintfObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "testtext", TkpTesttextCmd, (ClientData) Tk_MainWindow(interp), NULL); + Tcl_CreateObjCommand(interp, "testphotostringmatch", + TestPhotoStringMatchCmd, (ClientData) Tk_MainWindow(interp), + NULL); #if defined(_WIN32) || defined(MAC_OSX_TK) Tcl_CreateObjCommand(interp, "testmetrics", TestmetricsObjCmd, @@ -452,7 +462,7 @@ TestcursorObjCmd( * A standard Tcl result. * * Side effects: - * All the intepreters created by previous calls to "testnewapp" get + * All the interpreters created by previous calls to "testnewapp" get * deleted. * *---------------------------------------------------------------------- @@ -1896,6 +1906,60 @@ TestpropObjCmd( return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * TestpropObjCmd -- + * + * This function implements the "testprop" command. It fetches and prints + * the value of a property on a window. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestprintfObjCmd( + ClientData clientData, /* Not used */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ +{ + char buffer[256]; + Tcl_WideInt wideInt; +#ifdef _WIN32 + __int64 longLongInt; +#else + long long longLongInt; +#endif + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "wideint"); + return TCL_ERROR; + } + if (Tcl_GetWideIntFromObj(interp, objv[1], &wideInt) != TCL_OK) { + return TCL_ERROR; + } + longLongInt = wideInt; + + /* Just add a lot of arguments to sprintf. Reason: on AMD64, the first + * 4 or 6 arguments (we assume 8, just in case) might be put in registers, + * which still woudn't tell if the assumed size is correct: We want this + * test-case to fail if the 64-bit value is printed as truncated to 32-bit. + */ + sprintf(buffer, "%s%s%s%s%s%s%s%s%" TCL_LL_MODIFIER "d %" + TCL_LL_MODIFIER "u", "", "", "", "", "", "", "", "", + (Tcl_WideInt)longLongInt, (Tcl_WideUInt)longLongInt); + Tcl_AppendResult(interp, buffer, NULL); + return TCL_OK; +} + #if !(defined(_WIN32) || defined(MAC_OSX_TK) || defined(__CYGWIN__)) /* *---------------------------------------------------------------------- @@ -2066,6 +2130,54 @@ CustomOptionFree( ckfree(*(char **)internalPtr); } } +/* + *---------------------------------------------------------------------- + * + * TestPhotoStringMatchCmd -- + * + * This function implements the "testphotostringmatch" command. It + * provides a way from Tcl to call the string match function for the + * default image handler directly. + * + * Results: + * A standard Tcl result. If data is in the proper format, the result in + * interp will contain width and height as a list. If the data cannot be + * parsed as default image format, returns TCL_ERROR and leaves an + * appropriate error message in interp. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +static int +TestPhotoStringMatchCmd( + ClientData clientData, /* Main window for application. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ +{ + Tcl_Obj *dummy = NULL; + Tcl_Obj *resultObj[2]; + int width, height; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "imageData"); + return TCL_ERROR; + } + if (TkDebugPhotoStringMatchDef(interp, objv[1], dummy, &width, &height)) { + resultObj[0] = Tcl_NewIntObj(width); + resultObj[1] = Tcl_NewIntObj(height); + Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObj)); + return TCL_OK; + } else { + return TCL_ERROR; + } +} + + /* * Local Variables: diff --git a/generic/tkText.c b/generic/tkText.c index e0dcc50..ba1e9ab 100644 --- a/generic/tkText.c +++ b/generic/tkText.c @@ -2771,6 +2771,9 @@ TextPushUndoAction( { TkUndoSubAtom *iAtom, *dAtom; int canUndo, canRedo; + char lMarkName[20] = "tk::undoMarkL"; + char rMarkName[20] = "tk::undoMarkR"; + char stringUndoMarkId[7] = ""; /* * Create the helpers. @@ -2781,6 +2784,10 @@ TextPushUndoAction( Tcl_Obj *markSet2InsertObj = NULL; Tcl_Obj *insertCmdObj = Tcl_NewObj(); Tcl_Obj *deleteCmdObj = Tcl_NewObj(); + Tcl_Obj *markSetLUndoMarkCmdObj = Tcl_NewObj(); + Tcl_Obj *markSetRUndoMarkCmdObj = NULL; + Tcl_Obj *markGravityLUndoMarkCmdObj = Tcl_NewObj(); + Tcl_Obj *markGravityRUndoMarkCmdObj = NULL; /* * Get the index positions. @@ -2830,6 +2837,40 @@ TextPushUndoAction( Tcl_ListObjAppendElement(NULL, deleteCmdObj, index1Obj); Tcl_ListObjAppendElement(NULL, deleteCmdObj, index2Obj); + Tcl_ListObjAppendElement(NULL, markSetLUndoMarkCmdObj, + Tcl_NewStringObj(Tk_PathName(textPtr->tkwin), -1)); + Tcl_ListObjAppendElement(NULL, markSetLUndoMarkCmdObj, + Tcl_NewStringObj("mark", 4)); + Tcl_ListObjAppendElement(NULL, markSetLUndoMarkCmdObj, + Tcl_NewStringObj("set", 3)); + markSetRUndoMarkCmdObj = Tcl_DuplicateObj(markSetLUndoMarkCmdObj); + textPtr->sharedTextPtr->undoMarkId++; + sprintf(stringUndoMarkId, "%d", textPtr->sharedTextPtr->undoMarkId); + strcat(lMarkName, stringUndoMarkId); + strcat(rMarkName, stringUndoMarkId); + Tcl_ListObjAppendElement(NULL, markSetLUndoMarkCmdObj, + Tcl_NewStringObj(lMarkName, -1)); + Tcl_ListObjAppendElement(NULL, markSetRUndoMarkCmdObj, + Tcl_NewStringObj(rMarkName, -1)); + Tcl_ListObjAppendElement(NULL, markSetLUndoMarkCmdObj, index1Obj); + Tcl_ListObjAppendElement(NULL, markSetRUndoMarkCmdObj, index2Obj); + + Tcl_ListObjAppendElement(NULL, markGravityLUndoMarkCmdObj, + Tcl_NewStringObj(Tk_PathName(textPtr->tkwin), -1)); + Tcl_ListObjAppendElement(NULL, markGravityLUndoMarkCmdObj, + Tcl_NewStringObj("mark", 4)); + Tcl_ListObjAppendElement(NULL, markGravityLUndoMarkCmdObj, + Tcl_NewStringObj("gravity", 7)); + markGravityRUndoMarkCmdObj = Tcl_DuplicateObj(markGravityLUndoMarkCmdObj); + Tcl_ListObjAppendElement(NULL, markGravityLUndoMarkCmdObj, + Tcl_NewStringObj(lMarkName, -1)); + Tcl_ListObjAppendElement(NULL, markGravityRUndoMarkCmdObj, + Tcl_NewStringObj(rMarkName, -1)); + Tcl_ListObjAppendElement(NULL, markGravityLUndoMarkCmdObj, + Tcl_NewStringObj("left", 4)); + Tcl_ListObjAppendElement(NULL, markGravityRUndoMarkCmdObj, + Tcl_NewStringObj("right", 5)); + /* * Note: we don't wish to use textPtr->widgetCmd in these callbacks * because if we delete the textPtr, but peers still exist, we will then @@ -2847,11 +2888,19 @@ TextPushUndoAction( insertCmdObj, NULL); TkUndoMakeCmdSubAtom(NULL, markSet2InsertObj, iAtom); TkUndoMakeCmdSubAtom(NULL, seeInsertObj, iAtom); + TkUndoMakeCmdSubAtom(NULL, markSetLUndoMarkCmdObj, iAtom); + TkUndoMakeCmdSubAtom(NULL, markSetRUndoMarkCmdObj, iAtom); + TkUndoMakeCmdSubAtom(NULL, markGravityLUndoMarkCmdObj, iAtom); + TkUndoMakeCmdSubAtom(NULL, markGravityRUndoMarkCmdObj, iAtom); dAtom = TkUndoMakeSubAtom(&TextUndoRedoCallback, textPtr->sharedTextPtr, deleteCmdObj, NULL); TkUndoMakeCmdSubAtom(NULL, markSet1InsertObj, dAtom); TkUndoMakeCmdSubAtom(NULL, seeInsertObj, dAtom); + TkUndoMakeCmdSubAtom(NULL, markSetLUndoMarkCmdObj, dAtom); + TkUndoMakeCmdSubAtom(NULL, markSetRUndoMarkCmdObj, dAtom); + TkUndoMakeCmdSubAtom(NULL, markGravityLUndoMarkCmdObj, dAtom); + TkUndoMakeCmdSubAtom(NULL, markGravityRUndoMarkCmdObj, dAtom); Tcl_DecrRefCount(seeInsertObj); Tcl_DecrRefCount(index1Obj); @@ -5066,6 +5115,8 @@ TextEditUndo( TkText *textPtr) /* Overall information about text widget. */ { int status; + Tcl_Obj *cmdObj; + int code; if (!textPtr->sharedTextPtr->undo) { return TCL_OK; @@ -5089,6 +5140,22 @@ TextEditUndo( } textPtr->sharedTextPtr->undo = 1; + /* + * Convert undo/redo temporary marks set by TkUndoRevert() into + * indices left in the interp result. + */ + + cmdObj = Tcl_ObjPrintf("::tk::TextUndoRedoProcessMarks %s", + Tk_PathName(textPtr->tkwin)); + Tcl_IncrRefCount(cmdObj); + code = Tcl_EvalObjEx(textPtr->interp, cmdObj, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { + Tcl_AddErrorInfo(textPtr->interp, + "\n (on undoing)"); + Tcl_BackgroundException(textPtr->interp, code); + } + Tcl_DecrRefCount(cmdObj); + return status; } @@ -5114,6 +5181,8 @@ TextEditRedo( TkText *textPtr) /* Overall information about text widget. */ { int status; + Tcl_Obj *cmdObj; + int code; if (!textPtr->sharedTextPtr->undo) { return TCL_OK; @@ -5136,6 +5205,23 @@ TextEditRedo( textPtr->sharedTextPtr->dirtyMode = TK_TEXT_DIRTY_NORMAL; } textPtr->sharedTextPtr->undo = 1; + + /* + * Convert undo/redo temporary marks set by TkUndoApply() into + * indices left in the interp result. + */ + + cmdObj = Tcl_ObjPrintf("::tk::TextUndoRedoProcessMarks %s", + Tk_PathName(textPtr->tkwin)); + Tcl_IncrRefCount(cmdObj); + code = Tcl_EvalObjEx(textPtr->interp, cmdObj, TCL_EVAL_GLOBAL); + if (code != TCL_OK) { + Tcl_AddErrorInfo(textPtr->interp, + "\n (on undoing)"); + Tcl_BackgroundException(textPtr->interp, code); + } + Tcl_DecrRefCount(cmdObj); + return status; } diff --git a/generic/tkText.h b/generic/tkText.h index 5d88784..430c96b 100644 --- a/generic/tkText.h +++ b/generic/tkText.h @@ -580,6 +580,8 @@ typedef struct TkSharedText { * statements. */ int autoSeparators; /* Non-zero means the separators will be * inserted automatically. */ + int undoMarkId; /* Counts undo marks temporarily used during + undo and redo operations. */ int isDirty; /* Flag indicating the 'dirtyness' of the * text widget. If the flag is not zero, * unsaved modifications have been applied to diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c index 9c2f536..0958986 100644 --- a/generic/tkTextDisp.c +++ b/generic/tkTextDisp.c @@ -610,7 +610,7 @@ static void AsyncUpdateLineMetrics(ClientData clientData); static void GenerateWidgetViewSyncEvent(TkText *textPtr, Bool InSync); static void AsyncUpdateYScrollbar(ClientData clientData); static int IsStartOfNotMergedLine(TkText *textPtr, - CONST TkTextIndex *indexPtr); + const TkTextIndex *indexPtr); /* * Result values returned by TextGetScrollInfoObj: @@ -6890,7 +6890,7 @@ FindDLine( static int IsStartOfNotMergedLine( TkText *textPtr, /* Widget record for text widget. */ - CONST TkTextIndex *indexPtr) /* Index to check. */ + const TkTextIndex *indexPtr) /* Index to check. */ { TkTextIndex indexPtr2; diff --git a/generic/tkTextIndex.c b/generic/tkTextIndex.c index faa1afd..cfe230c 100644 --- a/generic/tkTextIndex.c +++ b/generic/tkTextIndex.c @@ -40,9 +40,9 @@ static const char * StartEnd(TkText *textPtr, const char *string, static int GetIndex(Tcl_Interp *interp, TkSharedText *sharedPtr, TkText *textPtr, const char *string, TkTextIndex *indexPtr, int *canCachePtr); -static int IndexCountBytesOrdered(CONST TkText *textPtr, - CONST TkTextIndex *indexPtr1, - CONST TkTextIndex *indexPtr2); +static int IndexCountBytesOrdered(const TkText *textPtr, + const TkTextIndex *indexPtr1, + const TkTextIndex *indexPtr2); /* * The "textindex" Tcl_Obj definition: @@ -1636,9 +1636,9 @@ TkTextIndexForwChars( int TkTextIndexCountBytes( - CONST TkText *textPtr, - CONST TkTextIndex *indexPtr1, /* Index describing one location. */ - CONST TkTextIndex *indexPtr2) /* Index describing second location. */ + const TkText *textPtr, + const TkTextIndex *indexPtr1, /* Index describing one location. */ + const TkTextIndex *indexPtr2) /* Index describing second location. */ { int compare = TkTextIndexCmp(indexPtr1, indexPtr2); @@ -1653,11 +1653,11 @@ TkTextIndexCountBytes( static int IndexCountBytesOrdered( - CONST TkText *textPtr, - CONST TkTextIndex *indexPtr1, + const TkText *textPtr, + const TkTextIndex *indexPtr1, /* Index describing location of character from * which to count. */ - CONST TkTextIndex *indexPtr2) + const TkTextIndex *indexPtr2) /* Index describing location of last character * at which to stop the count. */ { diff --git a/generic/tkUtil.c b/generic/tkUtil.c index e686826..d89282f 100644 --- a/generic/tkUtil.c +++ b/generic/tkUtil.c @@ -1187,7 +1187,7 @@ TkSendVirtualEvent( event.general.xany.display = Tk_Display(target); event.virtual.name = Tk_GetUid(eventName); if (detail != NULL) { - event.virtual.user_data = detail; + event.virtual.user_data = detail; } Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL); diff --git a/generic/tkVisual.c b/generic/tkVisual.c index 8b0c155..6f6816d 100644 --- a/generic/tkVisual.c +++ b/generic/tkVisual.c @@ -46,7 +46,7 @@ static const VisualDictionary visualNames[] = { struct TkColormap { Colormap colormap; /* X's identifier for the colormap. */ Visual *visual; /* Visual for which colormap was allocated. */ - int refCount; /* How many uses of the colormap are still + size_t refCount; /* How many uses of the colormap are still * outstanding (calls to Tk_GetColormap minus * calls to Tk_FreeColormap). */ int shareable; /* 0 means this colormap was allocated by a @@ -137,7 +137,7 @@ Tk_GetVisual( for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL; cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->colormap == *colormapPtr) { - cmapPtr->refCount += 1; + cmapPtr->refCount++; break; } } @@ -324,7 +324,7 @@ Tk_GetVisual( cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->shareable && (cmapPtr->visual == visual)) { *colormapPtr = cmapPtr->colormap; - cmapPtr->refCount += 1; + cmapPtr->refCount++; goto done; } } @@ -427,7 +427,7 @@ Tk_GetColormap( for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL; cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->colormap == colormap) { - cmapPtr->refCount += 1; + cmapPtr->refCount++; } } return colormap; @@ -476,8 +476,7 @@ Tk_FreeColormap( for (prevPtr = NULL, cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL; prevPtr = cmapPtr, cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->colormap == colormap) { - cmapPtr->refCount -= 1; - if (cmapPtr->refCount == 0) { + if (cmapPtr->refCount-- <= 1) { XFreeColormap(display, colormap); if (prevPtr == NULL) { dispPtr->cmapPtr = cmapPtr->nextPtr; @@ -534,7 +533,7 @@ Tk_PreserveColormap( for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL; cmapPtr = cmapPtr->nextPtr) { if (cmapPtr->colormap == colormap) { - cmapPtr->refCount += 1; + cmapPtr->refCount++; return; } } diff --git a/generic/tkWindow.c b/generic/tkWindow.c index 2848ff5..ef06a5b 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -336,6 +336,7 @@ CreateTopLevelWindow( * Create built-in photo image formats. */ + Tk_CreatePhotoImageFormat(&tkImgFmtDefault); Tk_CreatePhotoImageFormat(&tkImgFmtGIF); Tk_CreatePhotoImageFormat(&tkImgFmtPNG); Tk_CreatePhotoImageFormat(&tkImgFmtPPM); @@ -949,7 +950,7 @@ TkCreateMainWindow( } /* - * Set variables for the intepreter. + * Set variables for the interpreter. */ Tcl_SetVar2(interp, "tk_patchLevel", NULL, TK_PATCH_LEVEL, TCL_GLOBAL_ONLY); @@ -3047,7 +3048,7 @@ Initialize( * Ensure that we are getting a compatible version of Tcl. */ - if (Tcl_InitStubs(interp, "8.6", 0) == NULL) { + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) { return TCL_ERROR; } diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c index c00754b..ef55ec3 100644 --- a/generic/ttk/ttkButton.c +++ b/generic/ttk/ttkButton.c @@ -23,6 +23,7 @@ typedef struct * Text element resources: */ Tcl_Obj *textObj; + Tcl_Obj *justifyObj; Tcl_Obj *textVariableObj; Tcl_Obj *underlineObj; Tcl_Obj *widthObj; @@ -56,6 +57,9 @@ typedef struct static Tk_OptionSpec BaseOptionSpecs[] = { + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + "left", Tk_Offset(Base,base.justifyObj), -1, + TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_STRING, "-text", "text", "Text", "", Tk_Offset(Base,base.textObj), -1, 0,0,GEOMETRY_CHANGED }, diff --git a/generic/ttk/ttkClamTheme.c b/generic/ttk/ttkClamTheme.c index 15ebcb7..b44eeb5 100644 --- a/generic/ttk/ttkClamTheme.c +++ b/generic/ttk/ttkClamTheme.c @@ -7,8 +7,8 @@ #include <tk.h> #include "ttkTheme.h" -/* - * Under windows, the Tk-provided XDrawLine and XDrawArc have an +/* + * Under windows, the Tk-provided XDrawLine and XDrawArc have an * off-by-one error in the end point. This is especially apparent with this * theme. Defining this macro as true handles this case. */ @@ -123,8 +123,8 @@ static Ttk_ElementOptionSpec BorderElementOptions[] = { /* * <<NOTE-BORDERWIDTH>>: -borderwidth is only partially supported: * in this theme, borders are always exactly 2 pixels thick. - * With -borderwidth 0, border is not drawn at all; - * otherwise a 2-pixel border is used. For -borderwidth > 2, + * With -borderwidth 0, border is not drawn at all; + * otherwise a 2-pixel border is used. For -borderwidth > 2, * the excess is used as padding. */ @@ -402,7 +402,7 @@ typedef struct { static Ttk_ElementOptionSpec MenuIndicatorElementOptions[] = { { "-arrowsize", TK_OPTION_PIXELS, - Tk_Offset(MenuIndicatorElement,sizeObj), + Tk_Offset(MenuIndicatorElement,sizeObj), STR(MENUBUTTON_ARROW_SIZE)}, { "-arrowcolor",TK_OPTION_COLOR, Tk_Offset(MenuIndicatorElement,colorObj), @@ -630,7 +630,7 @@ static void ThumbElementDraw( Tcl_GetIntFromObj(NULL, sb->gripCountObj, &gripCount); lightGC = Ttk_GCForColor(tkwin,sb->lightColorObj,d); darkGC = Ttk_GCForColor(tkwin,sb->borderColorObj,d); - + if (orient == TTK_ORIENT_HORIZONTAL) { dx = 1; dy = 0; x1 = x2 = b.x + b.width / 2 - gripCount; @@ -710,12 +710,12 @@ static void PbarElementDraw( Drawable d, Ttk_Box b, unsigned state) { ScrollbarElement *sb = elementRecord; - + b = Ttk_PadBox(b, Ttk_UniformPadding(2)); if (b.width > 4 && b.height > 4) { DrawSmoothBorder(tkwin, d, b, sb->borderColorObj, sb->lightColorObj, sb->darkColorObj); - XFillRectangle(Tk_Display(tkwin), d, + XFillRectangle(Tk_Display(tkwin), d, BackgroundGC(tkwin, sb->backgroundObj), b.x+2, b.y+2, b.width-4, b.height-4); } @@ -780,8 +780,8 @@ static Ttk_ElementSpec ArrowElementSpec = { /*------------------------------------------------------------------------ * +++ Notebook elements. - * - * Note: Tabs, except for the rightmost, overlap the neighbor to + * + * Note: Tabs, except for the rightmost, overlap the neighbor to * their right by one pixel. */ diff --git a/generic/ttk/ttkClassicTheme.c b/generic/ttk/ttkClassicTheme.c index 2fbcd76..d16cb85 100644 --- a/generic/ttk/ttkClassicTheme.c +++ b/generic/ttk/ttkClassicTheme.c @@ -68,7 +68,7 @@ static Ttk_ElementSpec HighlightElementSpec = /*------------------------------------------------------------------------ * +++ Button Border element: - * + * * The Motif-style button border on X11 consists of (from outside-in): * * + focus indicator (controlled by -highlightcolor and -highlightthickness), @@ -85,13 +85,13 @@ typedef struct { static Ttk_ElementOptionSpec ButtonBorderElementOptions[] = { - { "-background", TK_OPTION_BORDER, + { "-background", TK_OPTION_BORDER, Tk_Offset(ButtonBorderElement,borderObj), DEFAULT_BACKGROUND }, - { "-borderwidth", TK_OPTION_PIXELS, + { "-borderwidth", TK_OPTION_PIXELS, Tk_Offset(ButtonBorderElement,borderWidthObj), DEFAULT_BORDERWIDTH }, - { "-relief", TK_OPTION_RELIEF, + { "-relief", TK_OPTION_RELIEF, Tk_Offset(ButtonBorderElement,reliefObj), "flat" }, - { "-default", TK_OPTION_ANY, + { "-default", TK_OPTION_ANY, Tk_Offset(ButtonBorderElement,defaultStateObj), "disabled" }, { NULL, 0, 0, NULL } }; @@ -115,7 +115,7 @@ static void ButtonBorderElementSize( /* * (@@@ Note: ButtonBorderElement still still still buggy: - * padding for default ring is drawn in the wrong color + * padding for default ring is drawn in the wrong color * when the button is active.) */ static void ButtonBorderElementDraw( @@ -281,19 +281,19 @@ static Ttk_ElementSpec ArrowElementSpec = /*------------------------------------------------------------------------ * +++ Sash element (for ttk::panedwindow) * - * NOTES: + * NOTES: * * panedwindows with -orient horizontal use vertical sashes, and vice versa. * * Interpretation of -sashrelief 'groove' and 'ridge' are * swapped wrt. the core panedwindow, which (I think) has them backwards. * - * Default -sashrelief is sunken; the core panedwindow has default + * Default -sashrelief is sunken; the core panedwindow has default * -sashrelief raised, but that looks wrong to me. */ static Ttk_Orient SashClientData[] = { - TTK_ORIENT_HORIZONTAL, TTK_ORIENT_VERTICAL + TTK_ORIENT_HORIZONTAL, TTK_ORIENT_VERTICAL }; typedef struct { @@ -306,13 +306,13 @@ typedef struct { } SashElement; static Ttk_ElementOptionSpec SashOptions[] = { - { "-background", TK_OPTION_BORDER, + { "-background", TK_OPTION_BORDER, Tk_Offset(SashElement,borderObj), DEFAULT_BACKGROUND }, - { "-sashrelief", TK_OPTION_RELIEF, + { "-sashrelief", TK_OPTION_RELIEF, Tk_Offset(SashElement,sashReliefObj), "sunken" }, { "-sashthickness", TK_OPTION_PIXELS, Tk_Offset(SashElement,sashThicknessObj), "6" }, - { "-sashpad", TK_OPTION_PIXELS, + { "-sashpad", TK_OPTION_PIXELS, Tk_Offset(SashElement,sashPadObj), "2" }, { "-handlesize", TK_OPTION_PIXELS, Tk_Offset(SashElement,handleSizeObj), "8" }, @@ -367,10 +367,10 @@ static void SashElementDraw( gc1 = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC); gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_LIGHT_GC); break; - case TK_RELIEF_SOLID: + case TK_RELIEF_SOLID: gc1 = gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_DARK_GC); break; - case TK_RELIEF_FLAT: + case TK_RELIEF_FLAT: default: gc1 = gc2 = Tk_3DBorderGC(tkwin, border, TK_3D_FLAT_GC); break; @@ -398,7 +398,7 @@ static void SashElementDraw( hb = Ttk_StickBox(b, handleSize, handleSize, TTK_STICK_N); hb.y += handlePad; } - Tk_Fill3DRectangle(tkwin, d, border, + Tk_Fill3DRectangle(tkwin, d, border, hb.x, hb.y, hb.width, hb.height, 1, TK_RELIEF_RAISED); } } @@ -495,7 +495,7 @@ MODULE_SCOPE int TtkClassicTheme_Init(Tcl_Interp *interp) Ttk_RegisterElement(interp, theme, "arrow", &ArrowElementSpec, &ArrowElements[0]); - Ttk_RegisterElement(interp, theme, "hsash", + Ttk_RegisterElement(interp, theme, "hsash", &SashElementSpec, &SashClientData[0]); Ttk_RegisterElement(interp, theme, "vsash", &SashElementSpec, &SashClientData[1]); diff --git a/generic/ttk/ttkGenStubs.tcl b/generic/ttk/ttkGenStubs.tcl deleted file mode 100644 index 8047e3f..0000000 --- a/generic/ttk/ttkGenStubs.tcl +++ /dev/null @@ -1,963 +0,0 @@ -# ttkGenStubs.tcl -- -# -# This script generates a set of stub files for a given -# interface. -# -# -# Copyright (c) 1998-1999 by Scriptics Corporation. -# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# SOURCE: tcl/tools/genStubs.tcl, revision 1.44 -# -# CHANGES: -# + Second argument to "declare" is used as a status guard -# instead of a platform guard. -# + Allow trailing semicolon in function declarations -# - -namespace eval genStubs { - # libraryName -- - # - # The name of the entire library. This value is used to compute - # the USE_*_STUBS macro and the name of the init file. - - variable libraryName "UNKNOWN" - - # interfaces -- - # - # An array indexed by interface name that is used to maintain - # the set of valid interfaces. The value is empty. - - array set interfaces {} - - # curName -- - # - # The name of the interface currently being defined. - - variable curName "UNKNOWN" - - # scspec -- - # - # Storage class specifier for external function declarations. - # Normally "EXTERN", may be set to something like XYZAPI - # - variable scspec "EXTERN" - - # epoch, revision -- - # - # The epoch and revision numbers of the interface currently being defined. - # (@@@TODO: should be an array mapping interface names -> numbers) - # - - variable epoch {} - variable revision 0 - - # hooks -- - # - # An array indexed by interface name that contains the set of - # subinterfaces that should be defined for a given interface. - - array set hooks {} - - # stubs -- - # - # This three dimensional array is indexed first by interface name, - # second by field name, and third by a numeric offset or the - # constant "lastNum". The lastNum entry contains the largest - # numeric offset used for a given interface. - # - # Field "decl,$i" contains the C function specification that - # should be used for the given entry in the stub table. The spec - # consists of a list in the form returned by parseDecl. - # Other fields TBD later. - - array set stubs {} - - # outDir -- - # - # The directory where the generated files should be placed. - - variable outDir . -} - -# genStubs::library -- -# -# This function is used in the declarations file to set the name -# of the library that the interfaces are associated with (e.g. "tcl"). -# This value will be used to define the inline conditional macro. -# -# Arguments: -# name The library name. -# -# Results: -# None. - -proc genStubs::library {name} { - variable libraryName $name -} - -# genStubs::interface -- -# -# This function is used in the declarations file to set the name -# of the interface currently being defined. -# -# Arguments: -# name The name of the interface. -# -# Results: -# None. - -proc genStubs::interface {name} { - variable curName $name - variable interfaces - variable stubs - - set interfaces($name) {} - set stubs($name,lastNum) 0 - return -} - -# genStubs::scspec -- -# -# Define the storage class macro used for external function declarations. -# Typically, this will be a macro like XYZAPI or EXTERN that -# expands to either DLLIMPORT or DLLEXPORT, depending on whether -# -DBUILD_XYZ has been set. -# -proc genStubs::scspec {value} { - variable scspec $value -} - -# genStubs::epoch -- -# -# Define the epoch number for this library. The epoch -# should be incrememented when a release is made that -# contains incompatible changes to the public API. -# -proc genStubs::epoch {value} { - variable epoch $value -} - -# genStubs::hooks -- -# -# This function defines the subinterface hooks for the current -# interface. -# -# Arguments: -# names The ordered list of interfaces that are reachable through the -# hook vector. -# -# Results: -# None. - -proc genStubs::hooks {names} { - variable curName - variable hooks - - set hooks($curName) $names - return -} - -# genStubs::declare -- -# -# This function is used in the declarations file to declare a new -# interface entry. -# -# Arguments: -# index The index number of the interface. -# status Status of the interface: one of "current", -# "deprecated", or "obsolete". -# decl The C function declaration, or {} for an undefined -# entry. -# -# Results: -# None. - -proc genStubs::declare {args} { - variable stubs - variable curName - variable revision - - incr revision - if {[llength $args] == 2} { - lassign $args index decl - set status current - } elseif {[llength $args] == 3} { - lassign $args index status decl - } else { - puts stderr "wrong # args: declare $args" - return - } - - # Check for duplicate declarations, then add the declaration and - # bump the lastNum counter if necessary. - - if {[info exists stubs($curName,decl,$index)]} { - puts stderr "Duplicate entry: $index" - } - regsub -all "\[ \t\n\]+" [string trim $decl] " " decl - set decl [parseDecl $decl] - - set stubs($curName,status,$index) $status - set stubs($curName,decl,$index) $decl - - if {$index > $stubs($curName,lastNum)} { - set stubs($curName,lastNum) $index - } - return -} - -# genStubs::export -- -# -# This function is used in the declarations file to declare a symbol -# that is exported from the library but is not in the stubs table. -# -# Arguments: -# decl The C function declaration, or {} for an undefined -# entry. -# -# Results: -# None. - -proc genStubs::export {args} { - if {[llength $args] != 1} { - puts stderr "wrong # args: export $args" - } - return -} - -# genStubs::rewriteFile -- -# -# This function replaces the machine generated portion of the -# specified file with new contents. It looks for the !BEGIN! and -# !END! comments to determine where to place the new text. -# -# Arguments: -# file The name of the file to modify. -# text The new text to place in the file. -# -# Results: -# None. - -proc genStubs::rewriteFile {file text} { - if {![file exists $file]} { - puts stderr "Cannot find file: $file" - return - } - set in [open ${file} r] - set out [open ${file}.new w] - fconfigure $out -translation lf - - while {![eof $in]} { - set line [gets $in] - if {[string match "*!BEGIN!*" $line]} { - break - } - puts $out $line - } - puts $out "/* !BEGIN!: Do not edit below this line. */" - puts $out $text - while {![eof $in]} { - set line [gets $in] - if {[string match "*!END!*" $line]} { - break - } - } - puts $out "/* !END!: Do not edit above this line. */" - puts -nonewline $out [read $in] - close $in - close $out - file rename -force ${file}.new ${file} - return -} - -# genStubs::addPlatformGuard -- -# -# Wrap a string inside a platform #ifdef. -# -# Arguments: -# plat Platform to test. -# -# Results: -# Returns the original text inside an appropriate #ifdef. - -proc genStubs::addPlatformGuard {plat iftxt {eltxt {}}} { - set text "" - switch $plat { - win { - append text "#ifdef _WIN32 /* WIN */\n${iftxt}" - if {$eltxt ne ""} { - append text "#else /* WIN */\n${eltxt}" - } - append text "#endif /* WIN */\n" - } - unix { - append text "#if !defined(_WIN32) && !defined(MAC_OSX_TCL)\ - /* UNIX */\n${iftxt}" - if {$eltxt ne ""} { - append text "#else /* UNIX */\n${eltxt}" - } - append text "#endif /* UNIX */\n" - } - macosx { - append text "#ifdef MAC_OSX_TCL /* MACOSX */\n${iftxt}" - if {$eltxt ne ""} { - append text "#else /* MACOSX */\n${eltxt}" - } - append text "#endif /* MACOSX */\n" - } - aqua { - append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}" - if {$eltxt ne ""} { - append text "#else /* AQUA */\n${eltxt}" - } - append text "#endif /* AQUA */\n" - } - x11 { - append text "#if !(defined(_WIN32) || defined(MAC_OSX_TK))\ - /* X11 */\n${iftxt}" - if {$eltxt ne ""} { - append text "#else /* X11 */\n${eltxt}" - } - append text "#endif /* X11 */\n" - } - default { - append text "${iftxt}${eltxt}" - } - } - return $text -} - -# genStubs::emitSlots -- -# -# Generate the stub table slots for the given interface. If there -# are no generic slots, then one table is generated for each -# platform, otherwise one table is generated for all platforms. -# -# Arguments: -# name The name of the interface being emitted. -# textVar The variable to use for output. -# -# Results: -# None. - -proc genStubs::emitSlots {name textVar} { - upvar $textVar text - - forAllStubs $name makeSlot noGuard text {" void (*reserved$i)(void);\n"} - return -} - -# genStubs::parseDecl -- -# -# Parse a C function declaration into its component parts. -# -# Arguments: -# decl The function declaration. -# -# Results: -# Returns a list of the form {returnType name args}. The args -# element consists of a list of type/name pairs, or a single -# element "void". If the function declaration is malformed -# then an error is displayed and the return value is {}. - -proc genStubs::parseDecl {decl} { - if {![regexp {^(.*)\((.*)\);?$} $decl all prefix args]} { - set prefix $decl - set args {} - } - set prefix [string trim $prefix] - if {![regexp {^(.+[ ][*]*)([^ *]+)$} $prefix all rtype fname]} { - puts stderr "Bad return type: $decl" - return - } - set rtype [string trim $rtype] - if {$args eq ""} { - return [list $rtype $fname {}] - } - foreach arg [split $args ,] { - lappend argList [string trim $arg] - } - if {![string compare [lindex $argList end] "..."]} { - set args TCL_VARARGS - foreach arg [lrange $argList 0 end-1] { - set argInfo [parseArg $arg] - if {[llength $argInfo] == 2 || [llength $argInfo] == 3} { - lappend args $argInfo - } else { - puts stderr "Bad argument: '$arg' in '$decl'" - return - } - } - } else { - set args {} - foreach arg $argList { - set argInfo [parseArg $arg] - if {![string compare $argInfo "void"]} { - lappend args "void" - break - } elseif {[llength $argInfo] == 2 || [llength $argInfo] == 3} { - lappend args $argInfo - } else { - puts stderr "Bad argument: '$arg' in '$decl'" - return - } - } - } - return [list $rtype $fname $args] -} - -# genStubs::parseArg -- -# -# This function parses a function argument into a type and name. -# -# Arguments: -# arg The argument to parse. -# -# Results: -# Returns a list of type and name with an optional third array -# indicator. If the argument is malformed, returns "". - -proc genStubs::parseArg {arg} { - if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} { - if {$arg eq "void"} { - return $arg - } else { - return - } - } - set result [list [string trim $type] $name] - if {$array ne ""} { - lappend result $array - } - return $result -} - -# genStubs::makeDecl -- -# -# Generate the prototype for a function. -# -# Arguments: -# name The interface name. -# decl The function declaration. -# index The slot index for this function. -# -# Results: -# Returns the formatted declaration string. - -proc genStubs::makeDecl {name decl index} { - variable scspec - lassign $decl rtype fname args - - append text "/* $index */\n" - set line "$scspec $rtype" - set count [expr {2 - ([string length $line] / 8)}] - append line [string range "\t\t\t" 0 $count] - set pad [expr {24 - [string length $line]}] - if {$pad <= 0} { - append line " " - set pad 0 - } - if {$args eq ""} { - append line $fname - append text $line - append text ";\n" - return $text - } - append line $fname - - set arg1 [lindex $args 0] - switch -exact $arg1 { - void { - append line "(void)" - } - TCL_VARARGS { - set sep "(" - foreach arg [lrange $args 1 end] { - append line $sep - set next {} - append next [lindex $arg 0] - if {[string index $next end] ne "*"} { - append next " " - } - append next [lindex $arg 1] [lindex $arg 2] - if {[string length $line] + [string length $next] \ - + $pad > 76} { - append text [string trimright $line] \n - set line "\t\t\t\t" - set pad 28 - } - append line $next - set sep ", " - } - append line ", ...)" - } - default { - set sep "(" - foreach arg $args { - append line $sep - set next {} - append next [lindex $arg 0] - if {[string index $next end] ne "*"} { - append next " " - } - append next [lindex $arg 1] [lindex $arg 2] - if {[string length $line] + [string length $next] \ - + $pad > 76} { - append text [string trimright $line] \n - set line "\t\t\t\t" - set pad 28 - } - append line $next - set sep ", " - } - append line ")" - } - } - return "$text$line;\n" -} - -# genStubs::makeMacro -- -# -# Generate the inline macro for a function. -# -# Arguments: -# name The interface name. -# decl The function declaration. -# index The slot index for this function. -# -# Results: -# Returns the formatted macro definition. - -proc genStubs::makeMacro {name decl index} { - lassign $decl rtype fname args - - set lfname [string tolower [string index $fname 0]] - append lfname [string range $fname 1 end] - - set text "#define $fname \\\n\t(" - if {$args eq ""} { - append text "*" - } - append text "${name}StubsPtr->$lfname)" - append text " /* $index */\n" - return $text -} - -# genStubs::makeSlot -- -# -# Generate the stub table entry for a function. -# -# Arguments: -# name The interface name. -# decl The function declaration. -# index The slot index for this function. -# -# Results: -# Returns the formatted table entry. - -proc genStubs::makeSlot {name decl index} { - lassign $decl rtype fname args - - set lfname [string tolower [string index $fname 0]] - append lfname [string range $fname 1 end] - - set text " " - if {$args eq ""} { - append text $rtype " *" $lfname "; /* $index */\n" - return $text - } - if {[string range $rtype end-8 end] eq "__stdcall"} { - append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " - } else { - append text $rtype " (*" $lfname ") " - } - set arg1 [lindex $args 0] - switch -exact $arg1 { - void { - append text "(void)" - } - TCL_VARARGS { - set sep "(" - foreach arg [lrange $args 1 end] { - append text $sep [lindex $arg 0] - if {[string index $text end] ne "*"} { - append text " " - } - append text [lindex $arg 1] [lindex $arg 2] - set sep ", " - } - append text ", ...)" - } - default { - set sep "(" - foreach arg $args { - append text $sep [lindex $arg 0] - if {[string index $text end] ne "*"} { - append text " " - } - append text [lindex $arg 1] [lindex $arg 2] - set sep ", " - } - append text ")" - } - } - - append text "; /* $index */\n" - return $text -} - -# genStubs::makeInit -- -# -# Generate the prototype for a function. -# -# Arguments: -# name The interface name. -# decl The function declaration. -# index The slot index for this function. -# -# Results: -# Returns the formatted declaration string. - -proc genStubs::makeInit {name decl index} { - if {[lindex $decl 2] eq ""} { - append text " &" [lindex $decl 1] ", /* " $index " */\n" - } else { - append text " " [lindex $decl 1] ", /* " $index " */\n" - } - return $text -} - -# genStubs::forAllStubs -- -# -# This function iterates over all of the slots and invokes -# a callback for each slot. The result of the callback is then -# placed inside appropriate guards. -# -# Arguments: -# name The interface name. -# slotProc The proc to invoke to handle the slot. It will -# have the interface name, the declaration, and -# the index appended. -# guardProc The proc to invoke to add guards. It will have -# the slot status and text appended. -# textVar The variable to use for output. -# skipString The string to emit if a slot is skipped. This -# string will be subst'ed in the loop so "$i" can -# be used to substitute the index value. -# -# Results: -# None. - -proc genStubs::forAllStubs {name slotProc guardProc textVar - {skipString {"/* Slot $i is reserved */\n"}}} { - variable stubs - upvar $textVar text - - set lastNum $stubs($name,lastNum) - - for {set i 0} {$i <= $lastNum} {incr i} { - if {[info exists stubs($name,decl,$i)]} { - append text [$guardProc $stubs($name,status,$i) \ - [$slotProc $name $stubs($name,decl,$i) $i]] - } else { - eval {append text} $skipString - } - } -} - -proc genStubs::noGuard {status text} { return $text } - -proc genStubs::addGuard {status text} { - variable libraryName - set upName [string toupper $libraryName] - - switch -- $status { - current { - # No change - } - deprecated { - set text [ifdeffed "${upName}_DEPRECATED" $text] - } - obsolete { - set text "" - } - default { - puts stderr "Unrecognized status code $status" - } - } - return $text -} - -proc genStubs::ifdeffed {macro text} { - join [list "#ifdef $macro" $text "#endif" ""] \n -} - -# genStubs::emitDeclarations -- -# -# This function emits the function declarations for this interface. -# -# Arguments: -# name The interface name. -# textVar The variable to use for output. -# -# Results: -# None. - -proc genStubs::emitDeclarations {name textVar} { - upvar $textVar text - - append text "\n/*\n * Exported function declarations:\n */\n\n" - forAllStubs $name makeDecl noGuard text - return -} - -# genStubs::emitMacros -- -# -# This function emits the inline macros for an interface. -# -# Arguments: -# name The name of the interface being emitted. -# textVar The variable to use for output. -# -# Results: -# None. - -proc genStubs::emitMacros {name textVar} { - variable libraryName - upvar $textVar text - - set upName [string toupper $libraryName] - append text "\n#if defined(USE_${upName}_STUBS)\n" - append text "\n/*\n * Inline function declarations:\n */\n\n" - - forAllStubs $name makeMacro addGuard text - - append text "\n#endif /* defined(USE_${upName}_STUBS) */\n" - return -} - -# genStubs::emitHeader -- -# -# This function emits the body of the <name>Decls.h file for -# the specified interface. -# -# Arguments: -# name The name of the interface being emitted. -# -# Results: -# None. - -proc genStubs::emitHeader {name} { - variable outDir - variable hooks - variable epoch - variable revision - - set capName [string toupper [string index $name 0]] - append capName [string range $name 1 end] - - if {$epoch ne ""} { - set CAPName [string toupper $name] - append text "\n" - append text "#define ${CAPName}_STUBS_EPOCH $epoch\n" - append text "#define ${CAPName}_STUBS_REVISION $revision\n" - } - - append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" - - emitDeclarations $name text - - if {[info exists hooks($name)]} { - append text "\ntypedef struct {\n" - foreach hook $hooks($name) { - set capHook [string toupper [string index $hook 0]] - append capHook [string range $hook 1 end] - append text " const struct ${capHook}Stubs *${hook}Stubs;\n" - } - append text "} ${capName}StubHooks;\n" - } - append text "\ntypedef struct ${capName}Stubs {\n" - append text " int magic;\n" - if {$epoch ne ""} { - append text " int epoch;\n" - append text " int revision;\n" - } - if {[info exists hooks($name)]} { - append text " const ${capName}StubHooks *hooks;\n\n" - } else { - append text " void *hooks;\n\n" - } - - emitSlots $name text - - append text "} ${capName}Stubs;\n\n" - - append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n" - append text "#ifdef __cplusplus\n}\n#endif\n" - - emitMacros $name text - - rewriteFile [file join $outDir ${name}Decls.h] $text - return -} - -# genStubs::emitInit -- -# -# Generate the table initializers for an interface. -# -# Arguments: -# name The name of the interface to initialize. -# textVar The variable to use for output. -# -# Results: -# Returns the formatted output. - -proc genStubs::emitInit {name textVar} { - variable hooks - variable interfaces - variable epoch - upvar $textVar text - set root 1 - - set capName [string toupper [string index $name 0]] - append capName [string range $name 1 end] - - if {[info exists hooks($name)]} { - append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n" - set sep " " - foreach sub $hooks($name) { - append text $sep "&${sub}Stubs" - set sep ",\n " - } - append text "\n\};\n" - } - foreach intf [array names interfaces] { - if {[info exists hooks($intf)]} { - if {[lsearch -exact $hooks($intf) $name] >= 0} { - set root 0 - break - } - } - } - - append text "\n" - if {!$root} { - append text "static " - } - append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n" - if {$epoch ne ""} { - set CAPName [string toupper $name] - append text " ${CAPName}_STUBS_EPOCH,\n" - append text " ${CAPName}_STUBS_REVISION,\n" - } - if {[info exists hooks($name)]} { - append text " &${name}StubHooks,\n" - } else { - append text " 0,\n" - } - - forAllStubs $name makeInit noGuard text {" 0, /* $i */\n"} - - append text "\};\n" - return -} - -# genStubs::emitInits -- -# -# This function emits the body of the <name>StubInit.c file for -# the specified interface. -# -# Arguments: -# name The name of the interface being emitted. -# -# Results: -# None. - -proc genStubs::emitInits {} { - variable hooks - variable outDir - variable libraryName - variable interfaces - - # Assuming that dependencies only go one level deep, we need to emit - # all of the leaves first to avoid needing forward declarations. - - set leaves {} - set roots {} - foreach name [lsort [array names interfaces]] { - if {[info exists hooks($name)]} { - lappend roots $name - } else { - lappend leaves $name - } - } - foreach name $leaves { - emitInit $name text - } - foreach name $roots { - emitInit $name text - } - - rewriteFile [file join $outDir ${libraryName}StubInit.c] $text -} - -# genStubs::init -- -# -# This is the main entry point. -# -# Arguments: -# None. -# -# Results: -# None. - -proc genStubs::init {} { - global argv argv0 - variable outDir - variable interfaces - - if {[llength $argv] < 2} { - puts stderr "usage: $argv0 outDir declFile ?declFile...?" - exit 1 - } - - set outDir [lindex $argv 0] - - foreach file [lrange $argv 1 end] { - source $file - } - - foreach name [lsort [array names interfaces]] { - puts "Emitting $name" - emitHeader $name - } - - emitInits -} - -# lassign -- -# -# This function emulates the TclX lassign command. -# -# Arguments: -# valueList A list containing the values to be assigned. -# args The list of variables to be assigned. -# -# Results: -# Returns any values that were not assigned to variables. - -if {[string length [namespace which lassign]] == 0} { - proc lassign {valueList args} { - if {[llength $args] == 0} { - error "wrong # args: should be \"lassign list varName ?varName ...?\"" - } - uplevel [list foreach $args $valueList {break}] - return [lrange $valueList [llength $args] end] - } -} - -genStubs::init diff --git a/generic/ttk/ttkLabel.c b/generic/ttk/ttkLabel.c index 1037840..b8b7f29 100644 --- a/generic/ttk/ttkLabel.c +++ b/generic/ttk/ttkLabel.c @@ -139,7 +139,7 @@ static void TextDraw(TextElement *text, Tk_Window tkwin, Drawable d, Ttk_Box b) gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin)); gc2 = Tk_GetGC(tkwin, GCFont | GCForeground, &gcValues); - /* + /* * Place text according to -anchor: */ Tk_GetAnchorFromObj(NULL, text->anchorObj, &anchor); @@ -342,15 +342,15 @@ static void ImageDraw( Tk_RedrawImage(image->tkimg, 0,0, width, height, d, b.x, b.y); - /* If we're disabled there's no state-specific 'disabled' image, + /* If we're disabled there's no state-specific 'disabled' image, * stipple the image. * @@@ Possibly: Don't do disabled-stippling at all; * @@@ it's ugly and out of fashion. - * Do not stipple at all under Aqua, just draw the image: it shows up + * Do not stipple at all under Aqua, just draw the image: it shows up * as a white rectangle otherwise. */ - + if (state & TTK_STATE_DISABLED) { if (TtkSelectImage(image->imageSpec, 0ul) == image->tkimg) { #ifndef MAC_OSX_TK @@ -577,7 +577,7 @@ static void LabelElementSize( if (label->compound != TTK_COMPOUND_IMAGE) textReqWidth = TextReqWidth(&label->text); - switch (label->compound) + switch (label->compound) { case TTK_COMPOUND_TEXT: *widthPtr = textReqWidth; @@ -588,11 +588,11 @@ static void LabelElementSize( case TTK_COMPOUND_TOP: case TTK_COMPOUND_BOTTOM: case TTK_COMPOUND_CENTER: - *widthPtr = MAX(label->image.width, textReqWidth); + *widthPtr = MAX(label->image.width, textReqWidth); break; case TTK_COMPOUND_LEFT: case TTK_COMPOUND_RIGHT: - *widthPtr = label->image.width + textReqWidth + label->space; + *widthPtr = label->image.width + textReqWidth + label->space; break; case TTK_COMPOUND_NONE: break; /* Can't happen */ diff --git a/generic/ttk/ttkManager.c b/generic/ttk/ttkManager.c index 24a0fb1..031fdec 100644 --- a/generic/ttk/ttkManager.c +++ b/generic/ttk/ttkManager.c @@ -320,7 +320,7 @@ void Ttk_GeometryRequestProc(ClientData clientData, Tk_Window slaveWindow) int reqHeight= Tk_ReqHeight(slaveWindow); if (mgr->managerSpec->SlaveRequest( - mgr->managerData, slaveIndex, reqWidth, reqHeight)) + mgr->managerData, slaveIndex, reqWidth, reqHeight)) { ScheduleUpdate(mgr, MGR_RESIZE_REQUIRED); } diff --git a/generic/ttk/ttkManager.h b/generic/ttk/ttkManager.h index d22ff98..07fcea1 100644 --- a/generic/ttk/ttkManager.h +++ b/generic/ttk/ttkManager.h @@ -22,7 +22,7 @@ typedef struct TtkManager_ Ttk_Manager; * SlaveRemoved() is called immediately before a slave is removed. * NB: the associated slave window may have been destroyed when this * routine is called. - * + * * SlaveRequest() is called when a slave requests a size change. * It should return 1 if the request should propagate, 0 otherwise. */ diff --git a/generic/ttk/ttkProgress.c b/generic/ttk/ttkProgress.c index 4dc50a2..7787390 100644 --- a/generic/ttk/ttkProgress.c +++ b/generic/ttk/ttkProgress.c @@ -23,13 +23,19 @@ static const char *const ProgressbarModeStrings[] = { }; typedef struct { - Tcl_Obj *orientObj; + Tcl_Obj *anchorObj; + Tcl_Obj *fontObj; + Tcl_Obj *foregroundObj; + Tcl_Obj *justifyObj; Tcl_Obj *lengthObj; - Tcl_Obj *modeObj; - Tcl_Obj *variableObj; Tcl_Obj *maximumObj; - Tcl_Obj *valueObj; + Tcl_Obj *modeObj; + Tcl_Obj *orientObj; Tcl_Obj *phaseObj; + Tcl_Obj *textObj; + Tcl_Obj *valueObj; + Tcl_Obj *variableObj; + Tcl_Obj *wrapLengthObj; int mode; Ttk_TraceHandle *variableTrace; /* Trace handle for -variable option */ @@ -46,28 +52,46 @@ typedef struct { static Tk_OptionSpec ProgressbarOptionSpecs[] = { - {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", - "horizontal", Tk_Offset(Progressbar,progress.orientObj), -1, - 0, (ClientData)ttkOrientStrings, STYLE_CHANGED }, + {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", + "w", Tk_Offset(Progressbar,progress.anchorObj), -1, + TK_OPTION_NULL_OK, 0, GEOMETRY_CHANGED}, + {TK_OPTION_FONT, "-font", "font", "Font", + DEFAULT_FONT, Tk_Offset(Progressbar,progress.fontObj), -1, + TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, + {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor", + "black", Tk_Offset(Progressbar,progress.foregroundObj), -1, + TK_OPTION_NULL_OK,0,0 }, + {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", + "left", Tk_Offset(Progressbar,progress.justifyObj), -1, + TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_PIXELS, "-length", "length", "Length", DEF_PROGRESSBAR_LENGTH, Tk_Offset(Progressbar,progress.lengthObj), -1, 0, 0, GEOMETRY_CHANGED }, + {TK_OPTION_DOUBLE, "-maximum", "maximum", "Maximum", + "100", Tk_Offset(Progressbar,progress.maximumObj), -1, + 0, 0, 0 }, {TK_OPTION_STRING_TABLE, "-mode", "mode", "ProgressMode", "determinate", Tk_Offset(Progressbar,progress.modeObj), Tk_Offset(Progressbar,progress.mode), 0, (ClientData)ProgressbarModeStrings, 0 }, - {TK_OPTION_DOUBLE, "-maximum", "maximum", "Maximum", - "100", Tk_Offset(Progressbar,progress.maximumObj), -1, + {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", + "horizontal", Tk_Offset(Progressbar,progress.orientObj), -1, + 0, (ClientData)ttkOrientStrings, STYLE_CHANGED }, + {TK_OPTION_INT, "-phase", "phase", "Phase", + "0", Tk_Offset(Progressbar,progress.phaseObj), -1, 0, 0, 0 }, - {TK_OPTION_STRING, "-variable", "variable", "Variable", - NULL, Tk_Offset(Progressbar,progress.variableObj), -1, - TK_OPTION_NULL_OK, 0, 0 }, + {TK_OPTION_STRING, "-text", "text", "Text", "", + Tk_Offset(Progressbar,progress.textObj), -1, + 0,0,GEOMETRY_CHANGED }, {TK_OPTION_DOUBLE, "-value", "value", "Value", "0.0", Tk_Offset(Progressbar,progress.valueObj), -1, 0, 0, 0 }, - {TK_OPTION_INT, "-phase", "phase", "Phase", - "0", Tk_Offset(Progressbar,progress.phaseObj), -1, - 0, 0, 0 }, + {TK_OPTION_STRING, "-variable", "variable", "Variable", + NULL, Tk_Offset(Progressbar,progress.variableObj), -1, + TK_OPTION_NULL_OK, 0, 0 }, + {TK_OPTION_PIXELS, "-wraplength", "wrapLength", "WrapLength", + "0", Tk_Offset(Progressbar, progress.wrapLengthObj), -1, + TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED}, WIDGET_TAKEFOCUS_FALSE, WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs) @@ -398,7 +422,7 @@ static int ProgressbarStepCommand( { Progressbar *pb = recordPtr; double value = 0.0, stepAmount = 1.0; - Tcl_Obj *newValueObj; + Tcl_Obj *newValueObj; if (objc == 3) { if (Tcl_GetDoubleFromObj(interp, objv[2], &stepAmount) != TCL_OK) { @@ -424,7 +448,7 @@ static int ProgressbarStepCommand( TtkRedisplayWidget(&pb->core); - /* Update value by setting the linked -variable, if there is one: + /* Update value by setting the linked -variable, if there is one: */ if (pb->progress.variableTrace) { return Tcl_ObjSetVar2( @@ -444,7 +468,7 @@ static int ProgressbarStepCommand( } /* $sb start|stop ?args? -- - * Change [$sb $cmd ...] to [ttk::progressbar::$cmd ...] + * Change [$sb $cmd ...] to [ttk::progressbar::$cmd ...] * and pass to interpreter. */ static int ProgressbarStartStopCommand( @@ -522,7 +546,8 @@ TTK_END_LAYOUT TTK_BEGIN_LAYOUT(HorizontalProgressbarLayout) TTK_GROUP("Horizontal.Progressbar.trough", TTK_FILL_BOTH, - TTK_NODE("Horizontal.Progressbar.pbar", TTK_PACK_LEFT|TTK_FILL_Y)) + TTK_NODE("Horizontal.Progressbar.pbar", TTK_PACK_LEFT|TTK_FILL_Y) + TTK_NODE("Horizontal.Progressbar.text", TTK_PACK_LEFT)) TTK_END_LAYOUT /* diff --git a/generic/ttk/ttkScale.c b/generic/ttk/ttkScale.c index 69753d1..95824af 100644 --- a/generic/ttk/ttkScale.c +++ b/generic/ttk/ttkScale.c @@ -46,14 +46,14 @@ typedef struct static Tk_OptionSpec ScaleOptionSpecs[] = { {TK_OPTION_STRING, "-command", "command", "Command", "", - Tk_Offset(Scale,scale.commandObj), -1, + Tk_Offset(Scale,scale.commandObj), -1, TK_OPTION_NULL_OK,0,0}, {TK_OPTION_STRING, "-variable", "variable", "Variable", "", - Tk_Offset(Scale,scale.variableObj), -1, + Tk_Offset(Scale,scale.variableObj), -1, 0,0,0}, {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", "horizontal", Tk_Offset(Scale,scale.orientObj), - Tk_Offset(Scale,scale.orient), 0, + Tk_Offset(Scale,scale.orient), 0, (ClientData)ttkOrientStrings, STYLE_CHANGED }, {TK_OPTION_DOUBLE, "-from", "from", "From", "0", @@ -63,7 +63,7 @@ static Tk_OptionSpec ScaleOptionSpecs[] = {TK_OPTION_DOUBLE, "-value", "value", "Value", "0", Tk_Offset(Scale,scale.valueObj), -1, 0, 0, 0}, {TK_OPTION_PIXELS, "-length", "length", "Length", - DEF_SCALE_LENGTH, Tk_Offset(Scale,scale.lengthObj), -1, 0, 0, + DEF_SCALE_LENGTH, Tk_Offset(Scale,scale.lengthObj), -1, 0, 0, GEOMETRY_CHANGED}, WIDGET_TAKEFOCUS_TRUE, @@ -76,7 +76,7 @@ static double PointToValue(Scale *scalePtr, int x, int y); /* ScaleVariableChanged -- * Variable trace procedure for scale -variable; * Updates the scale's value. - * If the linked variable is not a valid double, + * If the linked variable is not a valid double, * sets the 'invalid' state. */ static void ScaleVariableChanged(void *recordPtr, const char *value) @@ -172,7 +172,7 @@ static int ScalePostConfigure( /* ScaleGetLayout -- * getLayout hook. */ -static Ttk_Layout +static Ttk_Layout ScaleGetLayout(Tcl_Interp *interp, Ttk_Theme theme, void *recordPtr) { Scale *scalePtr = recordPtr; @@ -236,7 +236,7 @@ static double ScaleFraction(Scale *scalePtr, double value) } /* $scale get ?x y? -- - * Returns the current value of the scale widget, or if $x and + * Returns the current value of the scale widget, or if $x and * $y are specified, the value represented by point @x,y. */ static int diff --git a/generic/ttk/ttkScrollbar.c b/generic/ttk/ttkScrollbar.c index 5b0c212..9d99ea5 100644 --- a/generic/ttk/ttkScrollbar.c +++ b/generic/ttk/ttkScrollbar.c @@ -22,7 +22,7 @@ typedef struct double first; /* top fraction */ double last; /* bottom fraction */ - Ttk_Box troughBox; /* trough parcel */ + Ttk_Box troughBox; /* trough parcel */ int minSize; /* minimum size of thumb */ } ScrollbarPart; @@ -50,7 +50,7 @@ static Tk_OptionSpec ScrollbarOptionSpecs[] = * +++ Widget hooks. */ -static void +static void ScrollbarInitialize(Tcl_Interp *interp, void *recordPtr) { Scrollbar *sb = recordPtr; @@ -241,7 +241,7 @@ ScrollbarDeltaCommand( /* $sb fraction $x $y -- * Returns a real number between 0 and 1 indicating where the - * point given by x and y lies in the trough area of the scrollbar. + * point given by x and y lies in the trough area of the scrollbar. */ static int ScrollbarFractionCommand( diff --git a/generic/ttk/ttkSquare.c b/generic/ttk/ttkSquare.c index d002f2f..7837310 100644 --- a/generic/ttk/ttkSquare.c +++ b/generic/ttk/ttkSquare.c @@ -56,24 +56,24 @@ static Tk_OptionSpec SquareOptionSpecs[] = {TK_OPTION_BORDER, "-foreground", "foreground", "Foreground", DEFAULT_BACKGROUND, Tk_Offset(Square,square.foregroundObj), -1, 0, 0, 0}, - + {TK_OPTION_PIXELS, "-width", "width", "Width", "50", Tk_Offset(Square,square.widthObj), -1, 0, 0, GEOMETRY_CHANGED}, {TK_OPTION_PIXELS, "-height", "height", "Height", "50", Tk_Offset(Square,square.heightObj), -1, 0, 0, GEOMETRY_CHANGED}, - + {TK_OPTION_STRING, "-padding", "padding", "Pad", NULL, - Tk_Offset(Square,square.paddingObj), -1, + Tk_Offset(Square,square.paddingObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, - + {TK_OPTION_RELIEF, "-relief", "relief", "Relief", NULL, Tk_Offset(Square,square.reliefObj), -1, TK_OPTION_NULL_OK, 0, 0}, - + {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", NULL, Tk_Offset(Square,square.anchorObj), -1, TK_OPTION_NULL_OK, 0, 0}, - + WIDGET_TAKEFOCUS_TRUE, WIDGET_INHERIT_OPTIONS(ttkCoreOptionSpecs) }; @@ -138,7 +138,7 @@ static const Ttk_Ensemble SquareCommands[] = { }; /* - * The Widget specification structure holds all the implementation + * The Widget specification structure holds all the implementation * information about this widget and this is what must be registered * with Tk in the package initialization code (see bottom). */ @@ -159,7 +159,7 @@ static WidgetSpec SquareWidgetSpec = TtkWidgetDisplay /* displayProc */ }; -/* ---------------------------------------------------------------------- +/* ---------------------------------------------------------------------- * Square element * * In this section we demonstrate what is required to create a new themed @@ -176,7 +176,7 @@ typedef struct Tcl_Obj *heightObj; } SquareElement; -static Ttk_ElementOptionSpec SquareElementOptions[] = +static Ttk_ElementOptionSpec SquareElementOptions[] = { { "-background", TK_OPTION_BORDER, Tk_Offset(SquareElement,borderObj), DEFAULT_BACKGROUND }, @@ -248,7 +248,7 @@ static Ttk_ElementSpec SquareElementSpec = * engine is similar to the Tk pack geometry manager. Read the documentation * for the details. In this example we just need to have the square element * that has been defined for this widget placed on a background. We will - * also need some padding to keep it away from the edges. + * also need some padding to keep it away from the edges. */ TTK_BEGIN_LAYOUT(SquareLayout) @@ -257,12 +257,12 @@ TTK_BEGIN_LAYOUT(SquareLayout) TTK_NODE("Square.square", 0)) TTK_END_LAYOUT -/* ---------------------------------------------------------------------- +/* ---------------------------------------------------------------------- * * Widget initialization. * * This file defines a new element and a new widget. We need to register - * the element with the themes that will need it. In this case we will + * the element with the themes that will need it. In this case we will * register with the default theme that is the root of the theme inheritance * tree. This means all themes will find this element. * We then need to register the widget class style. This is the layout @@ -287,10 +287,10 @@ TtkSquareWidget_Init(Tcl_Interp *interp) /* register the new elements for this theme engine */ Ttk_RegisterElement(interp, theme, "square", &SquareElementSpec, NULL); - + /* register the layout for this theme */ Ttk_RegisterLayout(theme, "TSquare", SquareLayout); - + /* register the widget */ RegisterWidget(interp, "ttk::square", &SquareWidgetSpec); diff --git a/generic/ttk/ttkStubLib.c b/generic/ttk/ttkStubLib.c index 2c07b9d..c17f1e9 100644 --- a/generic/ttk/ttkStubLib.c +++ b/generic/ttk/ttkStubLib.c @@ -67,7 +67,7 @@ error: "Error loading ", packageName, " package", " (requested version '", version, "', loaded version '", actualVersion, "'): ", - errMsg, + errMsg, NULL); return NULL; } diff --git a/generic/ttk/ttkTagSet.c b/generic/ttk/ttkTagSet.c index f2108b9..31798ea 100644 --- a/generic/ttk/ttkTagSet.c +++ b/generic/ttk/ttkTagSet.c @@ -188,7 +188,7 @@ int Ttk_TagSetAdd(Ttk_TagSet tagset, Ttk_Tag tag) return 0; } } - tagset->tags = ckrealloc(tagset->tags, + tagset->tags = ckrealloc(tagset->tags, (tagset->nTags+1)*sizeof(tagset->tags[0])); tagset->tags[tagset->nTags++] = tag; return 1; diff --git a/generic/ttk/ttkTrace.c b/generic/ttk/ttkTrace.c index ba66db4..c0f17cf 100644 --- a/generic/ttk/ttkTrace.c +++ b/generic/ttk/ttkTrace.c @@ -3,7 +3,7 @@ * * Simplified interface to Tcl_TraceVariable. * - * PROBLEM: Can't distinguish "variable does not exist" (which is OK) + * PROBLEM: Can't distinguish "variable does not exist" (which is OK) * from other errors (which are not). */ diff --git a/generic/ttk/ttkWidget.h b/generic/ttk/ttkWidget.h index e4dd712..798bcce 100644 --- a/generic/ttk/ttkWidget.h +++ b/generic/ttk/ttkWidget.h @@ -111,8 +111,8 @@ MODULE_SCOPE int TtkWidgetConstructorObjCmd( /* WIDGET_TAKEFOCUS_TRUE -- * WIDGET_TAKEFOCUS_FALSE -- - * Add one or the other of these to each OptionSpecs table - * to indicate whether the widget should take focus + * Add one or the other of these to each OptionSpecs table + * to indicate whether the widget should take focus * during keyboard traversal. */ #define WIDGET_TAKEFOCUS_TRUE \ |