home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / docprocs.tcl < prev    next >
Encoding:
Text File  |  1997-09-25  |  5.0 KB  |  166 lines
  1. require_module_file "genlink.tcl" docwriter
  2. require_module_file "genlinkext.tcl" docwriter
  3. require_module_file "genfilepro.tcl" docwriter
  4. require_module_file "genitempro.tcl" docwriter
  5.  
  6. # args : fileTypes
  7. # the storeFile and section arguments are added by the docwriter
  8. # for internal use
  9.  
  10. proc createFileSections { fileTypes storeFile section} {
  11.     createPrefixedFileSections $fileTypes "" $storeFile $section
  12. }
  13.  
  14. proc createPrefixedFileSections { fileTypes prefix storeFile section} {
  15.     set fid [open $storeFile w]
  16.     GenLink new genLink [$section document]
  17.     puts $fid [genLink getDocStructure "$fileTypes" $prefix]
  18.     close $fid
  19. }
  20.  
  21. # args : fileTypes, propertyTypes
  22. # the storeFile and section arguments are added by the docwriter
  23. # for internal use
  24.  
  25. proc createFileAndPropertySections {fileTypes propertyTypes storeFile section} {
  26.     createPrefixedFileAndPropertySections $fileTypes $propertyTypes "" \
  27.         $storeFile $section
  28. }
  29.  
  30. proc createPrefixedFileAndPropertySections {fileTypes propertyTypes prefix
  31.     storeFile section} {
  32.     set fid [open $storeFile w]
  33.     GenLinkExtended new genLinkExt [$section document]
  34.     puts $fid [genLinkExt getDocStructure "$fileTypes" "$propertyTypes" \
  35.         $prefix]
  36.     close $fid
  37. }
  38.  
  39. # args : parentType
  40. # the storeFile and section arguments are added by the docwriter
  41. # for internal use
  42.  
  43. proc createSourceFileSections { parentType storeFile section} {
  44.     createPrefixedSourceFileSections $parentType "" $storeFile $section
  45. }
  46.  
  47. proc createPrefixedSourceFileSections { parentType prefix storeFile section} {
  48.     set sv [[$section document] documentedSystem]
  49.  
  50.     if [$sv isNil] {
  51.         wmtkerror "Invalid documented system"
  52.         return
  53.     }
  54.     set fileTypes {}
  55.     set fvs [$sv localFileVersions]
  56.     foreach fv $fvs {
  57.         set fileType [[$fv file] type]
  58.         set editor [[docTool document] editor]
  59.         set edName [$editor name]
  60.         set edVers [$editor version]
  61.         set class [Document::getClass $editor $edVers $fileType]
  62.         if {$class == ""} {
  63.             # no section class for the localFileVersion,
  64.             # check the objtype for isAscii
  65.             set spec [getObjectSpec $docToolObjectHdlr \
  66.                 ExternalFileVersion $fileType]
  67.             if {$spec == ""} {
  68.                 continue
  69.             } else {
  70.                 if {![$spec isAscii]} {
  71.                     continue
  72.                 }
  73.             }
  74.         } else {
  75.             set kind [Document::getFileClass $editor \
  76.                 $edVers $fileType]
  77.             if {$kind == "externalBinary"} {
  78.                 puts "externalBinary, type '$fileType'"
  79.                 continue
  80.             }
  81.         }
  82.         lappend_unique fileTypes $fileType
  83.     }
  84.  
  85.     GenLink new genLink [$section document]
  86.     set fid [open $storeFile w]
  87.     set first 1
  88.     foreach fileType $fileTypes {
  89.         if {$first == 1} {
  90.             puts $fid "$fileType Sources | + |  | $parentType"
  91.         } else {
  92.             puts $fid "$fileType Sources | - |  | $parentType"
  93.         }
  94.         set first 0
  95.         puts $fid [genLink getDocStructure "$fileType" $prefix]
  96.     }
  97.     close $fid
  98. }
  99.  
  100. # args : fileTypes, properties
  101. # the storeFile and section arguments are added by the docwriter
  102. # for internal use
  103.  
  104. proc createFilePropSections { fileTypes properties storeFile section} {
  105.     createPrefixedFilePropSections $fileTypes $properties "" \
  106.         $storeFile $section
  107. }
  108.  
  109. proc createPrefixedFilePropSections { fileTypes properties prefix storeFile
  110.     section} {
  111.     set fid [open $storeFile w]
  112.     GenFileProp new genFileProp [$section document]
  113.     puts $fid [genFileProp getDocStructure "$fileTypes" "$properties" \
  114.         $prefix]
  115.     close $fid
  116. }
  117.  
  118. # args : properties
  119. # the storeFile and section arguments are added by the docwriter
  120. # for internal use
  121.  
  122. proc createClassItemPropSections {properties storeFile section} {
  123.     createPrefixedClassItemPropSections $properties "" $storeFile $section
  124. }
  125.  
  126. proc createPrefixedClassItemPropSections {properties prefix storeFile section} {
  127.     createPrefixedItemPropSections cad cl cad_class name $properties \
  128.         $prefix $storeFile $section
  129. }
  130.  
  131. # args : fileTypes, itemType, componentType, labelType, properties
  132. # the storeFile and section arguments are added by the docwriter
  133. # for internal use
  134.  
  135. proc createItemPropSections { fileTypes itemType componentType labelType
  136.     properties storeFile section} {
  137.     createPrefixedItemPropSections $fileTypes $itemType $componentType \
  138.         $labelType $properties "" $storeFile $section
  139. }
  140.  
  141. proc createPrefixedItemPropSections { fileTypes itemType componentType
  142.     labelType properties prefix storeFile section} {
  143.     set fid [open $storeFile w]
  144.     GenItemProp new genItemProp [$section document]
  145.     puts $fid [genItemProp getDocStructure "$fileTypes" "$itemType" \
  146.         "$componentType" "$labelType" "$properties" $prefix]
  147.     close $fid
  148. }
  149.  
  150. proc dispatchContentsGen { name section } {
  151.     # remove 'gen' and lowercase
  152.     set newName [string range $name 3 end]ConGen
  153.     set nm [string tolower $newName]
  154.     set filenm [string range $nm 0 9].tcl
  155.     set s_modules [$moduleHdlr selectedModuleSpecSet]
  156.     # should always return 1 module
  157.     foreach module [$moduleHdlr moduleSpecSet] {
  158.         foreach file [$moduleHdlr getFiles tcl $filenm $module] {
  159.             require $file
  160.         }
  161.     }
  162.     $newName new contentsGen $section
  163.     contentsGen generate
  164.     contentsGen delete
  165. }
  166.