view release on metacpan or  search on metacpan

tools/tix-man2html.tcl  view on Meta::CPAN

	    } else {
		man-puts $line
	    }
	}
	man-puts <P></DL>
	lappend manual(section-toc) </DL>
	if {$accept_RE} {
	    manerror "missing .RE in output-IP-list"
	}
    }
}
##
## handle the NAME section lines
## there's only one line in the NAME section,
## consisting of a comma separated list of names,
## followed by a hyphen and a short description.
##
proc output-name {line} {
    global manual
    # split name line into pieces
    regexp {^([^-]+) - (.*)$} $line all head tail
    # output line to manual page untouched
    man-puts $line
    # output line to long table of contents
    lappend manual(section-toc) <DL><DD>$line</DL>
    # separate out the names for future reference
    foreach name [split $head ,] {
	set name [string trim $name]
	if {[llength $name] > 1} {
	    manerror "name has a space: {$name}\nfrom: $line"
	}
	lappend manual(wing-toc) $name
	lappend manual(name-$name) $manual(wing-file)/$manual(name)
    }
}
##
## build a cross-reference link if appropriate
##
proc cross-reference {ref} {
    global manual

    regsub {[(][31n][)]} $ref "" ref

    if {[string match Tcl_* $ref]} {
	set lref $ref
    } elseif {[string match Tk_* $ref]} {
	set lref $ref
    } elseif {[string equal $ref "Tcl"]} {
	set lref $ref
    } elseif {[regexp -nocase tix $ref]} {
	set lref $ref
    } else {
	set lref [string tolower $ref]
    }

    ##
    ## 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} {
	    if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
		    [string compare $manual(tail) "$name.n"] && \
                    [info exists manual(name-$name)]} {                    
		return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
	    }
	}
	if {[lsearch {stdin stdout stderr end} $lref] >= 0} {
	    # no good place to send these
	    # tcl tokens?
	    # also end
	}
	return $ref
    }
    ##
    ## would be a self reference
    ##
    foreach name $manual(name-$lref) {
	if {[lsearch $name $manual(wing-file)/$manual(name)] >= 0} {
	    return $ref
	}
    }
    ##
    ## multiple choices for reference
    ##
    if {[llength $manual(name-$lref)] > 1} {
	set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
	set tcl_ref [lindex $manual(name-$lref) $tcl_i]
	set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
	set tk_ref [lindex $manual(name-$lref) $tk_i]
	if {$tcl_i >= 0 && "$manual(wing-file)" == {TclCmd} ||  "$manual(wing-file)" == {TclLib}} {
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	if {$tk_i >= 0 && "$manual(wing-file)" == {TkCmd} || "$manual(wing-file)" == {TkLib}} {
	    return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
	}
	if {"$lref" == {exit} && "$manual(tail)" == {tclsh.1} && $tcl_i >= 0} {
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
	return $ref
    }
    ##
    ## exceptions, sigh, to the rule
    ##
    switch $manual(tail) {
	canvas.n {
	    if {$lref == {focus}} {
		upvar tail tail
		set clue [string first command $tail]
		if {$clue < 0 ||  $clue > 5} {
		    return $ref
		}
	    }
	    if {[lsearch {bitmap image text} $lref] >= 0} {
		return $ref
	    }
	}
	checkbutton.n -
	radiobutton.n {
	    if {[lsearch {image} $lref] >= 0} {