From 8adeea5368a0dc34f04572756248aa36492b4cad Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 31 Jan 2008 02:57:52 +0000 Subject: merge updates from HEAD --- ChangeLog | 12 +++++++- changes | 4 ++- generic/tclInterp.c | 4 +-- tools/tcltk-man2html.tcl | 80 +++++++++++++++++++++++++++--------------------- 4 files changed, 61 insertions(+), 39 deletions(-) diff --git a/ChangeLog b/ChangeLog index 519cd86..23641eb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,18 @@ +2008-01-30 Miguel Sofer + + * generic/tclInterp.c (Tcl_GetAlias): fix for [Bug 1882373], + thanks go to an00na + +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/changes b/changes index f48ff0d..06c3682 100644 --- a/changes +++ b/changes @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.116.2.7 2008/01/25 21:39:09 dgp Exp $ +RCS: @(#) $Id: changes,v 1.116.2.8 2008/01/31 02:57:52 dgp Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -7124,6 +7124,8 @@ Several documentation and release notes improvements 2008-01-22 (bug fix)[1867855] fix [lreverse {}] crash (sofer,madden) +2008-01-30 (bug fix)[1882373] fix Tcl_GetAlias pointer code (an00na) + Several documentation and release notes improvements --- Released 8.5.1, February 1, 2008 --- See ChangeLog for details --- diff --git a/generic/tclInterp.c b/generic/tclInterp.c index b6db62e..f25e0d9 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.74.2.6 2007/11/21 06:30:52 dgp Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.74.2.7 2008/01/31 02:57:52 dgp Exp $ */ #include "tclInt.h" @@ -1193,7 +1193,7 @@ Tcl_GetAlias( *argvPtr = (const char **) ckalloc((unsigned) sizeof(const char *) * (objc - 1)); for (i = 1; i < objc; i++) { - *argvPtr[i - 1] = TclGetString(objv[i]); + (*argvPtr)[i - 1] = TclGetString(objv[i]); } } return TCL_OK; 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