Merge pull request #3739 from BsAtHome/fix_tcl9-part2

Fix running with tcl/tk 9

Author: andypugh

configs/sim/qtvcp_screens/.gitignore

@@ -1,4 +1,5 @@
 *.var
 *.var.bak
 position*.txt
-
+qtaxis.pref
+qtvcp/

lib/python/rs274/OpenGLTk.py

@@ -380,8 +380,8 @@ def tkPrint(self, file):
         self.activate()
 
     def zoomwheel(self, event):
-        if event.delta > 0: self.zoomin(event)
-        else: self.zoomout(event)
+        if event.delta > 0: self.zoomin()
+        else: self.zoomout()
 
     def tkStartZoom(self, event):
         self.startZoom(event.y)

src/configure.ac

@@ -700,6 +700,7 @@ if test "xyes" = "x$RUN_IN_PLACE"; then
     EMC2_HELP_DIR=$EMC2_HOME/docs/help
     EMC2_RTLIB_DIR=$EMC2_HOME/rtlib
     LINUXCNC_CONFIG_PATH="~/linuxcnc/configs:$EMC2_HOME/configs"
+    LINUXCNC_CONFIG_PATH_TCL="$::env(HOME)/linuxcnc/configs:$EMC2_HOME/configs"
     EMC2_NCFILES_DIR=$EMC2_HOME/nc_files
     REALTIME=$EMC2_HOME/scripts/realtime
     EMC2_IMAGE_DIR=$EMC2_HOME
@@ -722,6 +723,7 @@ else
 	*) EMC2_RTLIB_DIR=$MODULE_DIR/linuxcnc
     esac
     LINUXCNC_CONFIG_PATH="~/linuxcnc/configs:/usr/local/etc/linuxcnc/configs:"$(eval echo $EMC2_HELP_DIR)"/examples/sample-configs"
+    LINUXCNC_CONFIG_PATH_TCL="$::env(HOME)/linuxcnc/configs:/usr/local/etc/linuxcnc/configs:"$(eval echo $EMC2_HELP_DIR)"/examples/sample-configs"
     EMC2_NCFILES_DIR=${prefix}/share/linuxcnc/ncfiles
     REALTIME=${prefix}/lib/linuxcnc/realtime
     EMC2_IMAGE_DIR=$(fe "$datadir")/linuxcnc
@@ -746,6 +748,7 @@ AC_SUBST([EMC2_HELP_DIR])
 AC_SUBST([EMC2_RTLIB_DIR])
 AC_SUBST([EMC2_LANG_DIR])
 AC_SUBST([LINUXCNC_CONFIG_PATH])
+AC_SUBST([LINUXCNC_CONFIG_PATH_TCL])
 AC_SUBST([EMC2_NCFILES_DIR])
 AC_SUBST([REALTIME])
 AC_SUBST([EMC2_IMAGE_DIR])
@@ -1354,9 +1357,9 @@ if test -z "$TKCONFIG"; then
 fi
 if (test "x$TKCONFIG" = "x"); then
     # search for tkConfig.sh
-    TKCONFIG=$(find /usr/lib -maxdepth 2 -name tkConfig.sh | sort -r | head -n1)
+    TKCONFIG=$(find /usr/lib* -maxdepth 2 -name tkConfig.sh | sort -r | head -n1)
     if (test "x$TKCONFIG" = "x"); then
-	TKCONFIG=$(find /usr/local/lib -maxdepth 2 -name tkConfig.sh | head -n1)
+	TKCONFIG=$(find /usr/local/lib* -maxdepth 2 -name tkConfig.sh | head -n1)
     fi
 fi
 
@@ -1380,6 +1383,14 @@ Tcl $TCL_VERSION and Tk $TK_VERSION.  You can use --with-tkConfig= and --with-tc
 to override the autodetected versions.])
 fi
 
+if test -z "$TCL_MAJOR_VERSION" || test -z "$TCL_MINOR_VERSION" ; then
+    AC_MSG_ERROR([tclConfig was not found or did not export TCL_MAJOR_VERSION/TCL_MINOR_VERSION. Cannot determine exact Tcl version.])
+fi
+
+if test "(" "$TCL_MAJOR_VERSION" -lt 8 ")" -o "(" "(" "$TCL_MAJOR_VERSION" -eq 8 ")" -a "(" "$TCL_MINOR_VERSION" -lt 4 ")" ")" ; then
+    AC_MSG_ERROR([Tcl version must be 8.4 or better. Your Tcl version ${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION} is too old.])
+fi
+
 if test -f $TCL_EXEC_PREFIX/bin/wish$TCL_VERSION; then
     WISH=$TCL_EXEC_PREFIX/bin/wish$TCL_VERSION
 elif test -f $TCL_EXEC_PREFIX/bin/wish; then
