From 730cfd66ec46d23a2be30b9db2980c682f564556 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 30 Jan 2008 09:54:04 +0000 Subject: Improved manual page scraper to do a better job with Ttk. [Tk Bug 1876493] --- ChangeLog | 7 ++++- tools/tcltk-man2html.tcl | 80 +++++++++++++++++++++++++++--------------------- 2 files changed, 51 insertions(+), 36 deletions(-) diff --git a/ChangeLog b/ChangeLog index 519cd86..9493183 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,13 @@ +2008-01-30 Donal K. Fellows + + * tools/tcltk-man2html.tcl: Reworked manual page scraper to do a + proper job of handling references to Ttk options. [Tk Bug 1876493] + 2008-01-29 Donal K. Fellows * doc/man.macros (SO, SE): Adjusted macros so that it is possible for Ttk to have its "standard options" on a manual page that is not called - "options". [Tk Bug 1876493] + "options". [Tk Bug 1876493] 2008-01-25 Don Porter diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 21f70d4..e846a00 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -149,26 +149,27 @@ proc manerror {msg} { global manual set name {} set subj {} + set procname [lindex [info level -1] 0] if {[info exists manual(name)]} { set name $manual(name) } if {[info exists manual(section)] && [string length $manual(section)]} { - puts stderr "$name: $manual(section): $msg" + puts stderr "$name: $manual(section): $procname: $msg" } else { - puts stderr "$name: $msg" + puts stderr "$name: $procname: $msg" } } proc manreport {level msg} { global manual if {$level < $manual(report-level)} { - manerror $msg + uplevel 1 [list manerror $msg] } } proc fatal {msg} { global manual - manerror $msg + uplevel 1 [list manerror $msg] exit 1 } @@ -390,12 +391,12 @@ proc process-text {text} { || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \ {\1\\fR\2\3} ntext] } then { - manerror "process-text: impotent font change: $text" + manerror "impotent font change: $text" set text $ntext continue } # unrecognized - manerror "process-text: uncaught backslash: $text" + manerror "uncaught backslash: $text" set text [string map [list "\\" "\"] $text] } return $text @@ -515,35 +516,40 @@ proc long-toc {text} { proc option-toc {name class switch} { global manual if {[string match "*OPTIONS" $manual(section)]} { - # link the defined option into the long table of contents - set link [long-toc "$switch, $name, $class"] - regsub -- "$switch, $name, $class" $link "$switch" link - return $link - } elseif {"$manual(name):$manual(section)" eq "options:DESCRIPTION"} { - # link the defined standard option to the long table of - # contents and make a target for the standard option references - # from other man pages. - set first [lindex $switch 0] - set here M$first - set there L[incr manual(long-toc-n)] - set manual(standard-option-$first) "$switch, $name, $class" - lappend manual(section-toc) "
$switch, $name, $class" - return "$switch" - } else { + if {$manual(name) ne "ttk_widget"} { + # link the defined option into the long table of contents + set link [long-toc "$switch, $name, $class"] + regsub -- "$switch, $name, $class" $link "$switch" link + return $link + } + } elseif {"$manual(name):$manual(section)" ne "options:DESCRIPTION"} { error "option-toc in $manual(name) section $manual(section)" } + + # link the defined standard option to the long table of contents and make + # a target for the standard option references from other man pages. + + set first [lindex $switch 0] + set here M$first + set there L[incr manual(long-toc-n)] + set manual(standard-option-$manual(name)-$first) \ + "$switch, $name, $class" + lappend manual(section-toc) \ + "
$switch, $name, $class" + return "$switch" } -proc std-option-toc {name} { +proc std-option-toc {name page} { global manual - if {[info exists manual(standard-option-$name)]} { - lappend manual(section-toc)
$manual(standard-option-$name) - return $manual(standard-option-$name) + if {[info exists manual(standard-option-$page-$name)]} { + lappend manual(section-toc)
$manual(standard-option-$page-$name) + return $manual(standard-option-$page-$name) } + manerror "missing reference to \"$name\" in $page.n" set here M[incr manual(section-toc-n)] set there L[incr manual(long-toc-n)] set other M$name - lappend manual(section-toc) "
$name" - return "$name" + lappend manual(section-toc) "
$name" + return "$name" } ## ## process the widget option section @@ -1248,18 +1254,14 @@ proc output-directive {line} { return } .SO { + set targetPage $rest if {[match-text @stuff .SE]} { output-directive {.SH STANDARD OPTIONS} - set opts {} - foreach line [split $stuff \n] { - foreach option [split $line \t] { - lappend opts $option - } - } + set opts [split $stuff \n\t] man-puts
lappend manual(section-toc)
foreach option [lsort -dictionary $opts] { - man-puts "
[std-option-toc $option]" + man-puts "
[std-option-toc $option $targetPage]" } man-puts
lappend manual(section-toc)
@@ -1527,6 +1529,10 @@ proc make-man-pages {html args} { set manual(long-toc-n) 1 # get the manual pages for this section set manual(pages) [lsort -dictionary [glob $manual(wing-glob)]] + set n [lsearch -glob $manual(pages) */ttk_widget.n] + if {$n >= 0} { + set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]" + } set n [lsearch -glob $manual(pages) */options.n] if {$n >= 0} { set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]" @@ -1666,7 +1672,11 @@ proc make-man-pages {html args} { .SO { flushbuffer incr manual(.SO) - lappend manual(text) $code + if {[llength $rest] == 0} { + lappend manual(text) "$code options" + } else { + lappend manual(text) "$code [unquote $rest]" + } } .SE { flushbuffer -- cgit v0.12