home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tcltk805.zip / tcl805s.zip / tcl8.0.5 / os2 / man2ipf.tcl < prev    next >
Text File  |  2001-08-30  |  5KB  |  196 lines
  1. #!/proj/tcl/install/5.x-sparc/bin/tclsh7.5
  2.  
  3. if [catch {
  4.  
  5. # man2ipf.tcl --
  6. #
  7. # This file contains procedures that work in conjunction with the
  8. # man2tcl program to generate an IPF file from Tcl manual entries.
  9. #
  10. # Copyright (c) 1996 by Sun Microsystems, Inc.
  11. #
  12. # SCCS: @(#) man2ipf.tcl 1.5 96/04/11 20:21:43
  13. #
  14.  
  15. set homeDir [pwd]
  16.  
  17. # sarray -
  18. #
  19. # Save an array to a file so that it can be sourced.
  20. #
  21. # Arguments:
  22. # file -        Name of the output file
  23. # args -        Name of the arrays to save
  24. #
  25. proc sarray {file args} {
  26.     set file [open $file w]
  27.     foreach a $args {
  28.     upvar $a array
  29.     if ![array exists array] {
  30.         puts "sarray: \"$a\" isn't an array"
  31.         break
  32.     }    
  33.     
  34.     foreach name [lsort [array names array]] {
  35.         regsub -all " " $name "\\ " name1
  36.         puts $file "set ${a}($name1) \{$array($name)\}"
  37.     }
  38.     }
  39.     close $file
  40. }
  41.  
  42.  
  43.  
  44. # footer --
  45. #
  46. # Builds footer info for HTML pages
  47. #
  48. # Arguments:
  49. # None
  50.  
  51. proc footer {files} {
  52.     lappend f ":cgraphic.----------------------------------------:ecgraphic."
  53.     set h {[}
  54.     foreach file $files {
  55.     lappend h ":link reftype=hd refid='$file'.$file:elink."
  56.     lappend h "|"
  57.     }
  58.     lappend f [join [lreplace $h end end {]} ] " "]
  59.     lappend f ":cgraphic.----------------------------------------"
  60.     lappend f "Copyright © 1989-1994 The Regents of the University of California."
  61.     lappend f "Copyright © 1994-1996 Sun Microsystems, Inc."
  62.     lappend f "Copyright © 1998-2000 Illya Vaes"
  63.     lappend f ":ecgraphic."
  64.     return [join $f "\n"]
  65. }
  66.  
  67.  
  68.  
  69.  
  70. # doDir --
  71. #
  72. # Given a directory as argument, translate all the man pages in
  73. # that directory.
  74. #
  75. # Arguments:
  76. # dir -            Name of the directory.
  77.  
  78. proc doDir dir {
  79.     foreach f [lsort [glob $dir/*.\[13n\]]] {
  80.     do $f    ;# defined in man2ipf1.tcl & man2ipf2.tcl
  81.     }
  82. }
  83.  
  84. # doSet --
  85. # Given a list of files and a section title, generate a section in
  86. # the IPF file and generate the manual pages in it.
  87.  
  88. proc doSet {fileList title} {
  89.     global file homeDir
  90.  
  91.     if {$fileList != [list] } {
  92.         puts $file "\n:h1 name='$title'.$title"
  93. #        puts $file "\n:i1 id='$title'.$title"
  94.         foreach manpg $fileList {
  95.             source $homeDir/man2ipf2.tcl
  96.             puts "Building IPF from man page $manpg..."
  97.             do $manpg
  98.         }
  99.     }
  100. }
  101.  
  102.  
  103. if {$argc < 3} {
  104.     puts stderr "usage: $argv0 projectName fullVersion manFiles..."
  105.     puts stderr "example: $argv0 tcl 8.0.5 e:/tcl8.0.5/doc e:/tk8.0.5/doc"
  106.     exit 1
  107. }
  108.     
  109. #set nextres {001}
  110. set baseName [lindex $argv 0]
  111. set fullVersion [lindex $argv 1]
  112. regsub -all {\.} $fullVersion {} shortVersion
  113. regsub -all {0$} $shortVersion {} shortVersion
  114. set tclfiles {}
  115. set tkfiles {}
  116. set addfiles {}
  117. # divide into entries for sections 1, 3 and n
  118. set tclfiles1 {}
  119. set tclfiles3 {}
  120. set tclfilesn {}
  121. set tkfiles1 {}
  122. set tkfiles3 {}
  123. set tkfilesn {}
  124. set addfiles1 {}
  125. set addfiles3 {}
  126. set addfilesn {}
  127. foreach i [lrange $argv 2 end] {
  128.     set i [file join $i]
  129.     if [ regexp tk $i ] {
  130. puts "i \[$i\], regexp tk \$i \[[regexp tk $i]\]"
  131.        set pkg tk
  132.     } elseif [ regexp tcl $i ] {
  133. puts "i \[$i\], regexp tcl \$i \[[regexp tcl $i]\]"
  134.        set pkg tcl
  135.     } else {
  136. puts "i \[$i\], other"
  137.        set pkg add
  138.     }
  139.     if [file isdir $i] {
  140.         foreach f [lsort [glob [file join $i *.1]]] {
  141.             lappend ${pkg}files1 $f
  142.         }
  143.         foreach f [lsort [glob [file join $i *.3]]] {
  144.             lappend ${pkg}files3 $f
  145.         }
  146.         foreach f [lsort [glob [file join $i *.n]]] {
  147.             lappend ${pkg}filesn $f
  148.         }
  149.     } elseif [file exists $i] {
  150.         set ext [ file extension $i ]
  151.         switch $ext {
  152.            {.1} {lappend ${pkg}files1 $i}
  153.            {.3} {lappend ${pkg}files3 $i}
  154.            {.n} {lappend ${pkg}filesn $i}
  155.            default {lappend ${pkg}files $i}
  156.         }
  157.     }
  158. }
  159.  
  160. #set footer [footer $files]
  161.  
  162. set file [ open "$baseName$shortVersion.ipf" w ]
  163. fconfigure $file -translation crlf
  164. if {$baseName == {tcl}} {
  165.   puts $file ":userdoc.\n:docprof toc=12.\n:title.Tcl/Tk $fullVersion Reference"
  166. } else {
  167.   puts $file ":userdoc.\n:docprof toc=12.\n:title.$baseName $fullVersion Reference"
  168. }
  169.  
  170. # make the hyperlink arrays and contents for all files
  171.     
  172. doSet $tclfiles1 {Tcl Applications}
  173. doSet $tclfiles3 {Tcl Library Procedures}
  174. doSet $tclfilesn {Tcl Built-In Commands}
  175. doSet $tclfiles {Tcl Other Manual Pages}
  176. doSet $tkfiles1 {Tk Applications}
  177. doSet $tkfiles3 {Tk Library Procedures}
  178. doSet $tkfilesn {Tk Built-In Commands}
  179. doSet $tkfiles {Tk Other Manual Pages}
  180. doSet $addfiles1 {Additional Applications}
  181. doSet $addfiles3 {Additional Library Procedures}
  182. doSet $addfilesn {Additional Built-In Commands}
  183. doSet $addfiles {Additional Other Manual Pages}
  184. doSet $addfiles {Other Manual Pages}
  185.  
  186. puts $file ":euserdoc."
  187. close $file
  188.  
  189. } result] {
  190.     global errorInfo
  191.     puts stderr $result
  192.     puts stderr "in"
  193.     puts stderr $errorInfo
  194. }
  195.  
  196.