home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / custfvuiob.tcl < prev    next >
Encoding:
Text File  |  1997-11-26  |  9.3 KB  |  342 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)custfvuiob.tcl    /main/titanic/18
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)custfvuiob.tcl    /main/titanic/18   26 Nov 1997 Copyright 1996 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14. require "browsuiobj.tcl"
  15.  
  16. Class CustFVUiObj : {BrowsUiObj} {
  17.     constructor
  18.     method destructor
  19.     method addCustomFileV
  20.     method customFileVersions
  21.     method deselectObjects
  22.     method initializeInfo
  23.     method moduleFiles
  24.     method newObjects
  25.     method printObjects
  26.     method removeObjects
  27.     method selectObject
  28. }
  29.  
  30. global CustFVUiObj::uiClass
  31. set CustFVUiObj::uiClass "CustomFileVersions"
  32.  
  33.  
  34. constructor CustFVUiObj {class this name} {
  35.     set this [BrowsUiObj::constructor $class $this $name]
  36.     # Start constructor user section
  37.  
  38.     $this uiName "<customization files>"
  39.     $this uiText "customization files"
  40.  
  41.     # End constructor user section
  42.     return $this
  43. }
  44.  
  45. method CustFVUiObj::destructor {this} {
  46.     # Start destructor user section
  47.     # End destructor user section
  48.     $this BrowsUiObj::destructor
  49. }
  50.  
  51. method CustFVUiObj::addCustomFileV {this} {
  52.     foreach childType [CustFVUiObj::customFileNames] {
  53.     set customFileList($childType) 1
  54.     }
  55.     foreach obj [$this getChildSet customFileVersions] {
  56.     set customFile [$obj customFile]
  57.     set name [$customFile name]
  58.     set type [$customFile type]
  59.     if {"$type" != ""} {
  60.         append name ".$type"
  61.     }
  62.     if [info exists customFileList($name)] {
  63.         unset customFileList($name)
  64.     }
  65.     }
  66.     if [info exists customFileList] {
  67.     set entrySet [lsort [array names customFileList]]
  68.     } else {
  69.     set entrySet ""
  70.     }
  71.  
  72.     require "editseldia.tcl"
  73.     set box .main.newCustfileV
  74.     ClassMaker::extend EditSelDialog NewCustfileVEditSelDialog dbObj
  75.     NewCustfileVEditSelDialog new $box \
  76.     -title "New Customization File Version" \
  77.     -message "Customization File:" \
  78.     -entrySet $entrySet \
  79.     -dbObj [$this getParent CustomLevelVersion] \
  80.     -okPressed {
  81.         set file [%this text]
  82.         set selection [splitFileName $file]
  83.         set name [lindex $selection 0]
  84.         set type [lindex $selection 1]
  85.         set script "global CustFVUiObj:custFV"
  86.         append script " ;"
  87.         append script " set CustFVUiObj:custFV \[CustFileUtilities::make \
  88.         [%this dbObj] [list $name] [list $type] \
  89.         \]"
  90.         require "custfileut.tcl"
  91.         .main startCommand tcl \
  92.         "$script" "" \
  93.         "Creating customization file version '$file'" \
  94.         {1 0} 1
  95.         %this delete
  96.     } \
  97.     -editPressed {
  98.         if [info exists CustFVUiObj:custFV] {
  99.         ${CustFVUiObj:custFV} editFile
  100.         unset CustFVUiObj:custFV
  101.         }
  102.     }
  103.     $box popUp
  104. }
  105.  
  106. proc CustFVUiObj::associations {} {
  107.     set associations {customFileVersions}
  108.  
  109.     # Only show module files when it is visible within the view spec
  110.     if [catch {
  111.     set viewSpec [[.main viewHdlr] getViewSpec \
  112.         "${CustFVUiObj::uiClass}" "" "[[.main infoView] currentViewName]"]
  113.     }] {
  114.     resetErrorVars
  115.     lappend associations moduleFiles
  116.     } elseif {[isCommand $viewSpec] &&
  117.           [lsearch -exact "[$viewSpec associations]" moduleFiles] != -1} {
  118.     lappend associations moduleFiles
  119.     }
  120.  
  121.     return $associations
  122. }
  123.  
  124. proc CustFVUiObj::childTypes {assoc} {
  125.     if {[lsearch -exact "[CustFVUiObj::associations]" "$assoc"] == -1} {
  126.     return ""
  127.     }
  128.     set childTypes [BrowserProcs::childTypes $assoc]
  129.     case "$childTypes" in {
  130.     {CustomFileVersion} {
  131.         return {
  132.         mnu modules objtype opendefs openlocs pnl propdefs proplocs
  133.         roundtrip vie
  134.         }
  135.     }
  136.     {ModuleFile} {
  137.         return ExternalDirectory
  138.     }
  139.     {default} {
  140.         return "$childTypes"
  141.     }
  142.     }
  143. }
  144.  
  145. proc CustFVUiObj::customEtcFileNames {} {
  146.     set customEtcFileNames {
  147.     cad.mnu cad.pnl ccd.mnu ccd.pnl checkconfig.checkconfig class.mnu
  148.     copyspecs.copyspecs cod.mnu cod.pnl desk.mnu desk.vie
  149.     dfd.mnu dfd.pnl diagram.mnu etd.mnu etd.pnl m4env.m4env mgd.mnu mgd.pnl
  150.     maketmpl.maketmpl objtype.objtype opendefs.opendefs openlocs.openlocs
  151.     propdefs.propdefs proplocs.proplocs roundtrip.roundtrip std.mnu
  152.     std.pnl ucd.mnu ucd.pnl
  153.     }
  154.     if [[[.main currentObj] browsUiObj] isA CustFVUiObj] {
  155.     lappend customEtcFileNames modules.modules
  156.     }
  157.     return $customEtcFileNames
  158. }
  159.  
  160. proc CustFVUiObj::customFileNames {} {
  161.     set currentObj [[.main currentObj] browsUiObj]
  162.     if {"$currentObj" == ""} {
  163.     return ""
  164.     }
  165.     if [$currentObj isA CustFVUiObj] {
  166.     return [concat \
  167.         [CustFVUiObj::customEtcFileNames] \
  168.         [CustFVUiObj::customTclFileNames] \
  169.     ]
  170.     }
  171.     for {set parent $currentObj} \
  172.     {"$parent" != ""} \
  173.     {set parent [$parent parent]} {
  174.         if {! [$parent isA ExtFUiObj]} break
  175.         if {"[$parent getInfo Type]" != "ExternalDirectory"} continue
  176.         if {"[$parent getInfo Name]" == "tcl"} {
  177.         return [CustFVUiObj::customTclFileNames]
  178.         }
  179.         if {"[$parent getInfo Name]" == "etc"} {
  180.         return [CustFVUiObj::customEtcFileNames]
  181.         }
  182.     }
  183.     return ""
  184. }
  185.  
  186. method CustFVUiObj::customFileVersions {this} {
  187.     return [[$this parent] customFileVersions]
  188. }
  189.  
  190. proc CustFVUiObj::customTclFileNames {} {
  191.     if [[[.main currentObj] browsUiObj] isA CustFVUiObj] {
  192.     return ""
  193.     }
  194.     return {
  195.     clbrowse.tcl d_desk.tcl docbatch.tcl mtool.tcl s_desk.tcl uce.tcl
  196.     ude.tcl
  197.     }
  198. }
  199.  
  200. method CustFVUiObj::deselectObjects {this} {
  201.     set custlvlV [$this getParent CustomLevelVersion]
  202.     set script ""
  203.     foreach obj [.main selectedObjSet] {
  204.     if {"$script" != ""} {
  205.         append script " ;"
  206.     }
  207.     append script " $custlvlV deselectVersion $obj"
  208.     }
  209.     .main startCommand tcl "$script" "" "" {1 0} 1
  210. }
  211.  
  212. proc CustFVUiObj::infoProperties {} {
  213.     return [BrowserProcs::infoProperties]
  214. }
  215.  
  216. method CustFVUiObj::initializeInfo {this dummy} {
  217.     $this BrowsUiObj::initializeInfo $dummy
  218.     $this setInfo Text "[$this uiText] of [[$this parent] getInfo Text]"
  219. }
  220.  
  221. method CustFVUiObj::moduleFiles {this} {
  222.     set moduleFiles ""
  223.     if {[.main customLevelVersion] == [$this parent]} {
  224.     foreach module [[.main moduleHdlr] moduleSpecSet] {
  225.         set path [$module path]
  226.         set directory [path_name directory $path]
  227.         set file [path_name file $path]
  228.         regsub -all " |\\." "$file" "_" fileId
  229.         set moduleFile $this.${ExtFUiObj::uiClass}:$fileId
  230.         if {! [isCommand $moduleFile]} {
  231.         ExtFUiObj new $moduleFile \
  232.             -parent $this \
  233.             -uiName "$file" \
  234.             -directory $directory \
  235.             -isDirectory 1 \
  236.             -inModule 1
  237.         }
  238.         lappend moduleFiles $moduleFile
  239.     }
  240.     }
  241.     return $moduleFiles
  242. }
  243.  
  244. method CustFVUiObj::newObjects {this} {
  245.     set custlvlV [$this getParent CustomLevelVersion]
  246.     set script ""
  247.     foreach obj [.main selectedObjSet] {
  248.     if {"$script" != ""} {
  249.         append script " ;"
  250.     }
  251.     append script " $custlvlV derive $obj"
  252.     }
  253.     .main startCommand tcl "$script" "" "" {1 0} 1
  254. }
  255.  
  256. method CustFVUiObj::printObjects {this} {
  257.     set tmpFiles ""
  258.     set asciiFiles ""
  259.     foreach obj [.main selectedObjSet] {
  260.     if [$obj isA CustomFileVersion] {
  261.         set tmpFile [args_file {}]
  262.         $obj downLoad $tmpFile
  263.         lappend tmpFiles $tmpFile
  264.     } else {
  265.         lappend asciiFiles [path_name concat [$obj directory] [$obj uiName]]
  266.     }
  267.     }
  268.     BrowserProcs::printObjects $tmpFiles "" 1
  269.     BrowserProcs::printObjects $asciiFiles "" 0
  270. }
  271.  
  272. method CustFVUiObj::removeObjects {this} {
  273.     set box .main.removeWarning
  274.     ClassMaker::extend YesNoWarningDialog RemoveObjectsWarningDialog dbObj
  275.     RemoveObjectsWarningDialog new $box \
  276.     -title "Confirm Customization File Version Delete" \
  277.     -message [BrowserProcs::removeMessage] \
  278.     -dbObj [$this getParent CustomLevelVersion] \
  279.     -noPressed {%this delete} \
  280.     -yesPressed {
  281.         set dbObj [%this dbObj]
  282.         set script ""
  283.         foreach obj [.main selectedObjSet] {
  284.         if {"$script" != ""} {
  285.             append script " ;"
  286.         }
  287.         if [$obj isA BrowsDbObj] {
  288.             append script " $dbObj remove $obj"
  289.         } else {
  290.             append script [list BasicFS::removeFile \
  291.             [path_name concat [$obj directory] [$obj uiName]]]
  292.         }
  293.         }
  294.         .main startCommand tcl "$script" "" "" {1 0} 1
  295.         %this delete
  296.     }
  297.     $box delCancelButton
  298.     $box popUp
  299. }
  300.  
  301. method CustFVUiObj::selectObject {this mode} {
  302.     busy {
  303.     set custlvlV [$this getParent CustomLevelVersion]
  304.     set versionList ""
  305.     foreach custFV [$custlvlV customFileVersions] {
  306.         set workingList([$custFV customFile]) $custFV
  307.     }
  308.     case "$mode" in {
  309.         {new} {
  310.         set custFList ""
  311.         foreach custF [[$custlvlV customLevel] customFiles] {
  312.             if [info exists workingList($custF)] continue
  313.             lappend custFList $custF
  314.         }
  315.         }
  316.         {default} {
  317.         set custFList ""
  318.         foreach obj [.main selectedObjSet] {
  319.             lappend custFList [$obj customFile]
  320.         }
  321.         }
  322.     }
  323.     foreach custF $custFList {
  324.         set custFName [$custF name]
  325.         if [info exists workingList($custF)] {
  326.         set working $workingList($custF)
  327.         } else {
  328.         set working [ORB::nil]
  329.         }
  330.         foreach version [$custF customFileVersions] {
  331.         if [$version isSame $working] continue
  332.         if {"[$version status]" == "working"} continue
  333.         lappend versionList [list $version "$custFName"]
  334.         }
  335.     }
  336.     BrowserProcs::selectObject $custlvlV $versionList $mode
  337.     }
  338. }
  339.  
  340. # Do not delete this line -- regeneration end marker
  341.  
  342.