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

通讯编程

开发平台:

Visual C++

  1. # man2help.tcl --
  2. #
  3. # This file defines procedures that work in conjunction with the
  4. # man2tcl program to generate a Windows help file from Tcl manual
  5. # entries.
  6. #
  7. # Copyright (c) 1996 by Sun Microsystems, Inc.
  8. #
  9. # RCS: @(#) $Id: man2help.tcl,v 1.13.2.1 2003/06/04 23:41:15 mistachkin Exp $
  10. #
  11. # PASS 1
  12. #
  13. set man2tclprog [file join [file dirname [info script]] man2tcl.exe]
  14. proc generateContents {basename version files} {
  15.     global curID topics
  16.     set curID 0
  17.     foreach f $files {
  18. puts "Pass 1 -- $f"
  19. flush stdout
  20. doFile $f
  21.     }
  22.     set fd [open [file join [file dirname [info script]] $basename$version.cnt] w]
  23.     fconfigure $fd -translation crlf
  24.     puts $fd ":Base $basename$version.hlp"
  25.     foreach package [getPackages] {
  26. foreach section [getSections $package] {
  27.             if {![info exists lastSection]} {
  28.                 set lastSection {}
  29.             }
  30.             if {[string compare $lastSection $section]} {
  31.                 puts $fd "1 $section"
  32.             }
  33.             set lastSection $section
  34.     set lastTopic {}
  35.     foreach topic [getTopics $package $section] {
  36. if {[string compare $lastTopic $topic]} {
  37.     set id $topics($package,$section,$topic) 
  38.     puts $fd "2 $topic=$id"
  39.     set lastTopic $topic
  40. }
  41.     }
  42. }
  43.     }
  44.     close $fd
  45. }
  46. #
  47. # PASS 2
  48. #
  49. proc generateHelp {basename files} {
  50.     global curID topics keywords file id_keywords
  51.     set curID 0
  52.     foreach key [array names keywords] {
  53. foreach id $keywords($key) {
  54.     lappend id_keywords($id) $key
  55. }
  56.     }
  57.     set file [open [file join [file dirname [info script]] $basename.rtf] w]
  58.     fconfigure $file -translation crlf
  59.     puts $file "{\rtf1\ansi \deff0\deflang1033{\fonttbl{\f0\froman\fcharset0\fprq2 Times New Roman;}{\f1\fmodern\fcharset0\fprq1 Courier New;}}"
  60.     foreach f $files {
  61. puts "Pass 2 -- $f"
  62. flush stdout
  63. initGlobals
  64. doFile $f
  65. pageBreak
  66.     }
  67.     puts $file "}"
  68.     close $file
  69. }
  70. # doFile --
  71. #
  72. # Given a file as argument, translate the file to a tcl script and
  73. # evaluate it.
  74. #
  75. # Arguments:
  76. # file - Name of file to translate.
  77. proc doFile {file} {
  78.     global man2tclprog
  79.     if {[catch {eval [exec $man2tclprog [glob $file]]} msg]} {
  80. global errorInfo
  81. puts stderr $msg
  82. puts "in"
  83. puts $errorInfo
  84. exit 1
  85.     }
  86. }
  87. # doDir --
  88. #
  89. # Given a directory as argument, translate all the man pages in
  90. # that directory.
  91. #
  92. # Arguments:
  93. # dir - Name of the directory.
  94. proc doDir dir {
  95.     puts "Generating man pages for $dir..."
  96.     foreach f [lsort [glob -directory $dir "*.[13n]"]] {
  97. doFile $f
  98.     }
  99. }
  100. # process command line arguments
  101. if {$argc < 3} {
  102.     puts stderr "usage: $argv0 [options] projectName version manFiles..."
  103.     exit 1
  104. }
  105. set arg 0
  106. if {![string compare [lindex $argv $arg] "-bitmap"]} {
  107.     set bitmap [lindex $argv [incr arg]]
  108.     incr arg
  109. }
  110. set baseName [lindex $argv $arg]
  111. set version [lindex $argv [incr arg]]
  112. set files {}
  113. foreach i [lrange $argv [incr arg] end] {
  114.     set i [file join $i]
  115.     if {[file isdir $i]} {
  116. foreach f [lsort [glob -directory $i "*.[13n]"]] {
  117.     lappend files $f
  118. }
  119.     } elseif {[file exists $i]} {
  120. lappend files $i
  121.     }
  122. }
  123. source [file join [file dirname [info script]] index.tcl]
  124. generateContents $baseName $version $files
  125. source [file join [file dirname [info script]] man2help2.tcl]
  126. generateHelp $baseName $files