More factoring out of special cases in the nroff->HTML code.

3 files changed, 100 insertions, 134 deletions

diff --git a/ChangeLog b/ChangeLog
index da37f80..3eb1c99 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,19 +1,26 @@
+2010-01-13  Donal K. Fellows  <dkf@users.sf.net>
+
+	* tools/tcltk-man2html.tcl:	  More factoring out of special cases
+	* tools/tcltk-man2html-utils.tcl: so that they are described outside
+	the engine file. Now there is only one real set of special cases in
+	there, to handle the .SO/.OP/.SE directives.
+
 2010-01-13  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tcl.h       Fix TCL_LL_MODIFIER for Cygwin
+	* generic/tcl.h:      Fix TCL_LL_MODIFIER for Cygwin
 	* generic/tclEnv.c:   Fix CYGWIN compilation problems,
-	* generic/tclInt.h    and remove some unnecessary
-	* generic/tclPort.h   double includes.
-	* generic/tclPlatDecls.h
-	* win/cat.c
-	* win/tclWinConsole.c
-	* win/tclWinFCmd.c
-	* win/tclWinFile.c
-	* win/tclWinPipe.c
-	* win/tclWinSerial.c
-	* win/tclWinThrd.c
+	* generic/tclInt.h:   and remove some unnecessary
+	* generic/tclPort.h:  double includes.
+	* generic/tclPlatDecls.h:
+	* win/cat.c:
+	* win/tclWinConsole.c:
+	* win/tclWinFCmd.c:
+	* win/tclWinFile.c:
+	* win/tclWinPipe.c:
+	* win/tclWinSerial.c:
+	* win/tclWinThrd.c:
 	* win/tclWinPort.h:   Put win32 includes first
-	* unix/tclUnixChan.c  Forgot one CONST change
+	* unix/tclUnixChan.c: Forgot one CONST change
 
 2010-01-12  Donal K. Fellows  <dkf@users.sf.net>
 
@@ -24,21 +31,21 @@
 2010-01-10  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tclWinDde.c:      VC++ 6.0 doesn't have
-	* win/tclWinReg.c       PDWORD_PTR
+	* win/tclWinReg.c:      PDWORD_PTR
 	* win/tclWinThrd.c:     Fix various minor gcc warnings.
