sl@0: # man2help.tcl --
sl@0: #
sl@0: # This file defines procedures that work in conjunction with the
sl@0: # man2tcl program to generate a Windows help file from Tcl manual
sl@0: # entries.
sl@0: #
sl@0: # Copyright (c) 1996 by Sun Microsystems, Inc.
sl@0: #
sl@0: # RCS: @(#) $Id: man2help.tcl,v 1.13.2.1 2003/06/04 23:41:15 mistachkin Exp $
sl@0: # 
sl@0: 
sl@0: #
sl@0: # PASS 1
sl@0: #
sl@0: 
sl@0: set man2tclprog [file join [file dirname [info script]] man2tcl.exe]
sl@0: 
sl@0: proc generateContents {basename version files} {
sl@0:     global curID topics
sl@0:     set curID 0
sl@0:     foreach f $files {
sl@0: 	puts "Pass 1 -- $f"
sl@0: 	flush stdout
sl@0: 	doFile $f
sl@0:     }
sl@0:     set fd [open [file join [file dirname [info script]] $basename$version.cnt] w]
sl@0:     fconfigure $fd -translation crlf
sl@0:     puts $fd ":Base $basename$version.hlp"
sl@0:     foreach package [getPackages] {
sl@0: 	foreach section [getSections $package] {
sl@0:             if {![info exists lastSection]} {
sl@0:                 set lastSection {}
sl@0:             }
sl@0:             if {[string compare $lastSection $section]} {
sl@0:                 puts $fd "1 $section"
sl@0:             }
sl@0:             set lastSection $section
sl@0: 	    set lastTopic {}
sl@0: 	    foreach topic [getTopics $package $section] {
sl@0: 		if {[string compare $lastTopic $topic]} {
sl@0: 		    set id $topics($package,$section,$topic) 
sl@0: 		    puts $fd "2 $topic=$id"
sl@0: 		    set lastTopic $topic
sl@0: 		}
sl@0: 	    }
sl@0: 	}
sl@0:     }
sl@0:     close $fd
sl@0: }
sl@0: 
sl@0: 
sl@0: #
sl@0: # PASS 2
sl@0: #
sl@0: 
sl@0: proc generateHelp {basename files} {
sl@0:     global curID topics keywords file id_keywords
sl@0:     set curID 0
sl@0: 
sl@0:     foreach key [array names keywords] {
sl@0: 	foreach id $keywords($key) {
sl@0: 	    lappend id_keywords($id) $key
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     set file [open [file join [file dirname [info script]] $basename.rtf] w]
sl@0:     fconfigure $file -translation crlf
sl@0:     puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\{\\f1\\fmodern\\fcharset0\\fprq1 Courier New\;\}\}"
sl@0:     foreach f $files {
sl@0: 	puts "Pass 2 -- $f"
sl@0: 	flush stdout
sl@0: 	initGlobals
sl@0: 	doFile $f
sl@0: 	pageBreak
sl@0:     }
sl@0:     puts $file "\}"
sl@0:     close $file
sl@0: }
sl@0: 
sl@0: # doFile --
sl@0: #
sl@0: # Given a file as argument, translate the file to a tcl script and
sl@0: # evaluate it.
sl@0: #
sl@0: # Arguments:
sl@0: # file -		Name of file to translate.
sl@0: 
sl@0: proc doFile {file} {
sl@0:     global man2tclprog
sl@0:     if {[catch {eval [exec $man2tclprog [glob $file]]} msg]} {
sl@0: 	global errorInfo
sl@0: 	puts stderr $msg
sl@0: 	puts "in"
sl@0: 	puts $errorInfo
sl@0: 	exit 1
sl@0:     }
sl@0: }
sl@0: 
sl@0: # doDir --
sl@0: #
sl@0: # Given a directory as argument, translate all the man pages in
sl@0: # that directory.
sl@0: #
sl@0: # Arguments:
sl@0: # dir -			Name of the directory.
sl@0: 
sl@0: proc doDir dir {
sl@0:     puts "Generating man pages for $dir..."
sl@0:     foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
sl@0: 	doFile $f
sl@0:     }
sl@0: }
sl@0: 
sl@0: # process command line arguments
sl@0: 
sl@0: if {$argc < 3} {
sl@0:     puts stderr "usage: $argv0 \[options\] projectName version manFiles..."
sl@0:     exit 1
sl@0: }
sl@0: 
sl@0: set arg 0
sl@0: 
sl@0: if {![string compare [lindex $argv $arg] "-bitmap"]} {
sl@0:     set bitmap [lindex $argv [incr arg]]
sl@0:     incr arg
sl@0: }
sl@0: set baseName [lindex $argv $arg]
sl@0: set version [lindex $argv [incr arg]]
sl@0: set files {}
sl@0: foreach i [lrange $argv [incr arg] end] {
sl@0:     set i [file join $i]
sl@0:     if {[file isdir $i]} {
sl@0: 	foreach f [lsort [glob -directory $i "*.\[13n\]"]] {
sl@0: 	    lappend files $f
sl@0: 	}
sl@0:     } elseif {[file exists $i]} {
sl@0: 	lappend files $i
sl@0:     }
sl@0: }
sl@0: source [file join [file dirname [info script]] index.tcl]
sl@0: generateContents $baseName $version $files
sl@0: source [file join [file dirname [info script]] man2help2.tcl]
sl@0: generateHelp $baseName $files