[GRASS-SVN] r35199 - in grass/trunk/lib: . form

svn_grass at osgeo.org svn_grass at osgeo.org
Sun Jan 4 10:47:39 EST 2009


Author: martinl
Date: 2009-01-04 10:47:39 -0500 (Sun, 04 Jan 2009)
New Revision: 35199

Added:
   grass/trunk/lib/form/
   grass/trunk/lib/form/Makefile
   grass/trunk/lib/form/form.c
   grass/trunk/lib/form/form.tcl
   grass/trunk/lib/form/generate.c
   grass/trunk/lib/form/html_library.tcl
   grass/trunk/lib/form/html_library_grass.tcl
   grass/trunk/lib/form/license.terms
   grass/trunk/lib/form/open.c
   grass/trunk/lib/form/todo
Removed:
   grass/trunk/lib/form/Makefile
   grass/trunk/lib/form/form.c
   grass/trunk/lib/form/form.tcl
   grass/trunk/lib/form/generate.c
   grass/trunk/lib/form/html_library.tcl
   grass/trunk/lib/form/html_library_grass.tcl
   grass/trunk/lib/form/license.terms
   grass/trunk/lib/form/open.c
   grass/trunk/lib/form/todo
Modified:
   grass/trunk/lib/Makefile
Log:
revert r35194: nviz requires lib/form 


Modified: grass/trunk/lib/Makefile
===================================================================
--- grass/trunk/lib/Makefile	2009-01-04 15:45:02 UTC (rev 35198)
+++ grass/trunk/lib/Makefile	2009-01-04 15:47:39 UTC (rev 35199)
@@ -20,6 +20,7 @@
 	db \
 	external \
 	fonts \
+	form \
 	imagery \
 	cluster \
 	proj \

Copied: grass/trunk/lib/form (from rev 35193, grass/trunk/lib/form)


Property changes on: grass/trunk/lib/form
___________________________________________________________________
Name: svn:ignore
   + *OBJ*


Deleted: grass/trunk/lib/form/Makefile
===================================================================
--- grass/trunk/lib/form/Makefile	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/Makefile	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,39 +0,0 @@
-MODULE_TOPDIR = ../..
-
-include $(MODULE_TOPDIR)/include/Make/Vars.make
-
-MOD_OBJS = generate.o open.o
-
-LIB_NAME = $(FORM_LIBNAME)
-
-include $(MODULE_TOPDIR)/include/Make/Lib.make
-
-EXTRA_LIBS=$(GISLIB) $(DBMILIB)
-EXTRA_CFLAGS = $(XCFLAGS) $(TCLINCDIR) $(TKINCDIR)
-
-FORMDIR=$(ARCH_DISTDIR)/etc/form
-FORM=$(FORMDIR)/form.tcl
-FORMPROG=$(FORMDIR)/form
-HTMLLIB=$(FORMDIR)/html_library.tcl
-
-ifneq ($(TCLTKLIBS),)
-    GTCLTKFORM = $(HTMLLIB) $(FORM) $(FORMPROG) 
-endif
-
-default: lib $(GTCLTKFORM)
-
-$(FORMDIR):
-	if [ ! -d $@ ]; then $(MKDIR) $@; fi
-
-$(HTMLLIB): html_library_grass.tcl
-	$(MAKE) $(FORMDIR)
-	$(INSTALL_DATA) $< $@
-
-$(FORM): form.tcl
-	$(MAKE) $(FORMDIR)
-	$(INSTALL_DATA) $< $@
-
-$(FORMPROG): $(OBJDIR)/form.o
-	$(MAKE) $(FORMDIR)
-	$(CC) $(LDFLAGS) -o $@ $(OBJDIR)/form.o $(DBMILIB) $(GISLIB) $(DATETIMELIB) \
-				$(TCLTKLIBPATH) $(TCLTKLIBS) $(MATHLIB) $(XDRLIB)

Copied: grass/trunk/lib/form/Makefile (from rev 35193, grass/trunk/lib/form/Makefile)
===================================================================
--- grass/trunk/lib/form/Makefile	                        (rev 0)
+++ grass/trunk/lib/form/Makefile	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,39 @@
+MODULE_TOPDIR = ../..
+
+include $(MODULE_TOPDIR)/include/Make/Vars.make
+
+MOD_OBJS = generate.o open.o
+
+LIB_NAME = $(FORM_LIBNAME)
+
+include $(MODULE_TOPDIR)/include/Make/Lib.make
+
+EXTRA_LIBS=$(GISLIB) $(DBMILIB)
+EXTRA_CFLAGS = $(XCFLAGS) $(TCLINCDIR) $(TKINCDIR)
+
+FORMDIR=$(ARCH_DISTDIR)/etc/form
+FORM=$(FORMDIR)/form.tcl
+FORMPROG=$(FORMDIR)/form
+HTMLLIB=$(FORMDIR)/html_library.tcl
+
+ifneq ($(TCLTKLIBS),)
+    GTCLTKFORM = $(HTMLLIB) $(FORM) $(FORMPROG) 
+endif
+
+default: lib $(GTCLTKFORM)
+
+$(FORMDIR):
+	if [ ! -d $@ ]; then $(MKDIR) $@; fi
+
+$(HTMLLIB): html_library_grass.tcl
+	$(MAKE) $(FORMDIR)
+	$(INSTALL_DATA) $< $@
+
+$(FORM): form.tcl
+	$(MAKE) $(FORMDIR)
+	$(INSTALL_DATA) $< $@
+
+$(FORMPROG): $(OBJDIR)/form.o
+	$(MAKE) $(FORMDIR)
+	$(CC) $(LDFLAGS) -o $@ $(OBJDIR)/form.o $(DBMILIB) $(GISLIB) $(DATETIMELIB) \
+				$(TCLTKLIBPATH) $(TCLTKLIBS) $(MATHLIB) $(XDRLIB)

