docbook.tcl, instant: finish remaining help generation issues with tcl

In this commit, we convert FreeBSD and OpenBSD to use a system version
of TCL (8.6).

We also get rid of the hairy and buggy "CompareI18NStrings" custom Tcl
function and use the newer Tcl's builtin dictionary sort mechanism for
generating the Indexes and Glossaries, which were silently broken in
previous commits.

It was just not possible to use the same Tcl code in modern versions
of Tcl in addition to the ancient version included with CDE - so, now
we will always depend on the system version.  It's been tested with
8.6 and 8.7 versions of Tcl with great results.
This commit is contained in:
Jon Trulson
2018-09-22 12:27:27 -06:00
parent 1fb82e3327
commit 77a027039c
4 changed files with 22 additions and 122 deletions

View File

@@ -123,24 +123,6 @@ if {[info commands OutputString] == ""} {
}
# set up a default string compare routine so everything works even
# if run outside of instant(1); it won't really be i18n safe, but
# it'll give us a dictionary sort
if {[info commands CompareI18NStrings] == ""} {
proc CompareI18NStrings {string1 string2} {
set string1 [string toupper $string1]
set string2 [string toupper $string2]
if {$string1 > $string2} {
return 1
} else if {$string1 < $string2} {
return -1
} else {
return 0
}
}
}
# emit a string to the output stream
proc Emit {string} {
OutputString $string
@@ -1629,6 +1611,8 @@ proc EndPart {} {
set glossString [lindex $currentGlossArray($name) 2]
UserError "No glossary definition for \"$glossString\"" no
}
} else {
puts stderr "EndPart: currentGlossArray: index does not exist: '$name'"
}
}
@@ -2216,11 +2200,14 @@ proc SortAndEmitGlossary {popForm} {
append sortArray($sortAs) $content
}
set names [lsort -command CompareI18NStrings [array names sortArray]]
foreach name $names {
set idxnames [lsort -dictionary [array names sortArray]]
foreach name $idxnames {
# puts stderr "JET1: name: $name"
if {[info exists sortArray($name)]} {
Emit $sortArray($name)
} else {
puts stderr "SortAndEmitGlossary: sortArray index does not exist: '$name'"
}
}
@@ -2479,14 +2466,14 @@ proc WriteIndex {} {
set file [open "${baseName}.idx" w]
# sort the index using our special I18N safe sort function that
# gives us a dictionary (case insensitive) sort
set names [lsort -command CompareI18NStrings [array names indexArray]]
# sort the index
if {[set length [llength $names]]} {
set idxnames [lsort -dictionary [array names indexArray]]
if {[set length [llength $idxnames]]} {
set oldLevel 0
puts $file "<INDEX COUNT=\"$length\">"
foreach name $names {
foreach name $idxnames {
if {[info exists indexArray($name)]} {
set thisEntry $indexArray($name)
switch [lindex $thisEntry 0] {
@@ -2506,6 +2493,8 @@ proc WriteIndex {} {
puts -nonewline $file "<ENTRY[Locs $thisEntry]>"
puts -nonewline $file [lindex $thisEntry 3]
set oldLevel [lindex $thisEntry 0]
} else {
puts stderr "WriteIndex: index does not exist: '$name'"
}
}