[Plplot-cvs] SF.net SVN: plplot:[12711] trunk/bindings/tk

[<arj...@us...>]

Revision: 12711
          http://sourceforge.net/p/plplot/code/12711
Author:   arjenmarkus
Date:     2013-11-18 19:31:25 +0000 (Mon, 18 Nov 2013)
Log Message:
-----------
Add print statements to make it clear to the user what went wrong if parts of the initialization fail. Also use the lappend command to set the auto_path variable, to prevent directories containing spaces to cause difficult to trace problems. 

Finally distinguish between the tow forms of the "exit" command (with and without a return code). The original code may have been causing segfaults, though it has to be confirmed that that particular problem has been solved.

Modified Paths:
--------------
    trunk/bindings/tk/plserver.c
    trunk/bindings/tk/tkMain.c

Modified: trunk/bindings/tk/plserver.c
===================================================================
--- trunk/bindings/tk/plserver.c	2013-11-17 00:49:08 UTC (rev 12710)
+++ trunk/bindings/tk/plserver.c	2013-11-18 19:31:25 UTC (rev 12711)
@@ -96,7 +96,7 @@
 main( int argc, const char **argv )
 {
     int        i, myargc = argc;
-    const char *myargv[20];
+    const char **myargv;
     Tcl_Interp *interp;
     const char *helpmsg = "Command-specific options:";
 
@@ -113,8 +113,9 @@
 
     interp = Tcl_CreateInterp();
 
-// Save arglist to get around tk_ParseArgv limitations
+// Save arglist to get around Tk_ParseArgv limitations
 
+    myargv = (const char **) malloc( argc * sizeof(char *) );
     for ( i = 0; i < argc; i++ )
     {
         myargv[i] = argv[i];
@@ -224,7 +225,7 @@
     if ( auto_path != NULL )
     {
         Tcl_SetVar( interp, "dir", auto_path, 0 );
-        tcl_cmd( interp, "set auto_path [list $dir $auto_path]" );
+        tcl_cmd( interp, "lappend auto_path $dir" );
     }
 
 // Rename "exit" to "tkexit", and insert custom exit handler
@@ -277,8 +278,17 @@
     Tcl_VarEval( interp, "plserver_link_end", (char **) NULL );
 
 // Now really exit
+// (Note: this function is actually deprecated, but as it is only used here
+// at the end of the program, let's leave it.)
 
-    return Tcl_VarEval( interp, "tkexit", argv[1], (char **) NULL );
+    if ( argc == 1 )
+    {
+        return Tcl_VarEval( interp, "tkexit", (char **) NULL );
+    }
+    else
+    {
+        return Tcl_VarEval( interp, "tkexit", argv[1], (char **) NULL );
+    }
 }
 
 //--------------------------------------------------------------------------

Modified: trunk/bindings/tk/tkMain.c
===================================================================
--- trunk/bindings/tk/tkMain.c	2013-11-17 00:49:08 UTC (rev 12710)
+++ trunk/bindings/tk/tkMain.c	2013-11-18 19:31:25 UTC (rev 12711)
@@ -251,21 +251,25 @@
 
     if ( Tcl_Init( interp ) == TCL_ERROR )
     {
+        fprintf( stderr, "Tcl initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
         return TCL_ERROR;
     }
     if ( Tk_Init( interp ) == TCL_ERROR )
     {
+        fprintf( stderr, "Tk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
         return TCL_ERROR;
     }
 #ifdef HAVE_ITCL
     if ( Itcl_Init( interp ) == TCL_ERROR )
     {
+        fprintf( stderr, "Itcl initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
         return TCL_ERROR;
     }
 #endif
 #ifdef HAVE_ITK
     if ( Itk_Init( interp ) == TCL_ERROR )
     {
+        fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
         return TCL_ERROR;
     }
 
@@ -281,17 +285,20 @@
     if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
              "::itk::*", /* allowOverwrite */ 1 ) != TCL_OK )
     {
+        fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
         return TCL_ERROR;
     }
 
     if ( Tcl_Import( interp, Tcl_GetGlobalNamespace( interp ),
              "::itcl::*", /* allowOverwrite */ 1 ) != TCL_OK )
     {
+        fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
         return TCL_ERROR;
     }
 
     if ( Tcl_Eval( interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }" ) != TCL_OK )
     {
+        fprintf( stderr, "Itk initialisation failed: %s\n", Tcl_GetStringResult( interp ) );
         return TCL_ERROR;
     }
 #endif
@@ -333,6 +340,7 @@
     if ( ( *AppInit )( interp ) != TCL_OK )
     {
         fprintf( stderr, "(*AppInit) failed: %s\n", Tcl_GetStringResult( interp ) );
+        return TCL_ERROR;
     }
 
     //
@@ -412,7 +420,7 @@
             Tcl_DStringFree( &buffer );
         }
 // Exclude UNIX-only feature
-#if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
+#if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
         Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
 #endif
         if ( tty )
@@ -493,7 +501,7 @@
             }
             else
             {
-#if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
+#if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
                 Tk_DeleteFileHandler( 0 );
 #endif
             }
@@ -527,11 +535,11 @@
     // finished.  Among other things, this will trash the text of the
     // command being evaluated.
     //
-#if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
+#if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
     Tk_CreateFileHandler( 0, 0, StdinProc, (ClientData) 0 );
 #endif
     code = Tcl_RecordAndEval( interp, cmd, 0 );
-#if !defined ( MAC_TCL ) && !defined ( __WIN32__ ) && !defined ( __CYGWIN__ )
+#if !defined ( MAC_TCL ) && !defined ( __WIN32__ )
     Tk_CreateFileHandler( 0, TK_READABLE, StdinProc, (ClientData) 0 );
 #endif
     Tcl_DStringFree( &command );
@@ -574,8 +582,8 @@
 //
 
 static void
-Prompt( intp, partial )
-Tcl_Interp * intp;                    // Interpreter to use for prompting.
+Prompt( interp, partial )
+Tcl_Interp * interp;                  // Interpreter to use for prompting.
 int partial;                          // Non-zero means there already
                                       // exists a partial command, so use
                                       // the secondary prompt.
@@ -583,7 +591,7 @@
     const char *promptCmd;
     int        code;
 
-    promptCmd = Tcl_GetVar( intp,
+    promptCmd = Tcl_GetVar( interp,
         partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY );
     if ( promptCmd == NULL )
     {
@@ -595,12 +603,12 @@
     }
     else
     {
-        code = Tcl_Eval( intp, promptCmd );
+        code = Tcl_Eval( interp, promptCmd );
         if ( code != TCL_OK )
         {
-            Tcl_AddErrorInfo( intp,
+            Tcl_AddErrorInfo( interp,
                 "\n    (script that generates prompt)" );
-            fprintf( stderr, "%s\n", Tcl_GetStringResult( intp ) );
+            fprintf( stderr, "%s\n", Tcl_GetStringResult( interp ) );
             goto defaultPrompt;
         }
     }

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.