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