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:
@@ -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);
|
||||
|
||||
|
@@ -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
|
||||
|
Reference in New Issue
Block a user