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 >
Encoding:
Text File  |  1997-10-27  |  3.8 KB  |  125 lines
  1. #---------------------------------------------------------------------------
  2.  
  3. #
  4.  
  5. #      (c)     Cayenne Software Inc. 1997
  6.  
  7. #
  8.  
  9. #      File:           @(#)config_pbexample.tcl    /main/titanic/6
  10.  
  11. #      Author:         
  12.  
  13. #      Description:    Base for configure PowerBuilder Examples
  14.  
  15. #---------------------------------------------------------------------------
  16.  
  17. # SccsId = @(#)config_pbexample.tcl    /main/titanic/6  27 Oct 1997  Copyright 1997 Cayenne Software Inc.
  18.  
  19.  
  20.  
  21. source [m4_path_name tcl cginit.tcl]
  22.  
  23.  
  24.  
  25. require wmt_util.tcl
  26.  
  27. require machdep.tcl
  28.  
  29.  
  30.  
  31.  
  32.  
  33. proc getBrowserType {fileType} {
  34.  
  35.     global fstorage::custObjHandler
  36.  
  37.     set custObjHandler ${fstorage::custObjHandler}
  38.  
  39.     if {$custObjHandler == ""} {
  40.  
  41.         set modHandler [ModuleHandler new]
  42.  
  43.         $modHandler setCurrentContext
  44.  
  45.         set custObjHandler [CustObjHandler new $modHandler]
  46.  
  47.         set fstorage::custObjHandler $custObjHandler
  48.  
  49.         $custObjHandler setCurrentContext
  50.  
  51.     }
  52.  
  53.     set objSpecSet [$custObjHandler currentObjectSpecSet]
  54.  
  55.     foreach objSpec $objSpecSet {
  56.  
  57.         if {([$objSpec fsExtension] == $fileType) && 
  58.  
  59.             ([$objSpec repositoryType] == "ExternalFileVersion")} {
  60.  
  61.             return [$objSpec browserType]
  62.  
  63.         }
  64.  
  65.         set repositoryType [$objSpec repositoryType]
  66.  
  67.     }
  68.  
  69.     return ""
  70.  
  71. }
  72.  
  73.  
  74.  
  75.  
  76.  
  77. proc m4copydir {dir checkfile} {
  78.  
  79.         set save_dir [pwd]
  80.  
  81.         set subdir [location config $dir]
  82.  
  83.         if [catch {set cddir [m4_path_name $subdir $checkfile]}] {
  84.  
  85.                 puts "could not find $checkfile in $subdir"
  86.  
  87.                 return
  88.  
  89.         }
  90.  
  91.  
  92.  
  93.         set PhaseV [[ClientContext::global] currentPhase]
  94.  
  95.  
  96.  
  97.         cd [path_name directory $cddir]
  98.  
  99.  
  100.  
  101.         set files [glob -nocomplain *]
  102.  
  103.         set dest [location [$PhaseV path] $dir]
  104.  
  105.         if {! [file exist $dest]} {
  106.  
  107.                 mkdir -path [list $dest]
  108.  
  109.         }
  110.  
  111.         foreach file $files {
  112.  
  113.             set fileName [nt_get_name $file]
  114.  
  115.             set fileType [nt_get_type $file]
  116.  
  117.             set browserType [getBrowserType $fileType]
  118.  
  119.             set fullName "$fileName.$browserType"
  120.  
  121.             if {$browserType != ""} {
  122.  
  123.                 if [catch {set fd [fstorage::open $fullName w]} reason] {
  124.  
  125.                     puts stderr $reason
  126.  
  127.                     puts stderr "could not create $file.$fileType \($browserType\)"
  128.  
  129.                     continue
  130.  
  131.                 } else {
  132.  
  133.                     fstorage::close $fd
  134.  
  135.                     fstorage::set_imp_from $fullName $fileName
  136.  
  137.                     puts "copying $file to $dest"
  138.  
  139.                     fstorage::copyFile $file phase $dir $file
  140.  
  141.                 } 
  142.  
  143.             } else {
  144.  
  145.                 puts "copying $file to $dest"
  146.  
  147.                 fstorage::copyFile $file phase $dir $file
  148.  
  149.             }
  150.  
  151.         }
  152.  
  153.         cd $save_dir
  154.  
  155. }    
  156.  
  157.  
  158.  
  159.  
  160.  
  161. proc mkImplementation {checkfile} {
  162.  
  163.     set cc [ClientContext::global]
  164.  
  165.     set path [$cc currentLevelString]
  166.  
  167.     set configV [$cc currentConfig]
  168.  
  169.     set phaseV [$cc currentPhase]
  170.  
  171.     set nextPhaseV [$phaseV next $configV]
  172.  
  173.     if {[$nextPhaseV isNil]} {
  174.  
  175.             puts "No 'Implementation' phase available"
  176.  
  177.             return
  178.  
  179.     }
  180.  
  181.     set sysV [$cc currentSystem]
  182.  
  183.     if {![$sysV isNil]} {
  184.  
  185.             set sysName [[$sysV system] name]
  186.  
  187.             set sysV [$nextPhaseV findSystemVersion $sysName "system"]
  188.  
  189.             if {[$sysV isNil]} {
  190.  
  191.                 puts "Creating system '$sysName' in 'Implementation' phase..."
  192.  
  193.                 set sysV [$nextPhaseV createSystemVersion $sysName "cl" "system" $configV]
  194.  
  195.             }
  196.  
  197.         while {[$cc currentLevel] != "Config"} {
  198.  
  199.             $cc upLevel
  200.  
  201.         }
  202.  
  203.             $cc downLevelId $nextPhaseV
  204.  
  205.             $cc downLevelId $sysV
  206.  
  207.  
  208.  
  209.         m4copydir $sysName $checkfile
  210.  
  211.     } else {
  212.  
  213.             puts "No current system"
  214.  
  215.             return
  216.  
  217.     }
  218.  
  219. }
  220.  
  221.  
  222.  
  223. proc installExample {sysName designSrc checkfile} {
  224.  
  225.  
  226.  
  227.     set cc [ClientContext::global]
  228.  
  229.     set phaseV [$cc currentPhase]
  230.  
  231.     set sysV [$phaseV findSystemVersion $sysName "system"]
  232.  
  233.     if {![$sysV isNil]} {
  234.  
  235.         puts "System '$sysName' already exists: not configuring it again."
  236.  
  237.     } else {
  238.  
  239.         require "$designSrc"
  240.  
  241.         mkImplementation $checkfile
  242.  
  243.     }
  244.  
  245. }
  246.  
  247.  
  248.  
  249.