758 lines
18 KiB
C
758 lines
18 KiB
C
/*
|
||
* tkGet.c --
|
||
*
|
||
* This file contains a number of "Tk_GetXXX" procedures, which parse
|
||
* text strings into useful forms for Tk. This file has the simpler
|
||
* functions, like Tk_GetDirection and Tk_GetUid. The more complex
|
||
* functions like Tk_GetColor are in separate files.
|
||
*
|
||
* Copyright (c) 1991-1994 The Regents of the University of California.
|
||
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
|
||
*
|
||
* See the file "license.terms" for information on usage and redistribution of
|
||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||
*/
|
||
|
||
#include "tkInt.h"
|
||
|
||
/*
|
||
* One of these structures is created per thread to store thread-specific
|
||
* data. In this case, it is used to house the Tk_Uid structs used by each
|
||
* thread. The "dataKey" below is used to locate the ThreadSpecificData for
|
||
* the current thread.
|
||
*/
|
||
|
||
typedef struct {
|
||
int initialized;
|
||
Tcl_HashTable uidTable;
|
||
} ThreadSpecificData;
|
||
static Tcl_ThreadDataKey dataKey;
|
||
|
||
static void FreeUidThreadExitProc(ClientData clientData);
|
||
|
||
/*
|
||
* The following tables defines the string values for reliefs, which are
|
||
* used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
|
||
*/
|
||
|
||
static const char *const anchorStrings[] = {
|
||
"n", "ne", "e", "se", "s", "sw", "w", "nw", "center", NULL
|
||
};
|
||
static const char *const justifyStrings[] = {
|
||
"left", "right", "center", NULL
|
||
};
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tk_GetAnchorFromObj --
|
||
*
|
||
* Return a Tk_Anchor value based on the value of the objPtr.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl result. If an error occurs during
|
||
* conversion, an error message is left in the interpreter's result
|
||
* unless "interp" is NULL.
|
||
*
|
||
* Side effects:
|
||
* The object gets converted by Tcl_GetIndexFromObj.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_GetAnchorFromObj(
|
||
Tcl_Interp *interp, /* Used for error reporting. */
|
||
Tcl_Obj *objPtr, /* The object we are trying to get the value
|
||
* from. */
|
||
Tk_Anchor *anchorPtr) /* Where to place the Tk_Anchor that
|
||
* corresponds to the string value of
|
||
* objPtr. */
|
||
{
|
||
int index, code;
|
||
|
||
code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0,
|
||
&index);
|
||
if (code == TCL_OK) {
|
||
*anchorPtr = (Tk_Anchor) index;
|
||
}
|
||
return code;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_GetAnchor --
|
||
*
|
||
* Given a string, return the corresponding Tk_Anchor.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl return result. If TCL_OK is
|
||
* returned, then everything went well and the position is stored at
|
||
* *anchorPtr; otherwise TCL_ERROR is returned and an error message is
|
||
* left in the interp's result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_GetAnchor(
|
||
Tcl_Interp *interp, /* Use this for error reporting. */
|
||
const char *string, /* String describing a direction. */
|
||
Tk_Anchor *anchorPtr) /* Where to store Tk_Anchor corresponding to
|
||
* string. */
|
||
{
|
||
switch (string[0]) {
|
||
case 'n':
|
||
if (string[1] == 0) {
|
||
*anchorPtr = TK_ANCHOR_N;
|
||
return TCL_OK;
|
||
} else if ((string[1] == 'e') && (string[2] == 0)) {
|
||
*anchorPtr = TK_ANCHOR_NE;
|
||
return TCL_OK;
|
||
} else if ((string[1] == 'w') && (string[2] == 0)) {
|
||
*anchorPtr = TK_ANCHOR_NW;
|
||
return TCL_OK;
|
||
}
|
||
goto error;
|
||
case 's':
|
||
if (string[1] == 0) {
|
||
*anchorPtr = TK_ANCHOR_S;
|
||
return TCL_OK;
|
||
} else if ((string[1] == 'e') && (string[2] == 0)) {
|
||
*anchorPtr = TK_ANCHOR_SE;
|
||
return TCL_OK;
|
||
} else if ((string[1] == 'w') && (string[2] == 0)) {
|
||
*anchorPtr = TK_ANCHOR_SW;
|
||
return TCL_OK;
|
||
} else {
|
||
goto error;
|
||
}
|
||
case 'e':
|
||
if (string[1] == 0) {
|
||
*anchorPtr = TK_ANCHOR_E;
|
||
return TCL_OK;
|
||
}
|
||
goto error;
|
||
case 'w':
|
||
if (string[1] == 0) {
|
||
*anchorPtr = TK_ANCHOR_W;
|
||
return TCL_OK;
|
||
}
|
||
goto error;
|
||
case 'c':
|
||
if (strncmp(string, "center", strlen(string)) == 0) {
|
||
*anchorPtr = TK_ANCHOR_CENTER;
|
||
return TCL_OK;
|
||
}
|
||
goto error;
|
||
}
|
||
|
||
error:
|
||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||
"bad anchor position \"%s\": must be"
|
||
" n, ne, e, se, s, sw, w, nw, or center", string));
|
||
Tcl_SetErrorCode(interp, "TK", "VALUE", "ANCHOR", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_NameOfAnchor --
|
||
*
|
||
* Given a Tk_Anchor, return the string that corresponds to it.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
const char *
|
||
Tk_NameOfAnchor(
|
||
Tk_Anchor anchor) /* Anchor for which identifying string is
|
||
* desired. */
|
||
{
|
||
switch (anchor) {
|
||
case TK_ANCHOR_N: return "n";
|
||
case TK_ANCHOR_NE: return "ne";
|
||
case TK_ANCHOR_E: return "e";
|
||
case TK_ANCHOR_SE: return "se";
|
||
case TK_ANCHOR_S: return "s";
|
||
case TK_ANCHOR_SW: return "sw";
|
||
case TK_ANCHOR_W: return "w";
|
||
case TK_ANCHOR_NW: return "nw";
|
||
case TK_ANCHOR_CENTER: return "center";
|
||
}
|
||
return "unknown anchor position";
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_GetJoinStyle --
|
||
*
|
||
* Given a string, return the corresponding Tk JoinStyle.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl return result. If TCL_OK is
|
||
* returned, then everything went well and the justification is stored at
|
||
* *joinPtr; otherwise TCL_ERROR is returned and an error message is left
|
||
* in the interp's result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_GetJoinStyle(
|
||
Tcl_Interp *interp, /* Use this for error reporting. */
|
||
const char *string, /* String describing a justification style. */
|
||
int *joinPtr) /* Where to store join style corresponding to
|
||
* string. */
|
||
{
|
||
int c;
|
||
size_t length;
|
||
|
||
c = string[0];
|
||
length = strlen(string);
|
||
|
||
if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
|
||
*joinPtr = JoinBevel;
|
||
return TCL_OK;
|
||
}
|
||
if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
|
||
*joinPtr = JoinMiter;
|
||
return TCL_OK;
|
||
}
|
||
if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
|
||
*joinPtr = JoinRound;
|
||
return TCL_OK;
|
||
}
|
||
|
||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||
"bad join style \"%s\": must be bevel, miter, or round",
|
||
string));
|
||
Tcl_SetErrorCode(interp, "TK", "VALUE", "JOIN", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_NameOfJoinStyle --
|
||
*
|
||
* Given a Tk JoinStyle, return the string that corresponds to it.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
const char *
|
||
Tk_NameOfJoinStyle(
|
||
int join) /* Join style for which identifying string is
|
||
* desired. */
|
||
{
|
||
switch (join) {
|
||
case JoinBevel: return "bevel";
|
||
case JoinMiter: return "miter";
|
||
case JoinRound: return "round";
|
||
}
|
||
return "unknown join style";
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_GetCapStyle --
|
||
*
|
||
* Given a string, return the corresponding Tk CapStyle.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl return result. If TCL_OK is
|
||
* returned, then everything went well and the justification is stored at
|
||
* *capPtr; otherwise TCL_ERROR is returned and an error message is left
|
||
* in the interp's result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_GetCapStyle(
|
||
Tcl_Interp *interp, /* Use this for error reporting. */
|
||
const char *string, /* String describing a justification style. */
|
||
int *capPtr) /* Where to store cap style corresponding to
|
||
* string. */
|
||
{
|
||
int c;
|
||
size_t length;
|
||
|
||
c = string[0];
|
||
length = strlen(string);
|
||
|
||
if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
|
||
*capPtr = CapButt;
|
||
return TCL_OK;
|
||
}
|
||
if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
|
||
*capPtr = CapProjecting;
|
||
return TCL_OK;
|
||
}
|
||
if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
|
||
*capPtr = CapRound;
|
||
return TCL_OK;
|
||
}
|
||
|
||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||
"bad cap style \"%s\": must be butt, projecting, or round",
|
||
string));
|
||
Tcl_SetErrorCode(interp, "TK", "VALUE", "CAP", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_NameOfCapStyle --
|
||
*
|
||
* Given a Tk CapStyle, return the string that corresponds to it.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
const char *
|
||
Tk_NameOfCapStyle(
|
||
int cap) /* Cap style for which identifying string is
|
||
* desired. */
|
||
{
|
||
switch (cap) {
|
||
case CapButt: return "butt";
|
||
case CapProjecting: return "projecting";
|
||
case CapRound: return "round";
|
||
}
|
||
return "unknown cap style";
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tk_GetJustifyFromObj --
|
||
*
|
||
* Return a Tk_Justify value based on the value of the objPtr.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl result. If an error occurs during
|
||
* conversion, an error message is left in the interpreter's result
|
||
* unless "interp" is NULL.
|
||
*
|
||
* Side effects:
|
||
* The object gets converted by Tcl_GetIndexFromObj.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_GetJustifyFromObj(
|
||
Tcl_Interp *interp, /* Used for error reporting. */
|
||
Tcl_Obj *objPtr, /* The object we are trying to get the value
|
||
* from. */
|
||
Tk_Justify *justifyPtr) /* Where to place the Tk_Justify that
|
||
* corresponds to the string value of
|
||
* objPtr. */
|
||
{
|
||
int index, code;
|
||
|
||
code = Tcl_GetIndexFromObj(interp, objPtr, justifyStrings,
|
||
"justification", 0, &index);
|
||
if (code == TCL_OK) {
|
||
*justifyPtr = (Tk_Justify) index;
|
||
}
|
||
return code;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_GetJustify --
|
||
*
|
||
* Given a string, return the corresponding Tk_Justify.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl return result. If TCL_OK is
|
||
* returned, then everything went well and the justification is stored at
|
||
* *justifyPtr; otherwise TCL_ERROR is returned and an error message is
|
||
* left in the interp's result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_GetJustify(
|
||
Tcl_Interp *interp, /* Use this for error reporting. */
|
||
const char *string, /* String describing a justification style. */
|
||
Tk_Justify *justifyPtr) /* Where to store Tk_Justify corresponding to
|
||
* string. */
|
||
{
|
||
int c;
|
||
size_t length;
|
||
|
||
c = string[0];
|
||
length = strlen(string);
|
||
|
||
if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
|
||
*justifyPtr = TK_JUSTIFY_LEFT;
|
||
return TCL_OK;
|
||
}
|
||
if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
|
||
*justifyPtr = TK_JUSTIFY_RIGHT;
|
||
return TCL_OK;
|
||
}
|
||
if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
|
||
*justifyPtr = TK_JUSTIFY_CENTER;
|
||
return TCL_OK;
|
||
}
|
||
|
||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||
"bad justification \"%s\": must be left, right, or center",
|
||
string));
|
||
Tcl_SetErrorCode(interp, "TK", "VALUE", "JUSTIFY", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_NameOfJustify --
|
||
*
|
||
* Given a Tk_Justify, return the string that corresponds
|
||
* to it.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
const char *
|
||
Tk_NameOfJustify(
|
||
Tk_Justify justify) /* Justification style for which identifying
|
||
* string is desired. */
|
||
{
|
||
switch (justify) {
|
||
case TK_JUSTIFY_LEFT: return "left";
|
||
case TK_JUSTIFY_RIGHT: return "right";
|
||
case TK_JUSTIFY_CENTER: return "center";
|
||
}
|
||
return "unknown justification style";
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* FreeUidThreadExitProc --
|
||
*
|
||
* Cleans up memory used for Tk_Uids in the thread.
|
||
*
|
||
* Results:
|
||
* None.
|
||
*
|
||
* Side effects:
|
||
* All information in the identifier table is deleted.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
static void
|
||
FreeUidThreadExitProc(
|
||
TCL_UNUSED(void *))
|
||
{
|
||
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
|
||
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
|
||
|
||
Tcl_DeleteHashTable(&tsdPtr->uidTable);
|
||
tsdPtr->initialized = 0;
|
||
}
|
||
|
||
/*
|
||
*----------------------------------------------------------------------
|
||
*
|
||
* Tk_GetUid --
|
||
*
|
||
* Given a string, this function returns a unique identifier for the
|
||
* string.
|
||
*
|
||
* Results:
|
||
* This function returns a Tk_Uid corresponding to the "string" argument.
|
||
* The Tk_Uid has a string value identical to string (strcmp will return
|
||
* 0), but it's guaranteed that any other calls to this function with a
|
||
* string equal to "string" will return exactly the same result (i.e. can
|
||
* compare Tk_Uid *values* directly, without having to call strcmp on
|
||
* what they point to).
|
||
*
|
||
* Side effects:
|
||
* New information may be entered into the identifier table.
|
||
*
|
||
*----------------------------------------------------------------------
|
||
*/
|
||
|
||
Tk_Uid
|
||
Tk_GetUid(
|
||
const char *string) /* String to convert. */
|
||
{
|
||
int dummy;
|
||
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
|
||
Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
|
||
Tcl_HashTable *tablePtr = &tsdPtr->uidTable;
|
||
|
||
if (!tsdPtr->initialized) {
|
||
Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
|
||
Tcl_CreateThreadExitHandler(FreeUidThreadExitProc, NULL);
|
||
tsdPtr->initialized = 1;
|
||
}
|
||
return (Tk_Uid) Tcl_GetHashKey(tablePtr,
|
||
Tcl_CreateHashEntry(tablePtr, string, &dummy));
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_GetScreenMM --
|
||
*
|
||
* Given a string, returns the number of screen millimeters corresponding
|
||
* to that string.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl return result. If TCL_OK is
|
||
* returned, then everything went well and the screen distance is stored
|
||
* at *doublePtr; otherwise TCL_ERROR is returned and an error message is
|
||
* left in the interp's result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_GetScreenMM(
|
||
Tcl_Interp *interp, /* Use this for error reporting. */
|
||
Tk_Window tkwin, /* Window whose screen determines conversion
|
||
* from centimeters and other absolute
|
||
* units. */
|
||
const char *string, /* String describing a screen distance. */
|
||
double *doublePtr) /* Place to store converted result. */
|
||
{
|
||
char *end;
|
||
double d;
|
||
|
||
d = strtod(string, &end);
|
||
if (end == string) {
|
||
goto error;
|
||
}
|
||
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
||
end++;
|
||
}
|
||
switch (*end) {
|
||
case 0:
|
||
d /= WidthOfScreen(Tk_Screen(tkwin));
|
||
d *= WidthMMOfScreen(Tk_Screen(tkwin));
|
||
break;
|
||
case 'c':
|
||
d *= 10;
|
||
end++;
|
||
break;
|
||
case 'i':
|
||
d *= 25.4;
|
||
end++;
|
||
break;
|
||
case 'm':
|
||
end++;
|
||
break;
|
||
case 'p':
|
||
d *= 25.4/72.0;
|
||
end++;
|
||
break;
|
||
default:
|
||
goto error;
|
||
}
|
||
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
||
end++;
|
||
}
|
||
if (*end != 0) {
|
||
goto error;
|
||
}
|
||
*doublePtr = d;
|
||
return TCL_OK;
|
||
|
||
error:
|
||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||
"bad screen distance \"%s\"", string));
|
||
Tcl_SetErrorCode(interp, "TK", "VALUE", "SCREEN_DISTANCE", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* Tk_GetPixels --
|
||
*
|
||
* Given a string, returns the number of pixels corresponding to that
|
||
* string.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl return result. If TCL_OK is
|
||
* returned, then everything went well and the rounded pixel distance is
|
||
* stored at *intPtr; otherwise TCL_ERROR is returned and an error
|
||
* message is left in the interp's result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
Tk_GetPixels(
|
||
Tcl_Interp *interp, /* Use this for error reporting. */
|
||
Tk_Window tkwin, /* Window whose screen determines conversion
|
||
* from centimeters and other absolute
|
||
* units. */
|
||
const char *string, /* String describing a number of pixels. */
|
||
int *intPtr) /* Place to store converted result. */
|
||
{
|
||
double d;
|
||
|
||
if (TkGetDoublePixels(interp, tkwin, string, &d) != TCL_OK) {
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
if (d < 0) {
|
||
*intPtr = (int) (d - 0.5);
|
||
} else {
|
||
*intPtr = (int) (d + 0.5);
|
||
}
|
||
return TCL_OK;
|
||
}
|
||
/*
|
||
*--------------------------------------------------------------
|
||
*
|
||
* TkGetDoublePixels --
|
||
*
|
||
* Given a string, returns the number of pixels corresponding to that
|
||
* string.
|
||
*
|
||
* Results:
|
||
* The return value is a standard Tcl return result. If TCL_OK is
|
||
* returned, then everything went well and the pixel distance is stored
|
||
* at *doublePtr; otherwise TCL_ERROR is returned and an error message is
|
||
* left in interp->result.
|
||
*
|
||
* Side effects:
|
||
* None.
|
||
*
|
||
*--------------------------------------------------------------
|
||
*/
|
||
|
||
int
|
||
TkGetDoublePixels(
|
||
Tcl_Interp *interp, /* Use this for error reporting. */
|
||
Tk_Window tkwin, /* Window whose screen determines conversion
|
||
* from centimeters and other absolute
|
||
* units. */
|
||
const char *string, /* String describing a number of pixels. */
|
||
double *doublePtr) /* Place to store converted result. */
|
||
{
|
||
char *end;
|
||
double d;
|
||
|
||
if (!tkwin) {
|
||
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad screen"));
|
||
Tcl_SetErrorCode(interp, "TK", "VALUE", "FRACTIONAL_PIXELS", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
d = strtod((char *) string, &end);
|
||
if (end == string) {
|
||
goto error;
|
||
}
|
||
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
||
end++;
|
||
}
|
||
switch (*end) {
|
||
case 0:
|
||
break;
|
||
case 'c':
|
||
d *= 10*WidthOfScreen(Tk_Screen(tkwin));
|
||
d /= WidthMMOfScreen(Tk_Screen(tkwin));
|
||
end++;
|
||
break;
|
||
case 'i':
|
||
d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
|
||
d /= WidthMMOfScreen(Tk_Screen(tkwin));
|
||
end++;
|
||
break;
|
||
case 'm':
|
||
d *= WidthOfScreen(Tk_Screen(tkwin));
|
||
d /= WidthMMOfScreen(Tk_Screen(tkwin));
|
||
end++;
|
||
break;
|
||
case 'p':
|
||
d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
|
||
d /= WidthMMOfScreen(Tk_Screen(tkwin));
|
||
end++;
|
||
break;
|
||
default:
|
||
goto error;
|
||
}
|
||
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
||
end++;
|
||
}
|
||
if (*end != 0) {
|
||
goto error;
|
||
}
|
||
*doublePtr = d;
|
||
return TCL_OK;
|
||
|
||
error:
|
||
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
||
"bad screen distance \"%s\"", string));
|
||
Tcl_SetErrorCode(interp, "TK", "VALUE", "FRACTIONAL_PIXELS", NULL);
|
||
return TCL_ERROR;
|
||
}
|
||
|
||
/*
|
||
* Local Variables:
|
||
* mode: c
|
||
* c-basic-offset: 4
|
||
* fill-column: 78
|
||
* End:
|
||
*/
|