os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/man2help.tcl
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/man2help.tcl	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,143 @@
     1.4 +# man2help.tcl --
     1.5 +#
     1.6 +# This file defines procedures that work in conjunction with the
     1.7 +# man2tcl program to generate a Windows help file from Tcl manual
     1.8 +# entries.
     1.9 +#
    1.10 +# Copyright (c) 1996 by Sun Microsystems, Inc.
    1.11 +#
    1.12 +# RCS: @(#) $Id: man2help.tcl,v 1.13.2.1 2003/06/04 23:41:15 mistachkin Exp $
    1.13 +# 
    1.14 +
    1.15 +#
    1.16 +# PASS 1
    1.17 +#
    1.18 +
    1.19 +set man2tclprog [file join [file dirname [info script]] man2tcl.exe]
    1.20 +
    1.21 +proc generateContents {basename version files} {
    1.22 +    global curID topics
    1.23 +    set curID 0
    1.24 +    foreach f $files {
    1.25 +	puts "Pass 1 -- $f"
    1.26 +	flush stdout
    1.27 +	doFile $f
    1.28 +    }
    1.29 +    set fd [open [file join [file dirname [info script]] $basename$version.cnt] w]
    1.30 +    fconfigure $fd -translation crlf
    1.31 +    puts $fd ":Base $basename$version.hlp"
    1.32 +    foreach package [getPackages] {
    1.33 +	foreach section [getSections $package] {
    1.34 +            if {![info exists lastSection]} {
    1.35 +                set lastSection {}
    1.36 +            }
    1.37 +            if {[string compare $lastSection $section]} {
    1.38 +                puts $fd "1 $section"
    1.39 +            }
    1.40 +            set lastSection $section
    1.41 +	    set lastTopic {}
    1.42 +	    foreach topic [getTopics $package $section] {
    1.43 +		if {[string compare $lastTopic $topic]} {
    1.44 +		    set id $topics($package,$section,$topic) 
    1.45 +		    puts $fd "2 $topic=$id"
    1.46 +		    set lastTopic $topic
    1.47 +		}
    1.48 +	    }
    1.49 +	}
    1.50 +    }
    1.51 +    close $fd
    1.52 +}
    1.53 +
    1.54 +
    1.55 +#
    1.56 +# PASS 2
    1.57 +#
    1.58 +
    1.59 +proc generateHelp {basename files} {
    1.60 +    global curID topics keywords file id_keywords
    1.61 +    set curID 0
    1.62 +
    1.63 +    foreach key [array names keywords] {
    1.64 +	foreach id $keywords($key) {
    1.65 +	    lappend id_keywords($id) $key
    1.66 +	}
    1.67 +    }
    1.68 +
    1.69 +    set file [open [file join [file dirname [info script]] $basename.rtf] w]
    1.70 +    fconfigure $file -translation crlf
    1.71 +    puts $file "\{\\rtf1\\ansi \\deff0\\deflang1033\{\\fonttbl\{\\f0\\froman\\fcharset0\\fprq2 Times New Roman\;\}\{\\f1\\fmodern\\fcharset0\\fprq1 Courier New\;\}\}"
    1.72 +    foreach f $files {
    1.73 +	puts "Pass 2 -- $f"
    1.74 +	flush stdout
    1.75 +	initGlobals
    1.76 +	doFile $f
    1.77 +	pageBreak
    1.78 +    }
    1.79 +    puts $file "\}"
    1.80 +    close $file
    1.81 +}
    1.82 +
    1.83 +# doFile --
    1.84 +#
    1.85 +# Given a file as argument, translate the file to a tcl script and
    1.86 +# evaluate it.
    1.87 +#
    1.88 +# Arguments:
    1.89 +# file -		Name of file to translate.
    1.90 +
    1.91 +proc doFile {file} {
    1.92 +    global man2tclprog
    1.93 +    if {[catch {eval [exec $man2tclprog [glob $file]]} msg]} {
    1.94 +	global errorInfo
    1.95 +	puts stderr $msg
    1.96 +	puts "in"
    1.97 +	puts $errorInfo
    1.98 +	exit 1
    1.99 +    }
   1.100 +}
   1.101 +
   1.102 +# doDir --
   1.103 +#
   1.104 +# Given a directory as argument, translate all the man pages in
   1.105 +# that directory.
   1.106 +#
   1.107 +# Arguments:
   1.108 +# dir -			Name of the directory.
   1.109 +
   1.110 +proc doDir dir {
   1.111 +    puts "Generating man pages for $dir..."
   1.112 +    foreach f [lsort [glob -directory $dir "*.\[13n\]"]] {
   1.113 +	doFile $f
   1.114 +    }
   1.115 +}
   1.116 +
   1.117 +# process command line arguments
   1.118 +
   1.119 +if {$argc < 3} {
   1.120 +    puts stderr "usage: $argv0 \[options\] projectName version manFiles..."
   1.121 +    exit 1
   1.122 +}
   1.123 +
   1.124 +set arg 0
   1.125 +
   1.126 +if {![string compare [lindex $argv $arg] "-bitmap"]} {
   1.127 +    set bitmap [lindex $argv [incr arg]]
   1.128 +    incr arg
   1.129 +}
   1.130 +set baseName [lindex $argv $arg]
   1.131 +set version [lindex $argv [incr arg]]
   1.132 +set files {}
   1.133 +foreach i [lrange $argv [incr arg] end] {
   1.134 +    set i [file join $i]
   1.135 +    if {[file isdir $i]} {
   1.136 +	foreach f [lsort [glob -directory $i "*.\[13n\]"]] {
   1.137 +	    lappend files $f
   1.138 +	}
   1.139 +    } elseif {[file exists $i]} {
   1.140 +	lappend files $i
   1.141 +    }
   1.142 +}
   1.143 +source [file join [file dirname [info script]] index.tcl]
   1.144 +generateContents $baseName $version $files
   1.145 +source [file join [file dirname [info script]] man2help2.tcl]
   1.146 +generateHelp $baseName $files