tkGet.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:18k
源码类别:

通讯编程

开发平台:

Visual C++

  1. /* 
  2.  * tkGet.c --
  3.  *
  4.  * This file contains a number of "Tk_GetXXX" procedures, which
  5.  * parse text strings into useful forms for Tk.  This file has
  6.  * the simpler procedures, like Tk_GetDirection and Tk_GetUid.
  7.  * The more complex procedures like Tk_GetColor are in separate
  8.  * files.
  9.  *
  10.  * Copyright (c) 1991-1994 The Regents of the University of California.
  11.  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  *
  16.  * RCS: @(#) $Id: tkGet.c,v 1.10 2002/08/05 04:30:38 dgp Exp $
  17.  */
  18. #include "tkInt.h"
  19. #include "tkPort.h"
  20. /*
  21.  * One of these structures is created per thread to store 
  22.  * thread-specific data.  In this case, it is used to house the 
  23.  * Tk_Uid structs used by each thread.  The "dataKey" below is 
  24.  * used to locate the ThreadSpecificData for the current thread.
  25.  */
  26. typedef struct ThreadSpecificData {
  27.     int initialized;
  28.     Tcl_HashTable uidTable;
  29. } ThreadSpecificData;
  30. static Tcl_ThreadDataKey dataKey;
  31. static void FreeUidThreadExitProc _ANSI_ARGS_((ClientData clientData));
  32. /*
  33.  * The following tables defines the string values for reliefs, which are
  34.  * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
  35.  */
  36. static CONST char *anchorStrings[] = {
  37.     "n", "ne", "e", "se", "s", "sw", "w", "nw", "center", (char *) NULL
  38. };
  39. static CONST char *justifyStrings[] = {
  40.     "left", "right", "center", (char *) NULL
  41. };
  42. /*
  43.  *----------------------------------------------------------------------
  44.  *
  45.  * Tk_GetAnchorFromObj --
  46.  *
  47.  * Return a Tk_Anchor value based on the value of the objPtr.
  48.  *
  49.  * Results:
  50.  * The return value is a standard Tcl result. If an error occurs during
  51.  * conversion, an error message is left in the interpreter's result
  52.  * unless "interp" is NULL.
  53.  *
  54.  * Side effects:
  55.  * The object gets converted by Tcl_GetIndexFromObj.
  56.  *
  57.  *----------------------------------------------------------------------
  58.  */
  59. int
  60. Tk_GetAnchorFromObj(interp, objPtr, anchorPtr)
  61.     Tcl_Interp *interp; /* Used for error reporting. */
  62.     Tcl_Obj *objPtr; /* The object we are trying to get the 
  63.  * value from. */
  64.     Tk_Anchor *anchorPtr; /* Where to place the Tk_Anchor that
  65.  * corresponds to the string value of
  66.  * objPtr. */
  67. {
  68.     int index, code;
  69.     code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0, 
  70.     &index);
  71.     if (code == TCL_OK) {
  72. *anchorPtr = (Tk_Anchor) index;
  73.     }
  74.     return code;
  75. }
  76. /*
  77.  *--------------------------------------------------------------
  78.  *
  79.  * Tk_GetAnchor --
  80.  *
  81.  * Given a string, return the corresponding Tk_Anchor.
  82.  *
  83.  * Results:
  84.  * The return value is a standard Tcl return result.  If
  85.  * TCL_OK is returned, then everything went well and the
  86.  * position is stored at *anchorPtr;  otherwise TCL_ERROR
  87.  * is returned and an error message is left in
  88.  * the interp's result.
  89.  *
  90.  * Side effects:
  91.  * None.
  92.  *
  93.  *--------------------------------------------------------------
  94.  */
  95. int
  96. Tk_GetAnchor(interp, string, anchorPtr)
  97.     Tcl_Interp *interp; /* Use this for error reporting. */
  98.     CONST char *string; /* String describing a direction. */
  99.     Tk_Anchor *anchorPtr; /* Where to store Tk_Anchor corresponding
  100.  * to string. */
  101. {
  102.     switch (string[0]) {
  103. case 'n':
  104.     if (string[1] == 0) {
  105. *anchorPtr = TK_ANCHOR_N;
  106. return TCL_OK;
  107.     } else if ((string[1] == 'e') && (string[2] == 0)) {
  108. *anchorPtr = TK_ANCHOR_NE;
  109. return TCL_OK;
  110.     } else if ((string[1] == 'w') && (string[2] == 0)) {
  111. *anchorPtr = TK_ANCHOR_NW;
  112. return TCL_OK;
  113.     }
  114.     goto error;
  115. case 's':
  116.     if (string[1] == 0) {
  117. *anchorPtr = TK_ANCHOR_S;
  118. return TCL_OK;
  119.     } else if ((string[1] == 'e') && (string[2] == 0)) {
  120. *anchorPtr = TK_ANCHOR_SE;
  121. return TCL_OK;
  122.     } else if ((string[1] == 'w') && (string[2] == 0)) {
  123. *anchorPtr = TK_ANCHOR_SW;
  124. return TCL_OK;
  125.     } else {
  126. goto error;
  127.     }
  128. case 'e':
  129.     if (string[1] == 0) {
  130. *anchorPtr = TK_ANCHOR_E;
  131. return TCL_OK;
  132.     }
  133.     goto error;
  134. case 'w':
  135.     if (string[1] == 0) {
  136. *anchorPtr = TK_ANCHOR_W;
  137. return TCL_OK;
  138.     }
  139.     goto error;
  140. case 'c':
  141.     if (strncmp(string, "center", strlen(string)) == 0) {
  142. *anchorPtr = TK_ANCHOR_CENTER;
  143. return TCL_OK;
  144.     }
  145.     goto error;
  146.     }
  147.     error:
  148.     Tcl_AppendResult(interp, "bad anchor position "", string,
  149.     "": must be n, ne, e, se, s, sw, w, nw, or center",
  150.     (char *) NULL);
  151.     return TCL_ERROR;
  152. }
  153. /*
  154.  *--------------------------------------------------------------
  155.  *
  156.  * Tk_NameOfAnchor --
  157.  *
  158.  * Given a Tk_Anchor, return the string that corresponds
  159.  * to it.
  160.  *
  161.  * Results:
  162.  * None.
  163.  *
  164.  * Side effects:
  165.  * None.
  166.  *
  167.  *--------------------------------------------------------------
  168.  */
  169. CONST char *
  170. Tk_NameOfAnchor(anchor)
  171.     Tk_Anchor anchor; /* Anchor for which identifying string
  172.  * is desired. */
  173. {
  174.     switch (anchor) {
  175. case TK_ANCHOR_N: return "n";
  176. case TK_ANCHOR_NE: return "ne";
  177. case TK_ANCHOR_E: return "e";
  178. case TK_ANCHOR_SE: return "se";
  179. case TK_ANCHOR_S: return "s";
  180. case TK_ANCHOR_SW: return "sw";
  181. case TK_ANCHOR_W: return "w";
  182. case TK_ANCHOR_NW: return "nw";
  183. case TK_ANCHOR_CENTER: return "center";
  184.     }
  185.     return "unknown anchor position";
  186. }
  187. /*
  188.  *--------------------------------------------------------------
  189.  *
  190.  * Tk_GetJoinStyle --
  191.  *
  192.  * Given a string, return the corresponding Tk JoinStyle.
  193.  *
  194.  * Results:
  195.  * The return value is a standard Tcl return result.  If
  196.  * TCL_OK is returned, then everything went well and the
  197.  * justification is stored at *joinPtr;  otherwise
  198.  * TCL_ERROR is returned and an error message is left in
  199.  * the interp's result.
  200.  *
  201.  * Side effects:
  202.  * None.
  203.  *
  204.  *--------------------------------------------------------------
  205.  */
  206. int
  207. Tk_GetJoinStyle(interp, string, joinPtr)
  208.     Tcl_Interp *interp; /* Use this for error reporting. */
  209.     CONST char *string; /* String describing a justification style. */
  210.     int *joinPtr; /* Where to store join style corresponding
  211.  * to string. */
  212. {
  213.     int c;
  214.     size_t length;
  215.     c = string[0];
  216.     length = strlen(string);
  217.     if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
  218. *joinPtr = JoinBevel;
  219. return TCL_OK;
  220.     }
  221.     if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
  222. *joinPtr = JoinMiter;
  223. return TCL_OK;
  224.     }
  225.     if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
  226. *joinPtr = JoinRound;
  227. return TCL_OK;
  228.     }
  229.     Tcl_AppendResult(interp, "bad join style "", string,
  230.     "": must be bevel, miter, or round",
  231.     (char *) NULL);
  232.     return TCL_ERROR;
  233. }
  234. /*
  235.  *--------------------------------------------------------------
  236.  *
  237.  * Tk_NameOfJoinStyle --
  238.  *
  239.  * Given a Tk JoinStyle, return the string that corresponds
  240.  * to it.
  241.  *
  242.  * Results:
  243.  * None.
  244.  *
  245.  * Side effects:
  246.  * None.
  247.  *
  248.  *--------------------------------------------------------------
  249.  */
  250. CONST char *
  251. Tk_NameOfJoinStyle(join)
  252.     int join; /* Join style for which identifying string
  253.  * is desired. */
  254. {
  255.     switch (join) {
  256. case JoinBevel: return "bevel";
  257. case JoinMiter: return "miter";
  258. case JoinRound: return "round";
  259.     }
  260.     return "unknown join style";
  261. }
  262. /*
  263.  *--------------------------------------------------------------
  264.  *
  265.  * Tk_GetCapStyle --
  266.  *
  267.  * Given a string, return the corresponding Tk CapStyle.
  268.  *
  269.  * Results:
  270.  * The return value is a standard Tcl return result.  If
  271.  * TCL_OK is returned, then everything went well and the
  272.  * justification is stored at *capPtr;  otherwise
  273.  * TCL_ERROR is returned and an error message is left in
  274.  * the interp's result.
  275.  *
  276.  * Side effects:
  277.  * None.
  278.  *
  279.  *--------------------------------------------------------------
  280.  */
  281. int
  282. Tk_GetCapStyle(interp, string, capPtr)
  283.     Tcl_Interp *interp; /* Use this for error reporting. */
  284.     CONST char *string; /* String describing a justification style. */
  285.     int *capPtr; /* Where to store cap style corresponding
  286.  * to string. */
  287. {
  288.     int c;
  289.     size_t length;
  290.     c = string[0];
  291.     length = strlen(string);
  292.     if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
  293. *capPtr = CapButt;
  294. return TCL_OK;
  295.     }
  296.     if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
  297. *capPtr = CapProjecting;
  298. return TCL_OK;
  299.     }
  300.     if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
  301. *capPtr = CapRound;
  302. return TCL_OK;
  303.     }
  304.     Tcl_AppendResult(interp, "bad cap style "", string,
  305.     "": must be butt, projecting, or round",
  306.     (char *) NULL);
  307.     return TCL_ERROR;
  308. }
  309. /*
  310.  *--------------------------------------------------------------
  311.  *
  312.  * Tk_NameOfCapStyle --
  313.  *
  314.  * Given a Tk CapStyle, return the string that corresponds
  315.  * to it.
  316.  *
  317.  * Results:
  318.  * None.
  319.  *
  320.  * Side effects:
  321.  * None.
  322.  *
  323.  *--------------------------------------------------------------
  324.  */
  325. CONST char *
  326. Tk_NameOfCapStyle(cap)
  327.     int cap; /* Cap style for which identifying string
  328.  * is desired. */
  329. {
  330.     switch (cap) {
  331. case CapButt: return "butt";
  332. case CapProjecting: return "projecting";
  333. case CapRound: return "round";
  334.     }
  335.     return "unknown cap style";
  336. }
  337. /*
  338.  *----------------------------------------------------------------------
  339.  *
  340.  * Tk_GetJustifyFromObj --
  341.  *
  342.  * Return a Tk_Justify value based on the value of the objPtr.
  343.  *
  344.  * Results:
  345.  * The return value is a standard Tcl result. If an error occurs during
  346.  * conversion, an error message is left in the interpreter's result
  347.  * unless "interp" is NULL.
  348.  *
  349.  * Side effects:
  350.  * The object gets converted by Tcl_GetIndexFromObj.
  351.  *
  352.  *----------------------------------------------------------------------
  353.  */
  354. int
  355. Tk_GetJustifyFromObj(interp, objPtr, justifyPtr)
  356.     Tcl_Interp *interp; /* Used for error reporting. */
  357.     Tcl_Obj *objPtr; /* The object we are trying to get the 
  358.  * value from. */
  359.     Tk_Justify *justifyPtr; /* Where to place the Tk_Justify that
  360.  * corresponds to the string value of
  361.  * objPtr. */
  362. {
  363.     int index, code;
  364.     code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings,
  365.     "justification", 0, &index);
  366.     if (code == TCL_OK) {
  367. *justifyPtr = (Tk_Justify) index;
  368.     }
  369.     return code;
  370. }
  371. /*
  372.  *--------------------------------------------------------------
  373.  *
  374.  * Tk_GetJustify --
  375.  *
  376.  * Given a string, return the corresponding Tk_Justify.
  377.  *
  378.  * Results:
  379.  * The return value is a standard Tcl return result.  If
  380.  * TCL_OK is returned, then everything went well and the
  381.  * justification is stored at *justifyPtr;  otherwise
  382.  * TCL_ERROR is returned and an error message is left in
  383.  * the interp's result.
  384.  *
  385.  * Side effects:
  386.  * None.
  387.  *
  388.  *--------------------------------------------------------------
  389.  */
  390. int
  391. Tk_GetJustify(interp, string, justifyPtr)
  392.     Tcl_Interp *interp; /* Use this for error reporting. */
  393.     CONST char *string; /* String describing a justification style. */
  394.     Tk_Justify *justifyPtr; /* Where to store Tk_Justify corresponding
  395.  * to string. */
  396. {
  397.     int c;
  398.     size_t length;
  399.     c = string[0];
  400.     length = strlen(string);
  401.     if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
  402. *justifyPtr = TK_JUSTIFY_LEFT;
  403. return TCL_OK;
  404.     }
  405.     if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
  406. *justifyPtr = TK_JUSTIFY_RIGHT;
  407. return TCL_OK;
  408.     }
  409.     if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
  410. *justifyPtr = TK_JUSTIFY_CENTER;
  411. return TCL_OK;
  412.     }
  413.     Tcl_AppendResult(interp, "bad justification "", string,
  414.     "": must be left, right, or center",
  415.     (char *) NULL);
  416.     return TCL_ERROR;
  417. }
  418. /*
  419.  *--------------------------------------------------------------
  420.  *
  421.  * Tk_NameOfJustify --
  422.  *
  423.  * Given a Tk_Justify, return the string that corresponds
  424.  * to it.
  425.  *
  426.  * Results:
  427.  * None.
  428.  *
  429.  * Side effects:
  430.  * None.
  431.  *
  432.  *--------------------------------------------------------------
  433.  */
  434. CONST char *
  435. Tk_NameOfJustify(justify)
  436.     Tk_Justify justify; /* Justification style for which
  437.  * identifying string is desired. */
  438. {
  439.     switch (justify) {
  440. case TK_JUSTIFY_LEFT: return "left";
  441. case TK_JUSTIFY_RIGHT: return "right";
  442. case TK_JUSTIFY_CENTER: return "center";
  443.     }
  444.     return "unknown justification style";
  445. }
  446. /*
  447.  *----------------------------------------------------------------------
  448.  *
  449.  * FreeUidThreadExitProc --
  450.  *
  451.  * Cleans up memory used for Tk_Uids in the thread.
  452.  *
  453.  * Results:
  454.  * None.
  455.  *
  456.  * Side effects:
  457.  * All information in the identifier table is deleted.
  458.  *
  459.  *----------------------------------------------------------------------
  460.  */
  461. static void
  462. FreeUidThreadExitProc(clientData)
  463.     ClientData clientData; /* Not used. */
  464. {
  465.     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
  466.             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  467.     Tcl_DeleteHashTable(&tsdPtr->uidTable);
  468.     tsdPtr->initialized = 0;
  469. }
  470. /*
  471.  *----------------------------------------------------------------------
  472.  *
  473.  * Tk_GetUid --
  474.  *
  475.  * Given a string, this procedure returns a unique identifier
  476.  * for the string.
  477.  *
  478.  * Results:
  479.  * This procedure returns a Tk_Uid corresponding to the "string"
  480.  * argument.  The Tk_Uid has a string value identical to string
  481.  * (strcmp will return 0), but it's guaranteed that any other
  482.  * calls to this procedure with a string equal to "string" will
  483.  * return exactly the same result (i.e. can compare Tk_Uid
  484.  * *values* directly, without having to call strcmp on what they
  485.  * point to).
  486.  *
  487.  * Side effects:
  488.  * New information may be entered into the identifier table.
  489.  *
  490.  *----------------------------------------------------------------------
  491.  */
  492. Tk_Uid
  493. Tk_GetUid(string)
  494.     CONST char *string; /* String to convert. */
  495. {
  496.     int dummy;
  497.     ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
  498.             Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  499.     Tcl_HashTable *tablePtr = &tsdPtr->uidTable;
  500.     if (!tsdPtr->initialized) {
  501. Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
  502. Tcl_CreateThreadExitHandler(FreeUidThreadExitProc, NULL);
  503. tsdPtr->initialized = 1;
  504.     }
  505.     return (Tk_Uid) Tcl_GetHashKey(tablePtr,
  506.     Tcl_CreateHashEntry(tablePtr, string, &dummy));
  507. }
  508. /*
  509.  *--------------------------------------------------------------
  510.  *
  511.  * Tk_GetScreenMM --
  512.  *
  513.  * Given a string, returns the number of screen millimeters
  514.  * corresponding to that string.
  515.  *
  516.  * Results:
  517.  * The return value is a standard Tcl return result.  If
  518.  * TCL_OK is returned, then everything went well and the
  519.  * screen distance is stored at *doublePtr;  otherwise
  520.  * TCL_ERROR is returned and an error message is left in
  521.  * the interp's result.
  522.  *
  523.  * Side effects:
  524.  * None.
  525.  *
  526.  *--------------------------------------------------------------
  527.  */
  528. int
  529. Tk_GetScreenMM(interp, tkwin, string, doublePtr)
  530.     Tcl_Interp *interp; /* Use this for error reporting. */
  531.     Tk_Window tkwin; /* Window whose screen determines conversion
  532.  * from centimeters and other absolute
  533.  * units. */
  534.     CONST char *string; /* String describing a screen distance. */
  535.     double *doublePtr; /* Place to store converted result. */
  536. {
  537.     char *end;
  538.     double d;
  539.     d = strtod(string, &end);
  540.     if (end == string) {
  541. error:
  542. Tcl_AppendResult(interp, "bad screen distance "", string,
  543. """, (char *) NULL);
  544. return TCL_ERROR;
  545.     }
  546.     while ((*end != '') && isspace(UCHAR(*end))) {
  547. end++;
  548.     }
  549.     switch (*end) {
  550. case 0:
  551.     d /= WidthOfScreen(Tk_Screen(tkwin));
  552.     d *= WidthMMOfScreen(Tk_Screen(tkwin));
  553.     break;
  554. case 'c':
  555.     d *= 10;
  556.     end++;
  557.     break;
  558. case 'i':
  559.     d *= 25.4;
  560.     end++;
  561.     break;
  562. case 'm':
  563.     end++;
  564.     break;
  565. case 'p':
  566.     d *= 25.4/72.0;
  567.     end++;
  568.     break;
  569. default:
  570.     goto error;
  571.     }
  572.     while ((*end != '') && isspace(UCHAR(*end))) {
  573. end++;
  574.     }
  575.     if (*end != 0) {
  576. goto error;
  577.     }
  578.     *doublePtr = d;
  579.     return TCL_OK;
  580. }
  581. /*
  582.  *--------------------------------------------------------------
  583.  *
  584.  * Tk_GetPixels --
  585.  *
  586.  * Given a string, returns the number of pixels corresponding
  587.  * to that string.
  588.  *
  589.  * Results:
  590.  * The return value is a standard Tcl return result.  If
  591.  * TCL_OK is returned, then everything went well and the
  592.  * rounded pixel distance is stored at *intPtr;  otherwise
  593.  * TCL_ERROR is returned and an error message is left in
  594.  * the interp's result.
  595.  *
  596.  * Side effects:
  597.  * None.
  598.  *
  599.  *--------------------------------------------------------------
  600.  */
  601. int
  602. Tk_GetPixels(interp, tkwin, string, intPtr)
  603.     Tcl_Interp *interp; /* Use this for error reporting. */
  604.     Tk_Window tkwin; /* Window whose screen determines conversion
  605.  * from centimeters and other absolute
  606.  * units. */
  607.     CONST char *string; /* String describing a number of pixels. */
  608.     int *intPtr; /* Place to store converted result. */
  609. {
  610.     double d;
  611.     if (TkGetDoublePixels(interp, tkwin, string, &d) != TCL_OK) {
  612. return TCL_ERROR;
  613.     }
  614.     if (d < 0) {
  615. *intPtr = (int) (d - 0.5);
  616.     } else {
  617. *intPtr = (int) (d + 0.5);
  618.     }
  619.     return TCL_OK;
  620. }
  621. /*
  622.  *--------------------------------------------------------------
  623.  *
  624.  * TkGetDoublePixels --
  625.  *
  626.  * Given a string, returns the number of pixels corresponding
  627.  * to that string.
  628.  *
  629.  * Results:
  630.  * The return value is a standard Tcl return result.  If
  631.  * TCL_OK is returned, then everything went well and the
  632.  * pixel distance is stored at *doublePtr;  otherwise
  633.  * TCL_ERROR is returned and an error message is left in
  634.  * interp->result.
  635.  *
  636.  * Side effects:
  637.  * None.
  638.  *
  639.  *--------------------------------------------------------------
  640.  */
  641. int
  642. TkGetDoublePixels(interp, tkwin, string, doublePtr)
  643.     Tcl_Interp *interp; /* Use this for error reporting. */
  644.     Tk_Window tkwin; /* Window whose screen determines conversion
  645.  * from centimeters and other absolute
  646.  * units. */
  647.     CONST char *string; /* String describing a number of pixels. */
  648.     double *doublePtr; /* Place to store converted result. */
  649. {
  650.     char *end;
  651.     double d;
  652.     d = strtod((char *) string, &end);
  653.     if (end == string) {
  654. error:
  655. Tcl_AppendResult(interp, "bad screen distance "", string,
  656. """, (char *) NULL);
  657. return TCL_ERROR;
  658.     }
  659.     while ((*end != '') && isspace(UCHAR(*end))) {
  660. end++;
  661.     }
  662.     switch (*end) {
  663. case 0:
  664.     break;
  665. case 'c':
  666.     d *= 10*WidthOfScreen(Tk_Screen(tkwin));
  667.     d /= WidthMMOfScreen(Tk_Screen(tkwin));
  668.     end++;
  669.     break;
  670. case 'i':
  671.     d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
  672.     d /= WidthMMOfScreen(Tk_Screen(tkwin));
  673.     end++;
  674.     break;
  675. case 'm':
  676.     d *= WidthOfScreen(Tk_Screen(tkwin));
  677.     d /= WidthMMOfScreen(Tk_Screen(tkwin));
  678.     end++;
  679.     break;
  680. case 'p':
  681.     d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
  682.     d /= WidthMMOfScreen(Tk_Screen(tkwin));
  683.     end++;
  684.     break;
  685. default:
  686.     goto error;
  687.     }
  688.     while ((*end != '') && isspace(UCHAR(*end))) {
  689. end++;
  690.     }
  691.     if (*end != 0) {
  692. goto error;
  693.     }
  694.     *doublePtr = d;
  695.     return TCL_OK;
  696. }