763 lines
21 KiB
Tcl
Executable File
763 lines
21 KiB
Tcl
Executable File
#!/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:
|