diff options
Diffstat (limited to 'tcl8.6/tools/man2help.tcl')
-rw-r--r-- | tcl8.6/tools/man2help.tcl | 141 |
1 files changed, 141 insertions, 0 deletions
diff --git a/tcl8.6/tools/man2help.tcl b/tcl8.6/tools/man2help.tcl new file mode 100644 index 0000000..ca29226 --- /dev/null +++ b/tcl8.6/tools/man2help.tcl @@ -0,0 +1,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 by 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 [file join [file dirname [info script]] index.tcl] +generateContents $baseName $version $files +source [file join [file dirname [info script]] man2help2.tcl] +generateHelp $baseName $files |