-	* win/tclWinTime.c
-	* win/tclWinConsole.c   Put channel type definitions
-	* win/tclWinChan.c      in static const memory
-	* win/tclWinPipe.c
-	* win/tclWinSerial.c
-	* win/tclWinSock.c
-	* generic/tclIOGT.c
-	* generic/tclIORChan.c
-	* generic/tclIORTrans.c
-	* unix/tclUnixChan.c
-	* unix/tclUnixPipe.c
-	* unix/tclUnixSock.c
-	* unix/configure        (regenerated with autoconf 2.59)
+	* win/tclWinTime.c:
+	* win/tclWinConsole.c:  Put channel type definitions
+	* win/tclWinChan.c:     in static const memory
+	* win/tclWinPipe.c:
+	* win/tclWinSerial.c:
+	* win/tclWinSock.c:
+	* generic/tclIOGT.c:
+	* generic/tclIORChan.c:
+	* generic/tclIORTrans.c:
+	* unix/tclUnixChan.c:
+	* unix/tclUnixPipe.c:
+	* unix/tclUnixSock.c:
+	* unix/configure:       (regenerated with autoconf 2.59)
 	* tests/info.test:      Make test independant from
 	                        tcltest implementation.
 
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index bf5d37b..e6a4227 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -299,6 +299,7 @@ proc long-toc {text} {
 }
 proc option-toc {name class switch} {
     global manual
+    # Special case handling, oh we hate it but must do it
     if {[string match "*OPTIONS" $manual(section)]} {
 	if {$manual(name) ne "ttk_widget" && ($manual(name) ne "ttk_entry" ||
 		![string match validate* $name])} {
@@ -509,12 +510,6 @@ proc output-IP-list {context code rest} {
 			} else {
 			    man-puts "$para<DT>[long-toc $rest]<DD>"
 			}
-			if {"$manual(name):$manual(section)" eq \
-				"selection:DESCRIPTION"} {
-			    if {[match-text .RE @rest .RS .RS]} {
-				man-puts <DT>[long-toc $rest]<DD>
-			    }
-			}
 		    }
 		    .sp - .br - .DS - .CS {
 			output-directive $line
@@ -613,28 +608,23 @@ proc output-name {line} {
 ##
 proc cross-reference {ref} {
     global manual
-    if {[string match "Tcl_*" $ref]} {
-	set lref $ref
-    } elseif {[string match "Tk_*" $ref]} {
+    global ensemble_commands exclude_refs_map exclude_when_followed_by_map
+    set lref [string tolower $ref]
+    if {[string match "Tcl_*" $ref] || [string match "Tk_*" $ref]} {
 	set lref $ref
     } elseif {$ref eq "Tcl"} {
 	set lref $ref
-    } elseif {[regexp {^[A-Z0-9 ?!]+$} $ref]} {
-	if {[info exists manual($manual(name)-id-$ref)]} {
-	    return "<A HREF=\"#$manual($manual(name)-id-$ref)\">$ref</A>"
-	}
-	set lref [string tolower $ref]
-    } else {
-	set lref [string tolower $ref]
+    } elseif {
+	[regexp {^[A-Z0-9 ?!]+$} $ref]
+	&& [info exists manual($manual(name)-id-$ref)]
+    } {
+	return "<A HREF=\"#$manual($manual(name)-id-$ref)\">$ref</A>"
     }
     ##
     ## nothing to reference
     ##
     if {![info exists manual(name-$lref)]} {
-	foreach name {
-	    array file history info interp string trace after clipboard grab
-	    image option pack place selection tk tkwait update winfo wm
-	} {
+	foreach name $ensemble_commands {
 	    if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
 		    [info exists manual(name-$name)] && \
 		    $manual(tail) ne "$name.n"} {
@@ -681,60 +671,22 @@ proc cross-reference {ref} {
     ##
     ## exceptions, sigh, to the rule
     ##
-    switch -exact -- $manual(tail) {
-	canvas.n {
-	    if {$lref eq "focus"} {
-		upvar 1 tail tail
-		set clue [string first command $tail]
-		if {$clue < 0 ||  $clue > 5} {
-		    return $ref
-		}
-	    }
-	    if {$lref in {bitmap image text}} {
-		return $ref
-	    }
-	}
-	checkbutton.n - radiobutton.n {
-	    if {$lref in {image}} {
-		return $ref
-	    }
-	}
-	menu.n {
-	    if {$lref in {checkbutton radiobutton}} {
-		return $ref
-	    }
-	}
-	options.n {
-	    if {$lref in {bitmap image set}} {
-		return $ref
-	    }
-	}
-	regexp.n {
-	    if {$lref in {string}} {
-		return $ref
-	    }
-	}
-	source.n {
-	    if {$lref in {text}} {
-		return $ref
-	    }
-	}
-	history.n {
-	    if {$lref in {exec}} {
-		return $ref
-	    }
-	}
-	return.n {
-	    if {$lref in {error continue break}} {
-		return $ref
-	    }
-	}
-	scrollbar.n {
-	    if {$lref in {set}} {
+    if {[info exists exclude_when_followed_by_map($manual(tail))]} {
+	upvar 1 tail tail
+	set following_word [regexp -inline {\S+} $tail]
+	foreach {this that} $exclude_when_followed_by_map($manual(tail)) {
+	    # only a ref if $this is not followed by $that
+	    if {$lref eq $this && [string match $that* $following_word]} {
 		return $ref
 	    }
 	}
     }
+    if {
+	[info exists exclude_refs_map($manual(tail))]
+	&& $lref in $exclude_refs_map($manual(tail))
+    } {
+	return $ref
+    }
     ##
     ## return the cross reference
     ##
@@ -923,15 +875,8 @@ proc output-directive {line} {
 	    }
 	    # some sections can simply free wheel their way through the text
 	    # some sections can be processed in their own loops
-	    switch -exact -- $manual(section) {
-		NAME {
-		    if {$manual(tail) in {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3}} {
-			# these manual pages have two NAME sections
-			if {[info exists manual($manual(tail)-NAME)]} {
-			    return
-			}
-			set manual($manual(tail)-NAME) 1
-		    }
+	    switch -exact -- [string index $code end]:$manual(section) {
+		H:NAME {
 		    set names {}
 		    while {1} {
 			set line [next-text]
@@ -939,12 +884,11 @@ proc output-directive {line} {
 			    backup-text 1
 			    output-name [join $names { }]
 			    return
-			} else {
-			    lappend names [string trim $line]
 			}
+			lappend names [string trim $line]
 		    }
 		}
-		SYNOPSIS {
+		H:SYNOPSIS {
 		    lappend manual(section-toc) <DL>
 		    while {1} {
 			if {
@@ -988,7 +932,7 @@ proc output-directive {line} {
 		    lappend manual(section-toc) </DL>
 		    return
 		}
-		{SEE ALSO} {
+		{H:SEE ALSO} {
 		    while {[more-text]} {
 			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
 			    backup-text 1
@@ -1015,7 +959,7 @@ proc output-directive {line} {
 		    }
 		    return
 		}
-		KEYWORDS {
+		H:KEYWORDS {
 		    while {[more-text]} {
 			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
 			    backup-text 1
@@ -1030,7 +974,8 @@ proc output-directive {line} {
 			set keys {}
 			foreach key [split $more ,] {
 			    set key [string trim $key]
-			    lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]
+			    lappend manual(keyword-$key) [list $manual(name) \
+				    $manual(wing-file)/$manual(name).htm]
 			    set initial [string toupper [string index $key 0]]
 			    lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
 			}
@@ -1135,23 +1080,7 @@ proc output-directive {line} {
 	    man-puts <P>
 	}
 	.ta {
-	    # these are tab stop settings for short tables
-	    switch -exact -- $manual(name):$manual(section) {
-		{bind:MODIFIERS} -
-		{bind:EVENT TYPES} -
-		{bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
-		{expr:OPERANDS} -
-		{expr:MATH FUNCTIONS} -
-		{history:DESCRIPTION} -
-		{history:HISTORY REVISION} -
-		{switch:DESCRIPTION} -
-		{upvar:DESCRIPTION} {
-		    return;			# fix.me
-		}
-		default {
-		    manerror "ignoring $line"
-		}
-	    }
+	    manerror "ignoring $line"
 	}
 	.nf {
 	    if {[match-text @more .fi]} {
@@ -1261,9 +1190,12 @@ proc merge-copyrights {l1 l2} {
 }
 
 proc makedirhier {dir} {
-    if {![file isdirectory $dir] && \
-	    [catch {file mkdir $dir} error]} {
-	return -code error "cannot create directory $dir: $error"
+    try {
+	if {![file isdirectory $dir]} {
+	    file mkdir $dir
+	}
+    } on error msg {
+	return -code error "cannot create directory $dir: $msg"
     }
 }
 
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index a1b8191..2611393 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -299,9 +299,9 @@ proc make-man-pages {html args} {
 	    set n [lsearch -glob $manual(pages) $pat]
 	    if {$n >= 0} {
 		set f [lindex $manual(pages) $n]
-		puts stderr "shuffling [file tail $f] to front"
-		set manual(pages) [linsert [lreplace $manual(pages) $n $n] 0 \
-				       $f]
+		puts stderr "shuffling [file tail $f] to front of processing queue"
+		set manual(pages) \
+		    [linsert [lreplace $manual(pages) $n $n] 0 $f]
 	    }
 	}
 	# set manual(pages) [lrange $manual(pages) 0 5]
@@ -788,6 +788,33 @@ proc plus-pkgs {type args} {
 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 grab grid image option pack place selection tk tkwait
+    winfo wm
+}
+array set exclude_refs_map {
+    history.n		{exec}
+    regexp.n		{string}
+    return.n		{break continue error}
+    source.n		{text}
+    canvas.n		{bitmap text}
+    checkbutton.n	{image}
+    menu.n		{checkbutton radiobutton}
+    options.n		{bitmap image set}
+    radiobutton.n	{image}
+    scrollbar.n		{set}
+}
+array set exclude_when_followed_by_map {
+    canvas.n {
+	bind widget
+	focus widget
+	image are
+	lower widget
+	raise widget
+    }
+}
 
 try {
     # Parse what the user told us to do