@@ -1424,13 +1435,16 @@ if test "$RUNTIME_CHECK" = "yes"; then
         AC_MSG_RESULT([not found])
     fi
 
-    AC_MSG_CHECKING([for tclX using $TCLSH])
-    if (unset DISPLAY; echo ["catch { package require Tclx }; exit [expr [lsearch [package names] Tclx] == -1]"] | $TCLSH); then
-        AC_MSG_RESULT([found])
-    else
-        AC_MSG_RESULT(no)
-        AC_MSG_ERROR([Tclx not found!
-    install with "sudo apt-get install tclx"])
+    # Don't need tclX anymore in Tcl9
+    if test "$TCL_MAJOR_VERSION" -lt 9; then
+        AC_MSG_CHECKING([for tclX using $TCLSH])
+        if (unset DISPLAY; echo ["catch { package require Tclx }; exit [expr [lsearch [package names] Tclx] == -1]"] | $TCLSH); then
+            AC_MSG_RESULT([found])
+        else
+            AC_MSG_RESULT(no)
+            AC_MSG_ERROR([Tclx not found!
+        install with "sudo apt-get install tclx"])
+        fi
     fi
 
     AC_MSG_CHECKING([for python pango module])

src/emc/usr_intf/axis/extensions/_toglmodule.c

@@ -33,12 +33,12 @@ PyObject *install(PyObject *s, PyObject *arg) {
         PyErr_SetString(PyExc_TypeError, "get_interpreter() returned NULL");
         return NULL;
     }
-    if (Tcl_InitStubs(trp, "8.1", 0) == NULL) 
+    if (Tcl_InitStubs(trp, TCL_VERSION, 0) == NULL)
     {
         PyErr_SetString(PyExc_RuntimeError, "Tcl_InitStubs returned NULL");
         return NULL;
     }
