home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / config_examples.tcl < prev    next >
Text File  |  1997-10-28  |  4KB  |  133 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc. 1997
  4. #
  5. #      File:           @(#)config_examples.tcl    /main/titanic/4
  6. #      Author:         
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)config_examples.tcl    /main/titanic/4 28 Oct 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. source [m4_path_name tcl cginit.tcl]
  12.  
  13. require wmt_util.tcl
  14. require machdep.tcl
  15.  
  16. proc getBrowserType {fileType} {
  17.     global fstorage::custObjHandler
  18.     set custObjHandler ${fstorage::custObjHandler}
  19.     if {$custObjHandler == ""} {
  20.         set modHandler [ModuleHandler new]
  21.         $modHandler setCurrentContext
  22.         set custObjHandler [CustObjHandler new $modHandler]
  23.         set fstorage::custObjHandler $custObjHandler
  24.         $custObjHandler setCurrentContext
  25.     }
  26.     set objSpecSet [$custObjHandler currentObjectSpecSet]
  27.     foreach objSpec $objSpecSet {
  28.         if {([$objSpec fsExtension] == $fileType) && 
  29.             ([$objSpec repositoryType] == "ExternalFileVersion")} {
  30.             return [$objSpec browserType]
  31.         }
  32.         set repositoryType [$objSpec repositoryType]
  33.     }
  34.     return ""
  35. }
  36.  
  37.  
  38. proc m4copydir {dir checkfile} {
  39.         set save_dir [pwd]
  40.         set subdir [location config $dir]
  41.         if [catch {set cddir [m4_path_name $subdir $checkfile]}] {
  42.                 puts "could not find $checkfile in $subdir"
  43.                 return
  44.         }
  45.  
  46.         set PhaseV [[ClientContext::global] currentPhase]
  47.  
  48.         cd [path_name directory $cddir]
  49.  
  50.         set files [glob -nocomplain *]
  51.         set dest [location [$PhaseV path] $dir]
  52.         if {! [file exist $dest]} {
  53.                 mkdir -path [list $dest]
  54.         }
  55.         foreach file $files {
  56.             set fileName [nt_get_name $file]
  57.             set fileType [nt_get_type $file]
  58.             set browserType [getBrowserType $fileType]
  59.             set fullName "$fileName.$browserType"
  60.             if {$browserType != ""} {
  61.                 if [catch {set fd [fstorage::open $fullName w]} reason] {
  62.                     puts stderr $reason
  63.                     puts stderr "could not create $file.$fileType \($browserType\)"
  64.                     continue
  65.                 } else {
  66.                     fstorage::close $fd
  67.                     if {($browserType == "pas") || ($browserType == "txt")} {
  68.                         set uIndex [string last "Unit" $fileName]
  69.                         incr uIndex -1
  70.                         set className [string range $fileName 0 $uIndex]
  71.                         fstorage::set_imp_from $fullName $className
  72.                     }
  73.                     puts "copying $file to $dest"
  74.                     fstorage::copyFile $file phase $dir $file
  75.                 } 
  76.             } else {
  77.                 puts "copying $file to $dest"
  78.                 fstorage::copyFile $file phase $dir $file
  79.             }
  80.         }
  81.         cd $save_dir
  82. }    
  83.  
  84. proc mkImplementation {checkfile} {
  85.     set cc [ClientContext::global]
  86.     set path [$cc currentLevelString]
  87.     set configV [$cc currentConfig]
  88.     set phaseV [$cc currentPhase]
  89.     set nextPhaseV [$phaseV next $configV]
  90.     if {[$nextPhaseV isNil]} {
  91.             puts "No 'Implementation' phase available"
  92.             return
  93.     }
  94.     set sysV [$cc currentSystem]
  95.     if {![$sysV isNil]} {
  96.             set sysName [[$sysV system] name]
  97.             set sysV [$nextPhaseV findSystemVersion $sysName "system"]
  98.             if {[$sysV isNil]} {
  99.                 puts "Creating system '$sysName' in 'Implementation' phase..."
  100.                 set sysV [$nextPhaseV createSystemVersion $sysName "cl" "system" $configV]
  101.             }
  102.         while {[$cc currentLevel] != "Config"} {
  103.             $cc upLevel
  104.         }
  105.             $cc downLevelId $nextPhaseV
  106.             $cc downLevelId $sysV
  107.  
  108.         m4copydir $sysName $checkfile
  109.     } else {
  110.             puts "No current system"
  111.             return
  112.     }
  113. }
  114.  
  115. proc installExample {sysName designSrc checkfile} {
  116.     set cc [ClientContext::global]
  117.     set phaseV [$cc currentPhase]
  118.     set sysV [$phaseV findSystemVersion $sysName "system"]
  119.     if {![$sysV isNil]} {
  120.        puts "System '$sysName' already exists: not configuring it again."
  121.     } else {
  122.        require "$designSrc"
  123.        mkImplementation $checkfile
  124.     }
  125. }
  126.  
  127. puts "Start configure TicTacToe Delphi Example"
  128. set sysName "TicTacToe"
  129. set designSrc "TicTacToe.tcl"
  130. set checkfile "TicTacToe_CellUnit.pas"
  131. installExample $sysName $designSrc $checkfile
  132. puts "End configure TicTacToe Delphi Example"
  133.