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.

diff --git a/cde/programs/dtdocbook/Imakefile b/cde/programs/dtdocbook/Imakefile
index a2504152c315eff6cb8e6ab06860570cc73db1a6..2e039ad89399366d9d67c6c71fea38c8bff261aa 100644 (file)
--- a/cde/programs/dtdocbook/Imakefile
+++ b/cde/programs/dtdocbook/Imakefile
@@ -3,13 +3,7 @@ XCOMM $XConsortium: Imakefile /main/6 1996/10/24 00:10:08 cde-hp $
 #define IHaveSubdirs
 #define PassCDebugFlags 'CDEBUGFLAGS=$(CDEBUGFLAGS)'
 
-#if defined(LinuxArchitecture)
-TCLDIR =
-#else
-TCLDIR = tcl
-#endif
-
-SUBDIRS = doc2sdl lib $(TCLDIR) instant xlate_locale
+SUBDIRS = doc2sdl lib instant xlate_locale
 
 MakeSubdirs($(SUBDIRS))
 DependSubdirs($(SUBDIRS))

diff --git a/cde/programs/dtdocbook/doc2sdl/docbook.tcl b/cde/programs/dtdocbook/doc2sdl/docbook.tcl
index 3cef0f92596be904b369d7842a91f529aa4fc89c..17a0d08b81b6d7a56e86347173c5cba724fb225d 100755 (executable)
--- a/cde/programs/dtdocbook/doc2sdl/docbook.tcl
+++ b/cde/programs/dtdocbook/doc2sdl/docbook.tcl
@@ -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'"
             }
        }
 

diff --git a/cde/programs/dtdocbook/instant/Imakefile b/cde/programs/dtdocbook/instant/Imakefile
index 01e4e8e81aafc0b8546f5d7d982bbde59a91cdd6..0969f10b6086df4826f36febc71b3238e43b727b 100644 (file)
--- a/cde/programs/dtdocbook/instant/Imakefile
+++ b/cde/programs/dtdocbook/instant/Imakefile
@@ -2,12 +2,15 @@ XCOMM $XConsortium: Imakefile /main/6 1996/11/29 11:06:09 rswiston $
 
 XLATESRC  = $(DTSVCSRC)/DtUtil2
 
+TCLINC =
+TCLLIB =
+
 #if defined(LinuxArchitecture)
 TCLINC = -I/usr/include/tcl
 TCLLIB = -ltcl
-#else
-TCLINC = -I../tcl
-TCLLIB = ../tcl/libtcl.a
+#elif defined(FreeBSDArchitecture) || defined(OpenBSDArchitecture)
+TCLINC = -I/usr/local/include/tcl8.6
+TCLLIB = -ltcl86
 #endif
 
 INCLUDES = -I../lib/tptregexp -I$(XLATESRC) $(TCLINC)

diff --git a/cde/programs/dtdocbook/instant/main.c b/cde/programs/dtdocbook/instant/main.c
index 9860d64da15c1af6ec037f93024d18cec875ccf1..7dfe91c606e2b6aa1f0c54f25a0fa90ef7581f20 100644 (file)
--- a/cde/programs/dtdocbook/instant/main.c
+++ b/cde/programs/dtdocbook/instant/main.c
@@ -116,10 +116,6 @@ static int DefaultOutputString(ClientData clientData,
                               Tcl_Interp *interp,
                               int argc,
                               const char *argv[]);
-static int CompareI18NStrings(ClientData clientData,
-                             Tcl_Interp *interp,
-                             int argc,
-                             const char *argv[]);
 static int TclReadLocaleStrings(ClientData clientData,
                                Tcl_Interp *interp,
                                int argc,
@@ -208,17 +204,6 @@ main(
                      0,
                      0);
 
-    /* Add a function to the interpreter to compare to strings.  Our
-     * comparison will unmung any i18n characters (see
-     * {Un}EscapeI18NChars()) and uppercase the strings before
-     * comparison to insure we get a dictionary sort.  We also use the
-     * nl_strcmp() function to get proper i18n collation */
-    Tcl_CreateCommand(interpreter,
-                      "CompareI18NStrings",
-                     CompareI18NStrings,
-                     0,
-                     0);
-
     /* Add a function to read a localized set of data from a file.
      * We'll make sure the munging takes place so we can parse it
      * in Tcl and any strings we get will output properly when
@@ -444,77 +429,6 @@ static int DefaultOutputString(ClientData clientData,
     return retCode;
 }
 
-
-static int CompareI18NStrings(ClientData clientData,
-                             Tcl_Interp *interp,
-                             int argc,
-                             const char *argv[])
-{
-    int   ret_val, len;
-    char *ret_string, *cp;
-
-    if (argc < 3) {
-       Tcl_SetResult(interpreter,
-                     "Missing string(s) to compare",
-                     TCL_VOLATILE);
-       return TCL_ERROR;
-    }
-
-    if (argc > 3) {
-       Tcl_SetResult(interpreter, "Too many arguments", TCL_VOLATILE);
-       return TCL_ERROR;
-    }
-
-    /* unmung the two strings (see {Un}EscapeI18NChars()) */
-    UnEscapeI18NChars(argv[1]);
-    UnEscapeI18NChars(argv[2]);
-
-    /* upper case the strings to insure a dictionary sort */
-    cp = argv[1];
-    while (*cp) {
-       if ((len = mblen(cp, MB_CUR_MAX)) == 1) {
-           if (isalpha(*cp)) {
-               *cp = toupper(*cp);
-           }
-           cp++;
-       } else {
-         if (len > 0)
-           cp += len;
-         else
-           break; /* JET - we should be done here... */
-       }
-    }
-    cp = argv[2];
-    while (*cp) {
-       if ((len = mblen(cp, MB_CUR_MAX)) == 1) {
-           if (isalpha(*cp)) {
-               *cp = toupper(*cp);
-           }
-           cp++;
-       } else {
-         if (len > 0)
-           cp += len;
-         else
-           break; /* JET - we should be done here... */
-       }
-    }
-
-    /* compare the strings using an I18N safe sort */
-    ret_val = strcoll(argv[1], argv[2]);
-    if (ret_val > 0) {
-       ret_string = "1";
-    } else if (ret_val < 0) {
-       ret_string = "-1";
-    } else {
-       ret_string = "0";
-    }
-
-    Tcl_SetResult(interpreter, ret_string, TCL_VOLATILE);
-
-    return TCL_OK;
-}
-
-
 static int TclPrintLocation(ClientData clientData,
                            Tcl_Interp *interp,
                            int argc,
@@ -943,7 +857,7 @@ EscapeI18NChars(
 
 
 static char *
-ReadLocaleStrings(char *file_name, int *ret_code) {
+ReadLocaleStrings(const char *file_name, int *ret_code) {
     int          fd;
     char        *pBuf;
     char        *i18nBuf;