home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / dsysvdbobj.tcl < prev    next >
Encoding:
Text File  |  1997-09-25  |  17.1 KB  |  655 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Cayenne Software Inc.    1997
  4. #
  5. #      File:           @(#)dsysvdbobj.tcl    /main/titanic/14
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)dsysvdbobj.tcl    /main/titanic/14   25 Sep 1997 Copyright 1997 Cayenne Software Inc.
  10.  
  11. # Start user added include file section
  12. require "ssysvdbobj.tcl"
  13. # End user added include file section
  14.  
  15. require "sysvdbobj.tcl"
  16.  
  17. Class DSysVDbObj : {SysVDbObj} {
  18.     constructor
  19.     method destructor
  20.     method promoter
  21.     method addDocStructure
  22.     method addFileSections
  23.     method addPropertySection
  24.     method addLocalSection
  25.     method allowsDrop
  26.     method browserObjType
  27.     method browserType
  28.     method documentedSystemName
  29.     method editorType
  30.     method generate
  31.     method generateObjects
  32.     method importObject
  33.     method name2section
  34.     method printObjects
  35.     method removeDocDir
  36.     method sections
  37.     method updateDocDir
  38.     method unstructuredName
  39.     method removeSpecials
  40.     method changeObjects
  41. }
  42.  
  43. global DSysVDbObj::dsmName
  44. set DSysVDbObj::dsmName "DocumentStructureMatrix"
  45.  
  46.  
  47. constructor DSysVDbObj {class this name} {
  48.     set this [SysVDbObj::constructor $class $this $name]
  49.     # Start constructor user section
  50.     # End constructor user section
  51.     return $this
  52. }
  53.  
  54. method DSysVDbObj::destructor {this} {
  55.     # Start destructor user section
  56.     # End destructor user section
  57.     $this SysVDbObj::destructor
  58. }
  59.  
  60. method DSysVDbObj::promoter {this} {
  61.  
  62.     global DSysVDbObj::count
  63.     set DSysVDbObj::count 0
  64.  
  65.     module_promoter DSysVDbObj $this
  66. }
  67.  
  68. method DSysVDbObj::addDocStructure {this} {
  69.     if {! [[$this findFileVersion "${DSysVDbObj::dsmName}" dsm] isNil]} {
  70.     wmtkinfo "${DSysVDbObj::dsmName} already exists"
  71.     return
  72.     }
  73.  
  74.     set configV [$this getParent ConfigVersion]
  75.     set script "$this createFileVersion \
  76.     [list ${DSysVDbObj::dsmName}] doc 0 dsm matrix $configV"
  77.     .main startCommand tcl \
  78.     "$script" "" \
  79.     "Creating dsm file version '${DSysVDbObj::dsmName}'..." \
  80.     {1 0} 1
  81. }
  82.  
  83. method DSysVDbObj::addFileSections {this} {
  84.     busy {
  85.     set docSys [$this docSys]
  86.     set docSysName [$this setGetProp doc_sys]
  87.     if {"$docSys" == "" || [$docSys isNil]} {
  88.         wmtkerror \
  89.         "Documented system '$docSysName' does not exist\
  90.          within the current PhaseVersion"
  91.         return
  92.     }
  93.  
  94.     set headerSpecList {
  95.         {Name 25 ascii {increasing 2}}
  96.         {Version 25 ascii {increasing 3}}
  97.         {Type 18 ascii {increasing 1}}
  98.     }
  99.     set fileVList ""
  100.     set objectSpecList ""
  101.     foreach fileV [$docSys localFileVersions] {
  102.         set fileType [[$fileV file] type]
  103.         if {"$fileType" == "cdm"} continue
  104.         set typeSpec [getObjectSpec [.main objectHdlr] \
  105.         [$fileV uiClass] [$fileV browserType] \
  106.         ]
  107.         if {"$typeSpec" != ""} {
  108.         set icon [$typeSpec smallIcon]
  109.         } else {
  110.         set icon ""
  111.         }
  112.         lappend fileVList $fileV
  113.         lappend objectSpecList [list $icon \
  114.         [$fileV name] \
  115.         [$fileV versionName] \
  116.         [$fileV browserType] \
  117.         ]
  118.     }
  119.  
  120.     if [lempty $fileVList] {
  121.         wmtkinfo \
  122.         "There are no files in system '$docSysName'\
  123.          to create a reference to"
  124.         return
  125.     }
  126.  
  127.     if [[$this findFileVersion "${DSysVDbObj::dsmName}" dsm] isNil] {
  128.         $this addDocStructure
  129.     }
  130.  
  131.     require "browsviewd.tcl"
  132.     set box .main.newFileSection
  133.     ClassMaker::extend BrowsViewDialog NewFileSectionBrowsViewDialog dbObj
  134.     NewFileSectionBrowsViewDialog new $box \
  135.         -title "New File Section" \
  136.         -message "Select FileVersion(s) to create a link to" \
  137.         -headerSpecList $headerSpecList \
  138.         -objectSpecList $objectSpecList \
  139.         -objectList $fileVList \
  140.         -dbObj $this \
  141.         -cancelPressed {%this delete} \
  142.         -okPressed {
  143.         set script ""
  144.         set dbObj [%this dbObj]
  145.         foreach object [[%this view] selectedSet] {
  146.             set fileV [$object object]
  147.             set file [$fileV file]
  148.             if {"$script" != ""} {
  149.             append script " ;"
  150.             }
  151.             append script \
  152.             " DocStructPart new .docStrucPart \
  153.                 -documentVersion $dbObj \
  154.                 -sectionName \
  155.                 \"[$file qualifiedName :]_[$file type]\" \
  156.                 -sectionType \"[$file type]\" \
  157.                 -fileVersion $fileV"
  158.             append script " ;"
  159.             append script " DocGenerator::createSection .docStrucPart"
  160.             append script " ;"
  161.             append script " .docStrucPart delete"
  162.         }
  163.  
  164.         require_module_file "docgenerat.tcl" docwriter
  165.         require_module_file "docstructp.tcl" docwriter
  166.         .main startCommand tcl \
  167.             "$script" "" "Creating file section(s)..." {1 0} 1
  168.         %this delete
  169.         }
  170.     $box popUp
  171.     }
  172. }
  173.  
  174. method DSysVDbObj::addPropertySection {this} {
  175.     busy {
  176.     if [[$this findFileVersion "${DSysVDbObj::dsmName}" dsm] isNil] {
  177.         $this addDocStructure
  178.     }
  179.     set dlg .main.newPropertySection
  180.     if [[$this documentedSystem] isNil] {
  181.         wmtkerror "Invalid documented system specified"
  182.     } else {
  183.         require "propsecdlg.tcl"
  184.         PropSecDlg new $dlg $this "" -title "New Property Section"
  185.         $dlg popUp
  186.     }
  187.     }
  188. }
  189.  
  190. method DSysVDbObj::addLocalSection {this} {
  191.     busy {
  192.     if [[$this findFileVersion "${DSysVDbObj::dsmName}" dsm] isNil] {
  193.         $this addDocStructure
  194.     }
  195.     set box .main.newLocalSection
  196.     if {! [isCommand $box]} {
  197.         require_module_file "newlocalse.tcl" docwriter
  198.         NewLocalSectionDlg new $box
  199.     }
  200.     $box dbObj $this
  201.     $box popUp
  202.     }
  203. }
  204.  
  205. method DSysVDbObj::allowsDrop {this uiClass} {
  206.     case "$uiClass" in {
  207.     {ExternalFileVersion Graph} {
  208.         return 1
  209.     }
  210.     {default} {
  211.         return 0
  212.     }
  213.     }
  214. }
  215.  
  216. proc DSysVDbObj::associations {} {
  217.     return {sections customFileVersionSet workItemSet}
  218. }
  219.  
  220. method DSysVDbObj::browserObjType {this} {
  221.     return "DSysVDbObj"
  222. }
  223.  
  224. method DSysVDbObj::browserType {this} {
  225.     return "DocumentVersion"
  226. }
  227.  
  228. proc DSysVDbObj::childTypes {assoc} {
  229.     if {[lsearch -exact "[DSysVDbObj::associations]" "$assoc"] == -1} {
  230.     return ""
  231.     }
  232.     return [SysVDbObj::childTypes "$assoc"]
  233. }
  234.  
  235. proc DSysVDbObj::controlledLists {} {
  236.     return [concat \
  237.     [SysVDbObj::controlledLists] \
  238.     {"[$this fileVersionReferenceList]"
  239.      "[$this propertyReferenceList]"} \
  240.     ]
  241. }
  242.  
  243. method DSysVDbObj::documentedSystemName {this} {
  244.     return [$this getPropertyValue doc_sys]
  245. }
  246.  
  247. method DSysVDbObj::editorType {this} {
  248.     return [$this getPropertyValue editor]
  249. }
  250.  
  251. method DSysVDbObj::generate {this} {
  252.     if {[$this getPropertyValue structFile] == "" } {
  253.         set entrySet {}
  254.     } else {
  255.         set entrySet [list [$this getPropertyValue structFile]]
  256.     }
  257.  
  258.     # find the structure templates
  259.     set docEditor [$this getInfo Editor]
  260.     if {[info exist docwriterEditors($docEditor)]} {
  261.     set elms $docwriterTemplates([$this getInfo Editor])
  262.     foreach elm $elms {
  263.         lappend entrySet "[lindex $elm 0] ([lindex $elm 1])"
  264.     }
  265.     }
  266.     
  267.     ClassMaker::extend ListDialog GenerateDocListDialog dbObj
  268.     GenerateDocListDialog new .main.generateDoc \
  269.     -modal yes \
  270.     -title "Generate Document" \
  271.     -message "Document Structure File:" \
  272.     -selectionPolicy BROWSE \
  273.     -entrySet $entrySet \
  274.     -rowCount [llength $entrySet] \
  275.     -dbObj $this \
  276.     -helpPressed {.main helpOnName generateDoc} \
  277.     -cancelPressed {%this delete} \
  278.     -okPressed {
  279.         set dbObj [%this dbObj]
  280.         set structureFile [lindex [%this selectedSet] 0]
  281.         # strip til (
  282.         set index [string first " (" $structureFile]
  283.         if {$index != -1} {
  284.         incr index -1
  285.         set structureFile [string range $structureFile 0 $index]
  286.         }
  287.         
  288.         set confVId [[$dbObj getParent ConfigVersion] identity]
  289.         set sysVId [$dbObj identity]
  290.         set args "generateDocument $confVId $sysVId \
  291.                     [quoteIf $structureFile]"
  292.         .main startDocbatch mtool "$args" "" {0 0} 0
  293.         %this delete
  294.     }
  295.     .main.generateDoc popUp
  296. }
  297.  
  298. method DSysVDbObj::generateObjects {this what} {
  299.     # Determine list of involved objects
  300.     set objectList ""
  301.     foreach obj [.main selectedObjSet] {
  302.     lappend objectList [$obj identity]
  303.     }
  304.  
  305.     if [lempty $objectList] {
  306.     return
  307.     }
  308.  
  309.     # Start docbatch
  310.     set confVId [[$this getParent ConfigVersion] identity]
  311.     set sysVId [$this identity]
  312.     set argsfile [args_file $objectList]
  313.     case "$what" in {
  314.     {structure} {
  315.         set args "generateStructure $confVId $sysVId [list $argsfile]"
  316.     }
  317.     {structureandcontents} {
  318.         set args \
  319.         "generateStructureAndContents $confVId $sysVId [list $argsfile]"
  320.     }
  321.     {contents} {
  322.         set args "generateContents $confVId $sysVId [list $argsfile]"
  323.     }
  324.     }
  325.     .main startDocbatch mtool "$args" "" {1 0} 0
  326. }
  327.  
  328. method DSysVDbObj::importObject {this context node} {
  329.     set projId [lindex $context 0]
  330.     if {"[[$this project] identity]" != "$projId"} {
  331.     wmtkmessage "Can not import from another Project"
  332.     if [isCommand [.main undoCommand]] {
  333.         [.main undoCommand] delete
  334.     }
  335.     return 0
  336.     }
  337.     set phaseVId [lindex $context 2]
  338.     set myPhaseVId [[$node getParent PhaseVersion] identity]
  339.     if {"$myPhaseVId" != "$phaseVId"} {
  340.     wmtkmessage "Can not import from another PhaseVersion"
  341.     if [isCommand [.main undoCommand]] {
  342.         [.main undoCommand] delete
  343.     }
  344.     return 0
  345.     }
  346.     set fileVId [lindex $context 4]
  347.     set fileV [BrowserProcs::id2obj $fileVId FileVersion $node]
  348.  
  349.     # Make sure FileVersion exists
  350.     if [catch {$fileV file}] {
  351.     wmtkinfo "Can not import [lindex $context 5] because it is removed"
  352.     if [isCommand [.main undoCommand]] {
  353.         [.main undoCommand] delete
  354.     }
  355.     return 1
  356.     }
  357.  
  358.     # Make sure that document is initialized
  359.     $this initialize [$node getParent ConfigVersion]
  360.  
  361.     # Remove imported object in case of a cut operation
  362.     if {[.main undoCommandBusy EditPasteCmd] &&
  363.     "[[.main undoCommand] operation]" == "cut"} {
  364.     set sysVId [lindex $context 3]
  365.     set sysV [BrowserProcs::id2obj $sysVId SystemVersion $node]
  366.     $sysV cutVersion $fileV
  367.     }
  368.  
  369.     if [[$this findFileVersion "${DSysVDbObj::dsmName}" dsm] isNil] {
  370.     $this addDocStructure
  371.     }
  372.  
  373.     set script ""
  374.     set sectName [[$fileV file] qualifiedName :]
  375.     set sectType [lindex $context 5]
  376.     append script \
  377.     " DocStructPart new .docStrucPart \
  378.         -documentVersion $this \
  379.         -sectionName \"${sectName}_$sectType\" \
  380.         -sectionType \"$sectType\" \
  381.         -fileVersion $fileV"
  382.     append script " ;"
  383.     append script " set section \[DocGenerator::createSection .docStrucPart\]"
  384.     append script " ;"
  385.     append script " .docStrucPart delete"
  386.     if [.main undoCommandBusy EditPasteCmd] {
  387.     append script " ;"
  388.     append script " [.main undoCommand] addObject \$section"
  389.     }
  390.  
  391.     require_module_file "docgenerat.tcl" docwriter
  392.     require_module_file "docstructp.tcl" docwriter
  393.     if {$this == [[.main currentObj] browsUiObj]} {
  394.     set update 1
  395.     } else {
  396.     set update 0
  397.     }
  398.     .main startCommand tcl \
  399.     "$script" "" \
  400.     "Creating file section '${sectName}_$sectType'..." \
  401.     [list $update 0] 1
  402.  
  403.     return 1
  404. }
  405.  
  406. proc DSysVDbObj::infoProperties {} {
  407.     return [concat \
  408.     [SysVDbObj::infoProperties] \
  409.     {Editor "Documented System"} \
  410.     ]
  411. }
  412.  
  413. method DSysVDbObj::name2section {this name} {
  414.     global browserSections
  415.     foreach section [array names browserSections] {
  416.     set compareName $name
  417.     if {"$browserSections($section)" == "$compareName"} {
  418.         unset browserSections($section)
  419.         return $section
  420.     } else {
  421.         # backward compatible
  422.         if {![$section isA PropertyReference]} {
  423.                 set compareName [rmWhiteSpace $name]
  424.             if {"$browserSections($section)" == "$compareName"} {
  425.                     unset browserSections($section)
  426.                     return $section
  427.             }
  428.         }
  429.     }
  430.     }
  431.  
  432.     global DSysVDbObj::count
  433.     require_module_file "noneuiobj.tcl" docwriter
  434.     set noneObjId $this.${NoneUiObj::uiClass}:${DSysVDbObj::count}
  435.     set noneObj [NoneUiObj new $noneObjId \
  436.     -uiName "$name" \
  437.     -parent $this \
  438.     ]
  439.     incr DSysVDbObj::count 1
  440.     return $noneObj
  441. }
  442.  
  443. method DSysVDbObj::printObjects {this} {
  444.     set docbatchObjects ""
  445.     set skipList {NoneUiObj}
  446.     if {"[[$this editor] printsIncluded]" == "y"} {
  447.     lappend skipList FileRefSection
  448.     }
  449.     foreach obj [.main selectedObjSet] {
  450.     lappend docbatchObjects [$obj identity]
  451.     }
  452.     BrowserProcs::printDocObjects $docbatchObjects
  453. }
  454.  
  455. method DSysVDbObj::removeDocDir {this} {
  456.     set errorStack [$this initializeChildSet sections]
  457.     if {"$errorStack" != ""} {
  458.     wmtkerror $errorStack
  459.     return
  460.     }
  461.     foreach section [$this getChildSet sections] {
  462.     if {! [$section isA DocSection]} continue
  463.     BasicFS::removeFile [$section docLocation] 1
  464.     }
  465.     catch {BasicFS::removeDir [$this path]}
  466. }
  467.  
  468. method DSysVDbObj::sections {this} {
  469.     global browserSections
  470.  
  471.     set sections ""
  472.     foreach section [concat \
  473.         [$this localFileVersions] \
  474.         [$this fileVersionReferences] \
  475.         [$this propertyReferences] \
  476.     ] {
  477.     # Do not use 'getInfo Name' :
  478.     #    is not always up-to-date (e.g. after name change)
  479.     set browserSections($section) "[$section name]"
  480.     }
  481.  
  482.     set dsm [$this findFileVersion "${DSysVDbObj::dsmName}" dsm]
  483.     if {! [$dsm isNil]} {
  484.     if [info exists browserSections($dsm)] {
  485.         unset browserSections($dsm)
  486.     }
  487.     $dsm setIndentation 0
  488.     lappend sections $dsm
  489.  
  490.        set fileInfo [DocStructure new $this.fileInfo]
  491.     $fileInfo load $dsm
  492.     for {set component [$fileInfo firstComponent]} \
  493.         {"$component" != ""} \
  494.         {set component [$component next]} {
  495.         set componentName [$component uiName]
  496.  
  497.         set section [$this name2section "$componentName"]
  498.         $section setIndentation [$component indentation]
  499.         lappend sections $section
  500.     }
  501.     $fileInfo quit
  502.     $fileInfo delete
  503.     }
  504.  
  505.     # Sort the unstructured sections by name and type
  506.     if {! [catch {set nonDsmSections [array names browserSections]}]} {
  507.     foreach section $nonDsmSections {
  508.         set type [$section getInfo Type]
  509.         set nonDsmSectionNames($browserSections($section),$type) $section
  510.     }
  511.     if [info exists nonDsmSectionNames] {
  512.         foreach tuple [lsort [array names nonDsmSectionNames]] {
  513.         set section $nonDsmSectionNames($tuple)
  514.         $section setIndentation -1
  515.         lappend sections $section
  516.         unset browserSections($section)
  517.         }
  518.     }
  519.     }
  520.  
  521.     return "$sections"
  522. }
  523.  
  524. method DSysVDbObj::updateDocDir {this mode {ifNeeded 1}} {
  525.     set sections ""
  526.     set skipped 0
  527.     case "$mode" in {
  528.     {all} {
  529.         set errorStack [$this initializeChildSet sections]
  530.         if {"$errorStack" != ""} {
  531.         wmtkerror $errorStack
  532.         return
  533.         }
  534.         foreach section [$this getChildSet sections] {
  535.         if {! [$section isA DocSection]} continue
  536.         if {$ifNeeded && [$section isDocDirUpToDate]} {
  537.             set skipped 1
  538.             continue
  539.         }
  540.         lappend sections [$section identity]
  541.         }
  542.     }
  543.     {selected} {
  544.         # Determine list of involved objects
  545.             foreach obj [.main selectedObjSet] {
  546.         lappend sections [$obj identity]
  547.         }
  548.     }
  549.     }
  550.     if [lempty $sections] {
  551.     set box .main.updateDocDirInfo
  552.     set name [$this getInfo Name]
  553.     if $skipped {
  554.         set msg "All sections within document '$name' are up to date"
  555.     } else {
  556.         set msg "There are no sections within document '$name'"
  557.     }
  558.     wmtkinfo $msg
  559.     return
  560.     }
  561.  
  562.     set confVId [[$this getParent ConfigVersion] identity]
  563.     set sysVId [$this identity]
  564.     set argsfile [args_file $sections]
  565.     set args "updateDocDir $confVId $sysVId [list $argsfile]"
  566.     .main startDocbatch mtool "$args" "" {1 0} 0
  567. }
  568.  
  569. method DSysVDbObj::unstructuredName {this name type} {
  570.     require_module_file "docgenerat.tcl" docwriter
  571.  
  572.     foreach section [$this getChildSet sections] {
  573.     if {"[$section uiPrefix]" != "-"} continue
  574.     if {"[$section getInfo Type]" != "$type"} continue
  575.  
  576.     set sectionName [$section getInfo Name]
  577.     set id [string last ${DocGenerator::double} $sectionName]
  578.     if {$id == 0} {
  579.         set compareName ""
  580.     } elseif {$id > 0} {
  581.         incr id -1
  582.         set compareName [string range $sectionName 0 $id]
  583.     } else {
  584.         set compareName $sectionName
  585.     }
  586.     if {"$compareName" == "$name"} {
  587.         return "$sectionName"
  588.     }
  589.     }
  590.     return ""
  591. }
  592.  
  593. method DSysVDbObj::removeSpecials {this} {
  594.  
  595.     if {"[$this getInfo Status]" != "backGround"} {
  596.         $this removeDocDir
  597.     }
  598. }
  599.  
  600. method DSysVDbObj::changeObjects {this status} {
  601.  
  602.     case "$status" in {
  603.     {fixed} {
  604.         set operation "makeFixed"
  605.     }
  606.     {selected} {
  607.         set operation "makeSelected"
  608.     }
  609.     {snapshot} {
  610.         set operation "makeSnapshot"
  611.     }
  612.     {current} {
  613.         set operation "makeCurrent"
  614.     }
  615.     {default} {
  616.         return
  617.     }
  618.     }
  619.     set objectList [$wmttoolObj selectedObjSet]
  620.     set script ""
  621.     set sections ""
  622.     foreach obj $objectList {
  623.     if {"$script" != ""} {
  624.         append script " ;"
  625.     }
  626.     append script " $obj $operation"
  627.     if [$obj isA DocSection] {
  628.         lappend sections [$obj identity]
  629.     }
  630.     }
  631.  
  632.     if [lempty $sections] {
  633.     set cmd ""
  634.     } else {
  635.     case "$status" in {
  636.         {selected current} {
  637.         set confVId [[$this getParent ConfigVersion] identity]
  638.         set sysVId [$this identity]
  639.         set argsfile [args_file $sections]
  640.         set args "updateDocDir $confVId $sysVId [list $argsfile]"
  641.         set cmd \
  642.             "$wmttoolObj startDocbatch mtool [list $args] \"\" {0 0} 0"
  643.         }
  644.         {default} {
  645.         set cmd ""
  646.         }
  647.     }
  648.     }
  649.  
  650.     $wmttoolObj startCommand tcl "$script" "$cmd" "" {1 0} 1
  651. }
  652.  
  653. # Do not delete this line -- regeneration end marker
  654.  
  655.