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