-    if (Tk_InitStubs(trp, "8.1", 0) == NULL) 
+    if (Tk_InitStubs(trp, TK_VERSION, 0) == NULL)
     {
         PyErr_SetString(PyExc_RuntimeError, "Tk_InitStubs returned NULL");
         return NULL;

src/emc/usr_intf/axis/extensions/togl.c

@@ -78,7 +78,7 @@
 #undef Tcl_InitHashTable
 #define Tcl_InitHashTable (tclStubsPtr->tcl_InitHashTable)
 #endif
-#if (TK_MAJOR_VERSION>=8 && TK_MINOR_VERSION>=4)
+#if TK_MAJOR_VERSION * 100 + TK_MINOR_VERSION >= 804
 #  define HAVE_TK_SETCLASSPROCS
 #endif
 
@@ -87,6 +87,14 @@
  * (this is needed for Tcl ver =< 8.4a3)
  */
 
+#ifndef _ANSI_ARGS_
+#define _ANSI_ARGS_(x)	x
+#endif
+
+#ifndef Tk_Offset
+#define Tk_Offset	offsetof
+#endif
+
 typedef int (TkBindEvalProc) _ANSI_ARGS_((ClientData clientData,
 	Tcl_Interp *interp, XEvent *eventPtr, Tk_Window tkwin,
 	KeySym keySym));
@@ -700,18 +708,18 @@ int Togl_Init(Tcl_Interp *interp)
    int major,minor,patchLevel,releaseType;
 
 #ifdef USE_TCL_STUBS
-   if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {return TCL_ERROR;}
+   if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {return TCL_ERROR;}
 #endif
 #ifdef USE_TK_STUBS
-   if (Tk_InitStubs(interp, "8.1", 0) == NULL) {return TCL_ERROR;}
+   if (Tk_InitStubs(interp, TK_VERSION, 0) == NULL) {return TCL_ERROR;}
 #endif
 
    /* Skip all this on Tcl/Tk 8.0 or older.  Seems to work */
 #if TCL_MAJOR_VERSION * 100 + TCL_MINOR_VERSION > 800
    Tcl_GetVersion(&major,&minor,&patchLevel,&releaseType);
 
 #ifndef HAVE_TK_SETCLASSPROCS
-   if (major >= 8 && minor >= 4) {
+   if (major * 100 + minor >= 804) {
      TCL_ERR(interp,"Sorry, this instance of Togl was not compiled to work with Tcl/Tk 8.4 or higher.");
    }
 #endif
@@ -1049,13 +1057,26 @@ int Togl_Configure(Tcl_Interp *interp, struct Togl *togl,
    int oldStencilSize = togl->StencilSize;
    int oldAuxNumber   = togl->AuxNumber;
 
-#ifndef CONST84
-#define CONST84
+#if TK_MAJOR_VERSION >= 9
+   // Version 9+ uses Tcl_Obj* array as config whereas older uses a char* array
+   Tcl_Obj **optr = calloc(argc+1, sizeof(*optr));  // argc+1 to terminate list with a NULL pointer
+   for(int u = 0; u < argc; u++) {
+      optr[u] = Tcl_NewStringObj(argv[u], -1);
+   }
+#else
+   char **optr = argv;
 #endif
    if (Tk_ConfigureWidget(interp, togl->TkWin, configSpecs,
-                          argc, (CONST84 char**)argv, (char *)togl, flags) == TCL_ERROR) {
+                          argc, (void *)optr, (char *)togl, flags) == TCL_ERROR) {
       return(TCL_ERROR);
    }
+#if TK_VERSION_MAJOR >= 9
+   for(int u = 0; u < argc; u++) {
+      Tcl_DecrRefCount(optr[u]);
+   }
+   free(optr);
+#endif
+
 #ifndef USE_OVERLAY
    if (togl->OverlayFlag) {
      TCL_ERR(interp,"Sorry, overlay was disabled");
@@ -1126,7 +1147,7 @@ int Togl_Widget(ClientData clientData, Tcl_Interp *interp,
       return TCL_ERROR;
    }
 
-   Tk_Preserve((ClientData)togl);
+   Tcl_Preserve((ClientData)togl);
 
    if (!strncmp(argv[1], "configure", MAX(1, strlen(argv[1])))) {
       if (argc == 2) {
@@ -1237,12 +1258,10 @@ int Togl_Widget(ClientData clientData, Tcl_Interp *interp,
       }
    }
 
-   Tk_Release((ClientData)togl);
+   Tcl_Release((ClientData)togl);
    return result;
 }
 
-
-
 /*
  * Togl_Cmd
  *
@@ -1421,7 +1440,7 @@ static int Togl_Cmd(ClientData clientData, Tcl_Interp *interp,
 
    /* If defined, setup timer */
    if (togl->TimerProc){
-      Tk_CreateTimerHandler( togl->TimerInterval, Togl_Timer, (ClientData)togl );
+      Tcl_CreateTimerHandler( togl->TimerInterval, Togl_Timer, (ClientData)togl );
    }
 
    Tcl_AppendResult(interp, Tk_PathName(tkwin), NULL);
@@ -2153,7 +2172,11 @@ static void ToglCmdDeletedProc( ClientData clientData )
  * Gets called when an Togl widget is destroyed.
  */
 #if (TK_MAJOR_VERSION * 100 + TK_MINOR_VERSION) >= 401
+#if TK_MAJOR_VERSION >= 9
+static void Togl_Destroy( void *clientData )
+#else
 static void Togl_Destroy( char *clientData )
+#endif
 #else
 static void Togl_Destroy( ClientData clientData )
 #endif
@@ -2284,7 +2307,7 @@ void Togl_PostRedisplay( struct Togl *togl )
 {
    if (!togl->UpdatePending) {
       togl->UpdatePending = GL_TRUE;
-      Tk_DoWhenIdle( Togl_Render, (ClientData) togl );
+      Tcl_DoWhenIdle( Togl_Render, (ClientData) togl );
    }
 }
 
@@ -2863,7 +2886,7 @@ void Togl_PostOverlayRedisplay( struct Togl *togl )
 {
    if (!togl->OverlayUpdatePending
        && togl->OverlayWindow && togl->OverlayDisplayProc) {
-      Tk_DoWhenIdle( RenderOverlay, (ClientData) togl );
+      Tcl_DoWhenIdle( RenderOverlay, (ClientData) togl );
       togl->OverlayUpdatePending = 1;
    }
 }

src/emc/usr_intf/axis/scripts/axis.py

@@ -1660,7 +1660,7 @@ def __init__(self, title, text, default, unit_str=''):
         self.buttons = f = Tkinter.Frame(t)
         self.ok = Tkinter.Button(f, text=_("OK"), command=self.do_ok, width=10,height=1,padx=0,pady=.25, default="active")
         self.cancel = Tkinter.Button(f, text=_("Cancel"), command=self.do_cancel, width=10,height=1,padx=0,pady=.25, default="normal")
-        v.trace("w", self.check_valid)
+        v.trace_add("write", self.check_valid)
         t.wm_protocol("WM_DELETE_WINDOW", self.cancel.invoke)
         t.bind("<Return>", lambda event: (self.ok.flash(), self.ok.invoke()))
         t.bind("<KP_Enter>", lambda event: (self.ok.flash(), self.ok.invoke()))
@@ -1769,7 +1769,7 @@ def __init__(self, title, text_pattern, default, tool_only, defaultsystem):
         f = Frame(t)
         self.c = c = StringVar(t)
         c.set(defaultsystem)
-        c.trace_variable("w", self.change_system)
+        c.trace_add("write", self.change_system)
         if not tool_only:
             l = Label(f, text=_("Coordinate System:"))
             mb = OptionMenu(f, c, *systems)
@@ -4268,7 +4268,7 @@ def forget(widget, *pins):
 
 set_motion_teleop(0) # start in joint mode
 
-root_window.tk.call("trace", "variable", "metric", "w", "update_units")
+root_window.tk.call("trace", "add", "variable", "metric", "write", "update_units")
 install_help(root_window)
 
 widgets.numbers_text.bind("<Configure>", commands.redraw_soon)

src/emc/usr_intf/emcsh.cc

@@ -39,6 +39,10 @@
 
 #define setresult(t,s) Tcl_SetObjResult((t), Tcl_NewStringObj((s),-1))
 
+#ifndef CONST
+#define CONST const
+#endif
+
 /*
   Using tcl package Linuxcnc:
   Using emcsh:
@@ -3421,7 +3425,7 @@ extern "C"
 int Linuxcnc_Init(Tcl_Interp * interp);
 int Linuxcnc_Init(Tcl_Interp * interp)
 {
-    if (Tcl_InitStubs(interp, "8.1", 0) == NULL)
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
     {
         return TCL_ERROR;
     }

src/hal/utils/halsh.c

@@ -94,7 +94,7 @@ int Hal_Init(Tcl_Interp *interp) {
 	return TCL_ERROR;
     }
 
-    if (Tcl_InitStubs(interp, "8.1", 0) == NULL)
+    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL)
     {
         return TCL_ERROR;
     }

tcl/bin/halshow.tcl

@@ -42,8 +42,8 @@ if {[info exists ::env(CONFIG_DIR)]} {
     set ::INIDIR "${config_path}"
     set ::INIFILE "${config_path}halshow.preferences"
 } else {
-    set ::INIDIR "~"
-    set ::INIFILE "~/.halshow_preferences"
+    set ::INIDIR "$::env(HOME)"
+    set ::INIFILE "$::env(HOME)/.halshow_preferences"
 }
 # puts stderr "Halshow inifile: $::INIFILE"
 

tcl/linuxcnc.tcl.in

@@ -25,15 +25,15 @@ namespace eval linuxcnc {
     variable TCL_SCRIPT_DIR @EMC2_TCL_DIR@/scripts
     variable HELP_DIR @EMC2_HELP_DIR@
     variable RTLIB_DIR @EMC2_RTLIB_DIR@
-    variable CONFIG_PATH {@LINUXCNC_CONFIG_PATH@}
+    variable CONFIG_PATH {@LINUXCNC_CONFIG_PATH_TCL@}
     variable NCFILES_DIR @EMC2_NCFILES_DIR@
     variable LANG_DIR @EMC2_LANG_DIR@
     variable IMAGEDIR @EMC2_IMAGE_DIR@
     variable REALTIME @REALTIME@
     variable RTS @RTS@
     variable CONFIG_DIR {}
     variable _dir
-    foreach _dir  [split {@LINUXCNC_CONFIG_PATH@} :] {
+    foreach _dir  [split {@LINUXCNC_CONFIG_PATH_TCL@} :] {
 	lappend CONFIG_DIR [file normalize $_dir]
     }
     unset _dir