/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkget.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkget.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (show annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (7 years, 5 months ago) by dashley
File MIME type: text/plain
File size: 19044 byte(s)
Rename for reorganization.
1 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkget.c,v 1.1.1.1 2001/06/13 05:01:24 dtashley Exp $ */
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 *= 10*WidthOfScreen(Tk_Screen(tkwin));
690 d /= WidthMMOfScreen(Tk_Screen(tkwin));
691 end++;
692 break;
693 case 'i':
694 d *= 25.4*WidthOfScreen(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
722 /* $History: tkGet.c $
723 *
724 * ***************** Version 1 *****************
725 * User: Dtashley Date: 1/02/01 Time: 2:47a
726 * Created in $/IjuScripter, IjuConsole/Source/Tk Base
727 * Initial check-in.
728 */
729
730 /* End of TKGET.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25