shared_source/c_tk_base_7_5_w_mods/tkget.c

/* $Header$ */

/* 
 * 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 procedures, like Tk_GetDirection and Tk_GetUid.
 *      The more complex procedures 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.
 *
 * RCS: @(#) $Id: tkget.c,v 1.1.1.1 2001/06/13 05:01:24 dtashley Exp $
 */

#include "tkInt.h"
#include "tkPort.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 ThreadSpecificData {
    int initialized;
    Tcl_HashTable uidTable;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The following tables defines the string values for reliefs, which are
 * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj.
 */

static char *anchorStrings[] = {"n", "ne", "e", "se", "s", "sw", "w", "nw",
        "center", (char *) NULL};
static char *justifyStrings[] = {"left", "right", "center", (char *) 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(interp, objPtr, anchorPtr)
    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(interp, string, anchorPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    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_AppendResult(interp, "bad anchor position \"", string,
            "\": must be n, ne, e, se, s, sw, w, nw, or center",
            (char *) NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_NameOfAnchor --
 *
 *      Given a Tk_Anchor, return the string that corresponds
 *      to it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_NameOfAnchor(anchor)
    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(interp, string, joinPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    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_AppendResult(interp, "bad join style \"", string,
            "\": must be bevel, miter, or round",
            (char *) NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_NameOfJoinStyle --
 *
 *      Given a Tk JoinStyle, return the string that corresponds
 *      to it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_NameOfJoinStyle(join)
    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(interp, string, capPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    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_AppendResult(interp, "bad cap style \"", string,
            "\": must be butt, projecting, or round",
            (char *) NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_NameOfCapStyle --
 *
 *      Given a Tk CapStyle, return the string that corresponds
 *      to it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_NameOfCapStyle(cap)
    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(interp, objPtr, justifyPtr)
    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(interp, string, justifyPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    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_AppendResult(interp, "bad justification \"", string,
            "\": must be left, right, or center",
            (char *) NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_NameOfJustify --
 *
 *      Given a Tk_Justify, return the string that corresponds
 *      to it.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */

char *
Tk_NameOfJustify(justify)
    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";
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_GetUid --
 *
 *      Given a string, this procedure returns a unique identifier
 *      for the string.
 *
 * Results:
 *      This procedure 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 procedure 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(string)
    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);
        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(interp, tkwin, string, doublePtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    Tk_Window tkwin;            /* Window whose screen determines conversion
                                 * from centimeters and other absolute
                                 * units. */
    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) {
        error:
        Tcl_AppendResult(interp, "bad screen distance \"", string,
                "\"", (char *) NULL);
        return TCL_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;
}

/*
 *--------------------------------------------------------------
 *
 * 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(interp, tkwin, string, intPtr)
    Tcl_Interp *interp;         /* Use this for error reporting. */
    Tk_Window tkwin;            /* Window whose screen determines conversion
                                 * from centimeters and other absolute
                                 * units. */
    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(interp, tkwin, string, doublePtr)
    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;

    d = strtod((char *) string, &end);
    if (end == string) {
        error:
        Tcl_AppendResult(interp, "bad screen distance \"", string,
                "\"", (char *) NULL);
        return TCL_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;
}

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