git.zerfleddert.de Git - micropolis/blob - src/tk/tkget.c

   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 1991 Regents of the University of California
  11  * Permission to use, copy, modify, and distribute this
  12  * software and its documentation for any purpose and without
  13  * fee is hereby granted, provided that the above copyright
  14  * notice appear in all copies.  The University of California
  15  * makes no representations about the suitability of this
  16  * software for any purpose.  It is provided "as is" without
  17  * express or implied warranty.
  18  */
  19
  20 #ifndef lint
  21 static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkGet.c,v 1.5 92/08/10 09:02:46 ouster Exp $ SPRITE (Berkeley)";
  22 #endif /* not lint */
  23
  24 #include <tk.h>
  25 #include "tkconfig.h"
  26
  27 /*
  28  * The hash table below is used to keep track of all the Tk_Uids created
  29  * so far.
  30  */
  31
  32 static Tcl_HashTable uidTable;
  33 static int initialized = 0;
  34 \f
  35 /*
  36  *--------------------------------------------------------------
  37  *
  38  * Tk_GetAnchor --
  39  *
  40  *      Given a string, return the corresponding Tk_Anchor.
  41  *
  42  * Results:
  43  *      The return value is a standard Tcl return result.  If
  44  *      TCL_OK is returned, then everything went well and the
  45  *      position is stored at *anchorPtr;  otherwise TCL_ERROR
  46  *      is returned and an error message is left in
  47  *      interp->result.
  48  *
  49  * Side effects:
  50  *      None.
  51  *
  52  *--------------------------------------------------------------
  53  */
  54
  55 int
  56 Tk_GetAnchor(interp, string, anchorPtr)
  57     Tcl_Interp *interp;         /* Use this for error reporting. */
  58     char *string;               /* String describing a direction. */
  59     Tk_Anchor *anchorPtr;       /* Where to store Tk_Anchor corresponding
  60                                  * to string. */
  61 {
  62     switch (string[0]) {
  63         case 'n':
  64             if (string[1] == 0) {
  65                 *anchorPtr = TK_ANCHOR_N;
  66                 return TCL_OK;
  67             } else if ((string[1] == 'e') && (string[2] == 0)) {
  68                 *anchorPtr = TK_ANCHOR_NE;
  69                 return TCL_OK;
  70             } else if ((string[1] == 'w') && (string[2] == 0)) {
  71                 *anchorPtr = TK_ANCHOR_NW;
  72                 return TCL_OK;
  73             }
  74             goto error;
  75         case 's':
  76             if (string[1] == 0) {
  77                 *anchorPtr = TK_ANCHOR_S;
  78                 return TCL_OK;
  79             } else if ((string[1] == 'e') && (string[2] == 0)) {
  80                 *anchorPtr = TK_ANCHOR_SE;
  81                 return TCL_OK;
  82             } else if ((string[1] == 'w') && (string[2] == 0)) {
  83                 *anchorPtr = TK_ANCHOR_SW;
  84                 return TCL_OK;
  85             } else {
  86                 goto error;
  87             }
  88         case 'e':
  89             if (string[1] == 0) {
  90                 *anchorPtr = TK_ANCHOR_E;
  91                 return TCL_OK;
  92             }
  93             goto error;
  94         case 'w':
  95             if (string[1] == 0) {
  96                 *anchorPtr = TK_ANCHOR_W;
  97                 return TCL_OK;
  98             }
  99             goto error;
 100         case 'c':
 101             if (strncmp(string, "center", strlen(string)) == 0) {
 102                 *anchorPtr = TK_ANCHOR_CENTER;
 103                 return TCL_OK;
 104             }
 105             goto error;
 106     }
 107
 108     error:
 109     Tcl_AppendResult(interp, "bad anchor position \"", string,
 110             "\": must be n, ne, e, se, s, sw, w, nw, or center",
 111             (char *) NULL);
 112     return TCL_ERROR;
 113 }
 114 \f
 115 /*
 116  *--------------------------------------------------------------
 117  *
 118  * Tk_NameOfAnchor --
 119  *
 120  *      Given a Tk_Anchor, return the string that corresponds
 121  *      to it.
 122  *
 123  * Results:
 124  *      None.
 125  *
 126  * Side effects:
 127  *      None.
 128  *
 129  *--------------------------------------------------------------
 130  */
 131
 132 char *
 133 Tk_NameOfAnchor(anchor)
 134     Tk_Anchor anchor;           /* Anchor for which identifying string
 135                                  * is desired. */
 136 {
 137     switch (anchor) {
 138         case TK_ANCHOR_N: return "n";
 139         case TK_ANCHOR_NE: return "ne";
 140         case TK_ANCHOR_E: return "e";
 141         case TK_ANCHOR_SE: return "se";
 142         case TK_ANCHOR_S: return "s";
 143         case TK_ANCHOR_SW: return "sw";
 144         case TK_ANCHOR_W: return "w";
 145         case TK_ANCHOR_NW: return "nw";
 146         case TK_ANCHOR_CENTER: return "center";
 147     }
 148     return "unknown anchor position";
 149 }
 150 \f
 151 /*
 152  *--------------------------------------------------------------
 153  *
 154  * Tk_GetJoinStyle --
 155  *
 156  *      Given a string, return the corresponding Tk_JoinStyle.
 157  *
 158  * Results:
 159  *      The return value is a standard Tcl return result.  If
 160  *      TCL_OK is returned, then everything went well and the
 161  *      justification is stored at *joinPtr;  otherwise
 162  *      TCL_ERROR is returned and an error message is left in
 163  *      interp->result.
 164  *
 165  * Side effects:
 166  *      None.
 167  *
 168  *--------------------------------------------------------------
 169  */
 170
 171 int
 172 Tk_GetJoinStyle(interp, string, joinPtr)
 173     Tcl_Interp *interp;         /* Use this for error reporting. */
 174     char *string;               /* String describing a justification style. */
 175     int *joinPtr;               /* Where to store join style corresponding
 176                                  * to string. */
 177 {
 178     int c, length;
 179
 180     c = string[0];
 181     length = strlen(string);
 182
 183     if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
 184         *joinPtr = JoinBevel;
 185         return TCL_OK;
 186     }
 187     if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
 188         *joinPtr = JoinMiter;
 189         return TCL_OK;
 190     }
 191     if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
 192         *joinPtr = JoinRound;
 193         return TCL_OK;
 194     }
 195
 196     Tcl_AppendResult(interp, "bad join style \"", string,
 197             "\": must be bevel, miter, or round",
 198             (char *) NULL);
 199     return TCL_ERROR;
 200 }
 201 \f
 202 /*
 203  *--------------------------------------------------------------
 204  *
 205  * Tk_NameOfJoinStyle --
 206  *
 207  *      Given a Tk_JoinStyle, return the string that corresponds
 208  *      to it.
 209  *
 210  * Results:
 211  *      None.
 212  *
 213  * Side effects:
 214  *      None.
 215  *
 216  *--------------------------------------------------------------
 217  */
 218
 219 char *
 220 Tk_NameOfJoinStyle(join)
 221     int join;                   /* Join style for which identifying string
 222                                  * is desired. */
 223 {
 224     switch (join) {
 225         case JoinBevel: return "bevel";
 226         case JoinMiter: return "miter";
 227         case JoinRound: return "round";
 228     }
 229     return "unknown join style";
 230 }
 231 \f
 232 /*
 233  *--------------------------------------------------------------
 234  *
 235  * Tk_GetCapStyle --
 236  *
 237  *      Given a string, return the corresponding Tk_CapStyle.
 238  *
 239  * Results:
 240  *      The return value is a standard Tcl return result.  If
 241  *      TCL_OK is returned, then everything went well and the
 242  *      justification is stored at *capPtr;  otherwise
 243  *      TCL_ERROR is returned and an error message is left in
 244  *      interp->result.
 245  *
 246  * Side effects:
 247  *      None.
 248  *
 249  *--------------------------------------------------------------
 250  */
 251
 252 int
 253 Tk_GetCapStyle(interp, string, capPtr)
 254     Tcl_Interp *interp;         /* Use this for error reporting. */
 255     char *string;               /* String describing a justification style. */
 256     int *capPtr;                /* Where to store cap style corresponding
 257                                  * to string. */
 258 {
 259     int c, length;
 260
 261     c = string[0];
 262     length = strlen(string);
 263
 264     if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
 265         *capPtr = CapButt;
 266         return TCL_OK;
 267     }
 268     if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
 269         *capPtr = CapProjecting;
 270         return TCL_OK;
 271     }
 272     if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
 273         *capPtr = CapRound;
 274         return TCL_OK;
 275     }
 276
 277     Tcl_AppendResult(interp, "bad cap style \"", string,
 278             "\": must be butt, projecting, or round",
 279             (char *) NULL);
 280     return TCL_ERROR;
 281 }
 282 \f
 283 /*
 284  *--------------------------------------------------------------
 285  *
 286  * Tk_NameOfCapStyle --
 287  *
 288  *      Given a Tk_CapStyle, return the string that corresponds
 289  *      to it.
 290  *
 291  * Results:
 292  *      None.
 293  *
 294  * Side effects:
 295  *      None.
 296  *
 297  *--------------------------------------------------------------
 298  */
 299
 300 char *
 301 Tk_NameOfCapStyle(cap)
 302     int cap;                    /* Cap style for which identifying string
 303                                  * is desired. */
 304 {
 305     switch (cap) {
 306         case CapButt: return "butt";
 307         case CapProjecting: return "projecting";
 308         case CapRound: return "round";
 309     }
 310     return "unknown cap style";
 311 }
 312 \f
 313 /*
 314  *--------------------------------------------------------------
 315  *
 316  * Tk_GetJustify --
 317  *
 318  *      Given a string, return the corresponding Tk_Justify.
 319  *
 320  * Results:
 321  *      The return value is a standard Tcl return result.  If
 322  *      TCL_OK is returned, then everything went well and the
 323  *      justification is stored at *justifyPtr;  otherwise
 324  *      TCL_ERROR is returned and an error message is left in
 325  *      interp->result.
 326  *
 327  * Side effects:
 328  *      None.
 329  *
 330  *--------------------------------------------------------------
 331  */
 332
 333 int
 334 Tk_GetJustify(interp, string, justifyPtr)
 335     Tcl_Interp *interp;         /* Use this for error reporting. */
 336     char *string;               /* String describing a justification style. */
 337     Tk_Justify *justifyPtr;     /* Where to store Tk_Justify corresponding
 338                                  * to string. */
 339 {
 340     int c, length;
 341
 342     c = string[0];
 343     length = strlen(string);
 344
 345     if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
 346         *justifyPtr = TK_JUSTIFY_LEFT;
 347         return TCL_OK;
 348     }
 349     if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
 350         *justifyPtr = TK_JUSTIFY_RIGHT;
 351         return TCL_OK;
 352     }
 353     if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
 354         *justifyPtr = TK_JUSTIFY_CENTER;
 355         return TCL_OK;
 356     }
 357     if ((c == 'f') && (strncmp(string, "fill", length) == 0)) {
 358         *justifyPtr = TK_JUSTIFY_FILL;
 359         return TCL_OK;
 360     }
 361
 362     Tcl_AppendResult(interp, "bad justification \"", string,
 363             "\": must be left, right, center, or fill",
 364             (char *) NULL);
 365     return TCL_ERROR;
 366 }
 367 \f
 368 /*
 369  *--------------------------------------------------------------
 370  *
 371  * Tk_NameOfJustify --
 372  *
 373  *      Given a Tk_Justify, return the string that corresponds
 374  *      to it.
 375  *
 376  * Results:
 377  *      None.
 378  *
 379  * Side effects:
 380  *      None.
 381  *
 382  *--------------------------------------------------------------
 383  */
 384
 385 char *
 386 Tk_NameOfJustify(justify)
 387     Tk_Justify justify;         /* Justification style for which
 388                                  * identifying string is desired. */
 389 {
 390     switch (justify) {
 391         case TK_JUSTIFY_LEFT: return "left";
 392         case TK_JUSTIFY_RIGHT: return "right";
 393         case TK_JUSTIFY_CENTER: return "center";
 394         case TK_JUSTIFY_FILL: return "fill";
 395     }
 396     return "unknown justification style";
 397 }
 398 \f
 399 /*
 400  *----------------------------------------------------------------------
 401  *
 402  * Tk_GetUid --
 403  *
 404  *      Given a string, this procedure returns a unique identifier
 405  *      for the string.
 406  *
 407  * Results:
 408  *      This procedure returns a Tk_Uid corresponding to the "string"
 409  *      argument.  The Tk_Uid has a string value identical to string
 410  *      (strcmp will return 0), but it's guaranteed that any other
 411  *      calls to this procedure with a string equal to "string" will
 412  *      return exactly the same result (i.e. can compare Tk_Uid
 413  *      *values* directly, without having to call strcmp on what they
 414  *      point to).
 415  *
 416  * Side effects:
 417  *      New information may be entered into the identifier table.
 418  *
 419  *----------------------------------------------------------------------
 420  */
 421
 422 Tk_Uid
 423 Tk_GetUid(string)
 424     char *string;               /* String to convert. */
 425 {
 426     int dummy;
 427
 428     if (!initialized) {
 429         Tcl_InitHashTable(&uidTable, TCL_STRING_KEYS);
 430         initialized = 1;
 431     }
 432     return (Tk_Uid) Tcl_GetHashKey(&uidTable,
 433             Tcl_CreateHashEntry(&uidTable, string, &dummy));
 434 }
 435 \f
 436 /*
 437  *--------------------------------------------------------------
 438  *
 439  * Tk_GetScreenMM --
 440  *
 441  *      Given a string, returns the number of screen millimeters
 442  *      corresponding to that string.
 443  *
 444  * Results:
 445  *      The return value is a standard Tcl return result.  If
 446  *      TCL_OK is returned, then everything went well and the
 447  *      screen distance is stored at *doublePtr;  otherwise
 448  *      TCL_ERROR is returned and an error message is left in
 449  *      interp->result.
 450  *
 451  * Side effects:
 452  *      None.
 453  *
 454  *--------------------------------------------------------------
 455  */
 456
 457 int
 458 Tk_GetScreenMM(interp, tkwin, string, doublePtr)
 459     Tcl_Interp *interp;         /* Use this for error reporting. */
 460     Tk_Window tkwin;            /* Window whose screen determines conversion
 461                                  * from centimeters and other absolute
 462                                  * units. */
 463     char *string;               /* String describing a screen distance. */
 464     double *doublePtr;          /* Place to store converted result. */
 465 {
 466     char *end;
 467     double d;
 468
 469     d = strtod(string, &end);
 470     if (end == string) {
 471         error:
 472         Tcl_AppendResult(interp, "bad screen distance \"", string,
 473                 "\"", (char *) NULL);
 474         return TCL_ERROR;
 475     }
 476     while ((*end != '\0') && isspace(*end)) {
 477         end++;
 478     }
 479     switch (*end) {
 480         case 0:
 481             d /= WidthOfScreen(Tk_Screen(tkwin));
 482             d *= WidthMMOfScreen(Tk_Screen(tkwin));
 483             break;
 484         case 'c':
 485             d *= 10;
 486             end++;
 487             break;
 488         case 'i':
 489             d *= 25.4;
 490             end++;
 491             break;
 492         case 'm':
 493             end++;
 494             break;
 495         case 'p':
 496             d *= 25.4/72.0;
 497             end++;
 498             break;
 499         default:
 500             goto error;
 501     }
 502     while ((*end != '\0') && isspace(*end)) {
 503         end++;
 504     }
 505     if (*end != 0) {
 506         goto error;
 507     }
 508     *doublePtr = d;
 509     return TCL_OK;
 510 }
 511 \f
 512 /*
 513  *--------------------------------------------------------------
 514  *
 515  * Tk_GetPixels --
 516  *
 517  *      Given a string, returns the number of pixels corresponding
 518  *      to that string.
 519  *
 520  * Results:
 521  *      The return value is a standard Tcl return result.  If
 522  *      TCL_OK is returned, then everything went well and the
 523  *      rounded pixel distance is stored at *intPtr;  otherwise
 524  *      TCL_ERROR is returned and an error message is left in
 525  *      interp->result.
 526  *
 527  * Side effects:
 528  *      None.
 529  *
 530  *--------------------------------------------------------------
 531  */
 532
 533 int
 534 Tk_GetPixels(interp, tkwin, string, intPtr)
 535     Tcl_Interp *interp;         /* Use this for error reporting. */
 536     Tk_Window tkwin;            /* Window whose screen determines conversion
 537                                  * from centimeters and other absolute
 538                                  * units. */
 539     char *string;               /* String describing a justification style. */
 540     int *intPtr;                /* Place to store converted result. */
 541 {
 542     char *end;
 543     double d;
 544
 545     d = strtod(string, &end);
 546     if (end == string) {
 547         error:
 548         Tcl_AppendResult(interp, "bad screen distance \"", string,
 549                 "\"", (char *) NULL);
 550         return TCL_ERROR;
 551     }
 552     while ((*end != '\0') && isspace(*end)) {
 553         end++;
 554     }
 555     switch (*end) {
 556         case 0:
 557             break;
 558         case 'c':
 559             d *= 10*WidthOfScreen(Tk_Screen(tkwin));
 560             d /= WidthMMOfScreen(Tk_Screen(tkwin));
 561             end++;
 562             break;
 563         case 'i':
 564             d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
 565             d /= WidthMMOfScreen(Tk_Screen(tkwin));
 566             end++;
 567             break;
 568         case 'm':
 569             d *= WidthOfScreen(Tk_Screen(tkwin));
 570             d /= WidthMMOfScreen(Tk_Screen(tkwin));
 571             end++;
 572             break;
 573         case 'p':
 574             d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
 575             d /= WidthMMOfScreen(Tk_Screen(tkwin));
 576             end++;
 577             break;
 578         default:
 579             goto error;
 580     }
 581     while ((*end != '\0') && isspace(*end)) {
 582         end++;
 583     }
 584     if (*end != 0) {
 585         goto error;
 586     }
 587     if (d < 0) {
 588         *intPtr = (int) (d - 0.5);
 589     } else {
 590         *intPtr = (int) (d + 0.5);
 591     }
 592     return TCL_OK;
 593 }