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