Annotation of micropolis/src/tcl/tclget.c, revision 1.1

1.1     ! root        1: /* 
        !             2:  * tclGet.c --
        !             3:  *
        !             4:  *     This file contains procedures to convert strings into
        !             5:  *     other forms, like integers or floating-point numbers or
        !             6:  *     booleans, doing syntax checking along the way.
        !             7:  *
        !             8:  * Copyright 1990-1991 Regents of the University of California
        !             9:  * Permission to use, copy, modify, and distribute this
        !            10:  * software and its documentation for any purpose and without
        !            11:  * fee is hereby granted, provided that the above copyright
        !            12:  * notice appear in all copies.  The University of California
        !            13:  * makes no representations about the suitability of this
        !            14:  * software for any purpose.  It is provided "as is" without
        !            15:  * express or implied warranty.
        !            16:  */
        !            17: 
        !            18: #ifndef lint
        !            19: static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclGet.c,v 1.11 92/02/29 16:13:14 ouster Exp $ SPRITE (Berkeley)";
        !            20: #endif /* not lint */
        !            21: 
        !            22: #include "tclint.h"
        !            23: 
        !            24: /*
        !            25:  *----------------------------------------------------------------------
        !            26:  *
        !            27:  * Tcl_GetInt --
        !            28:  *
        !            29:  *     Given a string, produce the corresponding integer value.
        !            30:  *
        !            31:  * Results:
        !            32:  *     The return value is normally TCL_OK;  in this case *intPtr
        !            33:  *     will be set to the integer value equivalent to string.  If
        !            34:  *     string is improperly formed then TCL_ERROR is returned and
        !            35:  *     an error message will be left in interp->result.
        !            36:  *
        !            37:  * Side effects:
        !            38:  *     None.
        !            39:  *
        !            40:  *----------------------------------------------------------------------
        !            41:  */
        !            42: 
        !            43: int
        !            44: Tcl_GetInt(interp, string, intPtr)
        !            45:     Tcl_Interp *interp;                /* Interpreter to use for error reporting. */
        !            46:     char *string;              /* String containing a (possibly signed)
        !            47:                                 * integer in a form acceptable to strtol. */
        !            48:     int *intPtr;               /* Place to store converted result. */
        !            49: {
        !            50:     char *end;
        !            51:     int i;
        !            52: 
        !            53:     i = strtol(string, &end, 0);
        !            54:     while ((*end != '\0') && isspace(*end)) {
        !            55:        end++;
        !            56:     }
        !            57:     if ((end == string) || (*end != 0)) {
        !            58:        Tcl_AppendResult(interp, "expected integer but got \"", string,
        !            59:                "\"", (char *) NULL);
        !            60:        return TCL_ERROR;
        !            61:     }
        !            62:     *intPtr = i;
        !            63:     return TCL_OK;
        !            64: }
        !            65: 
        !            66: /*
        !            67:  *----------------------------------------------------------------------
        !            68:  *
        !            69:  * Tcl_GetDouble --
        !            70:  *
        !            71:  *     Given a string, produce the corresponding double-precision
        !            72:  *     floating-point value.
        !            73:  *
        !            74:  * Results:
        !            75:  *     The return value is normally TCL_OK;  in this case *doublePtr
        !            76:  *     will be set to the double-precision value equivalent to string.
        !            77:  *     If string is improperly formed then TCL_ERROR is returned and
        !            78:  *     an error message will be left in interp->result.
        !            79:  *
        !            80:  * Side effects:
        !            81:  *     None.
        !            82:  *
        !            83:  *----------------------------------------------------------------------
        !            84:  */
        !            85: 
        !            86: int
        !            87: Tcl_GetDouble(interp, string, doublePtr)
        !            88:     Tcl_Interp *interp;                /* Interpreter to use for error reporting. */
        !            89:     char *string;              /* String containing a floating-point number
        !            90:                                 * in a form acceptable to strtod. */
        !            91:     double *doublePtr;         /* Place to store converted result. */
        !            92: {
        !            93:     char *end;
        !            94:     double d;
        !            95: 
        !            96:     d = strtod(string, &end);
        !            97:     while ((*end != '\0') && isspace(*end)) {
        !            98:        end++;
        !            99:     }
        !           100:     if ((end == string) || (*end != 0)) {
        !           101:        Tcl_AppendResult(interp, "expected floating-point number but got \"",
        !           102:                string, "\"", (char *) NULL);
        !           103:        return TCL_ERROR;
        !           104:     }
        !           105:     *doublePtr = d;
        !           106:     return TCL_OK;
        !           107: }
        !           108: 
        !           109: /*
        !           110:  *----------------------------------------------------------------------
        !           111:  *
        !           112:  * Tcl_GetBoolean --
        !           113:  *
        !           114:  *     Given a string, return a 0/1 boolean value corresponding
        !           115:  *     to the string.
        !           116:  *
        !           117:  * Results:
        !           118:  *     The return value is normally TCL_OK;  in this case *boolPtr
        !           119:  *     will be set to the 0/1 value equivalent to string.  If
        !           120:  *     string is improperly formed then TCL_ERROR is returned and
        !           121:  *     an error message will be left in interp->result.
        !           122:  *
        !           123:  * Side effects:
        !           124:  *     None.
        !           125:  *
        !           126:  *----------------------------------------------------------------------
        !           127:  */
        !           128: 
        !           129: int
        !           130: Tcl_GetBoolean(interp, string, boolPtr)
        !           131:     Tcl_Interp *interp;                /* Interpreter to use for error reporting. */
        !           132:     char *string;              /* String containing a boolean number
        !           133:                                 * specified either as 1/0 or true/false or
        !           134:                                 * yes/no. */
        !           135:     int *boolPtr;              /* Place to store converted result, which
        !           136:                                 * will be 0 or 1. */
        !           137: {
        !           138:     char c;
        !           139:     char lowerCase[10];
        !           140:     int i, length;
        !           141: 
        !           142:     /*
        !           143:      * Convert the input string to all lower-case.
        !           144:      */
        !           145: 
        !           146:     for (i = 0; i < 9; i++) {
        !           147:        c = string[i];
        !           148:        if (c == 0) {
        !           149:            break;
        !           150:        }
        !           151:        if ((c >= 'A') && (c <= 'Z')) {
        !           152:            c += 'a' - 'A';
        !           153:        }
        !           154:        lowerCase[i] = c;
        !           155:     }
        !           156:     lowerCase[i] = 0;
        !           157: 
        !           158:     length = strlen(lowerCase);
        !           159:     c = lowerCase[0];
        !           160:     if ((c == '0') && (lowerCase[1] == '\0')) {
        !           161:        *boolPtr = 0;
        !           162:     } else if ((c == '1') && (lowerCase[1] == '\0')) {
        !           163:        *boolPtr = 1;
        !           164:     } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
        !           165:        *boolPtr = 1;
        !           166:     } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
        !           167:        *boolPtr = 0;
        !           168:     } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
        !           169:        *boolPtr = 1;
        !           170:     } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
        !           171:        *boolPtr = 0;
        !           172:     } else if ((c == 'o') && (length >= 2)) {
        !           173:        if (strncmp(lowerCase, "on", length) == 0) {
        !           174:            *boolPtr = 1;
        !           175:        } else if (strncmp(lowerCase, "off", length) == 0) {
        !           176:            *boolPtr = 0;
        !           177:        }
        !           178:     } else {
        !           179:        Tcl_AppendResult(interp, "expected boolean value but got \"",
        !           180:                string, "\"", (char *) NULL);
        !           181:        return TCL_ERROR;
        !           182:     }
        !           183:     return TCL_OK;
        !           184: }

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.