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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 25 - (hide annotations) (download)
Sat Oct 8 06:43:03 2016 UTC (8 years, 1 month ago) by dashley
Original Path: sf_code/esrgpcpj/shared/tk_base/tkget.c
File MIME type: text/plain
File size: 19044 byte(s)
Initial commit.
1 dashley 25 /* $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