cde/programs/dtdocbook/tcl/tclGet.c

   1 /*
   2  * CDE - Common Desktop Environment
   3  *
   4  * Copyright (c) 1993-2012, The Open Group. All rights reserved.
   5  *
   6  * These libraries and programs are free software; you can
   7  * redistribute them and/or modify them under the terms of the GNU
   8  * Lesser General Public License as published by the Free Software
   9  * Foundation; either version 2 of the License, or (at your option)
  10  * any later version.
  11  *
  12  * These libraries and programs are distributed in the hope that
  13  * they will be useful, but WITHOUT ANY WARRANTY; without even the
  14  * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  15  * PURPOSE. See the GNU Lesser General Public License for more
  16  * details.
  17  *
  18  * You should have received a copy of the GNU Lesser General Public
  19  * License along with these librararies and programs; if not, write
  20  * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  21  * Floor, Boston, MA 02110-1301 USA
  22  */
  23 /* $XConsortium: tclGet.c /main/2 1996/08/08 14:44:07 cde-hp $ */
  24 /*
  25  * tclGet.c --
  26  *
  27  *      This file contains procedures to convert strings into
  28  *      other forms, like integers or floating-point numbers or
  29  *      booleans, doing syntax checking along the way.
  30  *
  31  * Copyright (c) 1990-1993 The Regents of the University of California.
  32  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  33  *
  34  * See the file "license.terms" for information on usage and redistribution
  35  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  36  *
  37  * SCCS: @(#) tclGet.c 1.24 96/02/15 11:42:47
  38  */
  39
  40 #include "tclInt.h"
  41 #include "tclPort.h"
  42
  43 \f
  44 /*
  45  *----------------------------------------------------------------------
  46  *
  47  * Tcl_GetInt --
  48  *
  49  *      Given a string, produce the corresponding integer value.
  50  *
  51  * Results:
  52  *      The return value is normally TCL_OK;  in this case *intPtr
  53  *      will be set to the integer value equivalent to string.  If
  54  *      string is improperly formed then TCL_ERROR is returned and
  55  *      an error message will be left in interp->result.
  56  *
  57  * Side effects:
  58  *      None.
  59  *
  60  *----------------------------------------------------------------------
  61  */
  62
  63 int
  64 Tcl_GetInt(interp, string, intPtr)
  65     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
  66     char *string;               /* String containing a (possibly signed)
  67                                  * integer in a form acceptable to strtol. */
  68     int *intPtr;                /* Place to store converted result. */
  69 {
  70     char *end, *p;
  71     int i;
  72
  73     /*
  74      * Note: use strtoul instead of strtol for integer conversions
  75      * to allow full-size unsigned numbers, but don't depend on strtoul
  76      * to handle sign characters;  it won't in some implementations.
  77      */
  78
  79     errno = 0;
  80     for (p = string; isspace(UCHAR(*p)); p++) {
  81         /* Empty loop body. */
  82     }
  83     if (*p == '-') {
  84         p++;
  85         i = -(int)strtoul(p, &end, 0);
  86     } else if (*p == '+') {
  87         p++;
  88         i = strtoul(p, &end, 0);
  89     } else {
  90         i = strtoul(p, &end, 0);
  91     }
  92     if (end == p) {
  93         badInteger:
  94         if (interp != (Tcl_Interp *) NULL) {
  95             Tcl_AppendResult(interp, "expected integer but got \"", string,
  96                     "\"", (char *) NULL);
  97         }
  98         return TCL_ERROR;
  99     }
 100     if (errno == ERANGE) {
 101         if (interp != (Tcl_Interp *) NULL) {
 102             interp->result = "integer value too large to represent";
 103             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
 104                     interp->result, (char *) NULL);
 105         }
 106         return TCL_ERROR;
 107     }
 108     while ((*end != '\0') && isspace(UCHAR(*end))) {
 109         end++;
 110     }
 111     if (*end != 0) {
 112         goto badInteger;
 113     }
 114     *intPtr = i;
 115     return TCL_OK;
 116 }
 117 \f
 118 /*
 119  *----------------------------------------------------------------------
 120  *
 121  * Tcl_GetDouble --
 122  *
 123  *      Given a string, produce the corresponding double-precision
 124  *      floating-point value.
 125  *
 126  * Results:
 127  *      The return value is normally TCL_OK;  in this case *doublePtr
 128  *      will be set to the double-precision value equivalent to string.
 129  *      If string is improperly formed then TCL_ERROR is returned and
 130  *      an error message will be left in interp->result.
 131  *
 132  * Side effects:
 133  *      None.
 134  *
 135  *----------------------------------------------------------------------
 136  */
 137
 138 int
 139 Tcl_GetDouble(interp, string, doublePtr)
 140     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
 141     char *string;               /* String containing a floating-point number
 142                                  * in a form acceptable to strtod. */
 143     double *doublePtr;          /* Place to store converted result. */
 144 {
 145     char *end;
 146     double d;
 147
 148     errno = 0;
 149     d = strtod(string, &end);
 150     if (end == string) {
 151         badDouble:
 152         if (interp != (Tcl_Interp *) NULL) {
 153             Tcl_AppendResult(interp,
 154                     "expected floating-point number but got \"",
 155                     string, "\"", (char *) NULL);
 156         }
 157         return TCL_ERROR;
 158     }
 159     if (errno != 0) {
 160         if (interp != (Tcl_Interp *) NULL) {
 161             TclExprFloatError(interp, d);
 162         }
 163         return TCL_ERROR;
 164     }
 165     while ((*end != 0) && isspace(UCHAR(*end))) {
 166         end++;
 167     }
 168     if (*end != 0) {
 169         goto badDouble;
 170     }
 171     *doublePtr = d;
 172     return TCL_OK;
 173 }
 174 \f
 175 /*
 176  *----------------------------------------------------------------------
 177  *
 178  * Tcl_GetBoolean --
 179  *
 180  *      Given a string, return a 0/1 boolean value corresponding
 181  *      to the string.
 182  *
 183  * Results:
 184  *      The return value is normally TCL_OK;  in this case *boolPtr
 185  *      will be set to the 0/1 value equivalent to string.  If
 186  *      string is improperly formed then TCL_ERROR is returned and
 187  *      an error message will be left in interp->result.
 188  *
 189  * Side effects:
 190  *      None.
 191  *
 192  *----------------------------------------------------------------------
 193  */
 194
 195 int
 196 Tcl_GetBoolean(interp, string, boolPtr)
 197     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
 198     char *string;               /* String containing a boolean number
 199                                  * specified either as 1/0 or true/false or
 200                                  * yes/no. */
 201     int *boolPtr;               /* Place to store converted result, which
 202                                  * will be 0 or 1. */
 203 {
 204     int i;
 205     char lowerCase[10], c;
 206     size_t length;
 207
 208     /*
 209      * Convert the input string to all lower-case.
 210      */
 211
 212     for (i = 0; i < 9; i++) {
 213         c = string[i];
 214         if (c == 0) {
 215             break;
 216         }
 217         if ((c >= 'A') && (c <= 'Z')) {
 218             c += (char) ('a' - 'A');
 219         }
 220         lowerCase[i] = c;
 221     }
 222     lowerCase[i] = 0;
 223
 224     length = strlen(lowerCase);
 225     c = lowerCase[0];
 226     if ((c == '0') && (lowerCase[1] == '\0')) {
 227         *boolPtr = 0;
 228     } else if ((c == '1') && (lowerCase[1] == '\0')) {
 229         *boolPtr = 1;
 230     } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
 231         *boolPtr = 1;
 232     } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
 233         *boolPtr = 0;
 234     } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
 235         *boolPtr = 1;
 236     } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
 237         *boolPtr = 0;
 238     } else if ((c == 'o') && (length >= 2)) {
 239         if (strncmp(lowerCase, "on", length) == 0) {
 240             *boolPtr = 1;
 241         } else if (strncmp(lowerCase, "off", length) == 0) {
 242             *boolPtr = 0;
 243         } else {
 244             goto badBoolean;
 245         }
 246     } else {
 247         badBoolean:
 248         if (interp != (Tcl_Interp *) NULL) {
 249             Tcl_AppendResult(interp, "expected boolean value but got \"",
 250                     string, "\"", (char *) NULL);
 251         }
 252         return TCL_ERROR;
 253     }
 254     return TCL_OK;
 255 }