home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / X11 / tclMotif-1.4 / send / programs / xmSend3.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-29  |  2.8 KB  |  124 lines
  1. /*
  2.  * A Motif program to send and receive messages to and from a Tk program
  3.  * The Tk program is tkSend3, and this one is called xmSend3.
  4.  *
  5.  * This bats the label value back-and-forth in a recursive send, 
  6.  * each time increasing the number in the other until a limit
  7.  * is reached.
  8.  */
  9.  
  10. #include <Xm/PushB.h>
  11. #include "../tclXtSend.h"
  12.  
  13. void
  14. SendTo(w, clientData, callData)
  15.     Widget w;
  16.     XtPointer clientData;
  17.     XtPointer callData;
  18. {
  19.     Tcl_Interp *interp = (Tcl_Interp *) clientData;
  20.     char sendCommand[1024];
  21.  
  22.     strcpy(sendCommand,
  23.         "send tkSend3 incrementLabel");
  24.     if (Tcl_Eval(interp, sendCommand) != TCL_OK)
  25.     fprintf(stderr, "send failed\n");
  26. }
  27.  
  28. char incrementLabelCmd[] = "\
  29.   proc incrementLabel {} { \n\
  30.     getLabel value \n\
  31.     incr value \n\
  32.     setLabel $value \n\
  33.     if {$value < 20} { \n\
  34.       send tkSend3 incrementLabel \n\
  35.     }
  36.   } \
  37. ";
  38.  
  39. int
  40. SetLabel(clientData, interp, argc, argv)
  41.     ClientData *clientData;
  42.     Tcl_Interp *interp;
  43.     int argc;
  44.     char **argv;
  45. {
  46.     XmString xmstr;
  47.     Widget w = (Widget) clientData;
  48.  
  49.     if (argc < 2) {
  50.     Tcl_SetResult(interp, "setLabel label", TCL_STATIC);
  51.     return TCL_ERROR;
  52.     }
  53.  
  54. fprintf(stderr, "**Setting label to %s\n", argv[1]);
  55.     xmstr = XmStringCreateLocalized(argv[1]);
  56.     XtVaSetValues(w, XmNlabelString, xmstr, NULL);
  57.     XmStringFree(xmstr);
  58.  
  59.     return TCL_OK;
  60. }
  61.  
  62. int
  63. GetLabel(clientData, interp, argc, argv)
  64.     ClientData *clientData;
  65.     Tcl_Interp *interp;
  66.     int argc;
  67.     char **argv;
  68. {
  69.     XmString xmstr;
  70.     String str;
  71.     Widget w = (Widget) clientData;
  72.  
  73.     if (argc < 2) {
  74.     Tcl_SetResult(interp, "getLabel \"label\"", TCL_STATIC);
  75.     return TCL_ERROR;
  76.     }
  77.  
  78.     XtVaGetValues(w, XmNlabelString, &xmstr, NULL);
  79.     XmStringGetLtoR(xmstr, XmFONTLIST_DEFAULT_TAG, &str);
  80.     Tcl_SetVar(interp, argv[1], str, 0);
  81.  
  82.     XtFree(str);
  83.     XmStringFree(xmstr);
  84.  
  85.     return TCL_OK;
  86. }
  87.  
  88. int
  89. main(argc, argv)
  90.     int argc;
  91.     char **argv;
  92. {
  93.     Widget toplevel;
  94.     Widget button;
  95.     Tcl_Interp *interp;
  96.     XtAppContext app;
  97.  
  98.     toplevel = XtAppInitialize(&app, "XmSend", NULL, 0, &argc, argv,
  99.                 NULL, NULL, 0);
  100.  
  101.     button = XmCreatePushButton(toplevel, "1", NULL, 0);
  102.     XtManageChild(button);
  103.  
  104.     XtRealizeWidget(toplevel);
  105.  
  106.     interp = Tcl_CreateInterp();
  107.  
  108.     if (TclXtSend_RegisterInterp(interp, argv[0], toplevel) == TCL_ERROR)
  109.     fprintf(stderr, "couldn't register interpreter %s\n", argv[0]);
  110.  
  111.     /*
  112.      * Create tcl commands based in C, and then load a procedure
  113.      */
  114.     Tcl_CreateCommand(interp, "setLabel", SetLabel, (ClientData *) button,
  115.         (Tcl_CmdDeleteProc *) NULL);
  116.     Tcl_CreateCommand(interp, "getLabel", GetLabel, (ClientData *) button,
  117.         (Tcl_CmdDeleteProc *) NULL);
  118.     Tcl_Eval(interp, incrementLabelCmd);
  119.  
  120.     XtAddCallback(button, XmNactivateCallback, SendTo, (XtPointer) interp);
  121.  
  122.     XtAppMainLoop(app);
  123. }
  124.