Merge tag 'upstream/3.1.1+dfsg1'

Upstream version 3.1.1+dfsg1

# gpg: Signature made Thu 09 Feb 2017 04:37:24 AM EST
# gpg:                using RSA key 5001E1B09AA3744B
# gpg:                issuer "unit193@ubuntu.com"
# gpg: Good signature from "Unit 193 <unit193@ubuntu.com>" [unknown]
# gpg:                 aka "Unit 193 <unit193@gmail.com>" [unknown]
# gpg: WARNING: This key is not certified with a trusted signature!
# gpg:          There is no indication that the signature belongs to the owner.
# Primary key fingerprint: 8DB3 E586 865D 2B4A 2B18  5A5C 5001 E1B0 9AA3 744B

1 files changed, 23 insertions, 0 deletions

diff --git a/Plugins/ScriptingTcl/scriptingtcl.cpp b/Plugins/ScriptingTcl/scriptingtcl.cpp
index 4390317..962c073 100644
--- a/Plugins/ScriptingTcl/scriptingtcl.cpp
+++ b/Plugins/ScriptingTcl/scriptingtcl.cpp
@@ -435,6 +435,28 @@ int ScriptingTcl::dbCommand(ClientData clientData, Tcl_Interp* interp, int objc,
     return TCL_ERROR;
 }
 
+int ScriptingTcl::initTclCommand(ClientData clientData, Tcl_Interp* interp, int objc, Tcl_Obj* const objv[])
+{
+    UNUSED(clientData);
+    UNUSED(objv);
+
+    if (objc > 1)
+    {
+        Tcl_Obj* result = Tcl_NewStringObj(tr("Error from Tcl's' '%1' command: %2").arg("tcl_init", "invalid # args: tcl_init").toUtf8().constData(), -1);
+        Tcl_SetObjResult(interp, result);
+        return TCL_ERROR;
+    }
+
+    int res = Tcl_Init(interp);
+    if (res != TCL_OK)
+    {
+        ScriptObject codeObj("set tcl_library $tcl_pkgPath");
+        Tcl_EvalObjEx(interp, codeObj.getTclObj(), TCL_EVAL_GLOBAL);
+        res = Tcl_Init(interp);
+    }
+    return res;
+}
+
 int ScriptingTcl::dbEval(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[])
 {
     SqlQueryPtr execResults = dbCommonEval(ctx, interp, objv);
@@ -653,4 +675,5 @@ void ScriptingTcl::ContextTcl::reset()
 void ScriptingTcl::ContextTcl::init()
 {
     Tcl_CreateObjCommand(interp, "db", ScriptingTcl::dbCommand, reinterpret_cast<ClientData>(this), nullptr);
+    Tcl_CreateObjCommand(interp, "tcl_init", ScriptingTcl::initTclCommand, reinterpret_cast<ClientData>(this), nullptr);
 }