0023087: Upgrade of the OCCT test system

[occt.git] / src / DrawResources / DrawDefault

diff --git a/src/DrawResources/DrawDefault b/src/DrawResources/DrawDefault
index 124ed18..ef49dfa 100755 (executable)
--- a/src/DrawResources/DrawDefault
+++ b/src/DrawResources/DrawDefault
@@ -1,37 +1,105 @@
+# This script is to be executed automatically at DRAWEXE start.
+#
+# For that to happen, either environment DRAWDEFAULT should be set pointing
+# to this file, or CASROOT variable should be set, so that the script is
+# found as $CASROOT/src/DrawResources/DrawDefault
+
+# indicate that DRAW is interactive environment
 set tcl_interactive 1
-set tcl_precision 17
 
-if [info exists library] {
-  source [file join $library init.tcl]
-}
+# define location of standard DRAW scripts; normally it is 
+# $CASROOT/src/DrawResources
 set dir ""
 if { [info exists env(DRAWHOME) ] } { 
   set dir $env(DRAWHOME)  
 } else {
-    if { [info exists env(CASROOT) ] } {
-  set dir [file join $env(CASROOT) src DrawResources]
+  if { [info exists env(CASROOT) ] } {
+    set dir [file join $env(CASROOT) src DrawResources]
+  } else {
+    puts "Warning: CASROOT is not defined, some features may not load correctly"
+    set dir [file dirname [info script]]
+  }
+}
+
+# load standard DRAW scripts
+if { [file isdirectory $dir] } { 
+  foreach script {StandardCommands.tcl Geometry.tcl StandardViews.tcl TestCommands.tcl} {
+    if [file exist [file join $dir $script]] {
+      source [file join $dir $script]
     } else {
-  puts " CASROOT is Mandatory to Run OpenCascade"
+      puts "Warning: could not find command file $script"
     }
-}
+  }
 
-# san - 02/08/2002 - In Tcl8.3 it is no longer necessary to load Tix explicitly on WNT
-#if { [info exists env(STATION)] } {
-#  if { $env(STATION) == "wnt" } {
-#    load tix8183.dll Tix
-#  }
-#}
-
-if { [file exist  $dir] } { 
-   source [file join $dir StandardCommands.tcl]
-   source [file join $dir StandardViews.tcl]
-   source [file join $dir Geometry.tcl]
-   if [info exists tk_version] {source [file join $dir DrawTK.tcl]}
-   if [file readable DrawAppliInit] {
-  source DrawAppliInit
-   }
-   set stationname $tcl_platform(platform)
-   if { ${stationname} == "windows" } {
+  # and TK extensions
+  set stationname $tcl_platform(platform)
+  if [info exists tk_version] {
+    source [file join $dir DrawTK.tcl]
+    # setup the icon for main window
+    if { ${stationname} == "windows" } {
       wm iconbitmap . -default [file join $dir lamp.ico]
-   }
+    }
+  }
+} else {
+  puts "Warning: could not find DRAW directory"
+}
+
+# set default testing environment
+if { [info exists env(CASROOT)] && [file isdirectory $env(CASROOT)/tests] } {
+    if { ! [info exists env(CSF_TestScriptsPath)] } {
+        set env(CSF_TestScriptsPath) $env(CASROOT)/tests
+    } else {
+        set env(CSF_TestScriptsPath) $env(CSF_TestScriptsPath)[_path_separator]$env(CASROOT)/tests
+    }
+}
+
+# load application-defined initialization script, which is expected to 
+# be found either in the file pointed by environment variable CSF_DrawAppliInit,
+# or in the file DrawAppliInit in the current directory
+set draw_appli_init_file DrawAppliInit
+if { [info exists env(CSF_DrawAppliInit)] } {
+  set draw_appli_init_file $env(CSF_DrawAppliInit)
 } 
+if { [file readable $draw_appli_init_file] } {
+  if { [catch {source $draw_appli_init_file} res] } {
+    puts "Warning: problem while loading file $draw_appli_init_file: $res"
+  }
+} 
+
+# Temporary: load specific QA commands and handlers
+if {[array get env QA_DUMP] != "" && $env(QA_DUMP) == "1"} {
+    set env(CSF_DrawPluginQADefaults) $env(CASROOT)/src/DrawResources/.
+    catch {pload FULL}
+    catch {pload -DrawPluginProducts OMF CANONICALRECOGNITION EMESH PARASOLID DXF SAT }
+    catch {pload QAcommands}
+    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