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