diff options
Diffstat (limited to 'tools')
| -rw-r--r-- | tools/README | 3 | ||||
| -rwxr-xr-x[-rw-r--r--] | tools/checkLibraryDoc.tcl | 28 | ||||
| -rwxr-xr-x[-rw-r--r--] | tools/configure | 2 | ||||
| -rw-r--r-- | tools/configure.in | 4 | ||||
| -rw-r--r-- | tools/eolFix.tcl | 18 | ||||
| -rwxr-xr-x | tools/fix_tommath_h.tcl | 8 | ||||
| -rw-r--r-- | tools/genStubs.tcl | 100 | ||||
| -rw-r--r-- | tools/index.tcl | 10 | ||||
| -rw-r--r-- | tools/man2help2.tcl | 34 | ||||
| -rw-r--r-- | tools/regexpTestLib.tcl | 30 | ||||
| -rw-r--r-- | tools/str2c | 4 | ||||
| -rw-r--r-- | tools/tcl.hpj.in | 4 | ||||
| -rw-r--r-- | tools/tcl.wse.in | 2376 | ||||
| -rw-r--r-- | tools/tclSplash.bmp | bin | 162030 -> 0 bytes | |||
| -rwxr-xr-x | tools/tclZIC.tcl | 10 | ||||
| -rw-r--r-- | tools/tclmin.wse | 247 | ||||
| -rw-r--r-- | tools/tclsh.svg | 67 | ||||
| -rw-r--r-- | tools/tcltk-man2html-utils.tcl | 1629 | ||||
| -rwxr-xr-x | tools/tcltk-man2html.tcl | 2216 | ||||
| -rw-r--r-- | tools/tsdPerf.c | 59 | ||||
| -rw-r--r-- | tools/tsdPerf.tcl | 24 |
21 files changed, 2416 insertions, 4457 deletions
diff --git a/tools/README b/tools/README index 821b2b3..f4bf627 100644 --- a/tools/README +++ b/tools/README @@ -23,6 +23,3 @@ Generating Windows Help Files: this converts the Nroff to RTF files. 2) On Windows, convert the RTF to a Help doc, do nmake helpfile - -Generating Windows binary distribution. -Update and compile the WYSE tcl.wse configuration. diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl index cd08c2a..6d147ac 100644..100755 --- a/tools/checkLibraryDoc.tcl +++ b/tools/checkLibraryDoc.tcl @@ -1,7 +1,7 @@ # checkLibraryDoc.tcl -- # -# This script attempts to determine what APIs exist in the source base that -# have not been documented. By grepping through all of the doc/*.3 man +# This script attempts to determine what APIs exist in the source base that +# have not been documented. By grepping through all of the doc/*.3 man # pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list # against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch]) # we create six lists: @@ -11,10 +11,10 @@ # 4) Misc APIs and structs that we are not documenting. # 5) Command APIs (e.g., Tcl_ArrayObjCmd.) # 6) Proc pointers (e.g., Tcl_CloseProc.) -# +# # Note: Each list is "a best guess" approximation. If developers write # non-standard code, this script will produce erroneous results. Each -# list should be carefully checked for accuracy. +# list should be carefully checked for accuracy. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. @@ -86,7 +86,7 @@ set StructList { Tk_Window \ } -# Misc junk that appears in the comments of the source. This just +# Misc junk that appears in the comments of the source. This just # allows us to filter comments that "fool" the script. set CommentList { @@ -99,8 +99,8 @@ set CommentList { # Main entry point to this script. proc main {} { - global argv0 - global argv + global argv0 + global argv set len [llength $argv] if {($len != 2) && ($len != 3)} { @@ -121,12 +121,12 @@ proc main {} { foreach {c d} [compare [grepCode $dir $pkg] [grepDocs $dir $pkg]] {} filter $c $d $dir $pkg $file - if {$file != "stdout"} { + if {$file ne "stdout"} { close $file } return } - + # Intersect the two list and write out the sets of APIs in one # list that is not in the other. @@ -145,7 +145,7 @@ proc filter {code docs dir pkg {outFile stdout}} { # This list should just be verified for accuracy. set cmds {} - + # A list of proc pointer structs. These are not documented. # This list should just be verified for accuracy. @@ -162,7 +162,7 @@ proc filter {code docs dir pkg {outFile stdout}} { set misc [grepMisc $dir $pkg] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" - + # A list of APIs in the source, not in the docs. # This list should just be verified for accuracy. @@ -196,7 +196,7 @@ proc filter {code docs dir pkg {outFile stdout}} { # Print the list of APIs if the list is not null. proc dump {list title file} { - if {$list != {}} { + if {$list ne ""} { puts $file "" puts $file $title puts $file "---------------------------------------------------------" @@ -240,7 +240,7 @@ proc grepDocs {dir pkg} { # (e.g., Tcl_Export). Return a list of APIs. proc grepDecl {dir pkg} { - set file [file join $dir generic "[string tolower $pkg]IntDecls.h"] + set file [file join $dir generic "[string tolower $pkg]IntDecls.h"] set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_.*" $file] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" @@ -258,7 +258,7 @@ proc grepDecl {dir pkg} { proc grepMisc {dir pkg} { global CommentList global StructList - + set apis [myGrep "^EXTERN.*\[ \t\]${pkg}_Db.*" "${dir}/\*/\*\.\[ch\]"] set pat1 ".*(${pkg}_\[A-z0-9]+).*$" diff --git a/tools/configure b/tools/configure index 98b5867..3d30039 100644..100755 --- a/tools/configure +++ b/tools/configure @@ -1229,7 +1229,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.5 +DEF_VER=8.6 # Check whether --with-tcl or --without-tcl was given. diff --git a/tools/configure.in b/tools/configure.in index 542c1d3..6aebcaa 100644 --- a/tools/configure.in +++ b/tools/configure.in @@ -2,7 +2,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run to configure the dnl Makefile in this directory. AC_INIT(man2tcl.c) -AC_PREREQ(2.57) +AC_PREREQ(2.59) # Recover information that Tcl computed with its configure script. @@ -11,7 +11,7 @@ AC_PREREQ(2.57) # not, assume that its top-level directory is a sibling of ours. #-------------------------------------------------------------------- -DEF_VER=8.5 +DEF_VER=8.6 AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`) if test ! -d $TCL_BIN_DIR; then diff --git a/tools/eolFix.tcl b/tools/eolFix.tcl index ed3ec7c..3f35ed4 100644 --- a/tools/eolFix.tcl +++ b/tools/eolFix.tcl @@ -13,16 +13,18 @@ namespace eval ::EOL { variable outMode crlf } -proc EOL::fix {filename {newfilename ""}} { +proc EOL::fix {filename {newfilename {}}} { variable outMode - if {![file exists $filename]} { return } + if {![file exists $filename]} { + return + } puts "EOL Fixing: $filename" file rename ${filename} ${filename}.o set fhnd [open ${filename}.o r] - if {$newfilename != ""} { + if {$newfilename ne ""} { set newfhnd [open ${newfilename} w] } else { set newfhnd [open ${filename} w] @@ -63,12 +65,12 @@ proc EOL::fixall {args} { } if {$tcl_interactive == 0 && $argc > 0} { - if {[string index [lindex $argv 0] 0] == "-"} { + if {[string index [lindex $argv 0] 0] eq "-"} { switch -- [lindex $argv 0] { - -cr { set ::EOL::outMode cr } - -crlf { set ::EOL::outMode crlf } - -lf { set ::EOL::outMode lf } - default { puts stderr "improper mode switch" ; exit 1 } + -cr {set ::EOL::outMode cr} + -crlf {set ::EOL::outMode crlf} + -lf {set ::EOL::outMode lf} + default {puts stderr "improper mode switch"; exit 1} } set argv [lrange $argv 1 end] } diff --git a/tools/fix_tommath_h.tcl b/tools/fix_tommath_h.tcl index f92b7ac..04bf857 100755 --- a/tools/fix_tommath_h.tcl +++ b/tools/fix_tommath_h.tcl @@ -17,12 +17,13 @@ set eat_endif 0 set eat_semi 0 set def_count 0 foreach line [split $data \n] { - if { !$eat_semi && !$eat_endif } { + if {!$eat_semi && !$eat_endif} { switch -regexp -- $line { {#define BN_H_} { puts $line puts {} - puts "\#include <tclTomMathDecls.h>" + puts "\#include \"tclInt.h\"" + puts "\#include \"tclTomMathDecls.h\"" puts "\#ifndef MODULE_SCOPE" puts "\#define MODULE_SCOPE extern" puts "\#endif" @@ -76,6 +77,9 @@ foreach line [split $data \n] { puts "[string map {__x86_64__ NEVER} $line]\ /* 128-bit ints fail in too many places */" } + {#include} { + # remove all includes + } default { puts $line } diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 37205b2..7a75dc6 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -190,13 +190,11 @@ proc genStubs::declare {args} { puts stderr "Duplicate entry: declare $args" } } - regsub -all const $decl CONST decl - regsub -all _XCONST $decl _Xconst decl regsub -all "\[ \t\n\]+" [string trim $decl] " " decl set decl [parseDecl $decl] foreach platform $platformList { - if {$decl != ""} { + if {$decl ne ""} { set stubs($curName,$platform,$index) $decl if {![info exists stubs($curName,$platform,lastNum)] \ || ($index > $stubs($curName,$platform,lastNum))} { @@ -285,7 +283,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { set text "" switch $plat { win { - append text "#if defined(__WIN32__)" + append text "#if defined(_WIN32)" if {$withCygwin} { append text " || defined(__CYGWIN__)" } @@ -296,7 +294,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { append text "#endif /* WIN */\n" } unix { - append text "#if !defined(__WIN32__)" + append text "#if !defined(_WIN32)" if {$withCygwin} { append text " && !defined(__CYGWIN__)" } @@ -322,7 +320,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { append text "#endif /* AQUA */\n" } x11 { - append text "#if !(defined(__WIN32__)" + append text "#if !(defined(_WIN32)" if {$withCygwin} { append text " || defined(__CYGWIN__)" } @@ -356,7 +354,7 @@ proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} { proc genStubs::emitSlots {name textVar} { upvar $textVar text - forAllStubs $name makeSlot 1 text {" VOID *reserved$i;\n"} + forAllStubs $name makeSlot 1 text {" void (*reserved$i)(void);\n"} return } @@ -384,7 +382,7 @@ proc genStubs::parseDecl {decl} { return } set rtype [string trim $rtype] - if {$args == ""} { + if {$args eq ""} { return [list $rtype $fname {}] } foreach arg [split $args ,] { @@ -432,14 +430,14 @@ proc genStubs::parseDecl {decl} { proc genStubs::parseArg {arg} { if {![regexp {^(.+[ ][*]*)([^][ *]+)(\[\])?$} $arg all type name array]} { - if {$arg == "void"} { + if {$arg eq "void"} { return $arg } else { return } } set result [list [string trim $type] $name] - if {$array != ""} { + if {$array ne ""} { lappend result $array } return $result @@ -462,9 +460,6 @@ proc genStubs::makeDecl {name decl index} { lassign $decl rtype fname args append text "/* $index */\n" - if {$rtype != "void"} { - regsub -all void $rtype VOID rtype - } set line "$scspec $rtype" set count [expr {2 - ([string length $line] / 8)}] append line [string range "\t\t\t" 0 $count] @@ -481,10 +476,9 @@ proc genStubs::makeDecl {name decl index} { } append line $fname - regsub -all void $args VOID args set arg1 [lindex $args 0] switch -exact $arg1 { - VOID { + void { append line "(void)" } TCL_VARARGS { @@ -507,6 +501,9 @@ proc genStubs::makeDecl {name decl index} { set sep ", " } append line ", ...)" + if {[lindex $args end] eq "{const char *} format"} { + append line " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")" + } } default { set sep "(" @@ -530,9 +527,7 @@ proc genStubs::makeDecl {name decl index} { append line ")" } } - append text $line ";" - format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \ - $fname $fname $text + return "$text$line;\n" } # genStubs::makeMacro -- @@ -553,12 +548,12 @@ proc genStubs::makeMacro {name decl index} { set lfname [string tolower [string index $fname 0]] append lfname [string range $fname 1 end] - set text "#ifndef $fname\n#define $fname \\\n\t(" - if {$args == ""} { + set text "#define $fname \\\n\t(" + if {$args eq ""} { append text "*" } append text "${name}StubsPtr->$lfname)" - append text " /* $index */\n#endif\n" + append text " /* $index */\n" return $text } @@ -581,22 +576,18 @@ proc genStubs::makeSlot {name decl index} { append lfname [string range $fname 1 end] set text " " - if {$args == ""} { + if {$args eq ""} { append text $rtype " *" $lfname "; /* $index */\n" return $text } - if {$rtype ne "void"} { - regsub -all void $rtype VOID rtype - } - if {[string range $rtype end-8 end] == "__stdcall"} { + if {[string range $rtype end-8 end] eq "__stdcall"} { append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " } else { append text $rtype " (*" $lfname ") " } - regsub -all void $args VOID args set arg1 [lindex $args 0] switch -exact $arg1 { - VOID { + void { append text "(void)" } TCL_VARARGS { @@ -610,6 +601,9 @@ proc genStubs::makeSlot {name decl index} { set sep ", " } append text ", ...)" + if {[lindex $args end] eq "{const char *} format"} { + append text " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")" + } } default { set sep "(" @@ -642,7 +636,7 @@ proc genStubs::makeSlot {name decl index} { # Returns the formatted declaration string. proc genStubs::makeInit {name decl index} { - if {[lindex $decl 2] == ""} { + if {[lindex $decl 2] eq ""} { append text " &" [lindex $decl 1] ", /* " $index " */\n" } else { append text " " [lindex $decl 1] ", /* " $index " */\n" @@ -953,14 +947,12 @@ proc genStubs::emitMacros {name textVar} { upvar $textVar text set upName [string toupper $libraryName] - append text "\n#if defined(USE_${upName}_STUBS) &&\ - !defined(USE_${upName}_STUB_PROCS)\n" + append text "\n#if defined(USE_${upName}_STUBS)\n" append text "\n/*\n * Inline function declarations:\n */\n\n" forAllStubs $name makeMacro 0 text - append text "\n#endif /* defined(USE_${upName}_STUBS) &&\ - !defined(USE_${upName}_STUB_PROCS) */\n" + append text "\n#endif /* defined(USE_${upName}_STUBS) */\n" return } @@ -984,7 +976,7 @@ proc genStubs::emitHeader {name} { set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] - if {$epoch != ""} { + if {$epoch ne ""} { set CAPName [string toupper $name] append text "\n" append text "#define ${CAPName}_STUBS_EPOCH $epoch\n" @@ -996,27 +988,31 @@ proc genStubs::emitHeader {name} { emitDeclarations $name text if {[info exists hooks($name)]} { - append text "\ntypedef struct ${capName}StubHooks {\n" + append text "\ntypedef struct {\n" foreach hook $hooks($name) { set capHook [string toupper [string index $hook 0]] append capHook [string range $hook 1 end] - append text " struct ${capHook}Stubs *${hook}Stubs;\n" + append text " const struct ${capHook}Stubs *${hook}Stubs;\n" } append text "} ${capName}StubHooks;\n" } append text "\ntypedef struct ${capName}Stubs {\n" append text " int magic;\n" - if {$epoch != ""} { + if {$epoch ne ""} { append text " int epoch;\n" append text " int revision;\n" } - append text " struct ${capName}StubHooks *hooks;\n\n" + if {[info exists hooks($name)]} { + append text " const ${capName}StubHooks *hooks;\n\n" + } else { + append text " void *hooks;\n\n" + } emitSlots $name text append text "} ${capName}Stubs;\n\n" - append text "extern ${capName}Stubs *${name}StubsPtr;\n\n" + append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n" append text "#ifdef __cplusplus\n}\n#endif\n" emitMacros $name text @@ -1038,14 +1034,16 @@ proc genStubs::emitHeader {name} { proc genStubs::emitInit {name textVar} { variable hooks + variable interfaces variable epoch upvar $textVar text + set root 1 set capName [string toupper [string index $name 0]] append capName [string range $name 1 end] if {[info exists hooks($name)]} { - append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n" + append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n" set sep " " foreach sub $hooks($name) { append text $sep "&${sub}Stubs" @@ -1053,9 +1051,21 @@ proc genStubs::emitInit {name textVar} { } append text "\n\};\n" } - append text "\n${capName}Stubs ${name}Stubs = \{\n" - append text " TCL_STUB_MAGIC,\n" - if {$epoch != ""} { + foreach intf [array names interfaces] { + if {[info exists hooks($intf)]} { + if {[lsearch -exact $hooks($intf) $name] >= 0} { + set root 0 + break + } + } + } + + append text "\n" + if {!$root} { + append text "static " + } + append text "const ${capName}Stubs ${name}Stubs = \{\n TCL_STUB_MAGIC,\n" + if {$epoch ne ""} { set CAPName [string toupper $name] append text " ${CAPName}_STUBS_EPOCH,\n" append text " ${CAPName}_STUBS_REVISION,\n" @@ -1063,10 +1073,10 @@ proc genStubs::emitInit {name textVar} { if {[info exists hooks($name)]} { append text " &${name}StubHooks,\n" } else { - append text " NULL,\n" + append text " 0,\n" } - forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"} + forAllStubs $name makeInit 1 text {" 0, /* $i */\n"} append text "\};\n" return diff --git a/tools/index.tcl b/tools/index.tcl index 7b11e3f..71329c2 100644 --- a/tools/index.tcl +++ b/tools/index.tcl @@ -12,7 +12,7 @@ # Global variables used by these scripts: # # state - state variable that controls action of text proc. -# +# # topics - array indexed by (package,section,topic) with value # of topic ID. # @@ -135,7 +135,7 @@ proc macro {name args} { switch $args { NAME { - if {$state == "INIT" } { + if {$state eq "INIT" } { set state NAME } } @@ -144,7 +144,7 @@ proc macro {name args} { KEYWORDS {set state KEY} default {set state OFF} } - + } TH { global state curID curPkg curSect topics keywords @@ -176,7 +176,7 @@ proc macro {name args} { proc dash {} { global state - if {$state == "NAME"} { + if {$state eq "NAME"} { set state DASH } } @@ -185,7 +185,7 @@ proc dash {} { # initGlobals, tab, font, char, macro2 -- # -# These procedures do nothing during the first pass. +# These procedures do nothing during the first pass. # # Arguments: # None. diff --git a/tools/man2help2.tcl b/tools/man2help2.tcl index 75f4249..9c8f503 100644 --- a/tools/man2help2.tcl +++ b/tools/man2help2.tcl @@ -12,7 +12,7 @@ # Global variables used by these scripts: # # state - state variable that controls action of text proc. -# +# # topics - array indexed by (package,section,topic) with value # of topic ID. # @@ -176,12 +176,12 @@ proc text {string} { } switch $state(textState) { - REF { + REF { if {$state(inTP) == 0} { set string [insertRef $string] } } - SEE { + SEE { global topics curPkg curSect foreach i [split $string] { if {![regexp -nocase {^[a-z_0-9]+} [string trim $i] i ]} { @@ -231,7 +231,7 @@ proc insertRef {string} { } } - if {($ref != {}) && ($ref != $curID)} { + if {($ref != "") && ($ref != $curID)} { set string [link $string $ref] } return $string @@ -273,7 +273,7 @@ proc macro {name args} { # next page and previous page } br { - lineBreak + lineBreak } BS {} BE {} @@ -388,12 +388,12 @@ proc macro {name args} { set state(noFill) 1 } so { - if {$args != "man.macros"} { + if {$args ne "man.macros"} { puts stderr "Unknown macro: .$name [join $args " "]" } } sp { ;# needs work - if {$args == ""} { + if {$args eq ""} { set count 1 } else { set count [lindex $args 0] @@ -472,14 +472,14 @@ proc font {type} { P - R { endFont - if {$state(textState) == "REF"} { + if {$state(textState) eq "REF"} { set state(textState) INSERT } } C - B { beginFont Code - if {$state(textState) == "INSERT"} { + if {$state(textState) eq "INSERT"} { set state(textState) REF } } @@ -507,7 +507,7 @@ proc font {type} { proc formattedText {text} { global chars - while {$text != ""} { + while {$text ne ""} { set index [string first \\ $text] if {$index < 0} { text $text @@ -709,11 +709,15 @@ proc char {name} { textSetup puts -nonewline $file "\\'a9 " } + {\(mi} { + textSetup + puts -nonewline $file "-" + } {\(mu} { textSetup puts -nonewline $file "\\'d7 " } - {\(em} { + {\(em} - {\(en} { textSetup puts -nonewline $file "-" } @@ -760,7 +764,7 @@ proc SHmacro {argList {style section}} { } # control what the text proc does with text - + switch $args { NAME {set state(textState) NAME} DESCRIPTION {set state(textState) INSERT} @@ -885,7 +889,7 @@ proc THmacro {argList} { set curVer [lindex $argList 2] ;# 7.4 set curPkg [lindex $argList 3] ;# Tcl set curSect [lindex $argList 4] ;# {Tcl Library Procedures} - + regsub -all {\\ } $curSect { } curSect ;# Clean up for [incr\ Tcl] puts $file "#{\\footnote $curID}" ;# Context string @@ -950,7 +954,7 @@ proc newPara {leftIndent {firstIndent 0i}} { if $state(paragraph) { puts -nonewline $file "\\line\n" } - if {$leftIndent != ""} { + if {$leftIndent ne ""} { set state(leftIndent) [expr {$state(leftMargin) \ + ($state(offset) * $state(nestingLevel)) \ + [getTwips $leftIndent]}] @@ -1020,7 +1024,7 @@ proc incrNestingLevel {} { proc decrNestingLevel {} { global state - + if {$state(nestingLevel) == 0} { puts stderr "Nesting level decremented below 0" } else { diff --git a/tools/regexpTestLib.tcl b/tools/regexpTestLib.tcl index 86f2a3e..d84a012 100644 --- a/tools/regexpTestLib.tcl +++ b/tools/regexpTestLib.tcl @@ -43,7 +43,7 @@ proc readInputFile {} { # # strings with embedded @'s are truncated # unpreceeded @'s are replaced by {} -# +# proc removeAts {ls} { set len [llength $ls] set newLs {} @@ -94,7 +94,7 @@ proc writeOutputFile {numLines fcn} { global outFileName global lineArray - # open output file and write file header info to it. + # open output file and write file header info to it. set fileId [open $outFileName w] @@ -133,7 +133,7 @@ proc writeOutputFile {numLines fcn} { puts $fileId $currentLine incr srcLineNum $lineArray(c$lineNum) incr lineNum - continue + continue } set len [llength $currentLine] @@ -144,7 +144,7 @@ proc writeOutputFile {numLines fcn} { puts $fileId "\n" incr srcLineNum $lineArray(c$lineNum) incr lineNum - continue + continue } if {($len < 3)} { puts "warning: test is too short --\n\t$currentLine" @@ -209,21 +209,21 @@ proc convertTestLine {currentLine len lineNum srcLineNum} { set vals {} set result 0 set v 0 - + if {[regsub {\*} "$flags" "" newFlags] == 1} { # an error is expected - + if {[string compare $str "EMPTY"] == 0} { # empty regexp is not an error # skip this test - + return "\# skipping the empty-re test from line $srcLineNum\n" } set flags $newFlags set result "\{1 \{[convertErrCode $str]\}\}" } elseif {$numVars > 0} { # at least 1 match is made - + if {[regexp {s} $flags] == 1} { set result "\{0 1\}" } else { @@ -240,7 +240,7 @@ proc convertTestLine {currentLine len lineNum srcLineNum} { } } else { # no match is made - + set result "\{0 0\}" } @@ -248,16 +248,16 @@ proc convertTestLine {currentLine len lineNum srcLineNum} { set cmd [prepareCmd $flags $re $str $vars $noBraces] if {$cmd == -1} { - return "\# skipping test with metasyntax from line $srcLineNum\n" + return "\# skipping test with metasyntax from line $srcLineNum\n" } set test "test regexp-1.$srcLineNum \{converted from line $srcLineNum\} \{\n" append test "\tcatch {unset var}\n" - append test "\tlist \[catch \{ \n" - append test "\t\tset match \[$cmd\] \n" - append test "\t\tlist \$match $vals \n" - append test "\t\} msg\] \$msg \n" - append test "\} $result \n" + append test "\tlist \[catch \{\n" + append test "\t\tset match \[$cmd\]\n" + append test "\t\tlist \$match $vals\n" + append test "\t\} msg\] \$msg\n" + append test "\} $result\n" return $test } diff --git a/tools/str2c b/tools/str2c index 971e552..cff7ba2 100644 --- a/tools/str2c +++ b/tools/str2c @@ -36,7 +36,7 @@ static char data\[\]=\"[translate $r]\";" puts "/* * Multi parts read only string generated by str2c */ -static CONST char * CONST data\[\]= {" +static const char * const data\[\]= {" set n 1 for {set i 0} {$i<$lg} {incr i $MAX} { set part [string range $r $i [expr $i+$MAX-1]] @@ -48,7 +48,7 @@ static CONST char * CONST data\[\]= {" } puts "\tNULL\t/* End of data marker */\n};" puts "\n/* use for instance with: - CONST char * CONST *chunk; + const char * const *chunk; for (chunk=data; *chunk; chunk++) { Tcl_AppendResult(interp, *chunk, (char *) NULL); } diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in index 0d01f35..3bdccbe 100644 --- a/tools/tcl.hpj.in +++ b/tools/tcl.hpj.in @@ -5,9 +5,9 @@ HCW=0 LCID=0x409 0x0 0x0 ;English (United States) REPORT=Yes TITLE=Tcl/Tk Reference Manual -CNT=tcl85.cnt +CNT=tcl86.cnt COPYRIGHT=Copyright © 2000 Ajuba Solutions -HLP=tcl85.hlp +HLP=tcl86.hlp [FILES] tcl.rtf diff --git a/tools/tcl.wse.in b/tools/tcl.wse.in deleted file mode 100644 index e22b74a..0000000 --- a/tools/tcl.wse.in +++ /dev/null @@ -1,2376 +0,0 @@ -Document Type: WSE -item: Global - Version=6.01 - Title=Tcl 8.5 for Windows Installation - Flags=00010100 - Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - Japanese Font Name=MS Gothic - Japanese Font Size=10 - Start Gradient=0 0 255 - End Gradient=0 0 0 - Windows Flags=00000000000000010010110000001000 - Log Pathname=%MAINDIR%\INSTALL.LOG - Message Font=MS Sans Serif - Font Size=8 - Disk Label=tcl8.5.15 - Disk Filename=setup - Patch Flags=0000000000000001 - Patch Threshold=85 - Patch Memory=4000 - Variable Name1=_SYS_ - Variable Default1=C:\WINDOWS\SYSTEM - Variable Flags1=00001000 - Variable Name2=_ODBC16_ - Variable Default2=C:\WINDOWS\SYSTEM - Variable Flags2=00001000 - Variable Name3=_WISE_ - Variable Default3=${__WISE__} - Variable Flags3=00001000 -end -item: Open/Close INSTALL.LOG - Flags=00000001 -end -item: Check if File/Dir Exists - Pathname=%SYS% - Flags=10000100 -end -item: Set Variable - Variable=SYS - Value=%WIN% -end -item: End Block -end -item: Set Variable - Variable=VER - Value=8.5 -end -item: Set Variable - Variable=PATCHLEVEL - Value=${__TCL_PATCH_LEVEL__} -end -item: Set Variable - Variable=APPTITLE - Value=Tcl/Tk %PATCHLEVEL% for Windows -end -item: Set Variable - Variable=URL - Value=http://www.tcl.tk/ -end -item: Set Variable - Variable=GROUP - Value=Tcl -end -item: Set Variable - Variable=DISABLED - Value=! -end -item: Set Variable - Variable=MAINDIR - Value=Tcl -end -item: Check Configuration - Flags=10111011 -end -item: Get Registry Key Value - Variable=PROGRAM_FILES - Key=SOFTWARE\Microsoft\Windows\CurrentVersion - Default=C:\Program Files - Value Name=ProgramFilesDir - Flags=00000100 -end -item: Set Variable - Variable=MAINDIR - Value=%PROGRAM_FILES%\%MAINDIR% -end -item: Set Variable - Variable=EXPLORER - Value=1 -end -item: Else Statement -end -item: Set Variable - Variable=MAINDIR - Value=C:\%MAINDIR% -end -item: End Block -end -item: Set Variable - Variable=BACKUP - Value=%MAINDIR%\BACKUP -end -item: Set Variable - Variable=DOBACKUP - Value=B -end -item: Set Variable - Variable=BRANDING - Value=0 -end -remarked item: If/While Statement - Variable=BRANDING - Value=1 -end -remarked item: Read INI Value - Variable=NAME - Pathname=%INST%\CUSTDATA.INI - Section=Registration - Item=Name -end -remarked item: Read INI Value - Variable=COMPANY - Pathname=%INST%\CUSTDATA.INI - Section=Registration - Item=Company -end -remarked item: If/While Statement - Variable=NAME -end -remarked item: Set Variable - Variable=DOBRAND - Value=1 -end -remarked item: End Block -end -remarked item: End Block -end -item: Set Variable - Variable=TYPE - Value=C -end -item: Set Variable - Variable=COMPONENTS - Value=ABC -end -item: Wizard Block - Direction Variable=DIRECTION - Display Variable=DISPLAY - X Position=0 - Y Position=0 - Filler Color=8421440 - Flags=00000001 -end -item: Custom Dialog Set - Name=Splash - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Bienvenue - Title German=Willkommen - Title Portuguese=Bem-vindo - Title Spanish=Bienvenido - Title Italian=Benvenuto - Title Danish=Velkommen - Title Dutch=Welkom - Title Norwegian=Velkommen - Title Swedish=Välkommen - Width=273 - Height=250 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=166 214 208 228 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - end - item: Push Button - Rectangle=212 214 254 228 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=Cancel - end - item: Static - Rectangle=0 0 268 233 - Action=2 - Enabled Color=00000000000000001111111111111111 - Create Flags=01010000000000000000000000001011 - Pathname=${__TCLBASEDIR__}\tools\white.bmp - end - item: Static - Rectangle=5 5 268 215 - Destination Dialog=1 - Action=2 - Enabled Color=00000000000000001111111111111111 - Create Flags=01010000000000000000000000001011 - Pathname=${__TCLBASEDIR__}\tools\tclSplash.bmp - end - end -end -item: End Block -end -item: Wizard Block - Direction Variable=DIRECTION - Display Variable=DISPLAY - Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP - X Position=9 - Y Position=10 - Filler Color=8421440 - Dialog=Welcome - Dialog=Select Destination Directory - Dialog=Select Installation Type - Dialog=Select Components - Dialog=Select Program Manager Group - Variable= - Variable= - Variable= - Variable=TYPE - Variable=EXPLORER - Value= - Value= - Value= - Value=C - Value=1 - Compare=0 - Compare=0 - Compare=0 - Compare=1 - Compare=0 - Flags=00000011 -end -item: Custom Dialog Set - Name=Welcome - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Welcome! - Text French=Bienvenue ! - Text German=Willkommen! - Text Spanish=¡Bienvenido! - Text Italian=Benvenuti! - end - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DISABLED - Value=! - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=85 41 255 130 - Create Flags=01010000000000000000000000000000 - Text=This installation program will install %APPTITLE%. - Text= - Text=Press the Next button to start the installation. You can press the Exit Setup button now if you do not want to install %APPTITLE% at this time. - Text= - Text=It is strongly recommended that you exit all Windows programs before running this installation program. - Text French=Ce programme d'installation va installer %APPTITLE%. - Text French= - Text French=Cliquez sur le bouton Suite pour démarrer l'installation. Vous pouvez cliquer sur le bouton Quitter l'installation si vous ne voulez pas installer %APPTITLE% tout de suite. - Text German=Mit diesem Installationsprogramm wird %APPTITLE% installiert. - Text German= - Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Abbrechen", um die Installation von %APPTITLE% abzubrechen. - Text Spanish=Este programa de instalación instalará %APPTITLE%. - Text Spanish= - Text Spanish=Presione el botón Siguiente para iniciar la instalación. Puede presionar el botón Salir de instalación si no desea instalar %APPTITLE% en este momento. - Text Italian=Questo programma installerà %APPTITLE%. - Text Italian= - Text Italian=Per avvviare l'installazione premere il pulsante Avanti. Se non si desidera installare %APPTITLE% ora, premere il pulsante Esci dall'installazione. - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - end -end -item: Custom Dialog Set - Name=Select Destination Directory - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Flags=0000000000000001 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Select Destination Directory - Text French=Sélectionner le répertoire de destination - Text German=Zielverzeichnis wählen - Text Spanish=Seleccione el directorio de destino - Text Italian=Selezionare Directory di destinazione - end - item: Static - Rectangle=86 39 256 114 - Create Flags=01010000000000000000000000000000 - Text=Please select the directory where the %APPTITLE% files are to be installed. - Text= - Text=To install in the default directory below, click Next. - Text= - Text=To install in a different directory, click Browse and select another directory. - Text French=Veuillez sélectionner le répertoire dans lequel les fichiers %APPTITLE% doivent être installés. - Text German=Geben Sie an, in welchem Verzeichnis die %APPTITLE%-Dateien installiert werden sollen. - Text Spanish=Por favor seleccione el directorio donde desee instalar los archivos de %APPTITLE%. - Text Italian=Selezionare la directory dove verranno installati i file %APPTITLE%. - end - item: Static - Rectangle=86 130 256 157 - Action=1 - Create Flags=01010000000000000000000000000111 - end - item: Push Button - Rectangle=205 138 250 153 - Variable=MAINDIR_SAVE - Value=%MAINDIR% - Destination Dialog=1 - Action=2 - Create Flags=01010000000000010000000000000000 - Text=Browse - Text French=Parcourir - Text German=Durchsuchen - Text Spanish=Buscar - Text Italian=Sfoglie - end - item: Static - Rectangle=91 140 198 151 - Create Flags=01010000000000000000000000000000 - Text=%MAINDIR% - Text French=%MAINDIR% - Text German=%MAINDIR% - Text Spanish=%MAINDIR% - Text Italian=%MAINDIR% - end - end - item: Dialog - Title=Select Destination Directory - Title French=Sélectionner le répertoire de destination - Title German=Zielverzeichnis wählen - Title Spanish=Seleccione el directorio de destino - Title Italian=Selezionare Directory di destinazione - Width=221 - Height=173 - Font Name=Helv - Font Size=8 - item: Listbox - Rectangle=5 5 163 149 - Variable=MAINDIR - Create Flags=01010000100000010000000101000000 - Flags=0000110000100010 - Text=%MAINDIR% - Text French=%MAINDIR% - Text German=%MAINDIR% - Text Spanish=%MAINDIR% - Text Italian=%MAINDIR% - end - item: Push Button - Rectangle=167 6 212 21 - Create Flags=01010000000000010000000000000001 - Text=OK - Text French=OK - Text German=OK - Text Spanish=Aceptar - Text Italian=OK - end - item: Push Button - Rectangle=167 25 212 40 - Variable=MAINDIR - Value=%MAINDIR_SAVE% - Create Flags=01010000000000010000000000000000 - Flags=0000000000000001 - Text=Cancel - Text French=Annuler - Text German=Abbrechen - Text Spanish=Cancelar - Text Italian=Annulla - end - end -end -remarked item: Custom Dialog Set - Name=Select Installation Type - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Select Installation Type - Text French=Sélectionner les composants - Text German=Komponenten auswählen - Text Spanish=Seleccione componentes - Text Italian=Selezionare i componenti - end - item: Static - Rectangle=194 162 242 172 - Variable=COMPONENTS - Value=MAINDIR - Create Flags=01010000000000000000000000000010 - end - item: Static - Rectangle=194 153 242 162 - Variable=COMPONENTS - Create Flags=01010000000000000000000000000010 - end - item: Static - Rectangle=107 153 196 164 - Create Flags=01010000000000000000000000000000 - Text=Disk Space Required: - Text French=Espace disque requis : - Text German=Notwendiger Speicherplatz: - Text Spanish=Espacio requerido en el disco: - Text Italian=Spazio su disco necessario: - end - item: Static - Rectangle=107 162 196 172 - Create Flags=01010000000000000000000000000000 - Text=Disk Space Remaining: - Text French=Espace disque disponible : - Text German=Verbleibender Speicherplatz: - Text Spanish=Espacio en disco disponible: - Text Italian=Spazio su disco disponibile: - end - item: Static - Rectangle=86 145 256 175 - Action=1 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 42 256 61 - Create Flags=01010000000000000000000000000000 - Text=Choose which type of installation to perform by selecting one of the buttons below. - Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous. - Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken. - Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo. - Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti. - end - item: Radio Button - Rectangle=86 74 256 128 - Variable=TYPE - Create Flags=01010000000000010000000000001001 - Text=&Full Installation (Recommended) - Text=&Minimal Installation - Text=C&ustom Installation - Text= - end - end -end -item: Custom Dialog Set - Name=Select Components - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Select Components - Text French=Sélectionner les composants - Text German=Komponenten auswählen - Text Spanish=Seleccione componentes - Text Italian=Selezionare i componenti - end - item: Checkbox - Rectangle=86 75 256 129 - Variable=COMPONENTS - Create Flags=01010000000000010000000000000011 - Flags=0000000000000110 - Text=Tcl Run-Time Files - Text=Example Scripts - Text=Help Files - Text=Header and Library Files - Text= - Text French=Tcl Run-Time Files - Text French=Example Scripts - Text French=Help Files - Text French=Header and Library Files - Text French= - Text German=Tcl Run-Time Files - Text German=Example Scripts - Text German=Help Files - Text German=Header and Library Files - Text German= - Text Spanish=Tcl Run-Time Files - Text Spanish=Example Scripts - Text Spanish=Help Files - Text Spanish=Header and Library Files - Text Spanish= - Text Italian=Tcl Run-Time Files - Text Italian=Example Scripts - Text Italian=Help Files - Text Italian=Header and Library Files - Text Italian= - end - item: Static - Rectangle=194 162 242 172 - Variable=COMPONENTS - Value=MAINDIR - Create Flags=01010000000000000000000000000010 - end - item: Static - Rectangle=194 153 242 162 - Variable=COMPONENTS - Create Flags=01010000000000000000000000000010 - end - item: Static - Rectangle=107 153 196 164 - Create Flags=01010000000000000000000000000000 - Text=Disk Space Required: - Text French=Espace disque requis : - Text German=Notwendiger Speicherplatz: - Text Spanish=Espacio requerido en el disco: - Text Italian=Spazio su disco necessario: - end - item: Static - Rectangle=107 162 196 172 - Create Flags=01010000000000000000000000000000 - Text=Disk Space Remaining: - Text French=Espace disque disponible : - Text German=Verbleibender Speicherplatz: - Text Spanish=Espacio en disco disponible: - Text Italian=Spazio su disco disponibile: - end - item: Static - Rectangle=86 145 256 175 - Action=1 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 42 256 61 - Create Flags=01010000000000000000000000000000 - Text=Choose which components to install by checking the boxes below. - Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous. - Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken. - Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo. - Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti. - end - end -end -item: Custom Dialog Set - Name=Select Program Manager Group - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Flags=0000000000000001 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Select ProgMan Group - Text French=Sélectionner le groupe du Gestionnaire de programme - Text German=Bestimmung der Programm-Managergruppe - Text Spanish=Seleccione grupo del Administrador de programas - Text Italian=Selezionare il gruppo ProgMan - end - item: Static - Rectangle=86 44 256 68 - Create Flags=01010000000000000000000000000000 - Text=Enter the name of the Program Manager group to add the %APPTITLE% icons to: - Text French=Entrez le nom du groupe du Gestionnaire de programme dans lequel vous souhaitez ajouter les icônes de %APPTITLE% : - Text German=Geben Sie den Namen der Programmgruppe ein, der das Symbol %APPTITLE% hinzugefügt werden soll: - Text Spanish=Escriba el nombre del grupo del Administrador de programas en el que desea agregar los iconos de %APPTITLE%: - Text Italian=Inserire il nome del gruppo Program Manager per aggiungere le icone %APPTITLE% a: - end - item: Combobox - Rectangle=86 69 256 175 - Variable=GROUP - Create Flags=01010000000000010000001000000001 - Flags=0000000000000001 - Text=%GROUP% - Text French=%GROUP% - Text German=%GROUP% - Text Spanish=%GROUP% - Text Italian=%GROUP% - end - end -end -item: Custom Dialog Set - Name=Start Installation - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Next > - Text French=&Suite > - Text German=&Weiter > - Text Spanish=&Siguiente > - Text Italian=&Avanti > - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DIRECTION - Value=B - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Ready to Install! - Text French=Prêt à installer ! - Text German=Installationsbereit! - Text Spanish=¡Preparado para la instalación! - Text Italian=Pronto per l'installazione! - end - item: Static - Rectangle=86 42 256 102 - Create Flags=01010000000000000000000000000000 - Text=You are now ready to install %APPTITLE%. - Text= - Text=Press the Next button to begin the installation or the Back button to reenter the installation information. - Text French=Vous êtes maintenant prêt à installer les fichiers %APPTITLE%. - Text French= - Text French=Cliquez sur le bouton Suite pour commencer l'installation ou sur le bouton Retour pour entrer les informations d'installation à nouveau. - Text German=Sie können %APPTITLE% nun installieren. - Text German= - Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Zurück", um die Installationsinformationen neu einzugeben. - Text Spanish=Ya está listo para instalar %APPTITLE%. - Text Spanish= - Text Spanish=Presione el botón Siguiente para comenzar la instalación o presione Atrás para volver a ingresar la información para la instalación. - Text Italian=Ora è possibile installare %APPTITLE%. - Text Italian= - Text Italian=Premere il pulsante Avanti per avviare l'installazione o il pulsante Indietro per reinserire le informazioni di installazione. - end - end -end -item: If/While Statement - Variable=DISPLAY - Value=Select Destination Directory -end -item: Set Variable - Variable=BACKUP - Value=%MAINDIR%\BACKUP -end -item: End Block -end -item: End Block -end -item: If/While Statement - Variable=TYPE - Value=B -end -item: Set Variable - Variable=COMPONENTS - Value=A -end -item: End Block -end -item: If/While Statement - Variable=DOBACKUP - Value=A -end -item: Set Variable - Variable=BACKUPDIR - Value=%BACKUP% -end -item: End Block -end -remarked item: If/While Statement - Variable=BRANDING - Value=1 -end -remarked item: If/While Statement - Variable=DOBRAND - Value=1 -end -remarked item: Edit INI File - Pathname=%INST%\CUSTDATA.INI - Settings=[Registration] - Settings=NAME=%NAME% - Settings=COMPANY=%COMPANY% - Settings= -end -remarked item: End Block -end -remarked item: End Block -end -item: Set Variable - Variable=MAINDIRSHORT - Value=%MAINDIR% - Flags=00010100 -end -item: Open/Close INSTALL.LOG -end -item: Check Disk Space - Component=COMPONENTS -end -item: Install File - Source=${__TCLBASEDIR__}\license.txt - Destination=%MAINDIR%\license.txt - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\Readme.txt - Destination=%MAINDIR%\Readme.txt - Flags=0000000000000010 -end -item: If/While Statement - Variable=COMPONENTS - Value=D - Flags=00001010 -end -item: Install File - Source=${__TKBASEDIR__}\win\release\tk85.lib - Destination=%MAINDIR%\lib\tk85.lib - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\win\release\tkstub85.lib - Destination=%MAINDIR%\lib\tkstub85.lib - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tcl85.lib - Destination=%MAINDIR%\lib\tcl85.lib - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tclstub85.lib - Destination=%MAINDIR%\lib\tclstub85.lib - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\Xutil.h - Destination=%MAINDIR%\include\X11\Xutil.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\Xlib.h - Destination=%MAINDIR%\include\X11\Xlib.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\Xfuncproto.h - Destination=%MAINDIR%\include\X11\Xfuncproto.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\Xatom.h - Destination=%MAINDIR%\include\X11\Xatom.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\X.h - Destination=%MAINDIR%\include\X11\X.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\keysymdef.h - Destination=%MAINDIR%\include\X11\keysymdef.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\keysym.h - Destination=%MAINDIR%\include\X11\keysym.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\xlib\X11\cursorfont.h - Destination=%MAINDIR%\include\X11\cursorfont.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\generic\tk.h - Destination=%MAINDIR%\include\tk.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\generic\tkDecls.h - Destination=%MAINDIR%\include\tkDecls.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\generic\tkPlatDecls.h - Destination=%MAINDIR%\include\tkPlatDecls.h - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\generic\tkIntXlibDecls.h - Destination=%MAINDIR%\include\tkIntXlibDecls.h - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\generic\tcl.h - Destination=%MAINDIR%\include\tcl.h - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\generic\tclDecls.h - Destination=%MAINDIR%\include\tclDecls.h - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\generic\tclPlatDecls.h - Destination=%MAINDIR%\include\tclPlatDecls.h - Flags=0000000000000010 -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\msgcat\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.5\pkgIndex.tcl - Flags=0000000010000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\msgcat\msgcat.tcl - Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.5\msgcat.tcl - Flags=0000000010000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\tcltest\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\tcltest\tcltest.tcl - Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\tcltest.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\symbol.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\symbol.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\shiftjis.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\shiftjis.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macUkraine.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macUkraine.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macTurkish.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macTurkish.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macThai.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macThai.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macRomania.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRomania.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macRoman.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRoman.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macJapan.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macJapan.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macIceland.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macIceland.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macGreek.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macGreek.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macDingbats.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macDingbats.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macCyrillic.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCyrillic.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macCroatian.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCroatian.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\macCentEuro.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCentEuro.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\ksc5601.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\ksc5601.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\koi8-r.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\koi8-r.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\jis0212.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0212.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\jis0208.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0208.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\jis0201.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0201.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-15.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-15.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-9.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-9.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-8.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-8.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-7.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-7.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-6.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-6.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-5.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-5.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-4.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-4.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-3.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-3.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-2.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-2.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso8859-1.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-1.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso2022.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso2022-kr.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-kr.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\iso2022-jp.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-jp.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\gb2312.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb2312.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\gb1988.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb1988.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\gb12345.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb12345.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\euc-cn.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-cn.enc - Flags=0000000010000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\euc-jp.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-jp.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\euc-kr.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-kr.enc - Flags=0000000010000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\dingbats.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\dingbats.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp950.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp950.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp949.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp949.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp936.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp936.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp932.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp932.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp874.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp874.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp869.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp869.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp866.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp866.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp865.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp865.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp864.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp864.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp863.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp863.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp862.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp862.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp861.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp861.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp860.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp860.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp857.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp857.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp855.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp855.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp852.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp852.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp850.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp850.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp775.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp775.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp737.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp737.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp437.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp437.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1258.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1258.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1257.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1257.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1256.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1256.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1255.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1255.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1254.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1254.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1253.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1253.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1252.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1252.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1251.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1251.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\cp1250.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1250.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\ascii.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\ascii.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\encoding\big5.enc - Destination=%MAINDIR%\lib\tcl%VER%\encoding\big5.enc - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\opt\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\opt\optparse.tcl - Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\http\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\http\http.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\msgbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\optMenu.tcl - Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\clrpick.tcl - Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\entry.tcl - Destination=%MAINDIR%\lib\tk%VER%\entry.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\spinbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\spinbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\comdlg.tcl - Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\bgerror.tcl - Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\obsolete.tcl - Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\button.tcl - Destination=%MAINDIR%\lib\tk%VER%\button.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\xmfbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\console.tcl - Destination=%MAINDIR%\lib\tk%VER%\console.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\listbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\menu.tcl - Destination=%MAINDIR%\lib\tk%VER%\menu.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\dialog.tcl - Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\focus.tcl - Destination=%MAINDIR%\lib\tk%VER%\focus.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\palette.tcl - Destination=%MAINDIR%\lib\tk%VER%\palette.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\tkfbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\tk.tcl - Destination=%MAINDIR%\lib\tk%VER%\tk.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\text.tcl - Destination=%MAINDIR%\lib\tk%VER%\text.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\tearoff.tcl - Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\tclIndex - Destination=%MAINDIR%\lib\tk%VER%\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\scrlbar.tcl - Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\scale.tcl - Destination=%MAINDIR%\lib\tk%VER%\scale.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\safetk.tcl - Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\http1.0\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\http1.0\http.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\reg\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tclreg10.dll - Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg10.dll - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\dde\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tcldde12.dll - Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\tcldde12.dll - Flags=0000000000000010 -end -item: Install File - Source=C:\WINNT\SYSTEM32\Msvcrt.dll - Destination=%MAINDIR%\bin\msvcrt.dll - Flags=0010001000000011 -end -item: Install File - Source=${__TKBASEDIR__}\win\release\wish85.exe - Destination=%MAINDIR%\bin\wish85.exe - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tclsh85.exe - Destination=%MAINDIR%\bin\tclsh85.exe - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tclpip85.dll - Destination=%MAINDIR%\bin\tclpip85.dll - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\win\release\tcl85.dll - Destination=%MAINDIR%\bin\tcl85.dll - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\win\release\tk85.dll - Destination=%MAINDIR%\bin\tk85.dll - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\auto.tcl - Destination=%MAINDIR%\lib\tcl%VER%\auto.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\history.tcl - Destination=%MAINDIR%\lib\tcl%VER%\history.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\init.tcl - Destination=%MAINDIR%\lib\tcl%VER%\init.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\package.tcl - Destination=%MAINDIR%\lib\tcl%VER%\package.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\parray.tcl - Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\safe.tcl - Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\tclIndex - Destination=%MAINDIR%\lib\tcl%VER%\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\library\word.tcl - Destination=%MAINDIR%\lib\tcl%VER%\word.tcl - Flags=0000000000000010 -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=B - Flags=00001010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\tai-ku.gif - Destination=%MAINDIR%\lib\tk%VER%\images\tai-ku.gif - Flags=0000000010000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\teapot.ppm - Destination=%MAINDIR%\lib\tk%VER%\demos\images\teapot.ppm - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\tcllogo.gif - Destination=%MAINDIR%\lib\tk%VER%\demos\images\tcllogo.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\pattern.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\pattern.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\noletter.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\noletter.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\letters.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\letters.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\gray25.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\gray25.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\flagup.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagup.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\flagdown.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagdown.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\face.bmp - Destination=%MAINDIR%\lib\tk%VER%\demos\images\face.bmp - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\earthris.gif - Destination=%MAINDIR%\lib\tk%VER%\demos\images\earthris.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\images\earth.gif - Destination=%MAINDIR%\lib\tk%VER%\demos\images\earth.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\vscale.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\vscale.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\twind.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\twind.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\text.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\text.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\style.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\style.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\states.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\states.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\search.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\search.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\sayings.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\sayings.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\ruler.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\ruler.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\radio.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\radio.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\puzzle.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\puzzle.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\plot.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\plot.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\msgbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\msgbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\menubu.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\menubu.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\menu.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\menu.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\label.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\label.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\items.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\items.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\image2.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\image2.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\image1.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\image1.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\icon.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\icon.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\hscale.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\hscale.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\form.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\form.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\ixset - Destination=%MAINDIR%\lib\tk%VER%\demos\ixset.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\rolodex - Destination=%MAINDIR%\lib\tk%VER%\demos\rolodex.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\square - Destination=%MAINDIR%\lib\tk%VER%\demos\square.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\Readme - Destination=%MAINDIR%\lib\tk%VER%\demos\Readme - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\hello - Destination=%MAINDIR%\lib\tk%VER%\demos\hello.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\tclIndex - Destination=%MAINDIR%\lib\tk%VER%\demos\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\browse - Destination=%MAINDIR%\lib\tk%VER%\demos\browse.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\timer - Destination=%MAINDIR%\lib\tk%VER%\demos\timer.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\widget - Destination=%MAINDIR%\lib\tk%VER%\demos\widget.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\tcolor - Destination=%MAINDIR%\lib\tk%VER%\demos\tcolor.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\rmt - Destination=%MAINDIR%\lib\tk%VER%\demos\rmt.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\floor.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\floor.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\filebox.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\filebox.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo75.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo75.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo200.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo200.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo175.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo175.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo150.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo150.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\pwrdLogo100.gif - Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo100.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\logoMed.gif - Destination=%MAINDIR%\lib\tk%VER%\images\logoMed.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\logoLarge.gif - Destination=%MAINDIR%\lib\tk%VER%\images\logoLarge.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\logo64.gif - Destination=%MAINDIR%\lib\tk%VER%\images\logo64.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\logo100.gif - Destination=%MAINDIR%\lib\tk%VER%\images\logo100.gif - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\images\Readme - Destination=%MAINDIR%\lib\tk%VER%\images\Readme - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\arrow.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\arrow.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\bind.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\bind.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\bitmap.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\bitmap.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\button.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\button.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\check.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\check.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\clrpick.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\clrpick.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\colors.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\colors.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\cscroll.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\cscroll.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\ctext.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\ctext.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\dialog1.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\dialog1.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\dialog2.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\dialog2.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\entry1.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\entry1.tcl - Flags=0000000000000010 -end -item: Install File - Source=${__TKBASEDIR__}\library\demos\entry2.tcl - Destination=%MAINDIR%\lib\tk%VER%\demos\entry2.tcl - Flags=0000000000000010 -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=C - Flags=00001010 -end -item: Install File - Source=${__TCLBASEDIR__}\tools\tcl85.cnt - Destination=%MAINDIR%\doc\tcl85.cnt - Flags=0000000000000010 -end -item: Install File - Source=${__TCLBASEDIR__}\tools\tcl85.hlp - Destination=%MAINDIR%\doc\tcl85.hlp - Flags=0000000000000010 -end -item: End Block -end -item: Set Variable - Variable=MAINDIR - Value=%MAINDIR% - Flags=00010100 -end -item: Include Script - Pathname=\\pop\tools\1.2\win32-ix86\wise\INCLUDE\uninstal.wse -end -item: Check Configuration - Flags=10111011 -end -item: Get Registry Key Value - Variable=GROUPDIR - Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders - Default=%WIN%\Start Menu\Programs - Value Name=Programs - Flags=00000010 -end -item: Set Variable - Variable=GROUP - Value=%GROUPDIR%\%GROUP% -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Create Shortcut - Source=%MAINDIR%\bin\wish85.exe - Destination=%GROUP%\Wish.lnk - Working Directory=%MAINDIR% -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Create Shortcut - Source=%MAINDIR%\bin\tclsh85.exe - Destination=%GROUP%\Tclsh.lnk - Working Directory=%MAINDIR% - Key Type=1536 - Flags=00000001 -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=C - Flags=00001010 -end -item: Create Shortcut - Source=%MAINDIR%\doc\tcl85.hlp - Destination=%GROUP%\Tcl Help.lnk - Working Directory=%MAINDIR% -end -item: End Block -end -item: Create Shortcut - Source=%MAINDIR%\Readme.txt - Destination=%GROUP%\Readme.lnk - Working Directory=%MAINDIR% -end -item: If/While Statement - Variable=COMPONENTS - Value=B - Flags=00001010 -end -item: Create Shortcut - Source=%MAINDIR%\lib\tk%VER%\demos\widget.tcl - Destination=%GROUP%\Widget Tour.lnk - Working Directory=%MAINDIR% - Key Type=1536 - Flags=00000001 -end -item: End Block -end -item: Else Statement -end -item: If/While Statement - Variable=COMPONENTS - Value=B - Flags=00001010 -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Widget Tour - Command Line=%MAINDIR%\lib\tk%VER%\demos\widget.tcl - Icon Pathname=%MAINDIR%\bin\wish85.exe - Default Directory=%MAINDIR% -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=C - Flags=00001010 -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Tcl Help - Command Line=%MAINDIR%\doc\tcl85.hlp - Default Directory=%MAINDIR% -end -item: End Block -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Readme - Command Line=%MAINDIR%\Readme.txt - Default Directory=%MAINDIR% -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Wish - Command Line=%MAINDIR%\bin\wish85.exe - Default Directory=%MAINDIR% -end -item: End Block -end -item: If/While Statement - Variable=COMPONENTS - Value=A - Flags=00001010 -end -item: Add ProgMan Icon - Group=%GROUP% - Icon Name=Tclsh - Command Line=%MAINDIR%\bin\tclsh85.exe - Default Directory=%MAINDIR% -end -item: End Block -end -item: End Block -end -item: Self-Register OCXs/DLLs - Description=Updating System Configuration, Please Wait... -end -item: Edit Registry - Total Keys=1 - Key=SOFTWARE\Scriptics\Tcl\%VER% - New Value=%MAINDIR% - Value Name=Root - Root=2 -end -item: Edit Registry - Total Keys=1 - Key=TclScript\DefaultIcon - New Value=%MAINDIR%\bin\tk85.dll -end -item: Edit Registry - Total Keys=1 - Key=.tcl - New Value=TclScript -end -item: Edit Registry - Total Keys=1 - Key=TclScript - New Value=TclScript -end -item: Edit Registry - Total Keys=1 - Key=TclScript\shell\open\command - New Value=%MAINDIRSHORT%\bin\wish85.exe "%%1" %%* -end -item: Edit Registry - Total Keys=1 - Key=TclScript\shell\edit - New Value=&Edit -end -item: Edit Registry - Total Keys=1 - Key=TclScript\shell\edit\command - New Value=notepad "%%1" -end -item: Add Directory to Path - Directory=%MAINDIR%\bin -end -item: Check Configuration - Flags=10111011 -end -item: Set Variable - Variable=TO_SCRIPTICS - Value=A -end -item: Else Statement -end -item: Set Variable - Variable=TO_SCRIPTICS -end -item: End Block -end -item: Wizard Block - Direction Variable=DIRECTION - Display Variable=DISPLAY - Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP - X Position=9 - Y Position=10 - Filler Color=8421440 - Flags=00000011 -end -item: Custom Dialog Set - Name=Finished - Display Variable=DISPLAY - item: Dialog - Title=%APPTITLE% Installation - Title French=Installation de %APPTITLE% - Title German=Installation von %APPTITLE% - Title Spanish=Instalación de %APPTITLE% - Title Italian=Installazione di %APPTITLE% - Width=271 - Height=224 - Font Name=Helv - Font Size=8 - item: Push Button - Rectangle=150 187 195 202 - Variable=DIRECTION - Value=N - Create Flags=01010000000000010000000000000001 - Text=&Finish - Text French=&Fin - Text German=&Weiter - Text Spanish=&Terminar - Text Italian=&Fine - end - item: Push Button - Rectangle=105 187 150 202 - Variable=DISABLED - Value=! - Create Flags=01010000000000010000000000000000 - Text=< &Back - Text French=< &Retour - Text German=< &Zurück - Text Spanish=< &Atrás - Text Italian=< &Indietro - end - item: Push Button - Rectangle=211 187 256 202 - Variable=DISABLED - Value=! - Action=3 - Create Flags=01010000000000010000000000000000 - Text=&Cancel - Text French=&Annuler - Text German=&Abbrechen - Text Spanish=&Cancelar - Text Italian=&Annulla - end - item: Static - Rectangle=8 180 256 181 - Action=3 - Create Flags=01010000000000000000000000000111 - end - item: Static - Rectangle=86 8 258 42 - Create Flags=01010000000000000000000000000000 - Flags=0000000000000001 - Name=Times New Roman - Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18 - Text=Installation Completed! - Text French=Installation terminée ! - Text German=Die Installation ist abgeschlossen! - Text Spanish=¡Instalación terminada! - Text Italian=Installazione completata! - end - item: Static - Rectangle=86 42 256 153 - Create Flags=01010000000000000000000000000000 - Text=%APPTITLE% has been successfully installed. - Text= - Text=Click the Finish button to exit this installation. - Text= - Text=You can learn more about Tcl/Tk %VER%, including release notes, updates, tutorials, and more at %URL%. Check the box below to start your web browser and go there now. - Text= - Text=The installer may ask you to reboot your computer, this is to update your PATH and is not necessary to do immediately. - Text French=%APPTITLE% est maintenant installé. - Text French= - Text French=Cliquez sur le bouton Fin pour quitter l'installation. - Text German=%APPTITLE% wurde erfolgreich installiert. - Text German= - Text German=Klicken Sie auf "Weiter", um die Installation zu beenden. - Text Spanish=%APPTITLE% se ha instalado con éxito. - Text Spanish= - Text Spanish=Presione el botón Terminar para salir de esta instalación. - Text Italian=L'installazione %APPTITLE% è stata portata a termine con successo. - Text Italian= - Text Italian=Premere il pulsante Fine per uscire dall'installazione. - end - item: Checkbox - Rectangle=88 143 245 157 - Variable=TO_SCRIPTICS - Enabled Color=00000000000000001111111111111111 - Create Flags=01010000000000010000000000000011 - Text=Show me important information about - Text= - end - item: Static - Rectangle=99 156 245 170 - Enabled Color=00000000000000001111111111111111 - Create Flags=01010000000000000000000000000000 - Text=Tcl/Tk %VER% and TclPro - end - end -end -item: End Block -end -item: Check Configuration - Flags=10111011 -end -item: If/While Statement - Variable=TO_SCRIPTICS - Value=A - Flags=00000010 -end -item: Execute Program - Command Line=%URL% -end -item: End Block -end -item: Execute Program - Pathname=explorer - Command Line=%GROUP% -end -item: End Block -end diff --git a/tools/tclSplash.bmp b/tools/tclSplash.bmp Binary files differdeleted file mode 100644 index db8a17e..0000000 --- a/tools/tclSplash.bmp +++ /dev/null diff --git a/tools/tclZIC.tcl b/tools/tclZIC.tcl index 1b19d82..005919a 100755 --- a/tools/tclZIC.tcl +++ b/tools/tclZIC.tcl @@ -358,7 +358,7 @@ proc parseON {on} { # third possibility - lastWeekday - field 5 last([[:alpha:]]+) )$ - } $on -> dom1 wday2 dir2 num2 wday3]} then { + } $on -> dom1 wday2 dir2 num2 wday3]} { error "can't parse ON field \"$on\"" } if {$dom1 ne ""} { @@ -509,7 +509,7 @@ proc parseTOD {tod} { (?: ([wsugz]) # field 4 - type indicator )? - } $tod -> hour minute second ind]} then { + } $tod -> hour minute second ind]} { puts stderr "$fileName:$lno:can't parse time field \"$tod\"" incr errorCount } @@ -558,7 +558,7 @@ proc parseOffsetTime {offset} { :([[:digit:]]{2}) # field 4 - second )? )? - } $offset -> signum hour minute second]} then { + } $offset -> signum hour minute second]} { puts stderr "$fileName:$lno:can't parse offset time \"$offset\"" incr errorCount } @@ -940,7 +940,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset if { $earliestSecs > $startSecs && ($until eq "" || $earliestSecs < $untilSecs) - } then { + } { # Test if the initial transition has been done. # If not, do it now. @@ -989,7 +989,7 @@ proc applyRules {ruleSet year startSecs stdGMTOffset DSTOffset nextGMTOffset set date [::tcl::clock::GetJulianDayFromEraYearMonthDay \ [dict create era CE year $year month 1 dayOfMonth 1] 2361222] set startSecs [expr { - [dict get $date julianDay] * wide(86400) - 210866803200 + [dict get $date julianDay] * wide(86400) - 210866803200 - $stdGMTOffset - $DSTOffset }] diff --git a/tools/tclmin.wse b/tools/tclmin.wse deleted file mode 100644 index 2fd8185..0000000 --- a/tools/tclmin.wse +++ /dev/null @@ -1,247 +0,0 @@ -Document Type: WSE -item: Global - Version=5.0 - Flags=00000100 - Split=1420 - Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - Japanese Font Name=MS Gothic - Japanese Font Size=10 - Start Gradient=0 0 255 - End Gradient=0 0 0 - Windows Flags=00000000000000010010110000001000 - Message Font=MS Sans Serif - Font Size=8 - Disk Filename=SETUP - Patch Flags=0000000000000001 - Patch Threshold=85 - Patch Memory=4000 -end -item: Remark - Text=------- -end -item: Remark - Text=Tcl 8.0 Minimal Installation -end -item: Remark - Text=------- -end -item: Install File - Source=n:\dist\tcl8.0\library\opt0.4\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\opt0.4\optparse.tcl - Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\http\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\http\http.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\safe.tcl - Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\history.tcl - Destination=%MAINDIR%\lib\tcl%VER%\history.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\msgbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\optMenu.tcl - Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\clrpick.tcl - Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\entry.tcl - Destination=%MAINDIR%\lib\tk%VER%\entry.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\comdlg.tcl - Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\bgerror.tcl - Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\obsolete.tcl - Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\button.tcl - Destination=%MAINDIR%\lib\tk%VER%\button.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\xmfbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\console.tcl - Destination=%MAINDIR%\lib\tk%VER%\console.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\listbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\menu.tcl - Destination=%MAINDIR%\lib\tk%VER%\menu.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\dialog.tcl - Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\focus.tcl - Destination=%MAINDIR%\lib\tk%VER%\focus.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\palette.tcl - Destination=%MAINDIR%\lib\tk%VER%\palette.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\tkfbox.tcl - Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\tk.tcl - Destination=%MAINDIR%\lib\tk%VER%\tk.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\text.tcl - Destination=%MAINDIR%\lib\tk%VER%\text.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\tearoff.tcl - Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\tclIndex - Destination=%MAINDIR%\lib\tk%VER%\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\scrlbar.tcl - Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\scale.tcl - Destination=%MAINDIR%\lib\tk%VER%\scale.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tk8.0\library\safetk.tcl - Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\http1.0\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\http1.0\http.tcl - Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\pkgIndex.tcl - Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\tclreg80.dll - Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg80.dll - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\Tcl1680.dll - Destination=%SYS32%\Tcl1680.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\tcl80.dll - Destination=%SYS32%\tcl80.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\tclpip80.dll - Destination=%SYS32%\tclpip80.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\Bc45\Bin\cw3215.dll - Destination=%SYS32%\cw3215.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\tk8.0\win\tk80.dll - Destination=%SYS32%\tk80.dll - Flags=0000001000000010 -end -item: Install File - Source=n:\dist\tk8.0\win\wish80.exe - Destination=%MAINDIR%\bin\wish80.exe - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\win\tclsh80.exe - Destination=%MAINDIR%\bin\tclsh80.exe - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\tclIndex - Destination=%MAINDIR%\lib\tcl%VER%\tclIndex - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\init.tcl - Destination=%MAINDIR%\lib\tcl%VER%\init.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\parray.tcl - Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl - Flags=0000000000000010 -end -item: Install File - Source=n:\dist\tcl8.0\library\word.tcl - Destination=%MAINDIR%\lib\tcl%VER%\word.tcl - Flags=0000000000000010 -end diff --git a/tools/tclsh.svg b/tools/tclsh.svg new file mode 100644 index 0000000..34d45a4 --- /dev/null +++ b/tools/tclsh.svg @@ -0,0 +1,67 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<svg + xmlns:dc="http://purl.org/dc/elements/1.1/" + xmlns:cc="http://creativecommons.org/ns#" + xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" + xmlns:svg="http://www.w3.org/2000/svg" + xmlns="http://www.w3.org/2000/svg" + xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" + xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" + width="256" + height="256" + id="svg2309" + sodipodi:version="0.32" + inkscape:version="0.46" + sodipodi:modified="true" + version="1.0" + sodipodi:docname="tcl.svg" + inkscape:output_extension="org.inkscape.output.svg.inkscape" + inkscape:export-filename="tcl.png" + inkscape:export-xdpi="8.4399996" + inkscape:export-ydpi="8.4399996"> + <defs + id="defs2311" /> + <sodipodi:namedview + id="base" + pagecolor="#ffffff" + bordercolor="#666666" + borderopacity="1.0" + gridtolerance="10000" + guidetolerance="10" + objecttolerance="10" + inkscape:pageopacity="0.0" + inkscape:pageshadow="2" + inkscape:zoom="1.8096812" + inkscape:cx="110.83011" + inkscape:cy="132.34375" + inkscape:document-units="px" + inkscape:current-layer="layer1" + inkscape:window-width="993" + inkscape:window-height="669" + inkscape:window-x="5" + inkscape:window-y="49" + showgrid="false" /> + <g + inkscape:label="Layer 1" + inkscape:groupmode="layer" + id="layer1" + transform="translate(-311.79308,-365.73272)"> + <g + id="g2392" + transform="matrix(0.9671783,0,0,0.9671783,10.08245,12.003966)"> + <path + id="path4426" + d="M 499.58925,374.01397 C 499.97085,397.34606 499.27848,420.4264 479.08925,442.35772 L 478.33925,443.20147 L 479.46425,443.20147 L 487.71425,443.32647 C 474.30875,471.21288 465.58677,499.02017 446.308,526.79522 L 445.6205,527.79522 L 446.808,527.57647 L 456.9955,525.63897 C 449.7786,543.94928 437.43792,556.07176 424.058,560.13897 C 420.3754,508.57034 446.11026,463.05191 467.96425,417.67022 C 467.98435,417.62848 468.00666,417.58696 468.02675,417.54522 L 467.21425,416.98272 C 431.42858,456.99623 415.30305,513.43153 409.21425,559.98272 C 397.08579,553.13549 393.04346,544.06962 388.933,531.73272 L 397.40175,535.29522 L 398.27675,535.67022 L 398.08925,534.73272 C 391.65291,506.11299 401.64573,485.57026 411.33925,458.57647 L 418.308,463.23272 L 419.1205,463.79522 L 419.08925,462.82647 C 418.54325,440.89528 433.31028,418.87866 452.90175,399.23272 L 455.6205,406.51397 L 455.9955,407.48272 L 456.52675,406.57647 L 462.4955,396.63897 L 462.52675,396.57647 C 472.37862,383.00695 482.79421,378.58965 499.58925,374.01397 z" + style="opacity:1;fill:#3465a4;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" /> + <path + sodipodi:nodetypes="ccccccccccccccccccccccc" + id="path7600" + d="M 499.59927,374.00103 C 482.86154,378.56724 472.31963,383.0333 462.48689,396.57647 L 462.45564,396.63897 L 456.48689,406.57647 L 455.95564,407.48272 L 455.58064,406.51397 L 452.86189,399.23272 C 433.27042,418.87866 418.50339,440.89528 419.04939,462.82647 L 419.08064,463.79522 L 418.26814,463.23272 L 411.29939,458.57647 C 401.60587,485.57026 391.61305,506.11299 398.04939,534.73272 L 398.23689,535.67022 L 397.36189,535.29522 L 388.98689,531.76397 C 389.01386,531.93545 389.0525,532.09443 389.08064,532.26397 C 393.12974,544.32172 397.22634,553.23735 409.17439,559.98272 C 409.64601,556.37703 410.17162,552.69478 410.76814,548.98272 C 396.17755,514.81858 408.84232,489.70162 414.61189,467.10772 L 423.48689,472.23272 C 422.26097,451.07724 434.68113,428.26233 450.83064,408.35772 L 455.51814,416.60772 C 467.52689,391.90688 477.02451,381.99197 499.59927,374.00103 z" + style="opacity:1;fill:#eeeeec;fill-opacity:1;fill-rule:evenodd;stroke:#eff1cb;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" /> + <path + style="opacity:1;fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" + d="M 505.90485,365.73272 L 505.3736,365.82647 C 485.689,369.25998 466.41815,376.49266 457.96735,393.79522 L 454.40485,387.57647 L 454.09235,387.01397 L 453.6236,387.48272 C 443.92989,396.7586 433.52309,408.77328 425.84235,420.57647 C 418.63263,431.65584 413.85062,442.49956 414.3736,450.79522 L 409.34235,444.51397 L 408.84235,443.88897 L 408.4986,444.60772 C 402.37467,457.83671 396.19429,474.11179 392.4986,489.04522 C 388.9946,503.20407 387.73979,516.09228 390.9986,524.20147 L 382.71735,519.38897 L 382.02985,518.98272 L 381.96735,519.79522 C 380.40824,543.41224 390.00555,554.68855 401.02985,565.57647 L 391.84235,567.85772 L 389.9986,568.32647 L 391.84235,568.82647 C 397.11688,570.2558 402.11758,571.86507 405.59235,574.54522 C 409.06712,577.22537 411.06333,580.91104 410.46735,586.79522 L 410.46735,586.82647 L 410.46735,612.32647 L 410.46735,612.48272 L 410.5611,612.60772 L 422.0611,629.10772 L 422.96735,630.42022 L 422.96735,628.82647 L 422.96735,589.95147 C 424.48916,583.40757 426.27542,578.90352 428.84235,575.92022 C 431.40928,572.93692 434.74946,571.40505 439.52985,570.82647 L 441.2486,570.60772 L 439.6861,569.88897 L 433.6236,567.01397 C 448.07909,558.31023 464.26865,536.97467 468.52985,516.70147 L 468.71735,515.88897 L 467.9361,516.10772 L 460.4361,518.13897 C 467.09909,511.88271 473.81127,499.48743 480.1861,485.04522 C 486.94715,469.72802 493.25982,452.38054 498.4361,438.51397 L 498.71735,437.76397 L 497.9361,437.82647 L 492.15485,438.23272 C 499.30195,430.64691 503.27438,418.11982 505.21735,404.88897 C 507.23962,391.11815 507.0977,376.61792 505.96735,366.26397 L 505.90485,365.73272 z M 500.46735,374.01397 C 500.84895,397.34606 500.15658,420.4264 479.96735,442.35772 L 479.21735,443.20147 L 480.34235,443.20147 L 488.59235,443.32647 C 475.18685,471.21288 466.46487,499.02017 447.1861,526.79522 L 446.4986,527.79522 L 447.6861,527.57647 L 457.8736,525.63897 C 450.6567,543.94928 438.31602,556.07176 424.9361,560.13897 C 421.2535,508.57034 446.98836,463.05191 468.84235,417.67022 C 468.86245,417.62848 468.88476,417.58696 468.90485,417.54522 L 468.09235,416.98272 C 432.30668,456.99623 416.18115,513.43153 410.09235,559.98272 C 397.96389,553.13549 393.92156,544.06962 389.8111,531.73272 L 398.27985,535.29522 L 399.15485,535.67022 L 398.96735,534.73272 C 392.53101,506.11299 402.52383,485.57026 412.21735,458.57647 L 419.1861,463.23272 L 419.9986,463.79522 L 419.96735,462.82647 C 419.42135,440.89528 434.18838,418.87866 453.77985,399.23272 L 456.4986,406.51397 L 456.8736,407.48272 L 457.40485,406.57647 L 463.3736,396.63897 L 463.40485,396.57647 C 473.25672,383.00695 483.67231,378.58965 500.46735,374.01397 z" + id="path2177" /> + </g> + </g> +</svg> diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl new file mode 100644 index 0000000..8fd1245 --- /dev/null +++ b/tools/tcltk-man2html-utils.tcl @@ -0,0 +1,1629 @@ +## +## Utility functions for Man->HTML converter. Note that these +## functions are specifically intended to work with the format as used +## by Tcl and Tk; they do not cope with arbitrary nroff markup. +## +## Copyright (c) 1995-1997 Roger E. Critchlow Jr +## Copyright (c) 2004-2011 Donal K. Fellows + +set ::manual(report-level) 1 + +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): $procname: $msg" + } else { + puts stderr "$name: $procname: $msg" + } +} + +proc manreport {level msg} { + global manual + if {$level < $manual(report-level)} { + uplevel 1 [list manerror $msg] + } +} + +proc fatal {msg} { + global manual + uplevel 1 [list manerror $msg] + exit 1 +} + +## +## templating +## +proc indexfile {} { + if {[info exists ::TARGET] && $::TARGET eq "devsite"} { + return "index.tml" + } else { + return "contents.htm" + } +} + +proc copyright {copyright {level {}}} { + # We don't actually generate a separate copyright page anymore + #set page "${level}copyright.htm" + #return "<A HREF=\"$page\">Copyright</A> © [htmlize-text [lrange $copyright 2 end]]" + # obfuscate any email addresses that may appear in name + set who [string map {@ (at)} [lrange $copyright 2 end]] + return "Copyright © [htmlize-text $who]" +} + +proc copyout {copyrights {level {}}} { + set out "<div class=\"copy\">" + foreach c $copyrights { + append out "[copyright $c $level]\n" + } + append out "</div>" + return $out +} + +proc CSS {{level ""}} { + return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n" +} + +proc DOCTYPE {} { + return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">" +} + +proc htmlhead {title header args} { + set level "" + if {[lindex $args end] eq "../[indexfile]"} { + # XXX hack - assume same level for CSS file + set level "../" + } + set out "[DOCTYPE]\n<HTML>\n<HEAD><TITLE>$title</TITLE>\n[CSS $level]</HEAD>\n" + foreach {uptitle url} $args { + set header "<a href=\"$url\">$uptitle</a> <small>></small> $header" + } + append out "<BODY><H2>$header</H2>" + global manual + if {[info exists manual(subheader)]} { + set subs {} + foreach {name subdir} $manual(subheader) { + if {$name eq $title} { + lappend subs $name + } else { + lappend subs "<A HREF=\"${level}$subdir/[indexfile]\">$name</A>" + } + } + append out "\n<H3>[join $subs { | }]</H3>" + } + return $out +} + +## +## parsing +## +proc unquote arg { + return [string map [list \" {}] $arg] +} + +proc parse-directive {line codename restname} { + upvar 1 $codename code $restname rest + return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest] +} + +proc htmlize-text {text {charmap {}}} { + # contains some extras for use in nroff->html processing + # build on the list passed in, if any + lappend charmap \ + "–" "–" \ + {&} {&} \ + {\\} "\" \ + {\e} "\" \ + {\ } { } \ + {\|} { } \ + {\0} { } \ + \" {"} \ + {<} {<} \ + {>} {>} \ + \u201c "“" \ + \u201d "”" + + return [string map $charmap $text] +} + +proc process-text {text} { + global manual + # preprocess text; note that this is an incomplete map, and will probably + # need to have things added to it as the manuals expand to use them. + set charmap [list \ + {\&} "\t" \ + {\%} {} \ + "\\\n" "\n" \ + {\(+-} "±" \ + {\(co} "©" \ + {\(em} "—" \ + {\(en} "–" \ + {\(fm} "′" \ + {\(mu} "×" \ + {\(mi} "−" \ + {\(->} "<font size=\"+1\">→</font>" \ + {\fP} {\fR} \ + {\.} . \ + {\(bu} "•" \ + {\*(qo} "ô" \ + ] + lappend charmap {\-\|\-} -- ; # two hyphens + lappend charmap {\-} - ; # a hyphen + + set text [htmlize-text $text $charmap] + # General quoted entity + regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text + while {[string first "\\" $text] >= 0} { + # C R + if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \ + {\1<TT>\2</TT>\3} text]} continue + # B R + if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \ + {\1<B>\2</B>\3} text]} continue + # B I + if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \ + {\1<B>\2</B>\\fI\3} text]} continue + # I R + if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \ + {\1<I>\2</I>\3} text]} continue + # I B + if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \ + {\1<I>\2</I>\\fB\3} text]} continue + # B B, I I, R R + if { + [regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \ + {\1\\fB\2\3} ntext] + || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \ + {\1\\fI\2\3} ntext] + || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \ + {\1\\fR\2\3} ntext] + } { + manerror "impotent font change: $text" + set text $ntext + continue + } + # unrecognized + manerror "uncaught backslash: $text" + set text [string map [list "\\" "\"] $text] + } + return $text +} + +## +## pass 2 text input and matching +## +proc open-text {} { + global manual + set manual(text-length) [llength $manual(text)] + set manual(text-pointer) 0 +} + +proc more-text {} { + global manual + return [expr {$manual(text-pointer) < $manual(text-length)}] +} + +proc next-text {} { + global manual + if {[more-text]} { + set text [lindex $manual(text) $manual(text-pointer)] + incr manual(text-pointer) + return $text + } + manerror "read past end of text" + error "fatal" +} + +proc is-a-directive {line} { + return [string match .* $line] +} + +proc split-directive {line opname restname} { + upvar 1 $opname op $restname rest + set op [string range $line 0 2] + set rest [string trim [string range $line 3 end]] +} + +proc next-op-is {op restname} { + global manual + upvar 1 $restname rest + if {[more-text]} { + set text [lindex $manual(text) $manual(text-pointer)] + if {[string equal -length 3 $text $op]} { + set rest [string range $text 4 end] + incr manual(text-pointer) + return 1 + } + } + return 0 +} + +proc backup-text {n} { + global manual + if {$manual(text-pointer)-$n >= 0} { + incr manual(text-pointer) -$n + } +} + +proc match-text args { + global manual + set nargs [llength $args] + if {$manual(text-pointer) + $nargs > $manual(text-length)} { + return 0 + } + set nback 0 + foreach arg $args { + if {![more-text]} { + backup-text $nback + return 0 + } + set arg [string trim $arg] + set targ [string trim [lindex $manual(text) $manual(text-pointer)]] + if {$arg eq $targ} { + incr nback + incr manual(text-pointer) + continue + } + if {[regexp {^@(\w+)$} $arg all name]} { + upvar 1 $name var + set var $targ + incr nback + incr manual(text-pointer) + continue + } + if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\ + && [string equal $op [lindex $targ 0]]} { + upvar 1 $name var + set var [lrange $targ 1 end] + incr nback + incr manual(text-pointer) + continue + } + backup-text $nback + return 0 + } + return 1 +} + +proc expand-next-text {n} { + global manual + return [join [lrange $manual(text) $manual(text-pointer) \ + [expr {$manual(text-pointer)+$n-1}]] \n\n] +} + +## +## pass 2 output +## +proc man-puts {text} { + global manual + lappend manual(output-$manual(wing-file)-$manual(name)) $text +} + +## +## build hypertext links to tables of contents +## +proc long-toc {text} { + global manual + set here M[incr manual(section-toc-n)] + set manual($manual(name)-id-$text) $here + set there L[incr manual(long-toc-n)] + lappend manual(section-toc) \ + "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>" + return "<A NAME=\"$here\">$text</A>" +} + +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])} { + # 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) \ + "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>" + lappend manual(section-toc) \ + "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>" + return "<A NAME=\"$here\">$switch</A>" +} + +proc std-option-toc {name page} { + global manual + if {[info exists manual(standard-option-$page-$name)]} { + lappend manual(section-toc) <DD>$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) "<DD><A HREF=\"$page.htm#$other\">$name</A>" + return "<A HREF=\"$page.htm#$other\">$name</A>" +} + +## +## process the widget option section +## in widget and options man pages +## +proc output-widget-options {rest} { + global manual + man-puts <DL> + lappend manual(section-toc) <DL> + backup-text 1 + set para {} + while {[next-op-is .OP rest]} { + switch -exact -- [llength $rest] { + 3 { + lassign $rest switch name class + } + 5 { + set switch [lrange $rest 0 2] + set name [lindex $rest 3] + set class [lindex $rest 4] + } + default { + fatal "bad .OP $rest" + } + } + if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch \ + all oswitch switch cswitch]} { + if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch \ + all oswitch switch1 switch2 cswitch]} { + error "not Switch: $switch" + } + set switch "$switch1$cswitch or $oswitch$switch2" + } + if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} { + error "not Name: $name" + } + if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} { + error "not Class: $class" + } + man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch" + man-puts "<DT>Database Name: $oname$name$cname" + man-puts "<DT>Database Class: $oclass$class$cclass" + man-puts <DD>[next-text] + set para <P> + + if {[next-op-is .RS rest]} { + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + switch -exact -- $code { + .RE { + break + } + .SH - .SS { + manerror "unbalanced .RS at section end" + backup-text 1 + break + } + default { + output-directive $line + } + } + } else { + man-puts $line + } + } + } + } + man-puts </DL> + lappend manual(section-toc) </DL> +} + +## +## process .RS lists +## +proc output-RS-list {} { + global manual + if {[next-op-is .IP rest]} { + output-IP-list .RS .IP $rest + if {[match-text .RE .sp .RS @rest .IP @rest2]} { + man-puts <P>$rest + output-IP-list .RS .IP $rest2 + } + if {[match-text .RE .sp .RS @rest .RE]} { + man-puts <P>$rest + return + } + if {[next-op-is .RE rest]} { + return + } + } + man-puts <DL><DD> + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + switch -exact -- $code { + .RE { + break + } + .SH - .SS { + manerror "unbalanced .RS at section end" + backup-text 1 + break + } + default { + output-directive $line + } + } + } else { + man-puts $line + } + } + man-puts </DL> +} + +## +## process .IP lists which may be plain indents, +## numeric lists, or definition lists +## +proc output-IP-list {context code rest} { + global manual + if {![string length $rest]} { + # blank label, plain indent, no contents entry + man-puts <DL><DD> + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + if {$code eq ".IP" && $rest eq {}} { + man-puts "<P>" + continue + } + if {$code in {.br .DS .RS}} { + output-directive $line + } else { + backup-text 1 + break + } + } else { + man-puts $line + } + } + man-puts </DL> + } else { + # labelled list, make contents + if {$context ne ".SH" && $context ne ".SS"} { + man-puts <P> + } + set dl "<DL class=\"[string tolower $manual(section)]\">" + set enddl "</DL>" + if {$code eq ".IP"} { + if {[regexp {^\[[\da-f]+\]|\(?[\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 + set accept_RE 0 + set para {} + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + split-directive $line code rest + switch -exact -- $code { + .IP { + if {$accept_RE} { + output-IP-list .IP $code $rest + continue + } + if {$manual(section) eq "ARGUMENTS"} { + man-puts "$para<DT>$rest<DD>" + } elseif {[regexp {^\[([\da-f]+)\]$} $rest -> value]} { + man-puts "$para<LI value=\"$value\">" + } elseif {[regexp {^\(?([\da-f]+)\)$} $rest -> value]} { + man-puts "$para<LI value=\"$value\">" + } elseif {"•" eq $rest} { + man-puts "$para<LI>" + } else { + man-puts "$para<DT>[long-toc $rest]<DD>" + } + } + .sp - .br - .DS - .CS { + output-directive $line + } + .RS { + if {[match-text .RS]} { + output-directive $line + incr accept_RE 1 + } elseif {[match-text .CS]} { + output-directive .CS + incr accept_RE 1 + } elseif {[match-text .PP]} { + output-directive .PP + incr accept_RE 1 + } elseif {[match-text .DS]} { + output-directive .DS + incr accept_RE 1 + } else { + output-directive $line + } + } + .PP { + if {[match-text @rest1 .br @rest2 .RS]} { + # yet another nroff kludge as above + man-puts "$para<DT>[long-toc $rest1]" + man-puts "<DT>[long-toc $rest2]<DD>" + incr accept_RE 1 + } elseif {[match-text @rest .RE]} { + # gad, this is getting ridiculous + if {!$accept_RE} { + man-puts "$enddl<P>$rest$dl" + backup-text 1 + set para {} + break + } + man-puts "<P>$rest" + incr accept_RE -1 + } elseif {$accept_RE} { + output-directive $line + } else { + backup-text 1 + break + } + } + .RE { + if {!$accept_RE} { + backup-text 1 + break + } + incr accept_RE -1 + } + default { + backup-text 1 + break + } + } + } else { + man-puts $line + } + set para <P> + } + man-puts "$para$enddl" + lappend manual(section-toc) $enddl + 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 {^([^-]+) - (.*)$} [regsub -all {[ \n\r\t]+} $line " "] -> head tail + # output line to manual page untouched + man-puts "$head — $tail" + # output line to long table of contents + lappend manual(section-toc) "<DL><DD>$head — $tail</DD></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) + } + set manual(tooltip-$manual(wing-file)/$manual(name).htm) $line +} + +## +## build a cross-reference link if appropriate +## +proc cross-reference {ref} { + global manual remap_link_target + global ensemble_commands exclude_refs_map exclude_when_followed_by_map + set manname $manual(name) + set mantail $manual(tail) + if {[string match "Tcl_*" $ref] || [string match "Tk_*" $ref] || [string match "Ttk_*" $ref] || [string match "Itcl_*" $ref] || [string match "Tdbc_*" $ref]} { + regexp {^\w+} $ref lref + ## + ## 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($manname-id-$ref)] + } { + 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)] && + $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>" + } + } + if {$lref in {end}} { + # no good place to send this tcl token? + } + return $ref + } + set manref $manual(name-$lref) + ## + ## would be a self reference + ## + foreach name $manref { + if {"$manual(wing-file)/$manname" in $name} { + return $ref + } + } + ## + ## multiple choices for reference + ## + 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" && $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 $manref from $manual(wing-file)/$mantail" + return $ref + } + ## + ## exceptions, sigh, to the rule + ## + if {[info exists exclude_when_followed_by_map($mantail)]} { + upvar 1 text tail + set following_word [lindex [regexp -inline {\S+} $tail] 0] + 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 + } + } + } + if { + [info exists exclude_refs_map($mantail)] + && $lref in $exclude_refs_map($mantail) + } { + return $ref + } + ## + ## return the cross reference + ## + return "<A HREF=\"../$manref.htm\">$ref</A>" +} + +## +## reference generation errors +## +proc reference-error {msg text} { + global manual + puts stderr "$manual(tail): $msg: {$text}" + return $text +} + +## +## insert as many cross references into this text string as are appropriate +## +proc insert-cross-references {text} { + global manual + 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>} + c.tcl {Tcl_} + c.tk {Tk_} + c.ttk {Ttk_} + c.tdbc {Tdbc_} + c.itcl {Itcl_} + 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 + } + } + ## + ## 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 + } + quote { + if {$offset(end-quote) < 0} { + return [reference-error "Missing end quote" $text] + } + if {$invert([lindex $offsets 1]) in {tcl tk ttk}} { + 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] + 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] + } + bold { + if {$offset(end-bold) < 0} { + return [append result $text] + } + if {[string match "c.*" $invert([lindex $offsets 1])]} { + 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] + 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] + } + } + } + c.tk - c.ttk - c.tcl - c.tdbc - c.itcl { + append result [string range $text 0 \ + [expr {[lindex $offsets 0]-1}]] + regexp -indices -start [lindex $offsets 0] {\w+} $text range + set body [string range $text {*}$range] + set text [string range $text[set text ""] \ + [expr {[lindex $range 1]+1}] end] + append result [cross-reference $body] + continue + } + 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] + append result [cross-reference Tcl] + continue + } + 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=\"[string trimright $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] + } + } + } +} + +## +## process formatting directives +## +proc output-directive {line} { + global manual + # process format directive + split-directive $line code rest + switch -exact -- $code { + .BS - .BE { + # man-puts <HR> + } + .SH - .SS { + # drain any open lists + # announce the subject + set manual(section) $rest + # start our own stack of stuff + set manual($manual(name)-$manual(section)) {} + lappend manual(has-$manual(section)) $manual(name) + if {$code ne ".SS"} { + man-puts "<H3>[long-toc $manual(section)]</H3>" + } else { + man-puts "<H4>[long-toc $manual(section)]</H4>" + } + # some sections can simply free wheel their way through the text + # some sections can be processed in their own loops + switch -exact -- [string index $code end]:$manual(section) { + H:NAME { + set names {} + while {1} { + set line [next-text] + if {[is-a-directive $line]} { + backup-text 1 + if {[llength $names]} { + output-name [join $names { }] + } + return + } + lappend names [string trim $line] + } + } + H:SYNOPSIS { + lappend manual(section-toc) <DL> + while {1} { + if { + [next-op-is .nf rest] + || [next-op-is .br rest] + || [next-op-is .fi rest] + } { + continue + } + if { + [next-op-is .SH rest] + || [next-op-is .SS rest] + || [next-op-is .BE rest] + || [next-op-is .SO rest] + } { + backup-text 1 + break + } + if {[next-op-is .sp rest]} { + #man-puts <P> + continue + } + set more [next-text] + if {[is-a-directive $more]} { + manerror "in SYNOPSIS found $more" + backup-text 1 + break + } + foreach more [split $more \n] { + regexp {^(\s*)(.*)} $more -> spaces more + set spaces [string map {" " " "} $spaces] + if {[string length $spaces]} { + set spaces <TT>$spaces</TT> + } + man-puts $spaces$more<BR> + if {$manual(wing-file) in {TclLib TkLib}} { + lappend manual(section-toc) <DD>$more + } + } + } + lappend manual(section-toc) </DL> + return + } + {H:SEE ALSO} { + while {[more-text]} { + if {[next-op-is .SH rest] || [next-op-is .SS rest]} { + backup-text 1 + return + } + set more [next-text] + if {[is-a-directive $more]} { + manerror "$more" + backup-text 1 + return + } + set nmore {} + foreach cr [split $more ,] { + set cr [string trim $cr] + if {![regexp {^<B>.*</B>$} $cr]} { + set cr <B>$cr</B> + } + if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} { + set cr <B>$name</B> + } + lappend nmore $cr + } + man-puts [join $nmore {, }] + } + return + } + H:KEYWORDS { + while {[more-text]} { + if {[next-op-is .SH rest] || [next-op-is .SS rest]} { + backup-text 1 + return + } + set more [next-text] + if {[is-a-directive $more]} { + manerror "$more" + backup-text 1 + return + } + set keys {} + foreach key [split $more ,] { + set key [string trim $key] + 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>" + } + man-puts [join $keys {, }] + } + return + } + } + if {[next-op-is .IP rest]} { + output-IP-list $code .IP $rest + return + } + if {[next-op-is .PP rest]} { + return + } + return + } + .SO { + # When there's a sequence of multiple .SO chunks, process into one + set optslist {} + while 1 { + if {[match-text @stuff .SE]} { + foreach opt [split $stuff \n\t] { + lappend optslist [list $opt $rest] + } + } else { + manerror "unexpected .SO format:\n[expand-next-text 2]" + } + if {![next-op-is .SO rest]} { + break + } + } + output-directive {.SH STANDARD OPTIONS} + man-puts <DL> + lappend manual(section-toc) <DL> + foreach optionpair [lsort -dictionary -index 0 $optslist] { + lassign $optionpair option targetPage + man-puts "<DT><B>[std-option-toc $option $targetPage]</B>" + } + man-puts </DL> + lappend manual(section-toc) </DL> + } + .OP { + output-widget-options $rest + return + } + .IP { + output-IP-list .IP .IP $rest + return + } + .PP - .sp { + man-puts <P> + } + .RS { + output-RS-list + return + } + .br { + man-puts <BR> + return + } + .DS { + if {[next-op-is .ta rest]} { + # skip the leading .ta directive if it is there + } + if {[match-text @stuff .DE]} { + set td "<td><p class=\"tablecell\">" + set bodyText [string map [list \n <tr>$td \t $td] \n$stuff] + man-puts "<dl><dd><table border=\"0\">$bodyText</table></dl>" + #man-puts <PRE>$stuff</PRE> + } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} { + man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>" + } else { + manerror "unexpected .DS format:\n[expand-next-text 2]" + } + return + } + .CS { + if {[next-op-is .ta rest]} { + # ??? + } + if {[match-text @stuff .CE]} { + man-puts <PRE>$stuff</PRE> + } else { + manerror "unexpected .CS format:\n[expand-next-text 2]" + } + return + } + .nf { + if {[match-text @more .fi]} { + foreach more [split $more \n] { + man-puts $more<BR> + } + } elseif {[match-text .RS @more .RE .fi]} { + man-puts <DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts </DL> + } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} { + man-puts <DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts <DL><DD> + foreach more2 [split $more2 \n] { + man-puts $more2<BR> + } + man-puts </DL></DL> + } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} { + man-puts <DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts <DL><DD> + foreach more2 [split $more2 \n] { + man-puts $more2<BR> + } + man-puts </DL><DD> + foreach more3 [split $more3 \n] { + man-puts $more3<BR> + } + man-puts </DL> + } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} { + man-puts <P><DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts <DL><DD> + foreach more2 [split $more2 \n] { + man-puts $more2<BR> + } + man-puts </DL></DL><P> + } elseif {[match-text .RS .sp @more .sp .RE .fi]} { + man-puts <P><DL><DD> + foreach more [split $more \n] { + man-puts $more<BR> + } + man-puts </DL><P> + } else { + manerror "ignoring $line" + } + } + .RE - .DE - .CE { + manerror "unexpected $code" + return + } + .ta - .fi - .na - .ad - .UL - .ie - .el - .ne { + manerror "ignoring $line" + } + default { + manerror "unrecognized format directive: $line" + } + } +} + +## +## merge copyright listings +## +proc merge-copyrights {l1 l2} { + set merge {} + set re1 {^Copyright +(?:\(c\)|\\\(co|©) +(\w.*?)(?:all rights reserved)?(?:\. )*$} + set re2 {^(\d+) +(?:by +)?(\w.*)$} ;# date who + set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$} ;# from to who + set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who + foreach copyright [concat $l1 $l2] { + if {[regexp -nocase -- $re1 $copyright -> info]} { + set info [string trimright $info ". "] ; # remove extra period + if {[regexp -- $re2 $info -> date who]} { + lappend dates($who) $date + continue + } elseif {[regexp -- $re3 $info -> from to who]} { + for {set date $from} {$date <= $to} {incr date} { + lappend dates($who) $date + } + continue + } elseif {[regexp -- $re3 $info -> date1 date2 who]} { + lappend dates($who) $date1 $date2 + continue + } + } + puts "oops: $copyright" + } + foreach who [array names dates] { + set list [lsort -dictionary $dates($who)] + if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} { + lappend merge "Copyright © [lindex $list 0] $who" + } else { + lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who" + } + } + return [lsort -dictionary $merge] +} + +## +## foreach of the man pages in the section specified by +## sectionDescriptor, convert manpages into hypertext in +## the directory specified by outputDir. +## +proc make-manpage-section {outputDir sectionDescriptor} { + global manual overall_title tcltkdesc verbose + global excluded_pages forced_index_pages process_first_patterns + + set LQ \u201c + set RQ \u201d + + lassign $sectionDescriptor \ + manual(wing-glob) \ + manual(wing-name) \ + manual(wing-file) \ + manual(wing-description) + set manual(wing-copyrights) {} + makedirhier $outputDir/$manual(wing-file) + set manual(wing-toc-fp) [open $outputDir/$manual(wing-file)/[indexfile] w] + # whistle + puts stderr "scanning section $manual(wing-name)" + # put the entry for this section into the short table of contents + if {[regexp {^(.+), version (.+)$} $manual(wing-name) -> name version]} { + puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\" TITLE=\"version $version\">$name</A></DT><DD>$manual(wing-description)</DD>" + } else { + puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>" + } + # initialize the wing table of contents + puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \ + $manual(wing-name) $overall_title "../[indexfile]"] + # initialize the short table of contents for this section + set manual(wing-toc) {} + # initialize the man directory for this section + makedirhier $outputDir/$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 -dictionary [glob -nocomplain $manual(wing-glob)]] + # Some pages have to go first so that their links override others + foreach pat $process_first_patterns { + set n [lsearch -glob $manual(pages) $pat] + if {$n >= 0} { + set f [lindex $manual(pages) $n] + 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] + foreach manual_page $manual(pages) { + set manual(page) [file normalize $manual_page] + # whistle + if {$verbose} { + puts stderr "scanning page $manual(page)" + } else { + puts -nonewline stderr . + } + set manual(tail) [file tail $manual(page)] + set manual(name) [file root $manual(tail)] + set manual(section) {} + if {$manual(name) in $excluded_pages} { + # obsolete + if {!$verbose} { + puts stderr "" + } + 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) + lappend manual(all-page-domains) $manual(wing-name) + manreport 100 $manual(name) + while {[gets $manual(infp) line] >= 0} { + manreport 100 $line + if {[regexp {^[`'][/\\]} $line]} { + if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} { + lappend manual(copyrights) $copyright + } + # comment + continue + } + if {"$line" eq {'}} { + # comment + continue + } + if {![parse-directive $line code rest]} { + addbuffer $line + continue + } + switch -exact -- $code { + .if - .nr - .ti - .in - .ie - .el - + .ad - .na - .so - .ne - .AS - .HS - .VE - .VS - . { + # ignore + continue + } + } + switch -exact -- $code { + .SH - .SS { + flushbuffer + if {[llength $rest] == 0} { + gets $manual(infp) rest + } + lappend manual(text) "$code [unquote $rest]" + } + .TH { + flushbuffer + lappend manual(text) "$code [unquote $rest]" + } + .QW { + lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ + inQuote afterwards + addbuffer $LQ [unquote $inQuote] $RQ [unquote $afterwards] + } + .PQ { + lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ + inQuote punctuation afterwards + addbuffer ( $LQ [unquote $inQuote] $RQ \ + [unquote $punctuation] ) [unquote $afterwards] + } + .QR { + lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \ + rangeFrom rangeTo afterwards + addbuffer $LQ [unquote $rangeFrom] "–" \ + [unquote $rangeTo] $RQ [unquote $afterwards] + } + .MT { + addbuffer $LQ$RQ + } + .HS - .UL - .ta { + flushbuffer + lappend manual(text) "$code [unquote $rest]" + } + .BS - .BE - .br - .fi - .sp - .nf { + flushbuffer + if {$rest ne ""} { + if {!$verbose} { + puts stderr "" + } + manerror "unexpected argument: $line" + } + lappend manual(text) $code + } + .AP { + flushbuffer + lappend manual(text) [concat .IP [process-text \ + "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]] + } + .IP { + flushbuffer + regexp {^(.*) +\d+$} $rest all rest + lappend manual(text) ".IP [process-text \ + [unquote [string trim $rest]]]" + } + .TP { + flushbuffer + while {[is-a-directive [set next [gets $manual(infp)]]]} { + if {!$verbose} { + puts stderr "" + } + manerror "ignoring $next after .TP" + } + if {"$next" ne {'}} { + lappend manual(text) ".IP [process-text $next]" + } + } + .OP { + flushbuffer + lassign $rest cmdName dbName dbClass + lappend manual(text) [concat .OP [process-text \ + "\\fB$cmdName\\fR \\fB$dbName\\fR \\fB$dbClass\\fR"]] + } + .PP - .LP { + flushbuffer + lappend manual(text) {.PP} + } + .RS { + flushbuffer + incr manual(.RS) + lappend manual(text) $code + } + .RE { + flushbuffer + incr manual(.RS) -1 + lappend manual(text) $code + } + .SO { + flushbuffer + incr manual(.SO) + if {[llength $rest] == 0} { + lappend manual(text) "$code options" + } else { + lappend manual(text) "$code [unquote $rest]" + } + } + .SE { + flushbuffer + incr manual(.SO) -1 + lappend manual(text) $code + } + .DS { + flushbuffer + incr manual(.DS) + lappend manual(text) $code + } + .DE { + flushbuffer + incr manual(.DS) -1 + lappend manual(text) $code + } + .CS { + flushbuffer + incr manual(.CS) + lappend manual(text) $code + } + .CE { + flushbuffer + incr manual(.CS) -1 + lappend manual(text) $code + } + .de { + while {[gets $manual(infp) line] >= 0} { + if {[string match "..*" $line]} { + break + } + } + } + .. { + if {!$verbose} { + puts stderr "" + } + error "found .. outside of .de" + } + default { + if {!$verbose} { + puts stderr "" + } + flushbuffer + manerror "unrecognized format directive: $line" + } + } + } + flushbuffer + close $manual(infp) + # fixups + if {$manual(.RS) != 0} { + if {!$verbose} { + puts stderr "" + } + puts "unbalanced .RS .RE" + } + if {$manual(.DS) != 0} { + if {!$verbose} { + puts stderr "" + } + puts "unbalanced .DS .DE" + } + if {$manual(.CS) != 0} { + if {!$verbose} { + puts stderr "" + } + puts "unbalanced .CS .CE" + } + if {$manual(.SO) != 0} { + if {!$verbose} { + puts stderr "" + } + puts "unbalanced .SO .SE" + } + # output conversion + open-text + set haserror 0 + if {[next-op-is .HS rest]} { + set manual($manual(wing-file)-$manual(name)-title) \ + "[join [lrange $rest 1 end] { }] [lindex $rest 0] manual page" + } elseif {[next-op-is .TH rest]} { + set manual($manual(wing-file)-$manual(name)-title) \ + "[lindex $rest 0] manual page - [join [lrange $rest 4 end] { }]" + } else { + set haserror 1 + if {!$verbose} { + puts stderr "" + } + manerror "no .HS or .TH record found" + } + if {!$haserror} { + while {[more-text]} { + set line [next-text] + if {[is-a-directive $line]} { + output-directive $line + } else { + man-puts $line + } + } + man-puts [copyout $manual(copyrights) "../"] + set manual(wing-copyrights) [merge-copyrights \ + $manual(wing-copyrights) $manual(copyrights)] + } + # + # make the long table of contents for this page + # + set manual(toc-$manual(wing-file)-$manual(name)) \ + [concat <DL> $manual(section-toc) </DL>] + } + if {!$verbose} { + puts stderr "" + } + + # + # 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 {118 / $width}] + set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}] + set n 0 + catch {unset rows} + foreach name [lsort -dictionary $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] + if {[info exists manual(tooltip-$manual(wing-file)/$tail.htm)]} { + set tooltip $manual(tooltip-$manual(wing-file)/$tail.htm) + set tooltip [string map {[ {\[} ] {\]} $ {\$} \\ \\\\} $tooltip] + regsub {^[^-]+-\s*(.)} $tooltip {[string totitle \1]} tooltip + append rows([expr {$n%$nrows}]) \ + "<td> <a href=\"$tail.htm\" title=\"[subst $tooltip]\">$name</a> </td>" + } else { + append rows([expr {$n%$nrows}]) \ + "<td> <a href=\"$tail.htm\">$name</a> </td>" + } + 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) [copyout $manual(wing-copyrights) "../"] + puts $manual(wing-toc-fp) "</BODY></HTML>" + close $manual(wing-toc-fp) + set manual(merge-copyrights) \ + [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)] +} + +proc makedirhier {dir} { + try { + if {![file isdirectory $dir]} { + file mkdir $dir + } + } on error msg { + return -code error "cannot create directory $dir: $msg" + } +} + +proc addbuffer {args} { + global manual + if {$manual(partial-text) ne ""} { + append manual(partial-text) \n + } + append manual(partial-text) [join $args ""] +} +proc flushbuffer {} { + global manual + if {$manual(partial-text) ne ""} { + lappend manual(text) [process-text $manual(partial-text)] + set manual(partial-text) "" + } +} + +return diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index 59a2a63..89e8e5c 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -1,8 +1,12 @@ -#!/bin/sh -# The next line is executed by /bin/sh, but not tcl \ -exec tclsh "$0" ${1+"$@"} +#!/usr/bin/env tclsh -package require Tcl 8.5 +if {[catch {package require Tcl 8.6} msg]} { + puts stderr "ERROR: $msg" + puts stderr "If running this script from 'make html', set the\ + NATIVE_TCLSH environment\nvariable to point to an installed\ + tclsh8.6 (or the equivalent tclsh86.exe\non Windows)." + exit 1 +} # Convert Ousterhout format man pages into highly crosslinked hypertext. # @@ -16,17 +20,23 @@ package require Tcl 8.5 # try to use this, you'll be very much on your own. # # Copyright (c) 1995-1997 Roger E. Critchlow Jr +# Copyright (c) 2004-2010 Donal K. Fellows -set Version "0.40" - +set ::Version "50/8.6" set ::CSSFILE "docs.css" +## +## Source the utility functions that provide most of the +## implementation of the transformation from nroff to html. +## +source [file join [file dirname [info script]] tcltk-man2html-utils.tcl] + proc parse_command_line {} { global argv Version # These variables determine where the man pages come from and where # the converted pages go to. - global tcltkdir tkdir tcldir webdir build_tcl build_tk + global tcltkdir tkdir tcldir webdir build_tcl build_tk verbose # Set defaults based on original code. set tcltkdir ../.. @@ -35,6 +45,7 @@ proc parse_command_line {} { set webdir ../html set build_tcl 0 set build_tk 0 + set verbose 0 # Default search version is a glob pattern set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}} @@ -61,6 +72,7 @@ proc parse_command_line {} { puts " --tcl build tcl help" puts " --tk build tk help" puts " --useversion version of tcl/tk to search for" + puts " --verbose whether to print longer messages" exit 0 } @@ -87,6 +99,10 @@ proc parse_command_line {} { set build_tk 1 } + --verbose=* { + set verbose [string range $option \ + [string length --verbose=] end] + } default { puts stderr "tcltk-man-html: unrecognized option -- `$option'" exit 1 @@ -113,7 +129,7 @@ proc parse_command_line {} { if {$build_tk} { # Find Tk. set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ - -directory $tcltkdir tk$useversion]] end] + -directory $tcltkdir tk$useversion]] end] if {$tkdir eq ""} { puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" exit 1 @@ -121,6 +137,8 @@ proc parse_command_line {} { puts "using Tk source directory $tkdir" } + puts "verbose messages are [expr {$verbose ? {on} : {off}}]" + # the title for the man pages overall global overall_title set overall_title "" @@ -139,1681 +157,144 @@ proc parse_command_line {} { proc capitalize {string} { return [string toupper $string 0] } - -## -## -## -set manual(report-level) 1 - -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): $procname: $msg" - } else { - puts stderr "$name: $procname: $msg" - } -} - -proc manreport {level msg} { - global manual - if {$level < $manual(report-level)} { - uplevel 1 [list manerror $msg] - } -} - -proc fatal {msg} { - global manual - uplevel 1 [list manerror $msg] - exit 1 -} - + ## -## templating +## Returns the style sheet. ## -proc indexfile {} { - if {[info exists ::TARGET] && $::TARGET eq "devsite"} { - return "index.tml" - } else { - return "contents.htm" - } +proc css-style args { + upvar 1 style style + set body [uplevel 1 [list subst [lindex $args end]]] + set tokens [join [lrange $args 0 end-1] ", "] + append style $tokens " \{" $body "\}\n" } -proc copyright {copyright {level {}}} { - # We don't actually generate a separate copyright page anymore - #set page "${level}copyright.htm" - #return "<A HREF=\"$page\">Copyright</A> © [htmlize-text [lrange $copyright 2 end]]" - # obfuscate any email addresses that may appear in name - set who [string map {@ (at)} [lrange $copyright 2 end]] - return "Copyright © [htmlize-text $who]" -} -proc copyout {copyrights {level {}}} { - set out "<div class=\"copy\">" - foreach c $copyrights { - append out "[copyright $c $level]\n" - } - append out "</div>" - return $out -} -proc CSS {{level ""}} { - return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n" -} -proc DOCTYPE {} { - return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">" -} -proc htmlhead {title header args} { - set level "" - if {[lindex $args end] eq "../[indexfile]"} { - # XXX hack - assume same level for CSS file - set level "../" - } - set out "[DOCTYPE]\n<HTML>\n<HEAD><TITLE>$title</TITLE>\n[CSS $level]</HEAD>\n" - foreach {uptitle url} $args { - set header "<a href=\"$url\">$uptitle</a> <small>></small> $header" - } - append out "<BODY><H2>$header</H2>" - global manual - if {[info exists manual(subheader)]} { - set subs {} - foreach {name subdir} $manual(subheader) { - if {$name eq $title} { - lappend subs $name - } else { - lappend subs "<A HREF=\"${level}$subdir/[indexfile]\">$name</A>" - } - } - append out "\n<H3>[join $subs { | }]</H3>" - } - return $out -} -proc gencss {} { +proc css-stylesheet {} { set hBd "1px dotted #11577b" - return " -body, div, p, th, td, li, dd, ul, ol, dl, dt, blockquote { - font-family: Verdana, sans-serif; -} - -pre, code { font-family: 'Courier New', Courier, monospace; } - -pre { - background-color: #f6fcec; - border-top: 1px solid #6A6A6A; - border-bottom: 1px solid #6A6A6A; - padding: 1em; - overflow: auto; -} - -body { - background-color: #FFFFFF; - font-size: 12px; - line-height: 1.25; - letter-spacing: .2px; - padding-left: .5em; -} - -h1, h2, h3, h4 { - font-family: Georgia, serif; - padding-left: 1em; - margin-top: 1em; -} - -h1 { - font-size: 18px; - color: #11577b; - border-bottom: $hBd; - margin-top: 0px; -} - -h2 { - font-size: 14px; - color: #11577b; - background-color: #c5dce8; - padding-left: 1em; - border: 1px solid #6A6A6A; -} - -h3, h4 { - color: #1674A4; - background-color: #e8f2f6; - border-bottom: $hBd; - border-top: $hBd; -} - -h3 { font-size: 12px; } -h4 { font-size: 11px; } - -.keylist dt, .arguments dt { - width: 20em; - float: left; - padding: 2px; - border-top: 1px solid #999; -} - -.keylist dt { font-weight: bold; } - -.keylist dd, .arguments dd { - margin-left: 20em; - padding: 2px; - border-top: 1px solid #999; -} - -.copy { - background-color: #f6fcfc; - white-space: pre; - font-size: 80%; - border-top: 1px solid #6A6A6A; - margin-top: 2em; -} -" -} - -## -## parsing -## -proc unquote arg { - return [string map [list \" {}] $arg] -} - -proc parse-directive {line codename restname} { - upvar 1 $codename code $restname rest - return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest] -} - -proc htmlize-text {text {charmap {}}} { - # contains some extras for use in nroff->html processing - # build on the list passed in, if any - lappend charmap \ - {&} {&} \ - {\\} "\" \ - {\e} "\" \ - {\ } { } \ - {\|} { } \ - {\0} { } \ - \" {"} \ - {<} {<} \ - {>} {>} \ - \u201c "“" \ - \u201d "”" - - return [string map $charmap $text] -} - -proc process-text {text} { - global manual - # preprocess text - set charmap [list \ - {\&} "\t" \ - {\%} {} \ - "\\\n" "\n" \ - {\(+-} "±" \ - {\(co} "©" \ - {\(em} "—" \ - {\(fm} "′" \ - {\(mu} "×" \ - {\(->} "<font size=\"+1\">→</font>" \ - {\fP} {\fR} \ - {\.} . \ - {\(bu} "•" \ - ] - lappend charmap {\o'o^'} {ô} ; # o-circumflex in re_syntax.n - lappend charmap {\-\|\-} -- ; # two hyphens - lappend charmap {\-} - ; # a hyphen - - set text [htmlize-text $text $charmap] - # General quoted entity - regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text - while {[string first "\\" $text] >= 0} { - # C R - if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \ - {\1<TT>\2</TT>\3} text]} continue - # B R - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \ - {\1<B>\2</B>\3} text]} continue - # B I - if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \ - {\1<B>\2</B>\\fI\3} text]} continue - # I R - if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \ - {\1<I>\2</I>\3} text]} continue - # I B - if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \ - {\1<I>\2</I>\\fB\3} text]} continue - # B B, I I, R R - if { - [regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \ - {\1\\fB\2\3} ntext] - || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \ - {\1\\fI\2\3} ntext] - || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \ - {\1\\fR\2\3} ntext] - } then { - manerror "impotent font change: $text" - set text $ntext - continue - } - # unrecognized - manerror "uncaught backslash: $text" - set text [string map [list "\\" "\"] $text] - } - return $text -} -## -## pass 2 text input and matching -## -proc open-text {} { - global manual - set manual(text-length) [llength $manual(text)] - set manual(text-pointer) 0 -} -proc more-text {} { - global manual - return [expr {$manual(text-pointer) < $manual(text-length)}] -} -proc next-text {} { - global manual - if {[more-text]} { - set text [lindex $manual(text) $manual(text-pointer)] - incr manual(text-pointer) - return $text - } - manerror "read past end of text" - error "fatal" -} -proc is-a-directive {line} { - return [string match .* $line] -} -proc split-directive {line opname restname} { - upvar 1 $opname op $restname rest - set op [string range $line 0 2] - set rest [string trim [string range $line 3 end]] -} -proc next-op-is {op restname} { - global manual - upvar 1 $restname rest - if {[more-text]} { - set text [lindex $manual(text) $manual(text-pointer)] - if {[string equal -length 3 $text $op]} { - set rest [string range $text 4 end] - incr manual(text-pointer) - return 1 - } - } - return 0 -} -proc backup-text {n} { - global manual - if {$manual(text-pointer)-$n >= 0} { - incr manual(text-pointer) -$n - } -} -proc match-text args { - global manual - set nargs [llength $args] - if {$manual(text-pointer) + $nargs > $manual(text-length)} { - return 0 - } - set nback 0 - foreach arg $args { - if {![more-text]} { - backup-text $nback - return 0 - } - set arg [string trim $arg] - set targ [string trim [lindex $manual(text) $manual(text-pointer)]] - if {$arg eq $targ} { - incr nback - incr manual(text-pointer) - continue - } - if {[regexp {^@(\w+)$} $arg all name]} { - upvar 1 $name var - set var $targ - incr nback - incr manual(text-pointer) - continue - } - if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\ - && [string equal $op [lindex $targ 0]]} { - upvar 1 $name var - set var [lrange $targ 1 end] - incr nback - incr manual(text-pointer) - continue - } - backup-text $nback - return 0 - } - return 1 -} -proc expand-next-text {n} { - global manual - return [join [lrange $manual(text) $manual(text-pointer) \ - [expr {$manual(text-pointer)+$n-1}]] \n\n] -} -## -## pass 2 output -## -proc man-puts {text} { - global manual - lappend manual(output-$manual(wing-file)-$manual(name)) $text -} - -## -## build hypertext links to tables of contents -## -proc long-toc {text} { - global manual - set here M[incr manual(section-toc-n)] - set there L[incr manual(long-toc-n)] - lappend manual(section-toc) \ - "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>" - return "<A NAME=\"$here\">$text</A>" -} -proc option-toc {name class switch} { - global manual - if {[string match "*OPTIONS" $manual(section)]} { - if { - $manual(name) ne "ttk_widget" - && $manual(section) ne "WIDGET-SPECIFIC OPTIONS" - } then { - # 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) \ - "<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>" - lappend manual(section-toc) \ - "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>" - return "<A NAME=\"$here\">$switch</A>" -} -proc std-option-toc {name page} { - global manual - if {[info exists manual(standard-option-$page-$name)]} { - lappend manual(section-toc) <DD>$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) "<DD><A HREF=\"$page.htm#$other\">$name</A>" - return "<A HREF=\"$page.htm#$other\">$name</A>" -} -## -## process the widget option section -## in widget and options man pages -## -proc output-widget-options {rest} { - global manual - man-puts <DL> - lappend manual(section-toc) <DL> - backup-text 1 - set para {} - while {[next-op-is .OP rest]} { - switch -exact -- [llength $rest] { - 3 { - lassign $rest switch name class - } - 5 { - set switch [lrange $rest 0 2] - set name [lindex $rest 3] - set class [lindex $rest 4] - } - default { - fatal "bad .OP $rest" - } - } - if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch \ - all oswitch switch cswitch]} { - if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch \ - all oswitch switch1 switch2 cswitch]} { - error "not Switch: $switch" - } - set switch "$switch1$cswitch or $oswitch$switch2" - } - if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} { - error "not Name: $name" - } - if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} { - error "not Class: $class" - } - man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch" - man-puts "<DT>Database Name: $oname$name$cname" - man-puts "<DT>Database Class: $oclass$class$cclass" - man-puts <DD>[next-text] - set para <P> - - if {[next-op-is .RS rest]} { - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - split-directive $line code rest - switch -exact -- $code { - .RE { - break - } - .SH - .SS { - manerror "unbalanced .RS at section end" - backup-text 1 - break - } - default { - output-directive $line - } - } - } else { - man-puts $line - } - } - } - } - man-puts </DL> - lappend manual(section-toc) </DL> -} - -## -## process .RS lists -## -proc output-RS-list {} { - global manual - if {[next-op-is .IP rest]} { - output-IP-list .RS .IP $rest - if {[match-text .RE .sp .RS @rest .IP @rest2]} { - man-puts <P>$rest - output-IP-list .RS .IP $rest2 - } - if {[match-text .RE .sp .RS @rest .RE]} { - man-puts <P>$rest - return - } - if {[next-op-is .RE rest]} { - return - } - } - man-puts <DL><DD> - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - split-directive $line code rest - switch -exact -- $code { - .RE { - break - } - .SH - .SS { - manerror "unbalanced .RS at section end" - backup-text 1 - break - } - default { - output-directive $line - } - } - } else { - man-puts $line - } - } - man-puts </DL> -} - -## -## process .IP lists which may be plain indents, -## numeric lists, or definition lists -## -proc output-IP-list {context code rest} { - global manual - if {![string length $rest]} { - # blank label, plain indent, no contents entry - man-puts <DL><DD> - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - split-directive $line code rest - if {$code eq ".IP" && $rest eq {}} { - man-puts "<P>" - continue - } - if {$code in {.br .DS .RS}} { - output-directive $line - } else { - backup-text 1 - break - } - } else { - man-puts $line - } - } - man-puts </DL> - } else { - # labelled list, make contents - if {$context ne ".SH" && $context ne ".SS"} { - man-puts <P> - } - set dl "<DL class=\"[string tolower $manual(section)]\">" - man-puts $dl - lappend manual(section-toc) $dl - backup-text 1 - set accept_RE 0 - set para {} - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - split-directive $line code rest - switch -exact -- $code { - .IP { - if {$accept_RE} { - output-IP-list .IP $code $rest - continue - } - if {$manual(section) eq "ARGUMENTS" || \ - [regexp {^\[\d+\]$} $rest]} { - man-puts "$para<DT>$rest<DD>" - } elseif {"•" eq $rest} { - man-puts "$para<DT><DD>$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 - } - .RS { - if {[match-text .RS]} { - output-directive $line - incr accept_RE 1 - } elseif {[match-text .CS]} { - output-directive .CS - incr accept_RE 1 - } elseif {[match-text .PP]} { - output-directive .PP - incr accept_RE 1 - } elseif {[match-text .DS]} { - output-directive .DS - incr accept_RE 1 - } else { - output-directive $line - } - } - .PP { - if {[match-text @rest1 .br @rest2 .RS]} { - # yet another nroff kludge as above - man-puts "$para<DT>[long-toc $rest1]" - man-puts "<DT>[long-toc $rest2]<DD>" - incr accept_RE 1 - } elseif {[match-text @rest .RE]} { - # gad, this is getting ridiculous - if {!$accept_RE} { - man-puts "</DL><P>$rest<DL>" - backup-text 1 - set para {} - break - } else { - man-puts "<P>$rest" - incr accept_RE -1 - } - } elseif {$accept_RE} { - output-directive $line - } else { - backup-text 1 - break - } - } - .RE { - if {!$accept_RE} { - backup-text 1 - break - } - incr accept_RE -1 - } - default { - backup-text 1 - break - } - } - } else { - man-puts $line - } - set para <P> - } - man-puts "$para</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</DD></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 - if {[string match "Tcl_*" $ref]} { - set lref $ref - } elseif {[string match "Tk_*" $ref]} { - set lref $ref - } elseif {$ref eq "Tcl"} { - 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] && \ - [info exists manual(name-$name)] && \ - $manual(tail) ne "$name.n"} { - return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>" - } - } - if {$lref in {stdin stdout stderr end}} { - # no good place to send these - # tcl tokens? - # also end - } - return $ref - } - ## - ## would be a self reference - ## - foreach name $manual(name-$lref) { - if {"$manual(wing-file)/$manual(name)" 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 {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd" - || $manual(wing-file) eq "TclLib"} { - return "<A HREF=\"../$tcl_ref.htm\">$ref</A>" - } - if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd" - || $manual(wing-file) eq "TkLib"} { - return "<A HREF=\"../$tk_ref.htm\">$ref</A>" - } - if {$lref eq "exit" && $manual(tail) eq "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 -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}} { - return $ref - } - } - safe.n { - if {$lref in {options}} { - return $ref - } - } - } - ## - ## return the cross reference - ## - return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>" -} -## -## reference generation errors -## -proc reference-error {msg text} { - global manual - puts stderr "$manual(tail): $msg: {$text}" - return $text -} -## -## insert as many cross references into this text string as are appropriate -## -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 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] - } - 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]" - } - 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]" - } - } - 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] - } - 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]" - } - 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]" - } - } - 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] - } - 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] - } - 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] - } - } -} -## -## process formatting directives -## -proc output-directive {line} { - global manual - # process format directive - split-directive $line code rest - switch -exact -- $code { - .BS - .BE { - # man-puts <HR> - } - .SH - .SS { - # drain any open lists - # announce the subject - set manual(section) $rest - # start our own stack of stuff - set manual($manual(name)-$manual(section)) {} - lappend manual(has-$manual(section)) $manual(name) - if {$code ne ".SS"} { - man-puts "<H3>[long-toc $manual(section)]</H3>" - } else { - man-puts "<H4>[long-toc $manual(section)]</H4>" - } - # 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 - } - set names {} - while {1} { - set line [next-text] - if {[is-a-directive $line]} { - backup-text 1 - output-name [join $names { }] - return - } else { - lappend names [string trim $line] - } - } - } - SYNOPSIS { - lappend manual(section-toc) <DL> - while {1} { - if { - [next-op-is .nf rest] - || [next-op-is .br rest] - || [next-op-is .fi rest] - } then { - continue - } - if { - [next-op-is .SH rest] - || [next-op-is .SS rest] - || [next-op-is .BE rest] - || [next-op-is .SO rest] - } then { - backup-text 1 - break - } - if {[next-op-is .sp rest]} { - #man-puts <P> - continue - } - set more [next-text] - if {[is-a-directive $more]} { - manerror "in SYNOPSIS found $more" - backup-text 1 - break - } - foreach more [split $more \n] { - man-puts $more<BR> - if {$manual(wing-file) in {TclLib TkLib}} { - lappend manual(section-toc) <DD>$more - } - } - } - lappend manual(section-toc) </DL> - return - } - {SEE ALSO} { - while {[more-text]} { - if {[next-op-is .SH rest] || [next-op-is .SS rest]} { - backup-text 1 - return - } - set more [next-text] - if {[is-a-directive $more]} { - manerror "$more" - backup-text 1 - return - } - set nmore {} - foreach cr [split $more ,] { - set cr [string trim $cr] - if {![regexp {^<B>.*</B>$} $cr]} { - set cr <B>$cr</B> - } - if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} { - set cr <B>$name</B> - } - lappend nmore $cr - } - man-puts [join $nmore {, }] - } - return - } - KEYWORDS { - while {[more-text]} { - if {[next-op-is .SH rest] || [next-op-is .SS rest]} { - backup-text 1 - return - } - set more [next-text] - if {[is-a-directive $more]} { - manerror "$more" - backup-text 1 - return - } - set keys {} - foreach key [split $more ,] { - set key [string trim $key] - 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>" - } - man-puts [join $keys {, }] - } - return - } - } - if {[next-op-is .IP rest]} { - output-IP-list $code .IP $rest - return - } - if {[next-op-is .PP rest]} { - return - } - return - } - .SO { - set targetPage $rest - if {[match-text @stuff .SE]} { - output-directive {.SH STANDARD OPTIONS} - set opts [split $stuff \n\t] - man-puts <DL> - lappend manual(section-toc) <DL> - foreach option [lsort -dictionary $opts] { - man-puts "<DT><B>[std-option-toc $option $targetPage]</B>" - } - man-puts </DL> - lappend manual(section-toc) </DL> - } else { - manerror "unexpected .SO format:\n[expand-next-text 2]" - } - } - .OP { - output-widget-options $rest - return - } - .IP { - output-IP-list .IP .IP $rest - return - } - .PP { - man-puts <P> - } - .RS { - output-RS-list - return - } - .RE { - manerror "unexpected .RE" - return - } - .br { - man-puts <BR> - return - } - .DE { - manerror "unexpected .DE" - return - } - .DS { - if {[next-op-is .ta rest]} { - # skip the leading .ta directive if it is there - } - if {[match-text @stuff .DE]} { - set td "<td><p style=\"font-size:12px;padding-left:.5em;padding-right:.5em;\">" - set bodyText [string map [list \n <tr>$td \t $td] \n$stuff] - man-puts "<dl><dd><table border=\"0\">$bodyText</table></dl>" - #man-puts <PRE>$stuff</PRE> - } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} { - man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>" - } else { - manerror "unexpected .DS format:\n[expand-next-text 2]" - } - return - } - .CS { - if {[next-op-is .ta rest]} { - # ??? - } - if {[match-text @stuff .CE]} { - man-puts <PRE>$stuff</PRE> - } else { - manerror "unexpected .CS format:\n[expand-next-text 2]" - } - return - } - .CE { - manerror "unexpected .CE" - return - } - .sp { - 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" - } - } - } - .nf { - if {[match-text @more .fi]} { - foreach more [split $more \n] { - man-puts $more<BR> - } - } elseif {[match-text .RS @more .RE .fi]} { - man-puts <DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts </DL> - } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} { - man-puts <DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts <DL><DD> - foreach more2 [split $more2 \n] { - man-puts $more2<BR> - } - man-puts </DL></DL> - } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} { - man-puts <DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts <DL><DD> - foreach more2 [split $more2 \n] { - man-puts $more2<BR> - } - man-puts </DL><DD> - foreach more3 [split $more3 \n] { - man-puts $more3<BR> - } - man-puts </DL> - } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} { - man-puts <P><DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts <DL><DD> - foreach more2 [split $more2 \n] { - man-puts $more2<BR> - } - man-puts </DL></DL><P> - } elseif {[match-text .RS .sp @more .sp .RE .fi]} { - man-puts <P><DL><DD> - foreach more [split $more \n] { - man-puts $more<BR> - } - man-puts </DL><P> - } else { - manerror "ignoring $line" - } - } - .fi { - manerror "ignoring $line" - } - .na - - .ad - - .UL - - .ne { - manerror "ignoring $line" - } - default { - manerror "unrecognized format directive: $line" - } - } -} -## -## merge copyright listings -## -proc merge-copyrights {l1 l2} { - set merge {} - set re1 {^Copyright +(?:\(c\)|\\\(co|©) +(\w.*?)(?:all rights reserved)?(?:\. )*$} - set re2 {^(\d+) +(?:by +)?(\w.*)$} ;# date who - set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$} ;# from to who - set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who - foreach copyright [concat $l1 $l2] { - if {[regexp -nocase -- $re1 $copyright -> info]} { - set info [string trimright $info ". "] ; # remove extra period - if {[regexp -- $re2 $info -> date who]} { - lappend dates($who) $date - continue - } elseif {[regexp -- $re3 $info -> from to who]} { - for {set date $from} {$date <= $to} {incr date} { - lappend dates($who) $date - } - continue - } elseif {[regexp -- $re3 $info -> date1 date2 who]} { - lappend dates($who) $date1 $date2 - continue - } - } - puts "oops: $copyright" - } - foreach who [array names dates] { - set list [lsort -dictionary $dates($who)] - if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} { - lappend merge "Copyright © [lindex $list 0] $who" - } else { - lappend merge "Copyright © [lindex $list 0]-[lrange $list end end] $who" - } - } - return [lsort -dictionary $merge] -} - -proc makedirhier {dir} { - if {![file isdirectory $dir] && \ - [catch {file mkdir $dir} error]} { - return -code error "cannot create directory $dir: $error" - } -} - -proc addbuffer {args} { - global manual - if {$manual(partial-text) ne ""} { - append manual(partial-text) \n - } - append manual(partial-text) [join $args ""] -} -proc flushbuffer {} { - global manual - if {$manual(partial-text) ne ""} { - lappend manual(text) [process-text $manual(partial-text)] - set manual(partial-text) "" - } -} + css-style body div p th td li dd ul ol dl dt blockquote { + font-family: Verdana, sans-serif; + } + css-style pre code { + font-family: 'Courier New', Courier, monospace; + } + css-style pre { + background-color: #f6fcec; + border-top: 1px solid #6A6A6A; + border-bottom: 1px solid #6A6A6A; + padding: 1em; + overflow: auto; + } + css-style body { + background-color: #FFFFFF; + font-size: 12px; + line-height: 1.25; + letter-spacing: .2px; + padding-left: .5em; + } + css-style h1 h2 h3 h4 { + font-family: Georgia, serif; + padding-left: 1em; + margin-top: 1em; + } + css-style h1 { + font-size: 18px; + color: #11577b; + border-bottom: $hBd; + margin-top: 0px; + } + css-style h2 { + font-size: 14px; + color: #11577b; + background-color: #c5dce8; + padding-left: 1em; + border: 1px solid #6A6A6A; + } + css-style h3 h4 { + color: #1674A4; + background-color: #e8f2f6; + border-bottom: $hBd; + border-top: $hBd; + } + css-style h3 { + font-size: 12px; + } + css-style h4 { + font-size: 11px; + } + css-style ".keylist dt" ".arguments dt" { + width: 20em; + float: left; + padding: 2px; + border-top: 1px solid #999; + } + css-style ".keylist dt" { font-weight: bold; } + css-style ".keylist dd" ".arguments dd" { + margin-left: 20em; + padding: 2px; + border-top: 1px solid #999; + } + css-style .copy { + background-color: #f6fcfc; + white-space: pre; + font-size: 80%; + border-top: 1px solid #6A6A6A; + margin-top: 2em; + } + css-style .tablecell { + font-size: 12px; + padding-left: .5em; + padding-right: .5em; + } +} + ## ## 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 manual overall_title tcltkdesc + global manual overall_title tcltkdesc verbose + global excluded_pages forced_index_pages process_first_patterns + makedirhier $html set cssfd [open $html/$::CSSFILE w] - puts $cssfd [gencss] + puts $cssfd [css-stylesheet] close $cssfd set manual(short-toc-n) 1 set manual(short-toc-fp) [open $html/[indexfile] w] puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title] puts $manual(short-toc-fp) "<DL class=\"keylist\">" set manual(merge-copyrights) {} + foreach arg $args { # preprocess to set up subheader for the rest of the files if {![llength $arg]} { continue } - set name [lindex $arg 1] - set file [lindex $arg 2] + lassign $arg -> name file + if {[regexp {(.*)(?: Package)? Commands(?:, version .*)?} $name -> pkg]} { + set name "$pkg Commands" + } elseif {[regexp {(.*)(?: Package)? C API(?:, version .*)?} $name -> pkg]} { + set name "$pkg C API" + } lappend manual(subheader) $name $file } - foreach arg $args { - if {![llength $arg]} { - continue - } - 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)/[indexfile] 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)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>" - # initialize the wing table of contents - puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \ - $manual(wing-name) $overall_title "../[indexfile]"] - # 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 -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]" - } - # set manual(pages) [lrange $manual(pages) 0 5] - set LQ \u201c - set RQ \u201d - foreach manual_page $manual(pages) { - set manual(page) $manual_page - # 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 {$manual(name) in {case pack-old menubar}} { - # 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(copyrights) "Copyright © 1995-1997 Roger E. Critchlow Jr." - 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\)|\\\(co).*$} $line copyright]} { - lappend manual(copyrights) $copyright - } - # comment - continue - } - if {"$line" eq {'}} { - # comment - continue - } - if {![parse-directive $line code rest]} { - addbuffer $line - continue - } - switch -exact -- $code { - .ad - .na - .so - .ne - .AS - .VE - .VS - . { - # ignore - continue - } - } - switch -exact -- $code { - .SH - .SS { - flushbuffer - if {[llength $rest] == 0} { - gets $manual(infp) rest - } - lappend manual(text) "$code [unquote $rest]" - } - .TH { - flushbuffer - lappend manual(text) "$code [unquote $rest]" - } - .QW { - set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] - addbuffer $LQ [unquote [lindex $rest 0]] $RQ \ - [unquote [lindex $rest 1]] - } - .PQ { - set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] - addbuffer ( $LQ [unquote [lindex $rest 0]] $RQ \ - [unquote [lindex $rest 1]] ) \ - [unquote [lindex $rest 2]] - } - .QR { - set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] - addbuffer $LQ [unquote [lindex $rest 0]] - \ - [unquote [lindex $rest 1]] $RQ \ - [unquote [lindex $rest 2]] - } - .MT { - addbuffer $LQ$RQ - } - .HS - .UL - .ta { - flushbuffer - lappend manual(text) "$code [unquote $rest]" - } - .BS - .BE - .br - .fi - .sp - .nf { - flushbuffer - if {"$rest" ne {}} { - manerror "unexpected argument: $line" - } - lappend manual(text) $code - } - .AP { - flushbuffer - lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]] - } - .IP { - flushbuffer - regexp {^(.*) +\d+$} $rest all rest - lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]" - } - .TP { - flushbuffer - while {[is-a-directive [set next [gets $manual(infp)]]]} { - manerror "ignoring $next after .TP" - } - if {"$next" ne {'}} { - lappend manual(text) ".IP [process-text $next]" - } - } - .OP { - flushbuffer - lappend manual(text) [concat .OP [process-text \ - "\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]] - } - .PP - .LP { - flushbuffer - lappend manual(text) {.PP} - } - .RS { - flushbuffer - incr manual(.RS) - lappend manual(text) $code - } - .RE { - flushbuffer - incr manual(.RS) -1 - lappend manual(text) $code - } - .SO { - flushbuffer - incr manual(.SO) - if {[llength $rest] == 0} { - lappend manual(text) "$code options" - } else { - lappend manual(text) "$code [unquote $rest]" - } - } - .SE { - flushbuffer - incr manual(.SO) -1 - lappend manual(text) $code - } - .DS { - flushbuffer - incr manual(.DS) - lappend manual(text) $code - } - .DE { - flushbuffer - incr manual(.DS) -1 - lappend manual(text) $code - } - .CS { - flushbuffer - incr manual(.CS) - lappend manual(text) $code - } - .CE { - flushbuffer - 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 { - flushbuffer - manerror "unrecognized format directive: $line" - } - } - } - flushbuffer - close $manual(infp) - # fixups - if {$manual(.RS) != 0} { - 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 - set haserror 0 - if {[next-op-is .HS rest]} { - set manual($manual(name)-title) \ - "[lrange $rest 1 end] [lindex $rest 0] manual page" - } elseif {[next-op-is .TH rest]} { - set manual($manual(name)-title) "[lindex $rest 0] manual page - [lrange $rest 4 end]" - } else { - set haserror 1 - manerror "no .HS or .TH record found" - } - if {!$haserror} { - while {[more-text]} { - set line [next-text] - if {[is-a-directive $line]} { - output-directive $line - } else { - man-puts $line - } - } - man-puts [copyout $manual(copyrights) "../"] - set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)] - } - # - # make the long table of contents for this page - # - set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL>] - } - # - # 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 -dictionary $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> + ## + ## parse the manpages in a section of the docs (split by + ## package) and construct formatted manpages + ## + foreach arg $args { + if {[llength $arg]} { + make-manpage-section $html $arg } - puts $manual(wing-toc-fp) </table> - - # - # insert wing copyrights - # - puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"] - puts $manual(wing-toc-fp) "</BODY></HTML>" - close $manual(wing-toc-fp) - set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)] } ## ## build the keyword index. ## + if {!$verbose} { + puts stderr "Assembling index" + } file delete -force -- $html/Keywords makedirhier $html/Keywords set keyfp [open $html/Keywords/[indexfile] w] @@ -1831,7 +312,7 @@ proc make-man-pages {html args} { lappend keyheader $a } } - set keyheader "<H3>[join $keyheader " |\n"]</H3>" + set keyheader <H3>[join $keyheader " |\n"]</H3> puts $keyfp $keyheader foreach a $letters { set keys [array names manual "keyword-\[[string totitle $a$a]\]*"] @@ -1853,7 +334,15 @@ proc make-man-pages {html args} { foreach man $manual(keyword-$k) { set name [lindex $man 0] set file [lindex $man 1] - lappend refs "<A HREF=\"../$file\">$name</A>" + if {[info exists manual(tooltip-$file)]} { + set tooltip $manual(tooltip-$file) + if {[string match {*[<>""]*} $tooltip]} { + manerror "bad tooltip for $file: \"$tooltip\"" + } + lappend refs "<A HREF=\"../$file\" TITLE=\"$tooltip\">$name</A>" + } else { + lappend refs "<A HREF=\"../$file\">$name</A>" + } } puts $afp "[join $refs {, }]</DD>" } @@ -1882,81 +371,378 @@ proc make-man-pages {html args} { ## output man pages ## unset manual(section) - foreach path $manual(all-pages) { + if {!$verbose} { + puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links and write out" + } + foreach path $manual(all-pages) wing_name $manual(all-page-domains) { 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 outfd [open $html/$manual(wing-file)/$manual(name).htm w] - puts $outfd [htmlhead "$manual($manual(name)-title)" \ - $manual(name) $manual(wing-file) "[indexfile]" \ - $overall_title "../[indexfile]"] - if { - (($ntext > 60) && ($ntoc > 32)) || $manual(tail) in { - Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType - CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash - GetJustify GetPixels GetVisual ParseArgv QueueEvent - } - } then { + try { + 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 { - puts $outfd $item + incr ntoc [llength [split $item \n]] + incr ntoc } + if {$verbose} { + puts stderr "rescanning page $manual(name) $ntoc/$ntext" + } else { + puts -nonewline stderr . + } + set outfd [open $html/$manual(wing-file)/$manual(name).htm w] + puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \ + $manual(name) $wing_name "[indexfile]" \ + $overall_title "../[indexfile]"] + if {($ntext > 60) && ($ntoc > 32)} { + foreach item $toc { + puts $outfd $item + } + } elseif {$manual(name) in $forced_index_pages} { + if {!$verbose} {puts stderr ""} + manerror "forcing index generation" + foreach item $toc { + puts $outfd $item + } + } + foreach item $text { + puts $outfd [insert-cross-references $item] + } + puts $outfd "</BODY></HTML>" + } on error msg { + if {$verbose} { + puts stderr $msg + } else { + puts stderr "\nError when processing $manual(name): $msg" + } + } finally { + catch {close $outfd} } - foreach item $text { - puts $outfd [insert-cross-references $item] - } - puts $outfd "</BODY></HTML>" - close $outfd + } + if {!$verbose} { + puts stderr "\nDone" } return {} } + +## +## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk). +## +proc plus-base {var root glob name dir desc} { + global tcltkdir + if {$var} { + if {[file exists $tcltkdir/$root/README]} { + set f [open $tcltkdir/$root/README] + set d [read $f] + close $f + if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} { + append name ", version $version" + } + } + set glob $root/$glob + return [list $tcltkdir/$glob $name $dir $desc] + } +} + +## +## Helper for assembling the descriptions of contributed packages. +## +proc plus-pkgs {type args} { + global build_tcl tcltkdir tcldir + if {$type ni {n 3}} { + error "unknown type \"$type\": must be 3 or n" + } + if {!$build_tcl} return + set result {} + set pkgsdir $tcltkdir/$tcldir/pkgs + foreach {dir name version} $args { + set globpat $pkgsdir/$dir/doc/*.$type + if {![llength [glob -type f -nocomplain $globpat]]} { + # Fallback for manpages generated using doctools + set globpat $pkgsdir/$dir/doc/man/*.$type + if {![llength [glob -type f -nocomplain $globpat]]} { + continue + } + } + set dir [string trimright $dir "0123456789-."] + switch $type { + n { + set title "$name Package Commands" + if {$version ne ""} { + append title ", version $version" + } + set dir [string totitle $dir]Cmd + set desc \ + "The additional commands provided by the $name package." + } + 3 { + set title "$name Package C API" + if {$version ne ""} { + append title ", version $version" + } + set dir [string totitle $dir]Lib + set desc \ + "The additional C functions provided by the $name package." + } + } + lappend result [list $globpat $title $dir $desc] + } + return $result +} + +## +## Set up some special cases. It would be nice if we didn't have them, +## but we do... +## +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 font grab grid image option pack place selection tk + tkwait ttk::style winfo wm itcl::delete itcl::find itcl::is +} +array set remap_link_target { + stdin Tcl_GetStdChannel + stdout Tcl_GetStdChannel + stderr Tcl_GetStdChannel + 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 + Tcl_OpenFileChannelProc Tcl_FSOpenFileChannel + errorinfo env + errorcode env + tcl_pkgpath env + Tcl_Command Tcl_CreateObjCommand + Tcl_CmdProc Tcl_CreateObjCommand + Tcl_CmdDeleteProc Tcl_CreateObjCommand + Tcl_ObjCmdProc Tcl_CreateObjCommand + Tcl_Channel Tcl_OpenFileChannel + Tcl_WideInt Tcl_NewIntObj + Tcl_ChannelType Tcl_CreateChannel + Tcl_DString Tcl_DStringInit + Tcl_Namespace Tcl_AppendExportList + Tcl_Object Tcl_NewObjectInstance + Tcl_Class Tcl_GetObjectAsClass + Tcl_Event Tcl_QueueEvent + Tcl_Time Tcl_GetTime + Tcl_ThreadId Tcl_CreateThread + Tk_Window Tk_WindowId + Tk_3DBorder Tk_Get3DBorder + Tk_Anchor Tk_GetAnchor + Tk_Cursor Tk_GetCursor + Tk_Dash Tk_GetDash + Tk_Font Tk_GetFont + Tk_Image Tk_GetImage + Tk_ImageMaster Tk_GetImage + Tk_ItemType Tk_CreateItemType + Tk_Justify Tk_GetJustify + Ttk_Theme Ttk_GetTheme +} +array set exclude_refs_map { + bind.n {button destroy option} + clock.n {next} + history.n {exec} + next.n {unknown} + zlib.n {binary close filename text} + canvas.n {bitmap text} + console.n {eval} + checkbutton.n {image} + clipboard.n {string} + entry.n {string} + event.n {return} + font.n {menu} + getOpenFile.n {file open text} + grab.n {global} + interp.n {time} + menu.n {checkbutton radiobutton} + messageBox.n {error info} + options.n {bitmap image set} + radiobutton.n {image} + safe.n {join split} + scale.n {label variable} + scrollbar.n {set} + selection.n {string} + tcltest.n {error} + tkvars.n {tk} + tkwait.n {variable} + tm.n {exec} + ttk_checkbutton.n {variable} + ttk_combobox.n {selection} + ttk_entry.n {focus variable} + ttk_intro.n {focus text} + ttk_label.n {font text} + ttk_labelframe.n {text} + ttk_menubutton.n {flush} + ttk_notebook.n {image text} + ttk_progressbar.n {variable} + ttk_radiobutton.n {variable} + ttk_scale.n {variable} + ttk_scrollbar.n {set} + ttk_spinbox.n {format} + ttk_treeview.n {text open} + ttk_widget.n {image text variable} + TclZlib.3 {binary flush filename text} +} +array set exclude_when_followed_by_map { + canvas.n { + bind widget + focus widget + image are + lower widget + raise widget + } + selection.n { + clipboard selection + clipboard ; + } + ttk_image.n { + image imageSpec + } + fontchooser.n { + tk fontchooser + } +} + +try { + # Parse what the user told us to do + parse_command_line + + # Some strings depend on what options are specified + set tcltkdesc ""; set cmdesc ""; set appdir "" + if {$build_tcl} { + append tcltkdesc "Tcl" + append cmdesc "Tcl" + append appdir "$tcldir" + } + if {$build_tcl && $build_tk} { + append tcltkdesc "/" + append cmdesc " and " + append appdir "," + } + if {$build_tk} { + append tcltkdesc "Tk" + append cmdesc "Tk" + append appdir "$tkdir" + } -parse_command_line + apply {{} { + global packageBuildList tcltkdir tcldir build_tcl -set tcltkdesc ""; set cmdesc ""; set appdir "" -if {$build_tcl} { - append tcltkdesc "Tcl" - append cmdesc "Tcl" - append appdir "$tcldir" -} -if {$build_tcl && $build_tk} { - append tcltkdesc "/" - append cmdesc " and " - append appdir "," -} -if {$build_tk} { - append tcltkdesc "Tk" - append cmdesc "Tk" - append appdir "$tkdir" -} + # When building docs for Tcl, try to build docs for bundled packages too + set packageBuildList {} + if {$build_tcl} { + set pkgsDir [file join $tcltkdir $tcldir pkgs] + set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *] + + foreach dir [lsort $subdirs] { + # Parse the subdir name into (name, version) as fallback... + set description [split $dir -] + if {2 != [llength $description]} { + regexp {([^0-9]*)(.*)} $dir -> n v + set description [list $n $v] + } + + # ... but try to extract (name, version) from subdir contents + try { + set f [open [file join $pkgsDir $dir configure.in]] + foreach line [split [read $f] \n] { + if {2 == [scan $line \ + { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} { + set description [list $n $v] + break + } + } + } finally { + catch {close $f; unset f} + } -set usercmddesc "The interpreters which implement $cmdesc." -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.} + if {[file exists [file join $pkgsDir $dir configure]]} { + # Looks like a package, record our best extraction attempt + lappend packageBuildList $dir {*}$description + } + } + } + + # Get the list of packages to try, and what their human-readable names + # are. Note that the package directory list should be version-less. + try { + set packageDirNameMap {} + if {$build_tcl} { + set f [open $tcltkdir/$tcldir/pkgs/package.list.txt] + try { + foreach line [split [read $f] \n] { + if {[string trim $line] eq ""} continue + if {[string match #* $line]} continue + lassign $line dir name + lappend packageDirNameMap $dir $name + } + } finally { + close $f + } + } + } trap {POSIX ENOENT} {} { + set packageDirNameMap { + itcl {[incr Tcl]} + tdbc {TDBC} + thread Thread + } + } -if {1} { - if {[catch { - make-man-pages $webdir \ - "$tcltkdir/{$appdir}/doc/*.1 \"$tcltkdesc Applications\" UserCmd {$usercmddesc}" \ - [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" : ""}] \ - [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" : ""}] \ - [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" : ""}] \ - [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" : ""}] - } error]} { - puts $error\n$errorInfo + # Convert to human readable names, if applicable + for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} { + lassign [lrange $packageBuildList $idx $idx+2] d n v + if {[dict exists $packageDirNameMap $n]} { + lset packageBuildList $idx+1 [dict get $packageDirNameMap $n] + } } + }} + + # + # Invoke the scraper/converter engine. + # + make-man-pages $webdir \ + [list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \ + "The interpreters which implement $cmdesc."] \ + [plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \ + "The commands which the <B>tclsh</B> interpreter implements."] \ + [plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \ + "The additional commands which the <B>wish</B> interpreter implements."] \ + {*}[plus-pkgs n {*}$packageBuildList] \ + [plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \ + "The C functions which a Tcl extended C program may use."] \ + [plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \ + "The additional C functions which a Tk extended C program may use."] \ + {*}[plus-pkgs 3 {*}$packageBuildList] +} on error {msg opts} { + # On failure make sure we show what went wrong. We're not supposed + # to get here though; it represents a bug in the script. + puts $msg\n[dict get $opts -errorinfo] + exit 1 } + +# Local-Variables: +# mode: tcl +# End: diff --git a/tools/tsdPerf.c b/tools/tsdPerf.c new file mode 100644 index 0000000..40004b1 --- /dev/null +++ b/tools/tsdPerf.c @@ -0,0 +1,59 @@ +#include <tcl.h> + +extern DLLEXPORT Tcl_PackageInitProc Tsdperf_Init; + +static Tcl_ThreadDataKey key; + +typedef struct { + int value; +} TsdPerf; + + +static int +tsdPerfSetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { + TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf)); + int i; + + if (2 != objc) { + Tcl_WrongNumArgs(interp, 1, objv, "value"); + return TCL_ERROR; + } + + if (TCL_OK != Tcl_GetIntFromObj(interp, objv[1], &i)) { + return TCL_ERROR; + } + + perf->value = i; + + return TCL_OK; +} + +static int +tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { + TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf)); + + + Tcl_SetObjResult(interp, Tcl_NewIntObj(perf->value)); + + return TCL_OK; +} + +int +Tsdperf_Init(Tcl_Interp *interp) { + if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { + return TCL_ERROR; + } + + Tcl_CreateObjCommand(interp, "tsdPerfSet", tsdPerfSetObjCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "tsdPerfGet", tsdPerfGetObjCmd, NULL, NULL); + + return TCL_OK; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ diff --git a/tools/tsdPerf.tcl b/tools/tsdPerf.tcl new file mode 100644 index 0000000..360ca9c --- /dev/null +++ b/tools/tsdPerf.tcl @@ -0,0 +1,24 @@ + +package require Thread + +set ::tids [list] +for {set i 0} {$i < 4} {incr i} { + lappend ::tids [thread::create [string map [list IVALUE $i] { + set curdir [file dirname [info script]] + load [file join $curdir tsdPerf[info sharedlibextension]] + + while 1 { + tsdPerfSet IVALUE + } + }]] +} + +puts TIDS:$::tids + +set curdir [file dirname [info script]] +load [file join $curdir tsdPerf[info sharedlibextension]] + +tsdPerfSet 1234 +while 1 { + puts "TIME:[time {set value [tsdPerfGet]} 1000] VALUE:$value" +} |
