home *** CD-ROM | disk | FTP | other *** search
/ PC World 1997 November / PCWorld_1997-11_cd.bin / software / programy / komix / DATA.Z / docprocs.tcl < prev    next >
Encoding:
Text File  |  1996-10-29  |  3.0 KB  |  109 lines
  1. require "genlink.tcl"
  2. require "genlinkext.tcl"
  3. require "genfilepro.tcl"
  4. require "genitempro.tcl"
  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.     set fid [open $storeFile w]
  12.     GenLink new genLink [$section document]
  13.     puts $fid [genLink getDocStructure "$fileTypes"]
  14.     close $fid
  15. }
  16.  
  17. proc createFileAndPropertySections {fileTypes propertyTypes storeFile section} {
  18.     set fid [open $storeFile w]
  19.     GenLinkExtended new genLinkExt [$section document]
  20.     puts $fid [genLinkExt getDocStructure "$fileTypes" "$propertyTypes"]
  21.     close $fid
  22. }
  23.  
  24. proc createSourceFileSections { parentType storeFile section} {
  25.  
  26.     set sv [[$section document] documentedSystem]
  27.  
  28.     if [$sv isNil] {
  29.         wmtkerror "Invalid documented system"
  30.         return
  31.     }
  32.     set fileTypes {}
  33.     set fvs [$sv localFileVersions]
  34.     foreach fv $fvs {
  35.         set fileType [[$fv file] type]
  36.         set editor [[docTool document] editor]
  37.         set edName [$editor name]
  38.         set edVers [$editor version]
  39.         set class [Document::getClass $editor $edVers $fileType]
  40.         if {$class == ""} {
  41.             # no section class for the localFileVersion,
  42.             # check the objtype for isAscii
  43.             set spec [getObjectSpec $docToolObjectHdlr \
  44.                 ExternalFileVersion $fileType]
  45.             if {$spec == ""} {
  46.                 continue
  47.             } else {
  48.                 if {![$spec isAscii]} {
  49.                     continue
  50.                 }
  51.             }
  52.         } else {
  53.             set kind [Document::getFileClass $editor \
  54.                 $edVers $fileType]
  55.             if {$kind == "externalBinary"} {
  56.                 puts "externalBinary, type '$fileType'"
  57.                 continue
  58.             }
  59.         }
  60.         lappend_unique fileTypes $fileType
  61.     }
  62.  
  63.     GenLink new genLink [$section document]
  64.     set fid [open $storeFile w]
  65.     set first 1
  66.     foreach fileType $fileTypes {
  67.         if {$first == 1} {
  68.             puts $fid "$fileType Sources | + |  | $parentType"
  69.         } else {
  70.             puts $fid "$fileType Sources | - |  | $parentType"
  71.         }
  72.         set first 0
  73.         puts $fid [genLink getDocStructure "$fileType"]
  74.     }
  75.     close $fid
  76. }
  77.  
  78. proc createFilePropSections { fileTypes properties storeFile section} {
  79.     set fid [open $storeFile w]
  80.     GenFileProp new genFileProp [$section document]
  81.     puts $fid [genFileProp getDocStructure "$fileTypes" "$properties"]
  82.     close $fid
  83. }
  84.  
  85. proc createClassItemPropSections {properties storeFile section} {
  86.     createItemPropSections cad cl cad_class name $properties $storeFile \
  87.         $section
  88. }
  89.  
  90. proc createItemPropSections { fileTypes itemType componentType labelType
  91.     properties storeFile section} {
  92.     set fid [open $storeFile w]
  93.     GenItemProp new genItemProp [$section document]
  94.     puts $fid [genItemProp getDocStructure "$fileTypes" "$itemType" \
  95.         "$componentType" "$labelType" "$properties"]
  96.     close $fid
  97. }
  98.  
  99. proc dispatchContentsGen { name section } {
  100.     # remove 'gen' and lowercase
  101.     set newName [string range $name 3 end]ConGen
  102.     set nm [string tolower $newName]
  103.     set filenm [string range $nm 0 9].tcl
  104.     uplevel "require $filenm"
  105.     $newName new contentsGen $section
  106.     contentsGen generate
  107.     contentsGen delete
  108. }
  109.