home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / ucustfuiob.tcl < prev    next >
Encoding:
Text File  |  1997-10-17  |  8.0 KB  |  293 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1996
  4. #
  5. #      File:           @(#)ucustfuiob.tcl    /main/titanic/18
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)ucustfuiob.tcl    /main/titanic/18   17 Oct 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 UCustFUiObj : {BrowsUiObj} {
  17.     constructor
  18.     method destructor
  19.     method addExternalFile
  20.     method externalFiles
  21.     method files
  22.     method moduleFiles
  23.     method printObjects
  24.     method removeObjects
  25.     attribute pattern
  26. }
  27.  
  28. global UCustFUiObj::uiClass
  29. set UCustFUiObj::uiClass "UserCustomFiles"
  30.  
  31.  
  32. constructor UCustFUiObj {class this name} {
  33.     set this [BrowsUiObj::constructor $class $this $name]
  34.     # Start constructor user section
  35.  
  36.     $this uiName "<user customization files>"
  37.     $this uiText "user customization files"
  38.     $this pattern "*"
  39.  
  40.     # End constructor user section
  41.     return $this
  42. }
  43.  
  44. method UCustFUiObj::destructor {this} {
  45.     # Start destructor user section
  46.     # End destructor user section
  47.     $this BrowsUiObj::destructor
  48. }
  49.  
  50. method UCustFUiObj::addExternalFile {this} {
  51.     foreach childType [UCustFUiObj::externalFileNames] {
  52.     set externalFileList($childType) 1
  53.     }
  54.     foreach externalFile [$this getChildSet externalFiles] {
  55.     set type [$externalFile uiName]
  56.     if [info exists externalFileList($type)] {
  57.         unset externalFileList($type)
  58.     }
  59.     }
  60.     if [info exists externalFileList] {
  61.     set entrySet [lsort [array names externalFileList]]
  62.     } else {
  63.     set entrySet ""
  64.     }
  65.  
  66.     require "editseldia.tcl"
  67.     set box .main.newExternalF
  68.     ClassMaker::extend EditSelDialog NewExternalFileEditSelDialog uiObj
  69.     NewExternalFileEditSelDialog new $box \
  70.     -title "New External File" \
  71.     -message "External File:" \
  72.     -entrySet $entrySet \
  73.     -uiObj $this \
  74.     -okPressed {
  75.         set file [%this text]
  76.         set selection [splitFileName $file]
  77.         set name [lindex $selection 0]
  78.         set type [lindex $selection 1]
  79.         case "$type" in {
  80.         {opendefs openlocs propdefs proplocs} {
  81.             wmtkerror "External file of type $type not supported"
  82.             %this delete
  83.             return
  84.         }
  85.         }
  86.         set script "global UCustFUiObj:custF"
  87.         append script " ;"
  88.         append script " set UCustFUiObj:custF \[CustFileUtilities::make \
  89.         \"\" [list $name] [list $type] \
  90.         \]"
  91.         require "custfileut.tcl"
  92.         .main startCommand tcl \
  93.         "$script" "" \
  94.         "Creating external file '$file'" \
  95.         {1 0} 1
  96.         %this delete
  97.     } \
  98.     -editPressed {
  99.         if [info exists UCustFUiObj:custF] {
  100.         if [file isfile ${UCustFUiObj:custF}] {
  101.             regsub -all " |\\." "[$this text]" "_" fileId
  102.             [$this uiObj].ExternalFile:$fileId editFile
  103.         }
  104.         unset UCustFUiObj:custF
  105.         }
  106.     }
  107.     $box popUp
  108. }
  109.  
  110. proc UCustFUiObj::associations {} {
  111.     set associations {externalFiles}
  112.  
  113.     # Only show module files when it is visible within the view spec
  114.     if [catch {
  115.     set viewSpec [[.main viewHdlr] getViewSpec \
  116.         "${UCustFUiObj::uiClass}" "" "[[.main infoView] currentViewName]"]
  117.     }] {
  118.     resetErrorVars
  119.     lappend associations moduleFiles
  120.     } elseif {[isCommand $viewSpec] &&
  121.           [lsearch -exact "[$viewSpec associations]" moduleFiles] != -1} {
  122.     lappend associations moduleFiles
  123.     }
  124.  
  125.     return $associations
  126. }
  127.  
  128. proc UCustFUiObj::childTypes {assoc} {
  129.     if {[lsearch -exact "[UCustFUiObj::associations]" "$assoc"] == -1} {
  130.     return ""
  131.     }
  132.     set childTypes [BrowserProcs::childTypes $assoc]
  133.     case "$childTypes" in {
  134.     {ModuleFile} {
  135.         return ExternalDirectory
  136.     }
  137.     {default} {
  138.         return "$childTypes"
  139.     }
  140.     }
  141. }
  142.  
  143. proc UCustFUiObj::externalEtcFileNames {} {
  144.     set externalEtcFileNames {
  145.     cad.mnu cad.pnl ccd.mnu ccd.pnl checkconfig.checkconfig class.mnu \
  146.     cod.mnu cod.pnl copyspecs.copyspecs desk.mnu desk.vie \
  147.     dfd.mnu dfd.pnl diagram.mnu etd.mnu etd.pnl mgd.mnu mgd.pnl
  148.     objtype.objtype roundtrip.roundtrip std.mnu std.pnl ucd.mnu ucd.pnl
  149.     }
  150.     if [[[.main currentObj] browsUiObj] isA UCustFUiObj] {
  151.     lappend externalEtcFileNames modules.modules
  152.     lappend externalEtcFileNames [path_name file [m4_var meta4UserEnv]]
  153.     } else {
  154.     lappend externalEtcFileNames "m4env.m4env"
  155.     }
  156.  
  157.     return $externalEtcFileNames
  158. }
  159.  
  160. proc UCustFUiObj::externalFileNames {} {
  161.     set currentObj [[.main currentObj] browsUiObj]
  162.     if {"$currentObj" == ""} {
  163.     return ""
  164.     }
  165.     if [$currentObj isA UCustFUiObj] {
  166.     return [concat \
  167.         [UCustFUiObj::externalEtcFileNames] \
  168.         [UCustFUiObj::externalTclFileNames] \
  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 [UCustFUiObj::externalTclFileNames]
  178.         }
  179.         if {"[$parent getInfo Name]" == "etc"} {
  180.         return [UCustFUiObj::externalEtcFileNames]
  181.         }
  182.     }
  183.     return ""
  184. }
  185.  
  186. method UCustFUiObj::externalFiles {this} {
  187.     set triples ""
  188.  
  189.     set icaseDir [location [M4Login::getHomeDir] "icase"]
  190.  
  191.     if {[BasicFS::makeDirAll $icaseDir] == 0} {
  192.     set icasePattern [path_name concat $icaseDir \
  193.                   [$this pattern]]
  194.     if {! [catch {set files [otglob $icasePattern]}]} {
  195.         foreach pathFile $files {
  196.         if {! [file isfile $pathFile]} continue
  197.         set file [file tail $pathFile]
  198.         lappend triples [list $file $icaseDir 0]
  199.         }
  200.     }
  201.     }
  202.  
  203.     set meta4UserEnv [m4_var meta4UserEnv]
  204.     if [file exists "$meta4UserEnv"] {
  205.     set directory [path_name directory $meta4UserEnv]
  206.     set file [path_name file $meta4UserEnv]
  207.     lappend triples [list $file $directory 0]
  208.     }
  209.  
  210.     return [$this files $triples]
  211. }
  212.  
  213. proc UCustFUiObj::externalTclFileNames {} {
  214.     if [[[.main currentObj] browsUiObj] isA UCustFUiObj] {
  215.     return {u_clbrowse.tcl u_desk.tcl u_docbatch.tcl u_uce.tcl u_ude.tcl}
  216.     }
  217.     return {
  218.     clbrowse.tcl d_desk.tcl docbatch.tcl mtool.tcl s_desk.tcl uce.tcl
  219.     ude.tcl
  220.     }
  221. }
  222.  
  223. method UCustFUiObj::files {this triples} {
  224.     set externalFiles ""
  225.     foreach triple $triples {
  226.     set file [lindex $triple 0]
  227.     set directory [lindex $triple 1]
  228.     set inModule [lindex $triple 2]
  229.     regsub -all " |\\." "$file" "_" fileId
  230.     set externalFile $this.${ExtFUiObj::uiClass}:$fileId
  231.     if {! [isCommand $externalFile]} {
  232.         ExtFUiObj new $externalFile \
  233.         -parent $this \
  234.         -uiName "$file" \
  235.         -directory $directory \
  236.         -isDirectory $inModule \
  237.         -inModule $inModule
  238.     }
  239.     lappend externalFiles $externalFile
  240.     }
  241.     return "$externalFiles"
  242. }
  243.  
  244. proc UCustFUiObj::infoProperties {} {
  245.     return [BrowserProcs::infoProperties]
  246. }
  247.  
  248. method UCustFUiObj::moduleFiles {this} {
  249.     set triples ""
  250.     if {[.main customLevelVersion] == ""} {
  251.     foreach module [[.main moduleHdlr] moduleSpecSet] {
  252.         set path [$module path]
  253.         set directory [path_name directory $path]
  254.         set file [path_name file $path]
  255.         lappend triples [list $file $directory 1]
  256.     }
  257.     }
  258.     return [$this files [lsort $triples]]
  259. }
  260.  
  261. method UCustFUiObj::printObjects {this} {
  262.     set asciiFiles ""
  263.     foreach obj [.main selectedObjSet] {
  264.     lappend asciiFiles [path_name concat [$obj directory] [$obj uiName]]
  265.     }
  266.     BrowserProcs::printObjects $asciiFiles ""
  267. }
  268.  
  269. method UCustFUiObj::removeObjects {this} {
  270.     set box .main.removeWarning
  271.     YesNoWarningDialog new $box \
  272.     -title "Confirm Object Delete" \
  273.     -message [BrowserProcs::removeMessage] \
  274.     -noPressed {%this delete} \
  275.     -yesPressed {
  276.         set script ""
  277.         foreach obj [.main selectedObjSet] {
  278.         if {"$script" != ""} {
  279.             append script " ;"
  280.         }
  281.         append script [list BasicFS::removeFile \
  282.             [path_name concat [$obj directory] [$obj uiName]]]
  283.         }
  284.         .main startCommand tcl "$script" "" "" {1 0} 1
  285.         %this delete
  286.     }
  287.     $box delCancelButton
  288.     $box popUp
  289. }
  290.  
  291. # Do not delete this line -- regeneration end marker
  292.  
  293.