From 1d0390ab1fbd8c026186ce4b9a747d4b35192bf8 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Wed, 10 Jul 2024 22:05:27 +0000
Subject: (backport) Add TkLengthOne() function, just as TclLengthOne() in Tcl,
 for optimization within Tk internal objTypes. Only functional when compiling
 with Tcl 9.0 headers

---
 generic/tkColor.c  |  2 +-
 generic/tkCursor.c |  2 +-
 generic/tkInt.h    |  4 ++++
 generic/tkObj.c    | 11 +++++++++--
 4 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/generic/tkColor.c b/generic/tkColor.c
index b23255e..baff5e7 100644
--- a/generic/tkColor.c
+++ b/generic/tkColor.c
@@ -62,7 +62,7 @@ const TkObjType tkColorObjType = {
     DupColorObjProc,		/* dupIntRepProc */
     NULL,			/* updateStringProc */
     NULL,			/* setFromAnyProc */
-    TCL_OBJTYPE_V0},
+    TCL_OBJTYPE_V1(TkLengthOne)},
     0
 };
 
diff --git a/generic/tkCursor.c b/generic/tkCursor.c
index 9785470..1bed0c4 100644
--- a/generic/tkCursor.c
+++ b/generic/tkCursor.c
@@ -65,7 +65,7 @@ const TkObjType tkCursorObjType = {
     DupCursorObjProc,		/* dupIntRepProc */
     NULL,			/* updateStringProc */
     NULL,			/* setFromAnyProc */
-    TCL_OBJTYPE_V0},
+    TCL_OBJTYPE_V1(TkLengthOne)},
     0
 };
 
diff --git a/generic/tkInt.h b/generic/tkInt.h
index dc2347c..5ee4791 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -1138,6 +1138,9 @@ typedef struct {
 #ifndef TCL_OBJTYPE_V0
 #   define TCL_OBJTYPE_V0 /* just empty */
 #endif
+#ifndef TCL_OBJTYPE_V1
+#   define TCL_OBJTYPE_V1(lengthProc) /* just empty */
+#endif
 
 MODULE_SCOPE const TkObjType tkBorderObjType;
 MODULE_SCOPE const TkObjType tkBitmapObjType;
@@ -1330,6 +1333,7 @@ MODULE_SCOPE void	TkpDrawFrameEx(Tk_Window tkwin, Drawable drawable,
 			    int borderWidth, int relief);
 MODULE_SCOPE void	TkpShowBusyWindow(TkBusy busy);
 MODULE_SCOPE void	TkpHideBusyWindow(TkBusy busy);
+MODULE_SCOPE Tcl_Size	TkLengthOne(Tcl_Obj *);
 MODULE_SCOPE void	TkpMakeTransparentWindowExist(Tk_Window tkwin,
 			    Window parent);
 MODULE_SCOPE void	TkpCreateBusy(Tk_FakeWin *winPtr, Tk_Window tkRef,
diff --git a/generic/tkObj.c b/generic/tkObj.c
index 2eadff3..170f7d0 100644
--- a/generic/tkObj.c
+++ b/generic/tkObj.c
@@ -137,10 +137,17 @@ static const TkObjType pixelObjType = {
     DupPixelInternalRep,	/* dupIntRepProc */
     NULL,			/* updateStringProc */
     NULL,			/* setFromAnyProc */
-    TCL_OBJTYPE_V0},
+    TCL_OBJTYPE_V1(TkLengthOne)},
     0
 };
 
+Tcl_Size
+TkLengthOne(
+    TCL_UNUSED(Tcl_Obj *))
+{
+    return 1;
+}
+
 /*
  * The following structure defines the implementation of the "pixel" Tcl
  * object, used for measuring distances. The pixel object remembers its
@@ -153,7 +160,7 @@ static const TkObjType mmObjType = {
     DupMMInternalRep,		/* dupIntRepProc */
     UpdateStringOfMM,		/* updateStringProc */
     NULL,			/* setFromAnyProc */
-    TCL_OBJTYPE_V0},
+    TCL_OBJTYPE_V1(TkLengthOne)},
     0
 };
 
-- 
cgit v0.12