diff options
Diffstat (limited to 'tools')
| -rw-r--r-- | tools/tcltk-man2html-utils.tcl | 377 | ||||
| -rwxr-xr-x | tools/tcltk-man2html.tcl | 21 |
2 files changed, 232 insertions, 166 deletions
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl index e1a91a9..16e9a93 100644 --- a/tools/tcltk-man2html-utils.tcl +++ b/tools/tcltk-man2html-utils.tcl @@ -489,6 +489,16 @@ proc output-IP-list {context code rest} { man-puts <P> } set dl "<DL class=\"[string tolower $manual(section)]\">" + set enddl "</DL>" + if {$code eq ".IP"} { + if {[regexp {^\[[\da-f]+\]$} $rest]} { + set dl "<OL class=\"[string tolower $manual(section)]\">" + set enddl "</OL>" + } elseif {"•" eq $rest} { + set dl "<UL class=\"[string tolower $manual(section)]\">" + set enddl "</UL>" + } + } man-puts $dl lappend manual(section-toc) $dl backup-text 1 @@ -504,11 +514,12 @@ proc output-IP-list {context code rest} { output-IP-list .IP $code $rest continue } - if {$manual(section) eq "ARGUMENTS" || \ - [regexp {^\[\d+\]$} $rest]} { + if {$manual(section) eq "ARGUMENTS"} { man-puts "$para<DT>$rest<DD>" + } elseif {[regexp {^\[([\da-f]+)\]$} $rest -> value]} { + man-puts "$para<LI value=\"$value\">" } elseif {"•" eq $rest} { - man-puts "$para<DT><DD>$rest " + man-puts "$para<LI>" } else { man-puts "$para<DT>[long-toc $rest]<DD>" } @@ -542,14 +553,13 @@ proc output-IP-list {context code rest} { } elseif {[match-text @rest .RE]} { # gad, this is getting ridiculous if {!$accept_RE} { - man-puts "</DL><P>$rest<DL>" + man-puts "$enddl<P>$rest$dl" backup-text 1 set para {} break - } else { - man-puts "<P>$rest" - incr accept_RE -1 } + man-puts "<P>$rest" + incr accept_RE -1 } elseif {$accept_RE} { output-directive $line } else { @@ -574,8 +584,8 @@ proc output-IP-list {context code rest} { } set para <P> } - man-puts "$para</DL>" - lappend manual(section-toc) </DL> + man-puts "$para$enddl" + lappend manual(section-toc) $enddl if {$accept_RE} { manerror "missing .RE in output-IP-list" } @@ -611,31 +621,44 @@ proc output-name {line} { proc cross-reference {ref} { global manual remap_link_target global ensemble_commands exclude_refs_map exclude_when_followed_by_map - set lref [string tolower $ref] + set manname $manual(name) + set mantail $manual(tail) if {[string match "Tcl_*" $ref] || [string match "Tk_*" $ref]} { set lref $ref + ## + ## apply a link remapping if available + ## + if {[info exists remap_link_target($lref)]} { + set lref $remap_link_target($lref) + } } elseif {$ref eq "Tcl"} { set lref $ref } elseif { [regexp {^[A-Z0-9 ?!]+$} $ref] - && [info exists manual($manual(name)-id-$ref)] + && [info exists manual($manname-id-$ref)] } { - return "<A HREF=\"#$manual($manual(name)-id-$ref)\">$ref</A>" - } - ## - ## apply a link remapping if available - ## - if {[info exists remap_link_target($lref)]} { - set lref $remap_link_target($lref) + return "<A HREF=\"#$manual($manname-id-$ref)\">$ref</A>" + } else { + set lref [string tolower $ref] + ## + ## apply a link remapping if available + ## + if {[info exists remap_link_target($lref)]} { + set lref $remap_link_target($lref) + } } ## ## nothing to reference ## if {![info exists manual(name-$lref)]} { foreach name $ensemble_commands { - if {[regexp "^$name \[a-z0-9]*\$" $lref] && \ - [info exists manual(name-$name)] && \ - $manual(tail) ne "$name.n"} { + if { + [regexp "^$name \[a-z0-9]*\$" $lref] && + [info exists manual(name-$name)] && + $mantail ne "$name.n" && + (![info exists exclude_refs_map($mantail)] || + $manual(name-$name) ni $exclude_refs_map($mantail)) + } { return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>" } } @@ -644,43 +667,45 @@ proc cross-reference {ref} { } return $ref } + set manref $manual(name-$lref) ## ## would be a self reference ## - foreach name $manual(name-$lref) { - if {"$manual(wing-file)/$manual(name)" in $name} { + foreach name $manref { + if {"$manual(wing-file)/$manname" in $name} { 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 {[llength $manref] > 1} { + set tcl_i [lsearch -glob $manref *TclCmd*] if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd" || $manual(wing-file) eq "TclLib"} { + set tcl_ref [lindex $manref $tcl_i] return "<A HREF=\"../$tcl_ref.htm\">$ref</A>" } + set tk_i [lsearch -glob $manref *TkCmd*] if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd" || $manual(wing-file) eq "TkLib"} { + set tk_ref [lindex $manref $tk_i] return "<A HREF=\"../$tk_ref.htm\">$ref</A>" } - if {$lref eq "exit" && $manual(tail) eq "tclsh.1" && $tcl_i >= 0} { + if {$lref eq "exit" && $mantail eq "tclsh.1" && $tcl_i >= 0} { + set tcl_ref [lindex $manref $tcl_i] 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)" + puts stderr "multiple cross reference to $ref in $manref from $manual(wing-file)/$mantail" return $ref } ## ## exceptions, sigh, to the rule ## - if {[info exists exclude_when_followed_by_map($manual(tail))]} { + if {[info exists exclude_when_followed_by_map($mantail)]} { upvar 1 tail tail set following_word [lindex [regexp -inline {\S+} $tail] 0] - foreach {this that} $exclude_when_followed_by_map($manual(tail)) { + foreach {this that} $exclude_when_followed_by_map($mantail) { # only a ref if $this is not followed by $that if {$lref eq $this && [string match $that* $following_word]} { return $ref @@ -688,15 +713,15 @@ proc cross-reference {ref} { } } if { - [info exists exclude_refs_map($manual(tail))] - && $lref in $exclude_refs_map($manual(tail)) + [info exists exclude_refs_map($mantail)] + && $lref in $exclude_refs_map($mantail) } { return $ref } ## ## return the cross reference ## - return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>" + return "<A HREF=\"../$manref.htm\">$ref</A>" } ## ## reference generation errors @@ -711,148 +736,170 @@ proc reference-error {msg text} { ## proc insert-cross-references {text} { global manual - ## - ## we identify cross references by: - ## ``quotation'' - ## <B>emboldening</B> - ## Tcl_ prefix - ## Tk_ prefix - ## [a-zA-Z0-9]+ manual entry - ## and we avoid messing with already anchored text - ## - ## - ## find where each item lives - ## - array set offset [list \ - anchor [string first {<A } $text] \ - end-anchor [string first {</A>} $text] \ - quote [string first {``} $text] \ - end-quote [string first {''} $text] \ - bold [string first {<B>} $text] \ - end-bold [string first {</B>} $text] \ - tcl [string first {Tcl_} $text] \ - tk [string first {Tk_} $text] \ - Tcl1 [string first {Tcl manual entry} $text] \ - Tcl2 [string first {Tcl overview manual entry} $text] \ - ] - ## - ## accumulate a list - ## - foreach name [array names offset] { - if {$offset($name) >= 0} { - set invert($offset($name)) $name - lappend offsets $offset($name) - } - } - ## - ## if nothing, then we're done. - ## - if {![info exists offsets]} { - return $text - } - ## - ## sort the offsets - ## - set offsets [lsort -integer $offsets] - ## - ## see which we want to use - ## - switch -exact -- $invert([lindex $offsets 0]) { - anchor { - if {$offset(end-anchor) < 0} { - return [reference-error {Missing end anchor} $text] + set result "" + + while 1 { + ## + ## we identify cross references by: + ## ``quotation'' + ## <B>emboldening</B> + ## Tcl_ prefix + ## Tk_ prefix + ## [a-zA-Z0-9]+ manual entry + ## and we avoid messing with already anchored text + ## + ## + ## find where each item lives - EXPENSIVE - and accumulate a list + ## + unset -nocomplain offsets + foreach {name pattern} { + anchor {<A } end-anchor {</A>} + quote {``} end-quote {''} + bold {<B>} end-bold {</B>} + tcl {Tcl_} + tk {Tk_} + Tcl1 {Tcl manual entry} + Tcl2 {Tcl overview manual entry} + url {http://} + } { + set o [string first $pattern $text] + if {[set offset($name) $o] >= 0} { + set invert($o) $name + lappend offsets $o } - set head [string range $text 0 $offset(end-anchor)] - set tail [string range $text [expr {$offset(end-anchor)+1}] end] - return $head[insert-cross-references $tail] } - quote { - if {$offset(end-quote) < 0} { - return [reference-error "Missing end quote" $text] - } - if {$invert([lindex $offsets 1]) eq "tk"} { - set offsets [lreplace $offsets 1 1] - } - if {$invert([lindex $offsets 1]) eq "tcl"} { - set offsets [lreplace $offsets 1 1] + ## + ## if nothing, then we're done. + ## + if {![info exists offsets]} { + return [append result $text] + } + ## + ## sort the offsets + ## + set offsets [lsort -integer $offsets] + ## + ## see which we want to use + ## + switch -exact -- $invert([lindex $offsets 0]) { + anchor { + if {$offset(end-anchor) < 0} { + return [reference-error {Missing end anchor} $text] + } + append result [string range $text 0 $offset(end-anchor)] + set text [string range $text[set text ""] \ + [expr {$offset(end-anchor)+1}] end] + continue } - switch -exact -- $invert([lindex $offsets 1]) { - end-quote { - set head [string range $text 0 [expr {$offset(quote)-1}]] - set body [string range $text [expr {$offset(quote)+2}] \ - [expr {$offset(end-quote)-1}]] - set tail [string range $text \ - [expr {$offset(end-quote)+2}] end] - return "$head``[cross-reference $body]''[insert-cross-references $tail]" + quote { + if {$offset(end-quote) < 0} { + return [reference-error "Missing end quote" $text] } - bold - - anchor { - set head [string range $text \ - 0 [expr {$offset(end-quote)+1}]] - set tail [string range $text \ - [expr {$offset(end-quote)+2}] end] - return "$head[insert-cross-references $tail]" + if {$invert([lindex $offsets 1]) in {tcl tk}} { + set offsets [lreplace $offsets 1 1] } + switch -exact -- $invert([lindex $offsets 1]) { + end-quote { + append result [string range $text 0 [expr {$offset(quote)-1}]] + set body [string range $text [expr {$offset(quote)+2}] \ + [expr {$offset(end-quote)-1}]] + set text [string range $text[set text ""] \ + [expr {$offset(end-quote)+2}] end] + set tail $text + append result `` [cross-reference $body] '' + continue + } + bold - + anchor { + append result [string range $text \ + 0 [expr {$offset(end-quote)+1}]] + set text [string range $text[set text ""] \ + [expr {$offset(end-quote)+2}] end] + continue + } + } + return [reference-error "Uncaught quote case" $text] } - return [reference-error "Uncaught quote case" $text] - } - bold { - if {$offset(end-bold) < 0} { - return $text - } - if {$invert([lindex $offsets 1]) eq "tk"} { - set offsets [lreplace $offsets 1 1] - } - if {$invert([lindex $offsets 1]) eq "tcl"} { - set offsets [lreplace $offsets 1 1] + bold { + if {$offset(end-bold) < 0} { + return [append result $text] + } + if {$invert([lindex $offsets 1]) in {tcl tk}} { + set offsets [lreplace $offsets 1 1] + } + switch -exact -- $invert([lindex $offsets 1]) { + url - end-bold { + append result \ + [string range $text 0 [expr {$offset(bold)-1}]] + set body [string range $text [expr {$offset(bold)+3}] \ + [expr {$offset(end-bold)-1}]] + set text [string range $text[set text ""] \ + [expr {$offset(end-bold)+4}] end] + set tail $text + regsub {http://[\w/.]+} $body {<A HREF="&">&</A>} body + append result <B> [cross-reference $body] </B> + continue + } + anchor { + append result \ + [string range $text 0 [expr {$offset(end-bold)+3}]] + set text [string range $text[set text ""] \ + [expr {$offset(end-bold)+4}] end] + continue + } + default { + return [reference-error "Uncaught bold case" $text] + } + } } - switch -exact -- $invert([lindex $offsets 1]) { - end-bold { - set head [string range $text 0 [expr {$offset(bold)-1}]] - set body [string range $text [expr {$offset(bold)+3}] \ - [expr {$offset(end-bold)-1}]] - set tail [string range $text \ - [expr {$offset(end-bold)+4}] end] - return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]" + tk { + append result [string range $text 0 [expr {$offset(tk)-1}]] + if {![regexp -indices -start $offset(tk) {Tk_\w+} $text range]} { + return [reference-error "Tk regexp failed" $text] } - anchor { - set head [string range $text \ - 0 [expr {$offset(end-bold)+3}]] - set tail [string range $text \ - [expr {$offset(end-bold)+4}] end] - return "$head[insert-cross-references $tail]" + set body [string range $text {*}$range] + set text [string range $text[set text ""] \ + [expr {[lindex $range 1]+1}] end] + set tail $text + append result [cross-reference $body] + continue + } + tcl { + append result [string range $text 0 [expr {$offset(tcl)-1}]] + if {![regexp -indices -start $offset(tcl) {Tcl_\w+} $text range]} { + return [reference-error "Tcl regexp failed" $text] } + set body [string range $text {*}$range] + set text [string range $text[set text ""] \ + [expr {[lindex $range 1]+1}] end] + set tail $text + append result [cross-reference $body] + continue } - return [reference-error "Uncaught bold case" $text] - } - tk { - set head [string range $text 0 [expr {$offset(tk)-1}]] - set tail [string range $text $offset(tk) end] - if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} { - return [reference-error "Tk regexp failed" $text] + Tcl1 - + Tcl2 { + set off [lindex $offsets 0] + append result [string range $text 0 [expr {$off-1}]] + set text [string range $text[set text ""] [expr {$off+3}] end] + set tail $text + append result [cross-reference Tcl] + continue } - return $head[cross-reference $body][insert-cross-references $tail] - } - tcl { - set head [string range $text 0 [expr {$offset(tcl)-1}]] - set tail [string range $text $offset(tcl) end] - if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} { - return [reference-error {Tcl regexp failed} $text] + url { + set off [lindex $offsets 0] + append result [string range $text 0 [expr {$off-1}]] + regexp -indices -start $off {http://[\w/.]+} $text range + set url [string range $text {*}$range] + append result "<A HREF=\"$url\">" $url "</A>" + set text [string range $text[set text ""] \ + [expr {[lindex $range 1]+1}] end] + continue + } + end-anchor - + end-bold - + end-quote { + return [reference-error "Out of place $invert([lindex $offsets 0])" $text] } - return $head[cross-reference $body][insert-cross-references $tail] - } - Tcl1 - - Tcl2 { - set off [lindex $offsets 0] - set head [string range $text 0 [expr {$off-1}]] - set body Tcl - set tail [string range $text [expr {$off+3}] end] - return $head[cross-reference $body][insert-cross-references $tail] - } - end-anchor - - end-bold - - end-quote { - return [reference-error "Out of place $invert([lindex $offsets 0])" $text] } } } diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index c528153..33d9ff9 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -810,11 +810,27 @@ array set remap_link_target { stdin Tcl_GetStdChannel stdout Tcl_GetStdChannel stderr Tcl_GetStdChannel - safe {Safe Base} 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 } array set exclude_refs_map { + bind.n {button destroy option} clock.n {next} history.n {exec} next.n {unknown} @@ -822,13 +838,16 @@ array set exclude_refs_map { canvas.n {bitmap text} checkbutton.n {image} clipboard.n {string} + interp.n {time} menu.n {checkbutton radiobutton} options.n {bitmap image set} radiobutton.n {image} + safe.n {join split} scrollbar.n {set} selection.n {string} tcltest.n {error} tkvars.n {tk} + tm.n {exec} ttk_checkbutton.n {variable} ttk_combobox.n {selection} ttk_entry.n {focus variable} |