Support compilation against Tcl 8.6 and with MSVC 8 and 9.

Signed-off-by: Pat Thoyts <patthoyts@users.sourceforge.net>

diff --git a/src/ComObject.cpp b/src/ComObject.cpp
index 89e693e2c86c00fe13f6677c97a773b5e8253106..cb6baf91ef26cbf196f340482b813671a2e2dd8b 100644 (file)
--- a/src/ComObject.cpp
+++ b/src/ComObject.cpp
@@ -131,7 +131,7 @@ int
 ComObject::eval (TclObject script, TclObject *pResult)
 {
     int completionCode =
-#if TCL_MINOR_VERSION >= 1
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 81
         Tcl_EvalObjEx(m_interp, script, TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
 #else
         Tcl_GlobalEvalObj(m_interp, script);
@@ -165,7 +165,7 @@ ComObject::setVariable (TclObject name, TclObject value)
 HRESULT
 ComObject::hresultFromErrorCode () const
 {
-#if TCL_MINOR_VERSION >= 1
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 81
     Tcl_Obj *pErrorCode =
         Tcl_GetVar2Ex(m_interp, "::errorCode", 0, TCL_LEAVE_ERR_MSG);
 #else
@@ -569,7 +569,7 @@ convertNativeToTclObject (va_list pArg,
     case VT_LPWSTR:
     case VT_BSTR:
         {
-#if TCL_MINOR_VERSION >= 2
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 82
             // Uses Unicode function introduced in Tcl 8.2.
             Tcl_UniChar *pUnicode = byRef ?
                 *va_arg(pArg, Tcl_UniChar **) : va_arg(pArg, Tcl_UniChar *);

diff --git a/src/ComObjectFactory.cpp b/src/ComObjectFactory.cpp
index 710f2610ea2e7d577da3c17393a95333bb3176a1..0379a00ff07dac873b501f11bdc662c7eb74aa2b 100644 (file)
--- a/src/ComObjectFactory.cpp
+++ b/src/ComObjectFactory.cpp
@@ -79,7 +79,7 @@ int
 ComObjectFactory::eval (TclObject script, TclObject *pResult)
 {
     int completionCode =
-#if TCL_MINOR_VERSION >= 1
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 81
         Tcl_EvalObjEx(m_interp, script, TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
 #else
         Tcl_GlobalEvalObj(m_interp, script);

diff --git a/src/Extension.cpp b/src/Extension.cpp
index 01c20372918d548e6a260bc9c11fada0278e96db..dcc173bc06ce60170364df60fa09c86b4fa42037 100644 (file)
--- a/src/Extension.cpp
+++ b/src/Extension.cpp
@@ -94,9 +94,9 @@ Extension::typeofCmd (
        return TCL_ERROR;
     }
 
-    Tcl_ObjType *pType = objv[1]->typePtr;
-    char *name = (pType == 0) ? "NULL" : pType->name;
-    Tcl_SetResult(interp, name, TCL_STATIC);
+    const Tcl_ObjType *pType = objv[1]->typePtr;
+    const char *name = (pType == 0) ? "NULL" : pType->name;
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
     return TCL_OK;
 }
 

diff --git a/src/Extension.h b/src/Extension.h
index a354e988ba7b5a05ff294029ea05a55aebfc28f4..3d1a19ad26ed8c471f826ee446b933b206e23967 100644 (file)
--- a/src/Extension.h
+++ b/src/Extension.h
@@ -3,7 +3,7 @@
 #define EXTENSION_H
 
 #include <comdef.h>
-#include <tcl.h>
+#include "tclRunTime.h" //<tcl.h>
 #include "tcomApi.h"
 #include "HandleSupport.h"
 

diff --git a/src/HandleSupport.h b/src/HandleSupport.h
index d3a8d2d4db9574c9cf90bf4d97217e8cba5ade4a..3bfa99c620aadbb4c153b565cea3560022a5c991 100644 (file)
--- a/src/HandleSupport.h
+++ b/src/HandleSupport.h
@@ -2,7 +2,7 @@
 #ifndef HANDLESUPPORT_H
 #define HANDLESUPPORT_H
 
-#include <tcl.h>
+#include "tclRunTime.h" //<tcl.h>
 #include <string>
 #include "tcomApi.h"
 #include "Singleton.h"

diff --git a/src/HashTable.h b/src/HashTable.h
index 25f694931371aee522690094f8abfb901f11b18a..1dc144dfecb140f1256da9bb84e4011b4b32f7f3 100644 (file)
--- a/src/HashTable.h
+++ b/src/HashTable.h
@@ -2,7 +2,7 @@
 #ifndef HASHTABLE_H
 #define HASHTABLE_H
 
-#include <tcl.h>
+#include "tclRunTime.h" //<tcl.h>
 
 // Function object that invokes delete on its argument
 

diff --git a/src/Singleton.h b/src/Singleton.h
index 078d93d9855d5688b9d96756a03e3181ace0ef88..2608a38430a503bd43ef71c94506b0b1202c781c 100644 (file)
--- a/src/Singleton.h
+++ b/src/Singleton.h
@@ -2,7 +2,7 @@
 #ifndef SINGLETON_H
 #define SINGLETON_H
 
-#include <tcl.h>
+#include "tclRunTime.h" //<tcl.h>
 #include "mutex.h"
 
 // This template class provides code to construct and destroy a singleton.

diff --git a/src/TclInterp.h b/src/TclInterp.h
index 350695c1a456f9396c699e0bbb48538b33121fb1..b36abe13569b657917cb017d280188e5a498efca 100644 (file)
--- a/src/TclInterp.h
+++ b/src/TclInterp.h
@@ -3,7 +3,9 @@
 #define TCLINTERP_H
 
 #include <string>
-#include <tcl.h>
+#include "tclRunTime.h" //<tcl.h>
+
+
 
 class TclObject;
 

diff --git a/src/TclObject.cpp b/src/TclObject.cpp
index 2a924b6fd0ff193c1e7aab95430278559a164a5d..3ef5112615b6451eae1d20065ec726b7f49e887a 100644 (file)
--- a/src/TclObject.cpp
+++ b/src/TclObject.cpp
@@ -201,7 +201,7 @@ convertFromSafeArray (
 
         long length = upperBound - lowerBound + 1;
         pResult =
-#if TCL_MINOR_VERSION >= 1
+#if TCL_MAJOR_VERSION * 10 + TCL_MINOR_VERSION >= 81
             // Convert array of bytes to Tcl byte array.
             Tcl_NewByteArrayObj(pData, length);
 #else
@@ -437,9 +437,10 @@ TclObject::TclObject (VARIANT *pSrc, const Type &type, Tcl_Interp *interp)
 TclObject::TclObject (const _bstr_t &src)
 {
     if (src.length() > 0) {
-#if TCL_MINOR_VERSION >= 2
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION > 81
         // Uses Unicode functions introduced in Tcl 8.2.
-        m_pObj = Tcl_NewUnicodeObj(src, -1);
+        const wchar_t *wsz = src;
+        m_pObj = Tcl_NewUnicodeObj((const Tcl_UniChar *)wsz, -1);
 #else
         m_pObj = Tcl_NewStringObj(src, -1);
 #endif
@@ -545,7 +546,7 @@ TclObject::getSafeArray (const Type &elementType, Tcl_Interp *interp) const
 
             case VT_I2:
             case VT_UI2:
-                static_cast<short *>(pData)[i] = value.getLong();
+                static_cast<short *>(pData)[i] = static_cast<short>(value.getLong());
                 break;
 
             case VT_R4:

diff --git a/src/TclObject.h b/src/TclObject.h
index 35c3cb206faaf1195ca679bdf52e59b4deb156ee..afa6129cce9008a79f4a04b36b1da1822edaaf61 100644 (file)
--- a/src/TclObject.h
+++ b/src/TclObject.h
@@ -6,7 +6,7 @@
 #include "TypeInfo.h"
 #include "NativeValue.h"
 #endif
-#include <tcl.h>
+#include "tclRunTime.h" //<tcl.h>
 #include <string>
 #include "tcomApi.h"
 
@@ -34,7 +34,7 @@ public:
     static Tcl_ObjType *listType ()
     { return ms_pListType; }
 
-#if TCL_MINOR_VERSION >= 1
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 81
 private:
     static Tcl_ObjType *ms_pByteArrayType;
 
@@ -75,7 +75,7 @@ public:
     const char *c_str () const
     { return Tcl_GetStringFromObj(const_cast<Tcl_Obj *>(m_pObj), 0); }
 
-#if TCL_MINOR_VERSION >= 2
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 82
     // Construct Unicode string value.
     TclObject(const wchar_t *src, int len = -1);
 

diff --git a/src/foreachCmd.cpp b/src/foreachCmd.cpp
index f6e57589db267b8add570bc879aa25aab2653e36..b73063816daa1f759ae627900e2cd9d13b901159 100644 (file)
--- a/src/foreachCmd.cpp
+++ b/src/foreachCmd.cpp
@@ -156,7 +156,7 @@ Extension::foreachCmd (
 
         // Execute the script body.
         completionCode =
-#if TCL_MINOR_VERSION >= 1
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 81
             Tcl_EvalObjEx(interp, pBody, 0);
 #else
             Tcl_EvalObj(interp, pBody);
@@ -169,7 +169,7 @@ Extension::foreachCmd (
             break;
         } else if (completionCode == TCL_ERROR) {
            std::ostringstream oss;
-            oss << "\n    (\"foreach\" body line %d)" << interp->errorLine;
+            oss << "\n    (\"foreach\" body line %d)" << Tcl_GetErrorLine(interp);
             Tcl_AddObjErrorInfo(
                 interp, const_cast<char *>(oss.str().c_str()), -1);
             break;

diff --git a/src/importCmd.cpp b/src/importCmd.cpp
index b3d5c8bb1cb0b3bc8a7fca0a1c7a0619d700c104..b178499ea814b6c4b68ea853a423b4a69ac9bb35 100644 (file)
--- a/src/importCmd.cpp
+++ b/src/importCmd.cpp
@@ -173,7 +173,7 @@ Extension::interfaceCmd (
         s_pCurrentInterface = pInterface;
 
         int completionCode =
-#if TCL_MINOR_VERSION >= 1
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 81
             Tcl_EvalObjEx(interp, objv[3], TCL_EVAL_GLOBAL);
 #else
             Tcl_GlobalEvalObj(interp, objv[3]);
@@ -484,7 +484,7 @@ Extension::importCmd (
 
         script << '}' << std::endl;     // end of namespace
 
-#if TCL_MINOR_VERSION >= 1
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 81
         Tcl_EvalEx(
             interp,
             const_cast<char *>(script.str().c_str()),

diff --git a/src/main.cpp b/src/main.cpp
index eff5738485fbf679ca1146f24c0a767977e55c46..4c0a27e70757420f6af9df20694787daf1a4f476 100644 (file)
--- a/src/main.cpp
+++ b/src/main.cpp
@@ -6,6 +6,8 @@
 #include "version.h"
 #include "tclRunTime.h"
 
+#pragma comment(lib, "rpcrt4")
+
 /*
  *     This procedure performs application-specific initialization.
  *     Most applications, especially those that incorporate additional
@@ -21,12 +23,10 @@
 extern "C" DLLEXPORT int
 Tcom_Init (Tcl_Interp *interp)
 {
-#ifdef USE_TCL_STUBS
     // Stubs were introduced in Tcl 8.1.
     if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
         return TCL_ERROR;
     }
-#endif
 
     // Get pointers to Tcl's built-in internal representation types.
     TclTypes::initialize();

diff --git a/src/refCmd.cpp b/src/refCmd.cpp
index a21daeffbd4725b22fc277078ba3c47e9c8faaa0..9a964571ea29aaea7b408d4037dbb68dc87d3bb5 100644 (file)
--- a/src/refCmd.cpp
+++ b/src/refCmd.cpp
@@ -43,7 +43,7 @@ getErrorInfo (Reference *pReference, IErrorInfo **ppErrorInfo)
 static Tcl_Obj *
 formatMessage (HRESULT hresult)
 {
-#if TCL_MINOR_VERSION >= 2
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 82
     // Uses Unicode functions introduced in Tcl 8.2.
     wchar_t *pMessage;
     DWORD nLen = FormatMessageW(
@@ -77,9 +77,9 @@ formatMessage (HRESULT hresult)
         pMessage[nLen] = '\0';
 
         
-#if TCL_MINOR_VERSION >= 2
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 82
         // Uses Unicode functions introduced in Tcl 8.2.
-        pDescription = Tcl_NewUnicodeObj(pMessage, nLen);
+        pDescription = Tcl_NewUnicodeObj((const Tcl_UniChar *)pMessage, nLen);
 #else
         pDescription = Tcl_NewStringObj(pMessage, nLen);
 #endif
@@ -523,8 +523,8 @@ getObjectCmd (
        return TCL_ERROR;
     }
 
-#if TCL_MINOR_VERSION >= 2
-    const wchar_t *monikerName = Tcl_GetUnicode(objv[2]);
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION >= 82
+    const wchar_t *monikerName = (const wchar_t *)Tcl_GetUnicode(objv[2]);
 #else
     _bstr_t monikerName(Tcl_GetStringFromObj(objv[2], 0));
 #endif

diff --git a/src/tclRunTime.h b/src/tclRunTime.h
index 3bac0cbd50040dbe925826c5f526c0bc49132182..2e40926431ecf14277dc086dd20197b7ea40b10b 100644 (file)
--- a/src/tclRunTime.h
+++ b/src/tclRunTime.h
@@ -4,6 +4,14 @@
 
 #include <tcl.h>
 
+// Tcl API compatability macros
+
+// Tcl 8.6 introduced Tcl_GetErrorLine and removed interp->errorLine
+#if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86
+#define Tcl_GetErrorLine(interp) (interp)->errorLine
+#define CONST86
+#endif
+
 // Link the Tcl run-time library.
 #ifdef USE_TCL_STUBS
 #pragma comment(lib, \

diff --git a/src/variantCmd.cpp b/src/variantCmd.cpp
index cbad50e03e58eeb516f4f56bfeebbfd9a7eb2bbf..0a5e3e9de1e4bd9f39b5d83b21d9c96ad61a8ffa 100644 (file)
--- a/src/variantCmd.cpp
+++ b/src/variantCmd.cpp
@@ -39,7 +39,7 @@ variantSetFromAny (Tcl_Interp *interp, Tcl_Obj *pObj)
 {
     const char *stringRep = Tcl_GetStringFromObj(pObj, 0);
 
-    Tcl_ObjType *pOldType = pObj->typePtr;
+    const Tcl_ObjType *pOldType = pObj->typePtr;
     if (pOldType != NULL && pOldType->freeIntRepProc != NULL) {
        pOldType->freeIntRepProc(pObj);
     }