Skip to content

Commit

Permalink
Merge 9.0
Browse files Browse the repository at this point in the history
  • Loading branch information
jan.nijtmans committed Feb 21, 2025
2 parents 3bd9653 + 78c9b63 commit 6e155c8
Show file tree
Hide file tree
Showing 8 changed files with 47 additions and 75 deletions.
4 changes: 2 additions & 2 deletions .github/workflows/mac-build.yml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ env:
ERROR_ON_FAILURES: 1
jobs:
xcode:
runs-on: macos-14
runs-on: macos-15
defaults:
run:
shell: bash
Expand Down Expand Up @@ -57,7 +57,7 @@ jobs:
fi
timeout-minutes: 30
clang:
runs-on: macos-14
runs-on: macos-15
strategy:
matrix:
symbols:
Expand Down
8 changes: 4 additions & 4 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,10 +10,10 @@ site](https://sourceforge.net/projects/tcl/files/Tcl/).
[![Build Status](https://github.com/tcltk/tk/actions/workflows/win-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tk/actions/workflows/win-build.yml?query=branch%3Amain)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/mac-build.yml/badge.svg?branch=main)](https://github.com/tcltk/tk/actions/workflows/mac-build.yml?query=branch%3Amain)
<br>
8.7 (in development, daily build)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/linux-build.yml/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tk/actions/workflows/linux-build.yml?query=branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/win-build.yml/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tk/actions/workflows/win-build.yml?query=branch%3Acore-8-branch)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/mac-build.yml/badge.svg?branch=core-8-branch)](https://github.com/tcltk/tk/actions/workflows/mac-build.yml?query=branch%3Acore-8-branch)
8.6 (legacy release, daily build)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/linux-build.yml/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tk/actions/workflows/linux-build.yml?query=branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/win-build.yml/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tk/actions/workflows/win-build.yml?query=branch%3Acore-8-6-branch)
[![Build Status](https://github.com/tcltk/tk/actions/workflows/mac-build.yml/badge.svg?branch=core-8-6-branch)](https://github.com/tcltk/tk/actions/workflows/mac-build.yml?query=branch%3Acore-8-6-branch)

## <a id="intro">1.</a> Introduction

Expand Down
52 changes: 31 additions & 21 deletions generic/tkConfig.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,6 @@ static Tcl_Obj * GetObjectForOption(void *recordPtr,
static Option * GetOption(const char *name, OptionTable *tablePtr);
static Option * GetOptionFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, OptionTable *tablePtr);
static int ObjectIsEmpty(Tcl_Obj *objPtr);
static void FreeOptionInternalRep(Tcl_Obj *objPtr);
static void DupOptionInternalRep(Tcl_Obj *, Tcl_Obj *);

Expand Down Expand Up @@ -630,7 +629,7 @@ DoObjConfig(
case TK_OPTION_BOOLEAN: {
int newBool;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newBool = -1;
} else if (Tcl_GetBooleanFromObj(nullOK ? NULL : interp, valuePtr, &newBool) != TCL_OK) {
Expand Down Expand Up @@ -662,7 +661,7 @@ DoObjConfig(
int newInt;

if ((optionPtr->specPtr->flags & TYPE_MASK) == 0) {
if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newInt = INT_MIN;
} else if (Tcl_GetIntFromObj(nullOK ? NULL : interp, valuePtr, &newInt) != TCL_OK) {
Expand All @@ -680,7 +679,7 @@ DoObjConfig(
}
} else if ((optionPtr->specPtr->flags & TYPE_MASK) == TYPE_MASK) {
Tcl_WideInt newWideInt;
if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newWideInt = (sizeof(long) > sizeof(int)) ? LONG_MIN : LLONG_MIN;
} else if (Tcl_GetWideIntFromObj(nullOK ? NULL : interp, valuePtr, &newWideInt) != TCL_OK) {
Expand Down Expand Up @@ -724,7 +723,7 @@ DoObjConfig(
case TK_OPTION_DOUBLE: {
double newDbl;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
#if defined(NAN)
newDbl = NAN;
Expand Down Expand Up @@ -756,7 +755,7 @@ DoObjConfig(
const char *value;
Tcl_Size length;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
}
if (internalPtr != NULL) {
Expand All @@ -775,7 +774,7 @@ DoObjConfig(
case TK_OPTION_STRING_TABLE: {
int newValue;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newValue = -1;
} else {
Expand Down Expand Up @@ -810,7 +809,7 @@ DoObjConfig(
case TK_OPTION_COLOR: {
XColor *newPtr;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newPtr = NULL;
} else {
Expand All @@ -828,7 +827,7 @@ DoObjConfig(
case TK_OPTION_FONT: {
Tk_Font newFont;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newFont = NULL;
} else {
Expand All @@ -846,7 +845,7 @@ DoObjConfig(
case TK_OPTION_STYLE: {
Tk_Style newStyle;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newStyle = NULL;
} else {
Expand All @@ -864,7 +863,7 @@ DoObjConfig(
case TK_OPTION_BITMAP: {
Pixmap newBitmap;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newBitmap = None;
} else {
Expand All @@ -882,7 +881,7 @@ DoObjConfig(
case TK_OPTION_BORDER: {
Tk_3DBorder newBorder;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newBorder = NULL;
} else {
Expand All @@ -900,7 +899,7 @@ DoObjConfig(
case TK_OPTION_RELIEF: {
int newRelief;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newRelief = TK_RELIEF_NULL;
} else if (Tcl_GetIndexFromObj(interp, valuePtr, tkReliefStrings,
Expand Down Expand Up @@ -932,7 +931,7 @@ DoObjConfig(
case TK_OPTION_CURSOR: {
Tk_Cursor newCursor;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
newCursor = NULL;
valuePtr = NULL;
} else {
Expand All @@ -951,7 +950,7 @@ DoObjConfig(
case TK_OPTION_JUSTIFY: {
int newJustify;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newJustify = -1;
} else if (Tcl_GetIndexFromObj(interp, valuePtr, tkJustifyStrings,
Expand Down Expand Up @@ -983,7 +982,7 @@ DoObjConfig(
case TK_OPTION_ANCHOR: {
int newAnchor;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newAnchor = -1;
} else if (Tcl_GetIndexFromObj(interp, valuePtr, tkAnchorStrings,
Expand Down Expand Up @@ -1015,7 +1014,7 @@ DoObjConfig(
case TK_OPTION_PIXELS: {
int newPixels;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newPixels = INT_MIN;
} else if (Tk_GetPixelsFromObj(nullOK ? NULL : interp, tkwin, valuePtr,
Expand All @@ -1036,7 +1035,7 @@ DoObjConfig(
case TK_OPTION_WINDOW: {
Tk_Window newWin;

if (nullOK && ObjectIsEmpty(valuePtr)) {
if (nullOK && TkObjIsEmpty(valuePtr)) {
valuePtr = NULL;
newWin = NULL;
} else if (TkGetWindowFromObj(interp, tkwin, valuePtr,
Expand Down Expand Up @@ -1093,7 +1092,7 @@ DoObjConfig(
/*
*----------------------------------------------------------------------
*
* ObjectIsEmpty --
* TkObjIsEmpty --
*
* This function tests whether the string value of an object is empty.
*
Expand All @@ -1107,14 +1106,25 @@ DoObjConfig(
*----------------------------------------------------------------------
*/

static int
ObjectIsEmpty(
#if defined(USE_TCL_STUBS)
# undef Tcl_IsEmpty
# define Tcl_IsEmpty \
((int (*)(Tcl_Obj *))(void *)((&(tclStubsPtr->tcl_PkgProvideEx))[690]))
#endif

int
TkObjIsEmpty(
Tcl_Obj *objPtr) /* Object to test. May be NULL. */
{
if (objPtr == NULL) {
return 1;
}
if (objPtr->bytes == NULL) {
#if defined(USE_TCL_STUBS)
if (Tcl_IsEmpty) {
return Tcl_IsEmpty(objPtr);
}
#endif
Tcl_GetString(objPtr);
}
return (objPtr->length == 0);
Expand Down
1 change: 1 addition & 0 deletions generic/tkInt.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1261,6 +1261,7 @@ MODULE_SCOPE Tcl_Command TkMakeEnsemble(Tcl_Interp *interp,
const char *nsname, const char *name,
void *clientData, const TkEnsemble *map);
MODULE_SCOPE double TkScalingLevel(Tk_Window tkwin);
MODULE_SCOPE int TkObjIsEmpty(Tcl_Obj *objPtr);
MODULE_SCOPE int TkInitTkCmd(Tcl_Interp *interp,
void *clientData);
MODULE_SCOPE int TkInitFontchooser(Tcl_Interp *interp,
Expand Down
34 changes: 1 addition & 33 deletions generic/tkPanedWindow.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -227,7 +227,6 @@ static void AdjustForSticky(int sticky, int cavityWidth,
int cavityHeight, int *xPtr, int *yPtr,
int *paneWidthPtr, int *paneHeightPtr);
static void MoveSash(PanedWindow *pwPtr, int sash, int diff);
static int ObjectIsEmpty(Tcl_Obj *objPtr);
static void * ComputeSlotAddress(void *recordPtr, Tcl_Size offset);
static int PanedWindowIdentifyCoords(PanedWindow *pwPtr,
Tcl_Interp *interp, int x, int y);
Expand Down Expand Up @@ -2502,7 +2501,7 @@ SetSticky(

internalPtr = ComputeSlotAddress(recordPtr, internalOffset);

if (flags & TK_OPTION_NULL_OK && ObjectIsEmpty(*value)) {
if (flags & TK_OPTION_NULL_OK && TkObjIsEmpty(*value)) {
*value = NULL;
} else {
/*
Expand Down Expand Up @@ -3027,37 +3026,6 @@ PanedWindowProxyCommand(
return TCL_OK;
}

/*
*----------------------------------------------------------------------
*
* ObjectIsEmpty --
*
* This function tests whether the string value of an object is empty.
*
* Results:
* The return value is 1 if the string value of objPtr has length zero,
* and 0 otherwise.
*
* Side effects:
* May cause object shimmering, since this function can force a
* conversion to a string object.
*
*----------------------------------------------------------------------
*/

static int
ObjectIsEmpty(
Tcl_Obj *objPtr) /* Object to test. May be NULL. */
{
if (objPtr == NULL) {
return 1;
}
if (objPtr->bytes == NULL) {
Tcl_GetString(objPtr);
}
return (objPtr->length == 0);
}

/*
*----------------------------------------------------------------------
*
Expand Down
13 changes: 3 additions & 10 deletions generic/tkText.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8151,7 +8151,7 @@ TkTextInspectOptions(
Tcl_Obj *nameObj;
int myFlags = flags;

if (GetByteLength(valObj) == 0) {
if (TkObjIsEmpty(valObj)) {
continue;
}

Expand Down Expand Up @@ -11324,13 +11324,6 @@ GetTextStartEnd(
*----------------------------------------------------------------------
*/

static int
ObjectIsEmpty(
Tcl_Obj *objPtr) /* Object to test. May be NULL. */
{
return objPtr ? GetByteLength(objPtr) == 0 : 1;
}

static int
SetTextStartEnd(
TCL_UNUSED(void *),
Expand All @@ -11352,7 +11345,7 @@ SetTextStartEnd(
assert(!*objPtr);
*oldObjPtr = NULL;

if ((flags & TK_OPTION_NULL_OK) && ObjectIsEmpty(*value)) {
if ((flags & TK_OPTION_NULL_OK) && TkObjIsEmpty(*value)) {
*value = NULL;
*objPtr = Tcl_NewStringObj((objPtr == &textPtr->newStartIndex) ? "begin" : "end", TCL_INDEX_NONE);
} else {
Expand Down Expand Up @@ -11503,7 +11496,7 @@ SetLineStartEnd(
internalPtr = NULL;
}

if ((flags & TK_OPTION_NULL_OK) && ObjectIsEmpty(*value)) {
if ((flags & TK_OPTION_NULL_OK) && TkObjIsEmpty(*value)) {
*value = NULL;
} else {
int line;
Expand Down
6 changes: 3 additions & 3 deletions tests/config.test
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1117,22 +1117,22 @@ test config-4.115 {DoObjConfig - custom internal value} -constraints {
} -result {THIS IS A TEST}


test config-5.1 {ObjectIsEmpty - object is already string} -constraints {
test config-5.1 {TkObjIsEmpty - object is already string} -constraints {
testobjconfig
} -body {
testobjconfig alltypes .foo -color [format ""]
.foo cget -color
} -cleanup {
killTables
} -result {}
test config-5.2 {ObjectIsEmpty - object is already string} -constraints {
test config-5.2 {TkObjIsEmpty - object is already string} -constraints {
testobjconfig
} -body {
testobjconfig alltypes .foo -color [format " "]
} -cleanup {
killTables
} -returnCodes error -result {unknown color name " "}
test config-5.3 {ObjectIsEmpty - must convert back to string} -constraints {
test config-5.3 {TkObjIsEmpty - must convert back to string} -constraints {
testobjconfig
} -body {
testobjconfig alltypes .foo -color [list]
Expand Down
4 changes: 2 additions & 2 deletions tests/focus.test
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,13 +46,13 @@ proc focusClear {} {
dobg {after 200; focus -force .; update}
after 400
if {[tk windowingsystem] eq "aqua"} {
# In Aqua we need to explicitly wait until focus is cleared.
# In Aqua we need to explicitly wait until focus is cleared.
while {[focus] != ""} {
after 100 {set y 1}
tkwait variable y
}
}

update
}

Expand Down

0 comments on commit 6e155c8

Please sign in to comment.