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