Tcl Source Code

Artifact 2d84ad589f97e2bc8f0245bdf37d0d5d910f8f54:

#define USE_TCL_STUBS
#include <tclInt.h>
#include <windows.h>

Tcl_ObjCmdProc GetEnvObjCmd;
Tcl_ObjCmdProc SetEnvObjCmd;
Tcl_ObjCmdProc WGetEnvObjCmd;
Tcl_ObjCmdProc WSetEnvObjCmd;
Tcl_ObjCmdProc TGetEnvObjCmd;
Tcl_ObjCmdProc TSetEnvObjCmd;

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

EXTERN int
Test_Init (Tcl_Interp *interp)
{
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
	return TCL_ERROR;
    }
    Tcl_CreateObjCommand(interp, "getenv", GetEnvObjCmd, 0L, 0L);
    Tcl_CreateObjCommand(interp, "setenv", SetEnvObjCmd, 0L, 0L);
    Tcl_CreateObjCommand(interp, "wgetenv", WGetEnvObjCmd, 0L, 0L);
    Tcl_CreateObjCommand(interp, "wsetenv", WSetEnvObjCmd, 0L, 0L);
    Tcl_CreateObjCommand(interp, "tgetenv", TGetEnvObjCmd, 0L, 0L);
    Tcl_CreateObjCommand(interp, "tsetenv", TSetEnvObjCmd, 0L, 0L);
    return TCL_OK;
}

int
GetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc,
	       struct Tcl_Obj * CONST objv[])
{
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    getenv(Tcl_GetString(objv[1])), -1));
    return TCL_OK;
}
int
SetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc,
	       struct Tcl_Obj * CONST objv[])
{
    Tcl_DString ds;

    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, Tcl_GetString(objv[1]), -1);
    Tcl_DStringAppend(&ds, "=", -1);
    Tcl_DStringAppend(&ds, Tcl_GetString(objv[2]), -1);
    
    putenv(Tcl_DStringValue(&ds));

    Tcl_DStringFree(&ds);
    return TCL_OK;
}
int
WGetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc,
	       struct Tcl_Obj * CONST objv[])
{
    TCHAR buf[255];
    GetEnvironmentVariable(Tcl_GetString(objv[1]), buf, 255);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
    return TCL_OK;
}
int
WSetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc,
	       struct Tcl_Obj * CONST objv[])
{
    SetEnvironmentVariable(Tcl_GetString(objv[1]), Tcl_GetString(objv[2]));
    return TCL_OK;
}
int
TGetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc,
	       struct Tcl_Obj * CONST objv[])
{
    Tcl_DString ds;
    TclGetEnv(Tcl_GetString(objv[1]), &ds);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_DStringValue(&ds), -1));
    Tcl_DStringFree(&ds);
    return TCL_OK;
}
int
TSetEnvObjCmd(ClientData cData, Tcl_Interp *interp, int objc,
	       struct Tcl_Obj * CONST objv[])
{
    Tcl_DString ds;

    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, Tcl_GetString(objv[1]), -1);
    Tcl_DStringAppend(&ds, "=", -1);
    Tcl_DStringAppend(&ds, Tcl_GetString(objv[2]), -1);

    Tcl_PutEnv(Tcl_DStringValue(&ds));

    Tcl_DStringFree(&ds);
    return TCL_OK;
}