src/DrawResources/DrawDefault

   1 # Copyright (c) 1999-2014 OPEN CASCADE SAS
   2 #
   3 # This file is part of Open CASCADE Technology software library.
   4 #
   5 # This library is free software; you can redistribute it and/or modify it under
   6 # the terms of the GNU Lesser General Public License version 2.1 as published
   7 # by the Free Software Foundation, with special exception defined in the file
   8 # OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
   9 # distribution for complete text of the license and disclaimer of any warranty.
  10 #
  11 # Alternatively, this file may be used under the terms of Open CASCADE
  12 # commercial license or contractual agreement.
  13
  14 # This script is to be executed automatically at DRAWEXE start.
  15 #
  16 # For that to happen, either environment DRAWDEFAULT should be set pointing
  17 # to this file, or CASROOT variable should be set, so that the script is
  18 # found as $CASROOT/src/DrawResources/DrawDefault
  19
  20 # indicate that DRAW is interactive environment
  21 set tcl_interactive 1
  22
  23 # define location of standard DRAW scripts; normally it is
  24 # $CASROOT/src/DrawResources
  25 set dir ""
  26 if { [info exists env(DRAWHOME) ] } {
  27   set dir $env(DRAWHOME)
  28 } else {
  29   if { [info exists env(CASROOT) ] } {
  30     set dir [file join $env(CASROOT) src DrawResources]
  31   } else {
  32     puts "Warning: CASROOT is not defined, some features may not load correctly"
  33     set dir [file dirname [info script]]
  34   }
  35 }
  36
  37 # load standard DRAW scripts
  38 if { [file isdirectory $dir] } {
  39   foreach script {StandardCommands.tcl Geometry.tcl StandardViews.tcl TestCommands.tcl CheckCommands.tcl} {
  40     if [file exist [file join $dir $script]] {
  41       source [file join $dir $script]
  42     } else {
  43       puts "Warning: could not find command file $script"
  44     }
  45   }
  46
  47   # and TK extensions
  48   set stationname $tcl_platform(platform)
  49   if [info exists tk_version] {
  50     source [file join $dir DrawTK.tcl]
  51     # setup the icon for main window
  52     if { ${stationname} == "windows" } {
  53       wm iconbitmap . -default [file join $dir lamp.ico]
  54     }
  55     wm title . Draw
  56   }
  57 } else {
  58   puts "Warning: could not find DRAW directory"
  59 }
  60
  61 # set default testing environment
  62 if { [info exists env(CASROOT)] && [file isdirectory $env(CASROOT)/tests] } {
  63     if { ! [info exists env(CSF_TestScriptsPath)] } {
  64         set env(CSF_TestScriptsPath) $env(CASROOT)/tests
  65     } else {
  66         set env(CSF_TestScriptsPath) $env(CSF_TestScriptsPath)[_path_separator]$env(CASROOT)/tests
  67     }
  68     if { ! [info exists env(CSF_TestDataPath)] } {
  69         set env(CSF_TestDataPath) $env(CASROOT)/data
  70     } else {
  71         set env(CSF_TestDataPath) $env(CSF_TestDataPath)[_path_separator]$env(CASROOT)/data
  72     }
  73 }
  74
  75 # load application-defined initialization script, which is expected to
  76 # be found either in the file pointed by environment variable CSF_DrawAppliInit,
  77 # or in the file DrawAppliInit in the current directory
  78 set draw_appli_init_file DrawAppliInit
  79 if { [info exists env(CSF_DrawAppliInit)] } {
  80   set draw_appli_init_file $env(CSF_DrawAppliInit)
  81 }
  82 if { [file readable $draw_appli_init_file] } {
  83   if { [catch {source $draw_appli_init_file} res] } {
  84     puts "Warning: problem while loading file $draw_appli_init_file: $res"
  85   }
  86 }
  87
  88 # on Windows, set special handler to update automatically environment variables
  89 # in C subsystem when Tcl environment changes (see Mantis issue #23197)
  90 if { $tcl_platform(platform) == "windows" && ! [catch {dgetenv PATH} res] } {
  91     proc _update_c_env {envenv var op} {
  92         global env
  93         if { $op == "unset" } {
  94             if { $var != "" } {
  95                 dsetenv $var
  96             } else {
  97                 #"array get env varname" command calls _update_c_env with op="unset" and var=""
  98                 #It leads to detach of trace from env array
  99                 trace add variable env array _update_c_env
 100                 trace add variable env read  _update_c_env
 101                 trace add variable env write _update_c_env
 102                 trace add variable env unset _update_c_env
 103             }
 104         } elseif { $op == "write" } {
 105             dsetenv $var $env($var)
 106         } elseif { $op == "read" } {
 107             return dgetenv $var
 108         }
 109     }
 110     #Execute "trace add ..." block from _update_c_env proc
 111     _update_c_env env "" "unset"
 112 }
 113
 114 # silent return from the script
 115 return