Deleted: grass/trunk/lib/form/form.c
===================================================================
--- grass/trunk/lib/form/form.c	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/form.c	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,308 +0,0 @@
-#include <stdlib.h>
-#include <string.h>
-#include <stdio.h>
-#include <unistd.h>
-#include <fcntl.h>
-#include <sys/time.h>
-#include <sys/types.h>
-#include <tcl.h>
-#include <tk.h>
-#include <locale.h>
-#include <grass/gis.h>
-#include <grass/dbmi.h>
-#include <grass/form.h>
-
-/* Structure to store column names and values */
-typedef struct
-{
-    char *name;
-    int ctype;
-    char *value;
-} COLUMN;
-
-static char *Drvname, *Dbname, *Tblname, *Key;
-
-static COLUMN *Columns = NULL;
-static int allocatedRows = 0;	/* allocated space */
-static int nRows = 0;
-
-/* Start new sql update */
-int reset_values(ClientData cdata, Tcl_Interp * interp, int argc,
-		 char *argv[])
-{
-    nRows = 0;
-    Drvname = NULL;
-    Dbname = NULL;
-    Tblname = NULL;
-    Key = NULL;
-
-    return TCL_OK;
-}
-
-int set_value(ClientData cdata, Tcl_Interp * interp, int argc, char *argv[])
-{
-    G_debug(2, "set_value(): %s %s", argv[1], argv[2]);
-
-    if (strcmp(argv[1], F_DRIVER_FNAME) == 0) {
-	Drvname = G_store(argv[2]);
-    }
-    else if (strcmp(argv[1], F_DATABASE_FNAME) == 0) {
-	Dbname = G_store(argv[2]);
-    }
-    else if (strcmp(argv[1], F_TABLE_FNAME) == 0) {
-	Tblname = G_store(argv[2]);
-    }
-    else if (strcmp(argv[1], F_KEY_FNAME) == 0) {
-	Key = G_store(argv[2]);
-    }
-    else {
-	if (nRows == allocatedRows) {
-	    allocatedRows += 100;
-	    Columns =
-		(COLUMN *) G_realloc(Columns,
-				     (allocatedRows) * sizeof(COLUMN));
-	}
-	Columns[nRows].name = G_store(argv[1]);
-	Columns[nRows].value = G_store(argv[2]);
-	nRows++;
-    }
-
-    return TCL_OK;
-}
-
-/* Update table, use the data previously stored by set_value() */
-int submit(ClientData cdata, Tcl_Interp * interp, int argc, char *argv[])
-{
-    int i, first, ncols, found, col, sqltype, keyval = 0, ret;
-    char buf[2001];
-    dbString sql, table_name, strval;
-    dbDriver *driver;
-    dbHandle handle;
-    dbTable *table;
-    dbColumn *column;
-
-    G_debug(2, "submit()");
-
-    db_init_string(&sql);
-    db_init_string(&table_name);
-    db_init_string(&strval);
-
-    /* Check if all internal values are set */
-    if (Drvname == NULL || Dbname == NULL || Tblname == NULL || Key == NULL) {
-	G_warning("db connection was not set by form\n");
-	sprintf(buf, "set submit_msg \"db connection was not set by form.\"");
-	Tcl_Eval(interp, buf);
-	Tcl_Eval(interp, "set submit_result 0");
-	return TCL_OK;
-    }
-
-    /* Get column types */
-    G_debug(2, "Open driver");
-    driver = db_start_driver(Drvname);
-    if (driver == NULL) {
-	G_warning("Cannot open driver\n");
-	sprintf(buf, "set submit_msg \"Cannot open driver '%s'\"", Drvname);
-	Tcl_Eval(interp, buf);
-	Tcl_Eval(interp, "set submit_result 0");
-	return TCL_OK;
-    }
-    G_debug(2, "Driver opened");
-
-    db_init_handle(&handle);
-    db_set_handle(&handle, Dbname, NULL);
-    G_debug(2, "Open database");
-    if (db_open_database(driver, &handle) != DB_OK) {
-	G_warning("Cannot open database\n");
-	db_shutdown_driver(driver);
-	sprintf(buf,
-		"set submit_msg \"Cannot open database '%s' by driver '%s'\"",
-		Dbname, Drvname);
-	Tcl_Eval(interp, buf);
-	Tcl_Eval(interp, "set submit_result 0");
-	return TCL_OK;
-    }
-    G_debug(2, "Database opened");
-
-    db_set_string(&table_name, Tblname);
-    if (db_describe_table(driver, &table_name, &table) != DB_OK) {
-	G_warning("Cannot describe table\n");
-	db_shutdown_driver(driver);
-	db_close_database(driver);
-	sprintf(buf, "set submit_msg \"Cannot describe table '%s'\"",
-		Tblname);
-	Tcl_Eval(interp, buf);
-	Tcl_Eval(interp, "set submit_result 0");
-	return TCL_OK;
-    }
-    ncols = db_get_table_number_of_columns(table);
-
-    /* For each column get ctype */
-    for (i = 0; i < nRows; i++) {
-	found = 0;
-	for (col = 0; col < ncols; col++) {
-	    /* get keyval */
-	    if (G_strcasecmp(Columns[i].name, Key) == 0) {
-		keyval = atoi(Columns[i].value);
-	    }
-	    column = db_get_table_column(table, col);
-	    if (G_strcasecmp(db_get_column_name(column), Columns[i].name) ==
-		0) {
-		sqltype = db_get_column_sqltype(column);
-		Columns[i].ctype = db_sqltype_to_Ctype(sqltype);
-		found = 1;
-		break;
-	    }
-	}
-	if (!found && (G_strcasecmp(Columns[i].name, F_ENCODING) != 0)) {
-	    G_warning("Cannot find column type");
-	    db_close_database(driver);
-	    db_shutdown_driver(driver);
-	    sprintf(buf, "set submit_msg \"Cannot find column type\"");
-	    Tcl_Eval(interp, buf);
-	    Tcl_Eval(interp, "set submit_result 0");
-	    return TCL_OK;
-	}
-    }
-
-    /* Construct update statement */
-    sprintf(buf, "update %s set ", Tblname);
-    db_set_string(&sql, buf);
-
-    first = 1;
-    for (i = 0; i < nRows; i++) {
-	G_debug(3, "Index = %d of %d Name = %s, Key = %s", i, nRows,
-		Columns[i].name, Key);
-	if (G_strcasecmp(Columns[i].name, Key) == 0)
-	    continue;
-
-	if (G_strcasecmp(Columns[i].name, F_ENCODING) == 0) {
-
-	    G_debug(3, "GRASS_DB_ENCODING env-var is '%s', col val is '%s'",
-		    G__getenv("GRASS_DB_ENCODING"), Columns[i].value);
-
-	    if ((strlen(Columns[i].value) == 0) ||
-		G_strcasecmp(Columns[i].value,
-			     G__getenv("GRASS_DB_ENCODING")) == 0)
-		continue;
-	    else {
-		G_setenv("GRASS_DB_ENCODING", Columns[i].value);
-		G_debug(3, "Set env var GRASS_DB_ENCODING to '%s'",
-			Columns[i].value);
-		if (Tcl_SetSystemEncoding(interp, Columns[i].value) ==
-		    TCL_ERROR) {
-		    G_warning
-			("Could not set Tcl system encoding to '%s' (%s)",
-			 Columns[i].value, interp->result);
-		}
-	    }
-	    continue;
-	}
-
-	if (!first) {
-	    db_append_string(&sql, ", ");
-	}
-	if (strlen(Columns[i].value) == 0) {
-	    sprintf(buf, "%s = null", Columns[i].name);
-	}
-	else {
-	    if (Columns[i].ctype == DB_C_TYPE_INT ||
-		Columns[i].ctype == DB_C_TYPE_DOUBLE) {
-		sprintf(buf, "%s = %s", Columns[i].name, Columns[i].value);
-	    }
-	    else {
-		memset(buf, '\0', strlen(buf));
-		ret = Tcl_UtfToExternal(interp,
-					Tcl_GetEncoding(interp,
-							G__getenv
-							("GRASS_DB_ENCODING")),
-					Columns[i].value,
-					strlen(Columns[i].value), 0, NULL,
-					buf, 2000, NULL, NULL, NULL);
-
-		if (ret != TCL_OK) {
-		    G_warning("Could not convert UTF to external.");
-		    db_set_string(&strval, Columns[i].value);
-		}
-		else {
-		    db_set_string(&strval, buf);
-		}
-
-		db_double_quote_string(&strval);
-		sprintf(buf, "%s = '%s'", Columns[i].name,
-			db_get_string(&strval));
-	    }
-	}
-	db_append_string(&sql, buf);
-	first = 0;
-    }
-
-    sprintf(buf, " where %s = %d", Key, keyval);
-    db_append_string(&sql, buf);
-
-    G_debug(2, "SQL: %s", db_get_string(&sql));
-
-    /* Update table */
-    ret = db_execute_immediate(driver, &sql);
-
-    db_close_database(driver);
-    db_shutdown_driver(driver);
-
-    if (ret != DB_OK) {
-	G_warning("Cannot update table");
-	Tcl_VarEval(interp, "set submit_msg \"Cannot update table:\n",
-		    db_get_error_msg(), "\"", NULL);
-	Tcl_Eval(interp, "set submit_result 0");
-    }
-    else {
-	Tcl_Eval(interp, "set submit_msg \"Record successfully updated\"");
-	Tcl_Eval(interp, "set submit_result 1");
-    }
-
-    return TCL_OK;
-}
-
-/* 
- *  Form 
- */
-int Tcl_AppInit(Tcl_Interp * interp)
-{
-    if (Tcl_Init(interp) == TCL_ERROR)
-	return TCL_ERROR;
-
-    if (Tk_Init(interp) == TCL_ERROR)
-	return TCL_ERROR;
-
-    Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
-
-    /*
-     * Call Tcl_CreateCommand for application-specific commands, if
-     * they weren't already created by the init procedures called above.
-     */
-
-    Tcl_CreateCommand(interp, "submit", (Tcl_CmdProc *) submit,
-		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "set_value",
-		      (Tcl_CmdProc *) set_value,
-		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
-    Tcl_CreateCommand(interp, "reset_values",
-		      (Tcl_CmdProc *) reset_values,
-		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
-    /*
-     * Specify a user-specific startup file to invoke if the application
-     * is run interactively.  Typically the startup file is "~/.apprc"
-     * where "app" is the name of the application.  If this line is deleted
-     * then no user-specific startup file will be run under any conditions.
-     */
-
-    Tcl_SetVar(interp, "tcl_rcFileName", "~/.grassformrc", TCL_GLOBAL_ONLY);
-    return TCL_OK;
-}
-
-int main(int argc, char *argv[])
-{
-    G_gisinit("form");
-    G_debug(2, "Form: main()");
-
-    Tk_Main(argc, argv, Tcl_AppInit);
-    return 0;
-}

Copied: grass/trunk/lib/form/form.c (from rev 35193, grass/trunk/lib/form/form.c)
===================================================================
--- grass/trunk/lib/form/form.c	                        (rev 0)
+++ grass/trunk/lib/form/form.c	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,308 @@
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <sys/time.h>
+#include <sys/types.h>
+#include <tcl.h>
+#include <tk.h>
+#include <locale.h>
+#include <grass/gis.h>
+#include <grass/dbmi.h>
+#include <grass/form.h>
+
+/* Structure to store column names and values */
+typedef struct
+{
+    char *name;
+    int ctype;
+    char *value;
+} COLUMN;
+
+static char *Drvname, *Dbname, *Tblname, *Key;
+
+static COLUMN *Columns = NULL;
+static int allocatedRows = 0;	/* allocated space */
+static int nRows = 0;
+
+/* Start new sql update */
+int reset_values(ClientData cdata, Tcl_Interp * interp, int argc,
+		 char *argv[])
+{
+    nRows = 0;
+    Drvname = NULL;
+    Dbname = NULL;
+    Tblname = NULL;
+    Key = NULL;
+
+    return TCL_OK;
+}
+
+int set_value(ClientData cdata, Tcl_Interp * interp, int argc, char *argv[])
+{
+    G_debug(2, "set_value(): %s %s", argv[1], argv[2]);
+
+    if (strcmp(argv[1], F_DRIVER_FNAME) == 0) {
+	Drvname = G_store(argv[2]);
+    }
+    else if (strcmp(argv[1], F_DATABASE_FNAME) == 0) {
+	Dbname = G_store(argv[2]);
+    }
+    else if (strcmp(argv[1], F_TABLE_FNAME) == 0) {
+	Tblname = G_store(argv[2]);
+    }
+    else if (strcmp(argv[1], F_KEY_FNAME) == 0) {
+	Key = G_store(argv[2]);
+    }
+    else {
+	if (nRows == allocatedRows) {
+	    allocatedRows += 100;
+	    Columns =
+		(COLUMN *) G_realloc(Columns,
+				     (allocatedRows) * sizeof(COLUMN));
+	}
+	Columns[nRows].name = G_store(argv[1]);
+	Columns[nRows].value = G_store(argv[2]);
+	nRows++;
+    }
+
+    return TCL_OK;
+}
+
+/* Update table, use the data previously stored by set_value() */
+int submit(ClientData cdata, Tcl_Interp * interp, int argc, char *argv[])
+{
+    int i, first, ncols, found, col, sqltype, keyval = 0, ret;
+    char buf[2001];
+    dbString sql, table_name, strval;
+    dbDriver *driver;
+    dbHandle handle;
+    dbTable *table;
+    dbColumn *column;
+
+    G_debug(2, "submit()");
+
+    db_init_string(&sql);
+    db_init_string(&table_name);
+    db_init_string(&strval);
+
+    /* Check if all internal values are set */
+    if (Drvname == NULL || Dbname == NULL || Tblname == NULL || Key == NULL) {
+	G_warning("db connection was not set by form\n");
+	sprintf(buf, "set submit_msg \"db connection was not set by form.\"");
+	Tcl_Eval(interp, buf);
+	Tcl_Eval(interp, "set submit_result 0");
+	return TCL_OK;
+    }
+
+    /* Get column types */
+    G_debug(2, "Open driver");
+    driver = db_start_driver(Drvname);
+    if (driver == NULL) {
+	G_warning("Cannot open driver\n");
+	sprintf(buf, "set submit_msg \"Cannot open driver '%s'\"", Drvname);
+	Tcl_Eval(interp, buf);
+	Tcl_Eval(interp, "set submit_result 0");
+	return TCL_OK;
+    }
+    G_debug(2, "Driver opened");
+
+    db_init_handle(&handle);
+    db_set_handle(&handle, Dbname, NULL);
+    G_debug(2, "Open database");
+    if (db_open_database(driver, &handle) != DB_OK) {
+	G_warning("Cannot open database\n");
+	db_shutdown_driver(driver);
+	sprintf(buf,
+		"set submit_msg \"Cannot open database '%s' by driver '%s'\"",
+		Dbname, Drvname);
+	Tcl_Eval(interp, buf);
+	Tcl_Eval(interp, "set submit_result 0");
+	return TCL_OK;
+    }
+    G_debug(2, "Database opened");
+
+    db_set_string(&table_name, Tblname);
+    if (db_describe_table(driver, &table_name, &table) != DB_OK) {
+	G_warning("Cannot describe table\n");
+	db_shutdown_driver(driver);
+	db_close_database(driver);
+	sprintf(buf, "set submit_msg \"Cannot describe table '%s'\"",
+		Tblname);
+	Tcl_Eval(interp, buf);
+	Tcl_Eval(interp, "set submit_result 0");
+	return TCL_OK;
+    }
+    ncols = db_get_table_number_of_columns(table);
+
+    /* For each column get ctype */
+    for (i = 0; i < nRows; i++) {
+	found = 0;
+	for (col = 0; col < ncols; col++) {
+	    /* get keyval */
+	    if (G_strcasecmp(Columns[i].name, Key) == 0) {
+		keyval = atoi(Columns[i].value);
+	    }
+	    column = db_get_table_column(table, col);
+	    if (G_strcasecmp(db_get_column_name(column), Columns[i].name) ==
+		0) {
+		sqltype = db_get_column_sqltype(column);
+		Columns[i].ctype = db_sqltype_to_Ctype(sqltype);
+		found = 1;
+		break;
+	    }
+	}
+	if (!found && (G_strcasecmp(Columns[i].name, F_ENCODING) != 0)) {
+	    G_warning("Cannot find column type");
+	    db_close_database(driver);
+	    db_shutdown_driver(driver);
+	    sprintf(buf, "set submit_msg \"Cannot find column type\"");
+	    Tcl_Eval(interp, buf);
+	    Tcl_Eval(interp, "set submit_result 0");
+	    return TCL_OK;
+	}
+    }
+
+    /* Construct update statement */
+    sprintf(buf, "update %s set ", Tblname);
+    db_set_string(&sql, buf);
+
+    first = 1;
+    for (i = 0; i < nRows; i++) {
+	G_debug(3, "Index = %d of %d Name = %s, Key = %s", i, nRows,
+		Columns[i].name, Key);
+	if (G_strcasecmp(Columns[i].name, Key) == 0)
+	    continue;
+
+	if (G_strcasecmp(Columns[i].name, F_ENCODING) == 0) {
+
+	    G_debug(3, "GRASS_DB_ENCODING env-var is '%s', col val is '%s'",
+		    G__getenv("GRASS_DB_ENCODING"), Columns[i].value);
+
+	    if ((strlen(Columns[i].value) == 0) ||
+		G_strcasecmp(Columns[i].value,
+			     G__getenv("GRASS_DB_ENCODING")) == 0)
+		continue;
+	    else {
+		G_setenv("GRASS_DB_ENCODING", Columns[i].value);
+		G_debug(3, "Set env var GRASS_DB_ENCODING to '%s'",
+			Columns[i].value);
+		if (Tcl_SetSystemEncoding(interp, Columns[i].value) ==
+		    TCL_ERROR) {
+		    G_warning
+			("Could not set Tcl system encoding to '%s' (%s)",
+			 Columns[i].value, interp->result);
+		}
+	    }
+	    continue;
+	}
+
+	if (!first) {
+	    db_append_string(&sql, ", ");
+	}
+	if (strlen(Columns[i].value) == 0) {
+	    sprintf(buf, "%s = null", Columns[i].name);
+	}
+	else {
+	    if (Columns[i].ctype == DB_C_TYPE_INT ||
+		Columns[i].ctype == DB_C_TYPE_DOUBLE) {
+		sprintf(buf, "%s = %s", Columns[i].name, Columns[i].value);
+	    }
+	    else {
+		memset(buf, '\0', strlen(buf));
+		ret = Tcl_UtfToExternal(interp,
+					Tcl_GetEncoding(interp,
+							G__getenv
+							("GRASS_DB_ENCODING")),
+					Columns[i].value,
+					strlen(Columns[i].value), 0, NULL,
+					buf, 2000, NULL, NULL, NULL);
+
+		if (ret != TCL_OK) {
+		    G_warning("Could not convert UTF to external.");
+		    db_set_string(&strval, Columns[i].value);
+		}
+		else {
+		    db_set_string(&strval, buf);
+		}
+
+		db_double_quote_string(&strval);
+		sprintf(buf, "%s = '%s'", Columns[i].name,
+			db_get_string(&strval));
+	    }
+	}
+	db_append_string(&sql, buf);
+	first = 0;
+    }
+
+    sprintf(buf, " where %s = %d", Key, keyval);
+    db_append_string(&sql, buf);
+
+    G_debug(2, "SQL: %s", db_get_string(&sql));
+
+    /* Update table */
+    ret = db_execute_immediate(driver, &sql);
+
+    db_close_database(driver);
+    db_shutdown_driver(driver);
+
+    if (ret != DB_OK) {
+	G_warning("Cannot update table");
+	Tcl_VarEval(interp, "set submit_msg \"Cannot update table:\n",
+		    db_get_error_msg(), "\"", NULL);
+	Tcl_Eval(interp, "set submit_result 0");
+    }
+    else {
+	Tcl_Eval(interp, "set submit_msg \"Record successfully updated\"");
+	Tcl_Eval(interp, "set submit_result 1");
+    }
+
+    return TCL_OK;
+}
+
+/* 
+ *  Form 
+ */
+int Tcl_AppInit(Tcl_Interp * interp)
+{
+    if (Tcl_Init(interp) == TCL_ERROR)
+	return TCL_ERROR;
+
+    if (Tk_Init(interp) == TCL_ERROR)
+	return TCL_ERROR;
+
+    Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
+
+    /*
+     * Call Tcl_CreateCommand for application-specific commands, if
+     * they weren't already created by the init procedures called above.
+     */
+
+    Tcl_CreateCommand(interp, "submit", (Tcl_CmdProc *) submit,
+		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "set_value",
+		      (Tcl_CmdProc *) set_value,
+		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateCommand(interp, "reset_values",
+		      (Tcl_CmdProc *) reset_values,
+		      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
+    /*
+     * Specify a user-specific startup file to invoke if the application
+     * is run interactively.  Typically the startup file is "~/.apprc"
+     * where "app" is the name of the application.  If this line is deleted
+     * then no user-specific startup file will be run under any conditions.
+     */
+
+    Tcl_SetVar(interp, "tcl_rcFileName", "~/.grassformrc", TCL_GLOBAL_ONLY);
+    return TCL_OK;
+}
+
+int main(int argc, char *argv[])
+{
+    G_gisinit("form");
+    G_debug(2, "Form: main()");
+
+    Tk_Main(argc, argv, Tcl_AppInit);
+    return 0;
+}

Deleted: grass/trunk/lib/form/form.tcl
===================================================================
--- grass/trunk/lib/form/form.tcl	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/form.tcl	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,158 +0,0 @@
-lappend auto_path $env(GISBASE)/bwidget
-package require -exact BWidget 1.2.1 
-#package require http
-
-set formpath $env(GISBASE)/etc/form
-source $formpath/html_library.tcl
-
-proc create_submit_msg { formid  }  {
-    global submit_result submit_msg formf
-
-    destroy $formf($formid).sbw 
-    destroy $formf($formid).sbt
-
-    if { $submit_result == 1 } { set color "green" } else { set color "red" }
-    set sbw [ScrolledWindow $formf($formid).sbw -relief sunken -borderwidth 2]
-    set sbt [text $formf($formid).sbt -height 3 -width 20 -foreground $color ]
-    pack $sbw $sbt -fill x
-    $sbw setwidget $sbt
-    $sbt insert end $submit_msg
-    $sbt configure -state disabled
-}
-
-proc add_form { formid title } {
-    global nb formf html
-
-    set form($formid) [$nb insert end $formid -text $title]
-    $nb raise $formid
-    set formf($formid) [ frame $form($formid).frm ]
-    set formsw($formid) [ScrolledWindow $formf($formid).sw -relief sunken -borderwidth 2]
-    set formtxt($formid) [ text $formf($formid).txt -height 5 -width 20 ]
-    pack $formf($formid) $formsw($formid) $formtxt($formid) -fill both -expand yes
-    $formsw($formid) setwidget $formtxt($formid)
-    HMinit_win $formtxt($formid)
-    HMparse_html $html "HMrender $formtxt($formid)"
-    $formtxt($formid) configure -state disabled
-}
-
-proc clear_nb { }  {
-    global submit_msg
- 
-    set submit_msg ""
-  
-    foreach frm [ .nb pages ] {
-        .nb delete $frm
-    }
-}
-
-proc HMsubmit_form {win param query} {
-    global submit_result submit_msg
-
-    regexp -- {\.nb\.f(.+)\.frm\.txt} $win r formid 
-    #puts "win = $win formid = $formid"
-
-    reset_values
-    foreach {col val} $query {
-        #puts "$col : $val" 
-        set_value $col $val 
-    }
-
-    submit $formid
-    #puts "result = $submit_result msg = $submit_msg" 
-    create_submit_msg $formid   
-}
-
-proc make_form {} {
-	global nb
-
-	set nb [NoteBook .nb]
-	$nb configure -width 300 -height 500
-	pack .nb -fill both -expand yes
-}
-
-proc close_form {} {
-	global form_open
-	wm withdraw .
-	set form_open false
-}
-
-proc process_command {} {
-	global env
-	global child_recv child_send 
-	global form_open encoding_val frmid
-	global html
-
-	if {[eof $child_recv]} {
-		exit 0
-	}
-
-	set cmd [read $child_recv 1]
-
-	switch $cmd {
-		O {
-			if {! $form_open} {
-				wm state . normal
-				set form_open true
-			}
-			#  Read title 
-			set length [gets $child_recv]
-			set child_title [read $child_recv $length]
-
-			#  Read html 
-			set length [gets $child_recv]
-			set child_html [read $child_recv $length]
-
-			set child_html [encoding convertfrom $encoding_val $child_html]
-
-			#  Insert new page 
-			set html $child_html
-			add_form $frmid $child_title
-
-			puts -nonewline $child_send O
-			flush $child_send
-			incr frmid
-		}
-		C {	#  clear old forms 
-			clear_nb
-			puts -nonewline $child_send O
-			flush $child_send
-		}
-		D {	#  done! 
-			clear_nb
-			puts -nonewline $child_send O
-			flush $child_send
-
-			destroy .
-			exit 0
-		}
-	}
-}
-
-make_form
-
-wm protocol . WM_DELETE_WINDOW close_form
-
-bind . <Destroy> { if { "%W" == "."} { close_form } }
-
-set submit_result ""
-set submit_msg ""
-set html ""
-
-set frmid 0
-set form_open true
-
-set child_recv stdin
-set child_send stdout
-
-set encoding_val [exec g.gisenv GRASS_DB_ENCODING]
-if {$encoding_val == ""} {
-	set encoding_val [encoding system]
-}
-
-if {[catch {encoding system $encoding_val}]} {
-	puts stderr "Could not set Tcl system encoding to $encoding_val"
-}
-
-fconfigure $child_recv -buffering none -encoding binary -translation binary
-
-fileevent $child_recv readable process_command

Copied: grass/trunk/lib/form/form.tcl (from rev 35193, grass/trunk/lib/form/form.tcl)
===================================================================
--- grass/trunk/lib/form/form.tcl	                        (rev 0)
+++ grass/trunk/lib/form/form.tcl	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,158 @@
+lappend auto_path $env(GISBASE)/bwidget
+package require -exact BWidget 1.2.1 
+#package require http
+
+set formpath $env(GISBASE)/etc/form
+source $formpath/html_library.tcl
+
+proc create_submit_msg { formid  }  {
+    global submit_result submit_msg formf
+
+    destroy $formf($formid).sbw 
+    destroy $formf($formid).sbt
+
+    if { $submit_result == 1 } { set color "green" } else { set color "red" }
+    set sbw [ScrolledWindow $formf($formid).sbw -relief sunken -borderwidth 2]
+    set sbt [text $formf($formid).sbt -height 3 -width 20 -foreground $color ]
+    pack $sbw $sbt -fill x
+    $sbw setwidget $sbt
+    $sbt insert end $submit_msg
+    $sbt configure -state disabled
+}
+
+proc add_form { formid title } {
+    global nb formf html
+
+    set form($formid) [$nb insert end $formid -text $title]
+    $nb raise $formid
+    set formf($formid) [ frame $form($formid).frm ]
+    set formsw($formid) [ScrolledWindow $formf($formid).sw -relief sunken -borderwidth 2]
+    set formtxt($formid) [ text $formf($formid).txt -height 5 -width 20 ]
+    pack $formf($formid) $formsw($formid) $formtxt($formid) -fill both -expand yes
+    $formsw($formid) setwidget $formtxt($formid)
+    HMinit_win $formtxt($formid)
+    HMparse_html $html "HMrender $formtxt($formid)"
+    $formtxt($formid) configure -state disabled
+}
+
+proc clear_nb { }  {
+    global submit_msg
+ 
+    set submit_msg ""
+  
+    foreach frm [ .nb pages ] {
+        .nb delete $frm
+    }
+}
+
+proc HMsubmit_form {win param query} {
+    global submit_result submit_msg
+
+    regexp -- {\.nb\.f(.+)\.frm\.txt} $win r formid 
+    #puts "win = $win formid = $formid"
+
+    reset_values
+    foreach {col val} $query {
+        #puts "$col : $val" 
+        set_value $col $val 
+    }
+
+    submit $formid
+    #puts "result = $submit_result msg = $submit_msg" 
+    create_submit_msg $formid   
+}
+
+proc make_form {} {
+	global nb
+
+	set nb [NoteBook .nb]
+	$nb configure -width 300 -height 500
+	pack .nb -fill both -expand yes
+}
+
+proc close_form {} {
+	global form_open
+	wm withdraw .
+	set form_open false
+}
+
+proc process_command {} {
+	global env
+	global child_recv child_send 
+	global form_open encoding_val frmid
+	global html
+
+	if {[eof $child_recv]} {
+		exit 0
+	}
+
+	set cmd [read $child_recv 1]
+
+	switch $cmd {
+		O {
+			if {! $form_open} {
+				wm state . normal
+				set form_open true
+			}
+			#  Read title 
+			set length [gets $child_recv]
+			set child_title [read $child_recv $length]
+
+			#  Read html 
+			set length [gets $child_recv]
+			set child_html [read $child_recv $length]
+
+			set child_html [encoding convertfrom $encoding_val $child_html]
+
+			#  Insert new page 
+			set html $child_html
+			add_form $frmid $child_title
+
+			puts -nonewline $child_send O
+			flush $child_send
+			incr frmid
+		}
+		C {	#  clear old forms 
+			clear_nb
+			puts -nonewline $child_send O
+			flush $child_send
+		}
+		D {	#  done! 
+			clear_nb
+			puts -nonewline $child_send O
+			flush $child_send
+
+			destroy .
+			exit 0
+		}
+	}
+}
+
+make_form
+
+wm protocol . WM_DELETE_WINDOW close_form
+
+bind . <Destroy> { if { "%W" == "."} { close_form } }
+
+set submit_result ""
+set submit_msg ""
+set html ""
+
+set frmid 0
+set form_open true
+
+set child_recv stdin
+set child_send stdout
+
+set encoding_val [exec g.gisenv GRASS_DB_ENCODING]
+if {$encoding_val == ""} {
+	set encoding_val [encoding system]
+}
+
+if {[catch {encoding system $encoding_val}]} {
+	puts stderr "Could not set Tcl system encoding to $encoding_val"
+}
+
+fconfigure $child_recv -buffering none -encoding binary -translation binary
+
+fileevent $child_recv readable process_command

Deleted: grass/trunk/lib/form/generate.c
===================================================================
--- grass/trunk/lib/form/generate.c	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/generate.c	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,253 +0,0 @@
-#include <stdlib.h>
-#include <string.h>
-#include <grass/gis.h>
-#include <grass/dbmi.h>
-#include <grass/form.h>
-
-/* Generate form in HTML/TXT format.
- *  Pointer to resulting string is stored to 'form'. This string must be freed by application.
- *
- *  returns: -1 error 
- *            0 success
- */
-int
-F_generate(char *drvname, char *dbname, char *tblname, char *key, int keyval,
-	   char *frmname, char *frmmapset,
-	   int edit_mode, int format, char **form)
-{
-    int col, ncols, ctype, sqltype, more;
-    char buf[5000], buf1[100];
-    const char *colname;
-    dbString sql, html, str;
-    dbDriver *driver;
-    dbHandle handle;
-    dbCursor cursor;
-    dbTable *table;
-    dbColumn *column;
-    dbValue *value;
-
-    int i = 0;
-
-    /* see /usr/lib/tcl8.4/encoding/ */
-    static char *encoding_list[] = {
-	"utf-8",
-	"ascii",
-	"iso8859-1",
-	"iso8859-2",
-	"iso8859-15",
-	"iso2022-jp",
-	"koi8-r",
-	"euc-jp",
-	NULL
-    };
-    const char *enc_env;
-
-    G__read_env();
-    enc_env = G__getenv("GRASS_DB_ENCODING");
-
-    /* TODO: support 'format' (txt, html), currently html only */
-
-    G_debug(2,
-	    "F_generate(): drvname = '%s', dbname = '%s'\n      tblname = '%s', key = '%s', keyval = %d\n"
-	    "    form = '%s', form_mapset = '%s'\n      edit_mode = %d",
-	    drvname, dbname, tblname, key, keyval, frmname, frmmapset,
-	    edit_mode);
-
-    db_init_string(&sql);
-    db_init_string(&html);	/* here is the result stored */
-    db_init_string(&str);
-
-    G_debug(2, "Open driver");
-    driver = db_start_driver(drvname);
-    if (driver == NULL) {
-	G_warning("Cannot open driver\n");
-	sprintf(buf, "Cannot open driver '%s'<BR>", drvname);
-	*form = G_store(buf);
-	return -1;
-    }
-    G_debug(2, "Driver opened");
-
-    db_init_handle(&handle);
-    db_set_handle(&handle, dbname, NULL);
-    G_debug(2, "Open database");
-    if (db_open_database(driver, &handle) != DB_OK) {
-	G_warning("Cannot open database\n");
-	db_shutdown_driver(driver);
-	sprintf(buf, "Cannot open database '%s' by driver '%s'<BR>", dbname,
-		drvname);
-	*form = G_store(buf);
-	return -1;
-    }
-    G_debug(2, "Database opened");
-
-    /* TODO: test if table exist first, but this should be tested by application befor
-     *        F_generate() is called, because it may be correct (connection defined in DB
-     *        but table does not exist) */
-
-    sprintf(buf, "select * from %s where %s = %d", tblname, key, keyval);
-    G_debug(2, "%s", buf);
-    db_set_string(&sql, buf);
-    if (db_open_select_cursor(driver, &sql, &cursor, DB_SEQUENTIAL) != DB_OK) {
-	G_warning("Cannot open select cursor\n");
-	db_close_database(driver);
-	db_shutdown_driver(driver);
-	sprintf(buf,
-		"Cannot open select cursor:<BR>'%s'<BR>on database '%s' by driver '%s'<BR>",
-		db_get_string(&sql), dbname, drvname);
-	*form = G_store(buf);
-	return -1;
-    }
-    G_debug(2, "Select Cursor opened");
-
-    table = db_get_cursor_table(&cursor);
-
-    if (db_fetch(&cursor, DB_NEXT, &more) != DB_OK) {
-	G_warning("Cannot fetch next record\n");
-	db_close_cursor(&cursor);
-	db_close_database(driver);
-	db_shutdown_driver(driver);
-	*form = G_store("Cannot fetch next record");
-	return -1;
-    }
-
-    if (!more) {
-	G_warning("No database record");
-	if (format == F_HTML) {
-	    *form = G_store("No record selected.<BR>");
-	}
-	else {
-	    *form = G_store("No record selected.");
-	}
-    }
-    else {
-	ncols = db_get_table_number_of_columns(table);
-
-	/* Start form */
-	if (format == F_HTML) {
-	    if (edit_mode == F_EDIT) {
-		db_append_string(&html, "<FORM>");
-
-		sprintf(buf, "<INPUT type=hidden name=%s value=\"%s\">",
-			F_DRIVER_FNAME, drvname);
-		db_append_string(&html, buf);
-		/* Note: because html_library.tcl failes to parse
-		 *  <INPUT name=abc value='dbname=xxx'> and returnes
-		 *  name="xxx" value="dbname=xxx" order of value and name parameters is changed */
-		sprintf(buf, "<INPUT type=hidden value=\"%s\" name=%s>",
-			dbname, F_DATABASE_FNAME);
-		db_append_string(&html, buf);
-		sprintf(buf, "<INPUT type=hidden name=%s value=\"%s\">",
-			F_TABLE_FNAME, tblname);
-		db_append_string(&html, buf);
-		sprintf(buf, "<INPUT type=hidden name=%s value=\"%s\">",
-			F_KEY_FNAME, key);
-		db_append_string(&html, buf);
-
-	    }
-
-	    for (col = 0; col < ncols; col++) {
-		column = db_get_table_column(table, col);
-		sqltype = db_get_column_sqltype(column);
-		ctype = db_sqltype_to_Ctype(sqltype);
-		value = db_get_column_value(column);
-		db_convert_value_to_string(value, sqltype, &str);
-		colname = db_get_column_name(column);
-
-		G_debug(2, "%s: %s", colname, db_get_string(&str));
-
-		if (edit_mode == F_VIEW) {
-		    sprintf(buf, "<B>%s : </B> %s <BR>", colname,
-			    db_get_string(&str));
-		    db_append_string(&html, buf);
-		}
-		else {
-		    sprintf(buf, "<B>%s : </B>", colname);
-		    db_append_string(&html, buf);
-
-		    if (G_strcasecmp(colname, key) == 0) {
-			sprintf(buf,
-				"%s<BR> <INPUT type=hidden name=%s value=\"%s\">",
-				db_get_string(&str), colname,
-				db_get_string(&str));
-		    }
-		    else {
-			switch (ctype) {
-			case DB_C_TYPE_INT:
-			    sprintf(buf1, "20");
-			    break;
-			case DB_C_TYPE_DOUBLE:
-			    sprintf(buf1, "30");
-			    break;
-			case DB_C_TYPE_STRING:
-			    sprintf(buf1, "%d", db_get_column_length(column));
-			    break;
-			case DB_C_TYPE_DATETIME:
-			    sprintf(buf1, "20");
-			    break;
-			}
-			sprintf(buf,
-				"<INPUT type=text size=%s name=%s value=\"%s\"><BR>",
-				buf1, colname, db_get_string(&str));
-		    }
-		    db_append_string(&html, buf);
-		}
-	    }
-
-	    if (edit_mode == F_EDIT) {
-		sprintf(buf,
-			"<HR>   Assume data encoding as:<BR><BR><SELECT NAME=%s SIZE=4><HR><BR>",
-			F_ENCODING);
-		db_append_string(&html, buf);
-
-		i = 0;
-		while (encoding_list[i] != NULL) {
-
-		    if (G_strcasecmp(encoding_list[i], enc_env) == 0)
-			sprintf(buf, "<OPTION VALUE=\"%s\" SELECTED>%s",
-				encoding_list[i], encoding_list[i]);
-		    else
-			sprintf(buf, "<OPTION VALUE=\"%s\">%s",
-				encoding_list[i], encoding_list[i]);
-		    ++i;
-		    db_append_string(&html, buf);
-		}
-
-		sprintf(buf, "</SELECT>");
-		db_append_string(&html, buf);
-	    }
-
-	    /* Close form */
-	    if (edit_mode == F_EDIT) {
-		db_append_string(&html, "</FORM>");
-	    }
-	}
-	else {			/* F_TXT */
-	    for (col = 0; col < ncols; col++) {
-		column = db_get_table_column(table, col);
-		sqltype = db_get_column_sqltype(column);
-		ctype = db_sqltype_to_Ctype(sqltype);
-		value = db_get_column_value(column);
-		db_convert_value_to_string(value, sqltype, &str);
-		colname = db_get_column_name(column);
-
-		G_debug(2, "%s: %s", colname, db_get_string(&str));
-
-		sprintf(buf, "%s : %s\n", colname, db_get_string(&str));
-		db_append_string(&html, buf);
-	    }
-	}
-    }
-    G_debug(2, "FORM STRING:\n%s\n", db_get_string(&html));
-
-    db_close_cursor(&cursor);
-    db_close_database(driver);
-    db_shutdown_driver(driver);
-
-    *form = G_store(db_get_string(&html));
-
-    db_free_string(&sql);
-    db_free_string(&html);
-    db_free_string(&str);
-
-    return 0;
-}

Copied: grass/trunk/lib/form/generate.c (from rev 35193, grass/trunk/lib/form/generate.c)
===================================================================
--- grass/trunk/lib/form/generate.c	                        (rev 0)
+++ grass/trunk/lib/form/generate.c	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,253 @@
+#include <stdlib.h>
+#include <string.h>
+#include <grass/gis.h>
+#include <grass/dbmi.h>
+#include <grass/form.h>
+
+/* Generate form in HTML/TXT format.
+ *  Pointer to resulting string is stored to 'form'. This string must be freed by application.
+ *
+ *  returns: -1 error 
+ *            0 success
+ */
+int
+F_generate(char *drvname, char *dbname, char *tblname, char *key, int keyval,
+	   char *frmname, char *frmmapset,
+	   int edit_mode, int format, char **form)
+{
+    int col, ncols, ctype, sqltype, more;
+    char buf[5000], buf1[100];
+    const char *colname;
+    dbString sql, html, str;
+    dbDriver *driver;
+    dbHandle handle;
+    dbCursor cursor;
+    dbTable *table;
+    dbColumn *column;
+    dbValue *value;
+
+    int i = 0;
+
+    /* see /usr/lib/tcl8.4/encoding/ */
+    static char *encoding_list[] = {
+	"utf-8",
+	"ascii",
+	"iso8859-1",
+	"iso8859-2",
+	"iso8859-15",
+	"iso2022-jp",
+	"koi8-r",
+	"euc-jp",
+	NULL
+    };
+    const char *enc_env;
+
+    G__read_env();
+    enc_env = G__getenv("GRASS_DB_ENCODING");
+
+    /* TODO: support 'format' (txt, html), currently html only */
+
+    G_debug(2,
+	    "F_generate(): drvname = '%s', dbname = '%s'\n      tblname = '%s', key = '%s', keyval = %d\n"
+	    "    form = '%s', form_mapset = '%s'\n      edit_mode = %d",
+	    drvname, dbname, tblname, key, keyval, frmname, frmmapset,
+	    edit_mode);
+
+    db_init_string(&sql);
+    db_init_string(&html);	/* here is the result stored */
+    db_init_string(&str);
+
+    G_debug(2, "Open driver");
+    driver = db_start_driver(drvname);
+    if (driver == NULL) {
+	G_warning("Cannot open driver\n");
+	sprintf(buf, "Cannot open driver '%s'<BR>", drvname);
+	*form = G_store(buf);
+	return -1;
+    }
+    G_debug(2, "Driver opened");
+
+    db_init_handle(&handle);
+    db_set_handle(&handle, dbname, NULL);
+    G_debug(2, "Open database");
+    if (db_open_database(driver, &handle) != DB_OK) {
+	G_warning("Cannot open database\n");
+	db_shutdown_driver(driver);
+	sprintf(buf, "Cannot open database '%s' by driver '%s'<BR>", dbname,
+		drvname);
+	*form = G_store(buf);
+	return -1;
+    }
+    G_debug(2, "Database opened");
+
+    /* TODO: test if table exist first, but this should be tested by application befor
+     *        F_generate() is called, because it may be correct (connection defined in DB
+     *        but table does not exist) */
+
+    sprintf(buf, "select * from %s where %s = %d", tblname, key, keyval);
+    G_debug(2, "%s", buf);
+    db_set_string(&sql, buf);
+    if (db_open_select_cursor(driver, &sql, &cursor, DB_SEQUENTIAL) != DB_OK) {
+	G_warning("Cannot open select cursor\n");
+	db_close_database(driver);
+	db_shutdown_driver(driver);
+	sprintf(buf,
+		"Cannot open select cursor:<BR>'%s'<BR>on database '%s' by driver '%s'<BR>",
+		db_get_string(&sql), dbname, drvname);
+	*form = G_store(buf);
+	return -1;
+    }
+    G_debug(2, "Select Cursor opened");
+
+    table = db_get_cursor_table(&cursor);
+
+    if (db_fetch(&cursor, DB_NEXT, &more) != DB_OK) {
+	G_warning("Cannot fetch next record\n");
+	db_close_cursor(&cursor);
+	db_close_database(driver);
+	db_shutdown_driver(driver);
+	*form = G_store("Cannot fetch next record");
+	return -1;
+    }
+
+    if (!more) {
+	G_warning("No database record");
+	if (format == F_HTML) {
+	    *form = G_store("No record selected.<BR>");
+	}
+	else {
+	    *form = G_store("No record selected.");
+	}
+    }
+    else {
+	ncols = db_get_table_number_of_columns(table);
+
+	/* Start form */
+	if (format == F_HTML) {
+	    if (edit_mode == F_EDIT) {
+		db_append_string(&html, "<FORM>");
+
+		sprintf(buf, "<INPUT type=hidden name=%s value=\"%s\">",
+			F_DRIVER_FNAME, drvname);
+		db_append_string(&html, buf);
+		/* Note: because html_library.tcl failes to parse
+		 *  <INPUT name=abc value='dbname=xxx'> and returnes
+		 *  name="xxx" value="dbname=xxx" order of value and name parameters is changed */
+		sprintf(buf, "<INPUT type=hidden value=\"%s\" name=%s>",
+			dbname, F_DATABASE_FNAME);
+		db_append_string(&html, buf);
+		sprintf(buf, "<INPUT type=hidden name=%s value=\"%s\">",
+			F_TABLE_FNAME, tblname);
+		db_append_string(&html, buf);
+		sprintf(buf, "<INPUT type=hidden name=%s value=\"%s\">",
+			F_KEY_FNAME, key);
+		db_append_string(&html, buf);
+
+	    }
+
+	    for (col = 0; col < ncols; col++) {
+		column = db_get_table_column(table, col);
+		sqltype = db_get_column_sqltype(column);
+		ctype = db_sqltype_to_Ctype(sqltype);
+		value = db_get_column_value(column);
+		db_convert_value_to_string(value, sqltype, &str);
+		colname = db_get_column_name(column);
+
+		G_debug(2, "%s: %s", colname, db_get_string(&str));
+
+		if (edit_mode == F_VIEW) {
+		    sprintf(buf, "<B>%s : </B> %s <BR>", colname,
+			    db_get_string(&str));
+		    db_append_string(&html, buf);
+		}
+		else {
+		    sprintf(buf, "<B>%s : </B>", colname);
+		    db_append_string(&html, buf);
+
+		    if (G_strcasecmp(colname, key) == 0) {
+			sprintf(buf,
+				"%s<BR> <INPUT type=hidden name=%s value=\"%s\">",
+				db_get_string(&str), colname,
+				db_get_string(&str));
+		    }
+		    else {
+			switch (ctype) {
+			case DB_C_TYPE_INT:
+			    sprintf(buf1, "20");
+			    break;
+			case DB_C_TYPE_DOUBLE:
+			    sprintf(buf1, "30");
+			    break;
+			case DB_C_TYPE_STRING:
+			    sprintf(buf1, "%d", db_get_column_length(column));
+			    break;
+			case DB_C_TYPE_DATETIME:
+			    sprintf(buf1, "20");
+			    break;
+			}
+			sprintf(buf,
+				"<INPUT type=text size=%s name=%s value=\"%s\"><BR>",
+				buf1, colname, db_get_string(&str));
+		    }
+		    db_append_string(&html, buf);
+		}
+	    }
+
+	    if (edit_mode == F_EDIT) {
+		sprintf(buf,
+			"<HR>   Assume data encoding as:<BR><BR><SELECT NAME=%s SIZE=4><HR><BR>",
+			F_ENCODING);
+		db_append_string(&html, buf);
+
+		i = 0;
+		while (encoding_list[i] != NULL) {
+
+		    if (G_strcasecmp(encoding_list[i], enc_env) == 0)
+			sprintf(buf, "<OPTION VALUE=\"%s\" SELECTED>%s",
+				encoding_list[i], encoding_list[i]);
+		    else
+			sprintf(buf, "<OPTION VALUE=\"%s\">%s",
+				encoding_list[i], encoding_list[i]);
+		    ++i;
+		    db_append_string(&html, buf);
+		}
+
+		sprintf(buf, "</SELECT>");
+		db_append_string(&html, buf);
+	    }
+
+	    /* Close form */
+	    if (edit_mode == F_EDIT) {
+		db_append_string(&html, "</FORM>");
+	    }
+	}
+	else {			/* F_TXT */
+	    for (col = 0; col < ncols; col++) {
+		column = db_get_table_column(table, col);
+		sqltype = db_get_column_sqltype(column);
+		ctype = db_sqltype_to_Ctype(sqltype);
+		value = db_get_column_value(column);
+		db_convert_value_to_string(value, sqltype, &str);
+		colname = db_get_column_name(column);
+
+		G_debug(2, "%s: %s", colname, db_get_string(&str));
+
+		sprintf(buf, "%s : %s\n", colname, db_get_string(&str));
+		db_append_string(&html, buf);
+	    }
+	}
+    }
+    G_debug(2, "FORM STRING:\n%s\n", db_get_string(&html));
+
+    db_close_cursor(&cursor);
+    db_close_database(driver);
+    db_shutdown_driver(driver);
+
+    *form = G_store(db_get_string(&html));
+
+    db_free_string(&sql);
+    db_free_string(&html);
+    db_free_string(&str);
+
+    return 0;
+}

Deleted: grass/trunk/lib/form/html_library.tcl
===================================================================
--- grass/trunk/lib/form/html_library.tcl	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/html_library.tcl	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,1417 +0,0 @@
-# Simple HTML display library by Stephen Uhler (stephen.uhler at sun.com)
-# Copyright (c) 1995 by Sun Microsystems
-# Version 0.3 Fri Sep  1 10:47:17 PDT 1995
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# To use this package,  create a text widget (say, .text)
-# and set a variable full of html, (say $html), and issue:
-#	HMinit_win .text
-#	HMparse_html $html "HMrender .text"
-# You also need to supply the routine:
-#   proc HMlink_callback {win href} { ...}
-#      win:  The name of the text widget
-#      href  The name of the link
-# which will be called anytime the user "clicks" on a link.
-# The supplied version just prints the link to stdout.
-# In addition, if you wish to use embedded images, you will need to write
-#   proc HMset_image {handle src}
-#      handle  an arbitrary handle (not really)
-#      src     The name of the image
-# Which calls
-#	HMgot_image $handle $image
-# with the TK image.
-#
-# To return a "used" text widget to its initialized state, call:
-#   HMreset_win .text
-# See "sample.tcl" for sample usage
-##################################################################
-############################################
-# mapping of html tags to text tag properties
-# properties beginning with "T" map directly to text tags
-
-# These are Defined in HTML 2.0
-
-array set HMtag_map {
-	b      {weight bold}
-	blockquote	{style i indent 1 Trindent rindent}
-	bq		{style i indent 1 Trindent rindent}
-	cite   {style i}
-	code   {family courier}
-	dfn    {style i}	
-	dir    {indent 1}
-	dl     {indent 1}
-	em     {style i}
-	h1     {size 24 weight bold}
-	h2     {size 22}		
-	h3     {size 20}	
-	h4     {size 18}
-	h5     {size 16}
-	h6     {style i}
-	i      {style i}
-	kbd    {family courier weight bold}
-	menu     {indent 1}
-	ol     {indent 1}
-	pre    {fill 0 family courier Tnowrap nowrap}
-	samp   {family courier}		
-	strong {weight bold}		
-	tt     {family courier}
-	u	 {Tunderline underline}
-	ul     {indent 1}
-	var    {style i}	
-}
-
-# These are in common(?) use, but not defined in html2.0
-
-array set HMtag_map {
-	center {Tcenter center}
-	strike {Tstrike strike}
-	u	   {Tunderline underline}
-}
-
-# initial values
-
-set HMtag_map(hmstart) {
-	family times   weight medium   style r   size 14
-	Tcenter ""   Tlink ""   Tnowrap ""   Tunderline ""   list list
-	fill 1   indent "" counter 0 adjust 0
-}
-
-# html tags that insert white space
-
-array set HMinsert_map {
-	blockquote "\n\n" /blockquote "\n"
-	br	"\n"
-	dd	"\n" /dd	"\n"
-	dl	"\n" /dl	"\n"
-	dt	"\n"
-	form "\n"	/form "\n"
-	h1	"\n\n"	/h1	"\n"
-	h2	"\n\n"	/h2	"\n"
-	h3	"\n\n"	/h3	"\n"
-	h4	"\n"	/h4	"\n"
-	h5	"\n"	/h5	"\n"
-	h6	"\n"	/h6	"\n"
-	li   "\n"
-	/dir "\n"
-	/ul "\n"
-	/ol "\n"
-	/menu "\n"
-	p	"\n\n"
-	pre "\n"	/pre "\n"
-}
-
-# tags that are list elements, that support "compact" rendering
-
-array set HMlist_elements {
-	ol 1   ul 1   menu 1   dl 1   dir 1
-}
-############################################
-# initialize the window and stack state
-
-proc HMinit_win {win} {
-	upvar #0 HM$win var
-	
-	HMinit_state $win
-	$win tag configure underline -underline 1
-	$win tag configure center -justify center
-	$win tag configure nowrap -wrap none
-	$win tag configure rindent -rmargin $var(S_tab)c
-	$win tag configure strike -overstrike 1
-	$win tag configure mark -foreground red		;# list markers
-	$win tag configure list -spacing1 3p -spacing3 3p		;# regular lists
-	$win tag configure compact -spacing1 0p		;# compact lists
-	$win tag configure link -borderwidth 2 -foreground blue	;# hypertext links
-	HMset_indent $win $var(S_tab)
-	$win configure -wrap word
-
-	# configure the text insertion point
-	$win mark set $var(S_insert) 1.0
-
-	# for horizontal rules
-	$win tag configure thin -font [HMx_font times 2 medium r]
-	$win tag configure hr -relief sunken -borderwidth 2 -wrap none \
-		-tabs [winfo width $win]
-	bind $win <Configure> {
-		%W tag configure hr -tabs %w
-		%W tag configure last -spacing3 %h
-	}
-
-	# generic link enter callback
-
-	$win tag bind link <1> "HMlink_hit $win %x %y"
-}
-
-# set the indent spacing (in cm) for lists
-# TK uses a "weird" tabbing model that causes \t to insert a single
-# space if the current line position is past the tab setting
-
-proc HMset_indent {win cm} {
-	set tabs [expr $cm / 2.0]
-	$win configure -tabs ${tabs}c
-	foreach i {1 2 3 4 5 6 7 8 9} {
-		set tab [expr $i * $cm]
-		$win tag configure indent$i -lmargin1 ${tab}c -lmargin2 ${tab}c \
-			-tabs "[expr $tab + $tabs]c [expr $tab + 2*$tabs]c"
-	}
-}
-
-# reset the state of window - get ready for the next page
-# remove all but the font tags, and remove all form state
-
-proc HMreset_win {win} {
-	upvar #0 HM$win var
-	regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags
-	catch "$win tag delete $tags"
-	eval $win mark unset [$win mark names]
-	$win delete 0.0 end
-	$win tag configure hr -tabs [winfo width $win]
-
-	# configure the text insertion point
-	$win mark set $var(S_insert) 1.0
-
-	# remove form state.  If any check/radio buttons still exists, 
-	# their variables will be magically re-created, and never get
-	# cleaned up.
-	catch unset [info globals HM$win.form*]
-
-	HMinit_state $win
-	return HM$win
-}
-
-# initialize the window's state array
-# Parameters beginning with S_ are NOT reset
-#  adjust_size:		global font size adjuster
-#  unknown:		character to use for unknown entities
-#  tab:			tab stop (in cm)
-#  stop:		enabled to stop processing
-#  update:		how many tags between update calls
-#  tags:		number of tags processed so far
-#  symbols:		Symbols to use on un-ordered lists
-
-proc HMinit_state {win} {
-	upvar #0 HM$win var
-	array set tmp [array get var S_*]
-	catch {unset var}
-	array set var {
-		stop 0
-		tags 0
-		fill 0
-		list list
-		S_adjust_size 0
-		S_tab 1.0
-		S_unknown \xb7
-		S_update 10
-		S_symbols O*=+-o\xd7\xb0>:\xb7
-		S_insert Insert
-	}
-	array set var [array get tmp]
-}
-
-# alter the parameters of the text state
-# this allows an application to over-ride the default settings
-# it is called as: HMset_state -param value -param value ...
-
-array set HMparam_map {
-	-update S_update
-	-tab S_tab
-	-unknown S_unknown
-	-stop S_stop
-	-size S_adjust_size
-	-symbols S_symbols
-    -insert S_insert
-}
-
-proc HMset_state {win args} {
-	upvar #0 HM$win var
-	global HMparam_map
-	set bad 0
-	if {[catch {array set params $args}]} {return 0}
-	foreach i [array names params] {
-		incr bad [catch {set var($HMparam_map($i)) $params($i)}]
-	}
-	return [expr $bad == 0]
-}
-
-############################################
-# manage the display of html
-
-# HMrender gets called for every html tag
-#   win:   The name of the text widget to render into
-#   tag:   The html tag (in arbitrary case)
-#   not:   a "/" or the empty string
-#   param: The un-interpreted parameter list
-#   text:  The plain text until the next html tag
-
-proc HMrender {win tag not param text} {
-	upvar #0 HM$win var
-	if {$var(stop)} return
-	global HMtag_map HMinsert_map HMlist_elements
-	set tag [string tolower $tag]
-	set text [HMmap_esc $text]
-
-	# manage compact rendering of lists
-	if {[info exists HMlist_elements($tag)]} {
-		set list "list [expr {[HMextract_param $param compact] ? "compact" : "list"}]"
-	} else {
-		set list ""
-	}
-
-	# Allow text to be diverted to a different window (for tables)
-	# this is not currently used
-	if {[info exists var(divert)]} {
-		set win $var(divert)
-		upvar #0 HM$win var
-	}
-
-	# adjust (push or pop) tag state
-	catch {HMstack $win $not "$HMtag_map($tag) $list"}
-
-	# insert white space (with current font)
-	# adding white space can get a bit tricky.  This isn't quite right
-	set bad [catch {$win insert $var(S_insert) $HMinsert_map($not$tag) "space $var(font)"}]
-	if {!$bad && [lindex $var(fill) end]} {
-		set text [string trimleft $text]
-	}
-
-	# to fill or not to fill
-	if {[lindex $var(fill) end]} {
-		set text [HMzap_white $text]
-	}
-
-	# generic mark hook
-	catch {HMmark $not$tag $win $param text} err
-
-	# do any special tag processing
-	catch {HMtag_$not$tag $win $param text} msg
-
-
-	# add the text with proper tags
-
-	set tags [HMcurrent_tags $win]
-	$win insert $var(S_insert) $text $tags
-
-	# We need to do an update every so often to insure interactive response.
-	# This can cause us to re-enter the event loop, and cause recursive
-	# invocations of HMrender, so we need to be careful.
-	if {!([incr var(tags)] % $var(S_update))} {
-		update
-	}
-}
-
-# html tags requiring special processing
-# Procs of the form HMtag_<tag> or HMtag_</tag> get called just before
-# the text for this tag is displayed.  These procs are called inside a 
-# "catch" so it is OK to fail.
-#   win:   The name of the text widget to render into
-#   param: The un-interpreted parameter list
-#   text:  A pass-by-reference name of the plain text until the next html tag
-#          Tag commands may change this to affect what text will be inserted
-#          next.
-
-# A pair of pseudo tags are added automatically as the 1st and last html
-# tags in the document.  The default is <HMstart> and </HMstart>.
-# Append enough blank space at the end of the text widget while
-# rendering so HMgoto can place the target near the top of the page,
-# then remove the extra space when done rendering.
-
-proc HMtag_hmstart {win param text} {
-	upvar #0 HM$win var
-	$win mark gravity $var(S_insert) left
-	$win insert end "\n " last
-	$win mark gravity $var(S_insert) right
-}
-
-proc HMtag_/hmstart {win param text} {
-	$win delete last.first end
-}
-
-# put the document title in the window banner, and remove the title text
-# from the document
-
-proc HMtag_title {win param text} {
-	upvar $text data
-	wm title [winfo toplevel $win] $data
-	set data ""
-}
-
-proc HMtag_hr {win param text} {
-	upvar #0 HM$win var
-	$win insert $var(S_insert) "\n" space "\n" thin "\t" "thin hr" "\n" thin
-}
-
-# list element tags
-
-proc HMtag_ol {win param text} {
-	upvar #0 HM$win var
-	set var(count$var(level)) 0
-}
-
-proc HMtag_ul {win param text} {
-	upvar #0 HM$win var
-	catch {unset var(count$var(level))}
-}
-
-proc HMtag_menu {win param text} {
-	upvar #0 HM$win var
-	set var(menu) ->
-	set var(compact) 1
-}
-
-proc HMtag_/menu {win param text} {
-	upvar #0 HM$win var
-	catch {unset var(menu)}
-	catch {unset var(compact)}
-}
-	
-proc HMtag_dt {win param text} {
-	upvar #0 HM$win var
-	upvar $text data
-	set level $var(level)
-	incr level -1
-	$win insert $var(S_insert) "$data" \
-		"hi [lindex $var(list) end] indent$level $var(font)"
-	set data {}
-}
-
-proc HMtag_li {win param text} {
-	upvar #0 HM$win var
-	set level $var(level)
-	incr level -1
-	set x [string index $var(S_symbols)+-+-+-+-" $level]
-	catch {set x [incr var(count$level)]}
-	catch {set x $var(menu)}
-	$win insert $var(S_insert) \t$x\t "mark [lindex $var(list) end] indent$level $var(font)"
-}
-
-# Manage hypertext "anchor" links.  A link can be either a source (href)
-# a destination (name) or both.  If its a source, register it via a callback,
-# and set its default behavior.  If its a destination, check to see if we need
-# to go there now, as a result of a previous HMgoto request.  If so, schedule
-# it to happen with the closing </a> tag, so we can highlight the text up to
-# the </a>.
-
-proc HMtag_a {win param text} {
-	upvar #0 HM$win var
-
-	# a source
-
-	if {[HMextract_param $param href]} {
-		set var(Tref) [list L:$href]
-		HMstack $win "" "Tlink link"
-		HMlink_setup $win $href
-	}
-
-	# a destination
-
-	if {[HMextract_param $param name]} {
-		set var(Tname) [list N:$name]
-		HMstack $win "" "Tanchor anchor"
-		$win mark set N:$name "$var(S_insert) - 1 chars"
-		$win mark gravity N:$name left
-		if {[info exists var(goto)] && $var(goto) == $name} {
-			unset var(goto)
-			set var(going) $name
-		}
-	}
-}
-
-# The application should call here with the fragment name
-# to cause the display to go to this spot.
-# If the target exists, go there (and do the callback),
-# otherwise schedule the goto to happen when we see the reference.
-
-proc HMgoto {win where {callback HMwent_to}} {
-	upvar #0 HM$win var
-	if {[regexp N:$where [$win mark names]]} {
-		$win see N:$where
-		update
-		eval $callback $win [list $where]
-		return 1
-	} else {
-		set var(goto) $where
-		return 0
-	}
-}
-
-# We actually got to the spot, so highlight it!
-# This should/could be replaced by the application
-# We'll flash it orange a couple of times.
-
-proc HMwent_to {win where {count 0} {color orange}} {
-	upvar #0 HM$win var
-	if {$count > 5} return
-	catch {$win tag configure N:$where -foreground $color}
-	update
-	after 200 [list HMwent_to $win $where [incr count] \
-				[expr {$color=="orange" ? "" : "orange"}]]
-}
-
-proc HMtag_/a {win param text} {
-	upvar #0 HM$win var
-	if {[info exists var(Tref)]} {
-		unset var(Tref)
-		HMstack $win / "Tlink link"
-	}
-
-	# goto this link, then invoke the call-back.
-
-	if {[info exists var(going)]} {
-		$win yview N:$var(going)
-		update
-		HMwent_to $win $var(going)
-		unset var(going)
-	}
-
-	if {[info exists var(Tname)]} {
-		unset var(Tname)
-		HMstack $win / "Tanchor anchor"
-	}
-}
-
-#           Inline Images
-# This interface is subject to change
-# Most of the work is getting around a limitation of TK that prevents
-# setting the size of a label to a widthxheight in pixels
-#
-# Images have the following parameters:
-#    align:  top,middle,bottom
-#    alt:    alternate text
-#    ismap:  A clickable image map
-#    src:    The URL link
-# Netscape supports (and so do we)
-#    width:  A width hint (in pixels)
-#    height:  A height hint (in pixels)
-#    border: The size of the window border
-
-proc HMtag_img {win param text} {
-	upvar #0 HM$win var
-
-	# get alignment
-	array set align_map {top top    middle center    bottom bottom}
-	set align bottom		;# The spec isn't clear what the default should be
-	HMextract_param $param align
-	catch {set align $align_map([string tolower $align])}
-
-	# get alternate text
-	set alt "<image>"
-	HMextract_param $param alt
-	set alt [HMmap_esc $alt]
-
-	# get the border width
-	set border 1
-	HMextract_param $param border
-
-	# see if we have an image size hint
-	# If so, make a frame the "hint" size to put the label in
-	# otherwise just make the label
-	set item $win.$var(tags)
-	# catch {destroy $item}
-	if {[HMextract_param $param width] && [HMextract_param $param height]} {
-		frame $item -width $width -height $height
-		pack propagate $item 0
-		set label $item.label
-		label $label
-		pack $label -expand 1 -fill both
-	} else {
-		set label $item
-		label $label 
-	}
-
-	$label configure -relief ridge -fg orange -text $alt
-	catch {$label configure -bd $border}
-	$win window create $var(S_insert) -align $align -window $item -pady 2 -padx 2
-
-	# add in all the current tags (this is overkill)
-	set tags [HMcurrent_tags $win]
-	foreach tag $tags {
-		$win tag add $tag $item
-	}
-
-	# set imagemap callbacks
-	if {[HMextract_param $param ismap]} {
-		# regsub -all {[^L]*L:([^ ]*).*}  $tags {\1} link
-		set link [lindex $tags [lsearch -glob $tags L:*]]
-		regsub L: $link {} link
-		global HMevents
-		regsub -all {%} $link {%%} link2
-		foreach i [array names HMevents] {
-			bind $label <$i> "catch \{%W configure $HMevents($i)\}"
-		}
-		bind $label <1> "+HMlink_callback $win $link2?%x,%y"
-	} 
-
-	# now callback to the application
-	set src ""
-	HMextract_param $param src
-	HMset_image $win $label $src
-	return $label	;# used by the forms package for input_image types
-}
-
-# The app needs to supply one of these
-proc HMset_image {win handle src} {
-	HMgot_image $handle "can't get\n$src"
-}
-
-# When the image is available, the application should call back here.
-# If we have the image, put it in the label, otherwise display the error
-# message.  If we don't get a callback, the "alt" text remains.
-# if we have a clickable image, arrange for a callback
-
-proc HMgot_image {win image_error} {
-	# if we're in a frame turn on geometry propogation
-	if {[winfo name $win] == "label"} {
-		pack propagate [winfo parent $win] 1
-	}
-	if {[catch {$win configure -image $image_error}]} {
-		$win configure -image {}
-		$win configure -text $image_error
-	}
-}
-
-# Sample hypertext link callback routine - should be replaced by app
-# This proc is called once for each <A> tag.
-# Applications can overwrite this procedure, as required, or
-# replace the HMevents array
-#   win:   The name of the text widget to render into
-#   href:  The HREF link for this <a> tag.
-
-array set HMevents {
-	Enter	{-borderwidth 2 -relief raised }
-	Leave	{-borderwidth 2 -relief flat }
-	1		{-borderwidth 2 -relief sunken}
-	ButtonRelease-1	{-borderwidth 2 -relief raised}
-}
-
-# We need to escape any %'s in the href tag name so the bind command
-# doesn't try to substitute them.
-
-proc HMlink_setup {win href} {
-	global HMevents
-	regsub -all {%} $href {%%} href2
-	foreach i [array names HMevents] {
-		eval {$win tag bind  L:$href <$i>} \
-			\{$win tag configure \{L:$href2\} $HMevents($i)\}
-	}
-}
-
-# generic link-hit callback
-# This gets called upon button hits on hypertext links
-# Applications are expected to supply ther own HMlink_callback routine
-#   win:   The name of the text widget to render into
-#   x,y:   The cursor position at the "click"
-
-proc HMlink_hit {win x y} {
-	set tags [$win tag names @$x,$y]
-	set link [lindex $tags [lsearch -glob $tags L:*]]
-	# regsub -all {[^L]*L:([^ ]*).*}  $tags {\1} link
-	regsub L: $link {} link
-	HMlink_callback $win $link
-}
-
-# replace this!
-#   win:   The name of the text widget to render into
-#   href:  The HREF link for this <a> tag.
-
-proc HMlink_callback {win href} {
-	puts "Got hit on $win, link $href"
-}
-
-# extract a value from parameter list (this needs a re-do)
-# returns "1" if the keyword is found, "0" otherwise
-#   param:  A parameter list.  It should alredy have been processed to
-#           remove any entity references
-#   key:    The parameter name
-#   val:    The variable to put the value into (use key as default)
-
-proc HMextract_param {param key {val ""}} {
-
-	if {$val == ""} {
-		upvar $key result
-	} else {
-		upvar $val result
-	}
-    set ws "    \n\r"
- 
-    # look for name=value combinations.  Either (') or (") are valid delimeters
-    if {
-      [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] ||
-      [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] ||
-      [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } {
-        set result $value
-        return 1
-    }
-
-	# now look for valueless names
-	# I should strip out name=value pairs, so we don't end up with "name"
-	# inside the "value" part of some other key word - some day
-	
-	set bad \[^a-zA-Z\]+
-	if {[regexp -nocase  "$bad$key$bad" -$param-]} {
-		return 1
-	} else {
-		return 0
-	}
-}
-
-# These next two routines manage the display state of the page.
-
-# Push or pop tags to/from stack.
-# Each orthogonal text property has its own stack, stored as a list.
-# The current (most recent) tag is the last item on the list.
-# Push is {} for pushing and {/} for popping
-
-proc HMstack {win push list} {
-	upvar #0 HM$win var
-	array set tags $list
-	if {$push == ""} {
-		foreach tag [array names tags] {
-			lappend var($tag) $tags($tag)
-		}
-	} else {
-		foreach tag [array names tags] {
-			# set cnt [regsub { *[^ ]+$} $var($tag) {} var($tag)]
-			set var($tag) [lreplace $var($tag) end end]
-		}
-	}
-}
-
-# extract set of current text tags
-# tags starting with T map directly to text tags, all others are
-# handled specially.  There is an application callback, HMset_font
-# to allow the application to do font error handling
-
-proc HMcurrent_tags {win} {
-	upvar #0 HM$win var
-	set font font
-	foreach i {family size weight style} {
-		set $i [lindex $var($i) end]
-		append font :[set $i]
-	}
-	set xfont [HMx_font $family $size $weight $style $var(S_adjust_size)]
-	HMset_font $win $font $xfont
-	set indent [llength $var(indent)]
-	incr indent -1
-	lappend tags $font indent$indent
-	foreach tag [array names var T*] {
-		lappend tags [lindex $var($tag) end]	;# test
-	}
-	set var(font) $font
-	set var(xfont) [$win tag cget $font -font]
-	set var(level) $indent
-	return $tags
-}
-
-# allow the application to do do better font management
-# by overriding this procedure
-
-proc HMset_font {win tag font} {
-	catch {$win tag configure $tag -font $font} msg
-}
-
-# generate an X font name
-proc HMx_font {family size weight style {adjust_size 0}} {
-	catch {incr size $adjust_size}
-	return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*"
-}
-
-# Optimize HMrender (hee hee)
-# This is experimental
-
-proc HMoptimize {} {
-	regsub -all "\n\[ 	\]*#\[^\n\]*" [info body HMrender] {} body
-	regsub -all ";\[ 	\]*#\[^\n]*" $body {} body
-	regsub -all "\n\n+" $body \n body
-	proc HMrender {win tag not param text} $body
-}
-############################################
-# Turn HTML into TCL commands
-#   html    A string containing an html document
-#   cmd		A command to run for each html tag found
-#   start	The name of the dummy html start/stop tags
-
-proc HMparse_html {html {cmd HMtest_parse} {start hmstart}} {
-	regsub -all \{ $html {\&ob;} html
-	regsub -all \} $html {\&cb;} html
-	set w " \t\r\n"	;# white space
-	proc HMcl x {return "\[$x\]"}
-	set exp <(/?)([HMcl ^$w>]+)[HMcl $w]*([HMcl ^>]*)>
-	set sub "\}\n$cmd {\\2} {\\1} {\\3} \{"
-	regsub -all $exp $html $sub html
-	eval "$cmd {$start} {} {} \{ $html \}"
-	eval "$cmd {$start} / {} {}"
-}
-
-proc HMtest_parse {command tag slash text_after_tag} {
-	puts "==> $command $tag $slash $text_after_tag"
-}
-
-# Convert multiple white space into a single space
-
-proc HMzap_white {data} {
-	regsub -all "\[ \t\r\n\]+" $data " " data
-	return $data
-}
-
-# find HTML escape characters of the form &xxx;
-
-proc HMmap_esc {text} {
-	if {![regexp & $text]} {return $text}
-	regsub -all {([][$\\])} $text {\\\1} new
-	regsub -all {&#([0-9][0-9]?[0-9]?);?} \
-		$new {[format %c [scan \1 %d tmp;set tmp]]} new
-	regsub -all {&([a-zA-Z]+);?} $new {[HMdo_map \1]} new
-	return [subst $new]
-}
-
-# convert an HTML escape sequence into character
-
-proc HMdo_map {text {unknown ?}} {
-	global HMesc_map
-	set result $unknown
-	catch {set result $HMesc_map($text)}
-	return $result
-}
-
-# table of escape characters (ISO latin-1 esc's are in a different table)
-
-array set HMesc_map {
-   lt <   gt >   amp &   quot \"   copy \xa9
-   reg \xae   ob \x7b   cb \x7d   nbsp \xa0
-}
-#############################################################
-# ISO Latin-1 escape codes
-
-array set HMesc_map {
-	nbsp \xa0 iexcl \xa1 cent \xa2 pound \xa3 curren \xa4
-	yen \xa5 brvbar \xa6 sect \xa7 uml \xa8 copy \xa9
-	ordf \xaa laquo \xab not \xac shy \xad reg \xae
-	hibar \xaf deg \xb0 plusmn \xb1 sup2 \xb2 sup3 \xb3
-	acute \xb4 micro \xb5 para \xb6 middot \xb7 cedil \xb8
-	sup1 \xb9 ordm \xba raquo \xbb frac14 \xbc frac12 \xbd
-	frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc \xc2
-	Atilde \xc3 Auml \xc4 Aring \xc5 AElig \xc6 Ccedil \xc7
-	Egrave \xc8 Eacute \xc9 Ecirc \xca Euml \xcb Igrave \xcc
-	Iacute \xcd Icirc \xce Iuml \xcf ETH \xd0 Ntilde \xd1
-	Ograve \xd2 Oacute \xd3 Ocirc \xd4 Otilde \xd5 Ouml \xd6
-	times \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc \xdb
-	Uuml \xdc Yacute \xdd THORN \xde szlig \xdf agrave \xe0
-	aacute \xe1 acirc \xe2 atilde \xe3 auml \xe4 aring \xe5
-	aelig \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc \xea
-	euml \xeb igrave \xec iacute \xed icirc \xee iuml \xef
-	eth \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc \xf4
-	otilde \xf5 ouml \xf6 divide \xf7 oslash \xf8 ugrave \xf9
-	uacute \xfa ucirc \xfb uuml \xfc yacute \xfd thorn \xfe
-	yuml \xff
-}
-
-##########################################################
-# html forms management commands
-
-# As each form element is located, it is created and rendered.  Additional
-# state is stored in a form specific global variable to be processed at
-# the end of the form, including the "reset" and "submit" options.
-# Remember, there can be multiple forms existing on multiple pages.  When
-# HTML tables are added, a single form could be spread out over multiple
-# text widgets, which makes it impractical to hang the form state off the
-# HM$win structure.  We don't need to check for the existance of required
-# parameters, we just "fail" and get caught in HMrender
-
-# This causes line breaks to be preserved in the inital values
-# of text areas
-array set HMtag_map {
-	textarea    {fill 0}
-}
-
-##########################################################
-# html isindex tag.  Although not strictly forms, they're close enough
-# to be in this file
-
-# is-index forms
-# make a frame with a label, entry, and submit button
-
-proc HMtag_isindex {win param text} {
-	upvar #0 HM$win var
-
-	set item $win.$var(tags)
-	if {[winfo exists $item]} {
-		destroy $item
-	}
-	frame $item -relief ridge -bd 3
-	set prompt "Enter search keywords here"
-	HMextract_param $param prompt
-	label $item.label -text [HMmap_esc $prompt] -font $var(xfont)
-	entry $item.entry
-	bind $item.entry <Return> "$item.submit invoke"
-	button $item.submit -text search -font $var(xfont) -command \
-		[format {HMsubmit_index %s {%s} [HMmap_reply [%s get]]} \
-		$win $param $item.entry]
-	pack $item.label -side top
-	pack $item.entry $item.submit -side left
-
-	# insert window into text widget
-
-	$win insert $var(S_insert) \n isindex
-	HMwin_install $win $item
-	$win insert $var(S_insert) \n isindex
-	bind $item <Visibility> {focus %W.entry}
-}
-
-# This is called when the isindex form is submitted.
-# The default version calls HMlink_callback.  Isindex tags should either
-# be deprecated, or fully supported (e.g. they need an href parameter)
-
-proc HMsubmit_index {win param text} {
-	HMlink_callback $win ?$text
-}
-
-# initialize form state.  All of the state for this form is kept
-# in a global array whose name is stored in the form_id field of
-# the main window array.
-# Parameters: ACTION, METHOD, ENCTYPE
-
-proc HMtag_form {win param text} {
-	upvar #0 HM$win var
-
-	# create a global array for the form
-	set id HM$win.form$var(tags)
-	upvar #0 $id form
-
-	# missing /form tag, simulate it
-	if {[info exists var(form_id)]} {
-		puts "Missing end-form tag !!!! $var(form_id)"
-		HMtag_/form $win {} {}
-	}
-	catch {unset form}
-	set var(form_id) $id
-
-	set form(param) $param		;# form initial parameter list
-	set form(reset) ""			;# command to reset the form
-	set form(reset_button) ""	;# list of all reset buttons
-	set form(submit) ""			;# command to submit the form
-	set form(submit_button) ""	;# list of all submit buttons
-}
-
-# Where we're done try to get all of the state into the widgets so
-# we can free up the form structure here.  Unfortunately, we can't!
-
-proc HMtag_/form {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	# make submit button entries for all radio buttons
-	foreach name [array names form radio_*] {
-		regsub radio_ $name {} name
-		lappend form(submit) [list $name \$form(radio_$name)]
-	}
-
-	# process the reset button(s)
-
-	foreach item $form(reset_button) {
-		$item configure -command $form(reset)
-	}
-
-	# no submit button - add one
-	if {$form(submit_button) == ""} {
-		HMinput_submit $win {}
-	}
-
-	# process the "submit" command(s)
-	# each submit button could have its own name,value pair
-
-	foreach item $form(submit_button) {
-		set submit $form(submit)
-		catch {lappend submit $form(submit_$item)}
-		$item configure -command  \
-				[list HMsubmit_button $win $var(form_id) $form(param) \
-				$submit]
-	}
-
-	# unset all unused fields here
-	unset form(reset) form(submit) form(reset_button) form(submit_button)
-	unset var(form_id)
-}
-
-###################################################################
-# handle form input items
-# each item type is handled in a separate procedure
-# Each "type" procedure needs to:
-# - create the window
-# - initialize it
-# - add the "submit" and "reset" commands onto the proper Q's
-#   "submit" is subst'd
-#   "reset" is eval'd
-
-proc HMtag_input {win param text} {
-	upvar #0 HM$win var
-
-	set type text	;# the default
-	HMextract_param $param type
-	set type [string tolower $type]
-	if {[catch {HMinput_$type $win $param} err]} {
-		puts stderr $err
-	}
-}
-
-# input type=text
-# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE
-
-proc HMinput_text {win param {show {}}} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	# make the entry
-	HMextract_param $param name		;# required
-	set item $win.input_text,$var(tags)
-	set size 20; HMextract_param $param size
-	set maxlength 0; HMextract_param $param maxlength
-	entry $item -width $size -show $show
-
-	# set the initial value
-	set value ""; HMextract_param $param value
-	$item insert 0 $value
-		
-	# insert the entry
-	HMwin_install $win $item
-
-	# set the "reset" and "submit" commands
-	append form(reset) ";$item delete 0 end;$item insert 0 [list $value]"
-	lappend form(submit) [list $name "\[$item get]"]
-
-	# handle the maximum length (broken - no way to cleanup bindtags state)
-	if {$maxlength} {
-		bindtags $item "[bindtags $item] max$maxlength"
-		bind max$maxlength <KeyPress> "%W delete $maxlength end"
-	}
-}
-
-# password fields - same as text, only don't show data
-# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE
-
-proc HMinput_password {win param} {
-	HMinput_text $win $param *
-}
-
-# checkbuttons are missing a "get" option, so we must use a global
-# variable to store the value.
-# Parameters NAME, VALUE, (reqd), CHECKED
-
-proc HMinput_checkbox {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	HMextract_param $param name
-	HMextract_param $param value
-
-	# Set the global variable, don't use the "form" alias as it is not
-	# defined in the global scope of the button
-	set variable $var(form_id)(check_$var(tags))	
-	set item $win.input_checkbutton,$var(tags)
-	checkbutton $item -variable $variable -off {} -on $value -text "  "
-	if {[HMextract_param $param checked]} {
-		$item select
-		append form(reset) ";$item select"
-	} else {
-		append form(reset) ";$item deselect"
-	}
-
-	HMwin_install $win $item
-	lappend form(submit) [list $name \$form(check_$var(tags))]
-}
-
-# radio buttons.  These are like check buttons, but only one can be selected
-
-proc HMinput_radio {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	HMextract_param $param name
-	HMextract_param $param value
-
-	set first [expr ![info exists form(radio_$name)]]
-	set variable $var(form_id)(radio_$name)
-	set variable $var(form_id)(radio_$name)
-	set item $win.input_radiobutton,$var(tags)
-	radiobutton $item -variable $variable -value $value -text " "
-
-	HMwin_install $win $item
-
-	if {$first || [HMextract_param $param checked]} {
-		$item select
-		append form(reset) ";$item select"
-	} else {
-		append form(reset) ";$item deselect"
-	}
-
-	# do the "submit" actions in /form so we only end up with 1 per button grouping
-	# contributing to the submission
-}
-
-# hidden fields, just append to the "submit" data
-# params: NAME, VALUE (reqd)
-
-proc HMinput_hidden {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	HMextract_param $param name
-	HMextract_param $param value
-	lappend form(submit) [list $name $value]
-}
-
-# handle input images.  The spec isn't very clear on these, so I'm not
-# sure its quite right
-# Use std image tag, only set up our own callbacks
-#  (e.g. make sure ismap isn't set)
-# params: NAME, SRC (reqd) ALIGN
-
-proc HMinput_image {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	HMextract_param $param name
-	set name		;# barf if no name is specified
-	set item [HMtag_img $win $param {}]
-	$item configure -relief raised -bd 2 -bg blue
-
-	# make a dummy "submit" button, and invoke it to send the form.
-	# We have to get the %x,%y in the value somehow, so calculate it during
-	# binding, and save it in the form array for later processing
-
-	set submit $win.dummy_submit,$var(tags)
-	if {[winfo exists $submit]} {
-		destroy $submit
-	}
-	button $submit	-takefocus 0;# this never gets mapped!
-	lappend form(submit_button) $submit
-	set form(submit_$submit) [list $name $name.\$form(X).\$form(Y)]
-	
-	$item configure -takefocus 1
-	bind $item <FocusIn> "catch \{$win see $item\}"
-	bind $item <1> "$item configure -relief sunken"
-	bind $item <Return> "
-		set $var(form_id)(X) 0
-		set $var(form_id)(Y) 0
-		$submit invoke	
-	"
-	bind $item <ButtonRelease-1> "
-		set $var(form_id)(X) %x
-		set $var(form_id)(Y) %y
-		$item configure -relief raised
-		$submit invoke	
-	"
-}
-
-# Set up the reset button.  Wait for the /form to attach
-# the -command option.  There could be more that 1 reset button
-# params VALUE
-
-proc HMinput_reset {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	set value reset
-	HMextract_param $param value
-
-	set item $win.input_reset,$var(tags)
-	button $item -text [HMmap_esc $value]
-	HMwin_install $win $item
-	lappend form(reset_button) $item
-}
-
-# Set up the submit button.  Wait for the /form to attach
-# the -command option.  There could be more that 1 submit button
-# params: NAME, VALUE
-
-proc HMinput_submit {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	HMextract_param $param name
-	set value submit
-	HMextract_param $param value
-	set item $win.input_submit,$var(tags)
-	button $item -text [HMmap_esc $value] -fg blue
-	HMwin_install $win $item
-	lappend form(submit_button) $item
-	# need to tie the "name=value" to this button
-	# save the pair and do it when we finish the submit button
-	catch {set form(submit_$item) [list $name $value]}
-}
-
-#########################################################################
-# selection items
-# They all go into a list box.  We don't what to do with the listbox until
-# we know how many items end up in it.  Gather up the data for the "options"
-# and finish up in the /select tag
-# params: NAME (reqd), MULTIPLE, SIZE 
-
-proc HMtag_select {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	HMextract_param $param name
-	set size 5;  HMextract_param $param size
-	set form(select_size) $size
-	set form(select_name) $name
-	set form(select_values) ""		;# list of values to submit
-	if {[HMextract_param $param multiple]} {
-		set mode multiple
-	} else {
-		set mode single
-	}
-	set item $win.select,$var(tags)
-    frame $item
-    set form(select_frame) $item
-	listbox $item.list -selectmode $mode -width 0 -exportselection 0
-	HMwin_install $win $item
-}
-
-# select options
-# The values returned in the query may be different from those
-# displayed in the listbox, so we need to keep a separate list of
-# query values.
-#  form(select_default) - contains the default query value
-#  form(select_frame) - name of the listbox's containing frame
-#  form(select_values)  - list of query values
-# params: VALUE, SELECTED
-
-proc HMtag_option {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	upvar $text data
-	set frame $form(select_frame)
-
-	# set default option (or options)
-	if {[HMextract_param $param selected]} {
-        lappend form(select_default) [$form(select_frame).list size]
-    }
-    set value [string trimright $data " \n"]
-    $frame.list insert end $value
-	HMextract_param $param value
-	lappend form(select_values) $value
-	set data ""
-}
- 
-# do most of the work here!
-# if SIZE>1, make the listbox.  Otherwise make a "drop-down"
-# listbox with a label in it
-# If the # of items > size, add a scroll bar
-# This should probably be broken up into callbacks to make it
-# easier to override the "look".
-
-proc HMtag_/select {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	set frame $form(select_frame)
-	set size $form(select_size)
-	set items [$frame.list size]
-
-	# set the defaults and reset button
-	append form(reset) ";$frame.list selection clear 0  $items"
-	if {[info exists form(select_default)]} {
-		foreach i $form(select_default) {
-			$frame.list selection set $i
-			append form(reset) ";$frame.list selection set $i"
-		}
-	} else {
-		$frame.list selection set 0
-		append form(reset) ";$frame.list selection set 0"
-	}
-
-	# set up the submit button. This is the general case.  For single
-	# selections we could be smarter
-
-	for {set i 0} {$i < $size} {incr i} {
-		set value [format {[expr {[%s selection includes %s] ? {%s} : {}}]} \
-				$frame.list $i [lindex $form(select_values) $i]]
-		lappend form(submit) [list $form(select_name) $value]
-	}
-	
-	# show the listbox - no scroll bar
-
-	if {$size > 1 && $items <= $size} {
-		$frame.list configure -height $items
-		pack $frame.list
-
-	# Listbox with scrollbar
-
-	} elseif {$size > 1} {
-		scrollbar $frame.scroll -command "$frame.list yview"  \
-				-orient v -takefocus 0
-		$frame.list configure -height $size \
-			-yscrollcommand "$frame.scroll set"
-		pack $frame.list $frame.scroll -side right -fill y
-
-	# This is a joke!
-
-	} else {
-		scrollbar $frame.scroll -command "$frame.list yview"  \
-			-orient h -takefocus 0
-		$frame.list configure -height 1 \
-			-yscrollcommand "$frame.scroll set"
-		pack $frame.list $frame.scroll -side top -fill x
-	}
-
-	# cleanup
-
-	foreach i [array names form select_*] {
-		unset form($i)
-	}
-}
-
-# do a text area (multi-line text)
-# params: COLS, NAME, ROWS (all reqd, but default rows and cols anyway)
-
-proc HMtag_textarea {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	upvar $text data
-
-	set rows 5; HMextract_param $param rows
-	set cols 30; HMextract_param $param cols
-	HMextract_param $param name
-	set item $win.textarea,$var(tags)
-	frame $item
-	text $item.text -width $cols -height $rows -wrap none \
-			-yscrollcommand "$item.scroll set" -padx 3 -pady 3
-	scrollbar $item.scroll -command "$item.text yview"  -orient v
-	$item.text insert 1.0 $data
-	HMwin_install $win $item
-	pack $item.text $item.scroll -side right -fill y
-	lappend form(submit) [list $name "\[$item.text get 0.0 end]"]
-	append form(reset) ";$item.text delete 1.0 end; \
-			$item.text insert 1.0 [list $data]"
-	set data ""
-}
-
-# procedure to install windows into the text widget
-# - win:  name of the text widget
-# - item: name of widget to install
-
-proc HMwin_install {win item} {
-	upvar #0 HM$win var
-	$win window create $var(S_insert) -window $item -align bottom
-	$win tag add indent$var(level) $item
-	set focus [expr {[winfo class $item] != "Frame"}]
-	$item configure -takefocus $focus
-	bind $item <FocusIn> "$win see $item"
-}
-
-#####################################################################
-# Assemble and submit the query
-# each list element in "stuff" is a name/value pair
-# - The names are the NAME parameters of the various fields
-# - The values get run through "subst" to extract the values
-# - We do the user callback with the list of name value pairs
-
-proc HMsubmit_button {win form_id param stuff} {
-	upvar #0 HM$win var
-	upvar #0 $form_id form
-	set query ""
-	foreach pair $stuff {
-		set value [subst [lindex $pair 1]]
-		if {$value != ""} {
-			set item [lindex $pair 0]
-			lappend query $item $value
-		}
-	}
-	# this is the user callback.
-	HMsubmit_form $win $param $query
-}
-
-# sample user callback for form submission
-# should be replaced by the application
-# Sample version generates a string suitable for http
-
-proc HMsubmit_form {win param query} {
-	set result ""
-	set sep ""
-	foreach i $query {
-		append result  $sep [HMmap_reply $i]
-		if {$sep != "="} {set sep =} {set sep &}
-	}
-	puts $result
-}
-
-# do x-www-urlencoded character mapping
-# The spec says: "non-alphanumeric characters are replaced by '%HH'"
- 
-set HMalphanumeric	a-zA-Z0-9	;# definition of alphanumeric character class
-for {set i 1} {$i <= 256} {incr i} {
-    set c [format %c $i]
-    if {![string match \[$HMalphanumeric\] $c]} {
-        set HMform_map($c) %[format %.2x $i]
-    }
-}
-
-# These are handled specially
-array set HMform_map {
-    " " +   \n %0d%0a
-}
-
-# 1 leave alphanumerics characters alone
-# 2 Convert every other character to an array lookup
-# 3 Escape constructs that are "special" to the tcl parser
-# 4 "subst" the result, doing all the array substitutions
- 
-proc HMmap_reply {string} {
-    global HMform_map HMalphanumeric
-    regsub -all \[^$HMalphanumeric\] $string {$HMform_map(&)} string
-    regsub -all \n $string {\\n} string
-    regsub -all \t $string {\\t} string
-    regsub -all {[][{})\\]\)} $string {\\&} string
-    return [subst $string]
-}
-
-# convert a x-www-urlencoded string int a a list of name/value pairs
-
-# 1  convert a=b&c=d... to {a} {b} {c} {d}...
-# 2, convert + to  " "
-# 3, convert %xx to char equiv
-
-proc HMcgiDecode {data} {
-	set data [split $data "&="]
-	foreach i $data {
-		lappend result [cgiMap $i]
-	}
-	return $result
-}
-
-proc HMcgiMap {data} {
-	regsub -all {\+} $data " " data
-	
-	if {[regexp % $data]} {
-		regsub -all {([][$\\])} $data {\\\1} data
-		regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data  {[format %c 0x\1]} data
-		return [subst $data]
-	} else {
-		return $data
-	}
-}
-
-# There is a bug in the tcl library focus routines that prevents focus
-# from every reaching an un-viewable window.  Use our *own*
-# version of the library routine, until the bug is fixed, make sure we
-# over-ride the library version, and not the otherway around
-
-auto_load tkFocusOK
-proc tkFocusOK w {
-    set code [catch {$w cget -takefocus} value]
-    if {($code == 0) && ($value != "")} {
-    if {$value == 0} {
-        return 0
-    } elseif {$value == 1} {
-        return 1
-    } else {
-        set value [uplevel #0 $value $w]
-        if {$value != ""} {
-        return $value
-        }
-    }
-    }
-    set code [catch {$w cget -state} value]
-    if {($code == 0) && ($value == "disabled")} {
-    return 0
-    }
-    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
-}

Copied: grass/trunk/lib/form/html_library.tcl (from rev 35193, grass/trunk/lib/form/html_library.tcl)
===================================================================
--- grass/trunk/lib/form/html_library.tcl	                        (rev 0)
+++ grass/trunk/lib/form/html_library.tcl	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,1417 @@
+# Simple HTML display library by Stephen Uhler (stephen.uhler at sun.com)
+# Copyright (c) 1995 by Sun Microsystems
+# Version 0.3 Fri Sep  1 10:47:17 PDT 1995
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# To use this package,  create a text widget (say, .text)
+# and set a variable full of html, (say $html), and issue:
+#	HMinit_win .text
+#	HMparse_html $html "HMrender .text"
+# You also need to supply the routine:
+#   proc HMlink_callback {win href} { ...}
+#      win:  The name of the text widget
+#      href  The name of the link
+# which will be called anytime the user "clicks" on a link.
+# The supplied version just prints the link to stdout.
+# In addition, if you wish to use embedded images, you will need to write
+#   proc HMset_image {handle src}
+#      handle  an arbitrary handle (not really)
+#      src     The name of the image
+# Which calls
+#	HMgot_image $handle $image
+# with the TK image.
+#
+# To return a "used" text widget to its initialized state, call:
+#   HMreset_win .text
+# See "sample.tcl" for sample usage
+##################################################################
+############################################
+# mapping of html tags to text tag properties
+# properties beginning with "T" map directly to text tags
+
+# These are Defined in HTML 2.0
+
+array set HMtag_map {
+	b      {weight bold}
+	blockquote	{style i indent 1 Trindent rindent}
+	bq		{style i indent 1 Trindent rindent}
+	cite   {style i}
+	code   {family courier}
+	dfn    {style i}	
+	dir    {indent 1}
+	dl     {indent 1}
+	em     {style i}
+	h1     {size 24 weight bold}
+	h2     {size 22}		
+	h3     {size 20}	
+	h4     {size 18}
+	h5     {size 16}
+	h6     {style i}
+	i      {style i}
+	kbd    {family courier weight bold}
+	menu     {indent 1}
+	ol     {indent 1}
+	pre    {fill 0 family courier Tnowrap nowrap}
+	samp   {family courier}		
+	strong {weight bold}		
+	tt     {family courier}
+	u	 {Tunderline underline}
+	ul     {indent 1}
+	var    {style i}	
+}
+
+# These are in common(?) use, but not defined in html2.0
+
+array set HMtag_map {
+	center {Tcenter center}
+	strike {Tstrike strike}
+	u	   {Tunderline underline}
+}
+
+# initial values
+
+set HMtag_map(hmstart) {
+	family times   weight medium   style r   size 14
+	Tcenter ""   Tlink ""   Tnowrap ""   Tunderline ""   list list
+	fill 1   indent "" counter 0 adjust 0
+}
+
+# html tags that insert white space
+
+array set HMinsert_map {
+	blockquote "\n\n" /blockquote "\n"
+	br	"\n"
+	dd	"\n" /dd	"\n"
+	dl	"\n" /dl	"\n"
+	dt	"\n"
+	form "\n"	/form "\n"
+	h1	"\n\n"	/h1	"\n"
+	h2	"\n\n"	/h2	"\n"
+	h3	"\n\n"	/h3	"\n"
+	h4	"\n"	/h4	"\n"
+	h5	"\n"	/h5	"\n"
+	h6	"\n"	/h6	"\n"
+	li   "\n"
+	/dir "\n"
+	/ul "\n"
+	/ol "\n"
+	/menu "\n"
+	p	"\n\n"
+	pre "\n"	/pre "\n"
+}
+
+# tags that are list elements, that support "compact" rendering
+
+array set HMlist_elements {
+	ol 1   ul 1   menu 1   dl 1   dir 1
+}
+############################################
+# initialize the window and stack state
+
+proc HMinit_win {win} {
+	upvar #0 HM$win var
+	
+	HMinit_state $win
+	$win tag configure underline -underline 1
+	$win tag configure center -justify center
+	$win tag configure nowrap -wrap none
+	$win tag configure rindent -rmargin $var(S_tab)c
+	$win tag configure strike -overstrike 1
+	$win tag configure mark -foreground red		;# list markers
+	$win tag configure list -spacing1 3p -spacing3 3p		;# regular lists
+	$win tag configure compact -spacing1 0p		;# compact lists
+	$win tag configure link -borderwidth 2 -foreground blue	;# hypertext links
+	HMset_indent $win $var(S_tab)
+	$win configure -wrap word
+
+	# configure the text insertion point
+	$win mark set $var(S_insert) 1.0
+
+	# for horizontal rules
+	$win tag configure thin -font [HMx_font times 2 medium r]
+	$win tag configure hr -relief sunken -borderwidth 2 -wrap none \
+		-tabs [winfo width $win]
+	bind $win <Configure> {
+		%W tag configure hr -tabs %w
+		%W tag configure last -spacing3 %h
+	}
+
+	# generic link enter callback
+
+	$win tag bind link <1> "HMlink_hit $win %x %y"
+}
+
+# set the indent spacing (in cm) for lists
+# TK uses a "weird" tabbing model that causes \t to insert a single
+# space if the current line position is past the tab setting
+
+proc HMset_indent {win cm} {
+	set tabs [expr $cm / 2.0]
+	$win configure -tabs ${tabs}c
+	foreach i {1 2 3 4 5 6 7 8 9} {
+		set tab [expr $i * $cm]
+		$win tag configure indent$i -lmargin1 ${tab}c -lmargin2 ${tab}c \
+			-tabs "[expr $tab + $tabs]c [expr $tab + 2*$tabs]c"
+	}
+}
+
+# reset the state of window - get ready for the next page
+# remove all but the font tags, and remove all form state
+
+proc HMreset_win {win} {
+	upvar #0 HM$win var
+	regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags
+	catch "$win tag delete $tags"
+	eval $win mark unset [$win mark names]
+	$win delete 0.0 end
+	$win tag configure hr -tabs [winfo width $win]
+
+	# configure the text insertion point
+	$win mark set $var(S_insert) 1.0
+
+	# remove form state.  If any check/radio buttons still exists, 
+	# their variables will be magically re-created, and never get
+	# cleaned up.
+	catch unset [info globals HM$win.form*]
+
+	HMinit_state $win
+	return HM$win
+}
+
+# initialize the window's state array
+# Parameters beginning with S_ are NOT reset
+#  adjust_size:		global font size adjuster
+#  unknown:		character to use for unknown entities
+#  tab:			tab stop (in cm)
+#  stop:		enabled to stop processing
+#  update:		how many tags between update calls
+#  tags:		number of tags processed so far
+#  symbols:		Symbols to use on un-ordered lists
+
+proc HMinit_state {win} {
+	upvar #0 HM$win var
+	array set tmp [array get var S_*]
+	catch {unset var}
+	array set var {
+		stop 0
+		tags 0
+		fill 0
+		list list
+		S_adjust_size 0
+		S_tab 1.0
+		S_unknown \xb7
+		S_update 10
+		S_symbols O*=+-o\xd7\xb0>:\xb7
+		S_insert Insert
+	}
+	array set var [array get tmp]
+}
+
+# alter the parameters of the text state
+# this allows an application to over-ride the default settings
+# it is called as: HMset_state -param value -param value ...
+
+array set HMparam_map {
+	-update S_update
+	-tab S_tab
+	-unknown S_unknown
+	-stop S_stop
+	-size S_adjust_size
+	-symbols S_symbols
+    -insert S_insert
+}
+
+proc HMset_state {win args} {
+	upvar #0 HM$win var
+	global HMparam_map
+	set bad 0
+	if {[catch {array set params $args}]} {return 0}
+	foreach i [array names params] {
+		incr bad [catch {set var($HMparam_map($i)) $params($i)}]
+	}
+	return [expr $bad == 0]
+}
+
+############################################
+# manage the display of html
+
+# HMrender gets called for every html tag
+#   win:   The name of the text widget to render into
+#   tag:   The html tag (in arbitrary case)
+#   not:   a "/" or the empty string
+#   param: The un-interpreted parameter list
+#   text:  The plain text until the next html tag
+
+proc HMrender {win tag not param text} {
+	upvar #0 HM$win var
+	if {$var(stop)} return
+	global HMtag_map HMinsert_map HMlist_elements
+	set tag [string tolower $tag]
+	set text [HMmap_esc $text]
+
+	# manage compact rendering of lists
+	if {[info exists HMlist_elements($tag)]} {
+		set list "list [expr {[HMextract_param $param compact] ? "compact" : "list"}]"
+	} else {
+		set list ""
+	}
+
+	# Allow text to be diverted to a different window (for tables)
+	# this is not currently used
+	if {[info exists var(divert)]} {
+		set win $var(divert)
+		upvar #0 HM$win var
+	}
+
+	# adjust (push or pop) tag state
+	catch {HMstack $win $not "$HMtag_map($tag) $list"}
+
+	# insert white space (with current font)
+	# adding white space can get a bit tricky.  This isn't quite right
+	set bad [catch {$win insert $var(S_insert) $HMinsert_map($not$tag) "space $var(font)"}]
+	if {!$bad && [lindex $var(fill) end]} {
+		set text [string trimleft $text]
+	}
+
+	# to fill or not to fill
+	if {[lindex $var(fill) end]} {
+		set text [HMzap_white $text]
+	}
+
+	# generic mark hook
+	catch {HMmark $not$tag $win $param text} err
+
+	# do any special tag processing
+	catch {HMtag_$not$tag $win $param text} msg
+
+
+	# add the text with proper tags
+
+	set tags [HMcurrent_tags $win]
+	$win insert $var(S_insert) $text $tags
+
+	# We need to do an update every so often to insure interactive response.
+	# This can cause us to re-enter the event loop, and cause recursive
+	# invocations of HMrender, so we need to be careful.
+	if {!([incr var(tags)] % $var(S_update))} {
+		update
+	}
+}
+
+# html tags requiring special processing
+# Procs of the form HMtag_<tag> or HMtag_</tag> get called just before
+# the text for this tag is displayed.  These procs are called inside a 
+# "catch" so it is OK to fail.
+#   win:   The name of the text widget to render into
+#   param: The un-interpreted parameter list
+#   text:  A pass-by-reference name of the plain text until the next html tag
+#          Tag commands may change this to affect what text will be inserted
+#          next.
+
+# A pair of pseudo tags are added automatically as the 1st and last html
+# tags in the document.  The default is <HMstart> and </HMstart>.
+# Append enough blank space at the end of the text widget while
+# rendering so HMgoto can place the target near the top of the page,
+# then remove the extra space when done rendering.
+
+proc HMtag_hmstart {win param text} {
+	upvar #0 HM$win var
+	$win mark gravity $var(S_insert) left
+	$win insert end "\n " last
+	$win mark gravity $var(S_insert) right
+}
+
+proc HMtag_/hmstart {win param text} {
+	$win delete last.first end
+}
+
+# put the document title in the window banner, and remove the title text
+# from the document
+
+proc HMtag_title {win param text} {
+	upvar $text data
+	wm title [winfo toplevel $win] $data
+	set data ""
+}
+
+proc HMtag_hr {win param text} {
+	upvar #0 HM$win var
+	$win insert $var(S_insert) "\n" space "\n" thin "\t" "thin hr" "\n" thin
+}
+
+# list element tags
+
+proc HMtag_ol {win param text} {
+	upvar #0 HM$win var
+	set var(count$var(level)) 0
+}
+
+proc HMtag_ul {win param text} {
+	upvar #0 HM$win var
+	catch {unset var(count$var(level))}
+}
+
+proc HMtag_menu {win param text} {
+	upvar #0 HM$win var
+	set var(menu) ->
+	set var(compact) 1
+}
+
+proc HMtag_/menu {win param text} {
+	upvar #0 HM$win var
+	catch {unset var(menu)}
+	catch {unset var(compact)}
+}
+	
+proc HMtag_dt {win param text} {
+	upvar #0 HM$win var
+	upvar $text data
+	set level $var(level)
+	incr level -1
+	$win insert $var(S_insert) "$data" \
+		"hi [lindex $var(list) end] indent$level $var(font)"
+	set data {}
+}
+
+proc HMtag_li {win param text} {
+	upvar #0 HM$win var
+	set level $var(level)
+	incr level -1
+	set x [string index $var(S_symbols)+-+-+-+-" $level]
+	catch {set x [incr var(count$level)]}
+	catch {set x $var(menu)}
+	$win insert $var(S_insert) \t$x\t "mark [lindex $var(list) end] indent$level $var(font)"
+}
+
+# Manage hypertext "anchor" links.  A link can be either a source (href)
+# a destination (name) or both.  If its a source, register it via a callback,
+# and set its default behavior.  If its a destination, check to see if we need
+# to go there now, as a result of a previous HMgoto request.  If so, schedule
+# it to happen with the closing </a> tag, so we can highlight the text up to
+# the </a>.
+
+proc HMtag_a {win param text} {
+	upvar #0 HM$win var
+
+	# a source
+
+	if {[HMextract_param $param href]} {
+		set var(Tref) [list L:$href]
+		HMstack $win "" "Tlink link"
+		HMlink_setup $win $href
+	}
+
+	# a destination
+
+	if {[HMextract_param $param name]} {
+		set var(Tname) [list N:$name]
+		HMstack $win "" "Tanchor anchor"
+		$win mark set N:$name "$var(S_insert) - 1 chars"
+		$win mark gravity N:$name left
+		if {[info exists var(goto)] && $var(goto) == $name} {
+			unset var(goto)
+			set var(going) $name
+		}
+	}
+}
+
+# The application should call here with the fragment name
+# to cause the display to go to this spot.
+# If the target exists, go there (and do the callback),
+# otherwise schedule the goto to happen when we see the reference.
+
+proc HMgoto {win where {callback HMwent_to}} {
+	upvar #0 HM$win var
+	if {[regexp N:$where [$win mark names]]} {
+		$win see N:$where
+		update
+		eval $callback $win [list $where]
+		return 1
+	} else {
+		set var(goto) $where
+		return 0
+	}
+}
+
+# We actually got to the spot, so highlight it!
+# This should/could be replaced by the application
+# We'll flash it orange a couple of times.
+
+proc HMwent_to {win where {count 0} {color orange}} {
+	upvar #0 HM$win var
+	if {$count > 5} return
+	catch {$win tag configure N:$where -foreground $color}
+	update
+	after 200 [list HMwent_to $win $where [incr count] \
+				[expr {$color=="orange" ? "" : "orange"}]]
+}
+
+proc HMtag_/a {win param text} {
+	upvar #0 HM$win var
+	if {[info exists var(Tref)]} {
+		unset var(Tref)
+		HMstack $win / "Tlink link"
+	}
+
+	# goto this link, then invoke the call-back.
+
+	if {[info exists var(going)]} {
+		$win yview N:$var(going)
+		update
+		HMwent_to $win $var(going)
+		unset var(going)
+	}
+
+	if {[info exists var(Tname)]} {
+		unset var(Tname)
+		HMstack $win / "Tanchor anchor"
+	}
+}
+
+#           Inline Images
+# This interface is subject to change
+# Most of the work is getting around a limitation of TK that prevents
+# setting the size of a label to a widthxheight in pixels
+#
+# Images have the following parameters:
+#    align:  top,middle,bottom
+#    alt:    alternate text
+#    ismap:  A clickable image map
+#    src:    The URL link
+# Netscape supports (and so do we)
+#    width:  A width hint (in pixels)
+#    height:  A height hint (in pixels)
+#    border: The size of the window border
+
+proc HMtag_img {win param text} {
+	upvar #0 HM$win var
+
+	# get alignment
+	array set align_map {top top    middle center    bottom bottom}
+	set align bottom		;# The spec isn't clear what the default should be
+	HMextract_param $param align
+	catch {set align $align_map([string tolower $align])}
+
+	# get alternate text
+	set alt "<image>"
+	HMextract_param $param alt
+	set alt [HMmap_esc $alt]
+
+	# get the border width
+	set border 1
+	HMextract_param $param border
+
+	# see if we have an image size hint
+	# If so, make a frame the "hint" size to put the label in
+	# otherwise just make the label
+	set item $win.$var(tags)
+	# catch {destroy $item}
+	if {[HMextract_param $param width] && [HMextract_param $param height]} {
+		frame $item -width $width -height $height
+		pack propagate $item 0
+		set label $item.label
+		label $label
+		pack $label -expand 1 -fill both
+	} else {
+		set label $item
+		label $label 
+	}
+
+	$label configure -relief ridge -fg orange -text $alt
+	catch {$label configure -bd $border}
+	$win window create $var(S_insert) -align $align -window $item -pady 2 -padx 2
+
+	# add in all the current tags (this is overkill)
+	set tags [HMcurrent_tags $win]
+	foreach tag $tags {
+		$win tag add $tag $item
+	}
+
+	# set imagemap callbacks
+	if {[HMextract_param $param ismap]} {
+		# regsub -all {[^L]*L:([^ ]*).*}  $tags {\1} link
+		set link [lindex $tags [lsearch -glob $tags L:*]]
+		regsub L: $link {} link
+		global HMevents
+		regsub -all {%} $link {%%} link2
+		foreach i [array names HMevents] {
+			bind $label <$i> "catch \{%W configure $HMevents($i)\}"
+		}
+		bind $label <1> "+HMlink_callback $win $link2?%x,%y"
+	} 
+
+	# now callback to the application
+	set src ""
+	HMextract_param $param src
+	HMset_image $win $label $src
+	return $label	;# used by the forms package for input_image types
+}
+
+# The app needs to supply one of these
+proc HMset_image {win handle src} {
+	HMgot_image $handle "can't get\n$src"
+}
+
+# When the image is available, the application should call back here.
+# If we have the image, put it in the label, otherwise display the error
+# message.  If we don't get a callback, the "alt" text remains.
+# if we have a clickable image, arrange for a callback
+
+proc HMgot_image {win image_error} {
+	# if we're in a frame turn on geometry propogation
+	if {[winfo name $win] == "label"} {
+		pack propagate [winfo parent $win] 1
+	}
+	if {[catch {$win configure -image $image_error}]} {
+		$win configure -image {}
+		$win configure -text $image_error
+	}
+}
+
+# Sample hypertext link callback routine - should be replaced by app
+# This proc is called once for each <A> tag.
+# Applications can overwrite this procedure, as required, or
+# replace the HMevents array
+#   win:   The name of the text widget to render into
+#   href:  The HREF link for this <a> tag.
+
+array set HMevents {
+	Enter	{-borderwidth 2 -relief raised }
+	Leave	{-borderwidth 2 -relief flat }
+	1		{-borderwidth 2 -relief sunken}
+	ButtonRelease-1	{-borderwidth 2 -relief raised}
+}
+
+# We need to escape any %'s in the href tag name so the bind command
+# doesn't try to substitute them.
+
+proc HMlink_setup {win href} {
+	global HMevents
+	regsub -all {%} $href {%%} href2
+	foreach i [array names HMevents] {
+		eval {$win tag bind  L:$href <$i>} \
+			\{$win tag configure \{L:$href2\} $HMevents($i)\}
+	}
+}
+
+# generic link-hit callback
+# This gets called upon button hits on hypertext links
+# Applications are expected to supply ther own HMlink_callback routine
+#   win:   The name of the text widget to render into
+#   x,y:   The cursor position at the "click"
+
+proc HMlink_hit {win x y} {
+	set tags [$win tag names @$x,$y]
+	set link [lindex $tags [lsearch -glob $tags L:*]]
+	# regsub -all {[^L]*L:([^ ]*).*}  $tags {\1} link
+	regsub L: $link {} link
+	HMlink_callback $win $link
+}
+
+# replace this!
+#   win:   The name of the text widget to render into
+#   href:  The HREF link for this <a> tag.
+
+proc HMlink_callback {win href} {
+	puts "Got hit on $win, link $href"
+}
+
+# extract a value from parameter list (this needs a re-do)
+# returns "1" if the keyword is found, "0" otherwise
+#   param:  A parameter list.  It should alredy have been processed to
+#           remove any entity references
+#   key:    The parameter name
+#   val:    The variable to put the value into (use key as default)
+
+proc HMextract_param {param key {val ""}} {
+
+	if {$val == ""} {
+		upvar $key result
+	} else {
+		upvar $val result
+	}
+    set ws "    \n\r"
+ 
+    # look for name=value combinations.  Either (') or (") are valid delimeters
+    if {
+      [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] ||
+      [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] ||
+      [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } {
+        set result $value
+        return 1
+    }
+
+	# now look for valueless names
+	# I should strip out name=value pairs, so we don't end up with "name"
+	# inside the "value" part of some other key word - some day
+	
+	set bad \[^a-zA-Z\]+
+	if {[regexp -nocase  "$bad$key$bad" -$param-]} {
+		return 1
+	} else {
+		return 0
+	}
+}
+
+# These next two routines manage the display state of the page.
+
+# Push or pop tags to/from stack.
+# Each orthogonal text property has its own stack, stored as a list.
+# The current (most recent) tag is the last item on the list.
+# Push is {} for pushing and {/} for popping
+
+proc HMstack {win push list} {
+	upvar #0 HM$win var
+	array set tags $list
+	if {$push == ""} {
+		foreach tag [array names tags] {
+			lappend var($tag) $tags($tag)
+		}
+	} else {
+		foreach tag [array names tags] {
+			# set cnt [regsub { *[^ ]+$} $var($tag) {} var($tag)]
+			set var($tag) [lreplace $var($tag) end end]
+		}
+	}
+}
+
+# extract set of current text tags
+# tags starting with T map directly to text tags, all others are
+# handled specially.  There is an application callback, HMset_font
+# to allow the application to do font error handling
+
+proc HMcurrent_tags {win} {
+	upvar #0 HM$win var
+	set font font
+	foreach i {family size weight style} {
+		set $i [lindex $var($i) end]
+		append font :[set $i]
+	}
+	set xfont [HMx_font $family $size $weight $style $var(S_adjust_size)]
+	HMset_font $win $font $xfont
+	set indent [llength $var(indent)]
+	incr indent -1
+	lappend tags $font indent$indent
+	foreach tag [array names var T*] {
+		lappend tags [lindex $var($tag) end]	;# test
+	}
+	set var(font) $font
+	set var(xfont) [$win tag cget $font -font]
+	set var(level) $indent
+	return $tags
+}
+
+# allow the application to do do better font management
+# by overriding this procedure
+
+proc HMset_font {win tag font} {
+	catch {$win tag configure $tag -font $font} msg
+}
+
+# generate an X font name
+proc HMx_font {family size weight style {adjust_size 0}} {
+	catch {incr size $adjust_size}
+	return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*"
+}
+
+# Optimize HMrender (hee hee)
+# This is experimental
+
+proc HMoptimize {} {
+	regsub -all "\n\[ 	\]*#\[^\n\]*" [info body HMrender] {} body
+	regsub -all ";\[ 	\]*#\[^\n]*" $body {} body
+	regsub -all "\n\n+" $body \n body
+	proc HMrender {win tag not param text} $body
+}
+############################################
+# Turn HTML into TCL commands
+#   html    A string containing an html document
+#   cmd		A command to run for each html tag found
+#   start	The name of the dummy html start/stop tags
+
+proc HMparse_html {html {cmd HMtest_parse} {start hmstart}} {
+	regsub -all \{ $html {\&ob;} html
+	regsub -all \} $html {\&cb;} html
+	set w " \t\r\n"	;# white space
+	proc HMcl x {return "\[$x\]"}
+	set exp <(/?)([HMcl ^$w>]+)[HMcl $w]*([HMcl ^>]*)>
+	set sub "\}\n$cmd {\\2} {\\1} {\\3} \{"
+	regsub -all $exp $html $sub html
+	eval "$cmd {$start} {} {} \{ $html \}"
+	eval "$cmd {$start} / {} {}"
+}
+
+proc HMtest_parse {command tag slash text_after_tag} {
+	puts "==> $command $tag $slash $text_after_tag"
+}
+
+# Convert multiple white space into a single space
+
+proc HMzap_white {data} {
+	regsub -all "\[ \t\r\n\]+" $data " " data
+	return $data
+}
+
+# find HTML escape characters of the form &xxx;
+
+proc HMmap_esc {text} {
+	if {![regexp & $text]} {return $text}
+	regsub -all {([][$\\])} $text {\\\1} new
+	regsub -all {&#([0-9][0-9]?[0-9]?);?} \
+		$new {[format %c [scan \1 %d tmp;set tmp]]} new
+	regsub -all {&([a-zA-Z]+);?} $new {[HMdo_map \1]} new
+	return [subst $new]
+}
+
+# convert an HTML escape sequence into character
+
+proc HMdo_map {text {unknown ?}} {
+	global HMesc_map
+	set result $unknown
+	catch {set result $HMesc_map($text)}
+	return $result
+}
+
+# table of escape characters (ISO latin-1 esc's are in a different table)
+
+array set HMesc_map {
+   lt <   gt >   amp &   quot \"   copy \xa9
+   reg \xae   ob \x7b   cb \x7d   nbsp \xa0
+}
+#############################################################
+# ISO Latin-1 escape codes
+
+array set HMesc_map {
+	nbsp \xa0 iexcl \xa1 cent \xa2 pound \xa3 curren \xa4
+	yen \xa5 brvbar \xa6 sect \xa7 uml \xa8 copy \xa9
+	ordf \xaa laquo \xab not \xac shy \xad reg \xae
+	hibar \xaf deg \xb0 plusmn \xb1 sup2 \xb2 sup3 \xb3
+	acute \xb4 micro \xb5 para \xb6 middot \xb7 cedil \xb8
+	sup1 \xb9 ordm \xba raquo \xbb frac14 \xbc frac12 \xbd
+	frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc \xc2
+	Atilde \xc3 Auml \xc4 Aring \xc5 AElig \xc6 Ccedil \xc7
+	Egrave \xc8 Eacute \xc9 Ecirc \xca Euml \xcb Igrave \xcc
+	Iacute \xcd Icirc \xce Iuml \xcf ETH \xd0 Ntilde \xd1
+	Ograve \xd2 Oacute \xd3 Ocirc \xd4 Otilde \xd5 Ouml \xd6
+	times \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc \xdb
+	Uuml \xdc Yacute \xdd THORN \xde szlig \xdf agrave \xe0
+	aacute \xe1 acirc \xe2 atilde \xe3 auml \xe4 aring \xe5
+	aelig \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc \xea
+	euml \xeb igrave \xec iacute \xed icirc \xee iuml \xef
+	eth \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc \xf4
+	otilde \xf5 ouml \xf6 divide \xf7 oslash \xf8 ugrave \xf9
+	uacute \xfa ucirc \xfb uuml \xfc yacute \xfd thorn \xfe
+	yuml \xff
+}
+
+##########################################################
+# html forms management commands
+
+# As each form element is located, it is created and rendered.  Additional
+# state is stored in a form specific global variable to be processed at
+# the end of the form, including the "reset" and "submit" options.
+# Remember, there can be multiple forms existing on multiple pages.  When
+# HTML tables are added, a single form could be spread out over multiple
+# text widgets, which makes it impractical to hang the form state off the
+# HM$win structure.  We don't need to check for the existance of required
+# parameters, we just "fail" and get caught in HMrender
+
+# This causes line breaks to be preserved in the inital values
+# of text areas
+array set HMtag_map {
+	textarea    {fill 0}
+}
+
+##########################################################
+# html isindex tag.  Although not strictly forms, they're close enough
+# to be in this file
+
+# is-index forms
+# make a frame with a label, entry, and submit button
+
+proc HMtag_isindex {win param text} {
+	upvar #0 HM$win var
+
+	set item $win.$var(tags)
+	if {[winfo exists $item]} {
+		destroy $item
+	}
+	frame $item -relief ridge -bd 3
+	set prompt "Enter search keywords here"
+	HMextract_param $param prompt
+	label $item.label -text [HMmap_esc $prompt] -font $var(xfont)
+	entry $item.entry
+	bind $item.entry <Return> "$item.submit invoke"
+	button $item.submit -text search -font $var(xfont) -command \
+		[format {HMsubmit_index %s {%s} [HMmap_reply [%s get]]} \
+		$win $param $item.entry]
+	pack $item.label -side top
+	pack $item.entry $item.submit -side left
+
+	# insert window into text widget
+
+	$win insert $var(S_insert) \n isindex
+	HMwin_install $win $item
+	$win insert $var(S_insert) \n isindex
+	bind $item <Visibility> {focus %W.entry}
+}
+
+# This is called when the isindex form is submitted.
+# The default version calls HMlink_callback.  Isindex tags should either
+# be deprecated, or fully supported (e.g. they need an href parameter)
+
+proc HMsubmit_index {win param text} {
+	HMlink_callback $win ?$text
+}
+
+# initialize form state.  All of the state for this form is kept
+# in a global array whose name is stored in the form_id field of
+# the main window array.
+# Parameters: ACTION, METHOD, ENCTYPE
+
+proc HMtag_form {win param text} {
+	upvar #0 HM$win var
+
+	# create a global array for the form
+	set id HM$win.form$var(tags)
+	upvar #0 $id form
+
+	# missing /form tag, simulate it
+	if {[info exists var(form_id)]} {
+		puts "Missing end-form tag !!!! $var(form_id)"
+		HMtag_/form $win {} {}
+	}
+	catch {unset form}
+	set var(form_id) $id
+
+	set form(param) $param		;# form initial parameter list
+	set form(reset) ""			;# command to reset the form
+	set form(reset_button) ""	;# list of all reset buttons
+	set form(submit) ""			;# command to submit the form
+	set form(submit_button) ""	;# list of all submit buttons
+}
+
+# Where we're done try to get all of the state into the widgets so
+# we can free up the form structure here.  Unfortunately, we can't!
+
+proc HMtag_/form {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	# make submit button entries for all radio buttons
+	foreach name [array names form radio_*] {
+		regsub radio_ $name {} name
+		lappend form(submit) [list $name \$form(radio_$name)]
+	}
+
+	# process the reset button(s)
+
+	foreach item $form(reset_button) {
+		$item configure -command $form(reset)
+	}
+
+	# no submit button - add one
+	if {$form(submit_button) == ""} {
+		HMinput_submit $win {}
+	}
+
+	# process the "submit" command(s)
+	# each submit button could have its own name,value pair
+
+	foreach item $form(submit_button) {
+		set submit $form(submit)
+		catch {lappend submit $form(submit_$item)}
+		$item configure -command  \
+				[list HMsubmit_button $win $var(form_id) $form(param) \
+				$submit]
+	}
+
+	# unset all unused fields here
+	unset form(reset) form(submit) form(reset_button) form(submit_button)
+	unset var(form_id)
+}
+
+###################################################################
+# handle form input items
+# each item type is handled in a separate procedure
+# Each "type" procedure needs to:
+# - create the window
+# - initialize it
+# - add the "submit" and "reset" commands onto the proper Q's
+#   "submit" is subst'd
+#   "reset" is eval'd
+
+proc HMtag_input {win param text} {
+	upvar #0 HM$win var
+
+	set type text	;# the default
+	HMextract_param $param type
+	set type [string tolower $type]
+	if {[catch {HMinput_$type $win $param} err]} {
+		puts stderr $err
+	}
+}
+
+# input type=text
+# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE
+
+proc HMinput_text {win param {show {}}} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	# make the entry
+	HMextract_param $param name		;# required
+	set item $win.input_text,$var(tags)
+	set size 20; HMextract_param $param size
+	set maxlength 0; HMextract_param $param maxlength
+	entry $item -width $size -show $show
+
+	# set the initial value
+	set value ""; HMextract_param $param value
+	$item insert 0 $value
+		
+	# insert the entry
+	HMwin_install $win $item
+
+	# set the "reset" and "submit" commands
+	append form(reset) ";$item delete 0 end;$item insert 0 [list $value]"
+	lappend form(submit) [list $name "\[$item get]"]
+
+	# handle the maximum length (broken - no way to cleanup bindtags state)
+	if {$maxlength} {
+		bindtags $item "[bindtags $item] max$maxlength"
+		bind max$maxlength <KeyPress> "%W delete $maxlength end"
+	}
+}
+
+# password fields - same as text, only don't show data
+# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE
+
+proc HMinput_password {win param} {
+	HMinput_text $win $param *
+}
+
+# checkbuttons are missing a "get" option, so we must use a global
+# variable to store the value.
+# Parameters NAME, VALUE, (reqd), CHECKED
+
+proc HMinput_checkbox {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	HMextract_param $param name
+	HMextract_param $param value
+
+	# Set the global variable, don't use the "form" alias as it is not
+	# defined in the global scope of the button
+	set variable $var(form_id)(check_$var(tags))	
+	set item $win.input_checkbutton,$var(tags)
+	checkbutton $item -variable $variable -off {} -on $value -text "  "
+	if {[HMextract_param $param checked]} {
+		$item select
+		append form(reset) ";$item select"
+	} else {
+		append form(reset) ";$item deselect"
+	}
+
+	HMwin_install $win $item
+	lappend form(submit) [list $name \$form(check_$var(tags))]
+}
+
+# radio buttons.  These are like check buttons, but only one can be selected
+
+proc HMinput_radio {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	HMextract_param $param name
+	HMextract_param $param value
+
+	set first [expr ![info exists form(radio_$name)]]
+	set variable $var(form_id)(radio_$name)
+	set variable $var(form_id)(radio_$name)
+	set item $win.input_radiobutton,$var(tags)
+	radiobutton $item -variable $variable -value $value -text " "
+
+	HMwin_install $win $item
+
+	if {$first || [HMextract_param $param checked]} {
+		$item select
+		append form(reset) ";$item select"
+	} else {
+		append form(reset) ";$item deselect"
+	}
+
+	# do the "submit" actions in /form so we only end up with 1 per button grouping
+	# contributing to the submission
+}
+
+# hidden fields, just append to the "submit" data
+# params: NAME, VALUE (reqd)
+
+proc HMinput_hidden {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	HMextract_param $param name
+	HMextract_param $param value
+	lappend form(submit) [list $name $value]
+}
+
+# handle input images.  The spec isn't very clear on these, so I'm not
+# sure its quite right
+# Use std image tag, only set up our own callbacks
+#  (e.g. make sure ismap isn't set)
+# params: NAME, SRC (reqd) ALIGN
+
+proc HMinput_image {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	HMextract_param $param name
+	set name		;# barf if no name is specified
+	set item [HMtag_img $win $param {}]
+	$item configure -relief raised -bd 2 -bg blue
+
+	# make a dummy "submit" button, and invoke it to send the form.
+	# We have to get the %x,%y in the value somehow, so calculate it during
+	# binding, and save it in the form array for later processing
+
+	set submit $win.dummy_submit,$var(tags)
+	if {[winfo exists $submit]} {
+		destroy $submit
+	}
+	button $submit	-takefocus 0;# this never gets mapped!
+	lappend form(submit_button) $submit
+	set form(submit_$submit) [list $name $name.\$form(X).\$form(Y)]
+	
+	$item configure -takefocus 1
+	bind $item <FocusIn> "catch \{$win see $item\}"
+	bind $item <1> "$item configure -relief sunken"
+	bind $item <Return> "
+		set $var(form_id)(X) 0
+		set $var(form_id)(Y) 0
+		$submit invoke	
+	"
+	bind $item <ButtonRelease-1> "
+		set $var(form_id)(X) %x
+		set $var(form_id)(Y) %y
+		$item configure -relief raised
+		$submit invoke	
+	"
+}
+
+# Set up the reset button.  Wait for the /form to attach
+# the -command option.  There could be more that 1 reset button
+# params VALUE
+
+proc HMinput_reset {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	set value reset
+	HMextract_param $param value
+
+	set item $win.input_reset,$var(tags)
+	button $item -text [HMmap_esc $value]
+	HMwin_install $win $item
+	lappend form(reset_button) $item
+}
+
+# Set up the submit button.  Wait for the /form to attach
+# the -command option.  There could be more that 1 submit button
+# params: NAME, VALUE
+
+proc HMinput_submit {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	HMextract_param $param name
+	set value submit
+	HMextract_param $param value
+	set item $win.input_submit,$var(tags)
+	button $item -text [HMmap_esc $value] -fg blue
+	HMwin_install $win $item
+	lappend form(submit_button) $item
+	# need to tie the "name=value" to this button
+	# save the pair and do it when we finish the submit button
+	catch {set form(submit_$item) [list $name $value]}
+}
+
+#########################################################################
+# selection items
+# They all go into a list box.  We don't what to do with the listbox until
+# we know how many items end up in it.  Gather up the data for the "options"
+# and finish up in the /select tag
+# params: NAME (reqd), MULTIPLE, SIZE 
+
+proc HMtag_select {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	HMextract_param $param name
+	set size 5;  HMextract_param $param size
+	set form(select_size) $size
+	set form(select_name) $name
+	set form(select_values) ""		;# list of values to submit
+	if {[HMextract_param $param multiple]} {
+		set mode multiple
+	} else {
+		set mode single
+	}
+	set item $win.select,$var(tags)
+    frame $item
+    set form(select_frame) $item
+	listbox $item.list -selectmode $mode -width 0 -exportselection 0
+	HMwin_install $win $item
+}
+
+# select options
+# The values returned in the query may be different from those
+# displayed in the listbox, so we need to keep a separate list of
+# query values.
+#  form(select_default) - contains the default query value
+#  form(select_frame) - name of the listbox's containing frame
+#  form(select_values)  - list of query values
+# params: VALUE, SELECTED
+
+proc HMtag_option {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	upvar $text data
+	set frame $form(select_frame)
+
+	# set default option (or options)
+	if {[HMextract_param $param selected]} {
+        lappend form(select_default) [$form(select_frame).list size]
+    }
+    set value [string trimright $data " \n"]
+    $frame.list insert end $value
+	HMextract_param $param value
+	lappend form(select_values) $value
+	set data ""
+}
+ 
+# do most of the work here!
+# if SIZE>1, make the listbox.  Otherwise make a "drop-down"
+# listbox with a label in it
+# If the # of items > size, add a scroll bar
+# This should probably be broken up into callbacks to make it
+# easier to override the "look".
+
+proc HMtag_/select {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	set frame $form(select_frame)
+	set size $form(select_size)
+	set items [$frame.list size]
+
+	# set the defaults and reset button
+	append form(reset) ";$frame.list selection clear 0  $items"
+	if {[info exists form(select_default)]} {
+		foreach i $form(select_default) {
+			$frame.list selection set $i
+			append form(reset) ";$frame.list selection set $i"
+		}
+	} else {
+		$frame.list selection set 0
+		append form(reset) ";$frame.list selection set 0"
+	}
+
+	# set up the submit button. This is the general case.  For single
+	# selections we could be smarter
+
+	for {set i 0} {$i < $size} {incr i} {
+		set value [format {[expr {[%s selection includes %s] ? {%s} : {}}]} \
+				$frame.list $i [lindex $form(select_values) $i]]
+		lappend form(submit) [list $form(select_name) $value]
+	}
+	
+	# show the listbox - no scroll bar
+
+	if {$size > 1 && $items <= $size} {
+		$frame.list configure -height $items
+		pack $frame.list
+
+	# Listbox with scrollbar
+
+	} elseif {$size > 1} {
+		scrollbar $frame.scroll -command "$frame.list yview"  \
+				-orient v -takefocus 0
+		$frame.list configure -height $size \
+			-yscrollcommand "$frame.scroll set"
+		pack $frame.list $frame.scroll -side right -fill y
+
+	# This is a joke!
+
+	} else {
+		scrollbar $frame.scroll -command "$frame.list yview"  \
+			-orient h -takefocus 0
+		$frame.list configure -height 1 \
+			-yscrollcommand "$frame.scroll set"
+		pack $frame.list $frame.scroll -side top -fill x
+	}
+
+	# cleanup
+
+	foreach i [array names form select_*] {
+		unset form($i)
+	}
+}
+
+# do a text area (multi-line text)
+# params: COLS, NAME, ROWS (all reqd, but default rows and cols anyway)
+
+proc HMtag_textarea {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	upvar $text data
+
+	set rows 5; HMextract_param $param rows
+	set cols 30; HMextract_param $param cols
+	HMextract_param $param name
+	set item $win.textarea,$var(tags)
+	frame $item
+	text $item.text -width $cols -height $rows -wrap none \
+			-yscrollcommand "$item.scroll set" -padx 3 -pady 3
+	scrollbar $item.scroll -command "$item.text yview"  -orient v
+	$item.text insert 1.0 $data
+	HMwin_install $win $item
+	pack $item.text $item.scroll -side right -fill y
+	lappend form(submit) [list $name "\[$item.text get 0.0 end]"]
+	append form(reset) ";$item.text delete 1.0 end; \
+			$item.text insert 1.0 [list $data]"
+	set data ""
+}
+
+# procedure to install windows into the text widget
+# - win:  name of the text widget
+# - item: name of widget to install
+
+proc HMwin_install {win item} {
+	upvar #0 HM$win var
+	$win window create $var(S_insert) -window $item -align bottom
+	$win tag add indent$var(level) $item
+	set focus [expr {[winfo class $item] != "Frame"}]
+	$item configure -takefocus $focus
+	bind $item <FocusIn> "$win see $item"
+}
+
+#####################################################################
+# Assemble and submit the query
+# each list element in "stuff" is a name/value pair
+# - The names are the NAME parameters of the various fields
+# - The values get run through "subst" to extract the values
+# - We do the user callback with the list of name value pairs
+
+proc HMsubmit_button {win form_id param stuff} {
+	upvar #0 HM$win var
+	upvar #0 $form_id form
+	set query ""
+	foreach pair $stuff {
+		set value [subst [lindex $pair 1]]
+		if {$value != ""} {
+			set item [lindex $pair 0]
+			lappend query $item $value
+		}
+	}
+	# this is the user callback.
+	HMsubmit_form $win $param $query
+}
+
+# sample user callback for form submission
+# should be replaced by the application
+# Sample version generates a string suitable for http
+
+proc HMsubmit_form {win param query} {
+	set result ""
+	set sep ""
+	foreach i $query {
+		append result  $sep [HMmap_reply $i]
+		if {$sep != "="} {set sep =} {set sep &}
+	}
+	puts $result
+}
+
+# do x-www-urlencoded character mapping
+# The spec says: "non-alphanumeric characters are replaced by '%HH'"
+ 
+set HMalphanumeric	a-zA-Z0-9	;# definition of alphanumeric character class
+for {set i 1} {$i <= 256} {incr i} {
+    set c [format %c $i]
+    if {![string match \[$HMalphanumeric\] $c]} {
+        set HMform_map($c) %[format %.2x $i]
+    }
+}
+
+# These are handled specially
+array set HMform_map {
+    " " +   \n %0d%0a
+}
+
+# 1 leave alphanumerics characters alone
+# 2 Convert every other character to an array lookup
+# 3 Escape constructs that are "special" to the tcl parser
+# 4 "subst" the result, doing all the array substitutions
+ 
+proc HMmap_reply {string} {
+    global HMform_map HMalphanumeric
+    regsub -all \[^$HMalphanumeric\] $string {$HMform_map(&)} string
+    regsub -all \n $string {\\n} string
+    regsub -all \t $string {\\t} string
+    regsub -all {[][{})\\]\)} $string {\\&} string
+    return [subst $string]
+}
+
+# convert a x-www-urlencoded string int a a list of name/value pairs
+
+# 1  convert a=b&c=d... to {a} {b} {c} {d}...
+# 2, convert + to  " "
+# 3, convert %xx to char equiv
+
+proc HMcgiDecode {data} {
+	set data [split $data "&="]
+	foreach i $data {
+		lappend result [cgiMap $i]
+	}
+	return $result
+}
+
+proc HMcgiMap {data} {
+	regsub -all {\+} $data " " data
+	
+	if {[regexp % $data]} {
+		regsub -all {([][$\\])} $data {\\\1} data
+		regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data  {[format %c 0x\1]} data
+		return [subst $data]
+	} else {
+		return $data
+	}
+}
+
+# There is a bug in the tcl library focus routines that prevents focus
+# from every reaching an un-viewable window.  Use our *own*
+# version of the library routine, until the bug is fixed, make sure we
+# over-ride the library version, and not the otherway around
+
+auto_load tkFocusOK
+proc tkFocusOK w {
+    set code [catch {$w cget -takefocus} value]
+    if {($code == 0) && ($value != "")} {
+    if {$value == 0} {
+        return 0
+    } elseif {$value == 1} {
+        return 1
+    } else {
+        set value [uplevel #0 $value $w]
+        if {$value != ""} {
+        return $value
+        }
+    }
+    }
+    set code [catch {$w cget -state} value]
+    if {($code == 0) && ($value == "disabled")} {
+    return 0
+    }
+    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
+}

Deleted: grass/trunk/lib/form/html_library_grass.tcl
===================================================================
--- grass/trunk/lib/form/html_library_grass.tcl	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/html_library_grass.tcl	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,1418 +0,0 @@
-# Simple HTML display library by Stephen Uhler (stephen.uhler at sun.com)
-# Copyright (c) 1995 by Sun Microsystems
-# Version 0.3 Fri Sep  1 10:47:17 PDT 1995
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# To use this package,  create a text widget (say, .text)
-# and set a variable full of html, (say $html), and issue:
-#	HMinit_win .text
-#	HMparse_html $html "HMrender .text"
-# You also need to supply the routine:
-#   proc HMlink_callback {win href} { ...}
-#      win:  The name of the text widget
-#      href  The name of the link
-# which will be called anytime the user "clicks" on a link.
-# The supplied version just prints the link to stdout.
-# In addition, if you wish to use embedded images, you will need to write
-#   proc HMset_image {handle src}
-#      handle  an arbitrary handle (not really)
-#      src     The name of the image
-# Which calls
-#	HMgot_image $handle $image
-# with the TK image.
-#
-# To return a "used" text widget to its initialized state, call:
-#   HMreset_win .text
-# See "sample.tcl" for sample usage
-##################################################################
-############################################
-# mapping of html tags to text tag properties
-# properties beginning with "T" map directly to text tags
-
-# These are Defined in HTML 2.0
-
-array set HMtag_map {
-	b      {weight bold}
-	blockquote	{style i indent 1 Trindent rindent}
-	bq		{style i indent 1 Trindent rindent}
-	cite   {style i}
-	code   {family courier}
-	dfn    {style i}	
-	dir    {indent 1}
-	dl     {indent 1}
-	em     {style i}
-	h1     {size 24 weight bold}
-	h2     {size 22}		
-	h3     {size 20}	
-	h4     {size 18}
-	h5     {size 16}
-	h6     {style i}
-	i      {style i}
-	kbd    {family courier weight bold}
-	menu     {indent 1}
-	ol     {indent 1}
-	pre    {fill 0 family courier Tnowrap nowrap}
-	samp   {family courier}		
-	strong {weight bold}		
-	tt     {family courier}
-	u	 {Tunderline underline}
-	ul     {indent 1}
-	var    {style i}	
-}
-
-# These are in common(?) use, but not defined in html2.0
-
-array set HMtag_map {
-	center {Tcenter center}
-	strike {Tstrike strike}
-	u	   {Tunderline underline}
-}
-
-# initial values
-
-set HMtag_map(hmstart) {
-	family times   weight medium   style r   size 14
-	Tcenter ""   Tlink ""   Tnowrap ""   Tunderline ""   list list
-	fill 1   indent "" counter 0 adjust 0
-}
-
-# html tags that insert white space
-
-array set HMinsert_map {
-	blockquote "\n\n" /blockquote "\n"
-	br	"\n"
-	dd	"\n" /dd	"\n"
-	dl	"\n" /dl	"\n"
-	dt	"\n"
-	form "\n"	/form "\n"
-	h1	"\n\n"	/h1	"\n"
-	h2	"\n\n"	/h2	"\n"
-	h3	"\n\n"	/h3	"\n"
-	h4	"\n"	/h4	"\n"
-	h5	"\n"	/h5	"\n"
-	h6	"\n"	/h6	"\n"
-	li   "\n"
-	/dir "\n"
-	/ul "\n"
-	/ol "\n"
-	/menu "\n"
-	p	"\n\n"
-	pre "\n"	/pre "\n"
-}
-
-# tags that are list elements, that support "compact" rendering
-
-array set HMlist_elements {
-	ol 1   ul 1   menu 1   dl 1   dir 1
-}
-############################################
-# initialize the window and stack state
-
-proc HMinit_win {win} {
-	upvar #0 HM$win var
-	
-	HMinit_state $win
-	$win tag configure underline -underline 1
-	$win tag configure center -justify center
-	$win tag configure nowrap -wrap none
-	$win tag configure rindent -rmargin $var(S_tab)c
-	$win tag configure strike -overstrike 1
-	$win tag configure mark -foreground red		;# list markers
-	$win tag configure list -spacing1 3p -spacing3 3p		;# regular lists
-	$win tag configure compact -spacing1 0p		;# compact lists
-	$win tag configure link -borderwidth 2 -foreground blue	;# hypertext links
-	HMset_indent $win $var(S_tab)
-	$win configure -wrap word
-
-	# configure the text insertion point
-	$win mark set $var(S_insert) 1.0
-
-	# for horizontal rules
-	$win tag configure thin -font [HMx_font times 2 medium r]
-	$win tag configure hr -relief sunken -borderwidth 2 -wrap none \
-		-tabs [winfo width $win]
-	bind $win <Configure> {
-		%W tag configure hr -tabs %w
-		%W tag configure last -spacing3 %h
-	}
-
-	# generic link enter callback
-
-	$win tag bind link <1> "HMlink_hit $win %x %y"
-}
-
-# set the indent spacing (in cm) for lists
-# TK uses a "weird" tabbing model that causes \t to insert a single
-# space if the current line position is past the tab setting
-
-proc HMset_indent {win cm} {
-	set tabs [expr $cm / 2.0]
-	$win configure -tabs ${tabs}c
-	foreach i {1 2 3 4 5 6 7 8 9} {
-		set tab [expr $i * $cm]
-		$win tag configure indent$i -lmargin1 ${tab}c -lmargin2 ${tab}c \
-			-tabs "[expr $tab + $tabs]c [expr $tab + 2*$tabs]c"
-	}
-}
-
-# reset the state of window - get ready for the next page
-# remove all but the font tags, and remove all form state
-
-proc HMreset_win {win} {
-	upvar #0 HM$win var
-	regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags
-	catch "$win tag delete $tags"
-	eval $win mark unset [$win mark names]
-	$win delete 0.0 end
-	$win tag configure hr -tabs [winfo width $win]
-
-	# configure the text insertion point
-	$win mark set $var(S_insert) 1.0
-
-	# remove form state.  If any check/radio buttons still exists, 
-	# their variables will be magically re-created, and never get
-	# cleaned up.
-	catch unset [info globals HM$win.form*]
-
-	HMinit_state $win
-	return HM$win
-}
-
-# initialize the window's state array
-# Parameters beginning with S_ are NOT reset
-#  adjust_size:		global font size adjuster
-#  unknown:		character to use for unknown entities
-#  tab:			tab stop (in cm)
-#  stop:		enabled to stop processing
-#  update:		how many tags between update calls
-#  tags:		number of tags processed so far
-#  symbols:		Symbols to use on un-ordered lists
-
-proc HMinit_state {win} {
-	upvar #0 HM$win var
-	array set tmp [array get var S_*]
-	catch {unset var}
-	array set var {
-		stop 0
-		tags 0
-		fill 0
-		list list
-		S_adjust_size 0
-		S_tab 1.0
-		S_unknown \xb7
-		S_update 10
-		S_symbols O*=+-o\xd7\xb0>:\xb7
-		S_insert Insert
-	}
-	array set var [array get tmp]
-}
-
-# alter the parameters of the text state
-# this allows an application to over-ride the default settings
-# it is called as: HMset_state -param value -param value ...
-
-array set HMparam_map {
-	-update S_update
-	-tab S_tab
-	-unknown S_unknown
-	-stop S_stop
-	-size S_adjust_size
-	-symbols S_symbols
-    -insert S_insert
-}
-
-proc HMset_state {win args} {
-	upvar #0 HM$win var
-	global HMparam_map
-	set bad 0
-	if {[catch {array set params $args}]} {return 0}
-	foreach i [array names params] {
-		incr bad [catch {set var($HMparam_map($i)) $params($i)}]
-	}
-	return [expr $bad == 0]
-}
-
-############################################
-# manage the display of html
-
-# HMrender gets called for every html tag
-#   win:   The name of the text widget to render into
-#   tag:   The html tag (in arbitrary case)
-#   not:   a "/" or the empty string
-#   param: The un-interpreted parameter list
-#   text:  The plain text until the next html tag
-
-proc HMrender {win tag not param text} {
-	upvar #0 HM$win var
-	if {$var(stop)} return
-	global HMtag_map HMinsert_map HMlist_elements
-	set tag [string tolower $tag]
-	set text [HMmap_esc $text]
-
-	# manage compact rendering of lists
-	if {[info exists HMlist_elements($tag)]} {
-		set list "list [expr {[HMextract_param $param compact] ? "compact" : "list"}]"
-	} else {
-		set list ""
-	}
-
-	# Allow text to be diverted to a different window (for tables)
-	# this is not currently used
-	if {[info exists var(divert)]} {
-		set win $var(divert)
-		upvar #0 HM$win var
-	}
-
-	# adjust (push or pop) tag state
-	catch {HMstack $win $not "$HMtag_map($tag) $list"}
-
-	# insert white space (with current font)
-	# adding white space can get a bit tricky.  This isn't quite right
-	set bad [catch {$win insert $var(S_insert) $HMinsert_map($not$tag) "space $var(font)"}]
-	if {!$bad && [lindex $var(fill) end]} {
-		set text [string trimleft $text]
-	}
-
-	# to fill or not to fill
-	if {[lindex $var(fill) end]} {
-		set text [HMzap_white $text]
-	}
-
-	# generic mark hook
-	catch {HMmark $not$tag $win $param text} err
-
-	# do any special tag processing
-	catch {HMtag_$not$tag $win $param text} msg
-
-
-	# add the text with proper tags
-
-	set tags [HMcurrent_tags $win]
-	$win insert $var(S_insert) $text $tags
-
-	# We need to do an update every so often to insure interactive response.
-	# This can cause us to re-enter the event loop, and cause recursive
-	# invocations of HMrender, so we need to be careful.
-	if {!([incr var(tags)] % $var(S_update))} {
-		update
-	}
-}
-
-# html tags requiring special processing
-# Procs of the form HMtag_<tag> or HMtag_</tag> get called just before
-# the text for this tag is displayed.  These procs are called inside a 
-# "catch" so it is OK to fail.
-#   win:   The name of the text widget to render into
-#   param: The un-interpreted parameter list
-#   text:  A pass-by-reference name of the plain text until the next html tag
-#          Tag commands may change this to affect what text will be inserted
-#          next.
-
-# A pair of pseudo tags are added automatically as the 1st and last html
-# tags in the document.  The default is <HMstart> and </HMstart>.
-# Append enough blank space at the end of the text widget while
-# rendering so HMgoto can place the target near the top of the page,
-# then remove the extra space when done rendering.
-
-proc HMtag_hmstart {win param text} {
-	upvar #0 HM$win var
-	$win mark gravity $var(S_insert) left
-	$win insert end "\n " last
-	$win mark gravity $var(S_insert) right
-}
-
-proc HMtag_/hmstart {win param text} {
-	$win delete last.first end
-}
-
-# put the document title in the window banner, and remove the title text
-# from the document
-
-proc HMtag_title {win param text} {
-	upvar $text data
-	wm title [winfo toplevel $win] $data
-	set data ""
-}
-
-proc HMtag_hr {win param text} {
-	upvar #0 HM$win var
-	$win insert $var(S_insert) "\n" space "\n" thin "\t" "thin hr" "\n" thin
-}
-
-# list element tags
-
-proc HMtag_ol {win param text} {
-	upvar #0 HM$win var
-	set var(count$var(level)) 0
-}
-
-proc HMtag_ul {win param text} {
-	upvar #0 HM$win var
-	catch {unset var(count$var(level))}
-}
-
-proc HMtag_menu {win param text} {
-	upvar #0 HM$win var
-	set var(menu) ->
-	set var(compact) 1
-}
-
-proc HMtag_/menu {win param text} {
-	upvar #0 HM$win var
-	catch {unset var(menu)}
-	catch {unset var(compact)}
-}
-	
-proc HMtag_dt {win param text} {
-	upvar #0 HM$win var
-	upvar $text data
-	set level $var(level)
-	incr level -1
-	$win insert $var(S_insert) "$data" \
-		"hi [lindex $var(list) end] indent$level $var(font)"
-	set data {}
-}
-
-proc HMtag_li {win param text} {
-	upvar #0 HM$win var
-	set level $var(level)
-	incr level -1
-	set x [string index $var(S_symbols)+-+-+-+-" $level]
-	catch {set x [incr var(count$level)]}
-	catch {set x $var(menu)}
-	$win insert $var(S_insert) \t$x\t "mark [lindex $var(list) end] indent$level $var(font)"
-}
-
-# Manage hypertext "anchor" links.  A link can be either a source (href)
-# a destination (name) or both.  If its a source, register it via a callback,
-# and set its default behavior.  If its a destination, check to see if we need
-# to go there now, as a result of a previous HMgoto request.  If so, schedule
-# it to happen with the closing </a> tag, so we can highlight the text up to
-# the </a>.
-
-proc HMtag_a {win param text} {
-	upvar #0 HM$win var
-
-	# a source
-
-	if {[HMextract_param $param href]} {
-		set var(Tref) [list L:$href]
-		HMstack $win "" "Tlink link"
-		HMlink_setup $win $href
-	}
-
-	# a destination
-
-	if {[HMextract_param $param name]} {
-		set var(Tname) [list N:$name]
-		HMstack $win "" "Tanchor anchor"
-		$win mark set N:$name "$var(S_insert) - 1 chars"
-		$win mark gravity N:$name left
-		if {[info exists var(goto)] && $var(goto) == $name} {
-			unset var(goto)
-			set var(going) $name
-		}
-	}
-}
-
-# The application should call here with the fragment name
-# to cause the display to go to this spot.
-# If the target exists, go there (and do the callback),
-# otherwise schedule the goto to happen when we see the reference.
-
-proc HMgoto {win where {callback HMwent_to}} {
-	upvar #0 HM$win var
-	if {[regexp N:$where [$win mark names]]} {
-		$win see N:$where
-		update
-		eval $callback $win [list $where]
-		return 1
-	} else {
-		set var(goto) $where
-		return 0
-	}
-}
-
-# We actually got to the spot, so highlight it!
-# This should/could be replaced by the application
-# We'll flash it orange a couple of times.
-
-proc HMwent_to {win where {count 0} {color orange}} {
-	upvar #0 HM$win var
-	if {$count > 5} return
-	catch {$win tag configure N:$where -foreground $color}
-	update
-	after 200 [list HMwent_to $win $where [incr count] \
-				[expr {$color=="orange" ? "" : "orange"}]]
-}
-
-proc HMtag_/a {win param text} {
-	upvar #0 HM$win var
-	if {[info exists var(Tref)]} {
-		unset var(Tref)
-		HMstack $win / "Tlink link"
-	}
-
-	# goto this link, then invoke the call-back.
-
-	if {[info exists var(going)]} {
-		$win yview N:$var(going)
-		update
-		HMwent_to $win $var(going)
-		unset var(going)
-	}
-
-	if {[info exists var(Tname)]} {
-		unset var(Tname)
-		HMstack $win / "Tanchor anchor"
-	}
-}
-
-#           Inline Images
-# This interface is subject to change
-# Most of the work is getting around a limitation of TK that prevents
-# setting the size of a label to a widthxheight in pixels
-#
-# Images have the following parameters:
-#    align:  top,middle,bottom
-#    alt:    alternate text
-#    ismap:  A clickable image map
-#    src:    The URL link
-# Netscape supports (and so do we)
-#    width:  A width hint (in pixels)
-#    height:  A height hint (in pixels)
-#    border: The size of the window border
-
-proc HMtag_img {win param text} {
-	upvar #0 HM$win var
-
-	# get alignment
-	array set align_map {top top    middle center    bottom bottom}
-	set align bottom		;# The spec isn't clear what the default should be
-	HMextract_param $param align
-	catch {set align $align_map([string tolower $align])}
-
-	# get alternate text
-	set alt "<image>"
-	HMextract_param $param alt
-	set alt [HMmap_esc $alt]
-
-	# get the border width
-	set border 1
-	HMextract_param $param border
-
-	# see if we have an image size hint
-	# If so, make a frame the "hint" size to put the label in
-	# otherwise just make the label
-	set item $win.$var(tags)
-	# catch {destroy $item}
-	if {[HMextract_param $param width] && [HMextract_param $param height]} {
-		frame $item -width $width -height $height
-		pack propagate $item 0
-		set label $item.label
-		label $label
-		pack $label -expand 1 -fill both
-	} else {
-		set label $item
-		label $label 
-	}
-
-	$label configure -relief ridge -fg orange -text $alt
-	catch {$label configure -bd $border}
-	$win window create $var(S_insert) -align $align -window $item -pady 2 -padx 2
-
-	# add in all the current tags (this is overkill)
-	set tags [HMcurrent_tags $win]
-	foreach tag $tags {
-		$win tag add $tag $item
-	}
-
-	# set imagemap callbacks
-	if {[HMextract_param $param ismap]} {
-		# regsub -all {[^L]*L:([^ ]*).*}  $tags {\1} link
-		set link [lindex $tags [lsearch -glob $tags L:*]]
-		regsub L: $link {} link
-		global HMevents
-		regsub -all {%} $link {%%} link2
-		foreach i [array names HMevents] {
-			bind $label <$i> "catch \{%W configure $HMevents($i)\}"
-		}
-		bind $label <1> "+HMlink_callback $win $link2?%x,%y"
-	} 
-
-	# now callback to the application
-	set src ""
-	HMextract_param $param src
-	HMset_image $win $label $src
-	return $label	;# used by the forms package for input_image types
-}
-
-# The app needs to supply one of these
-proc HMset_image {win handle src} {
-	HMgot_image $handle "can't get\n$src"
-}
-
-# When the image is available, the application should call back here.
-# If we have the image, put it in the label, otherwise display the error
-# message.  If we don't get a callback, the "alt" text remains.
-# if we have a clickable image, arrange for a callback
-
-proc HMgot_image {win image_error} {
-	# if we're in a frame turn on geometry propogation
-	if {[winfo name $win] == "label"} {
-		pack propagate [winfo parent $win] 1
-	}
-	if {[catch {$win configure -image $image_error}]} {
-		$win configure -image {}
-		$win configure -text $image_error
-	}
-}
-
-# Sample hypertext link callback routine - should be replaced by app
-# This proc is called once for each <A> tag.
-# Applications can overwrite this procedure, as required, or
-# replace the HMevents array
-#   win:   The name of the text widget to render into
-#   href:  The HREF link for this <a> tag.
-
-array set HMevents {
-	Enter	{-borderwidth 2 -relief raised }
-	Leave	{-borderwidth 2 -relief flat }
-	1		{-borderwidth 2 -relief sunken}
-	ButtonRelease-1	{-borderwidth 2 -relief raised}
-}
-
-# We need to escape any %'s in the href tag name so the bind command
-# doesn't try to substitute them.
-
-proc HMlink_setup {win href} {
-	global HMevents
-	regsub -all {%} $href {%%} href2
-	foreach i [array names HMevents] {
-		eval {$win tag bind  L:$href <$i>} \
-			\{$win tag configure \{L:$href2\} $HMevents($i)\}
-	}
-}
-
-# generic link-hit callback
-# This gets called upon button hits on hypertext links
-# Applications are expected to supply ther own HMlink_callback routine
-#   win:   The name of the text widget to render into
-#   x,y:   The cursor position at the "click"
-
-proc HMlink_hit {win x y} {
-	set tags [$win tag names @$x,$y]
-	set link [lindex $tags [lsearch -glob $tags L:*]]
-	# regsub -all {[^L]*L:([^ ]*).*}  $tags {\1} link
-	regsub L: $link {} link
-	HMlink_callback $win $link
-}
-
-# replace this!
-#   win:   The name of the text widget to render into
-#   href:  The HREF link for this <a> tag.
-
-proc HMlink_callback {win href} {
-	puts "Got hit on $win, link $href"
-}
-
-# extract a value from parameter list (this needs a re-do)
-# returns "1" if the keyword is found, "0" otherwise
-#   param:  A parameter list.  It should alredy have been processed to
-#           remove any entity references
-#   key:    The parameter name
-#   val:    The variable to put the value into (use key as default)
-
-proc HMextract_param {param key {val ""}} {
-
-	if {$val == ""} {
-		upvar $key result
-	} else {
-		upvar $val result
-	}
-    set ws "    \n\r"
- 
-    # look for name=value combinations.  Either (') or (") are valid delimeters
-    if {
-      [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] ||
-      [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] ||
-      [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } {
-        set result $value
-        return 1
-    }
-
-	# now look for valueless names
-	# I should strip out name=value pairs, so we don't end up with "name"
-	# inside the "value" part of some other key word - some day
-	
-	set bad \[^a-zA-Z\]+
-	if {[regexp -nocase  "$bad$key$bad" -$param-]} {
-		return 1
-	} else {
-		return 0
-	}
-}
-
-# These next two routines manage the display state of the page.
-
-# Push or pop tags to/from stack.
-# Each orthogonal text property has its own stack, stored as a list.
-# The current (most recent) tag is the last item on the list.
-# Push is {} for pushing and {/} for popping
-
-proc HMstack {win push list} {
-	upvar #0 HM$win var
-	array set tags $list
-	if {$push == ""} {
-		foreach tag [array names tags] {
-			lappend var($tag) $tags($tag)
-		}
-	} else {
-		foreach tag [array names tags] {
-			# set cnt [regsub { *[^ ]+$} $var($tag) {} var($tag)]
-			set var($tag) [lreplace $var($tag) end end]
-		}
-	}
-}
-
-# extract set of current text tags
-# tags starting with T map directly to text tags, all others are
-# handled specially.  There is an application callback, HMset_font
-# to allow the application to do font error handling
-
-proc HMcurrent_tags {win} {
-	upvar #0 HM$win var
-	set font font
-	foreach i {family size weight style} {
-		set $i [lindex $var($i) end]
-		append font :[set $i]
-	}
-	set xfont [HMx_font $family $size $weight $style $var(S_adjust_size)]
-	HMset_font $win $font $xfont
-	set indent [llength $var(indent)]
-	incr indent -1
-	lappend tags $font indent$indent
-	foreach tag [array names var T*] {
-		lappend tags [lindex $var($tag) end]	;# test
-	}
-	set var(font) $font
-	set var(xfont) [$win tag cget $font -font]
-	set var(level) $indent
-	return $tags
-}
-
-# allow the application to do do better font management
-# by overriding this procedure
-
-proc HMset_font {win tag font} {
-	catch {$win tag configure $tag -font $font} msg
-}
-
-# generate an X font name
-proc HMx_font {family size weight style {adjust_size 0}} {
-	catch {incr size $adjust_size}
-	return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*"
-}
-
-# Optimize HMrender (hee hee)
-# This is experimental
-
-proc HMoptimize {} {
-	regsub -all "\n\[ 	\]*#\[^\n\]*" [info body HMrender] {} body
-	regsub -all ";\[ 	\]*#\[^\n]*" $body {} body
-	regsub -all "\n\n+" $body \n body
-	proc HMrender {win tag not param text} $body
-}
-############################################
-# Turn HTML into TCL commands
-#   html    A string containing an html document
-#   cmd		A command to run for each html tag found
-#   start	The name of the dummy html start/stop tags
-
-proc HMparse_html {html {cmd HMtest_parse} {start hmstart}} {
-	regsub -all \{ $html {\&ob;} html
-	regsub -all \} $html {\&cb;} html
-	set w " \t\r\n"	;# white space
-	proc HMcl x {return "\[$x\]"}
-	set exp <(/?)([HMcl ^$w>]+)[HMcl $w]*([HMcl ^>]*)>
-	set sub "\}\n$cmd {\\2} {\\1} {\\3} \{"
-	regsub -all $exp $html $sub html
-	eval "$cmd {$start} {} {} \{ $html \}"
-	eval "$cmd {$start} / {} {}"
-}
-
-proc HMtest_parse {command tag slash text_after_tag} {
-	puts "==> $command $tag $slash $text_after_tag"
-}
-
-# Convert multiple white space into a single space
-
-proc HMzap_white {data} {
-	regsub -all "\[ \t\r\n\]+" $data " " data
-	return $data
-}
-
-# find HTML escape characters of the form &xxx;
-
-proc HMmap_esc {text} {
-	if {![regexp & $text]} {return $text}
-	regsub -all {([][$\\])} $text {\\\1} new
-	regsub -all {&#([0-9][0-9]?[0-9]?);?} \
-		$new {[format %c [scan \1 %d tmp;set tmp]]} new
-	regsub -all {&([a-zA-Z]+);?} $new {[HMdo_map \1]} new
-	return [subst $new]
-}
-
-# convert an HTML escape sequence into character
-
-proc HMdo_map {text {unknown ?}} {
-	global HMesc_map
-	set result $unknown
-	catch {set result $HMesc_map($text)}
-	return $result
-}
-
-# table of escape characters (ISO latin-1 esc's are in a different table)
-
-array set HMesc_map {
-   lt <   gt >   amp &   quot \"   copy \xa9
-   reg \xae   ob \x7b   cb \x7d   nbsp \xa0
-}
-#############################################################
-# ISO Latin-1 escape codes
-
-array set HMesc_map {
-	nbsp \xa0 iexcl \xa1 cent \xa2 pound \xa3 curren \xa4
-	yen \xa5 brvbar \xa6 sect \xa7 uml \xa8 copy \xa9
-	ordf \xaa laquo \xab not \xac shy \xad reg \xae
-	hibar \xaf deg \xb0 plusmn \xb1 sup2 \xb2 sup3 \xb3
-	acute \xb4 micro \xb5 para \xb6 middot \xb7 cedil \xb8
-	sup1 \xb9 ordm \xba raquo \xbb frac14 \xbc frac12 \xbd
-	frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc \xc2
-	Atilde \xc3 Auml \xc4 Aring \xc5 AElig \xc6 Ccedil \xc7
-	Egrave \xc8 Eacute \xc9 Ecirc \xca Euml \xcb Igrave \xcc
-	Iacute \xcd Icirc \xce Iuml \xcf ETH \xd0 Ntilde \xd1
-	Ograve \xd2 Oacute \xd3 Ocirc \xd4 Otilde \xd5 Ouml \xd6
-	times \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc \xdb
-	Uuml \xdc Yacute \xdd THORN \xde szlig \xdf agrave \xe0
-	aacute \xe1 acirc \xe2 atilde \xe3 auml \xe4 aring \xe5
-	aelig \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc \xea
-	euml \xeb igrave \xec iacute \xed icirc \xee iuml \xef
-	eth \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc \xf4
-	otilde \xf5 ouml \xf6 divide \xf7 oslash \xf8 ugrave \xf9
-	uacute \xfa ucirc \xfb uuml \xfc yacute \xfd thorn \xfe
-	yuml \xff
-}
-
-##########################################################
-# html forms management commands
-
-# As each form element is located, it is created and rendered.  Additional
-# state is stored in a form specific global variable to be processed at
-# the end of the form, including the "reset" and "submit" options.
-# Remember, there can be multiple forms existing on multiple pages.  When
-# HTML tables are added, a single form could be spread out over multiple
-# text widgets, which makes it impractical to hang the form state off the
-# HM$win structure.  We don't need to check for the existance of required
-# parameters, we just "fail" and get caught in HMrender
-
-# This causes line breaks to be preserved in the inital values
-# of text areas
-array set HMtag_map {
-	textarea    {fill 0}
-}
-
-##########################################################
-# html isindex tag.  Although not strictly forms, they're close enough
-# to be in this file
-
-# is-index forms
-# make a frame with a label, entry, and submit button
-
-proc HMtag_isindex {win param text} {
-	upvar #0 HM$win var
-
-	set item $win.$var(tags)
-	if {[winfo exists $item]} {
-		destroy $item
-	}
-	frame $item -relief ridge -bd 3
-	set prompt "Enter search keywords here"
-	HMextract_param $param prompt
-	label $item.label -text [HMmap_esc $prompt] -font $var(xfont)
-	entry $item.entry
-	bind $item.entry <Return> "$item.submit invoke"
-	button $item.submit -text search -font $var(xfont) -command \
-		[format {HMsubmit_index %s {%s} [HMmap_reply [%s get]]} \
-		$win $param $item.entry]
-	pack $item.label -side top
-	pack $item.entry $item.submit -side left
-
-	# insert window into text widget
-
-	$win insert $var(S_insert) \n isindex
-	HMwin_install $win $item
-	$win insert $var(S_insert) \n isindex
-	bind $item <Visibility> {focus %W.entry}
-}
-
-# This is called when the isindex form is submitted.
-# The default version calls HMlink_callback.  Isindex tags should either
-# be deprecated, or fully supported (e.g. they need an href parameter)
-
-proc HMsubmit_index {win param text} {
-	HMlink_callback $win ?$text
-}
-
-# initialize form state.  All of the state for this form is kept
-# in a global array whose name is stored in the form_id field of
-# the main window array.
-# Parameters: ACTION, METHOD, ENCTYPE
-
-proc HMtag_form {win param text} {
-	upvar #0 HM$win var
-
-	# create a global array for the form
-	set id HM$win.form$var(tags)
-	upvar #0 $id form
-
-	# missing /form tag, simulate it
-	if {[info exists var(form_id)]} {
-		puts "Missing end-form tag !!!! $var(form_id)"
-		HMtag_/form $win {} {}
-	}
-	catch {unset form}
-	set var(form_id) $id
-
-	set form(param) $param		;# form initial parameter list
-	set form(reset) ""			;# command to reset the form
-	set form(reset_button) ""	;# list of all reset buttons
-	set form(submit) ""			;# command to submit the form
-	set form(submit_button) ""	;# list of all submit buttons
-}
-
-# Where we're done try to get all of the state into the widgets so
-# we can free up the form structure here.  Unfortunately, we can't!
-
-proc HMtag_/form {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	# make submit button entries for all radio buttons
-	foreach name [array names form radio_*] {
-		regsub radio_ $name {} name
-		lappend form(submit) [list $name \$form(radio_$name)]
-	}
-
-	# no submit button - add one
-	if {$form(submit_button) == ""} {
-		HMinput_submit $win {}
-				
-	}
-	
-	# process the "submit" command(s)
-	# each submit button could have its own name,value pair
-
-	foreach item $form(submit_button) {
-		set submit $form(submit)
-		catch {lappend submit $form(submit_$item)}
-		$item configure -command  \
-				[list HMsubmit_button $win $var(form_id) $form(param) \
-				$submit]
-	}
-
-	# process the reset button(s)
-	HMinput_reset $win {}
-	foreach item $form(reset_button) {
-		$item configure -command $form(reset)
-	}
-
-	# unset all unused fields here
-	unset form(reset) form(submit) form(reset_button) form(submit_button)
-	unset var(form_id)
-}
-
-###################################################################
-# handle form input items
-# each item type is handled in a separate procedure
-# Each "type" procedure needs to:
-# - create the window
-# - initialize it
-# - add the "submit" and "reset" commands onto the proper Q's
-#   "submit" is subst'd
-#   "reset" is eval'd
-
-proc HMtag_input {win param text} {
-	upvar #0 HM$win var
-
-	set type text	;# the default
-	HMextract_param $param type
-	set type [string tolower $type]
-	if {[catch {HMinput_$type $win $param} err]} {
-		puts stderr $err
-	}
-}
-
-# input type=text
-# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE
-
-proc HMinput_text {win param {show {}}} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	# make the entry
-	HMextract_param $param name		;# required
-	set item $win.input_text,$var(tags)
-	set size 20; HMextract_param $param size
-	set maxlength 0; HMextract_param $param maxlength
-	entry $item -width $size -show $show
-
-	# set the initial value
-	set value ""; HMextract_param $param value
-	$item insert 0 $value
-		
-	# insert the entry
-	HMwin_install $win $item
-
-	# set the "reset" and "submit" commands
-	append form(reset) ";$item delete 0 end;$item insert 0 [list $value]"
-	lappend form(submit) [list $name "\[$item get]"]
-
-	# handle the maximum length (broken - no way to cleanup bindtags state)
-	if {$maxlength} {
-		bindtags $item "[bindtags $item] max$maxlength"
-		bind max$maxlength <KeyPress> "%W delete $maxlength end"
-	}
-}
-
-# password fields - same as text, only don't show data
-# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE
-
-proc HMinput_password {win param} {
-	HMinput_text $win $param *
-}
-
-# checkbuttons are missing a "get" option, so we must use a global
-# variable to store the value.
-# Parameters NAME, VALUE, (reqd), CHECKED
-
-proc HMinput_checkbox {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	HMextract_param $param name
-	HMextract_param $param value
-
-	# Set the global variable, don't use the "form" alias as it is not
-	# defined in the global scope of the button
-	set variable $var(form_id)(check_$var(tags))	
-	set item $win.input_checkbutton,$var(tags)
-	checkbutton $item -variable $variable -off {} -on $value -text "  "
-	if {[HMextract_param $param checked]} {
-		$item select
-		append form(reset) ";$item select"
-	} else {
-		append form(reset) ";$item deselect"
-	}
-
-	HMwin_install $win $item
-	lappend form(submit) [list $name \$form(check_$var(tags))]
-}
-
-# radio buttons.  These are like check buttons, but only one can be selected
-
-proc HMinput_radio {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	HMextract_param $param name
-	HMextract_param $param value
-
-	set first [expr ![info exists form(radio_$name)]]
-	set variable $var(form_id)(radio_$name)
-	set variable $var(form_id)(radio_$name)
-	set item $win.input_radiobutton,$var(tags)
-	radiobutton $item -variable $variable -value $value -text " "
-
-	HMwin_install $win $item
-
-	if {$first || [HMextract_param $param checked]} {
-		$item select
-		append form(reset) ";$item select"
-	} else {
-		append form(reset) ";$item deselect"
-	}
-
-	# do the "submit" actions in /form so we only end up with 1 per button grouping
-	# contributing to the submission
-}
-
-# hidden fields, just append to the "submit" data
-# params: NAME, VALUE (reqd)
-
-proc HMinput_hidden {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	HMextract_param $param name
-	HMextract_param $param value
-	lappend form(submit) [list $name $value]
-}
-
-# handle input images.  The spec isn't very clear on these, so I'm not
-# sure its quite right
-# Use std image tag, only set up our own callbacks
-#  (e.g. make sure ismap isn't set)
-# params: NAME, SRC (reqd) ALIGN
-
-proc HMinput_image {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	HMextract_param $param name
-	set name		;# barf if no name is specified
-	set item [HMtag_img $win $param {}]
-	$item configure -relief raised -bd 2 -bg blue
-
-	# make a dummy "submit" button, and invoke it to send the form.
-	# We have to get the %x,%y in the value somehow, so calculate it during
-	# binding, and save it in the form array for later processing
-
-	set submit $win.dummy_submit,$var(tags)
-	if {[winfo exists $submit]} {
-		destroy $submit
-	}
-	button $submit	-takefocus 0;# this never gets mapped!
-	lappend form(submit_button) $submit
-	set form(submit_$submit) [list $name $name.\$form(X).\$form(Y)]
-	
-	$item configure -takefocus 1
-	bind $item <FocusIn> "catch \{$win see $item\}"
-	bind $item <1> "$item configure -relief sunken"
-	bind $item <Return> "
-		set $var(form_id)(X) 0
-		set $var(form_id)(Y) 0
-		$submit invoke	
-	"
-	bind $item <ButtonRelease-1> "
-		set $var(form_id)(X) %x
-		set $var(form_id)(Y) %y
-		$item configure -relief raised
-		$submit invoke	
-	"
-}
-
-# Set up the reset button.  Wait for the /form to attach
-# the -command option.  There could be more that 1 reset button
-# params VALUE
-
-proc HMinput_reset {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	set value reset
-	HMextract_param $param value
-
-	set item $win.input_reset,$var(tags)
-	button $item -text [HMmap_esc $value] -cursor left_ptr
-	HMwin_install $win $item
-	lappend form(reset_button) $item
-}
-
-# Set up the submit button.  Wait for the /form to attach
-# the -command option.  There could be more that 1 submit button
-# params: NAME, VALUE
-
-proc HMinput_submit {win param} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	HMextract_param $param name
-	set value submit
-	HMextract_param $param value
-	set item $win.input_submit,$var(tags)
-	button $item -text [HMmap_esc $value] -fg blue -cursor left_ptr
-	HMwin_install $win $item
-	lappend form(submit_button) $item
-	# need to tie the "name=value" to this button
-	# save the pair and do it when we finish the submit button
-	catch {set form(submit_$item) [list $name $value]}
-}
-
-#########################################################################
-# selection items
-# They all go into a list box.  We don't what to do with the listbox until
-# we know how many items end up in it.  Gather up the data for the "options"
-# and finish up in the /select tag
-# params: NAME (reqd), MULTIPLE, SIZE 
-
-proc HMtag_select {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-
-	HMextract_param $param name
-	set size 5;  HMextract_param $param size
-	set form(select_size) $size
-	set form(select_name) $name
-	set form(select_values) ""		;# list of values to submit
-	if {[HMextract_param $param multiple]} {
-		set mode multiple
-	} else {
-		set mode single
-	}
-	set item $win.select,$var(tags)
-    frame $item
-    set form(select_frame) $item
-	listbox $item.list -selectmode $mode -width 0 -exportselection 0 -cursor left_ptr
-	HMwin_install $win $item
-}
-
-# select options
-# The values returned in the query may be different from those
-# displayed in the listbox, so we need to keep a separate list of
-# query values.
-#  form(select_default) - contains the default query value
-#  form(select_frame) - name of the listbox's containing frame
-#  form(select_values)  - list of query values
-# params: VALUE, SELECTED
-
-proc HMtag_option {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	upvar $text data
-	set frame $form(select_frame)
-
-	# set default option (or options)
-	if {[HMextract_param $param selected]} {
-        lappend form(select_default) [$form(select_frame).list size]
-    }
-    set value [string trimright $data " \n"]
-    $frame.list insert end $value
-	HMextract_param $param value
-	lappend form(select_values) $value
-	set data ""
-}
- 
-# do most of the work here!
-# if SIZE>1, make the listbox.  Otherwise make a "drop-down"
-# listbox with a label in it
-# If the # of items > size, add a scroll bar
-# This should probably be broken up into callbacks to make it
-# easier to override the "look".
-
-proc HMtag_/select {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	set frame $form(select_frame)
-	set size $form(select_size)
-	set items [$frame.list size]
-
-	# set the defaults and reset button
-	append form(reset) ";$frame.list selection clear 0  $items"
-	if {[info exists form(select_default)]} {
-		foreach i $form(select_default) {
-			$frame.list selection set $i
-			append form(reset) ";$frame.list selection set $i"
-		}
-	} else {
-		$frame.list selection set 0
-		append form(reset) ";$frame.list selection set 0"
-	}
-
-	# set up the submit button. This is the general case.  For single
-	# selections we could be smarter
-
-	for {set i 0} {$i < $size} {incr i} {
-		set value [format {[expr {[%s selection includes %s] ? {%s} : {}}]} \
-				$frame.list $i [lindex $form(select_values) $i]]
-		lappend form(submit) [list $form(select_name) $value]
-	}
-	
-	# show the listbox - no scroll bar
-
-	if {$size > 1 && $items <= $size} {
-		$frame.list configure -height $items
-		pack $frame.list
-
-	# Listbox with scrollbar
-
-	} elseif {$size > 1} {
-		scrollbar $frame.scroll -command "$frame.list yview"  \
-				-orient v -takefocus 0
-		$frame.list configure -height $size \
-			-yscrollcommand "$frame.scroll set"
-		pack $frame.list $frame.scroll -side right -fill y
-
-	# This is a joke!
-
-	} else {
-		scrollbar $frame.scroll -command "$frame.list yview"  \
-			-orient h -takefocus 0
-		$frame.list configure -height 1 \
-			-yscrollcommand "$frame.scroll set"
-		pack $frame.list $frame.scroll -side top -fill x
-	}
-
-	# cleanup
-
-	foreach i [array names form select_*] {
-		unset form($i)
-	}
-}
-
-# do a text area (multi-line text)
-# params: COLS, NAME, ROWS (all reqd, but default rows and cols anyway)
-
-proc HMtag_textarea {win param text} {
-	upvar #0 HM$win var
-	upvar #0 $var(form_id) form
-	upvar $text data
-
-	set rows 5; HMextract_param $param rows
-	set cols 30; HMextract_param $param cols
-	HMextract_param $param name
-	set item $win.textarea,$var(tags)
-	frame $item
-	text $item.text -width $cols -height $rows -wrap none \
-			-yscrollcommand "$item.scroll set" -padx 3 -pady 3
-	scrollbar $item.scroll -command "$item.text yview"  -orient v
-	$item.text insert 1.0 $data
-	HMwin_install $win $item
-	pack $item.text $item.scroll -side right -fill y
-	lappend form(submit) [list $name "\[$item.text get 0.0 end]"]
-	append form(reset) ";$item.text delete 1.0 end; \
-			$item.text insert 1.0 [list $data]"
-	set data ""
-}
-
-# procedure to install windows into the text widget
-# - win:  name of the text widget
-# - item: name of widget to install
-
-proc HMwin_install {win item} {
-	upvar #0 HM$win var
-	$win window create $var(S_insert) -window $item -align bottom
-	$win tag add indent$var(level) $item
-	set focus [expr {[winfo class $item] != "Frame"}]
-	$item configure -takefocus $focus
-	bind $item <FocusIn> "$win see $item"
-}
-
-#####################################################################
-# Assemble and submit the query
-# each list element in "stuff" is a name/value pair
-# - The names are the NAME parameters of the various fields
-# - The values get run through "subst" to extract the values
-# - We do the user callback with the list of name value pairs
-
-proc HMsubmit_button {win form_id param stuff} {
-	upvar #0 HM$win var
-	upvar #0 $form_id form
-	set query ""
-	foreach pair $stuff {
-		set value [subst [lindex $pair 1]]
-		#if {$value != ""} {
-			set item [lindex $pair 0]
-			lappend query $item $value
-		#}
-	}
-	# this is the user callback.
-	HMsubmit_form $win $param $query
-}
-
-# sample user callback for form submission
-# should be replaced by the application
-# Sample version generates a string suitable for http
-
-proc HMsubmit_form {win param query} {
-	set result ""
-	set sep ""
-	foreach i $query {
-		append result  $sep [HMmap_reply $i]
-		if {$sep != "="} {set sep =} {set sep &}
-	}
-	puts $result
-}
-
-# do x-www-urlencoded character mapping
-# The spec says: "non-alphanumeric characters are replaced by '%HH'"
- 
-set HMalphanumeric	a-zA-Z0-9	;# definition of alphanumeric character class
-for {set i 1} {$i <= 256} {incr i} {
-    set c [format %c $i]
-    if {![string match \[$HMalphanumeric\] $c]} {
-        set HMform_map($c) %[format %.2x $i]
-    }
-}
-
-# These are handled specially
-array set HMform_map {
-    " " +   \n %0d%0a
-}
-
-# 1 leave alphanumerics characters alone
-# 2 Convert every other character to an array lookup
-# 3 Escape constructs that are "special" to the tcl parser
-# 4 "subst" the result, doing all the array substitutions
- 
-proc HMmap_reply {string} {
-    global HMform_map HMalphanumeric
-    regsub -all \[^$HMalphanumeric\] $string {$HMform_map(&)} string
-    regsub -all \n $string {\\n} string
-    regsub -all \t $string {\\t} string
-    regsub -all {[][{})\\]\)} $string {\\&} string
-    return [subst $string]
-}
-
-# convert a x-www-urlencoded string int a a list of name/value pairs
-
-# 1  convert a=b&c=d... to {a} {b} {c} {d}...
-# 2, convert + to  " "
-# 3, convert %xx to char equiv
-
-proc HMcgiDecode {data} {
-	set data [split $data "&="]
-	foreach i $data {
-		lappend result [cgiMap $i]
-	}
-	return $result
-}
-
-proc HMcgiMap {data} {
-	regsub -all {\+} $data " " data
-	
-	if {[regexp % $data]} {
-		regsub -all {([][$\\])} $data {\\\1} data
-		regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data  {[format %c 0x\1]} data
-		return [subst $data]
-	} else {
-		return $data
-	}
-}
-
-# There is a bug in the tcl library focus routines that prevents focus
-# from every reaching an un-viewable window.  Use our *own*
-# version of the library routine, until the bug is fixed, make sure we
-# over-ride the library version, and not the otherway around
-
-auto_load tkFocusOK
-proc tkFocusOK w {
-    set code [catch {$w cget -takefocus} value]
-    if {($code == 0) && ($value != "")} {
-    if {$value == 0} {
-        return 0
-    } elseif {$value == 1} {
-        return 1
-    } else {
-        set value [uplevel #0 $value $w]
-        if {$value != ""} {
-        return $value
-        }
-    }
-    }
-    set code [catch {$w cget -state} value]
-    if {($code == 0) && ($value == "disabled")} {
-    return 0
-    }
-    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
-}

Copied: grass/trunk/lib/form/html_library_grass.tcl (from rev 35193, grass/trunk/lib/form/html_library_grass.tcl)
===================================================================
--- grass/trunk/lib/form/html_library_grass.tcl	                        (rev 0)
+++ grass/trunk/lib/form/html_library_grass.tcl	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,1418 @@
+# Simple HTML display library by Stephen Uhler (stephen.uhler at sun.com)
+# Copyright (c) 1995 by Sun Microsystems
+# Version 0.3 Fri Sep  1 10:47:17 PDT 1995
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# To use this package,  create a text widget (say, .text)
+# and set a variable full of html, (say $html), and issue:
+#	HMinit_win .text
+#	HMparse_html $html "HMrender .text"
+# You also need to supply the routine:
+#   proc HMlink_callback {win href} { ...}
+#      win:  The name of the text widget
+#      href  The name of the link
+# which will be called anytime the user "clicks" on a link.
+# The supplied version just prints the link to stdout.
+# In addition, if you wish to use embedded images, you will need to write
+#   proc HMset_image {handle src}
+#      handle  an arbitrary handle (not really)
+#      src     The name of the image
+# Which calls
+#	HMgot_image $handle $image
+# with the TK image.
+#
+# To return a "used" text widget to its initialized state, call:
+#   HMreset_win .text
+# See "sample.tcl" for sample usage
+##################################################################
+############################################
+# mapping of html tags to text tag properties
+# properties beginning with "T" map directly to text tags
+
+# These are Defined in HTML 2.0
+
+array set HMtag_map {
+	b      {weight bold}
+	blockquote	{style i indent 1 Trindent rindent}
+	bq		{style i indent 1 Trindent rindent}
+	cite   {style i}
+	code   {family courier}
+	dfn    {style i}	
+	dir    {indent 1}
+	dl     {indent 1}
+	em     {style i}
+	h1     {size 24 weight bold}
+	h2     {size 22}		
+	h3     {size 20}	
+	h4     {size 18}
+	h5     {size 16}
+	h6     {style i}
+	i      {style i}
+	kbd    {family courier weight bold}
+	menu     {indent 1}
+	ol     {indent 1}
+	pre    {fill 0 family courier Tnowrap nowrap}
+	samp   {family courier}		
+	strong {weight bold}		
+	tt     {family courier}
+	u	 {Tunderline underline}
+	ul     {indent 1}
+	var    {style i}	
+}
+
+# These are in common(?) use, but not defined in html2.0
+
+array set HMtag_map {
+	center {Tcenter center}
+	strike {Tstrike strike}
+	u	   {Tunderline underline}
+}
+
+# initial values
+
+set HMtag_map(hmstart) {
+	family times   weight medium   style r   size 14
+	Tcenter ""   Tlink ""   Tnowrap ""   Tunderline ""   list list
+	fill 1   indent "" counter 0 adjust 0
+}
+
+# html tags that insert white space
+
+array set HMinsert_map {
+	blockquote "\n\n" /blockquote "\n"
+	br	"\n"
+	dd	"\n" /dd	"\n"
+	dl	"\n" /dl	"\n"
+	dt	"\n"
+	form "\n"	/form "\n"
+	h1	"\n\n"	/h1	"\n"
+	h2	"\n\n"	/h2	"\n"
+	h3	"\n\n"	/h3	"\n"
+	h4	"\n"	/h4	"\n"
+	h5	"\n"	/h5	"\n"
+	h6	"\n"	/h6	"\n"
+	li   "\n"
+	/dir "\n"
+	/ul "\n"
+	/ol "\n"
+	/menu "\n"
+	p	"\n\n"
+	pre "\n"	/pre "\n"
+}
+
+# tags that are list elements, that support "compact" rendering
+
+array set HMlist_elements {
+	ol 1   ul 1   menu 1   dl 1   dir 1
+}
+############################################
+# initialize the window and stack state
+
+proc HMinit_win {win} {
+	upvar #0 HM$win var
+	
+	HMinit_state $win
+	$win tag configure underline -underline 1
+	$win tag configure center -justify center
+	$win tag configure nowrap -wrap none
+	$win tag configure rindent -rmargin $var(S_tab)c
+	$win tag configure strike -overstrike 1
+	$win tag configure mark -foreground red		;# list markers
+	$win tag configure list -spacing1 3p -spacing3 3p		;# regular lists
+	$win tag configure compact -spacing1 0p		;# compact lists
+	$win tag configure link -borderwidth 2 -foreground blue	;# hypertext links
+	HMset_indent $win $var(S_tab)
+	$win configure -wrap word
+
+	# configure the text insertion point
+	$win mark set $var(S_insert) 1.0
+
+	# for horizontal rules
+	$win tag configure thin -font [HMx_font times 2 medium r]
+	$win tag configure hr -relief sunken -borderwidth 2 -wrap none \
+		-tabs [winfo width $win]
+	bind $win <Configure> {
+		%W tag configure hr -tabs %w
+		%W tag configure last -spacing3 %h
+	}
+
+	# generic link enter callback
+
+	$win tag bind link <1> "HMlink_hit $win %x %y"
+}
+
+# set the indent spacing (in cm) for lists
+# TK uses a "weird" tabbing model that causes \t to insert a single
+# space if the current line position is past the tab setting
+
+proc HMset_indent {win cm} {
+	set tabs [expr $cm / 2.0]
+	$win configure -tabs ${tabs}c
+	foreach i {1 2 3 4 5 6 7 8 9} {
+		set tab [expr $i * $cm]
+		$win tag configure indent$i -lmargin1 ${tab}c -lmargin2 ${tab}c \
+			-tabs "[expr $tab + $tabs]c [expr $tab + 2*$tabs]c"
+	}
+}
+
+# reset the state of window - get ready for the next page
+# remove all but the font tags, and remove all form state
+
+proc HMreset_win {win} {
+	upvar #0 HM$win var
+	regsub -all { +[^L ][^ ]*} " [$win tag names] " {} tags
+	catch "$win tag delete $tags"
+	eval $win mark unset [$win mark names]
+	$win delete 0.0 end
+	$win tag configure hr -tabs [winfo width $win]
+
+	# configure the text insertion point
+	$win mark set $var(S_insert) 1.0
+
+	# remove form state.  If any check/radio buttons still exists, 
+	# their variables will be magically re-created, and never get
+	# cleaned up.
+	catch unset [info globals HM$win.form*]
+
+	HMinit_state $win
+	return HM$win
+}
+
+# initialize the window's state array
+# Parameters beginning with S_ are NOT reset
+#  adjust_size:		global font size adjuster
+#  unknown:		character to use for unknown entities
+#  tab:			tab stop (in cm)
+#  stop:		enabled to stop processing
+#  update:		how many tags between update calls
+#  tags:		number of tags processed so far
+#  symbols:		Symbols to use on un-ordered lists
+
+proc HMinit_state {win} {
+	upvar #0 HM$win var
+	array set tmp [array get var S_*]
+	catch {unset var}
+	array set var {
+		stop 0
+		tags 0
+		fill 0
+		list list
+		S_adjust_size 0
+		S_tab 1.0
+		S_unknown \xb7
+		S_update 10
+		S_symbols O*=+-o\xd7\xb0>:\xb7
+		S_insert Insert
+	}
+	array set var [array get tmp]
+}
+
+# alter the parameters of the text state
+# this allows an application to over-ride the default settings
+# it is called as: HMset_state -param value -param value ...
+
+array set HMparam_map {
+	-update S_update
+	-tab S_tab
+	-unknown S_unknown
+	-stop S_stop
+	-size S_adjust_size
+	-symbols S_symbols
+    -insert S_insert
+}
+
+proc HMset_state {win args} {
+	upvar #0 HM$win var
+	global HMparam_map
+	set bad 0
+	if {[catch {array set params $args}]} {return 0}
+	foreach i [array names params] {
+		incr bad [catch {set var($HMparam_map($i)) $params($i)}]
+	}
+	return [expr $bad == 0]
+}
+
+############################################
+# manage the display of html
+
+# HMrender gets called for every html tag
+#   win:   The name of the text widget to render into
+#   tag:   The html tag (in arbitrary case)
+#   not:   a "/" or the empty string
+#   param: The un-interpreted parameter list
+#   text:  The plain text until the next html tag
+
+proc HMrender {win tag not param text} {
+	upvar #0 HM$win var
+	if {$var(stop)} return
+	global HMtag_map HMinsert_map HMlist_elements
+	set tag [string tolower $tag]
+	set text [HMmap_esc $text]
+
+	# manage compact rendering of lists
+	if {[info exists HMlist_elements($tag)]} {
+		set list "list [expr {[HMextract_param $param compact] ? "compact" : "list"}]"
+	} else {
+		set list ""
+	}
+
+	# Allow text to be diverted to a different window (for tables)
+	# this is not currently used
+	if {[info exists var(divert)]} {
+		set win $var(divert)
+		upvar #0 HM$win var
+	}
+
+	# adjust (push or pop) tag state
+	catch {HMstack $win $not "$HMtag_map($tag) $list"}
+
+	# insert white space (with current font)
+	# adding white space can get a bit tricky.  This isn't quite right
+	set bad [catch {$win insert $var(S_insert) $HMinsert_map($not$tag) "space $var(font)"}]
+	if {!$bad && [lindex $var(fill) end]} {
+		set text [string trimleft $text]
+	}
+
+	# to fill or not to fill
+	if {[lindex $var(fill) end]} {
+		set text [HMzap_white $text]
+	}
+
+	# generic mark hook
+	catch {HMmark $not$tag $win $param text} err
+
+	# do any special tag processing
+	catch {HMtag_$not$tag $win $param text} msg
+
+
+	# add the text with proper tags
+
+	set tags [HMcurrent_tags $win]
+	$win insert $var(S_insert) $text $tags
+
+	# We need to do an update every so often to insure interactive response.
+	# This can cause us to re-enter the event loop, and cause recursive
+	# invocations of HMrender, so we need to be careful.
+	if {!([incr var(tags)] % $var(S_update))} {
+		update
+	}
+}
+
+# html tags requiring special processing
+# Procs of the form HMtag_<tag> or HMtag_</tag> get called just before
+# the text for this tag is displayed.  These procs are called inside a 
+# "catch" so it is OK to fail.
+#   win:   The name of the text widget to render into
+#   param: The un-interpreted parameter list
+#   text:  A pass-by-reference name of the plain text until the next html tag
+#          Tag commands may change this to affect what text will be inserted
+#          next.
+
+# A pair of pseudo tags are added automatically as the 1st and last html
+# tags in the document.  The default is <HMstart> and </HMstart>.
+# Append enough blank space at the end of the text widget while
+# rendering so HMgoto can place the target near the top of the page,
+# then remove the extra space when done rendering.
+
+proc HMtag_hmstart {win param text} {
+	upvar #0 HM$win var
+	$win mark gravity $var(S_insert) left
+	$win insert end "\n " last
+	$win mark gravity $var(S_insert) right
+}
+
+proc HMtag_/hmstart {win param text} {
+	$win delete last.first end
+}
+
+# put the document title in the window banner, and remove the title text
+# from the document
+
+proc HMtag_title {win param text} {
+	upvar $text data
+	wm title [winfo toplevel $win] $data
+	set data ""
+}
+
+proc HMtag_hr {win param text} {
+	upvar #0 HM$win var
+	$win insert $var(S_insert) "\n" space "\n" thin "\t" "thin hr" "\n" thin
+}
+
+# list element tags
+
+proc HMtag_ol {win param text} {
+	upvar #0 HM$win var
+	set var(count$var(level)) 0
+}
+
+proc HMtag_ul {win param text} {
+	upvar #0 HM$win var
+	catch {unset var(count$var(level))}
+}
+
+proc HMtag_menu {win param text} {
+	upvar #0 HM$win var
+	set var(menu) ->
+	set var(compact) 1
+}
+
+proc HMtag_/menu {win param text} {
+	upvar #0 HM$win var
+	catch {unset var(menu)}
+	catch {unset var(compact)}
+}
+	
+proc HMtag_dt {win param text} {
+	upvar #0 HM$win var
+	upvar $text data
+	set level $var(level)
+	incr level -1
+	$win insert $var(S_insert) "$data" \
+		"hi [lindex $var(list) end] indent$level $var(font)"
+	set data {}
+}
+
+proc HMtag_li {win param text} {
+	upvar #0 HM$win var
+	set level $var(level)
+	incr level -1
+	set x [string index $var(S_symbols)+-+-+-+-" $level]
+	catch {set x [incr var(count$level)]}
+	catch {set x $var(menu)}
+	$win insert $var(S_insert) \t$x\t "mark [lindex $var(list) end] indent$level $var(font)"
+}
+
+# Manage hypertext "anchor" links.  A link can be either a source (href)
+# a destination (name) or both.  If its a source, register it via a callback,
+# and set its default behavior.  If its a destination, check to see if we need
+# to go there now, as a result of a previous HMgoto request.  If so, schedule
+# it to happen with the closing </a> tag, so we can highlight the text up to
+# the </a>.
+
+proc HMtag_a {win param text} {
+	upvar #0 HM$win var
+
+	# a source
+
+	if {[HMextract_param $param href]} {
+		set var(Tref) [list L:$href]
+		HMstack $win "" "Tlink link"
+		HMlink_setup $win $href
+	}
+
+	# a destination
+
+	if {[HMextract_param $param name]} {
+		set var(Tname) [list N:$name]
+		HMstack $win "" "Tanchor anchor"
+		$win mark set N:$name "$var(S_insert) - 1 chars"
+		$win mark gravity N:$name left
+		if {[info exists var(goto)] && $var(goto) == $name} {
+			unset var(goto)
+			set var(going) $name
+		}
+	}
+}
+
+# The application should call here with the fragment name
+# to cause the display to go to this spot.
+# If the target exists, go there (and do the callback),
+# otherwise schedule the goto to happen when we see the reference.
+
+proc HMgoto {win where {callback HMwent_to}} {
+	upvar #0 HM$win var
+	if {[regexp N:$where [$win mark names]]} {
+		$win see N:$where
+		update
+		eval $callback $win [list $where]
+		return 1
+	} else {
+		set var(goto) $where
+		return 0
+	}
+}
+
+# We actually got to the spot, so highlight it!
+# This should/could be replaced by the application
+# We'll flash it orange a couple of times.
+
+proc HMwent_to {win where {count 0} {color orange}} {
+	upvar #0 HM$win var
+	if {$count > 5} return
+	catch {$win tag configure N:$where -foreground $color}
+	update
+	after 200 [list HMwent_to $win $where [incr count] \
+				[expr {$color=="orange" ? "" : "orange"}]]
+}
+
+proc HMtag_/a {win param text} {
+	upvar #0 HM$win var
+	if {[info exists var(Tref)]} {
+		unset var(Tref)
+		HMstack $win / "Tlink link"
+	}
+
+	# goto this link, then invoke the call-back.
+
+	if {[info exists var(going)]} {
+		$win yview N:$var(going)
+		update
+		HMwent_to $win $var(going)
+		unset var(going)
+	}
+
+	if {[info exists var(Tname)]} {
+		unset var(Tname)
+		HMstack $win / "Tanchor anchor"
+	}
+}
+
+#           Inline Images
+# This interface is subject to change
+# Most of the work is getting around a limitation of TK that prevents
+# setting the size of a label to a widthxheight in pixels
+#
+# Images have the following parameters:
+#    align:  top,middle,bottom
+#    alt:    alternate text
+#    ismap:  A clickable image map
+#    src:    The URL link
+# Netscape supports (and so do we)
+#    width:  A width hint (in pixels)
+#    height:  A height hint (in pixels)
+#    border: The size of the window border
+
+proc HMtag_img {win param text} {
+	upvar #0 HM$win var
+
+	# get alignment
+	array set align_map {top top    middle center    bottom bottom}
+	set align bottom		;# The spec isn't clear what the default should be
+	HMextract_param $param align
+	catch {set align $align_map([string tolower $align])}
+
+	# get alternate text
+	set alt "<image>"
+	HMextract_param $param alt
+	set alt [HMmap_esc $alt]
+
+	# get the border width
+	set border 1
+	HMextract_param $param border
+
+	# see if we have an image size hint
+	# If so, make a frame the "hint" size to put the label in
+	# otherwise just make the label
+	set item $win.$var(tags)
+	# catch {destroy $item}
+	if {[HMextract_param $param width] && [HMextract_param $param height]} {
+		frame $item -width $width -height $height
+		pack propagate $item 0
+		set label $item.label
+		label $label
+		pack $label -expand 1 -fill both
+	} else {
+		set label $item
+		label $label 
+	}
+
+	$label configure -relief ridge -fg orange -text $alt
+	catch {$label configure -bd $border}
+	$win window create $var(S_insert) -align $align -window $item -pady 2 -padx 2
+
+	# add in all the current tags (this is overkill)
+	set tags [HMcurrent_tags $win]
+	foreach tag $tags {
+		$win tag add $tag $item
+	}
+
+	# set imagemap callbacks
+	if {[HMextract_param $param ismap]} {
+		# regsub -all {[^L]*L:([^ ]*).*}  $tags {\1} link
+		set link [lindex $tags [lsearch -glob $tags L:*]]
+		regsub L: $link {} link
+		global HMevents
+		regsub -all {%} $link {%%} link2
+		foreach i [array names HMevents] {
+			bind $label <$i> "catch \{%W configure $HMevents($i)\}"
+		}
+		bind $label <1> "+HMlink_callback $win $link2?%x,%y"
+	} 
+
+	# now callback to the application
+	set src ""
+	HMextract_param $param src
+	HMset_image $win $label $src
+	return $label	;# used by the forms package for input_image types
+}
+
+# The app needs to supply one of these
+proc HMset_image {win handle src} {
+	HMgot_image $handle "can't get\n$src"
+}
+
+# When the image is available, the application should call back here.
+# If we have the image, put it in the label, otherwise display the error
+# message.  If we don't get a callback, the "alt" text remains.
+# if we have a clickable image, arrange for a callback
+
+proc HMgot_image {win image_error} {
+	# if we're in a frame turn on geometry propogation
+	if {[winfo name $win] == "label"} {
+		pack propagate [winfo parent $win] 1
+	}
+	if {[catch {$win configure -image $image_error}]} {
+		$win configure -image {}
+		$win configure -text $image_error
+	}
+}
+
+# Sample hypertext link callback routine - should be replaced by app
+# This proc is called once for each <A> tag.
+# Applications can overwrite this procedure, as required, or
+# replace the HMevents array
+#   win:   The name of the text widget to render into
+#   href:  The HREF link for this <a> tag.
+
+array set HMevents {
+	Enter	{-borderwidth 2 -relief raised }
+	Leave	{-borderwidth 2 -relief flat }
+	1		{-borderwidth 2 -relief sunken}
+	ButtonRelease-1	{-borderwidth 2 -relief raised}
+}
+
+# We need to escape any %'s in the href tag name so the bind command
+# doesn't try to substitute them.
+
+proc HMlink_setup {win href} {
+	global HMevents
+	regsub -all {%} $href {%%} href2
+	foreach i [array names HMevents] {
+		eval {$win tag bind  L:$href <$i>} \
+			\{$win tag configure \{L:$href2\} $HMevents($i)\}
+	}
+}
+
+# generic link-hit callback
+# This gets called upon button hits on hypertext links
+# Applications are expected to supply ther own HMlink_callback routine
+#   win:   The name of the text widget to render into
+#   x,y:   The cursor position at the "click"
+
+proc HMlink_hit {win x y} {
+	set tags [$win tag names @$x,$y]
+	set link [lindex $tags [lsearch -glob $tags L:*]]
+	# regsub -all {[^L]*L:([^ ]*).*}  $tags {\1} link
+	regsub L: $link {} link
+	HMlink_callback $win $link
+}
+
+# replace this!
+#   win:   The name of the text widget to render into
+#   href:  The HREF link for this <a> tag.
+
+proc HMlink_callback {win href} {
+	puts "Got hit on $win, link $href"
+}
+
+# extract a value from parameter list (this needs a re-do)
+# returns "1" if the keyword is found, "0" otherwise
+#   param:  A parameter list.  It should alredy have been processed to
+#           remove any entity references
+#   key:    The parameter name
+#   val:    The variable to put the value into (use key as default)
+
+proc HMextract_param {param key {val ""}} {
+
+	if {$val == ""} {
+		upvar $key result
+	} else {
+		upvar $val result
+	}
+    set ws "    \n\r"
+ 
+    # look for name=value combinations.  Either (') or (") are valid delimeters
+    if {
+      [regsub -nocase [format {.*%s[%s]*=[%s]*"([^"]*).*} $key $ws $ws] $param {\1} value] ||
+      [regsub -nocase [format {.*%s[%s]*=[%s]*'([^']*).*} $key $ws $ws] $param {\1} value] ||
+      [regsub -nocase [format {.*%s[%s]*=[%s]*([^%s]+).*} $key $ws $ws $ws] $param {\1} value] } {
+        set result $value
+        return 1
+    }
+
+	# now look for valueless names
+	# I should strip out name=value pairs, so we don't end up with "name"
+	# inside the "value" part of some other key word - some day
+	
+	set bad \[^a-zA-Z\]+
+	if {[regexp -nocase  "$bad$key$bad" -$param-]} {
+		return 1
+	} else {
+		return 0
+	}
+}
+
+# These next two routines manage the display state of the page.
+
+# Push or pop tags to/from stack.
+# Each orthogonal text property has its own stack, stored as a list.
+# The current (most recent) tag is the last item on the list.
+# Push is {} for pushing and {/} for popping
+
+proc HMstack {win push list} {
+	upvar #0 HM$win var
+	array set tags $list
+	if {$push == ""} {
+		foreach tag [array names tags] {
+			lappend var($tag) $tags($tag)
+		}
+	} else {
+		foreach tag [array names tags] {
+			# set cnt [regsub { *[^ ]+$} $var($tag) {} var($tag)]
+			set var($tag) [lreplace $var($tag) end end]
+		}
+	}
+}
+
+# extract set of current text tags
+# tags starting with T map directly to text tags, all others are
+# handled specially.  There is an application callback, HMset_font
+# to allow the application to do font error handling
+
+proc HMcurrent_tags {win} {
+	upvar #0 HM$win var
+	set font font
+	foreach i {family size weight style} {
+		set $i [lindex $var($i) end]
+		append font :[set $i]
+	}
+	set xfont [HMx_font $family $size $weight $style $var(S_adjust_size)]
+	HMset_font $win $font $xfont
+	set indent [llength $var(indent)]
+	incr indent -1
+	lappend tags $font indent$indent
+	foreach tag [array names var T*] {
+		lappend tags [lindex $var($tag) end]	;# test
+	}
+	set var(font) $font
+	set var(xfont) [$win tag cget $font -font]
+	set var(level) $indent
+	return $tags
+}
+
+# allow the application to do do better font management
+# by overriding this procedure
+
+proc HMset_font {win tag font} {
+	catch {$win tag configure $tag -font $font} msg
+}
+
+# generate an X font name
+proc HMx_font {family size weight style {adjust_size 0}} {
+	catch {incr size $adjust_size}
+	return "-*-$family-$weight-$style-normal-*-*-${size}0-*-*-*-*-*-*"
+}
+
+# Optimize HMrender (hee hee)
+# This is experimental
+
+proc HMoptimize {} {
+	regsub -all "\n\[ 	\]*#\[^\n\]*" [info body HMrender] {} body
+	regsub -all ";\[ 	\]*#\[^\n]*" $body {} body
+	regsub -all "\n\n+" $body \n body
+	proc HMrender {win tag not param text} $body
+}
+############################################
+# Turn HTML into TCL commands
+#   html    A string containing an html document
+#   cmd		A command to run for each html tag found
+#   start	The name of the dummy html start/stop tags
+
+proc HMparse_html {html {cmd HMtest_parse} {start hmstart}} {
+	regsub -all \{ $html {\&ob;} html
+	regsub -all \} $html {\&cb;} html
+	set w " \t\r\n"	;# white space
+	proc HMcl x {return "\[$x\]"}
+	set exp <(/?)([HMcl ^$w>]+)[HMcl $w]*([HMcl ^>]*)>
+	set sub "\}\n$cmd {\\2} {\\1} {\\3} \{"
+	regsub -all $exp $html $sub html
+	eval "$cmd {$start} {} {} \{ $html \}"
+	eval "$cmd {$start} / {} {}"
+}
+
+proc HMtest_parse {command tag slash text_after_tag} {
+	puts "==> $command $tag $slash $text_after_tag"
+}
+
+# Convert multiple white space into a single space
+
+proc HMzap_white {data} {
+	regsub -all "\[ \t\r\n\]+" $data " " data
+	return $data
+}
+
+# find HTML escape characters of the form &xxx;
+
+proc HMmap_esc {text} {
+	if {![regexp & $text]} {return $text}
+	regsub -all {([][$\\])} $text {\\\1} new
+	regsub -all {&#([0-9][0-9]?[0-9]?);?} \
+		$new {[format %c [scan \1 %d tmp;set tmp]]} new
+	regsub -all {&([a-zA-Z]+);?} $new {[HMdo_map \1]} new
+	return [subst $new]
+}
+
+# convert an HTML escape sequence into character
+
+proc HMdo_map {text {unknown ?}} {
+	global HMesc_map
+	set result $unknown
+	catch {set result $HMesc_map($text)}
+	return $result
+}
+
+# table of escape characters (ISO latin-1 esc's are in a different table)
+
+array set HMesc_map {
+   lt <   gt >   amp &   quot \"   copy \xa9
+   reg \xae   ob \x7b   cb \x7d   nbsp \xa0
+}
+#############################################################
+# ISO Latin-1 escape codes
+
+array set HMesc_map {
+	nbsp \xa0 iexcl \xa1 cent \xa2 pound \xa3 curren \xa4
+	yen \xa5 brvbar \xa6 sect \xa7 uml \xa8 copy \xa9
+	ordf \xaa laquo \xab not \xac shy \xad reg \xae
+	hibar \xaf deg \xb0 plusmn \xb1 sup2 \xb2 sup3 \xb3
+	acute \xb4 micro \xb5 para \xb6 middot \xb7 cedil \xb8
+	sup1 \xb9 ordm \xba raquo \xbb frac14 \xbc frac12 \xbd
+	frac34 \xbe iquest \xbf Agrave \xc0 Aacute \xc1 Acirc \xc2
+	Atilde \xc3 Auml \xc4 Aring \xc5 AElig \xc6 Ccedil \xc7
+	Egrave \xc8 Eacute \xc9 Ecirc \xca Euml \xcb Igrave \xcc
+	Iacute \xcd Icirc \xce Iuml \xcf ETH \xd0 Ntilde \xd1
+	Ograve \xd2 Oacute \xd3 Ocirc \xd4 Otilde \xd5 Ouml \xd6
+	times \xd7 Oslash \xd8 Ugrave \xd9 Uacute \xda Ucirc \xdb
+	Uuml \xdc Yacute \xdd THORN \xde szlig \xdf agrave \xe0
+	aacute \xe1 acirc \xe2 atilde \xe3 auml \xe4 aring \xe5
+	aelig \xe6 ccedil \xe7 egrave \xe8 eacute \xe9 ecirc \xea
+	euml \xeb igrave \xec iacute \xed icirc \xee iuml \xef
+	eth \xf0 ntilde \xf1 ograve \xf2 oacute \xf3 ocirc \xf4
+	otilde \xf5 ouml \xf6 divide \xf7 oslash \xf8 ugrave \xf9
+	uacute \xfa ucirc \xfb uuml \xfc yacute \xfd thorn \xfe
+	yuml \xff
+}
+
+##########################################################
+# html forms management commands
+
+# As each form element is located, it is created and rendered.  Additional
+# state is stored in a form specific global variable to be processed at
+# the end of the form, including the "reset" and "submit" options.
+# Remember, there can be multiple forms existing on multiple pages.  When
+# HTML tables are added, a single form could be spread out over multiple
+# text widgets, which makes it impractical to hang the form state off the
+# HM$win structure.  We don't need to check for the existance of required
+# parameters, we just "fail" and get caught in HMrender
+
+# This causes line breaks to be preserved in the inital values
+# of text areas
+array set HMtag_map {
+	textarea    {fill 0}
+}
+
+##########################################################
+# html isindex tag.  Although not strictly forms, they're close enough
+# to be in this file
+
+# is-index forms
+# make a frame with a label, entry, and submit button
+
+proc HMtag_isindex {win param text} {
+	upvar #0 HM$win var
+
+	set item $win.$var(tags)
+	if {[winfo exists $item]} {
+		destroy $item
+	}
+	frame $item -relief ridge -bd 3
+	set prompt "Enter search keywords here"
+	HMextract_param $param prompt
+	label $item.label -text [HMmap_esc $prompt] -font $var(xfont)
+	entry $item.entry
+	bind $item.entry <Return> "$item.submit invoke"
+	button $item.submit -text search -font $var(xfont) -command \
+		[format {HMsubmit_index %s {%s} [HMmap_reply [%s get]]} \
+		$win $param $item.entry]
+	pack $item.label -side top
+	pack $item.entry $item.submit -side left
+
+	# insert window into text widget
+
+	$win insert $var(S_insert) \n isindex
+	HMwin_install $win $item
+	$win insert $var(S_insert) \n isindex
+	bind $item <Visibility> {focus %W.entry}
+}
+
+# This is called when the isindex form is submitted.
+# The default version calls HMlink_callback.  Isindex tags should either
+# be deprecated, or fully supported (e.g. they need an href parameter)
+
+proc HMsubmit_index {win param text} {
+	HMlink_callback $win ?$text
+}
+
+# initialize form state.  All of the state for this form is kept
+# in a global array whose name is stored in the form_id field of
+# the main window array.
+# Parameters: ACTION, METHOD, ENCTYPE
+
+proc HMtag_form {win param text} {
+	upvar #0 HM$win var
+
+	# create a global array for the form
+	set id HM$win.form$var(tags)
+	upvar #0 $id form
+
+	# missing /form tag, simulate it
+	if {[info exists var(form_id)]} {
+		puts "Missing end-form tag !!!! $var(form_id)"
+		HMtag_/form $win {} {}
+	}
+	catch {unset form}
+	set var(form_id) $id
+
+	set form(param) $param		;# form initial parameter list
+	set form(reset) ""			;# command to reset the form
+	set form(reset_button) ""	;# list of all reset buttons
+	set form(submit) ""			;# command to submit the form
+	set form(submit_button) ""	;# list of all submit buttons
+}
+
+# Where we're done try to get all of the state into the widgets so
+# we can free up the form structure here.  Unfortunately, we can't!
+
+proc HMtag_/form {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	# make submit button entries for all radio buttons
+	foreach name [array names form radio_*] {
+		regsub radio_ $name {} name
+		lappend form(submit) [list $name \$form(radio_$name)]
+	}
+
+	# no submit button - add one
+	if {$form(submit_button) == ""} {
+		HMinput_submit $win {}
+				
+	}
+	
+	# process the "submit" command(s)
+	# each submit button could have its own name,value pair
+
+	foreach item $form(submit_button) {
+		set submit $form(submit)
+		catch {lappend submit $form(submit_$item)}
+		$item configure -command  \
+				[list HMsubmit_button $win $var(form_id) $form(param) \
+				$submit]
+	}
+
+	# process the reset button(s)
+	HMinput_reset $win {}
+	foreach item $form(reset_button) {
+		$item configure -command $form(reset)
+	}
+
+	# unset all unused fields here
+	unset form(reset) form(submit) form(reset_button) form(submit_button)
+	unset var(form_id)
+}
+
+###################################################################
+# handle form input items
+# each item type is handled in a separate procedure
+# Each "type" procedure needs to:
+# - create the window
+# - initialize it
+# - add the "submit" and "reset" commands onto the proper Q's
+#   "submit" is subst'd
+#   "reset" is eval'd
+
+proc HMtag_input {win param text} {
+	upvar #0 HM$win var
+
+	set type text	;# the default
+	HMextract_param $param type
+	set type [string tolower $type]
+	if {[catch {HMinput_$type $win $param} err]} {
+		puts stderr $err
+	}
+}
+
+# input type=text
+# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE
+
+proc HMinput_text {win param {show {}}} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	# make the entry
+	HMextract_param $param name		;# required
+	set item $win.input_text,$var(tags)
+	set size 20; HMextract_param $param size
+	set maxlength 0; HMextract_param $param maxlength
+	entry $item -width $size -show $show
+
+	# set the initial value
+	set value ""; HMextract_param $param value
+	$item insert 0 $value
+		
+	# insert the entry
+	HMwin_install $win $item
+
+	# set the "reset" and "submit" commands
+	append form(reset) ";$item delete 0 end;$item insert 0 [list $value]"
+	lappend form(submit) [list $name "\[$item get]"]
+
+	# handle the maximum length (broken - no way to cleanup bindtags state)
+	if {$maxlength} {
+		bindtags $item "[bindtags $item] max$maxlength"
+		bind max$maxlength <KeyPress> "%W delete $maxlength end"
+	}
+}
+
+# password fields - same as text, only don't show data
+# parameters NAME (reqd), MAXLENGTH, SIZE, VALUE
+
+proc HMinput_password {win param} {
+	HMinput_text $win $param *
+}
+
+# checkbuttons are missing a "get" option, so we must use a global
+# variable to store the value.
+# Parameters NAME, VALUE, (reqd), CHECKED
+
+proc HMinput_checkbox {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	HMextract_param $param name
+	HMextract_param $param value
+
+	# Set the global variable, don't use the "form" alias as it is not
+	# defined in the global scope of the button
+	set variable $var(form_id)(check_$var(tags))	
+	set item $win.input_checkbutton,$var(tags)
+	checkbutton $item -variable $variable -off {} -on $value -text "  "
+	if {[HMextract_param $param checked]} {
+		$item select
+		append form(reset) ";$item select"
+	} else {
+		append form(reset) ";$item deselect"
+	}
+
+	HMwin_install $win $item
+	lappend form(submit) [list $name \$form(check_$var(tags))]
+}
+
+# radio buttons.  These are like check buttons, but only one can be selected
+
+proc HMinput_radio {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	HMextract_param $param name
+	HMextract_param $param value
+
+	set first [expr ![info exists form(radio_$name)]]
+	set variable $var(form_id)(radio_$name)
+	set variable $var(form_id)(radio_$name)
+	set item $win.input_radiobutton,$var(tags)
+	radiobutton $item -variable $variable -value $value -text " "
+
+	HMwin_install $win $item
+
+	if {$first || [HMextract_param $param checked]} {
+		$item select
+		append form(reset) ";$item select"
+	} else {
+		append form(reset) ";$item deselect"
+	}
+
+	# do the "submit" actions in /form so we only end up with 1 per button grouping
+	# contributing to the submission
+}
+
+# hidden fields, just append to the "submit" data
+# params: NAME, VALUE (reqd)
+
+proc HMinput_hidden {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	HMextract_param $param name
+	HMextract_param $param value
+	lappend form(submit) [list $name $value]
+}
+
+# handle input images.  The spec isn't very clear on these, so I'm not
+# sure its quite right
+# Use std image tag, only set up our own callbacks
+#  (e.g. make sure ismap isn't set)
+# params: NAME, SRC (reqd) ALIGN
+
+proc HMinput_image {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	HMextract_param $param name
+	set name		;# barf if no name is specified
+	set item [HMtag_img $win $param {}]
+	$item configure -relief raised -bd 2 -bg blue
+
+	# make a dummy "submit" button, and invoke it to send the form.
+	# We have to get the %x,%y in the value somehow, so calculate it during
+	# binding, and save it in the form array for later processing
+
+	set submit $win.dummy_submit,$var(tags)
+	if {[winfo exists $submit]} {
+		destroy $submit
+	}
+	button $submit	-takefocus 0;# this never gets mapped!
+	lappend form(submit_button) $submit
+	set form(submit_$submit) [list $name $name.\$form(X).\$form(Y)]
+	
+	$item configure -takefocus 1
+	bind $item <FocusIn> "catch \{$win see $item\}"
+	bind $item <1> "$item configure -relief sunken"
+	bind $item <Return> "
+		set $var(form_id)(X) 0
+		set $var(form_id)(Y) 0
+		$submit invoke	
+	"
+	bind $item <ButtonRelease-1> "
+		set $var(form_id)(X) %x
+		set $var(form_id)(Y) %y
+		$item configure -relief raised
+		$submit invoke	
+	"
+}
+
+# Set up the reset button.  Wait for the /form to attach
+# the -command option.  There could be more that 1 reset button
+# params VALUE
+
+proc HMinput_reset {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	set value reset
+	HMextract_param $param value
+
+	set item $win.input_reset,$var(tags)
+	button $item -text [HMmap_esc $value] -cursor left_ptr
+	HMwin_install $win $item
+	lappend form(reset_button) $item
+}
+
+# Set up the submit button.  Wait for the /form to attach
+# the -command option.  There could be more that 1 submit button
+# params: NAME, VALUE
+
+proc HMinput_submit {win param} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	HMextract_param $param name
+	set value submit
+	HMextract_param $param value
+	set item $win.input_submit,$var(tags)
+	button $item -text [HMmap_esc $value] -fg blue -cursor left_ptr
+	HMwin_install $win $item
+	lappend form(submit_button) $item
+	# need to tie the "name=value" to this button
+	# save the pair and do it when we finish the submit button
+	catch {set form(submit_$item) [list $name $value]}
+}
+
+#########################################################################
+# selection items
+# They all go into a list box.  We don't what to do with the listbox until
+# we know how many items end up in it.  Gather up the data for the "options"
+# and finish up in the /select tag
+# params: NAME (reqd), MULTIPLE, SIZE 
+
+proc HMtag_select {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+
+	HMextract_param $param name
+	set size 5;  HMextract_param $param size
+	set form(select_size) $size
+	set form(select_name) $name
+	set form(select_values) ""		;# list of values to submit
+	if {[HMextract_param $param multiple]} {
+		set mode multiple
+	} else {
+		set mode single
+	}
+	set item $win.select,$var(tags)
+    frame $item
+    set form(select_frame) $item
+	listbox $item.list -selectmode $mode -width 0 -exportselection 0 -cursor left_ptr
+	HMwin_install $win $item
+}
+
+# select options
+# The values returned in the query may be different from those
+# displayed in the listbox, so we need to keep a separate list of
+# query values.
+#  form(select_default) - contains the default query value
+#  form(select_frame) - name of the listbox's containing frame
+#  form(select_values)  - list of query values
+# params: VALUE, SELECTED
+
+proc HMtag_option {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	upvar $text data
+	set frame $form(select_frame)
+
+	# set default option (or options)
+	if {[HMextract_param $param selected]} {
+        lappend form(select_default) [$form(select_frame).list size]
+    }
+    set value [string trimright $data " \n"]
+    $frame.list insert end $value
+	HMextract_param $param value
+	lappend form(select_values) $value
+	set data ""
+}
+ 
+# do most of the work here!
+# if SIZE>1, make the listbox.  Otherwise make a "drop-down"
+# listbox with a label in it
+# If the # of items > size, add a scroll bar
+# This should probably be broken up into callbacks to make it
+# easier to override the "look".
+
+proc HMtag_/select {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	set frame $form(select_frame)
+	set size $form(select_size)
+	set items [$frame.list size]
+
+	# set the defaults and reset button
+	append form(reset) ";$frame.list selection clear 0  $items"
+	if {[info exists form(select_default)]} {
+		foreach i $form(select_default) {
+			$frame.list selection set $i
+			append form(reset) ";$frame.list selection set $i"
+		}
+	} else {
+		$frame.list selection set 0
+		append form(reset) ";$frame.list selection set 0"
+	}
+
+	# set up the submit button. This is the general case.  For single
+	# selections we could be smarter
+
+	for {set i 0} {$i < $size} {incr i} {
+		set value [format {[expr {[%s selection includes %s] ? {%s} : {}}]} \
+				$frame.list $i [lindex $form(select_values) $i]]
+		lappend form(submit) [list $form(select_name) $value]
+	}
+	
+	# show the listbox - no scroll bar
+
+	if {$size > 1 && $items <= $size} {
+		$frame.list configure -height $items
+		pack $frame.list
+
+	# Listbox with scrollbar
+
+	} elseif {$size > 1} {
+		scrollbar $frame.scroll -command "$frame.list yview"  \
+				-orient v -takefocus 0
+		$frame.list configure -height $size \
+			-yscrollcommand "$frame.scroll set"
+		pack $frame.list $frame.scroll -side right -fill y
+
+	# This is a joke!
+
+	} else {
+		scrollbar $frame.scroll -command "$frame.list yview"  \
+			-orient h -takefocus 0
+		$frame.list configure -height 1 \
+			-yscrollcommand "$frame.scroll set"
+		pack $frame.list $frame.scroll -side top -fill x
+	}
+
+	# cleanup
+
+	foreach i [array names form select_*] {
+		unset form($i)
+	}
+}
+
+# do a text area (multi-line text)
+# params: COLS, NAME, ROWS (all reqd, but default rows and cols anyway)
+
+proc HMtag_textarea {win param text} {
+	upvar #0 HM$win var
+	upvar #0 $var(form_id) form
+	upvar $text data
+
+	set rows 5; HMextract_param $param rows
+	set cols 30; HMextract_param $param cols
+	HMextract_param $param name
+	set item $win.textarea,$var(tags)
+	frame $item
+	text $item.text -width $cols -height $rows -wrap none \
+			-yscrollcommand "$item.scroll set" -padx 3 -pady 3
+	scrollbar $item.scroll -command "$item.text yview"  -orient v
+	$item.text insert 1.0 $data
+	HMwin_install $win $item
+	pack $item.text $item.scroll -side right -fill y
+	lappend form(submit) [list $name "\[$item.text get 0.0 end]"]
+	append form(reset) ";$item.text delete 1.0 end; \
+			$item.text insert 1.0 [list $data]"
+	set data ""
+}
+
+# procedure to install windows into the text widget
+# - win:  name of the text widget
+# - item: name of widget to install
+
+proc HMwin_install {win item} {
+	upvar #0 HM$win var
+	$win window create $var(S_insert) -window $item -align bottom
+	$win tag add indent$var(level) $item
+	set focus [expr {[winfo class $item] != "Frame"}]
+	$item configure -takefocus $focus
+	bind $item <FocusIn> "$win see $item"
+}
+
+#####################################################################
+# Assemble and submit the query
+# each list element in "stuff" is a name/value pair
+# - The names are the NAME parameters of the various fields
+# - The values get run through "subst" to extract the values
+# - We do the user callback with the list of name value pairs
+
+proc HMsubmit_button {win form_id param stuff} {
+	upvar #0 HM$win var
+	upvar #0 $form_id form
+	set query ""
+	foreach pair $stuff {
+		set value [subst [lindex $pair 1]]
+		#if {$value != ""} {
+			set item [lindex $pair 0]
+			lappend query $item $value
+		#}
+	}
+	# this is the user callback.
+	HMsubmit_form $win $param $query
+}
+
+# sample user callback for form submission
+# should be replaced by the application
+# Sample version generates a string suitable for http
+
+proc HMsubmit_form {win param query} {
+	set result ""
+	set sep ""
+	foreach i $query {
+		append result  $sep [HMmap_reply $i]
+		if {$sep != "="} {set sep =} {set sep &}
+	}
+	puts $result
+}
+
+# do x-www-urlencoded character mapping
+# The spec says: "non-alphanumeric characters are replaced by '%HH'"
+ 
+set HMalphanumeric	a-zA-Z0-9	;# definition of alphanumeric character class
+for {set i 1} {$i <= 256} {incr i} {
+    set c [format %c $i]
+    if {![string match \[$HMalphanumeric\] $c]} {
+        set HMform_map($c) %[format %.2x $i]
+    }
+}
+
+# These are handled specially
+array set HMform_map {
+    " " +   \n %0d%0a
+}
+
+# 1 leave alphanumerics characters alone
+# 2 Convert every other character to an array lookup
+# 3 Escape constructs that are "special" to the tcl parser
+# 4 "subst" the result, doing all the array substitutions
+ 
+proc HMmap_reply {string} {
+    global HMform_map HMalphanumeric
+    regsub -all \[^$HMalphanumeric\] $string {$HMform_map(&)} string
+    regsub -all \n $string {\\n} string
+    regsub -all \t $string {\\t} string
+    regsub -all {[][{})\\]\)} $string {\\&} string
+    return [subst $string]
+}
+
+# convert a x-www-urlencoded string int a a list of name/value pairs
+
+# 1  convert a=b&c=d... to {a} {b} {c} {d}...
+# 2, convert + to  " "
+# 3, convert %xx to char equiv
+
+proc HMcgiDecode {data} {
+	set data [split $data "&="]
+	foreach i $data {
+		lappend result [cgiMap $i]
+	}
+	return $result
+}
+
+proc HMcgiMap {data} {
+	regsub -all {\+} $data " " data
+	
+	if {[regexp % $data]} {
+		regsub -all {([][$\\])} $data {\\\1} data
+		regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data  {[format %c 0x\1]} data
+		return [subst $data]
+	} else {
+		return $data
+	}
+}
+
+# There is a bug in the tcl library focus routines that prevents focus
+# from every reaching an un-viewable window.  Use our *own*
+# version of the library routine, until the bug is fixed, make sure we
+# over-ride the library version, and not the otherway around
+
+auto_load tkFocusOK
+proc tkFocusOK w {
+    set code [catch {$w cget -takefocus} value]
+    if {($code == 0) && ($value != "")} {
+    if {$value == 0} {
+        return 0
+    } elseif {$value == 1} {
+        return 1
+    } else {
+        set value [uplevel #0 $value $w]
+        if {$value != ""} {
+        return $value
+        }
+    }
+    }
+    set code [catch {$w cget -state} value]
+    if {($code == 0) && ($value == "disabled")} {
+    return 0
+    }
+    regexp Key|Focus "[bind $w] [bind [winfo class $w]]"
+}

Deleted: grass/trunk/lib/form/license.terms
===================================================================
--- grass/trunk/lib/form/license.terms	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/license.terms	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,31 +0,0 @@
-Sun Microsystems, Inc.  The following terms apply to all files
-associated with the software unless explicitly disclaimed in individual
-files.
-
-The authors hereby grant permission to use, copy, modify, distribute,
-and license this software and its documentation for any purpose, provided
-that existing copyright notices are retained in all copies and that this
-notice is included verbatim in any distributions. No written agreement,
-license, or royalty fee is required for any of the authorized uses.
-Modifications to this software may be copyrighted by their authors
-and need not follow the licensing terms described here, provided that
-the new terms are clearly indicated on the first page of each file where
-they apply.
-
-IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
-FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
-ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
-DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGE.
-
-THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
-IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
-NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
-MODIFICATIONS.
-
-RESTRICTED RIGHTS: Use, duplication or disclosure by the government
-is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
-of the Rights in Technical Data and Computer Software Clause as DFARS
-252.227-7013 and FAR 52.227-19.

Copied: grass/trunk/lib/form/license.terms (from rev 35193, grass/trunk/lib/form/license.terms)
===================================================================
--- grass/trunk/lib/form/license.terms	                        (rev 0)
+++ grass/trunk/lib/form/license.terms	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,31 @@
+Sun Microsystems, Inc.  The following terms apply to all files
+associated with the software unless explicitly disclaimed in individual
+files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+RESTRICTED RIGHTS: Use, duplication or disclosure by the government
+is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
+of the Rights in Technical Data and Computer Software Clause as DFARS
+252.227-7013 and FAR 52.227-19.

Deleted: grass/trunk/lib/form/open.c
===================================================================
--- grass/trunk/lib/form/open.c	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/open.c	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,203 +0,0 @@
-#include <stdlib.h>
-#include <string.h>
-#include <unistd.h>
-#include <fcntl.h>
-#include <grass/gis.h>
-#include <grass/dbmi.h>
-#include <grass/form.h>
-
-#ifdef HAVE_SOCKET
-#include <sys/types.h>
-#ifdef __MINGW32__
-#include <winsock.h>
-
-#else /*__MINGW32__*/
-#include <sys/socket.h>
-#include <netinet/in.h>
-
-#endif /*__MINGW32__*/
-#endif /*HAVE_SOCKET */
-
-#ifdef HAVE_SOCKET
-static int make_socketpair(int *);
-#endif
-
-int first = 1;
-
-/* the pipe to send data to GUI */
-FILE *parent_send, *parent_recv;
-
-#ifdef HAVE_SOCKET
-int pipefd[2];
-
-#define	pfd	pipefd[1]	/* parent's end */
-#define	cfd	pipefd[0]	/* child's end */
-
-#endif /*HAVE_SOCKET */
-
-/* Open new form
- *
- *  returns: 0 success
- */
-#ifdef __MINGW32__
-int F_open(char *title, char *html)
-{
-    G_fatal_error("F_open is not supported on Windows");
-    return 1;
-}
-#else
-int F_open(char *title, char *html)
-{
-    /* parent */
-    int c;
-
-    /* common */
-    static int pid;
-
-#ifndef HAVE_SOCKET
-    static int p1[2], p2[2];
-#endif /*HAVE_SOCKET */
-    int length;
-
-    /* child */
-
-    G_debug(2, "F_open(): title = %s", title);
-
-    if (first) {
-#ifdef HAVE_SOCKET
-	if (make_socketpair(pipefd) < 0)
-	    G_fatal_error("Cannot make socket pair");
-#else
-	if (pipe(p1) < 0 || pipe(p2) < 0)
-	    G_fatal_error("Cannot open pipe");
-#endif /*HAVE_SOCKET */
-
-	if ((pid = fork()) < 0)
-	    G_fatal_error("Cannot create fork");
-    }
-
-    if (pid == 0) {		/* Child */
-	char command[2000], script[2000];
-
-	G_debug(2, "CHILD");
-
-	/* Note: If you are forking in a Tk based apllication  you
-	 *       must  execl  before  doing any window operations in the
-	 *       child or you will receive an error from the  X server */
-
-	close(0);
-	close(1);
-
-#ifndef HAVE_SOCKET
-	close(p1[1]);
-	close(p2[0]);
-	if (dup(p1[0]) != 0)
-	    G_fatal_error("Form: cannot dup() input");
-	if (dup(p2[1]) != 1)
-	    G_fatal_error("Form: cannot dup() output");
-
-#else
-	close(pfd);
-	if (dup(cfd) != 0)
-	    G_fatal_error("Form: cannot dup() input");
-	if (dup(cfd) != 1)
-	    G_fatal_error("Form: cannot dup() output");
-
-#endif /*HAVE_SOCKET */
-
-
-
-	sprintf(command, "%s/etc/form/form", G_gisbase());
-	sprintf(script, "%s/etc/form/form.tcl", G_gisbase());
-
-	execl(command, "form", "-f", script, NULL);
-
-	G_debug(2, "CHILD END\n");
-	exit(0);
-
-    }
-    else {			/* Parent */
-	G_debug(2, "PARENT");
-
-	if (first) {
-#ifndef HAVE_SOCKET
-	    parent_send = fdopen(p1[1], "w");
-	    close(p1[0]);
-	    parent_recv = fdopen(p2[0], "r");
-	    close(p2[1]);
-#else
-	    close(cfd);
-	    parent_send = fdopen(pfd, "w");
-	    parent_recv = fdopen(pfd, "r");
-#endif /*HAVE_SOCKET */
-	    first = 0;
-	}
-
-	G_debug(2, "PARENT HTML:\n%s\n", html);
-
-	fprintf(parent_send, "O");
-	length = strlen(title);
-	fprintf(parent_send, "%d\n", length);
-	fprintf(parent_send, "%s", title);
-	length = strlen(html);
-	fprintf(parent_send, "%d\n", length);
-	fprintf(parent_send, "%s", html);
-	fflush(parent_send);
-	G_debug(2, "PARENT: Request sent\n");
-
-	/* Wait for response */
-	c = fgetc(parent_recv);
-	G_debug(2, "PARENT: received %c\n", c);
-    }
-
-    return 0;
-}
-#endif
-
-/* Clear old forms from window
- *
- */
-void F_clear(void)
-{
-    char c;
-
-    G_debug(2, "F_clear()");
-
-    if (first)
-	return;
-
-    fprintf(parent_send, "C");
-    fflush(parent_send);
-    c = fgetc(parent_recv);
-    G_debug(2, "PARENT: received %c\n", c);
-}
-
-void F_close(void)
-{
-    char c;
-
-    G_debug(2, "F_close()");
-
-    if (first)
-	return;
-
-    fprintf(parent_send, "D");
-    fflush(parent_send);
-    c = fgetc(parent_recv);
-    G_debug(2, "PARENT: received %c\n", c);
-
-    first = 1;
-}
-
-#ifdef HAVE_SOCKET
-static int make_socketpair(int *fd)
-{
-    int n;
-
-    if ((n = socketpair(AF_UNIX, SOCK_STREAM, IPPROTO_IP, fd)) < 0)
-	return -1;
-    else
-	return 0;
-}
-
-#endif

Copied: grass/trunk/lib/form/open.c (from rev 35193, grass/trunk/lib/form/open.c)
===================================================================
--- grass/trunk/lib/form/open.c	                        (rev 0)
+++ grass/trunk/lib/form/open.c	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,203 @@
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <grass/gis.h>
+#include <grass/dbmi.h>
+#include <grass/form.h>
+
+#ifdef HAVE_SOCKET
+#include <sys/types.h>
+#ifdef __MINGW32__
+#include <winsock.h>
+
+#else /*__MINGW32__*/
+#include <sys/socket.h>
+#include <netinet/in.h>
+
+#endif /*__MINGW32__*/
+#endif /*HAVE_SOCKET */
+
+#ifdef HAVE_SOCKET
+static int make_socketpair(int *);
+#endif
+
+int first = 1;
+
+/* the pipe to send data to GUI */
+FILE *parent_send, *parent_recv;
+
+#ifdef HAVE_SOCKET
+int pipefd[2];
+
+#define	pfd	pipefd[1]	/* parent's end */
+#define	cfd	pipefd[0]	/* child's end */
+
+#endif /*HAVE_SOCKET */
+
+/* Open new form
+ *
+ *  returns: 0 success
+ */
+#ifdef __MINGW32__
+int F_open(char *title, char *html)
+{
+    G_fatal_error("F_open is not supported on Windows");
+    return 1;
+}
+#else
+int F_open(char *title, char *html)
+{
+    /* parent */
+    int c;
+
+    /* common */
+    static int pid;
+
+#ifndef HAVE_SOCKET
+    static int p1[2], p2[2];
+#endif /*HAVE_SOCKET */
+    int length;
+
+    /* child */
+
+    G_debug(2, "F_open(): title = %s", title);
+
+    if (first) {
+#ifdef HAVE_SOCKET
+	if (make_socketpair(pipefd) < 0)
+	    G_fatal_error("Cannot make socket pair");
+#else
+	if (pipe(p1) < 0 || pipe(p2) < 0)
+	    G_fatal_error("Cannot open pipe");
+#endif /*HAVE_SOCKET */
+
+	if ((pid = fork()) < 0)
+	    G_fatal_error("Cannot create fork");
+    }
+
+    if (pid == 0) {		/* Child */
+	char command[2000], script[2000];
+
+	G_debug(2, "CHILD");
+
+	/* Note: If you are forking in a Tk based apllication  you
+	 *       must  execl  before  doing any window operations in the
+	 *       child or you will receive an error from the  X server */
+
+	close(0);
+	close(1);
+
+#ifndef HAVE_SOCKET
+	close(p1[1]);
+	close(p2[0]);
+	if (dup(p1[0]) != 0)
+	    G_fatal_error("Form: cannot dup() input");
+	if (dup(p2[1]) != 1)
+	    G_fatal_error("Form: cannot dup() output");
+
+#else
+	close(pfd);
+	if (dup(cfd) != 0)
+	    G_fatal_error("Form: cannot dup() input");
+	if (dup(cfd) != 1)
+	    G_fatal_error("Form: cannot dup() output");
+
+#endif /*HAVE_SOCKET */
+
+
+
+	sprintf(command, "%s/etc/form/form", G_gisbase());
+	sprintf(script, "%s/etc/form/form.tcl", G_gisbase());
+
+	execl(command, "form", "-f", script, NULL);
+
+	G_debug(2, "CHILD END\n");
+	exit(0);
+
+    }
+    else {			/* Parent */
+	G_debug(2, "PARENT");
+
+	if (first) {
+#ifndef HAVE_SOCKET
+	    parent_send = fdopen(p1[1], "w");
+	    close(p1[0]);
+	    parent_recv = fdopen(p2[0], "r");
+	    close(p2[1]);
+#else
+	    close(cfd);
+	    parent_send = fdopen(pfd, "w");
+	    parent_recv = fdopen(pfd, "r");
+#endif /*HAVE_SOCKET */
+	    first = 0;
+	}
+
+	G_debug(2, "PARENT HTML:\n%s\n", html);
+
+	fprintf(parent_send, "O");
+	length = strlen(title);
+	fprintf(parent_send, "%d\n", length);
+	fprintf(parent_send, "%s", title);
+	length = strlen(html);
+	fprintf(parent_send, "%d\n", length);
+	fprintf(parent_send, "%s", html);
+	fflush(parent_send);
+	G_debug(2, "PARENT: Request sent\n");
+
+	/* Wait for response */
+	c = fgetc(parent_recv);
+	G_debug(2, "PARENT: received %c\n", c);
+    }
+
+    return 0;
+}
+#endif
+
+/* Clear old forms from window
+ *
+ */
+void F_clear(void)
+{
+    char c;
+
+    G_debug(2, "F_clear()");
+
+    if (first)
+	return;
+
+    fprintf(parent_send, "C");
+    fflush(parent_send);
+    c = fgetc(parent_recv);
+    G_debug(2, "PARENT: received %c\n", c);
+}
+
+void F_close(void)
+{
+    char c;
+
+    G_debug(2, "F_close()");
+
+    if (first)
+	return;
+
+    fprintf(parent_send, "D");
+    fflush(parent_send);
+    c = fgetc(parent_recv);
+    G_debug(2, "PARENT: received %c\n", c);
+
+    first = 1;
+}
+
+#ifdef HAVE_SOCKET
+static int make_socketpair(int *fd)
+{
+    int n;
+
+    if ((n = socketpair(AF_UNIX, SOCK_STREAM, IPPROTO_IP, fd)) < 0)
+	return -1;
+    else
+	return 0;
+}
+
+#endif

Deleted: grass/trunk/lib/form/todo
===================================================================
--- grass/trunk/lib/form/todo	2009-01-04 14:37:12 UTC (rev 35193)
+++ grass/trunk/lib/form/todo	2009-01-04 15:47:39 UTC (rev 35199)
@@ -1,3 +0,0 @@
-Support special characters:
-< > " & 
-in form entries.

Copied: grass/trunk/lib/form/todo (from rev 35193, grass/trunk/lib/form/todo)
===================================================================
--- grass/trunk/lib/form/todo	                        (rev 0)
+++ grass/trunk/lib/form/todo	2009-01-04 15:47:39 UTC (rev 35199)
@@ -0,0 +1,3 @@
+Support special characters:
+< > " & 
+in form entries.



More information about the grass-commit mailing list