OS/2 Shareware BBS: 10 Tools/10-Tools.zip/tk42r2x.zip/TclTk/bin/man2ipf.tcl

Text File | 1999-07-27 | 5KB | 206 lines

#!/proj/tcl/install/5.x-sparc/bin/tclsh7.5

if [catch {

# man2ipf.tcl --
#
# This file contains procedures that work in conjunction with the
# man2tcl program to generate an IPF file from Tcl manual entries.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
#
# SCCS: @(#) man2ipf.tcl 1.5 96/04/11 20:21:43
#

set homeDir [pwd]

# sarray -
#
# Save an array to a file so that it can be sourced.
#
# Arguments:
# file -        Name of the output file
# args -        Name of the arrays to save
#
proc sarray {file args} {
    set file [open $file w]
    foreach a $args {
    upvar $a array
    if ![array exists array] {
        puts "sarray: \"$a\" isn't an array"
        break
    }

    foreach name [lsort [array names array]] {
        regsub -all " " $name "\\ " name1
        puts $file "set ${a}($name1) \{$array($name)\}"
    }
    }
    close $file
}



# footer --
#
# Builds footer info for HTML pages
#
# Arguments:
# None

proc footer {files} {
    lappend f ":cgraphic.----------------------------------------:ecgraphic."
    set h {[}
    foreach file $files {
    lappend h ":link reftype=hd refid='$file'.$file:elink."
    lappend h "|"
    }
    lappend f [join [lreplace $h end end {]} ] " "]
    lappend f ":cgraphic.----------------------------------------"
    lappend f "Copyright © 1989-1994 The Regents of the University of California."
    lappend f "Copyright © 1994-1996 Sun Microsystems, Inc."
    lappend f ":ecgraphic."
    return [join $f "\n"]
}




# doDir --
#
# Given a directory as argument, translate all the man pages in
# that directory.
#
# Arguments:
# dir -            Name of the directory.

proc doDir dir {
    foreach f [lsort [glob $dir/*.\[13n\]]] {
    do $f    ;# defined in man2ipf1.tcl & man2ipf2.tcl
    }
}


if {$argc < 3} {
    puts stderr "usage: $argv0 projectName fullVersion manFiles..."
    puts stderr "example: $argv0 tcl 8.0.5 e:/tcl8.0.5/doc e:/tk8.0.5/doc"
    exit 1
}

#set nextres {001}
set baseName [lindex $argv 0]
set fullVersion [lindex $argv 1]
regsub -all {\.} $fullVersion {} shortVersion
set tclfiles {}
set tkfiles {}
# divide into entries for sections 1, 3 and n
set tclfiles1 {}
set tclfiles3 {}
set tclfilesn {}
set tkfiles1 {}
set tkfiles3 {}
set tkfilesn {}
foreach i [lrange $argv 2 end] {
    set i [file join $i]
    if [ regexp tk $i ] {
        set pkg {tk}
    } else {
        set pkg {tcl}
    }
    if [file isdir $i] {
        foreach f [lsort [glob [file join $i *.1]]] {
            lappend ${pkg}files1 $f
        }
        foreach f [lsort [glob [file join $i *.3]]] {
            lappend ${pkg}files3 $f
        }
        foreach f [lsort [glob [file join $i *.n]]] {
            lappend ${pkg}filesn $f
        }
    } elseif [file exists $i] {
        set ext [ file extension $i ]
        switch $ext {
           {.1} {lappend ${pkg}files1 $i}
           {.3} {lappend ${pkg}files3 $i}
           {.n} {lappend ${pkg}filesn $i}
           default {lappend ${pkg}files $i}
        }
    }
}

#set footer [footer $files]

set file [ open "$baseName$shortVersion.ipf" w ]
fconfigure $file -translation crlf
puts $file ":userdoc.\n:docprof toc=12.\n:title.Tcl/Tk $fullVersion Reference"

# make the hyperlink arrays and contents for all files

set ext {tcl1}
set sets [ list $tclfiles1 $tclfiles3 $tclfilesn $tclfiles \
                $tkfiles1 $tkfiles3 $tkfilesn $tkfiles ]
foreach set $sets {
#puts "set \[$set\]"
    switch $ext {
        {tcl1} {
            set title {Tcl Applications}
            set ext {tcl3}
        }
        {tcl3} {
            set title {Tcl Library Procedures}
            set ext {tcln}
        }
        {tcln} {
            set title {Tcl Built-In Commands}
            set ext {tcll}
        }
        {tcll} {
            set title {Tcl Other Manual Pages}
            set ext {tk1}
        }
        {tk1} {
            set title {Tk Applications}
            set ext {tk3}
        }
        {tk3} {
            set title {Tk Library Procedures}
            set ext {tkn}
        }
        {tkn} {
            set title {Tk Built-In Commands}
            set ext {tkl}
        }
        default {
            set title {Tk Other Manual Pages}
            set ext {}
        }
    }
    if {$set != {} } {
        puts $file "\n:h1 name='$title'.$title"
#        puts $file "\n:i1 id='$title'.$title"
    }
    foreach manpg $set {
        global homeDir

        # build hyperlink database arrays: NAME_file and KEY_file
        #

        source $homeDir/man2ipf2.tcl
        puts "Building IPF from man page $manpg..."
        do $manpg

        catch {unset NAME_file}
    }
}

puts $file ":euserdoc."
close $file

} result] {
    global errorInfo
    puts stderr $result
    puts stderr "in"
    puts stderr $errorInfo
}