From 81a0658d2cbb4ec2c227cd0304bdafbb74b23170 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:00:00 +0100 Subject: [PATCH 01/20] TCL9: magic.h ClientData type change helper macros Now a (void *) but previously an integer. These macros resolve the codebase allowing it to be built against both tcl8 (8.5, 8.6) and tcl9 (9.0). tar -zxvf tcl9.0.0-src.tar.gz cd tcl9.0.0/unix ./configure --enable-symbols --prefix=/opt/tktcl9 make install tar -zxvf tk9.0.0-src.tar.gz cd tk9.0.0/unix ./configure --enable-symbols --prefix=/opt/tktcl9 --with-tcl=/opt/tktcl9/lib make install cd magic ./configure --with-tk=/opt/tktcl9/lib --with-tcl=/opt/tktcl9/lib --- utils/magic.h | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/utils/magic.h b/utils/magic.h index 0dcda8e9..44934239 100644 --- a/utils/magic.h +++ b/utils/magic.h @@ -63,6 +63,16 @@ typedef int64_t dlong; typedef pointertype ClientData; #endif +/* this is not the (int) C type, but the conceptual difference between + * a pointer and an integer. The integer width uses same size as pointer + * width, so integer width truncations need to be applied at usage site. + */ +#define CD2PTR(cd) ((void*)(cd)) +#define CD2INT(cd) ((pointertype)(cd)) + +#define PTR2CD(data) ((ClientData)(data)) +#define INT2CD(data) ((ClientData)(pointertype)(data)) + /* --------------------------- Booleans ------------------------------- */ typedef unsigned char bool; From be964a7bfa3214d889e4ea1aa4bc59425fdb7371 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:00:21 +0100 Subject: [PATCH 02/20] TCL9: _ANSI_ARGS_ compatibility macro removal --- graphics/grTkCommon.c | 40 ++++++++++++++++++++-------------------- oa/magicInit.h | 4 ++-- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/graphics/grTkCommon.c b/graphics/grTkCommon.c index 5a174249..f1f33474 100644 --- a/graphics/grTkCommon.c +++ b/graphics/grTkCommon.c @@ -745,19 +745,19 @@ typedef struct LayerInstance { * The type record for bitmap images: */ -static int ImgLayerCreate _ANSI_ARGS_((Tcl_Interp *interp, - CONST84 char *name, int argc, Tcl_Obj *const objv[], - CONST84 Tk_ImageType *typePtr, Tk_ImageMaster master, - ClientData *clientDataPtr)); -static ClientData ImgLayerGet _ANSI_ARGS_((Tk_Window tkwin, - ClientData clientData)); -static void ImgLayerDisplay _ANSI_ARGS_((ClientData clientData, +static int ImgLayerCreate (Tcl_Interp *interp, + const char *name, int argc, Tcl_Obj *const objv[], + const Tk_ImageType *typePtr, Tk_ImageMaster master, + ClientData *clientDataPtr); +static ClientData ImgLayerGet (Tk_Window tkwin, + ClientData clientData); +static void ImgLayerDisplay (ClientData clientData, Display *display, Drawable drawable, int imageX, int imageY, int width, int height, - int drawableX, int drawableY)); -static void ImgLayerFree _ANSI_ARGS_((ClientData clientData, - Display *display)); -static void ImgLayerDelete _ANSI_ARGS_((ClientData clientData)); + int drawableX, int drawableY); +static void ImgLayerFree (ClientData clientData, + Display *display); +static void ImgLayerDelete (ClientData clientData); Tk_ImageType tkLayerImageType = { "layer", /* name */ @@ -794,15 +794,15 @@ static Tk_ConfigSpec configSpecs[] = { * Prototypes for procedures used only locally in this file: */ -static int ImgLayerCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, Tcl_Obj *CONST objv[])); -static void ImgLayerCmdDeletedProc _ANSI_ARGS_(( - ClientData clientData)); -static void ImgLayerConfigureInstance _ANSI_ARGS_(( - LayerInstance *instancePtr)); -static int ImgLayerConfigureMaster _ANSI_ARGS_(( - LayerMaster *masterPtr, int argc, Tcl_Obj *CONST objv[], - int flags)); +static int ImgLayerCmd (ClientData clientData, + Tcl_Interp *interp, int argc, Tcl_Obj *const objv[]); +static void ImgLayerCmdDeletedProc ( + ClientData clientData); +static void ImgLayerConfigureInstance ( + LayerInstance *instancePtr); +static int ImgLayerConfigureMaster ( + LayerMaster *masterPtr, int argc, Tcl_Obj *const objv[], + int flags); /* *---------------------------------------------------------------------- diff --git a/oa/magicInit.h b/oa/magicInit.h index dea0a337..68da7adf 100644 --- a/oa/magicInit.h +++ b/oa/magicInit.h @@ -27,8 +27,8 @@ extern FILE *REX_debug_file; #define USE_TCL_STUBS 1 -#define TCL_ARGS _ANSI_ARGS_((ClientData clientData, \ - Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv)) +#define TCL_ARGS (ClientData clientData, \ + Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv) #define TCLENTRY() {REX_interp = interp;} From f3f4bd6904cf318ab98c80d9f311e09c6b025069 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:00:44 +0100 Subject: [PATCH 03/20] TCL9: Tk_Offset() macro removal Modern compiler have support for 'offsetof' keyword. --- graphics/grTkCommon.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/graphics/grTkCommon.c b/graphics/grTkCommon.c index f1f33474..5edc4a15 100644 --- a/graphics/grTkCommon.c +++ b/graphics/grTkCommon.c @@ -777,15 +777,15 @@ Tk_ImageType tkLayerImageType = { static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_STRING, "-name", (char *) NULL, (char *) NULL, - (char *) NULL, Tk_Offset(LayerMaster, layerString), TK_CONFIG_NULL_OK}, + (char *) NULL, offsetof(LayerMaster, layerString), TK_CONFIG_NULL_OK}, {TK_CONFIG_BOOLEAN, "-disabled", (char *) NULL, (char *) NULL, - (char *) "0", Tk_Offset(LayerMaster, layerOff), 0}, + (char *) "0", offsetof(LayerMaster, layerOff), 0}, {TK_CONFIG_INT, "-icon", (char *) NULL, (char *) NULL, - (char *) "-1", Tk_Offset(LayerMaster, layerLock), 0}, + (char *) "-1", offsetof(LayerMaster, layerLock), 0}, {TK_CONFIG_INT, "-width", (char *) NULL, (char *) NULL, - (char *) "16", Tk_Offset(LayerMaster, width), 0}, + (char *) "16", offsetof(LayerMaster, width), 0}, {TK_CONFIG_INT, "-height", (char *) NULL, (char *) NULL, - (char *) "16", Tk_Offset(LayerMaster, height), 0}, + (char *) "16", offsetof(LayerMaster, height), 0}, {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL, (char *) NULL, 0, 0} }; From 2260376b4dd3b70410e9201c0b140e147f48d095 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:03:27 +0100 Subject: [PATCH 04/20] TCL9: CONST removal (all current compilers support const keyword) Legacy compiler support macro provided by TCL from a time when 'const' did not exist. --- graphics/grTkCommon.c | 6 +++--- tcltk/tclmagic.c | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/graphics/grTkCommon.c b/graphics/grTkCommon.c index 5edc4a15..dd337777 100644 --- a/graphics/grTkCommon.c +++ b/graphics/grTkCommon.c @@ -828,7 +828,7 @@ ImgLayerCreate(interp, name, argc, argv, typePtr, master, clientDataPtr) * image. */ const char *name; /* Name to use for image. */ int argc; /* Number of arguments. */ - Tcl_Obj *CONST argv[]; /* Argument objects for options (doesn't + Tcl_Obj *const argv[]; /* Argument objects for options (doesn't * include image name or type). */ const Tk_ImageType *typePtr;/* Pointer to our type record (not used). */ Tk_ImageMaster master; /* Token for image, to be used by us in @@ -881,7 +881,7 @@ ImgLayerConfigureMaster(masterPtr, objc, objv, flags) LayerMaster *masterPtr; /* Pointer to data structure describing * overall pixmap image to (reconfigure). */ int objc; /* Number of entries in objv. */ - Tcl_Obj *CONST objv[]; /* Pairs of configuration options for image. */ + Tcl_Obj *const objv[]; /* Pairs of configuration options for image. */ int flags; /* Flags to pass to Tk_ConfigureWidget, * such as TK_CONFIG_ARGV_ONLY. */ { @@ -1215,7 +1215,7 @@ ImgLayerCmd(clientData, interp, objc, objv) ClientData clientData; /* Information about the image master. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + Tcl_Obj *const objv[]; /* Argument objects. */ { static char *layerOptions[] = {"cget", "configure", (char *) NULL}; LayerMaster *masterPtr = (LayerMaster *) clientData; diff --git a/tcltk/tclmagic.c b/tcltk/tclmagic.c index 57de6176..3835ab5f 100644 --- a/tcltk/tclmagic.c +++ b/tcltk/tclmagic.c @@ -623,7 +623,7 @@ typedef struct FileState { static int _magic_flags(ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { int index, index2; bool value; From 683c50a1637da4895d76735bae4bf33bdf17b842 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:04:37 +0100 Subject: [PATCH 05/20] TCL9: CONST84 removal (all current compilers support const keyword) Legacy compiler support macro provided by TCL from a time when 'const' did not exist. This looks like it was put in place around the time of TCL 8.4 (from 2002 until 2013) which introduced APIs with 'const' types, that were previously non-const. Probably due to legacy compiler support across target platforms at the time. Since the minimum TCL level is hardwired to 8.5 (from 2007 until 2016) it does not seem like that compatiblity is a current requirement. --- graphics/grTkCommon.c | 4 ++-- tcltk/tclmagic.c | 6 +++--- tcltk/tclmagic.h | 6 ------ 3 files changed, 5 insertions(+), 11 deletions(-) diff --git a/graphics/grTkCommon.c b/graphics/grTkCommon.c index dd337777..a3c5a2ae 100644 --- a/graphics/grTkCommon.c +++ b/graphics/grTkCommon.c @@ -895,7 +895,7 @@ ImgLayerConfigureMaster(masterPtr, objc, objv, flags) argv[objc] = NULL; if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp), - configSpecs, objc, (CONST84 char **)argv, (char *) masterPtr, flags) + configSpecs, objc, (const char **)argv, (char *) masterPtr, flags) != TCL_OK) { Tcl_Free((char *) argv); return TCL_ERROR; @@ -1225,7 +1225,7 @@ ImgLayerCmd(clientData, interp, objc, objv) Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)layerOptions, + if (Tcl_GetIndexFromObj(interp, objv[1], (const char **)layerOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } diff --git a/tcltk/tclmagic.c b/tcltk/tclmagic.c index 3835ab5f..5bd20d5f 100644 --- a/tcltk/tclmagic.c +++ b/tcltk/tclmagic.c @@ -336,7 +336,7 @@ _tcl_dispatch(ClientData clientData, if (!strncmp(argv0, "::", 2)) argv0 += 2; objv0 = Tcl_NewStringObj(argv0, strlen(argv0)); - if (Tcl_GetIndexFromObj(interp, objv0, (CONST84 char **)conflicts, + if (Tcl_GetIndexFromObj(interp, objv0, (const char **)conflicts, "overloaded command", 0, &idx) == TCL_OK) { int i; @@ -636,7 +636,7 @@ _magic_flags(ClientData clientData, Tcl_WrongNumArgs(interp, 1, objv, "flag ?value?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], (CONST84 char **)flagOptions, + if (Tcl_GetIndexFromObj(interp, objv[1], (const char **)flagOptions, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } @@ -664,7 +664,7 @@ _magic_flags(ClientData clientData, Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); } else { - if (Tcl_GetIndexFromObj(interp, objv[2], (CONST84 char **)yesNo, + if (Tcl_GetIndexFromObj(interp, objv[2], (const char **)yesNo, "value", 0, &index2) != TCL_OK) return TCL_ERROR; diff --git a/tcltk/tclmagic.h b/tcltk/tclmagic.h index 423399dd..c9d411b2 100644 --- a/tcltk/tclmagic.h +++ b/tcltk/tclmagic.h @@ -28,11 +28,5 @@ extern int TagVerify(); extern int Tcl_printf(); extern void MakeWindowCommand(); -/* Backward compatibility issues */ -#ifndef CONST84 -#define CONST84 /* indicates something was changed to "const" */ - /* in Tcl version 8.4. */ -#endif - #endif /* MAGIC_WRAPPER */ #endif /* _TCLMAGIC_H */ From 5da000be4b3ca609cb86f11799d507d0ce63fd1a Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:04:38 +0100 Subject: [PATCH 06/20] TCL9: Tcl_xxxxxxx() API changes around Tcl_SaveResult() --- graphics/grTCairo1.c | 12 ++++++++++ graphics/grTOGL1.c | 12 ++++++++++ graphics/grTk1.c | 12 ++++++++++ tcltk/tclmagic.c | 56 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 92 insertions(+) diff --git a/graphics/grTCairo1.c b/graphics/grTCairo1.c index d0e1f2d5..8cee61b1 100644 --- a/graphics/grTCairo1.c +++ b/graphics/grTCairo1.c @@ -629,7 +629,11 @@ XEvent *xevent; if ((LocRedirect == TX_INPUT_REDIRECTED) && TxTkConsole) { +#if TCL_MAJOR_VERSION < 9 Tcl_SavedResult state; +#else + Tcl_InterpState state; +#endif static char outstr[] = "::tkcon::Insert .text \"x\" "; switch (keysym) @@ -644,12 +648,20 @@ XEvent *xevent; TxInputRedirect = TX_INPUT_NORMAL; TxSetPrompt('%'); +#if TCL_MAJOR_VERSION < 9 Tcl_SaveResult(magicinterp, &state); +#else + state = Tcl_SaveInterpState(magicinterp, TCL_OK); +#endif Tcl_EvalEx(magicinterp, "history event 0", 15, 0); MacroDefine(mw->w_client, (int)'.', Tcl_GetStringResult(magicinterp), NULL, FALSE); +#if TCL_MAJOR_VERSION < 9 Tcl_RestoreResult(magicinterp, &state); +#else + Tcl_RestoreInterpState(magicinterp, state); +#endif break; case XK_Up: Tcl_EvalEx(consoleinterp, "::tkcon::Event -1", diff --git a/graphics/grTOGL1.c b/graphics/grTOGL1.c index c518bb55..bb1b0354 100644 --- a/graphics/grTOGL1.c +++ b/graphics/grTOGL1.c @@ -634,7 +634,11 @@ TOGLEventProc(clientData, xevent) if ((LocRedirect == TX_INPUT_REDIRECTED) && TxTkConsole) { +#if TCL_MAJOR_VERSION < 9 Tcl_SavedResult state; +#else + Tcl_InterpState state; +#endif static char outstr[] = "::tkcon::Insert .text \"x\" "; switch (keysym) @@ -649,12 +653,20 @@ TOGLEventProc(clientData, xevent) TxInputRedirect = TX_INPUT_NORMAL; TxSetPrompt('%'); +#if TCL_MAJOR_VERSION < 9 Tcl_SaveResult(magicinterp, &state); +#else + state = Tcl_SaveInterpState(magicinterp, TCL_OK); +#endif Tcl_EvalEx(magicinterp, "history event 0", 15, 0); MacroDefine(mw->w_client, (int)'.', Tcl_GetStringResult(magicinterp), NULL, FALSE); +#if TCL_MAJOR_VERSION < 9 Tcl_RestoreResult(magicinterp, &state); +#else + Tcl_RestoreInterpState(magicinterp, state); +#endif break; case XK_Up: Tcl_EvalEx(consoleinterp, "::tkcon::Event -1", diff --git a/graphics/grTk1.c b/graphics/grTk1.c index ada54efa..d5d3e32f 100644 --- a/graphics/grTk1.c +++ b/graphics/grTk1.c @@ -886,7 +886,11 @@ MagicEventProc(clientData, xevent) if ((LocRedirect == TX_INPUT_REDIRECTED) && TxTkConsole) { +#if TCL_MAJOR_VERSION < 9 Tcl_SavedResult state; +#else + Tcl_InterpState state; +#endif static char outstr[] = "::tkcon::Insert .text \"x\" "; /* Translate Control-H to BackSpace */ if ((keymod & ControlMask) && (keysym == XK_h)) @@ -904,13 +908,21 @@ MagicEventProc(clientData, xevent) TxInputRedirect = TX_INPUT_NORMAL; TxSetPrompt('%'); +#if TCL_MAJOR_VERSION < 9 Tcl_SaveResult(magicinterp, &state); +#else + state = Tcl_SaveInterpState(magicinterp, TCL_OK); +#endif Tcl_EvalEx(magicinterp, "history event 0", 15, 0); MacroDefine(mw->w_client, (int)'.', Tcl_GetStringResult(magicinterp), NULL, FALSE); +#if TCL_MAJOR_VERSION < 9 Tcl_RestoreResult(magicinterp, &state); +#else + Tcl_RestoreInterpState(magicinterp, state); +#endif break; case XK_Up: Tcl_EvalEx(consoleinterp, "::tckon::Event -1", diff --git a/tcltk/tclmagic.c b/tcltk/tclmagic.c index 5bd20d5f..1bae2395 100644 --- a/tcltk/tclmagic.c +++ b/tcltk/tclmagic.c @@ -104,7 +104,11 @@ TagCallback(interp, tkpath, argc, argv) char *postcmd, *substcmd, *newcmd, *sptr, *sres; char *croot; HashEntry *entry; +#if TCL_MAJOR_VERSION < 9 Tcl_SavedResult state; +#else + Tcl_InterpState state; +#endif bool reset = FALSE; int cmdnum; @@ -240,12 +244,28 @@ TagCallback(interp, tkpath, argc, argv) /* fprintf(stderr, "Substituted tag callback is \"%s\"\n", substcmd); */ /* fflush(stderr); */ +#if TCL_MAJOR_VERSION < 9 Tcl_SaveResult(interp, &state); +#else + state = Tcl_SaveInterpState(interp, TCL_OK); +#endif result = Tcl_EvalEx(interp, substcmd, -1, 0); if ((result == TCL_OK) && (reset == FALSE)) + { +#if TCL_MAJOR_VERSION < 9 Tcl_RestoreResult(interp, &state); +#else + Tcl_RestoreInterpState(interp, state); +#endif + } else + { +#if TCL_MAJOR_VERSION < 9 Tcl_DiscardResult(&state); +#else + Tcl_DiscardInterpState(state); +#endif + } freeMagic(substcmd); TxCommandNumber = cmdnum; /* restore original value */ @@ -858,15 +878,27 @@ void TxSetPrompt(ch) char ch; { +#if TCL_MAJOR_VERSION < 9 Tcl_SavedResult state; +#else + Tcl_InterpState state; +#endif char promptline[16]; if (TxTkConsole) { sprintf(promptline, "replaceprompt %c", ch); +#if TCL_MAJOR_VERSION < 9 Tcl_SaveResult(consoleinterp, &state); +#else + state = Tcl_SaveInterpState(consoleinterp, TCL_OK); +#endif Tcl_EvalEx(consoleinterp, promptline, 15, 0); +#if TCL_MAJOR_VERSION < 9 Tcl_RestoreResult(consoleinterp, &state); +#else + Tcl_RestoreInterpState(consoleinterp, state); +#endif } } @@ -979,11 +1011,23 @@ TxParseString(str, q, event) void TxFlushErr() { +#if TCL_MAJOR_VERSION < 9 Tcl_SavedResult state; +#else + Tcl_InterpState state; +#endif +#if TCL_MAJOR_VERSION < 9 Tcl_SaveResult(magicinterp, &state); +#else + state = Tcl_SaveInterpState(magicinterp, TCL_OK); +#endif Tcl_EvalEx(magicinterp, "::tcl_flush stderr", 18, 0); +#if TCL_MAJOR_VERSION < 9 Tcl_RestoreResult(magicinterp, &state); +#else + Tcl_RestoreInterpState(magicinterp, state); +#endif } /*--------------------------------------------------------------*/ @@ -991,11 +1035,23 @@ TxFlushErr() void TxFlushOut() { +#if TCL_MAJOR_VERSION < 9 Tcl_SavedResult state; +#else + Tcl_InterpState state; +#endif +#if TCL_MAJOR_VERSION < 9 Tcl_SaveResult(magicinterp, &state); +#else + state = Tcl_SaveInterpState(magicinterp, TCL_OK); +#endif Tcl_EvalEx(magicinterp, "::tcl_flush stdout", 18, 0); +#if TCL_MAJOR_VERSION < 9 Tcl_RestoreResult(magicinterp, &state); +#else + Tcl_RestoreInterpState(magicinterp, state); +#endif } /*--------------------------------------------------------------*/ From da7dcf977c7ce6ea4b924997d02874ab1730dcb0 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:07:16 +0100 Subject: [PATCH 07/20] TCL9: Tcl_Size type introduction --- tcltk/tclmagic.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/tcltk/tclmagic.c b/tcltk/tclmagic.c index 1bae2395..0c68de10 100644 --- a/tcltk/tclmagic.c +++ b/tcltk/tclmagic.c @@ -913,7 +913,12 @@ TxGetLinePfix(dest, maxChars, prefix) char *prefix; { Tcl_Obj *objPtr; - int charsStored, length; + int charsStored; +#if TCL_MAJOR_VERSION < 9 + int length; +#else + Tcl_Size length; +#endif char *string; if (TxTkConsole) From b53b6a95410628c4c1b9e1562014fe071454a751 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:10:00 +0100 Subject: [PATCH 08/20] TCL9: Tk_ConfigureWidget() function signature change --- graphics/grTkCommon.c | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/graphics/grTkCommon.c b/graphics/grTkCommon.c index a3c5a2ae..9b47be3c 100644 --- a/graphics/grTkCommon.c +++ b/graphics/grTkCommon.c @@ -888,19 +888,30 @@ ImgLayerConfigureMaster(masterPtr, objc, objv, flags) LayerInstance *instancePtr; int dummy1; - char **argv = (char **) Tcl_Alloc((objc+1) * sizeof(char *)); +#if TCL_MAJOR_VERSION < 9 + char **tmp_argv = (char **) Tcl_Alloc((objc+1) * sizeof(char *)); for (dummy1 = 0; dummy1 < objc; dummy1++) { - argv[dummy1]=Tcl_GetString(objv[dummy1]); + tmp_argv[dummy1]=Tcl_GetString(objv[dummy1]); } - argv[objc] = NULL; - + tmp_argv[objc] = NULL; + + int argc = objc; + const char **argv = (const char **)tmp_argv; +#else + Tcl_Size argc = objc; + Tcl_Obj *const *argv = (Tcl_Obj *const *)objv; +#endif if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp), - configSpecs, objc, (const char **)argv, (char *) masterPtr, flags) + configSpecs, argc, argv, (char *) masterPtr, flags) != TCL_OK) { - Tcl_Free((char *) argv); +#if TCL_MAJOR_VERSION < 9 + Tcl_Free((char *) tmp_argv); +#endif return TCL_ERROR; } - Tcl_Free((char *) argv); +#if TCL_MAJOR_VERSION < 9 + Tcl_Free((char *) tmp_argv); +#endif /* * Cycle through all of the instances of this image, regenerating From 532bab3ca28f9385da1e330c3c88de5f8c8ce76e Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:10:46 +0100 Subject: [PATCH 09/20] TCL9: plugin createProc() function signature change ImgLayerCreate() Tk_ImageType.createProc() uses new Tcl_Size type now. --- graphics/grTkCommon.c | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/graphics/grTkCommon.c b/graphics/grTkCommon.c index 9b47be3c..acba90e0 100644 --- a/graphics/grTkCommon.c +++ b/graphics/grTkCommon.c @@ -745,10 +745,17 @@ typedef struct LayerInstance { * The type record for bitmap images: */ +#if TCL_MAJOR_VERSION < 9 static int ImgLayerCreate (Tcl_Interp *interp, const char *name, int argc, Tcl_Obj *const objv[], const Tk_ImageType *typePtr, Tk_ImageMaster master, ClientData *clientDataPtr); +#else +static int ImgLayerCreate (Tcl_Interp *interp, + const char *name, Tcl_Size argc, Tcl_Obj *const objv[], + const Tk_ImageType *typePtr, Tk_ImageMaster master, + ClientData *clientDataPtr); +#endif static ClientData ImgLayerGet (Tk_Window tkwin, ClientData clientData); static void ImgLayerDisplay (ClientData clientData, @@ -827,7 +834,11 @@ ImgLayerCreate(interp, name, argc, argv, typePtr, master, clientDataPtr) Tcl_Interp *interp; /* Interpreter for application containing * image. */ const char *name; /* Name to use for image. */ +#if TCL_MAJOR_VERSION < 9 int argc; /* Number of arguments. */ +#else + Tcl_Size argc; /* Number of arguments. */ +#endif Tcl_Obj *const argv[]; /* Argument objects for options (doesn't * include image name or type). */ const Tk_ImageType *typePtr;/* Pointer to our type record (not used). */ From 5ca123fc70425f9289ba4e0985444c9233a79249 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:12:57 +0100 Subject: [PATCH 10/20] TCL9: ClientData macro header file changes Header files documentation indicates the macros are of type ClientData but previously did not cast to ensure that. So now follow this intention. --- mzrouter/mzInternal.h | 8 ++++++-- plow/plowInt.h | 6 +++--- router/rtrDcmpose.h | 6 +++--- tiles/tile.h | 6 +++--- 4 files changed, 15 insertions(+), 11 deletions(-) diff --git a/mzrouter/mzInternal.h b/mzrouter/mzInternal.h index 34725686..514282ea 100644 --- a/mzrouter/mzInternal.h +++ b/mzrouter/mzInternal.h @@ -39,6 +39,10 @@ * the head of that function. */ +#ifndef _MAGIC_H +#include "utils/magic.h" +#endif + #ifndef _MZROUTER_H #include "mzrouter/mzrouter.h" #endif @@ -86,8 +90,8 @@ extern ClientData mzDebugID; * electrically connected to specified start or dest regions. */ #define DEF_EXPAND_ENDPOINTS 1 -#define MZ_EXPAND_START 1 /* ClientData type for start tiles */ -#define MZ_EXPAND_DEST 0 /* ClientData type for dest tiles */ +#define MZ_EXPAND_START INT2CD(1) /* ClientData type for start tiles */ +#define MZ_EXPAND_DEST INT2CD(0) /* ClientData type for dest tiles */ #define MZ_EXPAND_NONE CLIENTDEFAULT /* Normal ClientData type */ /* If set only hints in toplevel cell are recognized - speeds up processing diff --git a/plow/plowInt.h b/plow/plowInt.h index 8aea6130..ee8eeb98 100644 --- a/plow/plowInt.h +++ b/plow/plowInt.h @@ -161,11 +161,11 @@ typedef struct * of the tile to its right. */ #define TRAIL_UNINIT CLIENTDEFAULT -#define TRAILING(tp) (((tp)->ti_client == (ClientData)TRAIL_UNINIT) \ - ? LEFT(tp) : ((int)(tp)->ti_client)) +#define TRAILING(tp) (((tp)->ti_client == INT2CD(TRAIL_UNINIT)) \ + ? LEFT(tp) : ((int)CD2INT((tp)->ti_client))) #define LEADING(tp) TRAILING(TR(tp)) -#define plowSetTrailing(tp, n) ((tp)->ti_client = (ClientData) (n)) +#define plowSetTrailing(tp, n) ((tp)->ti_client = INT2CD((n))) /* ------------------ Design rules used by plowing -------------------- */ diff --git a/router/rtrDcmpose.h b/router/rtrDcmpose.h index 24d115e0..40cda9ae 100644 --- a/router/rtrDcmpose.h +++ b/router/rtrDcmpose.h @@ -49,19 +49,19 @@ /* rtrMARKED(t,s) Tile * t; int s; * Return 1 if the indicated horizontal boundary of a tile is marked. */ -#define rtrMARKED(t,s) (((int) (t)->ti_client) & (s)) +#define rtrMARKED(t,s) (((int) CD2INT((t)->ti_client)) & (s)) /* rtrMARK(t,s) Tile * t; int s; * Mark the indicated horizontal tile edge as a valid channel boundary. */ #define rtrMARK(t,s) \ - ((t)->ti_client = (ClientData) (((int) (t)->ti_client)&(s))) + ((t)->ti_client = INT2CD((((int) CD2INT((t)->ti_client))&(s)))) /* rtrCLEAR(t,s) Tile * t; int s; * Clear the indicated horizontal tile edge as a valid channel boundary. */ #define rtrCLEAR(t,s) \ - ((t)->ti_client = (ClientData) (((int) (t)->ti_client)&(!s))) + ((t)->ti_client = INT2CD((((int) CD2INT((t)->ti_client))&(!s)))) /* Private Procedures */ int rtrSrPaint(); diff --git a/tiles/tile.h b/tiles/tile.h index 59c357d1..8e50ceeb 100644 --- a/tiles/tile.h +++ b/tiles/tile.h @@ -163,7 +163,7 @@ typedef struct /* depending on whether it is cast into a 32 or a 64 bit word. */ #define CLIENTMAX (((pointertype)1 << (8 * sizeof(pointertype) - 2)) - 4) -#define CLIENTDEFAULT (-CLIENTMAX) +#define CLIENTDEFAULT INT2CD(-CLIENTMAX) /* ------------------------ Flags, etc -------------------------------- */ @@ -239,9 +239,9 @@ extern Tile *TiSrPoint(Tile *, Plane *, Point *); #define TiGetBody(tp) ((tp)->ti_body) /* See diagnostic subroutine version in tile.c */ -#define TiSetBody(tp, b) ((tp)->ti_body = (ClientData)(pointertype) (b)) +#define TiSetBody(tp, b) ((tp)->ti_body = INT2CD((b))) #define TiGetClient(tp) ((tp)->ti_client) -#define TiSetClient(tp,b) ((tp)->ti_client = (ClientData)(pointertype) (b)) +#define TiSetClient(tp,b) ((tp)->ti_client = INT2CD((b))) Tile *TiAlloc(void); void TiFree(Tile *); From aa51e338214041ade156124c3b60ba34d5ff739f Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:13:23 +0100 Subject: [PATCH 11/20] TCL9: ClientData macro assignment and access usage --- calma/CalmaWrite.c | 10 +++++----- calma/CalmaWriteZ.c | 10 +++++----- cif/CIFgen.c | 2 +- cif/CIFrdcl.c | 4 ++-- cif/CIFwrite.c | 18 +++++++++--------- cmwind/CMWundo.c | 2 +- commands/CmdSubrs.c | 4 ++-- database/DBconnect.c | 44 +++++++++++++++++++++---------------------- database/DBtechtype.c | 12 ++++++------ database/DBtiles.c | 12 ++++++------ dbwind/DBWprocs.c | 4 ++-- debug/debugFlags.c | 8 ++++---- extflat/EFflat.c | 8 ++++---- grouter/grouteChan.c | 4 ++-- grouter/grouteMain.c | 2 +- mzrouter/mzBlock.c | 2 +- mzrouter/mzSubrs.c | 8 ++++---- plow/PlowJogs.c | 2 +- plow/PlowMain.c | 22 +++++++++++----------- plow/PlowRules2.c | 2 +- plow/PlowYank.c | 10 +++++----- router/rtrSide.c | 6 +++--- select/selCreate.c | 2 +- select/selOps.c | 28 +++++++++++++-------------- tiles/tile.c | 6 +++--- utils/macros.c | 10 +++++----- 26 files changed, 121 insertions(+), 121 deletions(-) diff --git a/calma/CalmaWrite.c b/calma/CalmaWrite.c index 24c3ad64..c7920acf 100644 --- a/calma/CalmaWrite.c +++ b/calma/CalmaWrite.c @@ -867,15 +867,15 @@ calmaProcessDef( HashEntry *he; /* Skip if already output */ - if ((int) def->cd_client > 0) + if ((int) CD2INT(def->cd_client) > 0) return (0); /* Assign it a (negative) number if it doesn't have one yet */ - if ((int) def->cd_client == 0) - def->cd_client = (ClientData) calmaCellNum--; + if ((int) CD2INT(def->cd_client) == 0) + def->cd_client = INT2CD(calmaCellNum--); /* Mark this cell */ - def->cd_client = (ClientData) (- (int) def->cd_client); + def->cd_client = INT2CD(- (int) CD2INT(def->cd_client)); /* Read the cell in if it is not already available. */ if ((def->cd_flags & CDAVAILABLE) == 0) @@ -1769,7 +1769,7 @@ calmaOutStructName( { /* Bad name: use XXXXXcalmaNum */ bad: - calmanum = (int) def->cd_client; + calmanum = (int) CD2INT(def->cd_client); if (calmanum < 0) calmanum = -calmanum; defname = (char *)mallocMagic(32); (void) sprintf(defname, "XXXXX%d", calmanum); diff --git a/calma/CalmaWriteZ.c b/calma/CalmaWriteZ.c index b60f0b6d..261b3bc5 100644 --- a/calma/CalmaWriteZ.c +++ b/calma/CalmaWriteZ.c @@ -821,15 +821,15 @@ calmaProcessDefZ( HashEntry *he; /* Skip if already output */ - if ((int) def->cd_client > 0) + if ((int) CD2INT(def->cd_client) > 0) return (0); /* Assign it a (negative) number if it doesn't have one yet */ - if ((int) def->cd_client == 0) - def->cd_client = (ClientData) calmaCellNum--; + if ((int) CD2INT(def->cd_client) == 0) + def->cd_client = INT2CD(calmaCellNum--); /* Mark this cell */ - def->cd_client = (ClientData) (- (int) def->cd_client); + def->cd_client = INT2CD(- (int) CD2INT(def->cd_client)); /* Read the cell in if it is not already available. */ if ((def->cd_flags & CDAVAILABLE) == 0) @@ -1610,7 +1610,7 @@ calmaOutStructNameZ( { /* Bad name: use XXXXXcalmaNum */ bad: - calmanum = (int) def->cd_client; + calmanum = (int) CD2INT(def->cd_client); if (calmanum < 0) calmanum = -calmanum; defname = (char *)mallocMagic(32); (void) sprintf(defname, "XXXXX%d", calmanum); diff --git a/cif/CIFgen.c b/cif/CIFgen.c index b976ec73..2b45b146 100644 --- a/cif/CIFgen.c +++ b/cif/CIFgen.c @@ -5064,7 +5064,7 @@ CIFGenLayer( if (CIFErrorDef == NULL) break; /* co_client contains the flag (1) for top-level only */ - if ((int)op->co_client == 1) + if ((int)CD2INT(op->co_client) == 1) { /* Only generate output for the top-level cell */ int found = 0; diff --git a/cif/CIFrdcl.c b/cif/CIFrdcl.c index 0f60f510..683d13fc 100644 --- a/cif/CIFrdcl.c +++ b/cif/CIFrdcl.c @@ -697,7 +697,7 @@ CIFPaintCurrent( &DBAllButSpaceBits, cifCheckPaintFunc, (ClientData)NULL) == 1)) DBSrPaintArea((Tile *) NULL, plane, &TiPlaneRect, - &CIFSolidBits, cifMakeBoundaryFunc, (ClientData)filetype); + &CIFSolidBits, cifMakeBoundaryFunc, INT2CD(filetype)); } /* Swap planes */ @@ -709,7 +709,7 @@ CIFPaintCurrent( { DBSrPaintArea((Tile *) NULL, plane, &TiPlaneRect, &CIFSolidBits, cifPaintCurrentFunc, - (ClientData)type); + INT2CD(type)); } /* Recycle the plane, which was dynamically allocated. */ diff --git a/cif/CIFwrite.c b/cif/CIFwrite.c index 51c1f29f..6d0a29df 100644 --- a/cif/CIFwrite.c +++ b/cif/CIFwrite.c @@ -167,8 +167,8 @@ CIFWrite( cifOutPreamble(f, rootDef); cifOut(f); StackFree(cifStack); - if ((int) rootDef->cd_client < 0) - rootDef->cd_client = (ClientData) (- (int) rootDef->cd_client); + if ((int) CD2INT(rootDef->cd_client) < 0) + rootDef->cd_client = INT2CD(- (int) CD2INT(rootDef->cd_client)); /* See if any problems occurred. */ @@ -182,7 +182,7 @@ CIFWrite( * Now we are almost done. * Just output a call on the root cell */ - fprintf(f, "C %d;\nEnd\n", (int) rootDef->cd_client); + fprintf(f, "C %d;\nEnd\n", (int) CD2INT(rootDef->cd_client)); good = !ferror(f); return (good); } @@ -233,7 +233,7 @@ cifWriteMarkFunc( CellUse *use) { if (use->cu_def->cd_client != (ClientData) 0) return 0; - use->cu_def->cd_client = (ClientData) cifCellNum; + use->cu_def->cd_client = INT2CD(cifCellNum); cifCellNum -= 1; StackPush((ClientData) use->cu_def, cifStack); return (0); @@ -313,10 +313,10 @@ cifOut( while (!StackEmpty(cifStack)) { def = (CellDef *) StackPop(cifStack); - if ((int) def->cd_client >= 0) continue; /* Already output */ + if ((int) CD2INT(def->cd_client) >= 0) continue; /* Already output */ if (SigInterruptPending) continue; - def->cd_client = (ClientData) (- (int) def->cd_client); + def->cd_client = INT2CD(- (int) CD2INT(def->cd_client)); /* Read the cell in if it is not already available. */ if ((def->cd_flags & CDAVAILABLE) == 0) @@ -362,7 +362,7 @@ cifOutFunc( int type; CIFLayer *layer; - fprintf(f, "DS %d %d %d;\n", (int) def->cd_client, + fprintf(f, "DS %d %d %d;\n", (int) CD2INT(def->cd_client), CIFCurStyle->cs_reducer, 2 * CIFCurStyle->cs_expander); if (def->cd_name != (char *) NULL) @@ -493,7 +493,7 @@ cifWriteUseFunc( Transform *t; int cifnum; - cifnum = (int) use->cu_def->cd_client; + cifnum = (int) CD2INT(use->cu_def->cd_client); if (cifnum < 0) cifnum = (-cifnum); topx = use->cu_xhi - use->cu_xlo; if (topx < 0) topx = -topx; @@ -773,7 +773,7 @@ CIFWriteFlat( * Just output a call on the root cell */ - fprintf(f, "C %d;\nEnd\n", (int) CIFComponentDef->cd_client); + fprintf(f, "C %d;\nEnd\n", (int) CD2INT(CIFComponentDef->cd_client)); DBCellClearDef(CIFComponentDef); good = !ferror(f); diff --git a/cmwind/CMWundo.c b/cmwind/CMWundo.c index fb6cb9e5..46e11fe7 100644 --- a/cmwind/CMWundo.c +++ b/cmwind/CMWundo.c @@ -212,5 +212,5 @@ cmwUndoDone(void) for (i = 0; i < 256; i++) if (cmwColorsChanged[i]) (void) WindSearch(CMWclientID, (ClientData) NULL, (Rect *) NULL, - cmwRedisplayFunc, (ClientData) i); + cmwRedisplayFunc, INT2CD(i)); } diff --git a/commands/CmdSubrs.c b/commands/CmdSubrs.c index d3a5c7a3..72f9bffc 100644 --- a/commands/CmdSubrs.c +++ b/commands/CmdSubrs.c @@ -1132,7 +1132,7 @@ cmdExpandOneLevel( /* now, unexpand its direct children (ONE LEVEL ONLY) */ if (expand) - (void) DBCellEnum(cu->cu_def, cmdExpand1func, (ClientData) bitmask); + (void) DBCellEnum(cu->cu_def, cmdExpand1func, INT2CD(bitmask)); } int @@ -1140,7 +1140,7 @@ cmdExpand1func( CellUse *cu, ClientData bitmask) { - DBExpand(cu, (int) bitmask, FALSE); + DBExpand(cu, (int)CD2INT(bitmask), FALSE); return 0; } diff --git a/database/DBconnect.c b/database/DBconnect.c index 0859f206..74af4e4f 100644 --- a/database/DBconnect.c +++ b/database/DBconnect.c @@ -483,13 +483,13 @@ dbSrConnectFunc(tile, csa) /* Drop the first entry on the stack */ pNum = csa->csa_pNum; - STACKPUSH((ClientData)tile, dbConnectStack); - STACKPUSH((ClientData)pNum, dbConnectStack); + STACKPUSH(INT2CD(tile), dbConnectStack); + STACKPUSH(INT2CD(pNum), dbConnectStack); while (!StackEmpty(dbConnectStack)) { - pNum = (int)STACKPOP(dbConnectStack); - tile = (Tile *)STACKPOP(dbConnectStack); + pNum = (int)CD2INT(STACKPOP(dbConnectStack)); + tile = (Tile *)CD2INT(STACKPOP(dbConnectStack)); if (result == 1) continue; TiToRect(tile, &tileArea); @@ -565,9 +565,9 @@ dbSrConnectFunc(tile, csa) } else if (t2->ti_client == (ClientData) 1) continue; if (IsSplit(t2)) - TiSetBody(t2, (ClientData)(t2->ti_body | TT_SIDE)); /* bit set */ - STACKPUSH((ClientData)t2, dbConnectStack); - STACKPUSH((ClientData)pNum, dbConnectStack); + TiSetBody(t2, INT2CD(CD2INT(t2->ti_body) | TT_SIDE)); /* bit set */ + STACKPUSH(INT2CD(t2), dbConnectStack); + STACKPUSH(INT2CD(pNum), dbConnectStack); } } @@ -596,13 +596,13 @@ dbSrConnectFunc(tile, csa) { if (SplitDirection(t2)) /* bit set */ - TiSetBody(t2, (ClientData)(t2->ti_body | TT_SIDE)); + TiSetBody(t2, INT2CD(CD2INT(t2->ti_body) | TT_SIDE)); else /* bit clear */ - TiSetBody(t2, (ClientData)(t2->ti_body & ~TT_SIDE)); + TiSetBody(t2, INT2CD(CD2INT(t2->ti_body) & ~TT_SIDE)); } - STACKPUSH((ClientData)t2, dbConnectStack); - STACKPUSH((ClientData)pNum, dbConnectStack); + STACKPUSH(INT2CD(t2), dbConnectStack); + STACKPUSH(INT2CD(pNum), dbConnectStack); } } @@ -627,9 +627,9 @@ dbSrConnectFunc(tile, csa) } else if (t2->ti_client == (ClientData) 1) goto nextRight; if (IsSplit(t2)) - TiSetBody(t2, (ClientData)(t2->ti_body & ~TT_SIDE)); /* bit clear */ - STACKPUSH((ClientData)t2, dbConnectStack); - STACKPUSH((ClientData)pNum, dbConnectStack); + TiSetBody(t2, INT2CD(CD2INT(t2->ti_body) & ~TT_SIDE)); /* bit clear */ + STACKPUSH(INT2CD(t2), dbConnectStack); + STACKPUSH(INT2CD(pNum), dbConnectStack); } nextRight: if (BOTTOM(t2) <= tileArea.r_ybot) break; } @@ -658,13 +658,13 @@ dbSrConnectFunc(tile, csa) { if (SplitDirection(t2)) /* bit clear */ - TiSetBody(t2, (ClientData)(t2->ti_body & ~TT_SIDE)); + TiSetBody(t2, INT2CD(CD2INT(t2->ti_body) & ~TT_SIDE)); else /* bit set */ - TiSetBody(t2, (ClientData)(t2->ti_body | TT_SIDE)); + TiSetBody(t2, INT2CD(CD2INT(t2->ti_body) | TT_SIDE)); } - STACKPUSH((ClientData)t2, dbConnectStack); - STACKPUSH((ClientData)pNum, dbConnectStack); + STACKPUSH(INT2CD(t2), dbConnectStack); + STACKPUSH(INT2CD(pNum), dbConnectStack); } nextTop: if (LEFT(t2) <= tileArea.r_xbot) break; } @@ -692,16 +692,16 @@ dbSrConnectFunc(tile, csa) TiGetTypeExact(tile), &newArea, connectMask, dbcFindTileFunc, (ClientData)&t2) != 0) { - STACKPUSH((ClientData)t2, dbConnectStack); - STACKPUSH((ClientData)i, dbConnectStack); + STACKPUSH(INT2CD(t2), dbConnectStack); + STACKPUSH(INT2CD(i), dbConnectStack); } } else if (DBSrPaintArea((Tile *) NULL, csa->csa_def->cd_planes[i], &newArea, connectMask, dbcFindTileFunc, (ClientData)&t2) != 0) { - STACKPUSH((ClientData)t2, dbConnectStack); - STACKPUSH((ClientData)i, dbConnectStack); + STACKPUSH(INT2CD(t2), dbConnectStack); + STACKPUSH(INT2CD(i), dbConnectStack); } } } diff --git a/database/DBtechtype.c b/database/DBtechtype.c index f8509df6..35a13db4 100644 --- a/database/DBtechtype.c +++ b/database/DBtechtype.c @@ -140,7 +140,7 @@ DBTechInitPlane() for (dpp = dbTechDefaultPlanes; dpp->dp_names; dpp++) { - cp = dbTechNameAdd(dpp->dp_names, (ClientData) dpp->dp_plane, + cp = dbTechNameAdd(dpp->dp_names, INT2CD(dpp->dp_plane), &dbPlaneNameLists, FALSE); if (cp == NULL) { @@ -223,7 +223,7 @@ DBTechInitType() */ for (dtp = dbTechDefaultTypes; dtp->dt_names; dtp++) { - cp = dbTechNameAdd(dtp->dt_names, (ClientData) dtp->dt_type, + cp = dbTechNameAdd(dtp->dt_names, INT2CD(dtp->dt_type), &dbTypeNameLists, FALSE); if (cp == NULL) { @@ -283,7 +283,7 @@ DBTechAddPlane(sectionName, argc, argv) return FALSE; } - cp = dbTechNameAdd(argv[0], (ClientData) DBNumPlanes, &dbPlaneNameLists, FALSE); + cp = dbTechNameAdd(argv[0], INT2CD(DBNumPlanes), &dbPlaneNameLists, FALSE); if (cp == NULL) return FALSE; DBPlaneLongNameTbl[DBNumPlanes++] = cp; @@ -315,7 +315,7 @@ DBTechAddNameToType(newname, ttype, canonical) { char *cp; - cp = dbTechNameAdd(newname, (ClientData) ttype, &dbTypeNameLists, TRUE); + cp = dbTechNameAdd(newname, INT2CD(ttype), &dbTypeNameLists, TRUE); if (canonical) DBTypeLongNameTbl[ttype] = cp; } @@ -455,7 +455,7 @@ DBTechAddType(sectionName, argc, argv) } else { - cp = dbTechNameAdd(argv[1], (ClientData) DBNumTypes, &dbTypeNameLists, FALSE); + cp = dbTechNameAdd(argv[1], INT2CD(DBNumTypes), &dbTypeNameLists, FALSE); if (cp == NULL) return FALSE; @@ -513,7 +513,7 @@ dbTechNewStackedType(type1, type2) } sprintf(buf, "%s+%s", DBTypeShortName(type1), DBTypeShortName(type2)); - cp = dbTechNameAdd(buf, (ClientData) DBNumTypes, &dbTypeNameLists, FALSE); + cp = dbTechNameAdd(buf, INT2CD(DBNumTypes), &dbTypeNameLists, FALSE); if (cp == NULL) { TechError("Couldn't generate new stacking type %s\n", buf); diff --git a/database/DBtiles.c b/database/DBtiles.c index cfd8f8aa..e842bb84 100644 --- a/database/DBtiles.c +++ b/database/DBtiles.c @@ -266,12 +266,12 @@ DBSrPaintNMArea(hintTile, plane, ttype, rect, mask, func, arg) if (!(ignore_sides & IGNORE_LEFT)) { - TiSetBody(tp, (ClientData)(tpt & ~TT_SIDE)); /* bit clear */ + TiSetBody(tp, INT2CD(tpt & ~TT_SIDE)); /* bit clear */ if ((*func)(tp, arg)) return (1); } if (!(ignore_sides & IGNORE_RIGHT)) { - TiSetBody(tp, (ClientData)(tpt | TT_SIDE)); /* bit set */ + TiSetBody(tp, INT2CD(tpt | TT_SIDE)); /* bit set */ if ((*func)(tp, arg)) return (1); } } @@ -416,7 +416,7 @@ DBSrPaintArea(hintTile, plane, rect, mask, func, arg) (dlong)(rect->r_xbot - LEFT(tp)) * theight : DLONG_MIN; if (SplitDirection(tp) ? (f1 > f4) : (f2 > f4)) { - TiSetBody(tp, (ClientData)((TileType)TiGetBody(tp) + TiSetBody(tp, INT2CD((TileType)CD2INT(TiGetBody(tp)) & ~TT_SIDE)); /* bit clear */ if ((*func)(tp, arg)) return (1); } @@ -429,7 +429,7 @@ DBSrPaintArea(hintTile, plane, rect, mask, func, arg) (dlong)(RIGHT(tp) - rect->r_xtop) * theight : DLONG_MIN; if (SplitDirection(tp) ? (f2 > f3) : (f1 > f3)) { - TiSetBody(tp, (ClientData)((TileType)TiGetBody(tp) + TiSetBody(tp, INT2CD((TileType)CD2INT(TiGetBody(tp)) | TT_SIDE)); /* bit set */ if ((*func)(tp, arg)) return (1); } @@ -576,7 +576,7 @@ DBSrPaintClient(hintTile, plane, rect, mask, client, func, arg) (dlong)(rect->r_xbot - LEFT(tp)) * (dlong)theight : DLONG_MIN; if (SplitDirection(tp) ? (f1 > f4) : (f2 > f4)) { - TiSetBody(tp, (ClientData)((TileType)TiGetBody(tp) + TiSetBody(tp, INT2CD((TileType)CD2INT(TiGetBody(tp)) & ~TT_SIDE)); /* bit clear */ if ((tp->ti_client == client) && (*func)(tp, arg)) return (1); @@ -590,7 +590,7 @@ DBSrPaintClient(hintTile, plane, rect, mask, client, func, arg) (dlong)(RIGHT(tp) - rect->r_xtop) * (dlong)theight : DLONG_MIN; if (SplitDirection(tp) ? (f2 > f3) : (f1 > f3)) { - TiSetBody(tp, (ClientData)((TileType)TiGetBody(tp) + TiSetBody(tp, INT2CD((TileType)CD2INT(TiGetBody(tp)) | TT_SIDE)); /* bit set */ if ((tp->ti_client == client) && (*func)(tp, arg)) return (1); diff --git a/dbwind/DBWprocs.c b/dbwind/DBWprocs.c index 8f5344a7..97c0094b 100644 --- a/dbwind/DBWprocs.c +++ b/dbwind/DBWprocs.c @@ -549,8 +549,8 @@ DBWloadWindow(window, name, flags) if (expand) DBExpandAll(newEditUse, &(newEditUse->cu_bbox), ((DBWclientRec *)window->w_clientData)->dbw_bitmask, - FALSE, UnexpandFunc, (ClientData) - (((DBWclientRec *)window->w_clientData)->dbw_bitmask)); + FALSE, UnexpandFunc, + INT2CD(((DBWclientRec *)window->w_clientData)->dbw_bitmask)); if (newEdit) { diff --git a/debug/debugFlags.c b/debug/debugFlags.c index 9ae0caa7..175a0322 100644 --- a/debug/debugFlags.c +++ b/debug/debugFlags.c @@ -82,7 +82,7 @@ DebugAddClient(name, maxflags) dc->dc_flags[maxflags].df_value = FALSE; } - return ((ClientData) debugNumClients++); + return (INT2CD(debugNumClients++)); } /* @@ -116,7 +116,7 @@ DebugAddFlag(clientID, name) ClientData clientID; /* Client identifier from DebugAddClient */ char *name; /* Name of debugging flag */ { - int id = (int) clientID; + int id = (int) CD2INT(clientID); struct debugClient *dc; if (id < 0 || id >= debugNumClients) @@ -159,7 +159,7 @@ void DebugShow(clientID) ClientData clientID; { - int id = (int) clientID; + int id = (int) CD2INT(clientID); struct debugClient *dc; int n; @@ -202,7 +202,7 @@ DebugSet(clientID, argc, argv, value) bool value; { bool badFlag = FALSE; - int id = (int) clientID; + int id = (int) CD2INT(clientID); struct debugClient *dc; int n; diff --git a/extflat/EFflat.c b/extflat/EFflat.c index 25502dbe..bb6919f0 100644 --- a/extflat/EFflat.c +++ b/extflat/EFflat.c @@ -146,7 +146,7 @@ EFFlatBuild(name, flags) else { flatnodeflags |= FLATNODE_DOWARN; /* No FLATNODE_STDCELL flag */ - efFlatNodes(&efFlatContext, (ClientData)flatnodeflags); + efFlatNodes(&efFlatContext, INT2CD(flatnodeflags)); } efFlatKills(&efFlatContext); if (!(flags & EF_NONAMEMERGE)) @@ -217,7 +217,7 @@ EFFlatBuildOneLevel(def, flags) /* Record all nodes down the hierarchy from here */ flatnodeflags = 0; /* No FLATNODE_DOWARN */ - efFlatNodes(&efFlatContext, (ClientData)flatnodeflags); + efFlatNodes(&efFlatContext, INT2CD(flatnodeflags)); /* Expand all subcells that contain connectivity information but */ /* no active devices (including those in subcells). */ @@ -319,7 +319,7 @@ efFlatNodes(hc, clientData) HierContext *hc; ClientData clientData; { - int flags = (int)clientData; + int flags = (int)CD2INT(clientData); bool stdcell = (flags & FLATNODE_STDCELL) ? TRUE : FALSE; bool doWarn = (flags & FLATNODE_DOWARN) ? TRUE : FALSE; @@ -616,7 +616,7 @@ efAddConns(hc, doWarn) if (conn->conn_1.cn_nsubs == 0) efAddOneConn(hc, conn->conn_name1, conn->conn_name2, conn, doWarn); else - efHierSrArray(hc, conn, efAddOneConn, (ClientData)doWarn); + efHierSrArray(hc, conn, efAddOneConn, INT2CD(doWarn)); } return (0); diff --git a/grouter/grouteChan.c b/grouter/grouteChan.c index c0f201ec..e2c32cab 100644 --- a/grouter/grouteChan.c +++ b/grouter/grouteChan.c @@ -745,12 +745,12 @@ glChanBlockDens(ch) { /* Clip tiles overlapped by pa->pa_area */ while (DBSrPaintArea((Tile *) NULL, glChanPlane, &pa->pa_area, - &DBAllTypeBits, glChanClipFunc, (ClientData) &pa->pa_area)) + &DBAllTypeBits, glChanClipFunc, PTR2CD(&pa->pa_area))) /* Nothing */; /* Change the type of all tiles within the area */ (void) DBSrPaintArea((Tile *) NULL, glChanPlane, &pa->pa_area, - &DBAllTypeBits, glChanPaintFunc, (ClientData) pa->pa_type); + &DBAllTypeBits, glChanPaintFunc, INT2CD(pa->pa_type)); /* * Allow merging, as long as no tiles get merged across diff --git a/grouter/grouteMain.c b/grouter/grouteMain.c index 1a673a5a..e56082f0 100644 --- a/grouter/grouteMain.c +++ b/grouter/grouteMain.c @@ -134,7 +134,7 @@ GlGlobalRoute(chanList, netList) glPenSetPerChan(net); } numTerms += glMultiSteiner(EditCellUse, net, glProcessLoc, - glCrossMark, (ClientData) doFast, (ClientData) 0); + glCrossMark, INT2CD(doFast), (ClientData) 0); if (DebugIsSet(glDebugID, glDebPen)) glPenClearPerChan(net); RtrMilestonePrint(); diff --git a/mzrouter/mzBlock.c b/mzrouter/mzBlock.c index 7bbf2df2..8501fc1f 100644 --- a/mzrouter/mzBlock.c +++ b/mzrouter/mzBlock.c @@ -285,7 +285,7 @@ mzBlockSubcellsFunc(scx, cdarg) r = scx->scx_use->cu_def->cd_bbox; GEOTRANSRECT(&scx->scx_trans, &r, &rDest); - if((int)(scx->scx_use->cu_client) != MZ_EXPAND_DEST) + if(scx->scx_use->cu_client != MZ_EXPAND_DEST) /* cell over part of dest node, paint normal blocks onto affected * planes. * (area is bloated by appropriate spacing on each affected plane) diff --git a/mzrouter/mzSubrs.c b/mzrouter/mzSubrs.c index c756000c..e2ec6294 100644 --- a/mzrouter/mzSubrs.c +++ b/mzrouter/mzSubrs.c @@ -423,7 +423,7 @@ mzConnectedTileFunc(tile, cxp) * MZAddStart() and MZAddDest(). */ - if ((int)tile->ti_client != mzMakeEndpoints) + if ((int)CD2INT(tile->ti_client) != mzMakeEndpoints) { SearchContext *scx = cxp->tc_scx; List *expandList = (List *) (cxp->tc_filter->tf_arg); @@ -434,12 +434,12 @@ mzConnectedTileFunc(tile, cxp) GEOTRANSRECT(&scx->scx_trans, &rRaw, &r); /* mark tile with destination type */ - tile->ti_client = (ClientData) mzMakeEndpoints; + tile->ti_client = INT2CD(mzMakeEndpoints); /* Add tiles connected to Start to mzStartTerms */ /* (Added by Tim, August 2006) */ - if (mzMakeEndpoints == MZ_EXPAND_START) + if (INT2CD(mzMakeEndpoints) == MZ_EXPAND_START) { ColoredRect *newTerm; extern List *mzStartTerms; @@ -454,7 +454,7 @@ mzConnectedTileFunc(tile, cxp) /* or the planes will get fractured up, possibly into areas too */ /* small to place a valid route. */ - else if (mzMakeEndpoints == MZ_EXPAND_DEST) + else if (INT2CD(mzMakeEndpoints) == MZ_EXPAND_DEST) { RouteLayer *rL; TileType ttype = TiGetType(tile); diff --git a/plow/PlowJogs.c b/plow/PlowJogs.c index 3b85457a..63bbf530 100644 --- a/plow/PlowJogs.c +++ b/plow/PlowJogs.c @@ -373,7 +373,7 @@ plowProcessJogFunc(edge, area) ret = 0; plowJogEraseList = (LinkedRect *) NULL; if (plowSrShadowBack(newedge.e_pNum, &r, mask, - plowJogDragLHS, (ClientData) newedge.e_newx - width) == 0) + plowJogDragLHS, INT2CD(newedge.e_newx - width)) == 0) { /* Success: first paint to extend the RHS of the jog */ plane = plowYankDef->cd_planes[newedge.e_pNum]; diff --git a/plow/PlowMain.c b/plow/PlowMain.c index a498e4fb..47a6ee94 100644 --- a/plow/PlowMain.c +++ b/plow/PlowMain.c @@ -736,11 +736,11 @@ plowPropagateRect(def, userRect, lc, changedArea) /* Add the initial edges */ for (pNum = PL_TECHDEPBASE; pNum < DBNumPlanes; pNum++) (void) plowSrShadowInitial(pNum, &plowRect, - lc, plowInitialPaint, (ClientData) plowRect.r_xtop); + lc, plowInitialPaint, INT2CD(plowRect.r_xtop)); /* Find any subcells crossed by the plow */ (void) DBSrCellPlaneArea(plowYankDef->cd_cellPlane, - &cellPlowRect, plowInitialCell, (ClientData) &cellPlowRect); + &cellPlowRect, plowInitialCell, PTR2CD(&cellPlowRect)); /* While edges remain, process them */ tooFar = 0; @@ -910,9 +910,9 @@ plowPropagateSel(def, pdistance, changedArea) /* Add everything in the selection */ SelEnumPaint(&DBAllButSpaceBits, TRUE, &dummy, - plowSelPaintPlow, (ClientData) *pdistance); + plowSelPaintPlow, INT2CD(*pdistance)); SelEnumCells(TRUE, &dummy, (SearchContext *) NULL, - plowSelCellPlow, (ClientData) *pdistance); + plowSelCellPlow, INT2CD(*pdistance)); /* While edges remain, process them */ tooFar = 0; @@ -1043,7 +1043,7 @@ plowSelPaintPlow(rect, type, distance) #endif /* notdef */ plowLHS.r_xbot--; plowSrShadow(DBPlane(type), &plowLHS, DBZeroTypeBits, - plowInitialPaint, (ClientData) plowLHS.r_xtop); + plowInitialPaint, INT2CD(plowLHS.r_xtop)); /* Queue the RHS */ plowRHS.r_xbot = plowRHS.r_xtop; @@ -1054,7 +1054,7 @@ plowSelPaintPlow(rect, type, distance) plowRHS.r_xbot--; TTMaskSetOnlyType(&mask, type); plowSrShadow(DBPlane(type), &plowRHS, mask, - plowInitialPaint, (ClientData) plowRHS.r_xtop); + plowInitialPaint, INT2CD(plowRHS.r_xtop)); return (0); } @@ -1102,8 +1102,8 @@ plowSelCellPlow(selUse, realUse, transform, distance) /* Find the cell in the yanked def that has the same use-id as this one */ save = realUse->cu_client; - realUse->cu_client = (ClientData)distance; - (void) DBCellEnum(plowYankDef, plowFindSelCell, (ClientData)realUse); + realUse->cu_client = INT2CD(distance); + (void) DBCellEnum(plowYankDef, plowFindSelCell, PTR2CD(realUse)); realUse->cu_client = save; return (0); @@ -1125,7 +1125,7 @@ plowFindSelCell(yankUse, editUse) edge.e_ytop = yankUse->cu_bbox.r_ytop; edge.e_ybot = yankUse->cu_bbox.r_ybot; edge.e_x = yankUse->cu_bbox.r_xtop; - edge.e_newx = yankUse->cu_bbox.r_xtop + (int)editUse->cu_client; + edge.e_newx = yankUse->cu_bbox.r_xtop + (int)CD2INT(editUse->cu_client); edge.e_ltype = PLOWTYPE_CELL; edge.e_rtype = PLOWTYPE_CELL; (void) plowQueueAdd(&edge); @@ -1538,7 +1538,7 @@ plowProcessEdge(edge, changedArea) plowProcessedEdges++; if (edge->e_use) { - if (amountToMove > (int)edge->e_use->cu_client) + if (amountToMove > (int)CD2INT(edge->e_use->cu_client)) { /* Update area modified by plowing */ (void) GeoInclude(&edge->e_rect, changedArea); @@ -1558,7 +1558,7 @@ plowProcessEdge(edge, changedArea) * to update the area changed by the area of the * cell PLUS the area swept out by its RHS. */ - edge->e_use->cu_client = (ClientData)amountToMove; + edge->e_use->cu_client = INT2CD(amountToMove); r = edge->e_use->cu_bbox; r.r_xbot += amountToMove; r.r_xtop += amountToMove; diff --git a/plow/PlowRules2.c b/plow/PlowRules2.c index 0a172d81..3cd8a84c 100644 --- a/plow/PlowRules2.c +++ b/plow/PlowRules2.c @@ -1086,7 +1086,7 @@ plowFoundCell(use, ar) /* Only queue the edge if the cell has not moved far enough */ if ((use->cu_client != (ClientData)CLIENTDEFAULT) && - ((int)(use->cu_client) < xmove)) + ((int)CD2INT(use->cu_client) < xmove)) { edge.e_use = use; edge.e_flags = 0; diff --git a/plow/PlowYank.c b/plow/PlowYank.c index 9b7776ea..39ea50e3 100644 --- a/plow/PlowYank.c +++ b/plow/PlowYank.c @@ -185,7 +185,7 @@ plowYankMore(area, halo, back) { (void) DBSrPaintArea((Tile *) NULL, plowYankDef->cd_planes[pNum], &oldArea, &DBAllTypeBits, plowYankUpdatePaint, - (ClientData) pNum); + INT2CD(pNum)); } /* Switch the yank cell and the spare cell */ @@ -487,16 +487,16 @@ plowUpdateCell(use, origDef) switch (plowDirection) { case GEO_NORTH: - y = (int)use->cu_client; + y = (int)CD2INT(use->cu_client); break; case GEO_SOUTH: - y = -(int)use->cu_client; + y = -(int)CD2INT(use->cu_client); break; case GEO_WEST: - x = -(int)use->cu_client; + x = -(int)CD2INT(use->cu_client); break; case GEO_EAST: - x = (int)use->cu_client; + x = (int)CD2INT(use->cu_client); break; } GeoTranslateTrans(&origUse->cu_transform, x, y, &newTrans); diff --git a/router/rtrSide.c b/router/rtrSide.c index fb1e5333..9f0f0134 100644 --- a/router/rtrSide.c +++ b/router/rtrSide.c @@ -323,7 +323,7 @@ rtrEnumSidesFunc(tile) Side side; /* Skip if already processed, out of the area, or not a cell tile */ - yprev = (int) tile->ti_client; + yprev = (int) CD2INT(tile->ti_client); ybot = MAX(BOTTOM(tile), rtrSideArea.r_ybot); if (yprev <= ybot || tile->ti_body == (ClientData) NULL || RIGHT(tile) >= rtrSideArea.r_xtop) @@ -392,7 +392,7 @@ rtrEnumSidesFunc(tile) if (LEFT(tp) != RIGHT(tile) || TOP(tp) <= ybot) { /* Processed this tile completely */ - tile->ti_client = (ClientData) ybot; + tile->ti_client = INT2CD(ybot); return (0); } } @@ -441,7 +441,7 @@ rtrEnumSidesFunc(tile) else { side.side_line.r_ytop = MIN(TOP(tp), ytop); - tp->ti_client = (ClientData) ybot; + tp->ti_client = INT2CD(ybot); } } } diff --git a/select/selCreate.c b/select/selCreate.c index a8a3b903..d6a8d308 100644 --- a/select/selCreate.c +++ b/select/selCreate.c @@ -1274,7 +1274,7 @@ SelectAndCopy2(newSourceDef) { (void) DBSrPaintArea((Tile *) NULL, Select2Def->cd_planes[plane], &TiPlaneRect, &DBAllButSpaceAndDRCBits, selACPaintFunc, - (ClientData) plane); + INT2CD(plane)); DBMergeNMTiles(Select2Def->cd_planes[plane], &TiPlaneRect, (PaintUndoInfo *)NULL); } diff --git a/select/selOps.c b/select/selOps.c index f620e15d..c9785d01 100644 --- a/select/selOps.c +++ b/select/selOps.c @@ -404,9 +404,9 @@ selShortTileProc(tile, ssd) Tile *tile; ShortSearchData *ssd; { - if ((int)tile->ti_client < ssd->cost) + if ((int)CD2INT(tile->ti_client) < ssd->cost) { - ssd->cost = (int)tile->ti_client; + ssd->cost = (int)CD2INT(tile->ti_client); ssd->tile = tile; } return 0; @@ -448,7 +448,7 @@ selShortFindReverse(rlist, tile, pnum, fdir) TileType ttype; mindir = fdir; - mincost = (int)tile->ti_client; + mincost = (int)CD2INT(tile->ti_client); while (TRUE) { @@ -495,7 +495,7 @@ selShortFindReverse(rlist, tile, pnum, fdir) newrrec->r_next = *rlist; *rlist = newrrec; - if ((int)tile->ti_client == 0) return 0; /* We're done */ + if ((int)CD2INT(tile->ti_client) == 0) return 0; /* We're done */ minp = pnum; @@ -510,9 +510,9 @@ selShortFindReverse(rlist, tile, pnum, fdir) for (tp = RT(tile); RIGHT(tp) > LEFT(tile); tp = BL(tp)) { if (tp->ti_client == (ClientData)CLIENTDEFAULT) continue; - if ((int)tp->ti_client < mincost) + if ((int)CD2INT(tp->ti_client) < mincost) { - mincost = (int)tp->ti_client; + mincost = (int)CD2INT(tp->ti_client); mintp = tp; mindir = GEO_NORTH; } @@ -530,9 +530,9 @@ selShortFindReverse(rlist, tile, pnum, fdir) for (tp = BL(tile); BOTTOM(tp) < TOP(tile); tp = RT(tp)) { if (tp->ti_client == (ClientData)CLIENTDEFAULT) continue; - if ((int)tp->ti_client < mincost) + if ((int)CD2INT(tp->ti_client) < mincost) { - mincost = (int)tp->ti_client; + mincost = (int)CD2INT(tp->ti_client); mintp = tp; mindir = GEO_WEST; } @@ -550,9 +550,9 @@ selShortFindReverse(rlist, tile, pnum, fdir) for (tp = LB(tile); LEFT(tp) < RIGHT(tile); tp = TR(tp)) { if (tp->ti_client == (ClientData)CLIENTDEFAULT) continue; - if ((int)tp->ti_client < mincost) + if ((int)CD2INT(tp->ti_client) < mincost) { - mincost = (int)tp->ti_client; + mincost = (int)CD2INT(tp->ti_client); mintp = tp; mindir = GEO_SOUTH; } @@ -570,9 +570,9 @@ selShortFindReverse(rlist, tile, pnum, fdir) for (tp = TR(tile); TOP(tp) > BOTTOM(tile); tp = LB(tp)) { if (tp->ti_client == (ClientData)CLIENTDEFAULT) continue; - if ((int)tp->ti_client < mincost) + if ((int)CD2INT(tp->ti_client) < mincost) { - mincost = (int)tp->ti_client; + mincost = (int)CD2INT(tp->ti_client); mintp = tp; mindir = GEO_EAST; } @@ -741,7 +741,7 @@ selShortProcessTile(tile, cost, fdir, mask) if (tile->ti_client == (ClientData)CLIENTDEFAULT) TiSetClient(tile, cost); - else if ((int)tile->ti_client > cost) + else if ((int)CD2INT(tile->ti_client) > cost) TiSetClient(tile, cost); else return 1; @@ -1222,7 +1222,7 @@ SelectExpand(mask) extern int selExpandFunc(); /* Forward reference. */ (void) SelEnumCells(FALSE, (bool *) NULL, (SearchContext *) NULL, - selExpandFunc, (ClientData) mask); + selExpandFunc, INT2CD(mask)); } /* ARGSUSED */ diff --git a/tiles/tile.c b/tiles/tile.c index a1faa840..a0dae3c3 100644 --- a/tiles/tile.c +++ b/tiles/tile.c @@ -732,9 +732,9 @@ TileStoreFree(ptr) } else { - TileStoreFreeList_end->ti_client = (unsigned long)ptr; + TileStoreFreeList_end->ti_client = PTR2CD(ptr); TileStoreFreeList_end = ptr; - TileStoreFreeList_end->ti_client = (unsigned long) 0; + TileStoreFreeList_end->ti_client = INT2CD(0); } } @@ -827,5 +827,5 @@ tiPrintAll(tp) printf("UR=(%d,%d)\n", RIGHT(tp), TOP(tp)); /* The following is for plowing debugging */ - printf("LEAD=%d\n", (int) tp->ti_client); + printf("LEAD=%d\n", (int) CD2INT(tp->ti_client)); } diff --git a/utils/macros.c b/utils/macros.c index 6195698c..878673ee 100644 --- a/utils/macros.c +++ b/utils/macros.c @@ -103,7 +103,7 @@ MacroDefine(client, xc, str, help, imacro) HashInit(clienttable, 32, HT_WORDKEYS); HashSetValue(h, clienttable); } - h = HashFind(clienttable, (char *)((ClientData)xc)); + h = HashFind(clienttable, (char *)INT2CD(xc)); oldMacro = (macrodef *)HashGetValue(h); if (oldMacro != NULL) { @@ -158,7 +158,7 @@ MacroDefineHelp(client, xc, help) clienttable = (HashTable *)HashGetValue(h); if (clienttable == NULL) return; - h = HashFind(clienttable, (char *)((ClientData)xc)); + h = HashFind(clienttable, (char *)INT2CD(xc)); curMacro = (macrodef *)HashGetValue(h); if (curMacro == NULL) return; @@ -202,7 +202,7 @@ MacroRetrieve(client, xc, iReturn) clienttable = (HashTable *)HashGetValue(h); if (clienttable != NULL) { - h = HashLookOnly(clienttable, (char *)((ClientData)xc)); + h = HashLookOnly(clienttable, (char *)INT2CD(xc)); if (h != NULL) { cMacro = (macrodef *)HashGetValue(h); @@ -249,7 +249,7 @@ MacroRetrieveHelp(client, xc) clienttable = (HashTable *)HashGetValue(h); if (clienttable != NULL) { - h = HashLookOnly(clienttable, (char *)((ClientData)xc)); + h = HashLookOnly(clienttable, (char *)INT2CD(xc)); if (h != NULL) { cMacro = (macrodef *)HashGetValue(h); @@ -347,7 +347,7 @@ MacroDelete(client, xc) clienttable = (HashTable *)HashGetValue(h); if (clienttable != NULL) { - h = HashLookOnly(clienttable, (char *)((ClientData)xc)); + h = HashLookOnly(clienttable, (char *)INT2CD(xc)); if (h != NULL) { cMacro = (macrodef *)HashGetValue(h); From 749bf53b8c684b27440750d9b2c8c6c5a32bd33a Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:15:47 +0100 Subject: [PATCH 12/20] TCL9: Tcl_SetExitProc() API was removed The Tcl_Exit() replacement proc takes charge of calling exit() So this function can be easily migrated to libc atexit() which will now run during exit() not just before. Which seems ok for the purpose of restoring the termios state of the tty. This solution seems compatible with TCL8 as well so all calls to this removed API are removed. Note this patch also removes the invalidation (of the callback so the deefault use of Tcl_Exit() is restored) before returning from this function. atexit() usage can not be invalidated after registration but that can be controlled with application flag checked inside the callback function if needed. I have observed scenarios where I need to issue 'reset' manually after exiting magic, still understanding better the build types and scenarios that triggers this. --- utils/main.c | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/utils/main.c b/utils/main.c index f1aa9d84..a3f218a7 100644 --- a/utils/main.c +++ b/utils/main.c @@ -793,15 +793,21 @@ mainInitAfterArgs() } /* - * Tcl exit procedure hook for the Tcl_Exit() subroutine + * Tcl_SetExitProc() was removed in TCL9 and used to perform this function + * see: https://core.tcl-lang.org/tips/doc/trunk/tip/512.md * - * clientData is an exit value if "exit" was specified from a script. + * Note this change will slightly alter the order, the termios restore will + * not longer be performed before exit() is called. + * + * The default Tcl_Exit() does manage calling exit(status) by default. + * This assumes TxResetTerminal() will only attempt a restore if state + * was saved. + * TxResetTerminal() does not do anything if TxTkConsole is set that appears + * to be the popup shell window. */ - -void tcl_exit_hook(ClientData clientData) +static void atexit_exit_hook(void) { - TxResetTerminal(); - exit(*(int *)(&clientData)); + TxResetTerminal(TRUE); } /* @@ -830,7 +836,7 @@ mainInitFinal() #ifdef MAGIC_WRAPPER /* Reset terminal if exit is called inside a TCL script */ - Tcl_SetExitProc(tcl_exit_hook); + atexit(atexit_exit_hook); /* Read in system pre-startup file, if it exists. */ @@ -1223,10 +1229,6 @@ mainInitFinal() UndoFlush(); TxClearPoint(); -#ifdef MAGIC_WRAPPER - Tcl_SetExitProc(NULL); -#endif - return 0; } From d9f0a6bfee837524449a78734d6c487cb7bed61e Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:19:15 +0100 Subject: [PATCH 13/20] TCL9: Tcl_InitStubs(version="9.0") --- ext2sim/ext2sim.c | 2 +- ext2spice/ext2spice.c | 2 +- graphics/grTCairo1.c | 2 +- graphics/grTOGL1.c | 2 +- graphics/grTk1.c | 2 +- lef/tcllef.c | 2 +- plot/tclplot.c | 2 +- router/tclroute.c | 2 +- tcltk/tclmagic.c | 12 +++++++++++- tcltk/tclmagic.h | 2 ++ 10 files changed, 21 insertions(+), 9 deletions(-) diff --git a/ext2sim/ext2sim.c b/ext2sim/ext2sim.c index 3252bbbb..dc62f59f 100644 --- a/ext2sim/ext2sim.c +++ b/ext2sim/ext2sim.c @@ -210,7 +210,7 @@ Exttosim_Init(interp) if (interp == NULL) return TCL_ERROR; if (Tcl_PkgRequire(interp, "Tclmagic", MAGIC_VERSION, 0) == NULL) return TCL_ERROR; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) return TCL_ERROR; + if (Tcl_InitStubs(interp, Tclmagic_InitStubsVersion, 0) == NULL) return TCL_ERROR; TxPrintf("Auto-loading EXTTOSIM module\n"); TxFlushOut(); diff --git a/ext2spice/ext2spice.c b/ext2spice/ext2spice.c index 7bd1693c..a4086cb2 100644 --- a/ext2spice/ext2spice.c +++ b/ext2spice/ext2spice.c @@ -208,7 +208,7 @@ Exttospice_Init(interp) if (interp == NULL) return TCL_ERROR; if (Tcl_PkgRequire(interp, "Tclmagic", MAGIC_VERSION, 0) == NULL) return TCL_ERROR; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) return TCL_ERROR; + if (Tcl_InitStubs(interp, Tclmagic_InitStubsVersion, 0) == NULL) return TCL_ERROR; TxPrintf("Auto-loading EXTTOSPICE module\n"); TxFlushOut(); diff --git a/graphics/grTCairo1.c b/graphics/grTCairo1.c index 8cee61b1..133c518e 100644 --- a/graphics/grTCairo1.c +++ b/graphics/grTCairo1.c @@ -261,7 +261,7 @@ GrTCairoInit () { bool rstatus; - if (Tk_InitStubs(magicinterp, "8.5", 0) == NULL) return FALSE; + if (Tk_InitStubs(magicinterp, Tclmagic_InitStubsVersion, 0) == NULL) return FALSE; tcairoCurrent.window = Tk_MainWindow(magicinterp); if (tcairoCurrent.window == NULL) diff --git a/graphics/grTOGL1.c b/graphics/grTOGL1.c index bb1b0354..ec2d4c5f 100644 --- a/graphics/grTOGL1.c +++ b/graphics/grTOGL1.c @@ -269,7 +269,7 @@ GrTOGLInit () static int attributeList[] = { GLX_RGBA, None, None }; #endif - if (Tk_InitStubs(magicinterp, "8.5", 0) == NULL) return FALSE; + if (Tk_InitStubs(magicinterp, Tclmagic_InitStubsVersion, 0) == NULL) return FALSE; toglCurrent.window = Tk_MainWindow(magicinterp); if (toglCurrent.window == NULL) diff --git a/graphics/grTk1.c b/graphics/grTk1.c index d5d3e32f..d783d244 100644 --- a/graphics/grTk1.c +++ b/graphics/grTk1.c @@ -372,7 +372,7 @@ GrTkInit(dispType) int color_base, color_reserved; int status; - if (Tk_InitStubs(magicinterp, "8.5", 0) == NULL) return FALSE; + if (Tk_InitStubs(magicinterp, Tclmagic_InitStubsVersion, 0) == NULL) return FALSE; grCurrent.window = Tk_MainWindow(magicinterp); diff --git a/lef/tcllef.c b/lef/tcllef.c index c378b2a9..878d7af9 100644 --- a/lef/tcllef.c +++ b/lef/tcllef.c @@ -42,7 +42,7 @@ Magiclef_Init(interp) if (interp == NULL) return TCL_ERROR; if (Tcl_PkgRequire(interp, "Tclmagic", MAGIC_VERSION, 0) == NULL) return TCL_ERROR; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) return TCL_ERROR; + if (Tcl_InitStubs(interp, Tclmagic_InitStubsVersion, 0) == NULL) return TCL_ERROR; TxPrintf("Auto-loading LEF/DEF module\n"); TxFlushOut(); diff --git a/plot/tclplot.c b/plot/tclplot.c index 348b7b9f..a590f4b5 100644 --- a/plot/tclplot.c +++ b/plot/tclplot.c @@ -46,7 +46,7 @@ Tclplot_Init(interp) if (interp == NULL) return TCL_ERROR; if (Tcl_PkgRequire(interp, "Tclmagic", MAGIC_VERSION, 0) == NULL) return TCL_ERROR; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) return TCL_ERROR; + if (Tcl_InitStubs(interp, Tclmagic_InitStubsVersion, 0) == NULL) return TCL_ERROR; TxPrintf("Auto-loading PLOT module\n"); TxFlushOut(); diff --git a/router/tclroute.c b/router/tclroute.c index 0922b6f5..3426267b 100644 --- a/router/tclroute.c +++ b/router/tclroute.c @@ -53,7 +53,7 @@ Tclroute_Init(interp) if (interp == NULL) return TCL_ERROR; if (Tcl_PkgRequire(interp, "Tclmagic", MAGIC_VERSION, 0) == NULL) return TCL_ERROR; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) return TCL_ERROR; + if (Tcl_InitStubs(interp, Tclmagic_InitStubsVersion, 0) == NULL) return TCL_ERROR; TxPrintf("Auto-loading ROUTE module\n"); TxFlushOut(); diff --git a/tcltk/tclmagic.c b/tcltk/tclmagic.c index 0c68de10..272a5214 100644 --- a/tcltk/tclmagic.c +++ b/tcltk/tclmagic.c @@ -53,6 +53,16 @@ char *MagicVersion = MAGIC_VERSION; char *MagicRevision = MAGIC_REVISION; char *MagicCompileTime = MAGIC_DATE; +#if TCL_MAJOR_VERSION < 9 +const char *Tclmagic_InitStubsVersion = "8.5"; +#else +/* Major version changed API (as you'd expect for a major version upgrade) + * which is compiled into the resulting binary. + * No possibility of dual version support. + */ +const char *Tclmagic_InitStubsVersion = "9.0"; +#endif + Tcl_Interp *magicinterp; Tcl_Interp *consoleinterp; @@ -1293,7 +1303,7 @@ Tclmagic_Init(interp) /* Remember the interpreter */ magicinterp = interp; - if (Tcl_InitStubs(interp, "8.5", 0) == NULL) return TCL_ERROR; + if (Tcl_InitStubs(interp, Tclmagic_InitStubsVersion, 0) == NULL) return TCL_ERROR; /* Initialization and Startup commands */ Tcl_CreateCommand(interp, "magic::initialize", (Tcl_CmdProc *)_magic_initialize, diff --git a/tcltk/tclmagic.h b/tcltk/tclmagic.h index c9d411b2..c2dcbc61 100644 --- a/tcltk/tclmagic.h +++ b/tcltk/tclmagic.h @@ -28,5 +28,7 @@ extern int TagVerify(); extern int Tcl_printf(); extern void MakeWindowCommand(); +extern const char *Tclmagic_InitStubsVersion; + #endif /* MAGIC_WRAPPER */ #endif /* _TCLMAGIC_H */ From 7d1a83bf3d611e2afb6f67829d8464fe692d4c40 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:21:11 +0100 Subject: [PATCH 14/20] TCL9: Tcl_GetIntFromObj() call checked This API uses address of operator to Tcl API with (int) type, but does not use Tcl_Size in TCL9, it remained an (int) type. --- tcltk/tclmagic.c | 1 + 1 file changed, 1 insertion(+) diff --git a/tcltk/tclmagic.c b/tcltk/tclmagic.c index 272a5214..d047fe35 100644 --- a/tcltk/tclmagic.c +++ b/tcltk/tclmagic.c @@ -854,6 +854,7 @@ TxDialog(prompt, responses, defresp) Tcl_EvalEx(magicinterp, evalstr, -1, 0); objPtr = Tcl_GetObjResult(magicinterp); + /* tcl9 checked, this API is still (int) for &code */ result = Tcl_GetIntFromObj(magicinterp, objPtr, &code); if (result == TCL_OK) return code; From 0784af41839ea71ab2a68fd79e7256e9368a3291 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:22:24 +0100 Subject: [PATCH 15/20] TCL9: CmdLQ.c Tcl_AppendResult(... (char*)NULL) cast sentinal In the TCL8 to TCL9 porting information it was indicated the sentinal NULL termination should be cast (char *) with API call Tcl_AppendResult(). This was already in place for most of the codebase this resolves the last few places. --- commands/CmdLQ.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/commands/CmdLQ.c b/commands/CmdLQ.c index b9f42b29..28d6dadc 100644 --- a/commands/CmdLQ.c +++ b/commands/CmdLQ.c @@ -1875,7 +1875,7 @@ CmdPort( { #ifdef MAGIC_WRAPPER Tcl_AppendResult(magicinterp, cmdPortClassTypes[idx], - NULL); + (char *)NULL); #else TxPrintf("Class = %s\n", cmdPortClassTypes[idx]); #endif @@ -1920,7 +1920,7 @@ CmdPort( { #ifdef MAGIC_WRAPPER Tcl_AppendResult(magicinterp, cmdPortUseTypes[idx], - NULL); + (char *)NULL); #else TxPrintf("Use = %s\n", cmdPortUseTypes[idx]); #endif @@ -1965,7 +1965,7 @@ CmdPort( { #ifdef MAGIC_WRAPPER Tcl_AppendResult(magicinterp, cmdPortShapeTypes[idx], - NULL); + (char *)NULL); #else TxPrintf("Shape = %s\n", cmdPortShapeTypes[idx]); #endif @@ -2044,7 +2044,7 @@ CmdPort( if (pos & PORT_DIR_SOUTH) strcat(cdir, "s"); if (pos & PORT_DIR_WEST) strcat(cdir, "w"); #ifdef MAGIC_WRAPPER - Tcl_AppendResult(magicinterp, cdir, NULL); + Tcl_AppendResult(magicinterp, cdir, (char *)NULL); #else TxPrintf("Directions = %s\n", cdir); #endif From 2d2c9a87ba93f10ef9a59f398d50d0ed0ea44772 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:23:41 +0100 Subject: [PATCH 16/20] TCL9: TxResetTerminal(bool force) added arguments This seems like it has 2 use cases. Internal console management around reprinting command prompt, but many modes of operation delegate the prompt processing to tkcon or readline. Process termination to restore the termios. --- tcltk/tclmagic.c | 4 ++-- textio/textio.h | 2 +- textio/txInput.c | 10 ++++++---- utils/main.c | 2 +- utils/signals.c | 6 +++--- 5 files changed, 13 insertions(+), 11 deletions(-) diff --git a/tcltk/tclmagic.c b/tcltk/tclmagic.c index d047fe35..640ae1fe 100644 --- a/tcltk/tclmagic.c +++ b/tcltk/tclmagic.c @@ -634,7 +634,7 @@ _magic_initialize(ClientData clientData, return TCL_OK; magicfatal: - TxResetTerminal(); + TxResetTerminal(FALSE); Tcl_SetResult(interp, "Magic initialization encountered a fatal error.", NULL); return TCL_ERROR; } @@ -780,7 +780,7 @@ _magic_startup(ClientData clientData, NULL); } - TxResetTerminal(); + TxResetTerminal(FALSE); if (TxTkConsole) { diff --git a/textio/textio.h b/textio/textio.h index aa3e5fff..35adf6fb 100644 --- a/textio/textio.h +++ b/textio/textio.h @@ -89,7 +89,7 @@ extern void TxReprint(); /* terminal-state procedures */ extern void TxSetTerminal(); -extern void TxResetTerminal(); +extern void TxResetTerminal(bool force); extern char TxEOFChar; /* The current EOF character */ extern char TxInterruptChar; /* The current interrupt character */ diff --git a/textio/txInput.c b/textio/txInput.c index 3a6ef16d..20b527ac 100644 --- a/textio/txInput.c +++ b/textio/txInput.c @@ -1004,7 +1004,7 @@ TxGetLineWPrompt(dest, maxChars, prompt, prefix) txReprint1 = NULL; #else _rl_prefix = prefix; - TxResetTerminal (); + TxResetTerminal (FALSE); if (prompt != NULL) { res = readline (prompt); @@ -1427,6 +1427,9 @@ TxSetTerminal() * * Returns the terminal to the way it was when Magic started up. * + * 'force' maybe set for atexit() restoration, when the console + * input handler is no longer in effect. Also crash handling, SIGSTOP. + * * Results: * none. * @@ -1436,13 +1439,12 @@ TxSetTerminal() */ void -TxResetTerminal() +TxResetTerminal(bool force) { - #ifdef MAGIC_WRAPPER /* If using Tk console, don't mess with the terminal settings; */ /* Otherwise, this prevents running magic in the terminal background. */ - if (TxTkConsole) return; + if (TxTkConsole && !force) return; #endif if (TxStdinIsatty && haveCloseState) txSetTermState(&closeTermState); diff --git a/utils/main.c b/utils/main.c index a3f218a7..6f57447e 100644 --- a/utils/main.c +++ b/utils/main.c @@ -195,7 +195,7 @@ MainExit(errNum) DBRemoveBackup(); TxFlush(); - TxResetTerminal(); + TxResetTerminal(FALSE); /* set also atexit() handler */ #ifdef MAGIC_WRAPPER diff --git a/utils/signals.c b/utils/signals.c index 9250d6ea..e334a47e 100644 --- a/utils/signals.c +++ b/utils/signals.c @@ -204,7 +204,7 @@ sigRetVal sigOnStop(int signo) { /* fix things up */ - TxResetTerminal(); + TxResetTerminal(TRUE); GrStop(); /* restore the default action and resend the signal */ @@ -565,7 +565,7 @@ sigCrash(signum) strcpy(AbortMessage, msg); AbortFatal = TRUE; niceabort(); - TxResetTerminal(); + TxResetTerminal(TRUE); } #else if (magicNumber == 1239987) { @@ -585,7 +585,7 @@ sigCrash(signum) strcpy(AbortMessage, msg); AbortFatal = TRUE; niceabort(); - TxResetTerminal(); + TxResetTerminal(TRUE); } #endif From 94aa77d2ccd6b62a65e4584b797f3fc4b3c77d99 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:24:29 +0100 Subject: [PATCH 17/20] TCL9: *.tcl changes $::tcl_platform --- tcltk/tkcon.tcl | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tcltk/tkcon.tcl b/tcltk/tkcon.tcl index 3e76fa6e..1793a5cb 100755 --- a/tcltk/tkcon.tcl +++ b/tcltk/tkcon.tcl @@ -235,7 +235,7 @@ proc ::tkcon::Init {} { ## Do platform specific configuration here, other than defaults ### Use tkcon.cfg filename for resource filename on non-unix systems ### Determine what directory the resource file should be in - switch $tcl_platform(platform) { + switch $::tcl_platform(platform) { macintosh { if {![interp issafe]} {cd [file dirname [info script]]} set envHome PREF_FOLDER @@ -1153,7 +1153,7 @@ proc ::tkcon::InitMenus {w title} { -command ::tkcon::Destroy $m add command -label "Clear Console" -underline 1 -accel Ctrl-l \ -command { clear; ::tkcon::Prompt } - if {[string match unix $tcl_platform(platform)]} { + if {[string match unix $::tcl_platform(platform)]} { $m add separator $m add command -label "Make Xauth Secure" -und 5 \ -command ::tkcon::XauthSecure @@ -1191,7 +1191,7 @@ proc ::tkcon::InitMenus {w title} { ## Attach Display Menu ## - if {![string compare "unix" $tcl_platform(platform)]} { + if {![string compare "unix" $::tcl_platform(platform)]} { $sub add cascade -label "Display" -und 1 -menu $sub.disp menu $sub.disp -disabledforeground $COLOR(disabled) \ -tearoff 0 \ @@ -1577,7 +1577,7 @@ proc ::tkcon::NamespacesList {names} { proc ::tkcon::XauthSecure {} { global tcl_platform - if {[string compare unix $tcl_platform(platform)]} { + if {[string compare unix $::tcl_platform(platform)]} { # This makes no sense outside of Unix return } @@ -4176,7 +4176,7 @@ proc ::tkcon::Bindings {} { # and auto-scanning. #----------------------------------------------------------------------- - switch -glob $tcl_platform(platform) { + switch -glob $::tcl_platform(platform) { win* { set PRIV(meta) Alt } mac* { set PRIV(meta) Command } default { set PRIV(meta) Meta } @@ -4817,7 +4817,7 @@ proc ::tkcon::ExpandPathname str { } else { if {[llength $m] > 1} { global tcl_platform - if {[string match windows $tcl_platform(platform)]} { + if {[string match windows $::tcl_platform(platform)]} { ## Windows is screwy because it's case insensitive set tmp [ExpandBestMatch [string tolower $m] \ [string tolower $dir]] From 8449c75158f93e86255a2e763f82fe8d4615007f Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:26:25 +0100 Subject: [PATCH 18/20] TCL9: FIXME OPTIONAL magic.h ClientData This did not work as expected. Maybe that indicate this should have a slighlt restructure so the tcl.h definition is always given a chance to provide type. Or maybe autoconf should detect the type and provide in config.h ? --- utils/magic.h | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/utils/magic.h b/utils/magic.h index 44934239..714e3b37 100644 --- a/utils/magic.h +++ b/utils/magic.h @@ -60,7 +60,15 @@ typedef int64_t dlong; /* --------------------- Universal pointer type ----------------------- */ #ifndef _CLIENTDATA +// #ifdef MAGIC_WRAPPER +//#error "ClientData type is not defined, but we are building with TCL support, so we expect TCL to provide this type definition" +// #endif + #ifndef NO_VOID +typedef void *ClientData; + #else typedef pointertype ClientData; + #endif +#define _CLIENTDATA #endif /* this is not the (int) C type, but the conceptual difference between From 0e81416f8142592bff0f3597c8136db1aad82429 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:28:34 +0100 Subject: [PATCH 19/20] Revert "TCL9: *.tcl changes $::tcl_platform" This reverts commit 8adbd75760aeeb4f39507dcd3e746287381b7b38. --- tcltk/tkcon.tcl | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tcltk/tkcon.tcl b/tcltk/tkcon.tcl index 1793a5cb..3e76fa6e 100755 --- a/tcltk/tkcon.tcl +++ b/tcltk/tkcon.tcl @@ -235,7 +235,7 @@ proc ::tkcon::Init {} { ## Do platform specific configuration here, other than defaults ### Use tkcon.cfg filename for resource filename on non-unix systems ### Determine what directory the resource file should be in - switch $::tcl_platform(platform) { + switch $tcl_platform(platform) { macintosh { if {![interp issafe]} {cd [file dirname [info script]]} set envHome PREF_FOLDER @@ -1153,7 +1153,7 @@ proc ::tkcon::InitMenus {w title} { -command ::tkcon::Destroy $m add command -label "Clear Console" -underline 1 -accel Ctrl-l \ -command { clear; ::tkcon::Prompt } - if {[string match unix $::tcl_platform(platform)]} { + if {[string match unix $tcl_platform(platform)]} { $m add separator $m add command -label "Make Xauth Secure" -und 5 \ -command ::tkcon::XauthSecure @@ -1191,7 +1191,7 @@ proc ::tkcon::InitMenus {w title} { ## Attach Display Menu ## - if {![string compare "unix" $::tcl_platform(platform)]} { + if {![string compare "unix" $tcl_platform(platform)]} { $sub add cascade -label "Display" -und 1 -menu $sub.disp menu $sub.disp -disabledforeground $COLOR(disabled) \ -tearoff 0 \ @@ -1577,7 +1577,7 @@ proc ::tkcon::NamespacesList {names} { proc ::tkcon::XauthSecure {} { global tcl_platform - if {[string compare unix $::tcl_platform(platform)]} { + if {[string compare unix $tcl_platform(platform)]} { # This makes no sense outside of Unix return } @@ -4176,7 +4176,7 @@ proc ::tkcon::Bindings {} { # and auto-scanning. #----------------------------------------------------------------------- - switch -glob $::tcl_platform(platform) { + switch -glob $tcl_platform(platform) { win* { set PRIV(meta) Alt } mac* { set PRIV(meta) Command } default { set PRIV(meta) Meta } @@ -4817,7 +4817,7 @@ proc ::tkcon::ExpandPathname str { } else { if {[llength $m] > 1} { global tcl_platform - if {[string match windows $::tcl_platform(platform)]} { + if {[string match windows $tcl_platform(platform)]} { ## Windows is screwy because it's case insensitive set tmp [ExpandBestMatch [string tolower $m] \ [string tolower $dir]] From 5f41c9e4772735d79455b39aecf3fda84258cb42 Mon Sep 17 00:00:00 2001 From: "Darryl L. Miles" Date: Mon, 21 Oct 2024 09:30:16 +0100 Subject: [PATCH 20/20] HACK tkcon.tcl to get it running --- tcltk/tkcon.tcl | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tcltk/tkcon.tcl b/tcltk/tkcon.tcl index 3e76fa6e..8c9e67f2 100755 --- a/tcltk/tkcon.tcl +++ b/tcltk/tkcon.tcl @@ -64,14 +64,14 @@ catch {unset pkg file name version} # Tk 8.4 makes previously exposed stuff private. # FIX: Update tkcon to not rely on the private Tk code. # -if {![llength [info globals tkPriv]]} { - ::tk::unsupported::ExposePrivateVariable tkPriv -} -foreach cmd {SetCursor UpDownLine Transpose ScrollPages} { - if {![llength [info commands tkText$cmd]]} { - ::tk::unsupported::ExposePrivateCommand tkText$cmd - } -} +#if {![llength [info globals tkPriv]]} { +# ::tk::unsupported::ExposePrivateVariable tkPriv +#} +#foreach cmd {SetCursor UpDownLine Transpose ScrollPages} { +# if {![llength [info commands tkText$cmd]]} { +# ::tk::unsupported::ExposePrivateCommand tkText$cmd +# } +#} # Initialize the ::tkcon namespace #