tcl/tools/man2help.tcl

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