home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / tclmotif.1 / tclmotif / tm.1.2 / src / tmWidget.c < prev   
Encoding:
C/C++ Source or Header  |  1994-05-03  |  15.1 KB  |  618 lines
  1. /*
  2.  * TmWidget.c --
  3.  *    This module contains the main set of functions
  4.  *    common to all widget types. ie it implements the
  5.  *    Tm Core widget stuff.
  6.  *
  7.  * Copyright 1993 Jan Newmarch, University of Canberra.
  8.  * Permission to use, copy, modify, and distribute this
  9.  * software and its documentation for any purpose and without
  10.  * fee is hereby granted, provided that the above copyright
  11.  * notice appear in all copies.  The author
  12.  * makes no representations about the suitability of this
  13.  * software for any purpose.  It is provided "as is" without
  14.  * express or implied warranty.
  15.  */
  16.  
  17. #include "tm.h"
  18. #include "tmFuncs.h"
  19. #include <Xm/List.h>
  20. #include <Xm/Xm.h>
  21.  
  22. XEvent *Tm_HackXEvent;    /* needed for D&D to pass X event into XDragStart */
  23.  
  24. /*
  25.  *--------------------------------------------------------------
  26.  *
  27.  * Tm_ParentWidgetFromPath --
  28.  *
  29.  *    Given a Tm widget pathname, finds the parent Xt widget.
  30.  *
  31.  * Results:
  32.  *
  33.  *    returns the Xt parent
  34.  *
  35.  * Side effects:
  36.  *
  37.  *--------------------------------------------------------------
  38.  */
  39.  
  40. Widget Tm_ParentWidgetFromPath (interp, pathName)
  41.     Tcl_Interp *interp;
  42.     char *pathName;
  43. {
  44.     char *p;
  45.     int numChars;
  46.     Tm_Widget *info;
  47.     Tcl_HashEntry *hPtr;
  48.     Tcl_CmdInfo cmdInfo;
  49.  
  50.     /*
  51.      * Strip the parent's name out of pathName (it's everything up
  52.      * to the last dot).  There are two tricky parts: (a) must
  53.      * copy the parent's name somewhere else to avoid modifying
  54.      * the pathName string (for large names, space for the copy
  55.      * will have to be malloc'ed);  (b) must special-case the
  56.      * situation where the parent is ".".
  57.      */
  58.  
  59.     p = strrchr(pathName, '.');
  60.     if (p == NULL) {
  61.         Tcl_AppendResult(interp, "bad window path name \"", pathName,
  62.                 "\"", (char *) NULL);
  63.         return NULL;
  64.     }
  65.  
  66.     numChars = p-pathName;
  67.  
  68.     p = (char *) XtMalloc((unsigned) (numChars+2));
  69.     if (numChars == 0) {
  70.     *p = '.';
  71.     p[1] = '\0';
  72.     } else {
  73.     strncpy(p, pathName, numChars);
  74.     p[numChars] = '\0';
  75.     }
  76.  
  77. /*
  78.     hPtr = Tcl_FindHashEntry(&WidgetTable, p);
  79.     if (hPtr == NULL) {
  80. */
  81.     if (Tcl_GetCommandInfo(interp, p, &cmdInfo) == 0) {
  82.         Tcl_AppendResult(interp, "no such widget \"", pathName,
  83.                 "\"", (char *) NULL);
  84.         return NULL;
  85.     }
  86.     XtFree(p);
  87. /*
  88.     info = (Tm_Widget *) Tcl_GetHashValue(hPtr);
  89.     return (info->widget);
  90. */
  91.     return ( ((Tm_Widget *) (cmdInfo.clientData))->widget);
  92. }
  93.  
  94.  
  95. /*
  96.  *--------------------------------------------------------------
  97.  *
  98.  * Tm_WidgetInfoFromPath --
  99.  *
  100.  *    looks up the hash table to find the info about the widget
  101.  *
  102.  * Results:
  103.  *
  104.  *    returns the widget info record.
  105.  *
  106.  * Side effects:
  107.  *
  108.  *    none
  109.  *--------------------------------------------------------------
  110.  */
  111.  
  112. Tm_Widget * 
  113. Tm_WidgetInfoFromPath (interp, pathName)
  114.     Tcl_Interp *interp;
  115.     char *pathName;
  116. {
  117. #define FIXED_SPACE 5
  118.     Tm_Widget *info;
  119.     Tcl_HashEntry *hPtr;
  120.     Tcl_CmdInfo cmdInfo;
  121.  
  122. /*
  123.     hPtr = Tcl_FindHashEntry(&WidgetTable, pathName);
  124.     if (hPtr == NULL) {
  125. */
  126.     if (Tcl_GetCommandInfo(interp, pathName, &cmdInfo) == 0) {
  127.         Tcl_AppendResult(interp, "no such widget \"", pathName,
  128.                 "\"", (char *) NULL);
  129.         return NULL;
  130.     }
  131. /*
  132.     info = (Tm_Widget *) Tcl_GetHashValue(hPtr);
  133.     return (info);
  134. */
  135.    return (Tm_Widget *) (cmdInfo.clientData);
  136. }
  137.  
  138. /*
  139.  *--------------------------------------------------------------
  140.  *
  141.  * Tm_ActionsHandler --
  142.  *
  143.  *    All actions are vectored through here.
  144.  *    It calls the Tcl command contained in the args
  145.  *
  146.  * Results:
  147.  *
  148.  * Side effects:
  149.  *
  150.  *--------------------------------------------------------------
  151.  */
  152.  
  153. void
  154. Tm_ActionsHandler(w, event, argv, argc)
  155.     Widget w;
  156.     XEvent *event;
  157.     char **argv;
  158.     Cardinal *argc;
  159. {
  160.     Tm_Widget *wPtr;
  161.     Tcl_Interp *interp;
  162.     char *orig_command, *new_command;
  163.     char *p_orig, *p_new;
  164.     int size;
  165.     int n;
  166.     char *msg;
  167.  
  168.     XtVaGetValues(w, XmNuserData, &wPtr, NULL);
  169.     interp = wPtr->interp;
  170.  
  171.     if (*argc < 1) {
  172.     fprintf(stderr, "action must have an arg\n");
  173.     }
  174.  
  175.     Tm_HackXEvent = event; /* hack to get value into XmDragStart */
  176.  
  177.     size = 128;
  178.     orig_command = XtMalloc(size);
  179.     *orig_command = '\0';
  180.  
  181.     for (n = 0; n < *argc; n++) {
  182.     if (strlen(orig_command) + strlen(argv[n]) + 2 > size) {
  183.         size = 2*size + strlen(argv[n]);
  184.         orig_command = XtRealloc(orig_command, size);
  185.     }
  186.     strcat(orig_command, argv[n]);
  187.     strcat(orig_command, " ");
  188.     }
  189.     p_orig = orig_command;
  190.  
  191.     new_command = Tm_ExpandPercents(wPtr->pathName, w, event,
  192.                 NULL, orig_command);
  193.  
  194.     if (Tcl_GlobalEval(interp, new_command) != TCL_OK) {
  195.         msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  196.         if (msg == NULL) {
  197.             msg = interp->result;
  198.         }
  199.         XtAppWarningMsg(XtWidgetToApplicationContext(w),
  200.                 "TclError", "TclError", "TclError", msg, NULL, 0);
  201.     }
  202.  
  203.     /* record result in case callActionProc invoked this */
  204.     if (Tm_SaveResult(interp))
  205.         Tm_AppendResult(interp, interp->result);
  206.  
  207.     XtFree(orig_command);
  208.     XtFree(new_command);
  209. }
  210.  
  211. /*
  212.  *--------------------------------------------------------------
  213.  *
  214.  * Tm_WidgetCallbackHandler --
  215.  *
  216.  *    nearly all callbacks are vectored through here.
  217.  *    It calls the appropriate callback with right
  218.  *    Tcl command
  219.  *
  220.  * Results:
  221.  *
  222.  * Side effects:
  223.  *
  224.  *--------------------------------------------------------------
  225.  */
  226.  
  227. void
  228. Tm_WidgetCallbackHandler(w, client_data, call_data)
  229.     Widget w;
  230.     XtPointer client_data;
  231.     XtPointer call_data;
  232. {
  233.     Tm_ClientData *c_data = (Tm_ClientData *) client_data;
  234.     Tcl_Interp *interp;
  235.     char *command;
  236.     char *msg;
  237.  
  238.     interp = c_data->widget_info->interp;
  239. #   ifdef DEBUG
  240.     fprintf(stderr, "%s\n", (char *) c_data->callback_func);
  241. #   endif
  242.     command = Tm_ExpandPercents(c_data->widget_info->pathName,
  243.         c_data->widget_info->widget,
  244.         ((XmAnyCallbackStruct *) call_data)->event, call_data, 
  245.         (char *) c_data->callback_func);
  246. #   ifdef DEBUG
  247.     fprintf(stderr, "%% expanded command: %s\n", command);
  248. #   endif
  249.  
  250.     if (Tcl_GlobalEval(interp, command) != TCL_OK) {
  251.     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  252.     if (msg == NULL) {
  253.         msg = interp->result;
  254.     }
  255.     XtAppWarningMsg(XtWidgetToApplicationContext(w),
  256.         "TclError", "TclError", "TclError", msg, NULL, 0);
  257.     }
  258.  
  259.     if (Tm_SaveResult(interp))
  260.     Tm_AppendResult(interp, interp->result);
  261.  
  262.     XtFree(command);
  263. }
  264.  
  265.  
  266. /*
  267.  *--------------------------------------------------------------
  268.  *
  269.  * Tm_DestroyWidgetHandler --
  270.  *
  271.  *    nearly all callbacks are vectored through here.
  272.  *    It calls the appropriate callback with right
  273.  *    Tcl command
  274.  *
  275.  * Results:
  276.  *
  277.  * Side effects:
  278.  *
  279.  *--------------------------------------------------------------
  280.  */
  281.  
  282. void
  283. Tm_DestroyWidgetHandler(w, client_data, call_data)
  284.     Widget w;
  285.     XtPointer client_data;
  286.     XtPointer call_data;
  287. {
  288.     Tm_Widget *c_data = (Tm_Widget *) client_data;
  289.     Tcl_Interp *interp;
  290.     char *path;
  291.     char *parent;
  292.  
  293.     interp = c_data->interp;
  294.     path = c_data->pathName;
  295.     parent = c_data->parent;
  296.  
  297.     Tcl_DeleteCommand(interp, path);
  298.  
  299.     XtFree(parent);
  300.     XtFree(path);
  301.     XtFree((char *) c_data);
  302.  
  303. }
  304.  
  305.  
  306. /*
  307.  *--------------------------------------------------------------
  308.  *
  309.  * Tm_DestroyReclaimHandler --
  310.  *
  311.  *    reclaim space in callback client data when widget 
  312.  *    is destroyed
  313.  *
  314.  * Results:
  315.  *
  316.  * Side effects:
  317.  *
  318.  *--------------------------------------------------------------
  319.  */
  320.  
  321. void
  322. Tm_DestroyReclaimHandler(w, client_data, call_data)
  323.     Widget w;
  324.     XtPointer client_data;
  325.     XtPointer call_data;
  326. {
  327.     Tm_ClientData *c_data = (Tm_ClientData *) client_data;
  328.  
  329.     XtFree(c_data->callback_func);
  330.     XtFree((char *) c_data);
  331. }
  332.  
  333. /*
  334.  *--------------------------------------------------------------
  335.  *
  336.  * Tm_TextVerifyCallbackHandler --
  337.  *
  338.  *    special case callback handler for Text Verify callbacks.
  339.  *    It calls the appropriate callback with right
  340.  *    Tcl command, then sets fields as needed by Text
  341.  *    (or will do)
  342.  *
  343.  * Results:
  344.  *
  345.  * Side effects:
  346.  *
  347.  *--------------------------------------------------------------
  348.  */
  349.  
  350. void
  351. Tm_TextVerifyCallbackHandler(w, client_data, call_data)
  352.     Widget w;
  353.     XtPointer client_data;
  354.     XtPointer call_data;
  355. {
  356.     Tm_ClientData *c_data = (Tm_ClientData *) client_data;
  357.     XmTextVerifyCallbackStruct *verify_data = 
  358.             (XmTextVerifyCallbackStruct *) call_data;
  359.     Tcl_Interp *interp;
  360.     char *path;
  361.     char *msg;
  362.     char *command;
  363.     int doit;
  364.     XmTextPosition startPos, endPos;
  365.     char *ptr;
  366.     int length;
  367.     char buf_startPos[128];
  368.     char buf_endPos[128];
  369.     char buf_length[128];
  370.     char buf[128];
  371.     char *buf_ptr;
  372.  
  373.     interp = c_data->widget_info->interp;
  374.     path = c_data->widget_info->pathName;
  375.  
  376. /* in here we have to set tcl vbls to the values of the callback fields
  377.    and afterwards get their values and set them in the callback data
  378. */
  379.     if (verify_data->doit)
  380.         Tcl_SetVar(interp, TM_TEXT_DOIT, "true", TCL_GLOBAL_ONLY);
  381.     else
  382.     Tcl_SetVar(interp, TM_TEXT_DOIT, "false", TCL_GLOBAL_ONLY);
  383.  
  384.     sprintf(buf_startPos, "%ld", verify_data->startPos);
  385.     Tcl_SetVar(interp, TM_TEXT_STARTPOS, buf_startPos, TCL_GLOBAL_ONLY);
  386.  
  387.     sprintf(buf_endPos, "%ld", verify_data->endPos);
  388.     Tcl_SetVar(interp, TM_TEXT_ENDPOS, buf_endPos, TCL_GLOBAL_ONLY);
  389.  
  390.     if (verify_data->reason == XmCR_MODIFYING_TEXT_VALUE) {
  391.         length = verify_data->text->length;
  392.         buf_ptr = XtMalloc(length + 1);
  393.         strncpy(buf_ptr, verify_data->text->ptr, length);
  394.         buf_ptr[length] = '\0';
  395.         Tcl_SetVar(interp, TM_TEXT_PTR, buf_ptr, TCL_GLOBAL_ONLY);
  396.     
  397.         sprintf(buf_length, "%d", length);
  398.         Tcl_SetVar(interp, TM_TEXT_LENGTH, buf_length, TCL_GLOBAL_ONLY);
  399.     } else {
  400.     Tcl_SetVar(interp, TM_TEXT_PTR, "", TCL_GLOBAL_ONLY);
  401.     Tcl_SetVar(interp, TM_TEXT_LENGTH, "0", TCL_GLOBAL_ONLY);
  402.     buf_ptr = NULL;
  403.     }
  404.     
  405.  
  406.     command = Tm_ExpandPercents(c_data->widget_info->pathName,
  407.         c_data->widget_info->widget,
  408.         ((XmAnyCallbackStruct *) call_data)->event, call_data, 
  409.         (char *) c_data->callback_func);
  410.     if (Tcl_GlobalEval(interp, command) != TCL_OK) {
  411.         msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  412.         if (msg == NULL) {
  413.             msg = interp->result;
  414.         }
  415.         XtAppWarningMsg(XtWidgetToApplicationContext(w),
  416.                 "TclError", "TclError", "TclError", msg, NULL, 0);
  417.     XtFree(command);
  418.         XtFree(buf_ptr);
  419.     return;
  420.     }
  421.     XtFree(command);
  422.  
  423.     if (Tm_SaveResult(interp))
  424.     Tm_AppendResult(interp, interp->result);
  425.  
  426.     /* now set results back into callback struct for Text */
  427.     msg = Tcl_GetVar(interp, TM_TEXT_DOIT, TCL_GLOBAL_ONLY);
  428.     if (Tcl_GetBoolean(interp, msg, &doit) == TCL_ERROR) {
  429.         XtAppWarningMsg(XtWidgetToApplicationContext(w),
  430.                 "TclError", "TclError", "TclError", msg, NULL, 0);
  431.         XtFree(buf_ptr);
  432.         return;
  433.     }
  434.     verify_data->doit = doit;
  435.  
  436.     if (verify_data->reason != XmCR_MODIFYING_TEXT_VALUE) {
  437.     return;
  438.     }
  439.  
  440.     msg = Tcl_GetVar(interp, TM_TEXT_STARTPOS, TCL_GLOBAL_ONLY);
  441.     if (strcmp(msg, buf_startPos) != 0) {
  442.     /* no error checks here - need Tcl_GetLong */
  443.         startPos = strtol(msg, NULL, 0);
  444.         verify_data->startPos = startPos;
  445.     }
  446.  
  447.     msg = Tcl_GetVar(interp, TM_TEXT_ENDPOS, TCL_GLOBAL_ONLY);
  448.     if (strcmp(msg, buf_endPos) != 0) {
  449.     /* no error checks here - need Tcl_GetLong */
  450.         endPos = strtol(msg, NULL, 0);
  451.         verify_data->endPos = endPos;
  452.     }
  453.     msg = Tcl_GetVar(interp, TM_TEXT_PTR, TCL_GLOBAL_ONLY);
  454.     if (strcmp(msg, buf_ptr) != 0) {
  455.     XtFree(verify_data->text->ptr);
  456.         verify_data->text->ptr = XtNewString(msg);
  457.     }
  458.     msg = Tcl_GetVar(interp, TM_TEXT_LENGTH, TCL_GLOBAL_ONLY);
  459.     if (strcmp(msg, buf_length) != 0) {
  460.         if (Tcl_GetInt(interp, msg, &length) == TCL_ERROR) {
  461.             XtAppWarningMsg(XtWidgetToApplicationContext(w),
  462.                 "TclError", "TclError", "TclError", msg, NULL, 0);
  463.         XtFree(buf_ptr);
  464.             return;
  465.         }
  466.         verify_data->text->length = length;
  467.     }
  468.     XtFree(buf_ptr);
  469. }
  470.  
  471. /*
  472.  *--------------------------------------------------------------
  473.  *
  474.  * Tm_InputHandler --
  475.  *
  476.  * Results:
  477.  *     none
  478.  *
  479.  * Side effects:
  480.  *     could be any - this handles any Xt input
  481.  *
  482.  *--------------------------------------------------------------
  483.  */
  484.  
  485. /* ARGSUSED */
  486. void
  487. Tm_InputHandler(clientData, source, id)
  488.     XtPointer clientData;
  489.     int *source;
  490.     XtInputId *id;
  491. {
  492.     Tm_InputData *i_data = (Tm_InputData *) clientData;
  493.     Tcl_Interp *interp = i_data->interp;
  494.     char *command = i_data->command;
  495.     char *message;
  496.  
  497.     /* should "expand percents" first */
  498.     if (Tcl_Eval(interp, command) != TCL_OK) {
  499.     message = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  500.     if (message == NULL) {
  501.         message = interp->result;
  502.     }
  503.     /* we don't have an AppContext for an XtAppWarningMessage! */
  504.     fprintf(stderr, "%s\n", message);
  505.     }
  506. }
  507.  
  508. /*
  509.  *--------------------------------------------------------------
  510.  *
  511.  * Tm_TimerHandler --
  512.  *
  513.  * Results:
  514.  *     none
  515.  *
  516.  * Side effects:
  517.  *     could be any - this handles any Xt timer
  518.  *
  519.  *--------------------------------------------------------------
  520.  */
  521.  
  522. void
  523. Tm_TimerHandler(clientData, id)
  524.     XtPointer clientData;
  525.     XtIntervalId *id;
  526. {
  527.     Tm_TimerData *t_data = (Tm_TimerData *) clientData;
  528.     Tcl_Interp *interp = t_data->interp;
  529.     char *command = t_data->command;
  530.     char *message;
  531.  
  532.     /* should "expand percents" first */
  533.     if (Tcl_Eval(interp, command) != TCL_OK) {
  534.     message = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  535.     if (message == NULL) {
  536.         message = interp->result;
  537.     }
  538.     /* we don't have an AppContext for an XtAppWarningMessage! */
  539.     fprintf(stderr, "%s\n", message);
  540.     }
  541.     XtFree(command);
  542.     XtFree((char *) clientData);
  543. }
  544.  
  545.  
  546. /*
  547.  *--------------------------------------------------------------
  548.  *
  549.  * Tm_GetGC --
  550.  *
  551.  *    get a graphics context attached to a widget
  552.  *
  553.  * Results:
  554.  *
  555.  * Side effects:
  556.  *
  557.  *--------------------------------------------------------------
  558.  */
  559.  
  560. char *
  561. Tm_GetGC(pathName, interp, w, class, argv, argc)
  562.     char *pathName;
  563.     Tcl_Interp *interp;
  564.     Widget w;
  565.     WidgetClass class;
  566.     char **argv;
  567.     int argc;
  568. {
  569.     XrmValue from, converted;
  570.     char *new_value;
  571.     char *resource;
  572.     XGCValues gc_value;
  573.     XtGCMask mask = 0;
  574.     GC gc;
  575.     char *buf;
  576.  
  577.     while (argc >= 2) {
  578.     if (argv[0][0] != '-') {
  579.         fprintf(stderr, "Skipping argument %s\n", argv[0]);
  580.         argc -= 2; argv += 2;
  581.         continue;
  582.     }
  583.     resource = argv[0]+1;
  584.  
  585.     if (strcmp(resource, XmNforeground) == 0) {    
  586.             if (Tm_ConvertValue(w, XmRString, argv[1], strlen(argv[1]),
  587.         XmRPixel, &gc_value.foreground, sizeof(unsigned long))) {
  588.         mask |= GCForeground;
  589.         }
  590.     } else
  591.  
  592.     if (strcmp(resource, XmNbackground) == 0) {    
  593.             if (Tm_ConvertValue(w, XmRString, argv[1], strlen(argv[1]),
  594.         XmRPixel, &gc_value.background, sizeof(unsigned long))) {
  595.         mask |= GCBackground;
  596.         }
  597.     } else
  598.  
  599.     if (strcmp(resource, XmNfont) == 0) {    
  600.             if (Tm_ConvertValue(w, XmRString, argv[1], strlen(argv[1]),
  601.         XmRFont, &gc_value.font, sizeof(unsigned long))) {
  602.         mask |= GCFont;
  603.         }
  604.     }
  605.     argc -= 2;
  606.     argv += 2;
  607.     }
  608.  
  609.     buf = XtMalloc(16);
  610.     gc = XtGetGC(w, mask, &gc_value);
  611. /*    %p may be broken on the Sun, so fit into an XtArgVal
  612.     sprintf(buf, "%p", (void *) gc);
  613. */
  614.     /* allow simple type checking: prefix value with "gc-" */
  615.     sprintf(buf, "gc-%lu", (long) gc);
  616.     return buf;
  617. }
  618.