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