Imported Upstream version 2.99.6upstream/2.99.6

7 files changed, 918 insertions, 0 deletions

diff --git a/Plugins/ScriptingTcl/ScriptingTcl.pro b/Plugins/ScriptingTcl/ScriptingTcl.pro
new file mode 100644
index 0000000..4b89ce6
--- /dev/null
+++ b/Plugins/ScriptingTcl/ScriptingTcl.pro
@@ -0,0 +1,127 @@
+#-------------------------------------------------
+#
+# Project created by QtCreator 2014-07-19T12:58:14
+#
+#-------------------------------------------------
+
+include($$PWD/../../SQLiteStudio3/plugins.pri)
+
+QT       -= gui
+
+TARGET = ScriptingTcl
+TEMPLATE = lib
+
+DEFINES += SCRIPTINGTCL_LIBRARY
+
+SOURCES += scriptingtcl.cpp
+
+HEADERS += scriptingtcl.h\
+        scriptingtcl_global.h
+
+OTHER_FILES += \
+    scriptingtcl.json
+
+linux: {
+    # Find tclsh
+    TCLSH = $$system(echo "puts 1" | tclsh)
+    !contains(TCLSH, 1): {
+        error("Could not find tclsh executable. ScriptingTcl plugin requires it to find out all Tcl libraries and headers. Make tclsh available in PATH.")
+    }
+    TCLSH = $$system(which tclsh)
+
+    # Find its version
+    TCL_VERSION = $$system(echo "puts [info tclversion]" | tclsh)
+    #message("Found tclsh: $$TCLSH (version: $$TCL_VERSION)")
+
+    # Find tclConfig.sh
+    TCL_CONFIG_DIR = $$system(echo "puts [info library]" | tclsh)
+    TCL_CONFIG = $$TCL_CONFIG_DIR/tclConfig.sh
+
+    # Define other libs required when linking with Tcl
+    eval($$system(cat $$TCL_CONFIG | grep TCL_LIBS))
+    eval(LIBS += $$TCL_LIBS)
+
+    # Define headers dir
+    eval($$system(cat $$TCL_CONFIG | grep TCL_INCLUDE_SPEC))
+    INCLUDEPATH += $$replace(TCL_INCLUDE_SPEC, -I/, /)
+    DEPENDPATH += $$replace(TCL_INCLUDE_SPEC, -I/, /)
+
+    # Find static library
+    eval($$system(cat $$TCL_CONFIG | grep TCL_STUB_LIB_PATH))
+    STATIC_LIB = $$replace(TCL_STUB_LIB_PATH, tclstub, tcl)
+
+    # If found static lib, we link statically
+    exists($$STATIC_LIB) {
+        #message("Static linking of libtcl: $$STATIC_LIB")
+        LIBS += $$STATIC_LIB
+    }
+
+    # If not found, use dynamic linking flags
+    !exists($$STATIC_LIB) {
+        eval($$system(cat $$TCL_CONFIG | grep TCL_LIB_SPEC))
+        #message("Dynamic linking of libtcl: $$TCL_LIB_SPEC")
+        eval(LIBS += $$TCL_LIB_SPEC)
+    }
+}
+
+macx: {
+    # Find tclsh
+    TCLSH = $$system(echo "puts 1" | tclsh)
+    !contains(TCLSH, 1): {
+        error("Could not find tclsh executable. ScriptingTcl plugin requires it to find out all Tcl libraries and headers. Make tclsh available in PATH.")
+    }
+    TCLSH = $$system(which tclsh)
+
+    # Find its version
+    TCL_VERSION = $$system(echo "puts [info tclversion]" | tclsh)
+    #message("Found tclsh: $$TCLSH (version: $$TCL_VERSION)")
+
+    # Find tclConfig.sh
+    TCL_CONFIG_DIR = $$system(echo "puts [info library]" | tclsh)
+    TCL_CONFIG = $$TCL_CONFIG_DIR/../../tclConfig.sh
+
+    # Define other libs required when linking with Tcl
+    eval($$system(cat $$TCL_CONFIG | grep TCL_LIBS))
+    eval(LIBS += $$TCL_LIBS)
+
+    # Define headers dir
+    eval($$system(cat $$TCL_CONFIG | grep TCL_INCLUDE_SPEC))
+    INCLUDEPATH += $$replace(TCL_INCLUDE_SPEC, -I/, /)
+    DEPENDPATH += $$replace(TCL_INCLUDE_SPEC, -I/, /)
+
+    # Find static library
+    eval($$system(cat $$TCL_CONFIG | grep TCL_STUB_LIB_PATH))
+    STATIC_LIB = $$replace(TCL_STUB_LIB_PATH, tclstub, tcl)
+
+    # If found static lib, we link statically
+    exists($$STATIC_LIB) {
+        #message("Static linking of libtcl: $$STATIC_LIB")
+        LIBS += $$STATIC_LIB
+    }
+
+    # If not found, use dynamic linking flags
+    !exists($$STATIC_LIB) {
+        eval($$system(cat $$TCL_CONFIG | grep TCL_LIB_SPEC))
+        #message("Dynamic linking of libtcl: $$TCL_LIB_SPEC")
+        eval(LIBS += $$TCL_LIB_SPEC)
+    }
+}
+
+win32: {
+    # Under Windows we don't do the research. We just assume we have everything in the lib/ and include/
+    # directories, which contain all other dependencies for SQLiteStudio. Get them from any Tcl installation you want.
+    # Lib files required for compilation of this plugin:
+    # - tcl86.lib
+    # - tcl86.dll
+    # Include files required for compilation:
+    # - tcl.h
+    # - tclDecls.h
+    # - tclPlatDecls.h
+    # Lib files required for the runtime in applications directory:
+    # - tcl86.dll
+    # The "86" part may vary, depending on Tcl version you're linking with.
+    LIBS += -ltcl86
+}
+
+RESOURCES += \
+    scriptingtcl.qrc
diff --git a/Plugins/ScriptingTcl/scriptingtcl.cpp b/Plugins/ScriptingTcl/scriptingtcl.cpp
new file mode 100644
index 0000000..5709808
--- /dev/null
+++ b/Plugins/ScriptingTcl/scriptingtcl.cpp
@@ -0,0 +1,656 @@
+#include "scriptingtcl.h"
+#include "common/global.h"
+#include "common/unused.h"
+#include "db/db.h"
+#include "parser/lexer.h"
+#include "parser/token.h"
+#include "common/utils_sql.h"
+#include <QDebug>
+#include <QMutexLocker>
+
+ScriptingTcl::ScriptingTcl()
+{
+    mainInterpMutex = new QMutex();
+}
+
+ScriptingTcl::~ScriptingTcl()
+{
+    safe_delete(mainInterpMutex);
+}
+
+bool ScriptingTcl::init()
+{
+    Q_INIT_RESOURCE(scriptingtcl);
+    QMutexLocker locker(mainInterpMutex);
+    mainContext = new ContextTcl();
+    return true;
+}
+
+void ScriptingTcl::deinit()
+{
+    QMutexLocker locker(mainInterpMutex);
+    safe_delete(mainContext);
+    Tcl_Finalize();
+    Q_CLEANUP_RESOURCE(scriptingtcl);
+}
+
+QString ScriptingTcl::getLanguage() const
+{
+    return "Tcl";
+}
+
+ScriptingPlugin::Context* ScriptingTcl::createContext()
+{
+    ContextTcl* ctx = new ContextTcl();
+    contexts << ctx;
+    return ctx;
+}
+
+void ScriptingTcl::releaseContext(ScriptingPlugin::Context* context)
+{
+    ContextTcl* ctx = getContext(context);
+    if (!ctx)
+        return;
+
+    contexts.removeOne(ctx);
+    delete ctx;
+}
+
+void ScriptingTcl::resetContext(ScriptingPlugin::Context* context)
+{
+    ContextTcl* ctx = getContext(context);
+    if (!ctx)
+        return;
+
+    ctx->reset();
+}
+
+void ScriptingTcl::setVariable(ScriptingPlugin::Context* context, const QString& name, const QVariant& value)
+{
+    ContextTcl* ctx = getContext(context);
+    if (!ctx)
+        return;
+
+    setVariable(ctx->interp, name, value);
+}
+
+QVariant ScriptingTcl::getVariable(ScriptingPlugin::Context* context, const QString& name)
+{
+    ContextTcl* ctx = getContext(context);
+    if (!ctx)
+        return QVariant();
+
+    return getVariable(ctx->interp, name);
+}
+
+bool ScriptingTcl::hasError(ScriptingPlugin::Context* context) const
+{
+    ContextTcl* ctx = getContext(context);
+    if (!ctx)
+        return false;
+
+    return !ctx->error.isEmpty();
+}
+
+QString ScriptingTcl::getErrorMessage(ScriptingPlugin::Context* context) const
+{
+    ContextTcl* ctx = getContext(context);
+    if (!ctx)
+        return QString();
+
+    return ctx->error;
+}
+
+QString ScriptingTcl::getIconPath() const
+{
+    return ":/scriptingtcl/scriptingtcl.png";
+}
+
+QVariant ScriptingTcl::evaluate(ScriptingPlugin::Context* context, const QString& code, const QList<QVariant>& args, Db* db, bool locking)
+{
+    ContextTcl* ctx = getContext(context);
+    if (!ctx)
+        return QVariant();
+
+    setArgs(ctx, args);
+    return compileAndEval(ctx, code, db, locking);
+}
+
+QVariant ScriptingTcl::evaluate(const QString& code, const QList<QVariant>& args, Db* db, bool locking, QString* errorMessage)
+{
+    QMutexLocker locker(mainInterpMutex);
+    setArgs(mainContext, args);
+    QVariant results = compileAndEval(mainContext, code, db, locking);
+
+    if (errorMessage && !mainContext->error.isEmpty())
+        *errorMessage = mainContext->error;
+
+    return results;
+}
+
+ScriptingTcl::ContextTcl* ScriptingTcl::getContext(ScriptingPlugin::Context* context) const
+{
+    ContextTcl* ctx = dynamic_cast<ContextTcl*>(context);
+    if (!ctx)
+        qDebug() << "Invalid context passed to ScriptingTcl:" << context;
+
+    return ctx;
+}
+
+QVariant ScriptingTcl::compileAndEval(ScriptingTcl::ContextTcl* ctx, const QString& code, Db* db, bool locking)
+{
+    ScriptObject* scriptObj = nullptr;
+    if (!ctx->scriptCache.contains(code))
+    {
+        scriptObj = new ScriptObject(code);
+        ctx->scriptCache.insert(code, scriptObj);
+    }
+    else
+    {
+        scriptObj = ctx->scriptCache[code];
+    }
+    Tcl_ResetResult(ctx->interp);
+    ctx->error.clear();
+
+    ctx->db = db;
+    ctx->useDbLocking = locking;
+
+    int result = Tcl_EvalObjEx(ctx->interp, scriptObj->getTclObj(), TCL_EVAL_GLOBAL);
+
+    ctx->db = nullptr;
+    ctx->useDbLocking = false;
+
+    if (result != TCL_OK)
+    {
+        ctx->error = QString::fromUtf8(Tcl_GetStringResult(ctx->interp));
+        return QVariant();
+    }
+    return extractResult(ctx);
+}
+
+QVariant ScriptingTcl::extractResult(ScriptingTcl::ContextTcl* ctx)
+{
+    Tcl_Obj* obj = Tcl_GetObjResult(ctx->interp);
+    return tclObjToVariant(obj);
+}
+
+void ScriptingTcl::setArgs(ScriptingTcl::ContextTcl* ctx, const QList<QVariant>& args)
+{
+    setVariable(ctx, "argc", args.size());
+    setVariable(ctx, "argv", args);
+}
+
+Tcl_Obj* ScriptingTcl::argsToList(const QList<QVariant>& args)
+{
+    Tcl_Obj** objArray = new Tcl_Obj*[args.size()];
+
+    int i = 0;
+    for (const QVariant& arg : args)
+        objArray[i++] = variantToTclObj(arg);
+
+    Tcl_Obj* obj = Tcl_NewListObj(args.size(), objArray);
+    delete[] objArray;
+
+    return obj;
+}
+
+QVariant ScriptingTcl::tclObjToVariant(Tcl_Obj* obj)
+{
+    static const QStringList typeLiterals = {"boolean", "booleanString", "double", "int", "wideInt", "bignum", "bytearray", "string", "list", "dict"};
+
+    TclDataType type = TclDataType::UNKNOWN;
+    if (obj->typePtr)
+    {
+        int typeIdx = typeLiterals.indexOf(obj->typePtr->name);
+        if (typeIdx > -1)
+            type = static_cast<TclDataType>(typeIdx);
+    }
+
+    QVariant result;
+    bool ok = true;
+    switch (type)
+    {
+        case TclDataType::Boolean:
+        case TclDataType::BooleanString:
+        {
+            int b;
+            if (Tcl_GetBooleanFromObj(nullptr, obj, &b) == TCL_OK)
+                result = (bool)b;
+            else
+                ok = false;
+
+            break;
+        }
+        case TclDataType::Double:
+        {
+            double d;
+            if (Tcl_GetDoubleFromObj(nullptr, obj, &d) == TCL_OK)
+                result = d;
+            else
+                ok = false;
+
+            break;
+        }
+        case TclDataType::Int:
+        {
+            int i;
+            if (Tcl_GetIntFromObj(nullptr, obj, &i) == TCL_OK)
+                result = i;
+            else
+                ok = false;
+
+            break;
+        }
+        case TclDataType::WideInt:
+        {
+            Tcl_WideInt wideInt;
+            if (Tcl_GetWideIntFromObj(nullptr, obj, &wideInt) == TCL_OK)
+                result = (qint64)wideInt;
+            else
+                ok = false;
+
+            break;
+        }
+        case TclDataType::Bytearray:
+        {
+            int lgt;
+            unsigned char* bytes = Tcl_GetByteArrayFromObj(obj, &lgt);
+            result = QByteArray::fromRawData(reinterpret_cast<char*>(bytes), lgt);
+            break;
+        }
+        case TclDataType::List:
+        {
+            QList<QVariant> list;
+            int objc;
+            Tcl_Obj** objv = nullptr;
+            Tcl_ListObjGetElements(nullptr, obj, &objc, &objv);
+            for (int i = 0; i < objc; i++)
+                list << tclObjToVariant(objv[i]);
+
+            result = list;
+            break;
+        }
+        case TclDataType::Dict:
+        {
+            Tcl_DictSearch search;
+            Tcl_Obj* key = nullptr;
+            Tcl_Obj* value = nullptr;
+            QString keyStr;
+            QVariant valueVariant;
+            int done;
+            QHash<QString,QVariant> hash;
+            if (Tcl_DictObjFirst(nullptr, obj, &search, &key, &value, &done) == TCL_OK)
+            {
+                for (; !done ; Tcl_DictObjNext(&search, &key, &value, &done))
+                {
+                    keyStr = QString::fromUtf8(Tcl_GetStringFromObj(key, nullptr));
+                    valueVariant = tclObjToVariant(value);
+                    hash[keyStr] = valueVariant;
+                }
+                Tcl_DictObjDone(&search);
+            }
+            result = hash;
+        }
+        case TclDataType::Bignum:
+        case TclDataType::String:
+        case TclDataType::UNKNOWN:
+        default:
+            result = tclObjToString(obj);
+            break;
+    }
+
+    if (!ok)
+        result = tclObjToString(obj);
+
+    return result;
+}
+
+QString ScriptingTcl::tclObjToString(Tcl_Obj* obj)
+{
+    return QString::fromUtf8(Tcl_GetStringFromObj(obj, nullptr));
+}
+
+Tcl_Obj* ScriptingTcl::variantToTclObj(const QVariant& value)
+{
+    Tcl_Obj* obj = nullptr;
+    switch (value.type())
+    {
+        case QVariant::Bool:
+            obj = Tcl_NewBooleanObj(value.toBool());
+            break;
+        case QVariant::Int:
+        case QVariant::UInt:
+            obj = Tcl_NewIntObj(value.toInt());
+            break;
+        case QVariant::LongLong:
+        case QVariant::ULongLong:
+            obj = Tcl_NewWideIntObj((Tcl_WideInt)value.toLongLong());
+            break;
+        case QVariant::Double:
+            obj = Tcl_NewDoubleObj(value.toDouble());
+            break;
+        case QVariant::ByteArray:
+        {
+            QByteArray bytes = value.toByteArray();
+            unsigned char* ubytes = reinterpret_cast<unsigned char*>(bytes.data());
+            obj = Tcl_NewByteArrayObj(ubytes, bytes.size());
+            break;
+        }
+        case QVariant::List:
+        {
+            QList<QVariant> list = value.toList();
+            int listSize = list.size();
+            Tcl_Obj** objList = new Tcl_Obj*[listSize];
+            for (int i = 0; i < listSize; ++i)
+                objList[i] = variantToTclObj(list[i]);
+
+            obj = Tcl_NewListObj(listSize, objList);
+            delete[] objList;
+            break;
+        }
+        case QVariant::StringList:
+        {
+            QStringList list = value.toStringList();
+            int listSize = list.size();
+            Tcl_Obj** objList = new Tcl_Obj*[listSize];
+            for (int i = 0; i < listSize; ++i)
+                objList[i] = stringToTclObj(list[i]);
+
+            obj = Tcl_NewListObj(listSize, objList);
+            delete[] objList;
+            break;
+        }
+        case QVariant::Hash:
+        {
+            QHash<QString, QVariant> hash = value.toHash();
+            obj = Tcl_NewDictObj();
+            QHashIterator<QString, QVariant> it(hash);
+            while (it.hasNext())
+            {
+                it.next();
+                Tcl_DictObjPut(nullptr, obj, variantToTclObj(it.key()), variantToTclObj(it.value()));
+            }
+            break;
+        }
+        case QVariant::Map:
+        {
+            QMap<QString, QVariant> map = value.toMap();
+            obj = Tcl_NewDictObj();
+            QMapIterator<QString, QVariant> it(map);
+            while (it.hasNext())
+            {
+                it.next();
+                Tcl_DictObjPut(nullptr, obj, variantToTclObj(it.key()), variantToTclObj(it.value()));
+            }
+            break;
+        }
+        case QVariant::String:
+        default:
+            obj = stringToTclObj(value.toString());
+            break;
+    }
+
+    if (!obj)
+        obj = stringToTclObj(value.toString());
+
+    return obj;
+}
+
+Tcl_Obj* ScriptingTcl::stringToTclObj(const QString& value)
+{
+    return Tcl_NewStringObj(value.toUtf8().constData(), -1);
+}
+
+int ScriptingTcl::dbCommand(ClientData clientData, Tcl_Interp* interp, int objc, Tcl_Obj* const objv[])
+{
+    ContextTcl* ctx = reinterpret_cast<ContextTcl*>(clientData);
+
+    Tcl_Obj* result = nullptr;
+    if (!ctx->db)
+    {
+        result = Tcl_NewStringObj(tr("No database available in current context, while called Tcl's 'db' command.").toUtf8().constData(), -1);
+        Tcl_SetObjResult(interp, result);
+        return TCL_ERROR;
+    }
+
+    if (strcmp(Tcl_GetStringFromObj(objv[1], nullptr), "eval") == 0)
+    {
+        if (objc == 3)
+            return dbEval(ctx, interp, objv);
+        else if (objc == 5) {
+            return dbEvalRowByRow(ctx, interp, objv);
+        }
+    }
+    else if (strcmp(Tcl_GetStringFromObj(objv[1], nullptr), "rows") == 0 && objc == 3)
+    {
+        return dbEvalDeepResults(ctx, interp, objv);
+    }
+    else if (strcmp(Tcl_GetStringFromObj(objv[1], nullptr), "onecolumn") == 0 && objc == 3)
+    {
+        return dbEvalOneColumn(ctx, interp, objv);
+    }
+
+    result = Tcl_NewStringObj(tr("Invalid 'db' command sytax. Should be: db eval sql").toUtf8().constData(), -1);
+    Tcl_SetObjResult(interp, result);
+    return TCL_ERROR;
+}
+
+int ScriptingTcl::dbEval(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[])
+{
+    SqlQueryPtr execResults = dbCommonEval(ctx, interp, objv);
+    if (execResults->isError())
+        return TCL_ERROR;
+
+    Tcl_Obj* result = nullptr;
+    QList<QVariant> cells;
+    SqlResultsRowPtr row;
+    while (execResults->hasNext())
+    {
+        row = execResults->next();
+        cells += row->valueList();
+    }
+    result = variantToTclObj(cells);
+
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+int ScriptingTcl::dbEvalRowByRow(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[])
+{
+    SqlQueryPtr execResults = dbCommonEval(ctx, interp, objv);
+    if (execResults->isError())
+        return TCL_ERROR;
+
+    Tcl_Obj* code = objv[4];
+    QString arrayName = tclObjToString(objv[3]);
+    const char* arrayCharName = arrayName.toUtf8().constData();
+    SqlResultsRowPtr row;
+    int resCode = TCL_OK;
+    QHash<QString, QVariant> valueMap;
+    while (execResults->hasNext())
+    {
+        row = execResults->next();
+
+        Tcl_UnsetVar2(interp, arrayCharName, nullptr, 0);
+        valueMap = row->valueMap();
+        valueMap["*"] = QStringList(valueMap.keys());
+        if (setArrayVariable(interp, arrayName, valueMap) != TCL_OK)
+            return TCL_ERROR;
+
+        resCode = Tcl_EvalObjEx(interp, code, 0);
+
+        if (resCode == TCL_ERROR)
+            return TCL_ERROR;
+        else if (resCode == TCL_BREAK)
+            break;
+        else if (resCode == TCL_RETURN)
+            return TCL_RETURN;
+    }
+
+    return TCL_OK;
+}
+
+int ScriptingTcl::dbEvalDeepResults(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[])
+{
+    SqlQueryPtr execResults = dbCommonEval(ctx, interp, objv);
+    if (execResults->isError())
+        return TCL_ERROR;
+
+    Tcl_Obj* result = nullptr;
+    QList<QVariant> rows;
+    SqlResultsRowPtr row;
+    while (execResults->hasNext())
+    {
+        row = execResults->next();
+        rows << QVariant(row->valueList());
+    }
+    result = variantToTclObj(rows);
+
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+int ScriptingTcl::dbEvalOneColumn(ScriptingTcl::ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[])
+{
+    SqlQueryPtr execResults = dbCommonEval(ctx, interp, objv);
+    if (execResults->isError())
+        return TCL_ERROR;
+
+    Tcl_Obj* result = nullptr;
+    QVariant resultValue;
+    if (execResults->hasNext())
+        resultValue = execResults->getSingleCell();
+
+    result = variantToTclObj(resultValue);
+
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+SqlQueryPtr ScriptingTcl::dbCommonEval(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[])
+{
+    Db::Flags flags;
+    if (!ctx->useDbLocking)
+        flags |= Db::Flag::NO_LOCK;
+
+    Tcl_Obj* result = nullptr;
+    QString sql = QString::fromUtf8(Tcl_GetStringFromObj(objv[2], nullptr));
+
+    TokenList bindTokens = Lexer::tokenize(sql, ctx->db->getDialect()).filter(Token::BIND_PARAM);
+    QString bindVarName;
+    QHash<QString, QVariant> queryArgs;
+    for (const TokenPtr& token : bindTokens)
+    {
+        bindVarName = getBindTokenName(token);
+        if (bindVarName == "?")
+            continue;
+
+        queryArgs[token->value] = getVariable(interp, bindVarName);
+    }
+
+    SqlQueryPtr execResults = ctx->db->exec(sql, queryArgs, flags);
+    if (execResults->isError())
+    {
+        result = Tcl_NewStringObj(tr("Error from Tcl's' 'db' command: %1").arg(execResults->getErrorText()).toUtf8().constData(), -1);
+        Tcl_SetObjResult(interp, result);
+    }
+    return execResults;
+}
+
+int ScriptingTcl::setArrayVariable(Tcl_Interp* interp, const QString& arrayName, const QHash<QString, QVariant>& hash)
+{
+    Tcl_Obj* varName = Tcl_NewStringObj(arrayName.toUtf8().constData(), -1);
+    Tcl_IncrRefCount(varName);
+
+    Tcl_Obj* key = nullptr;
+    Tcl_Obj* value = nullptr;
+    Tcl_Obj* res = nullptr;
+
+    QHashIterator<QString, QVariant> it(hash);
+    while (it.hasNext())
+    {
+        it.next();
+        key = variantToTclObj(it.key());
+        value = variantToTclObj(it.value());
+
+        Tcl_IncrRefCount(key);
+        Tcl_IncrRefCount(value);
+
+        res = Tcl_ObjSetVar2(interp, varName, key, value, 0);
+
+        Tcl_DecrRefCount(key);
+        Tcl_DecrRefCount(value);
+
+        if (!res)
+            return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+void ScriptingTcl::setVariable(Tcl_Interp* interp, const QString& name, const QVariant& value)
+{
+    Tcl_Obj* varName = Tcl_NewStringObj(name.toUtf8().constData(), -1);
+    Tcl_IncrRefCount(varName);
+    Tcl_Obj* tclObjValue = variantToTclObj(value);
+    Tcl_IncrRefCount(tclObjValue);
+    Tcl_ObjSetVar2(interp, varName, nullptr, tclObjValue, 0);
+    Tcl_DecrRefCount(tclObjValue);
+    Tcl_DecrRefCount(varName);
+}
+
+QVariant ScriptingTcl::getVariable(Tcl_Interp* interp, const QString& name)
+{
+    Tcl_Obj* varName = Tcl_NewStringObj(name.toUtf8().constData(), -1);
+    Tcl_IncrRefCount(varName);
+    Tcl_Obj* obj = Tcl_ObjGetVar2(interp, varName, nullptr, 0);
+    if (!obj)
+        return QVariant();
+
+    Tcl_IncrRefCount(obj);
+    QVariant val = tclObjToVariant(obj);
+    Tcl_DecrRefCount(varName);
+    Tcl_DecrRefCount(obj);
+    return val;
+}
+
+ScriptingTcl::ScriptObject::ScriptObject(const QString& code)
+{
+    QByteArray utf8Bytes = code.toUtf8();
+    obj = Tcl_NewStringObj(utf8Bytes.constData(), utf8Bytes.size());
+    Tcl_IncrRefCount(obj);
+}
+
+ScriptingTcl::ScriptObject::~ScriptObject()
+{
+    Tcl_DecrRefCount(obj);
+}
+
+Tcl_Obj* ScriptingTcl::ScriptObject::getTclObj()
+{
+    return obj;
+}
+
+ScriptingTcl::ContextTcl::ContextTcl()
+{
+    scriptCache.setMaxCost(cacheSize);
+    interp = Tcl_CreateInterp();
+    init();
+}
+
+ScriptingTcl::ContextTcl::~ContextTcl()
+{
+    Tcl_DeleteInterp(interp);
+}
+
+void ScriptingTcl::ContextTcl::reset()
+{
+    Tcl_DeleteInterp(interp);
+    interp = Tcl_CreateInterp();
+    error = QString();
+    init();
+}
+
+void ScriptingTcl::ContextTcl::init()
+{
+    Tcl_CreateObjCommand(interp, "db", ScriptingTcl::dbCommand, reinterpret_cast<ClientData>(this), nullptr);
+}
diff --git a/Plugins/ScriptingTcl/scriptingtcl.h b/Plugins/ScriptingTcl/scriptingtcl.h
new file mode 100644
index 0000000..8fe44d5
--- /dev/null
+++ b/Plugins/ScriptingTcl/scriptingtcl.h
@@ -0,0 +1,111 @@
+#ifndef SCRIPTINGTCL_H
+#define SCRIPTINGTCL_H
+
+#include "scriptingtcl_global.h"
+#include "plugins/genericplugin.h"
+#include "plugins/scriptingplugin.h"
+#include "db/sqlquery.h"
+#include <QCache>
+#include <tcl.h>
+
+class QMutex;
+struct Tcl_Interp;
+struct Tcl_Obj;
+
+class SCRIPTINGTCLSHARED_EXPORT ScriptingTcl : public GenericPlugin, public DbAwareScriptingPlugin
+{
+        Q_OBJECT
+        SQLITESTUDIO_PLUGIN("scriptingtcl.json")
+
+    public:
+        ScriptingTcl();
+        ~ScriptingTcl();
+
+        bool init();
+        void deinit();
+        QString getLanguage() const;
+        Context* createContext();
+        void releaseContext(Context* context);
+        void resetContext(Context* context);
+        void setVariable(Context* context, const QString& name, const QVariant& value);
+        QVariant getVariable(Context* context, const QString& name);
+        bool hasError(Context* context) const;
+        QString getErrorMessage(Context* context) const;
+        QString getIconPath() const;
+        QVariant evaluate(Context* context, const QString& code, const QList<QVariant>& args, Db* db, bool locking = false);
+        QVariant evaluate(const QString& code, const QList<QVariant>& args, Db* db, bool locking = false, QString* errorMessage = nullptr);
+
+    private:
+        class ScriptObject
+        {
+            public:
+                ScriptObject(const QString& code);
+                ~ScriptObject();
+
+                Tcl_Obj* getTclObj();
+
+            private:
+                Tcl_Obj* obj = nullptr;
+        };
+
+        class ContextTcl : public ScriptingPlugin::Context
+        {
+            public:
+                ContextTcl();
+                ~ContextTcl();
+
+                void reset();
+
+                Tcl_Interp* interp = nullptr;
+                QCache<QString,ScriptObject> scriptCache;
+                QString error;
+                Db* db = nullptr;
+                bool useDbLocking = false;
+
+            private:
+                void init();
+        };
+
+        enum class TclDataType
+        {
+            Boolean,
+            BooleanString,
+            Double,
+            Int,
+            WideInt,
+            Bignum,
+            Bytearray,
+            String,
+            List,
+            Dict,
+            UNKNOWN
+        };
+
+        ContextTcl* getContext(ScriptingPlugin::Context* context) const;
+        QVariant compileAndEval(ContextTcl* ctx, const QString& code, Db* db, bool locking);
+        QVariant extractResult(ContextTcl* ctx);
+        void setArgs(ContextTcl* ctx, const QList<QVariant>& args);
+
+        static Tcl_Obj* argsToList(const QList<QVariant>& args);
+        static QVariant tclObjToVariant(Tcl_Obj* obj);
+        static QString tclObjToString(Tcl_Obj* obj);
+        static Tcl_Obj* variantToTclObj(const QVariant& value);
+        static Tcl_Obj* stringToTclObj(const QString& value);
+        static int dbCommand(ClientData clientData, Tcl_Interp* interp, int objc, Tcl_Obj* const objv[]);
+        static int dbEval(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[]);
+        static int dbEvalRowByRow(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[]);
+        static int dbEvalDeepResults(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[]);
+        static int dbEvalOneColumn(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[]);
+        static SqlQueryPtr dbCommonEval(ContextTcl* ctx, Tcl_Interp* interp, Tcl_Obj* const objv[]);
+        static int setArrayVariable(Tcl_Interp* interp, const QString& arrayName, const QHash<QString,QVariant>& hash);
+        static void setVariable(Tcl_Interp* interp, const QString& name, const QVariant& value);
+        static QVariant getVariable(Tcl_Interp* interp, const QString& name);
+
+        static const constexpr int cacheSize = 5;
+
+        ContextTcl* mainContext = nullptr;
+        QList<Context*> contexts;
+        QMutex* mainInterpMutex = nullptr;
+};
+
+#endif // SCRIPTINGTCL_H
diff --git a/Plugins/ScriptingTcl/scriptingtcl.json b/Plugins/ScriptingTcl/scriptingtcl.json
new file mode 100644
index 0000000..108d7c0
--- /dev/null
+++ b/Plugins/ScriptingTcl/scriptingtcl.json
@@ -0,0 +1,7 @@
+{
+    "type":         "ScriptingPlugin",
+    "title":        "Tcl scripting",
+    "description":  "Provides Tcl scripting language support for SQLiteStudio.",
+    "version":      10001,
+    "author":       "SalSoft"
+}
diff --git a/Plugins/ScriptingTcl/scriptingtcl.png b/Plugins/ScriptingTcl/scriptingtcl.png
new file mode 100644
index 0000000..fa4c6ad
--- /dev/null
+++ b/Plugins/ScriptingTcl/scriptingtcl.png
diff --git a/Plugins/ScriptingTcl/scriptingtcl.qrc b/Plugins/ScriptingTcl/scriptingtcl.qrc
new file mode 100644
index 0000000..8a0d047
--- /dev/null
+++ b/Plugins/ScriptingTcl/scriptingtcl.qrc
@@ -0,0 +1,5 @@
+<RCC>
+    <qresource prefix="/scriptingtcl">
+        <file>scriptingtcl.png</file>
+    </qresource>
+</RCC>
diff --git a/Plugins/ScriptingTcl/scriptingtcl_global.h b/Plugins/ScriptingTcl/scriptingtcl_global.h
new file mode 100644
index 0000000..006bcc0
--- /dev/null
+++ b/Plugins/ScriptingTcl/scriptingtcl_global.h
@@ -0,0 +1,12 @@
+#ifndef SCRIPTINGTCL_GLOBAL_H
+#define SCRIPTINGTCL_GLOBAL_H
+
+#include <QtCore/qglobal.h>
+
+#if defined(SCRIPTINGTCL_LIBRARY)
+#  define SCRIPTINGTCLSHARED_EXPORT Q_DECL_EXPORT
+#else
+#  define SCRIPTINGTCLSHARED_EXPORT Q_DECL_IMPORT
+#endif
+
+#endif // SCRIPTINGTCL_GLOBAL_H