man2html.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:4k
源码类别:

通讯编程

开发平台:

Visual C++

  1. #!/proj/tcl/install/5.x-sparc/bin/tclsh7.5
  2. if [catch {
  3. # man2html.tcl --
  4. #
  5. # This file contains procedures that work in conjunction with the
  6. # man2tcl program to generate a HTML files from Tcl manual entries.
  7. #
  8. # Copyright (c) 1996 by Sun Microsystems, Inc.
  9. #
  10. # SCCS: @(#) man2html.tcl 1.5 96/04/11 20:21:43
  11. #
  12. set homeDir /home/rjohnson/Projects/tools/generic
  13. # sarray -
  14. #
  15. # Save an array to a file so that it can be sourced.
  16. #
  17. # Arguments:
  18. # file - Name of the output file
  19. # args - Name of the arrays to save
  20. #
  21. proc sarray {file args} {
  22.     set file [open $file w]
  23.     foreach a $args {
  24. upvar $a array
  25. if ![array exists array] {
  26.     puts "sarray: "$a" isn't an array"
  27.     break
  28. }
  29.     
  30. foreach name [lsort [array names array]] {
  31.     regsub -all " " $name "\ " name1
  32.     puts $file "set ${a}($name1) {$array($name)}"
  33. }
  34.     }
  35.     close $file
  36. }
  37. # footer --
  38. #
  39. # Builds footer info for HTML pages
  40. #
  41. # Arguments:
  42. # None
  43. proc footer {packages} {
  44.     lappend f "<HR>"
  45.     set h {[}
  46.     foreach package $packages {
  47. lappend h "<A HREF="../$package/contents.html">$package</A>"
  48. lappend h "|"
  49.     }
  50.     lappend f [join [lreplace $h end end {]} ] " "]
  51.     lappend f "<HR>"
  52.     lappend f "<PRE>Copyright &#169; 1989-1994 The Regents of the University of California."
  53.     lappend f "Copyright &#169; 1994-1996 Sun Microsystems, Inc."
  54.     lappend f "</PRE>"
  55.     return [join $f "n"]
  56. }
  57. # doDir --
  58. #
  59. # Given a directory as argument, translate all the man pages in
  60. # that directory.
  61. #
  62. # Arguments:
  63. # dir - Name of the directory.
  64. proc doDir dir {
  65.     foreach f [lsort [glob -directory $dir "*.[13n]"]] {
  66. do $f ;# defined in man2html1.tcl & man2html2.tcl
  67.     }
  68. }
  69. if {$argc < 2} {
  70.     puts stderr "usage: $argv0 html_dir tcl_dir packages..."
  71.     puts stderr "usage: $argv0 -clean html_dir"
  72.     exit 1
  73. }
  74. if {[lindex $argv 0] == "-clean"} {
  75.     set html_dir [lindex $argv 1]
  76.     puts -nonewline "recursively remove: $html_dir? "
  77.     flush stdout
  78.     if {[gets stdin] == "y"} {
  79. puts "removing: $html_dir"
  80. exec rm -r $html_dir
  81.     }
  82.     exit 0
  83. }
  84. set html_dir [lindex $argv 0]
  85. set tcl_dir  [lindex $argv 1]
  86. set packages [lrange $argv 2 end]
  87. #### need to add glob capability to packages ####
  88. # make sure there are doc directories for each package
  89. foreach i $packages {
  90.     if ![file exists $tcl_dir/$i/doc] {
  91. puts stderr "Error: doc directory for package $i is missing"
  92. exit 1
  93.     }
  94.     if ![file isdirectory $tcl_dir/$i/doc] {
  95. puts stderr "Error: $tcl_dir/$i/doc is not a directory"
  96. exit 1
  97.     }
  98. }
  99. # we want to start with a clean sheet
  100. if [file exists $html_dir] {
  101.     puts stderr "Error: HTML directory already exists"
  102.     exit 1
  103. } else {
  104.     exec mkdir $html_dir
  105. }
  106. set footer [footer $packages]
  107. # make the hyperlink arrays and contents.html for all packages
  108. foreach package $packages {
  109.     global homeDir
  110.     exec mkdir $html_dir/$package
  111.     
  112.     # build hyperlink database arrays: NAME_file and KEY_file
  113.     #
  114.     puts "nScanning man pages in $tcl_dir/$package/doc..."
  115.     source $homeDir/man2html1.tcl
  116.     
  117.     doDir $tcl_dir/$package/doc
  118.     # clean up the NAME_file and KEY_file database arrays
  119.     #
  120.     catch {unset KEY_file()}
  121.     foreach name [lsort [array names NAME_file]] {
  122. set file_name $NAME_file($name)
  123. if {[llength $file_name] > 1} {
  124.     set file_name [lsort $file_name]
  125.     puts stdout "Warning: '$name' multiply defined in: $file_name; using last"
  126.     set NAME_file($name) [lindex $file_name end]
  127. }
  128.     }
  129. #   sarray $html_dir/$package/xref.tcl NAME_file KEY_file
  130.     # build the contents file from NAME_file
  131.     #
  132.     puts "nGenerating contents.html for $package"
  133.     doContents $html_dir/$package/contents.html $lib ;# defined in man2html1.tcl
  134.     # now translate the man pages to HTML pages
  135.     #
  136.     source $homeDir/man2html2.tcl
  137.     puts "nBuilding html pages from man pages in $tcl_dir/$package/doc..."
  138.     doDir $tcl_dir/$package/doc
  139.     unset NAME_file
  140. }
  141. } result] {
  142.     global errorInfo
  143.     puts stderr $result
  144.     puts stderr "in"
  145.     puts stderr $errorInfo
  146. }