1
0
mirror of https://git.dev.opencascade.org/repos/occt.git synced 2025-08-09 13:22:24 +03:00

0023197: Draw executable do not detect update of environment variables on Windows.

New DRAW commands dgetenv and dsetenv are added, allowing to query and set environment variables as defined in C subsystem, from Tcl.

On Windows, special handler is armed in DrawDefaults providing automatic update of C environment when Tcl environment (array env) is modified. Note that this is not needed on Linux (Tcl does this internally).

Fixed problem with "array get env" command.

Added comments to _update_c_env proc.
This commit is contained in:
abv
2012-06-28 17:48:50 +04:00
parent aa02980dbf
commit b7e7622471
2 changed files with 71 additions and 0 deletions

View File

@@ -55,6 +55,7 @@ extern Draw_Viewer dout;
#include <tcl.h>
#include <errno.h>
#include <OSD_Environment.hxx>
Standard_Boolean Draw_ParseFailed;
@@ -592,6 +593,46 @@ static Standard_Integer set(Draw_Interpretor& di, Standard_Integer n, const char
return 0;
}
//=======================================================================
//function : dsetenv
//purpose :
//=======================================================================
static Standard_Integer dsetenv(Draw_Interpretor& di, Standard_Integer argc, const char** argv)
{
if (argc < 2) {
cout << "Use: " << argv[0] << " {varname} [value]" << endl;
return 1;
}
OSD_Environment env (argv[1]);
if (argc > 2 && argv[2][0] != '\0')
{
env.SetValue (argv[2]);
env.Build();
}
else
env.Remove();
return env.Failed();
}
//=======================================================================
//function : dgetenv
//purpose :
//=======================================================================
static Standard_Integer dgetenv(Draw_Interpretor& di, Standard_Integer argc, const char** argv)
{
if (argc < 2) {
cout << "Use: " << argv[0] << " {varname}" << endl;
return 1;
}
const char* val = getenv (argv[1]);
di << ( val ? val : "" );
return 0;
}
//=======================================================================
//function : isdraw
//purpose :
@@ -1269,6 +1310,10 @@ void Draw::VariableCommands(Draw_Interpretor& theCommands)
theCommands.Add("renamevar","renamevar name1 toname1 name2 toname2 ...",__FILE__,copy,g);
theCommands.Add("dset","var1 value1 vr2 value2 ...",__FILE__,set,g);
// commands to access C environment variables; see Mantis issue #23197
theCommands.Add("dgetenv","var : get value of environment variable in C subsystem",__FILE__,dgetenv,g);
theCommands.Add("dsetenv","var [value] : set (unset if value is empty) environment variable in C subsystem",__FILE__,dsetenv,g);
theCommands.Add("pick","pick id X Y Z b [nowait]",__FILE__,pick,g);
theCommands.Add("lastrep","lastrep id X Y [Z] b, return name",__FILE__,lastrep,g);

View File

@@ -62,5 +62,31 @@ if {[array get env QA_DUMP] != "" && $env(QA_DUMP) == "1"} {
catch {source $env(CSF_DrawPluginQADefaults)/QARebuildCommands}
}
# on Windows, set special handler to update automatically environment variables
# in C subsystem when Tcl environment changes (see Mantis issue #23197)
if { $tcl_platform(platform) == "windows" && ! [catch {dgetenv PATH} res] } {
proc _update_c_env {envenv var op} {
global env
if { $op == "unset" } {
if { $var != "" } {
dsetenv $var
} else {
#"array get env varname" command calls _update_c_env with op="unset" and var=""
#It leads to detach of trace from env array
trace add variable env array _update_c_env
trace add variable env read _update_c_env
trace add variable env write _update_c_env
trace add variable env unset _update_c_env
}
} elseif { $op == "write" } {
dsetenv $var $env($var)
} elseif { $op == "read" } {
return dgetenv $var
}
}
#Execute "trace add ..." block from _update_c_env proc
_update_c_env env "" "unset"
}
# silent return from the script
return