home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / maths / plplot / plplot_2 / drivers / tk / tkshell.c < prev   
Encoding:
C/C++ Source or Header  |  1994-07-26  |  7.4 KB  |  274 lines
  1. /* $Id: tkshell.c,v 1.23 1994/07/26 21:14:36 mjl Exp $
  2.  * $Log: tkshell.c,v $
  3.  * Revision 1.23  1994/07/26  21:14:36  mjl
  4.  * Improvements to the way PLplot looks for various files.  Now more
  5.  * consistent and flexible.  In particular, environmentals can be set for
  6.  * locations of each directory (for Tcl, binary, and library files).
  7.  * Contributed by Mark Olesen.
  8.  *
  9.  * Revision 1.22  1994/07/25  06:44:27  mjl
  10.  * Wrapped the include of unistd.h in a HAVE_UNISTD_H.
  11.  *
  12.  * Revision 1.21  1994/07/22  22:21:16  mjl
  13.  * Eliminated a gcc -Wall warning.
  14.  *
  15.  * Revision 1.20  1994/07/19  22:31:50  mjl
  16.  * All device drivers: enabling macro renamed to PLD_<driver>, where <driver>
  17.  * is xwin, ps, etc.  See plDevs.h for more detail.  All internal header file
  18.  * inclusion changed to /not/ use a search path so that it will work better
  19.  * with makedepend.
  20.  *
  21.  * Revision 1.19  1994/06/30  18:44:18  mjl
  22.  * Cleaning up, also moved Tk-driver-specific functions to tk.c
  23.  *
  24.  * Revision 1.18  1994/06/23  22:37:30  mjl
  25.  * Minor cosmetic changes.
  26.  *
  27.  * Revision 1.17  1994/06/16  19:15:17  mjl
  28.  * Moved the Tk initialization function for the tk driver into tk.c.  Changed
  29.  * Pltk_Init to include by default some of the other Tcl commands used by
  30.  * the PLplot/Tk driver.  Turned set_auto_path() into pls_auto_path() and
  31.  * made it global.
  32.  *
  33.  * Revision 1.16  1994/06/09  20:27:35  mjl
  34.  * Hacked out direct widget support; this was moved to plframe.c.
  35. */
  36.  
  37. /* 
  38.  * tkshell.c
  39.  * Maurice LeBrun
  40.  * 6-May-93
  41.  *
  42.  * A miscellaneous assortment of Tcl support functions.
  43.  */
  44.  
  45. #include "plserver.h"
  46. #ifdef HAVE_UNISTD_H
  47. #include <unistd.h>
  48. #endif
  49.  
  50. /* Static functions */
  51.  
  52. /* Evals the specified command, aborting on an error. */
  53.  
  54. static int
  55. tcl_cmd(Tcl_Interp *interp, char *cmd);
  56.  
  57. /*----------------------------------------------------------------------*\
  58.  * Pltk_Init
  59.  *
  60.  * Initialization routine for extended wish'es.
  61.  * Creates the plframe, matrix, wait_until, and host_id (w/Tcl-DP only)
  62.  * commands.  Also sets the auto_path variable.
  63. \*----------------------------------------------------------------------*/
  64.  
  65. int
  66. Pltk_Init( Tcl_Interp *interp )
  67. {
  68.     Tk_Window main;
  69.  
  70.     main = Tk_MainWindow(interp);
  71.  
  72. /* plframe -- PLplot graphing widget */
  73.  
  74.     Tcl_CreateCommand(interp, "plframe", plFrameCmd,
  75.                       (ClientData) main, (void (*)(ClientData)) NULL);
  76.  
  77. /* matrix -- matrix support command */
  78.  
  79.     Tcl_CreateCommand(interp, "matrix", Tcl_MatrixCmd,
  80.                       (ClientData) main, (void (*)(ClientData)) NULL);
  81.  
  82. /* wait_until -- waits for a specific condition to arise */
  83. /* Can be used with either Tcl-DP or TK */
  84.  
  85.     Tcl_CreateCommand(interp, "wait_until", plWait_Until,
  86.               (ClientData) NULL, (void (*) (ClientData)) NULL);
  87.  
  88. /* host_id -- returns host IP number.  Only for use with Tcl-DP */
  89.  
  90. #ifdef PLD_dp
  91.     Tcl_CreateCommand(interp, "host_id", plHost_ID,
  92.               (ClientData) NULL, (void (*) (ClientData)) NULL);
  93. #endif
  94.  
  95. /* Set up auto_path */
  96.  
  97.     if (pls_auto_path(interp) == TCL_ERROR)
  98.     return TCL_ERROR;
  99.  
  100. /* Save initial RGB colormap components */
  101. /* Disabled for now */
  102.  
  103. #if 0
  104.     {
  105.     Display *display;
  106.     Colormap map;
  107.  
  108.     display = Tk_Display(main);
  109.     map = DefaultColormap(display, DefaultScreen(display));
  110.  
  111.     PLX_save_colormap(display, map);
  112.     }
  113. #endif
  114.     return TCL_OK;
  115. }
  116.  
  117. /*----------------------------------------------------------------------*\
  118.  * pls_auto_path
  119.  *
  120.  * Sets up auto_path variable.  
  121.  * Directories are added to the FRONT of autopath.  Therefore, they are
  122.  * searched in reverse order of how they are listed below.
  123.  *
  124.  * Note: there is no harm in adding extra directories, even if they don't
  125.  * actually exist (aside from a slight increase in processing time when
  126.  * the autoloaded proc is first found).
  127. \*----------------------------------------------------------------------*/
  128.  
  129. int
  130. pls_auto_path(Tcl_Interp *interp)
  131. {
  132.     char *buf, *ptr=NULL, *dn;
  133. #ifdef DEBUG
  134.     char *path;
  135. #endif
  136.  
  137.     dbug_enter("set_auto_path");
  138.     buf = (char *) malloc(256 * sizeof(char));
  139.  
  140. /* Add TCL_DIR */
  141.  
  142. #ifdef TCL_DIR
  143.     Tcl_SetVar(interp, "dir", TCL_DIR, TCL_GLOBAL_ONLY);
  144.     if (tcl_cmd(interp, "set auto_path \"$dir $auto_path\"") == TCL_ERROR)
  145.     return TCL_ERROR;
  146. #ifdef DEBUG
  147.     fprintf(stderr, "adding %s to auto_path\n", TCL_DIR);
  148.     path = Tcl_GetVar(interp, "auto_path", 0);
  149.     fprintf(stderr, "auto_path is %s\n", path);
  150. #endif
  151. #endif
  152.  
  153. /* Add $HOME/tcl */
  154.  
  155.     if ((dn = getenv("HOME")) != NULL) {
  156.     plGetName(dn, "tcl", "", &ptr);
  157.     Tcl_SetVar(interp, "dir", ptr, 0);
  158.     if (tcl_cmd(interp, "set auto_path \"$dir $auto_path\"") == TCL_ERROR)
  159.         return TCL_ERROR;
  160. #ifdef DEBUG
  161.     fprintf(stderr, "adding %s to auto_path\n", ptr);
  162.     path = Tcl_GetVar(interp, "auto_path", 0);
  163.     fprintf(stderr, "auto_path is %s\n", path);
  164. #endif
  165.     }
  166.  
  167. /* Add PL_TCL_ENV = $(PL_TCL) */
  168.  
  169. #if defined (PL_TCL_ENV)
  170.     if ((dn = getenv(PL_TCL_ENV)) != NULL) {
  171.     plGetName(dn, "", "", &ptr);
  172.     Tcl_SetVar(interp, "dir", ptr, 0);
  173.     if (tcl_cmd(interp, "set auto_path \"$dir $auto_path\"") == TCL_ERROR)
  174.         return TCL_ERROR;
  175. #ifdef DEBUG
  176.     fprintf(stderr, "adding %s to auto_path\n", ptr);
  177.     path = Tcl_GetVar(interp, "auto_path", 0);
  178.     fprintf(stderr, "auto_path is %s\n", path);
  179. #endif
  180.     }
  181. #endif  /* PL_TCL_ENV */
  182.  
  183. /* Add PL_HOME_ENV/tcl = $(PL_HOME_ENV)/tcl */
  184.  
  185. #if defined (PL_HOME_ENV)
  186.     if ((dn = getenv(PL_HOME_ENV)) != NULL) {
  187.     plGetName(dn, "tcl", "", &ptr);
  188.     Tcl_SetVar(interp, "dir", ptr, 0);
  189.     if (tcl_cmd(interp, "set auto_path \"$dir $auto_path\"") == TCL_ERROR)
  190.         return TCL_ERROR;
  191. #ifdef DEBUG
  192.     fprintf(stderr, "adding %s to auto_path\n", ptr);
  193.     path = Tcl_GetVar(interp, "auto_path", 0);
  194.     fprintf(stderr, "auto_path is %s\n", path);
  195. #endif
  196.     }
  197. #endif  /* PL_HOME_ENV */
  198.  
  199. /* Add cwd */
  200.  
  201.     if (getcwd(buf, 256) == NULL) 
  202.     return TCL_ERROR;
  203.  
  204.     Tcl_SetVar(interp, "dir", buf, 0);
  205.     if (tcl_cmd(interp, "set auto_path \"$dir $auto_path\"") == TCL_ERROR)
  206.     return TCL_ERROR;
  207.  
  208. #ifdef DEBUG
  209.     fprintf(stderr, "adding %s to auto_path\n", buf);
  210.     path = Tcl_GetVar(interp, "auto_path", 0);
  211.     fprintf(stderr, "auto_path is %s\n", path);
  212. #endif
  213.  
  214.     free_mem(buf);
  215.     free_mem(ptr);
  216.  
  217.     return TCL_OK;
  218. }
  219.  
  220. /*----------------------------------------------------------------------*\
  221.  * tcl_cmd
  222.  *
  223.  * Evals the specified command, aborting on an error.
  224. \*----------------------------------------------------------------------*/
  225.  
  226. static int
  227. tcl_cmd(Tcl_Interp *interp, char *cmd)
  228. {
  229.     int result;
  230.  
  231.     result = Tcl_VarEval(interp, cmd, (char **) NULL);
  232.     if (result != TCL_OK) {
  233.     fprintf(stderr, "TCL command \"%s\" failed:\n\t %s\n",
  234.         cmd, interp->result);
  235.     }
  236.     return result;
  237. }
  238.  
  239. /*----------------------------------------------------------------------*\
  240.  * plWait_Until
  241.  *
  242.  * Tcl command -- wait until the specified condition is satisfied.
  243.  * Processes all events while waiting.
  244.  *
  245.  * This command is more capable than tkwait, and has the added benefit
  246.  * of working with Tcl-DP as well.  Example usage:
  247.  *
  248.  *    wait_until {[info exists foobar]}
  249.  *
  250.  * Note the [info ...] command must be protected by braces so that it
  251.  * isn't actually evaluated until passed into this routine.
  252. \*----------------------------------------------------------------------*/
  253.  
  254. int
  255. plWait_Until(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
  256. {
  257.     int result = 0;
  258.  
  259.     dbug_enter("plWait_Until");
  260.  
  261.     for (;;) {
  262.     if (Tcl_ExprBoolean(interp, argv[1], &result)) {
  263.         fprintf(stderr, "wait_until command \"%s\" failed:\n\t %s\n",
  264.             argv[1], interp->result);
  265.         break;
  266.     }
  267.     if (result)
  268.         break;
  269.  
  270.     Tk_DoOneEvent(0);
  271.     }
  272.     return TCL_OK;
  273. }
  274.