home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / custfileut.tcl < prev    next >
Text File  |  1996-11-15  |  5KB  |  174 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cadre Technologies Inc.    1996
  4. #
  5. #      File:           @(#)custfileut.tcl    /main/hindenburg/3
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)custfileut.tcl    /main/hindenburg/3   15 Nov 1996 Copyright 1996 Cadre Technologies Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class CustFileUtilities : {Object} {
  16.     constructor
  17.     method destructor
  18. }
  19.  
  20. constructor CustFileUtilities {class this name} {
  21.     set this [Object::constructor $class $this $name]
  22.     # Start constructor user section
  23.     # End constructor user section
  24.     return $this
  25. }
  26.  
  27. method CustFileUtilities::destructor {this} {
  28.     # Start destructor user section
  29.     # End destructor user section
  30. }
  31.  
  32. proc CustFileUtilities::find {lvlObj name type {subDir etc}} {
  33.     if {"$lvlObj" == ""} {
  34.     set custF [path_name concat [path_name concat ~ icase] $name $type]
  35.     if {! [file exists $custF]} {
  36.         return ""
  37.     }
  38.     } elseif {[$lvlObj isA Corporate]} {
  39.     if {"[path_name file $name]" != "$name"} {
  40.         set custF [path_name concat \
  41.         [path_name concat [m4_var get M4_home] $subDir] $name $type \
  42.         ]
  43.         if {! [file exists $custF]} {
  44.         return ""
  45.         }
  46.     } elseif [catch {set custF [m4_path_name $subDir $name.$type]}] {
  47.         resetErrorVars
  48.         return ""
  49.     }
  50.     } else {
  51.     set custF [$lvlObj findCustomFileVersion $name $type]
  52.     if [$custF isNil] {
  53.         return ""
  54.     }
  55.     }
  56.     return $custF
  57. }
  58.  
  59. proc CustFileUtilities::read {lvlObj name type {subDir etc}} {
  60.     set custF [CustFileUtilities::find $lvlObj $name $type $subDir]
  61.     if {"$custF" == ""} return
  62.  
  63.     if {"$lvlObj" == "" || [$lvlObj isA Corporate]} {
  64.     source $custF
  65.     } else {
  66.         set tmpFile [args_file {}]
  67.         $custF downLoad $tmpFile
  68.         source $tmpFile
  69.         unlink $tmpFile
  70.     }
  71. }
  72.  
  73. proc CustFileUtilities::save {tmpFile lvlObj name type {subDir etc}} {
  74.     set custF [CustFileUtilities::find $lvlObj $name $type $subDir]
  75.     if {"$custF" == ""} return
  76.  
  77.     if {"$lvlObj" == "" || [$lvlObj isA Corporate]} {
  78.     copy_text_file $tmpFile $custF
  79.     } else {
  80.     $custF upLoad $tmpFile
  81.     }
  82. }
  83.  
  84. proc CustFileUtilities::make {lvlObj name type {subDir etc}} {
  85.  
  86.     # Check whether contents should be initialized or not
  87.     case "$type" in {
  88.     {mnu objtype opendefs openlocs propdefs proplocs tcl vie} {
  89.         set initContents 0
  90.     }
  91.     default {
  92.         case "$name" in {
  93.         {"" m4env} {
  94.             set initContents 0
  95.         }
  96.         default {
  97.             set initContents 1
  98.         }
  99.         }
  100.     }
  101.     }
  102.     if {"$lvlObj" == ""} {
  103.     set custF [path_name concat [path_name concat ~ icase] $name $type]
  104.     set crntPath [pwd]
  105.     cd [path_name directory $custF]
  106.     BasicFS::makeFile [path_name file $custF]
  107.     cd $crntPath
  108.  
  109.     # Initialize contents
  110.     set cc [ClientContext::global]
  111.     if {$initContents && [$cc customFileExists $name $type $subDir]} {
  112.         set tmpFile [args_file {}]
  113.         $cc downLoadCustomFile $name $type $subDir $tmpFile
  114.         copy_text_file $tmpFile $custF
  115.         unlink $tmpFile
  116.     }
  117.     } elseif {[$lvlObj isA Corporate]} {
  118.     set custF [path_name concat \
  119.         [path_name concat [m4_var get M4_home] $subDir] $name $type \
  120.     ]
  121.     set crntPath [pwd]
  122.     cd [path_name directory $custF]
  123.     BasicFS::makeFile [path_name file $custF]
  124.     cd $crntPath
  125.     } else {
  126.     # Initialize contents
  127.     set cc [ClientContext::global]
  128.     set tmpFileExists 0
  129.     if {$initContents && [$cc customFileExists $name $type $subDir]} {
  130.         set tmpFile [args_file {}]
  131.         set tmpFileExists 1
  132.         $cc downLoadCustomFile $name $type $subDir $tmpFile
  133.     }
  134.  
  135.     set custF [$lvlObj createCustomFileVersion $name $type]
  136.  
  137.     if $tmpFileExists {
  138.         $custF edit
  139.         $custF upLoad $tmpFile
  140.         $custF quit
  141.         unlink $tmpFile
  142.     }
  143.     }
  144.     return $custF
  145. }
  146.  
  147. proc CustFileUtilities::contents {lvlObj name type {subDir etc}} {
  148.     set custF [CustFileUtilities::find $lvlObj $name $type $subDir]
  149.     if {"$custF" == ""} {
  150.     return {0 ""}
  151.     }
  152.  
  153.     set tmpFileExists 0
  154.     if {"$lvlObj" == "" || [$lvlObj isA Corporate]} {
  155.     set fid [open $custF]
  156.     } else {
  157.         set tmpFile [args_file {}]
  158.         set tmpFileExists 1
  159.         $custF downLoad $tmpFile
  160.         set fid [open $tmpFile]
  161.     }
  162.  
  163.     set contents [read -nonewline $fid]
  164.     close $fid
  165.     if $tmpFileExists {
  166.         unlink $tmpFile
  167.     }
  168.  
  169.     return [list 1 "$contents"]
  170. }
  171.  
  172. # Do not delete this line -- regeneration end marker
  173.  
  174.