763 lines
21 KiB
Tcl
763 lines
21 KiB
Tcl
|
#!/usr/bin/env tclsh
|
|||
|
|
|
|||
|
|
if {[catch {package require Tcl 8.6-} msg]} {
|
|||
|
|
puts stderr "ERROR: $msg"
|
|||
|
|
puts stderr "If running this script from 'make html', set the\
|
|||
|
|
NATIVE_TCLSH environment\nvariable to point to an installed\
|
|||
|
|
tclsh8.6 (or the equivalent tclsh86.exe\non Windows)."
|
|||
|
|
exit 1
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# Convert Ousterhout format man pages into highly crosslinked hypertext.
|
|||
|
|
#
|
|||
|
|
# Along the way detect many unmatched font changes and other odd things.
|
|||
|
|
#
|
|||
|
|
# Note well, this program is a hack rather than a piece of software
|
|||
|
|
# engineering. In that sense it's probably a good example of things
|
|||
|
|
# that a scripting language, like Tcl, can do well. It is offered as
|
|||
|
|
# an example of how someone might convert a specific set of man pages
|
|||
|
|
# into hypertext, not as a general solution to the problem. If you
|
|||
|
|
# try to use this, you'll be very much on your own.
|
|||
|
|
#
|
|||
|
|
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
|
|||
|
|
# Copyright (c) 2004-2010 Donal K. Fellows
|
|||
|
|
|
|||
|
|
set ::Version "50/8.6"
|
|||
|
|
set ::CSSFILE "docs.css"
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## Source the utility functions that provide most of the
|
|||
|
|
## implementation of the transformation from nroff to html.
|
|||
|
|
##
|
|||
|
|
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]
|
|||
|
|
|
|||
|
|
proc parse_command_line {} {
|
|||
|
|
global argv Version
|
|||
|
|
|
|||
|
|
# These variables determine where the man pages come from and where
|
|||
|
|
# the converted pages go to.
|
|||
|
|
global tcltkdir tkdir tcldir webdir build_tcl build_tk verbose
|
|||
|
|
|
|||
|
|
# Set defaults based on original code.
|
|||
|
|
set tcltkdir ../..
|
|||
|
|
set tkdir {}
|
|||
|
|
set tcldir {}
|
|||
|
|
set webdir ../html
|
|||
|
|
set build_tcl 0
|
|||
|
|
set build_tk 0
|
|||
|
|
set verbose 0
|
|||
|
|
# Default search version is a glob pattern
|
|||
|
|
set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}
|
|||
|
|
|
|||
|
|
# Handle arguments a la GNU:
|
|||
|
|
# --version
|
|||
|
|
# --useversion=<version>
|
|||
|
|
# --help
|
|||
|
|
# --srcdir=/path
|
|||
|
|
# --htmldir=/path
|
|||
|
|
|
|||
|
|
foreach option $argv {
|
|||
|
|
switch -glob -- $option {
|
|||
|
|
--version {
|
|||
|
|
puts "tcltk-man-html $Version"
|
|||
|
|
exit 0
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
--help {
|
|||
|
|
puts "usage: tcltk-man-html \[OPTION\] ...\n"
|
|||
|
|
puts " --help print this help, then exit"
|
|||
|
|
puts " --version print version number, then exit"
|
|||
|
|
puts " --srcdir=DIR find tcl and tk source below DIR"
|
|||
|
|
puts " --htmldir=DIR put generated HTML in DIR"
|
|||
|
|
puts " --tcl build tcl help"
|
|||
|
|
puts " --tk build tk help"
|
|||
|
|
puts " --useversion version of tcl/tk to search for"
|
|||
|
|
puts " --verbose whether to print longer messages"
|
|||
|
|
exit 0
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
--srcdir=* {
|
|||
|
|
# length of "--srcdir=" is 9.
|
|||
|
|
set tcltkdir [string range $option 9 end]
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
--htmldir=* {
|
|||
|
|
# length of "--htmldir=" is 10
|
|||
|
|
set webdir [string range $option 10 end]
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
--useversion=* {
|
|||
|
|
# length of "--useversion=" is 13
|
|||
|
|
set useversion [string range $option 13 end]
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
--tcl {
|
|||
|
|
set build_tcl 1
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
--tk {
|
|||
|
|
set build_tk 1
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
--verbose=* {
|
|||
|
|
set verbose [string range $option \
|
|||
|
|
[string length --verbose=] end]
|
|||
|
|
}
|
|||
|
|
default {
|
|||
|
|
puts stderr "tcltk-man-html: unrecognized option -- `$option'"
|
|||
|
|
exit 1
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if {!$build_tcl && !$build_tk} {
|
|||
|
|
set build_tcl 1;
|
|||
|
|
set build_tk 1
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if {$build_tcl} {
|
|||
|
|
# Find Tcl
|
|||
|
|
set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
|
|||
|
|
-directory $tcltkdir tcl$useversion]] end]
|
|||
|
|
if {$tcldir eq ""} {
|
|||
|
|
puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
|
|||
|
|
exit 1
|
|||
|
|
}
|
|||
|
|
puts "using Tcl source directory $tcldir"
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if {$build_tk} {
|
|||
|
|
# Find Tk
|
|||
|
|
set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
|
|||
|
|
-directory $tcltkdir tk$useversion]] end]
|
|||
|
|
if {$tkdir eq ""} {
|
|||
|
|
puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
|
|||
|
|
exit 1
|
|||
|
|
}
|
|||
|
|
puts "using Tk source directory $tkdir"
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
puts "verbose messages are [expr {$verbose ? {on} : {off}}]"
|
|||
|
|
|
|||
|
|
# the title for the man pages overall
|
|||
|
|
global overall_title
|
|||
|
|
set overall_title ""
|
|||
|
|
if {$build_tcl} {
|
|||
|
|
append overall_title "[capitalize $tcldir]"
|
|||
|
|
}
|
|||
|
|
if {$build_tcl && $build_tk} {
|
|||
|
|
append overall_title "/"
|
|||
|
|
}
|
|||
|
|
if {$build_tk} {
|
|||
|
|
append overall_title "[capitalize $tkdir]"
|
|||
|
|
}
|
|||
|
|
append overall_title " Documentation"
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
proc capitalize {string} {
|
|||
|
|
return [string toupper $string 0]
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## Returns the style sheet.
|
|||
|
|
##
|
|||
|
|
proc css-style args {
|
|||
|
|
upvar 1 style style
|
|||
|
|
set body [uplevel 1 [list subst [lindex $args end]]]
|
|||
|
|
set tokens [join [lrange $args 0 end-1] ", "]
|
|||
|
|
append style $tokens " \{" $body "\}\n"
|
|||
|
|
}
|
|||
|
|
proc css-stylesheet {} {
|
|||
|
|
set hBd "1px dotted #11577B"
|
|||
|
|
|
|||
|
|
css-style body div p th td li dd ul ol dl dt blockquote {
|
|||
|
|
font-family: Verdana, sans-serif;
|
|||
|
|
}
|
|||
|
|
css-style pre code {
|
|||
|
|
font-family: 'Courier New', Courier, monospace;
|
|||
|
|
}
|
|||
|
|
css-style pre {
|
|||
|
|
background-color: #F6FCEC;
|
|||
|
|
border-top: 1px solid #6A6A6A;
|
|||
|
|
border-bottom: 1px solid #6A6A6A;
|
|||
|
|
padding: 1em;
|
|||
|
|
overflow: auto;
|
|||
|
|
}
|
|||
|
|
css-style body {
|
|||
|
|
background-color: #FFFFFF;
|
|||
|
|
font-size: 12px;
|
|||
|
|
line-height: 1.25;
|
|||
|
|
letter-spacing: .2px;
|
|||
|
|
padding-left: .5em;
|
|||
|
|
}
|
|||
|
|
css-style h1 h2 h3 h4 {
|
|||
|
|
font-family: Georgia, serif;
|
|||
|
|
padding-left: 1em;
|
|||
|
|
margin-top: 1em;
|
|||
|
|
}
|
|||
|
|
css-style h1 {
|
|||
|
|
font-size: 18px;
|
|||
|
|
color: #11577B;
|
|||
|
|
border-bottom: $hBd;
|
|||
|
|
margin-top: 0px;
|
|||
|
|
}
|
|||
|
|
css-style h2 {
|
|||
|
|
font-size: 14px;
|
|||
|
|
color: #11577B;
|
|||
|
|
background-color: #C5DCE8;
|
|||
|
|
padding-left: 1em;
|
|||
|
|
border: 1px solid #6A6A6A;
|
|||
|
|
}
|
|||
|
|
css-style h3 h4 {
|
|||
|
|
color: #1674A4;
|
|||
|
|
background-color: #E8F2F6;
|
|||
|
|
border-bottom: $hBd;
|
|||
|
|
border-top: $hBd;
|
|||
|
|
}
|
|||
|
|
css-style h3 {
|
|||
|
|
font-size: 12px;
|
|||
|
|
}
|
|||
|
|
css-style h4 {
|
|||
|
|
font-size: 11px;
|
|||
|
|
}
|
|||
|
|
css-style ".keylist dt" ".arguments dt" {
|
|||
|
|
width: 20em;
|
|||
|
|
float: left;
|
|||
|
|
padding: 2px;
|
|||
|
|
border-top: 1px solid #999999;
|
|||
|
|
}
|
|||
|
|
css-style ".keylist dt" { font-weight: bold; }
|
|||
|
|
css-style ".keylist dd" ".arguments dd" {
|
|||
|
|
margin-left: 20em;
|
|||
|
|
padding: 2px;
|
|||
|
|
border-top: 1px solid #999999;
|
|||
|
|
}
|
|||
|
|
css-style .copy {
|
|||
|
|
background-color: #F6FCFC;
|
|||
|
|
white-space: pre;
|
|||
|
|
font-size: 80%;
|
|||
|
|
border-top: 1px solid #6A6A6A;
|
|||
|
|
margin-top: 2em;
|
|||
|
|
}
|
|||
|
|
css-style .tablecell {
|
|||
|
|
font-size: 12px;
|
|||
|
|
padding-left: .5em;
|
|||
|
|
padding-right: .5em;
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## foreach of the man directories specified by args
|
|||
|
|
## convert manpages into hypertext in the directory
|
|||
|
|
## specified by html.
|
|||
|
|
##
|
|||
|
|
proc make-man-pages {html args} {
|
|||
|
|
global manual overall_title tcltkdesc verbose
|
|||
|
|
global excluded_pages forced_index_pages process_first_patterns
|
|||
|
|
|
|||
|
|
makedirhier $html
|
|||
|
|
set cssfd [open $html/$::CSSFILE w]
|
|||
|
|
fconfigure $cssfd -translation lf -encoding utf-8
|
|||
|
|
puts $cssfd [css-stylesheet]
|
|||
|
|
close $cssfd
|
|||
|
|
set manual(short-toc-n) 1
|
|||
|
|
set manual(short-toc-fp) [open $html/[indexfile] w]
|
|||
|
|
fconfigure $manual(short-toc-fp) -translation lf -encoding utf-8
|
|||
|
|
puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title]
|
|||
|
|
puts $manual(short-toc-fp) "<DL class=\"keylist\">"
|
|||
|
|
set manual(merge-copyrights) {}
|
|||
|
|
|
|||
|
|
foreach arg $args {
|
|||
|
|
# preprocess to set up subheader for the rest of the files
|
|||
|
|
if {![llength $arg]} {
|
|||
|
|
continue
|
|||
|
|
}
|
|||
|
|
lassign $arg -> name file
|
|||
|
|
if {[regexp {(.*)(?: Package)? Commands(?:, version .*)?} $name -> pkg]} {
|
|||
|
|
set name "$pkg Commands"
|
|||
|
|
} elseif {[regexp {(.*)(?: Package)? C API(?:, version .*)?} $name -> pkg]} {
|
|||
|
|
set name "$pkg C API"
|
|||
|
|
}
|
|||
|
|
lappend manual(subheader) $name $file
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## parse the manpages in a section of the docs (split by
|
|||
|
|
## package) and construct formatted manpages
|
|||
|
|
##
|
|||
|
|
foreach arg $args {
|
|||
|
|
if {[llength $arg]} {
|
|||
|
|
make-manpage-section $html $arg
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## build the keyword index.
|
|||
|
|
##
|
|||
|
|
if {!$verbose} {
|
|||
|
|
puts stderr "Assembling index"
|
|||
|
|
}
|
|||
|
|
file delete -force -- $html/Keywords
|
|||
|
|
makedirhier $html/Keywords
|
|||
|
|
set keyfp [open $html/Keywords/[indexfile] w]
|
|||
|
|
fconfigure $keyfp -translation lf -encoding utf-8
|
|||
|
|
puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \
|
|||
|
|
$overall_title "../[indexfile]"]
|
|||
|
|
set letters {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
|
|||
|
|
# Create header first
|
|||
|
|
set keyheader {}
|
|||
|
|
foreach a $letters {
|
|||
|
|
set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
|
|||
|
|
if {[llength $keys]} {
|
|||
|
|
lappend keyheader "<A HREF=\"$a.htm\">$a</A>"
|
|||
|
|
} else {
|
|||
|
|
# No keywords for this letter
|
|||
|
|
lappend keyheader $a
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
set keyheader <H3>[join $keyheader " |\n"]</H3>
|
|||
|
|
puts $keyfp $keyheader
|
|||
|
|
foreach a $letters {
|
|||
|
|
set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
|
|||
|
|
if {![llength $keys]} {
|
|||
|
|
continue
|
|||
|
|
}
|
|||
|
|
# Per-keyword page
|
|||
|
|
set afp [open $html/Keywords/$a.htm w]
|
|||
|
|
fconfigure $afp -translation lf -encoding utf-8
|
|||
|
|
puts $afp [htmlhead "$tcltkdesc Keywords - $a" \
|
|||
|
|
"$tcltkdesc Keywords - $a" \
|
|||
|
|
$overall_title "../[indexfile]"]
|
|||
|
|
puts $afp $keyheader
|
|||
|
|
puts $afp "<DL class=\"keylist\">"
|
|||
|
|
foreach k [lsort -dictionary $keys] {
|
|||
|
|
set k [string range $k 8 end]
|
|||
|
|
puts $afp "<DT><A NAME=\"$k\">$k</A></DT>"
|
|||
|
|
puts $afp "<DD>"
|
|||
|
|
set refs {}
|
|||
|
|
foreach man $manual(keyword-$k) {
|
|||
|
|
set name [lindex $man 0]
|
|||
|
|
set file [lindex $man 1]
|
|||
|
|
if {[info exists manual(tooltip-$file)]} {
|
|||
|
|
set tooltip $manual(tooltip-$file)
|
|||
|
|
if {[string match {*[<>""]*} $tooltip]} {
|
|||
|
|
manerror "bad tooltip for $file: \"$tooltip\""
|
|||
|
|
}
|
|||
|
|
lappend refs "<A HREF=\"../$file\" TITLE=\"$tooltip\">$name</A>"
|
|||
|
|
} else {
|
|||
|
|
lappend refs "<A HREF=\"../$file\">$name</A>"
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
puts $afp "[join $refs {, }]</DD>"
|
|||
|
|
}
|
|||
|
|
puts $afp "</DL>"
|
|||
|
|
# insert merged copyrights
|
|||
|
|
puts $afp [copyout $manual(merge-copyrights)]
|
|||
|
|
puts $afp "</BODY></HTML>"
|
|||
|
|
close $afp
|
|||
|
|
}
|
|||
|
|
# insert merged copyrights
|
|||
|
|
puts $keyfp [copyout $manual(merge-copyrights)]
|
|||
|
|
puts $keyfp "</BODY></HTML>"
|
|||
|
|
close $keyfp
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## finish off short table of contents
|
|||
|
|
##
|
|||
|
|
puts $manual(short-toc-fp) "<DT><A HREF=\"Keywords/[indexfile]\">Keywords</A><DD>The keywords from the $tcltkdesc man pages."
|
|||
|
|
puts $manual(short-toc-fp) "</DL>"
|
|||
|
|
# insert merged copyrights
|
|||
|
|
puts $manual(short-toc-fp) [copyout $manual(merge-copyrights)]
|
|||
|
|
puts $manual(short-toc-fp) "</BODY></HTML>"
|
|||
|
|
close $manual(short-toc-fp)
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## output man pages
|
|||
|
|
##
|
|||
|
|
unset manual(section)
|
|||
|
|
if {!$verbose} {
|
|||
|
|
puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links and write out"
|
|||
|
|
}
|
|||
|
|
foreach path $manual(all-pages) wing_name $manual(all-page-domains) {
|
|||
|
|
set manual(wing-file) [file dirname $path]
|
|||
|
|
set manual(tail) [file tail $path]
|
|||
|
|
set manual(name) [file root $manual(tail)]
|
|||
|
|
try {
|
|||
|
|
set text $manual(output-$manual(wing-file)-$manual(name))
|
|||
|
|
set ntext 0
|
|||
|
|
foreach item $text {
|
|||
|
|
incr ntext [llength [split $item \n]]
|
|||
|
|
incr ntext
|
|||
|
|
}
|
|||
|
|
set toc $manual(toc-$manual(wing-file)-$manual(name))
|
|||
|
|
set ntoc 0
|
|||
|
|
foreach item $toc {
|
|||
|
|
incr ntoc [llength [split $item \n]]
|
|||
|
|
incr ntoc
|
|||
|
|
}
|
|||
|
|
if {$verbose} {
|
|||
|
|
puts stderr "rescanning page $manual(name) $ntoc/$ntext"
|
|||
|
|
} else {
|
|||
|
|
puts -nonewline stderr .
|
|||
|
|
}
|
|||
|
|
set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
|
|||
|
|
fconfigure $outfd -translation lf -encoding utf-8
|
|||
|
|
puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \
|
|||
|
|
$manual(name) $wing_name "[indexfile]" \
|
|||
|
|
$overall_title "../[indexfile]"]
|
|||
|
|
if {($ntext > 60) && ($ntoc > 32)} {
|
|||
|
|
foreach item $toc {
|
|||
|
|
puts $outfd $item
|
|||
|
|
}
|
|||
|
|
} elseif {$manual(name) in $forced_index_pages} {
|
|||
|
|
if {!$verbose} {puts stderr ""}
|
|||
|
|
manerror "forcing index generation"
|
|||
|
|
foreach item $toc {
|
|||
|
|
puts $outfd $item
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
foreach item $text {
|
|||
|
|
puts $outfd [insert-cross-references $item]
|
|||
|
|
}
|
|||
|
|
puts $outfd "</BODY></HTML>"
|
|||
|
|
} on error msg {
|
|||
|
|
if {$verbose} {
|
|||
|
|
puts stderr $msg
|
|||
|
|
} else {
|
|||
|
|
puts stderr "\nError when processing $manual(name): $msg"
|
|||
|
|
}
|
|||
|
|
} finally {
|
|||
|
|
catch {close $outfd}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
if {!$verbose} {
|
|||
|
|
puts stderr "\nDone"
|
|||
|
|
}
|
|||
|
|
return {}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk).
|
|||
|
|
##
|
|||
|
|
proc plus-base {var root glob name dir desc} {
|
|||
|
|
global tcltkdir
|
|||
|
|
if {$var} {
|
|||
|
|
if {[file exists $tcltkdir/$root/README]} {
|
|||
|
|
set f [open $tcltkdir/$root/README]
|
|||
|
|
fconfigure $f -encoding utf-8
|
|||
|
|
set d [read $f]
|
|||
|
|
close $f
|
|||
|
|
if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} {
|
|||
|
|
append name ", version $version"
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
set glob $root/$glob
|
|||
|
|
return [list $tcltkdir/$glob $name $dir $desc]
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## Helper for assembling the descriptions of contributed packages.
|
|||
|
|
##
|
|||
|
|
proc plus-pkgs {type args} {
|
|||
|
|
global build_tcl tcltkdir tcldir
|
|||
|
|
if {$type ni {n 3}} {
|
|||
|
|
error "unknown type \"$type\": must be 3 or n"
|
|||
|
|
}
|
|||
|
|
if {!$build_tcl} return
|
|||
|
|
set result {}
|
|||
|
|
set pkgsdir $tcltkdir/$tcldir/pkgs
|
|||
|
|
foreach {dir name version} $args {
|
|||
|
|
set globpat $pkgsdir/$dir/doc/*.$type
|
|||
|
|
if {![llength [glob -type f -nocomplain $globpat]]} {
|
|||
|
|
# Fallback for manpages generated using doctools
|
|||
|
|
set globpat $pkgsdir/$dir/doc/man/*.$type
|
|||
|
|
if {![llength [glob -type f -nocomplain $globpat]]} {
|
|||
|
|
continue
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
set dir [string trimright $dir "0123456789-."]
|
|||
|
|
switch $type {
|
|||
|
|
n {
|
|||
|
|
set title "$name Package Commands"
|
|||
|
|
if {$version ne ""} {
|
|||
|
|
append title ", version $version"
|
|||
|
|
}
|
|||
|
|
set dir [string totitle $dir]Cmd
|
|||
|
|
set desc \
|
|||
|
|
"The additional commands provided by the $name package."
|
|||
|
|
}
|
|||
|
|
3 {
|
|||
|
|
set title "$name Package C API"
|
|||
|
|
if {$version ne ""} {
|
|||
|
|
append title ", version $version"
|
|||
|
|
}
|
|||
|
|
set dir [string totitle $dir]Lib
|
|||
|
|
set desc \
|
|||
|
|
"The additional C functions provided by the $name package."
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
lappend result [list $globpat $title $dir $desc]
|
|||
|
|
}
|
|||
|
|
return $result
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
##
|
|||
|
|
## Set up some special cases. It would be nice if we didn't have them,
|
|||
|
|
## but we do...
|
|||
|
|
##
|
|||
|
|
set excluded_pages {case menubar pack-old}
|
|||
|
|
set forced_index_pages {GetDash}
|
|||
|
|
set process_first_patterns {*/ttk_widget.n */options.n}
|
|||
|
|
set ensemble_commands {
|
|||
|
|
after array binary chan clock dde dict encoding file history info interp
|
|||
|
|
memory namespace package registry self string trace update zlib
|
|||
|
|
clipboard console font grab grid image option pack place selection tk
|
|||
|
|
tkwait ttk::style winfo wm itcl::delete itcl::find itcl::is
|
|||
|
|
}
|
|||
|
|
array set remap_link_target {
|
|||
|
|
stdin Tcl_GetStdChannel
|
|||
|
|
stdout Tcl_GetStdChannel
|
|||
|
|
stderr Tcl_GetStdChannel
|
|||
|
|
style ttk::style
|
|||
|
|
{style map} ttk::style
|
|||
|
|
{tk busy} busy
|
|||
|
|
library auto_execok
|
|||
|
|
safe-tcl safe
|
|||
|
|
tclvars env
|
|||
|
|
tcl_break catch
|
|||
|
|
tcl_continue catch
|
|||
|
|
tcl_error catch
|
|||
|
|
tcl_ok catch
|
|||
|
|
tcl_return catch
|
|||
|
|
int() mathfunc
|
|||
|
|
wide() mathfunc
|
|||
|
|
packagens pkg::create
|
|||
|
|
pkgMkIndex pkg_mkIndex
|
|||
|
|
pkg_mkIndex pkg_mkIndex
|
|||
|
|
Tcl_Obj Tcl_NewObj
|
|||
|
|
Tcl_ObjType Tcl_RegisterObjType
|
|||
|
|
Tcl_OpenFileChannelProc Tcl_FSOpenFileChannel
|
|||
|
|
errorinfo env
|
|||
|
|
errorcode env
|
|||
|
|
tcl_pkgpath env
|
|||
|
|
Tcl_Command Tcl_CreateObjCommand
|
|||
|
|
Tcl_CmdProc Tcl_CreateObjCommand
|
|||
|
|
Tcl_CmdDeleteProc Tcl_CreateObjCommand
|
|||
|
|
Tcl_ObjCmdProc Tcl_CreateObjCommand
|
|||
|
|
Tcl_Channel Tcl_OpenFileChannel
|
|||
|
|
Tcl_WideInt Tcl_NewIntObj
|
|||
|
|
Tcl_ChannelType Tcl_CreateChannel
|
|||
|
|
Tcl_DString Tcl_DStringInit
|
|||
|
|
Tcl_Namespace Tcl_AppendExportList
|
|||
|
|
Tcl_Object Tcl_NewObjectInstance
|
|||
|
|
Tcl_Class Tcl_GetObjectAsClass
|
|||
|
|
Tcl_Event Tcl_QueueEvent
|
|||
|
|
Tcl_Time Tcl_GetTime
|
|||
|
|
Tcl_ThreadId Tcl_CreateThread
|
|||
|
|
Tk_Window Tk_WindowId
|
|||
|
|
Tk_3DBorder Tk_Get3DBorder
|
|||
|
|
Tk_Anchor Tk_GetAnchor
|
|||
|
|
Tk_Cursor Tk_GetCursor
|
|||
|
|
Tk_Dash Tk_GetDash
|
|||
|
|
Tk_Font Tk_GetFont
|
|||
|
|
Tk_Image Tk_GetImage
|
|||
|
|
Tk_ImageMaster Tk_GetImage
|
|||
|
|
Tk_ImageModel Tk_GetImage
|
|||
|
|
Tk_ItemType Tk_CreateItemType
|
|||
|
|
Tk_Justify Tk_GetJustify
|
|||
|
|
Ttk_Theme Ttk_GetTheme
|
|||
|
|
}
|
|||
|
|
array set exclude_refs_map {
|
|||
|
|
bind.n {button destroy option}
|
|||
|
|
clock.n {next}
|
|||
|
|
history.n {exec}
|
|||
|
|
next.n {unknown}
|
|||
|
|
zlib.n {binary close filename text}
|
|||
|
|
canvas.n {bitmap text}
|
|||
|
|
console.n {eval}
|
|||
|
|
checkbutton.n {image}
|
|||
|
|
clipboard.n {string}
|
|||
|
|
entry.n {string}
|
|||
|
|
event.n {return}
|
|||
|
|
font.n {menu}
|
|||
|
|
getOpenFile.n {file open text}
|
|||
|
|
grab.n {global}
|
|||
|
|
interp.n {time}
|
|||
|
|
menu.n {checkbutton radiobutton}
|
|||
|
|
messageBox.n {error info}
|
|||
|
|
options.n {bitmap image set}
|
|||
|
|
radiobutton.n {image}
|
|||
|
|
safe.n {join split}
|
|||
|
|
scale.n {label variable}
|
|||
|
|
scrollbar.n {set}
|
|||
|
|
selection.n {string}
|
|||
|
|
tcltest.n {error}
|
|||
|
|
text.n {bind image lower raise}
|
|||
|
|
tkvars.n {tk}
|
|||
|
|
tkwait.n {variable}
|
|||
|
|
tm.n {exec}
|
|||
|
|
ttk_checkbutton.n {variable}
|
|||
|
|
ttk_combobox.n {selection}
|
|||
|
|
ttk_entry.n {focus variable}
|
|||
|
|
ttk_intro.n {focus text}
|
|||
|
|
ttk_label.n {font text}
|
|||
|
|
ttk_labelframe.n {text}
|
|||
|
|
ttk_menubutton.n {flush}
|
|||
|
|
ttk_notebook.n {image text}
|
|||
|
|
ttk_progressbar.n {variable}
|
|||
|
|
ttk_radiobutton.n {variable}
|
|||
|
|
ttk_scale.n {variable}
|
|||
|
|
ttk_scrollbar.n {set}
|
|||
|
|
ttk_spinbox.n {format}
|
|||
|
|
ttk_treeview.n {text open}
|
|||
|
|
ttk_widget.n {image text variable}
|
|||
|
|
TclZlib.3 {binary flush filename text}
|
|||
|
|
}
|
|||
|
|
array set exclude_when_followed_by_map {
|
|||
|
|
canvas.n {
|
|||
|
|
bind widget
|
|||
|
|
focus widget
|
|||
|
|
image are
|
|||
|
|
lower widget
|
|||
|
|
raise widget
|
|||
|
|
}
|
|||
|
|
selection.n {
|
|||
|
|
clipboard selection
|
|||
|
|
clipboard ;
|
|||
|
|
}
|
|||
|
|
ttk_image.n {
|
|||
|
|
image imageSpec
|
|||
|
|
}
|
|||
|
|
fontchooser.n {
|
|||
|
|
tk fontchooser
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
try {
|
|||
|
|
# Parse what the user told us to do
|
|||
|
|
parse_command_line
|
|||
|
|
|
|||
|
|
# Some strings depend on what options are specified
|
|||
|
|
set tcltkdesc ""; set cmdesc ""; set appdir ""
|
|||
|
|
if {$build_tcl} {
|
|||
|
|
append tcltkdesc "Tcl"
|
|||
|
|
append cmdesc "Tcl"
|
|||
|
|
append appdir "$tcldir"
|
|||
|
|
}
|
|||
|
|
if {$build_tcl && $build_tk} {
|
|||
|
|
append tcltkdesc "/"
|
|||
|
|
append cmdesc " and "
|
|||
|
|
append appdir ","
|
|||
|
|
}
|
|||
|
|
if {$build_tk} {
|
|||
|
|
append tcltkdesc "Tk"
|
|||
|
|
append cmdesc "Tk"
|
|||
|
|
append appdir "$tkdir"
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
apply {{} {
|
|||
|
|
global packageBuildList tcltkdir tcldir build_tcl
|
|||
|
|
|
|||
|
|
# When building docs for Tcl, try to build docs for bundled packages too
|
|||
|
|
set packageBuildList {}
|
|||
|
|
if {$build_tcl} {
|
|||
|
|
set pkgsDir [file join $tcltkdir $tcldir pkgs]
|
|||
|
|
set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *]
|
|||
|
|
|
|||
|
|
foreach dir [lsort $subdirs] {
|
|||
|
|
# Parse the subdir name into (name, version) as fallback...
|
|||
|
|
set description [split $dir -]
|
|||
|
|
if {2 != [llength $description]} {
|
|||
|
|
regexp {([^0-9]*)(.*)} $dir -> n v
|
|||
|
|
set description [list $n $v]
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# ... but try to extract (name, version) from subdir contents
|
|||
|
|
try {
|
|||
|
|
try {
|
|||
|
|
set f [open [file join $pkgsDir $dir configure.in]]
|
|||
|
|
} trap {POSIX ENOENT} {} {
|
|||
|
|
set f [open [file join $pkgsDir $dir configure.ac]]
|
|||
|
|
}
|
|||
|
|
fconfigure $f -encoding utf-8
|
|||
|
|
foreach line [split [read $f] \n] {
|
|||
|
|
if {2 == [scan $line \
|
|||
|
|
{ AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} {
|
|||
|
|
set description [list $n $v]
|
|||
|
|
break
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
} finally {
|
|||
|
|
catch {close $f; unset f}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
if {[file exists [file join $pkgsDir $dir configure]]} {
|
|||
|
|
# Looks like a package, record our best extraction attempt
|
|||
|
|
lappend packageBuildList $dir {*}$description
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# Get the list of packages to try, and what their human-readable names
|
|||
|
|
# are. Note that the package directory list should be version-less.
|
|||
|
|
try {
|
|||
|
|
set packageDirNameMap {}
|
|||
|
|
if {$build_tcl} {
|
|||
|
|
set f [open $tcltkdir/$tcldir/pkgs/package.list.txt]
|
|||
|
|
fconfigure $f -encoding utf-8
|
|||
|
|
try {
|
|||
|
|
foreach line [split [read $f] \n] {
|
|||
|
|
if {[string trim $line] eq ""} continue
|
|||
|
|
if {[string match #* $line]} continue
|
|||
|
|
lassign $line dir name
|
|||
|
|
lappend packageDirNameMap $dir $name
|
|||
|
|
}
|
|||
|
|
} finally {
|
|||
|
|
close $f
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
} trap {POSIX ENOENT} {} {
|
|||
|
|
set packageDirNameMap {
|
|||
|
|
itcl {[incr Tcl]}
|
|||
|
|
tdbc {TDBC}
|
|||
|
|
thread Thread
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# Convert to human readable names, if applicable
|
|||
|
|
for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} {
|
|||
|
|
lassign [lrange $packageBuildList $idx $idx+2] d n v
|
|||
|
|
if {[dict exists $packageDirNameMap $n]} {
|
|||
|
|
lset packageBuildList $idx+1 [dict get $packageDirNameMap $n]
|
|||
|
|
}
|
|||
|
|
}
|
|||
|
|
}}
|
|||
|
|
|
|||
|
|
#
|
|||
|
|
# Invoke the scraper/converter engine.
|
|||
|
|
#
|
|||
|
|
make-man-pages $webdir \
|
|||
|
|
[list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \
|
|||
|
|
"The interpreters which implement $cmdesc."] \
|
|||
|
|
[plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \
|
|||
|
|
"The commands which the <B>tclsh</B> interpreter implements."] \
|
|||
|
|
[plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \
|
|||
|
|
"The additional commands which the <B>wish</B> interpreter implements."] \
|
|||
|
|
{*}[plus-pkgs n {*}$packageBuildList] \
|
|||
|
|
[plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \
|
|||
|
|
"The C functions which a Tcl extended C program may use."] \
|
|||
|
|
[plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \
|
|||
|
|
"The additional C functions which a Tk extended C program may use."] \
|
|||
|
|
{*}[plus-pkgs 3 {*}$packageBuildList]
|
|||
|
|
} on error {msg opts} {
|
|||
|
|
# On failure make sure we show what went wrong. We're not supposed
|
|||
|
|
# to get here though; it represents a bug in the script.
|
|||
|
|
puts $msg\n[dict get $opts -errorinfo]
|
|||
|
|
exit 1
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
# Local-Variables:
|
|||
|
|
# mode: tcl
|
|||
|
|
# End:
|