[GRASS-dev] v.digit: Could not set Tcl system encoding fixed
(bug #4110)
Glynn Clements
glynn at gclements.plus.com
Sat Feb 10 09:59:04 EST 2007
Markus Neteler wrote:
> > I'm pretty sure that the problem is that lib/form/form.c doesn't call
> > Tcl_Main(), so the library path doesn't get set, so Tcl can't find its
> > .enc files.
> >
> > Realistically, if you are trying to use Tcl/Tk and your program
> > *doesn't* look very much like tkAppInit.c, all bets are off.
> >
> > Rather than trying to process the data from the form library in C,
> > form.c should just register the commands then do the rest in Tcl.
>
> Since I know nothing about tcl, I'll leave that to the experts. AFAIK
> form.c was
> originally written by Radim.
The attached patch appears to work, insofar as v.digit appears to work
as before, minus the encoding errors. OTOH, I know next to nothing
about v.digit (or the vector stuff in general), so it would probably
be a good idea for it to be tested by someone who is familiar with
v.digit.
Essentially, the form utility (lib/form/form.c) has been rewritten as
a typical "extended wish", with the communication with the form
library being performed in Tcl.
--
Glynn Clements <glynn at gclements.plus.com>
-------------- next part --------------
Index: lib/form/form.c
===================================================================
RCS file: /grassrepository/grass6/lib/form/form.c,v
retrieving revision 1.17
diff -u -r1.17 form.c
--- lib/form/form.c 6 Feb 2007 11:15:03 -0000 1.17
+++ lib/form/form.c 10 Feb 2007 14:51:52 -0000
@@ -12,12 +12,6 @@
#include <grass/dbmi.h>
#include <grass/form.h>
-#ifdef __MINGW32__
-#include <winsock.h>
-#define F_SETFL 4 /* Set file status flags. */
-#define O_NONBLOCK 0x0004 /* Non-blocking I/O. */
-#endif
-
/* Structure to store column names and values */
typedef struct
{
@@ -26,21 +20,11 @@
char *value;
} COLUMN;
-char *Drvname, *Dbname, *Tblname, *Key;
-
-COLUMN *Columns = NULL;
-int allocatedRows = 0; /* allocated space */
-int nRows = 0;
+static char *Drvname, *Dbname, *Tblname, *Key;
-int form_open = 0;
-
-/* Close form */
-int close_form(ClientData cdata, Tcl_Interp * interp, int argc, char *argv[])
-{
- G_debug(3, "close_form()");
- form_open = 0;
- return TCL_OK;
-}
+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[])
@@ -267,151 +251,49 @@
/*
* Form
*/
-int main(int argc, char *argv[])
+int Tcl_AppInit(Tcl_Interp *interp)
{
- int length;
- int ret;
- char buf[5000];
- char *child_html, *child_title;
- static FILE *child_send, *child_recv;
- static Tcl_Interp *interp;
- static int frmid = 0;
- char *encoding_val;
-
- G_gisinit("form");
-
- G_debug(2, "Form: main()");
-
- setlocale(LC_CTYPE, "");
-
- child_recv = stdin;
- child_send = stdout;
-
- while (1) {
- fd_set waitset;
- struct timeval tv;
-
- tv.tv_sec = 0;
- tv.tv_usec = 200;
-
- FD_ZERO(&waitset);
- FD_SET(fileno(stdin), &waitset);
-
- if (select(FD_SETSIZE, &waitset, NULL, NULL, &tv) < 0) {
- perror("form: select");
- }
-
- ret = read(fileno(stdin), &(buf[0]), 1);
-#ifndef __MINGW32__
- fcntl(fileno(child_recv), F_SETFL, O_NONBLOCK); /* Don't wait if pipe is empty */
-#endif
- if (ret == 0)
- break; /* Pipe was closed by parent -> quit */
- if (ret == 1) {
- G_debug(3, "Form: received = '%c'", buf[0]);
- if (buf[0] == 'O') {
- if (!form_open) {
- G_debug(3, "Form is not opened");
- /* Open the window and display the form */
- interp = Tcl_CreateInterp();
- if (Tcl_Init(interp) == TCL_ERROR)
- G_fatal_error("Tcl_Init failed: %s\n", interp->result);
- if (Tk_Init(interp) == TCL_ERROR)
- G_fatal_error("Tk_Init failed: %s\n", interp->result);
-
- 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);
- Tcl_CreateCommand(interp, "close_form",
- (Tcl_CmdProc *) close_form,
- (ClientData) NULL,
- (Tcl_CmdDeleteProc *) NULL);
-
- sprintf(buf, "%s/etc/form/form.tcl", G_gisbase());
- ret = Tcl_EvalFile(interp, buf);
- if (ret == TCL_ERROR) {
- if (interp->result != NULL)
- G_fatal_error("Cannot open form: %s\n",
- interp->result);
- else
- G_fatal_error("Cannot open form\n");
- }
+ if (Tcl_Init(interp) == TCL_ERROR)
+ return TCL_ERROR;
+ if (Tk_Init(interp) == TCL_ERROR)
+ return TCL_ERROR;
- form_open = 1;
- }
- G_debug(2, "Open form %d", frmid);
- /* Read title */
- fgets(buf, 1000, child_recv);
- length = atoi(buf); /* length of the string */
- G_debug(2, "length = %d", length);
- child_title = (char *)G_malloc(length + 1);
- fread(child_title, length, 1, child_recv);
- child_title[length] = '\0';
-
- /* Read html */
- fgets(buf, 1000, child_recv);
- length = atoi(buf); /* length of the string */
- G_debug(2, "length = %d", length);
- child_html = (char *)G_malloc(length + 1);
- fread(child_html, length, 1, child_recv);
- child_html[length] = '\0';
-
- memset(buf, '\0', strlen(buf));
-
- encoding_val = G__getenv("GRASS_DB_ENCODING");
- Tcl_ExternalToUtf(interp,
- Tcl_GetEncoding(interp, encoding_val),
- child_html, strlen(child_html), 0, NULL,
- buf, strlen(child_html) * 2, NULL, NULL,
- NULL);
-
- G_debug(3, "Current GRASS_DB_ENCODING: %s", encoding_val);
- if (Tcl_SetSystemEncoding(interp, encoding_val) == TCL_ERROR) {
- fprintf(stderr,
- "Could not set Tcl system encoding to %s\n",
- encoding_val);
- }
+ Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
- G_debug(2, "Form: html = %s", buf);
+ /*
+ * 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.
+ */
- /* Insert new page */
- Tcl_SetVar(interp, "html", buf, 0);
- sprintf(buf, "add_form %d \"%s\"", frmid, child_title);
- Tcl_Eval(interp, buf);
-
- fprintf(child_send, "O"); /* OK */
- fflush(child_send);
- frmid++;
- G_debug(2, "Form displayed\n");
- }
- else if (buf[0] == 'C') { /* clear old forms */
- Tcl_Eval(interp, "clear_nb");
- fprintf(child_send, "O"); /* OK */
- fflush(child_send);
- }
- else if (buf[0] == 'D') { /* done! */
- Tcl_Eval(interp, "clear_nb");
- fprintf(child_send, "O"); /* OK */
- fflush(child_send);
- break;
- }
- }
-
- Tcl_Eval(interp, "update");
- }
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/.grassformrc", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
- Tcl_Eval(interp, "destroy .");
- G_debug(3, "Form: end\n");
- exit(0);
+int main(int argc, char *argv[])
+{
+ G_gisinit("form");
+ G_debug(2, "Form: main()");
- return 0;
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0;
}
+
Index: lib/form/form.tcl
===================================================================
RCS file: /grassrepository/grass6/lib/form/form.tcl,v
retrieving revision 1.3
diff -u -r1.3 form.tcl
--- lib/form/form.tcl 17 Feb 2003 06:41:03 -0000 1.3
+++ lib/form/form.tcl 10 Feb 2007 14:51:52 -0000
@@ -2,17 +2,9 @@
package require -exact BWidget 1.2.1
#package require http
-set formpath $env(GISBASE)/etc/form/
+set formpath $env(GISBASE)/etc/form
source $formpath/html_library.tcl
-set submit_result ""
-set submit_msg ""
-set html ""
-
-set nb [NoteBook .nb]
-$nb configure -width 300 -height 500
-pack .nb -fill both -expand yes
-
proc create_submit_msg { formid } {
global submit_result submit_msg formf
@@ -70,4 +62,97 @@
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
Index: lib/form/open.c
===================================================================
RCS file: /grassrepository/grass6/lib/form/open.c,v
retrieving revision 1.13
diff -u -r1.13 open.c
--- lib/form/open.c 7 Nov 2006 06:05:07 -0000 1.13
+++ lib/form/open.c 10 Feb 2007 14:51:52 -0000
@@ -51,9 +51,6 @@
#endif /*USE_G_SOCKS*/
int length;
/* child */
- char buf[2000];
-
-
G_debug ( 2, "F_open(): title = %s", title);
@@ -70,6 +67,8 @@
}
if ( pid == 0 ) { /* Child */
+ char command[2000], script[2000];
+
G_debug ( 2, "CHILD" );
/* Note: If you are forking in a Tk based apllication you
@@ -94,9 +93,10 @@
- sprintf(buf,"%s/etc/form/form", G_gisbase());
+ sprintf(command, "%s/etc/form/form", G_gisbase());
+ sprintf(script, "%s/etc/form/form.tcl", G_gisbase());
- execl ("/bin/sh", "sh", "-c", buf, NULL);
+ execl(command, "form", "-f", script, NULL);
G_debug(2, "CHILD END\n");
exit (0);
More information about the grass-dev
mailing list