- # 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 by Sun Microsystems, Inc.
- #
- # RCS: @(#) $Id: man2help.tcl,v 1.13.2.1 2003/06/04 23:41:15 mistachkin Exp $
- #
- #
- # PASS 1
- #
- set man2tclprog [file join [file dirname [info script]] man2tcl.exe]
- 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 [file join [file dirname [info script]] index.tcl]
- generateContents $baseName $version $files
- source [file join [file dirname [info script]] man2help2.tcl]
- generateHelp $baseName $files