00001 // $Id: tkshell.c 11760 2011-06-01 19:29:11Z airwin $ 00002 // 00003 // Maurice LeBrun 00004 // 6-May-93 00005 // 00006 // A miscellaneous assortment of Tcl support functions. 00007 // 00008 // 00009 // Copyright (C) 2004 Joao Cardoso 00010 // 00011 // This file is part of PLplot. 00012 // 00013 // PLplot is free software; you can redistribute it and/or modify 00014 // it under the terms of the GNU Library General Public License as published 00015 // by the Free Software Foundation; either version 2 of the License, or 00016 // (at your option) any later version. 00017 // 00018 // PLplot is distributed in the hope that it will be useful, 00019 // but WITHOUT ANY WARRANTY; without even the implied warranty of 00020 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00021 // GNU Library General Public License for more details. 00022 // 00023 // You should have received a copy of the GNU Library General Public License 00024 // along with PLplot; if not, write to the Free Software 00025 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 00026 // 00027 00028 #include "plserver.h" 00029 00030 //-------------------------------------------------------------------------- 00031 // Pltk_Init 00032 // 00033 // Initialization routine for extended wish'es. 00034 // Creates the plframe, matrix, wait_until, and host_id (w/Tcl-DP only) 00035 // commands. Also sets the auto_path variable. 00036 //-------------------------------------------------------------------------- 00037 00038 int 00039 Pltk_Init( Tcl_Interp *interp ) 00040 { 00041 Tk_Window main; 00042 00043 main = Tk_MainWindow( interp ); 00044 00045 // plframe -- PLplot graphing widget 00046 00047 Tcl_CreateCommand( interp, "plframe", (Tcl_CmdProc *) plFrameCmd, 00048 (ClientData) main, (Tcl_CmdDeleteProc *) NULL ); 00049 00050 // matrix -- matrix support command 00051 00052 Tcl_CreateCommand( interp, "matrix", (Tcl_CmdProc *) Tcl_MatrixCmd, 00053 (ClientData) main, (Tcl_CmdDeleteProc *) NULL ); 00054 00055 // wait_until -- waits for a specific condition to arise 00056 // Can be used with either Tcl-DP or TK 00057 00058 Tcl_CreateCommand( interp, "wait_until", (Tcl_CmdProc *) plWait_Until, 00059 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL ); 00060 00061 // host_id -- returns host IP number. Only for use with Tcl-DP 00062 00063 #ifdef PLD_dp 00064 Tcl_CreateCommand( interp, "host_id", (Tcl_CmdProc *) plHost_ID, 00065 (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL ); 00066 #endif 00067 00068 // Set up auto_path 00069 00070 if ( pls_auto_path( interp ) == TCL_ERROR ) 00071 return TCL_ERROR; 00072 00073 // Save initial RGB colormap components 00074 // Disabled for now 00075 00076 #if 0 00077 { 00078 Display *display; 00079 Colormap map; 00080 00081 display = Tk_Display( main ); 00082 map = DefaultColormap( display, DefaultScreen( display ) ); 00083 00084 // Convert this to use esc function if it's going to be used 00085 // SaveColormap(display, map); 00086 } 00087 #endif 00088 return TCL_OK; 00089 } 00090 00091 //-------------------------------------------------------------------------- 00092 // plWait_Until 00093 // 00094 // Tcl command -- wait until the specified condition is satisfied. 00095 // Processes all events while waiting. 00096 // 00097 // This command is more capable than tkwait, and has the added benefit 00098 // of working with Tcl-DP as well. Example usage: 00099 // 00100 // wait_until {[info exists foobar]} 00101 // 00102 // Note the [info ...] command must be protected by braces so that it 00103 // isn't actually evaluated until passed into this routine. 00104 //-------------------------------------------------------------------------- 00105 00106 int 00107 plWait_Until( ClientData clientData, Tcl_Interp *interp, int argc, char **argv ) 00108 { 00109 int result = 0; 00110 00111 dbug_enter( "plWait_Until" ); 00112 00113 for (;; ) 00114 { 00115 if ( Tcl_ExprBoolean( interp, argv[1], &result ) ) 00116 { 00117 fprintf( stderr, "wait_until command \"%s\" failed:\n\t %s\n", 00118 argv[1], interp->result ); 00119 break; 00120 } 00121 if ( result ) 00122 break; 00123 00124 Tk_DoOneEvent( 0 ); 00125 } 00126 return TCL_OK; 00127 }