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.

src/Draw/Draw_VariableCommands.cxx

@@ -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);
 

src/DrawResources/DrawDefault

@@ -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