📄 tcltk-man2html.tcl
字号:
}#### foreach of the man directories specified by args## convert manpages into hypertext in the directory## specified by html.##proc make-man-pages {html args} { global env manual overall_title makedirhier $html set manual(short-toc-n) 1 set manual(short-toc-fp) [open $html/contents.htm w] puts $manual(short-toc-fp) "<HTML><HEAD><TITLE>$overall_title</TITLE></HEAD>" puts $manual(short-toc-fp) "<BODY><HR><H3>$overall_title</H3><HR><DL>" set manual(merge-copyrights) {} foreach arg $args { set manual(wing-glob) [lindex $arg 0] set manual(wing-name) [lindex $arg 1] set manual(wing-file) [lindex $arg 2] set manual(wing-description) [lindex $arg 3] set manual(wing-copyrights) {} makedirhier $html/$manual(wing-file) set manual(wing-toc-fp) [open $html/$manual(wing-file)/contents.htm w] # whistle puts stderr "scanning section $manual(wing-name)" # put the entry for this section into the short table of contents puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/contents.htm\">$manual(wing-name)</A><DD>$manual(wing-description)" # initialize the wing table of contents puts $manual(wing-toc-fp) "<HTML><HEAD><TITLE>$manual(wing-name) Manual</TITLE></HEAD>" puts $manual(wing-toc-fp) "<BODY><HR><H3>$manual(wing-name)</H3><HR>" # initialize the short table of contents for this section set manual(wing-toc) {} # initialize the man directory for this section makedirhier $html/$manual(wing-file) # initialize the long table of contents for this section set manual(long-toc-n) 1 # get the manual pages for this section set manual(pages) [lsort [glob $manual(wing-glob)]] if {[lsearch -glob $manual(pages) */options.n] >= 0} { set n [lsearch $manual(pages) */options.n] set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]" } # set manual(pages) [lrange $manual(pages) 0 5] foreach manual(page) $manual(pages) { # whistle puts stderr "scanning page $manual(page)" set manual(tail) [file tail $manual(page)] set manual(name) [file root $manual(tail)] set manual(section) {} if {[lsearch {case pack-old menubar} $manual(name)] >= 0} { # obsolete manerror "discarding $manual(name)" continue } set manual(infp) [open $manual(page)] set manual(text) {} set manual(partial-text) {} foreach p {.RS .DS .CS .SO} { set manual($p) 0 } set manual(stack) {} set manual(section) {} set manual(section-toc) {} set manual(section-toc-n) 1 set manual(copyrights) {} lappend manual(all-pages) $manual(wing-file)/$manual(tail) manreport 100 $manual(name) while {[gets $manual(infp) line] >= 0} { manreport 100 $line if {[regexp {^[`'][/\\]} $line]} { if {[regexp {Copyright \(c\).*$} $line copyright]} { lappend manual(copyrights) $copyright } # comment continue } if {"$line" == {'}} { # comment continue } if {[parse-directive $line code rest]} { switch -exact $code { .ad - .na - .so - .ne - .AS - .VE - .VS - . { # ignore continue } } if {"$manual(partial-text)" != {}} { lappend manual(text) [process-text $manual(partial-text)] set manual(partial-text) {} } switch -exact $code { .SH { if {[llength $rest] == 0} { gets $manual(infp) rest } lappend manual(text) ".SH [unquote $rest]" } .TH { lappend manual(text) "$code [unquote $rest]" } .HS - .UL - .ta { lappend manual(text) "$code [unquote $rest]" } .BS - .BE - .br - .fi - .sp - .nf { if {"$rest" != {}} { manerror "unexpected argument: $line" } lappend manual(text) $code } .AP { lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]] } .IP { regexp {^(.*) +\d+$} $rest all rest lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]" } .TP { set next [gets $manual(infp)] if {"$next" != {'}} { lappend manual(text) ".IP [process-text $next]" } } .OP { lappend manual(text) [concat .OP [process-text \ "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]] } .PP - .LP { lappend manual(text) {.PP} } .RS { incr manual(.RS) lappend manual(text) $code } .RE { incr manual(.RS) -1 lappend manual(text) $code } .SO { incr manual(.SO) lappend manual(text) $code } .SE { incr manual(.SO) -1 lappend manual(text) $code } .DS { incr manual(.DS) lappend manual(text) $code } .DE { incr manual(.DS) -1 lappend manual(text) $code } .CS { incr manual(.CS) lappend manual(text) $code } .CE { incr manual(.CS) -1 lappend manual(text) $code } .de { while {[gets $manual(infp) line] >= 0} { if {[string match "..*" $line]} { break } } } .. { error "found .. outside of .de" } default { manerror "unrecognized format directive: $line" } } } else { if {$manual(partial-text) == ""} { set manual(partial-text) $line } else { append manual(partial-text) \n$line } } } if {$manual(partial-text) != ""} { lappend manual(text) [process-text $manual(partial-text)] } close $manual(infp) # fixups if {$manual(.RS) != 0} { if {$manual(name) != "selection"} { puts "unbalanced .RS .RE" } } if {$manual(.DS) != 0} { puts "unbalanced .DS .DE" } if {$manual(.CS) != 0} { puts "unbalanced .CS .CE" } if {$manual(.SO) != 0} { puts "unbalanced .SO .SE" } # output conversion open-text if {[next-op-is .HS rest]} { set manual($manual(name)-title) \ "[lrange $rest 1 end] [lindex $rest 0] manual page" while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { output-directive $line } else { man-puts $line } } man-puts <HR><PRE> foreach copyright $manual(copyrights) { man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" } man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>" set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)] } elseif {[next-op-is .TH rest]} { set manual($manual(name)-title) "[lrange $rest 4 end] - [lindex $rest 0] manual page" while {[more-text]} { set line [next-text] if {[is-a-directive $line]} { output-directive $line } else { man-puts $line } } man-puts <HR><PRE> foreach copyright $manual(copyrights) { man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" } man-puts "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr.</PRE>" set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)] } else { manerror "no .HS or .TH record found" } # # make the long table of contents for this page # set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL><HR>] } # # make the wing table of contents for the section # set width 0 foreach name $manual(wing-toc) { if {[string length $name] > $width} { set width [string length $name] } } set perline [expr {120 / $width}] set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}] set n 0 catch {unset rows} foreach name [lsort $manual(wing-toc)] { set tail $manual(name-$name) if {[llength $tail] > 1} { manerror "$name is defined in more than one file: $tail" set tail [lindex $tail [expr {[llength $tail]-1}]] } set tail [file tail $tail] append rows([expr {$n%$nrows}]) \ "<td> <a href=\"$tail.htm\">$name</a>" incr n } puts $manual(wing-toc-fp) <table> foreach row [lsort -integer [array names rows]] { puts $manual(wing-toc-fp) <tr>$rows($row)</tr> } puts $manual(wing-toc-fp) </table> # # insert wing copyrights # puts $manual(wing-toc-fp) "<HR><PRE>" foreach copyright $manual(wing-copyrights) { puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" } puts $manual(wing-toc-fp) "<A HREF=\"../copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." puts $manual(wing-toc-fp) "</PRE></BODY></HTML>" close $manual(wing-toc-fp) set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)] } ## ## build the keyword index. ## proc strcasecmp {a b} { return [string compare -nocase $a $b] } set keys [lsort -command strcasecmp [array names manual keyword-*]] makedirhier $html/Keywords catch {eval file delete -- [glob $html/Keywords/*]} puts $manual(short-toc-fp) {<DT><A HREF="Keywords/contents.htm">Keywords</A><DD>The keywords from the Tcl/Tk man pages.} set keyfp [open $html/Keywords/contents.htm w] puts $keyfp "<HTML><HEAD><TITLE>Tcl/Tk Keywords</TITLE></HEAD>" puts $keyfp "<BODY><HR><H3>Tcl/Tk Keywords</H3><HR><H2>" foreach a {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} { puts $keyfp "<A HREF=\"$a.htm\">$a</A>" set afp [open $html/Keywords/$a.htm w] puts $afp "<HTML><HEAD><TITLE>Tcl/Tk Keywords - $a</TITLE></HEAD>" puts $afp "<BODY><HR><H3>Tcl/Tk Keywords - $a</H3><HR><H2>" foreach b {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} { puts $afp "<A HREF=\"$b.htm\">$b</A>" } puts $afp "</H2><HR><DL>" foreach k $keys { if {[regexp -nocase -- "^keyword-$a" $k]} { set k [string range $k 8 end] puts $afp "<DT><A NAME=\"$k\">$k</A><DD>" set refs {} foreach man $manual(keyword-$k) { set name [lindex $man 0] set file [lindex $man 1] lappend refs "<A HREF=\"../$file\">$name</A>" } puts $afp [join $refs {, }] } } puts $afp "</DL><HR><PRE>" # insert merged copyrights foreach copyright $manual(merge-copyrights) { puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" } puts $afp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." puts $afp "</PRE></BODY></HTML>" close $afp } puts $keyfp "</H2><HR><PRE>" # insert merged copyrights foreach copyright $manual(merge-copyrights) { puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" } puts $keyfp "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." puts $keyfp </PRE><HR></BODY></HTML> close $keyfp ## ## finish off short table of contents ## puts $manual(short-toc-fp) {<DT><A HREF="http://www.elf.org">Source</A><DD>More information about these man pages.} puts $manual(short-toc-fp) "</DL><HR><PRE>" # insert merged copyrights foreach copyright $manual(merge-copyrights) { puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © [lrange $copyright 2 end]" } puts $manual(short-toc-fp) "<A HREF=\"copyright.htm\">Copyright</A> © 1995-1997 Roger E. Critchlow Jr." puts $manual(short-toc-fp) "</PRE></BODY></HTML>" close $manual(short-toc-fp) ## ## output man pages ## unset manual(section) foreach path $manual(all-pages) { set manual(wing-file) [file dirname $path] set manual(tail) [file tail $path] set manual(name) [file root $manual(tail)] set text $manual(output-$manual(wing-file)-$manual(name)) set ntext 0 foreach item $text { incr ntext [llength [split $item \n]] incr ntext } set toc $manual(toc-$manual(wing-file)-$manual(name)) set ntoc 0 foreach item $toc { incr ntoc [llength [split $item \n]] incr ntoc } puts stderr "rescanning page $manual(name) $ntoc/$ntext" set manual(outfp) [open $html/$manual(wing-file)/$manual(name).htm w] puts $manual(outfp) "<HTML><HEAD><TITLE>$manual($manual(name)-title)</TITLE></HEAD><BODY>" if {($ntext > 60) && ($ntoc > 32) || [lsearch { Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash GetJustify GetPixels GetVisual ParseArgv QueueEvent } $manual(tail)] >= 0} { foreach item $toc { puts $manual(outfp) $item } } foreach item $text { puts $manual(outfp) [insert-cross-references $item] } puts $manual(outfp) </BODY></HTML> close $manual(outfp) } return {}}set usercmddesc {The interpreters which implement Tcl and Tk.}set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.}set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.}set tcllibdesc {The C functions which a Tcl extended C program may use.}set tklibdesc {The additional C functions which a Tk extended C program may use.} parse_command_lineif {1} { if {[catch { make-man-pages $webdir \ "$tcltkdir/{$tkdir,$tcldir}/doc/*.1 {Tcl/Tk Applications} UserCmd {$usercmddesc}" \ "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" \ "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" \ "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" \ "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" } error]} { puts $error\n$errorInfo }}⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -