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