expect/tclParse-compat.c

   1
   2 /* Expect depends on these Tcl functions, which have been removed
   3    in the latest version of Tcl/Tk 8.3. */
   4
   5 /*
   6  * tclParse.c --
   7  *
   8  *      This file contains a collection of procedures that are used
   9  *      to parse Tcl commands or parts of commands (like quoted
  10  *      strings or nested sub-commands).
  11  *
  12  * Copyright (c) 1987-1993 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$
  19  */
  20
  21 /* Only do this for Tcl8.3 and above. */
  22 #include "tcl.h"
  23 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION > 2
  24 #include "tclInt.h"
  25
  26
  27 static char *QuoteEnd(char *string, char *lastChar, int term);
  28 static char *VarNameEnd(char *string, char *lastChar);
  29 static char *ScriptEnd(char *p, char *lastChar, int nested);
  30 /*
  31  *----------------------------------------------------------------------
  32  *
  33  * TclWordEnd --
  34  *
  35  *      Given a pointer into a Tcl command, find the end of the next
  36  *      word of the command.
  37  *
  38  * Results:
  39  *      The return value is a pointer to the last character that's part
  40  *      of the word pointed to by "start".  If the word doesn't end
  41  *      properly within the string then the return value is the address
  42  *      of the null character at the end of the string.
  43  *
  44  * Side effects:
  45  *      None.
  46  *
  47  *----------------------------------------------------------------------
  48  */
  49
  50 char *
  51 TclWordEnd(start, lastChar, nested, semiPtr)
  52     char *start;                /* Beginning of a word of a Tcl command. */
  53     char *lastChar;             /* Terminating character in string. */
  54     int nested;                 /* Zero means this is a top-level command.
  55                                  * One means this is a nested command (close
  56                                  * bracket is a word terminator). */
  57     int *semiPtr;               /* Set to 1 if word ends with a command-
  58                                  * terminating semi-colon, zero otherwise.
  59                                  * If NULL then ignored. */
  60 {
  61     register char *p;
  62     int count;
  63
  64     if (semiPtr != NULL) {
  65         *semiPtr = 0;
  66     }
  67
  68     /*
  69      * Skip leading white space (backslash-newline must be treated like
  70      * white-space, except that it better not be the last thing in the
  71      * command).
  72      */
  73
  74     for (p = start; ; p++) {
  75         if (isspace(UCHAR(*p))) {
  76             continue;
  77         }
  78         if ((p[0] == '\\') && (p[1] == '\n')) {
  79             if (p+2 == lastChar) {
  80                 return p+2;
  81             }
  82             continue;
  83         }
  84         break;
  85     }
  86
  87     /*
  88      * Handle words beginning with a double-quote or a brace.
  89      */
  90
  91     if (*p == '"') {
  92         p = QuoteEnd(p+1, lastChar, '"');
  93         if (p == lastChar) {
  94             return p;
  95         }
  96         p++;
  97     } else if (*p == '{') {
  98         int braces = 1;
  99         while (braces != 0) {
 100             p++;
 101             while (*p == '\\') {
 102                 (void) Tcl_Backslash(p, &count);
 103                 p += count;
 104             }
 105             if (*p == '}') {
 106                 braces--;
 107             } else if (*p == '{') {
 108                 braces++;
 109             } else if (p == lastChar) {
 110                 return p;
 111             }
 112         }
 113         p++;
 114     }
 115
 116     /*
 117      * Handle words that don't start with a brace or double-quote.
 118      * This code is also invoked if the word starts with a brace or
 119      * double-quote and there is garbage after the closing brace or
 120      * quote.  This is an error as far as Tcl_Eval is concerned, but
 121      * for here the garbage is treated as part of the word.
 122      */
 123
 124     while (1) {
 125         if (*p == '[') {
 126             p = ScriptEnd(p+1, lastChar, 1);
 127             if (p == lastChar) {
 128                 return p;
 129             }
 130             p++;
 131         } else if (*p == '\\') {
 132             if (p[1] == '\n') {
 133                 /*
 134                  * Backslash-newline:  it maps to a space character
 135                  * that is a word separator, so the word ends just before
 136                  * the backslash.
 137                  */
 138
 139                 return p-1;
 140             }
 141             (void) Tcl_Backslash(p, &count);
 142             p += count;
 143         } else if (*p == '$') {
 144             p = VarNameEnd(p, lastChar);
 145             if (p == lastChar) {
 146                 return p;
 147             }
 148             p++;
 149         } else if (*p == ';') {
 150             /*
 151              * Include the semi-colon in the word that is returned.
 152              */
 153
 154             if (semiPtr != NULL) {
 155                 *semiPtr = 1;
 156             }
 157             return p;
 158         } else if (isspace(UCHAR(*p))) {
 159             return p-1;
 160         } else if ((*p == ']') && nested) {
 161             return p-1;
 162         } else if (p == lastChar) {
 163             if (nested) {
 164                 /*
 165                  * Nested commands can't end because of the end of the
 166                  * string.
 167                  */
 168                 return p;
 169             }
 170             return p-1;
 171         } else {
 172             p++;
 173         }
 174     }
 175 }
 176 \f
 177 /*
 178  *----------------------------------------------------------------------
 179  *
 180  * QuoteEnd --
 181  *
 182  *      Given a pointer to a string that obeys the parsing conventions
 183  *      for quoted things in Tcl, find the end of that quoted thing.
 184  *      The actual thing may be a quoted argument or a parenthesized
 185  *      index name.
 186  *
 187  * Results:
 188  *      The return value is a pointer to the last character that is
 189  *      part of the quoted string (i.e the character that's equal to
 190  *      term).  If the quoted string doesn't terminate properly then
 191  *      the return value is a pointer to the null character at the
 192  *      end of the string.
 193  *
 194  * Side effects:
 195  *      None.
 196  *
 197  *----------------------------------------------------------------------
 198  */
 199
 200 static char *
 201 QuoteEnd(string, lastChar, term)
 202     char *string;               /* Pointer to character just after opening
 203                                  * "quote". */
 204     char *lastChar;             /* Terminating character in string. */
 205     int term;                   /* This character will terminate the
 206                                  * quoted string (e.g. '"' or ')'). */
 207 {
 208     register char *p = string;
 209     int count;
 210
 211     while (*p != term) {
 212         if (*p == '\\') {
 213             (void) Tcl_Backslash(p, &count);
 214             p += count;
 215         } else if (*p == '[') {
 216             for (p++; *p != ']'; p++) {
 217                 p = TclWordEnd(p, lastChar, 1, (int *) NULL);
 218                 if (*p == 0) {
 219                     return p;
 220                 }
 221             }
 222             p++;
 223         } else if (*p == '$') {
 224             p = VarNameEnd(p, lastChar);
 225             if (*p == 0) {
 226                 return p;
 227             }
 228             p++;
 229         } else if (p == lastChar) {
 230             return p;
 231         } else {
 232             p++;
 233         }
 234     }
 235     return p-1;
 236 }
 237 \f
 238 /*
 239  *----------------------------------------------------------------------
 240  *
 241  * VarNameEnd --
 242  *
 243  *      Given a pointer to a variable reference using $-notation, find
 244  *      the end of the variable name spec.
 245  *
 246  * Results:
 247  *      The return value is a pointer to the last character that
 248  *      is part of the variable name.  If the variable name doesn't
 249  *      terminate properly then the return value is a pointer to the
 250  *      null character at the end of the string.
 251  *
 252  * Side effects:
 253  *      None.
 254  *
 255  *----------------------------------------------------------------------
 256  */
 257
 258 static char *
 259 VarNameEnd(string, lastChar)
 260     char *string;               /* Pointer to dollar-sign character. */
 261     char *lastChar;             /* Terminating character in string. */
 262 {
 263     register char *p = string+1;
 264
 265     if (*p == '{') {
 266         for (p++; (*p != '}') && (p != lastChar); p++) {
 267             /* Empty loop body. */
 268         }
 269         return p;
 270     }
 271     while (isalnum(UCHAR(*p)) || (*p == '_')) {
 272         p++;
 273     }
 274     if ((*p == '(') && (p != string+1)) {
 275         return QuoteEnd(p+1, lastChar, ')');
 276     }
 277     return p-1;
 278 }
 279
 280 \f
 281 /*
 282  *----------------------------------------------------------------------
 283  *
 284  * ScriptEnd --
 285  *
 286  *      Given a pointer to the beginning of a Tcl script, find the end of
 287  *      the script.
 288  *
 289  * Results:
 290  *      The return value is a pointer to the last character that's part
 291  *      of the script pointed to by "p".  If the command doesn't end
 292  *      properly within the string then the return value is the address
 293  *      of the null character at the end of the string.
 294  *
 295  * Side effects:
 296  *      None.
 297  *
 298  *----------------------------------------------------------------------
 299  */
 300
 301 static char *
 302 ScriptEnd(p, lastChar, nested)
 303     char *p;                    /* Script to check. */
 304     char *lastChar;             /* Terminating character in string. */
 305     int nested;                 /* Zero means this is a top-level command.
 306                                  * One means this is a nested command (the
 307                                  * last character of the script must be
 308                                  * an unquoted ]). */
 309 {
 310     int commentOK = 1;
 311     int length;
 312
 313     while (1) {
 314         while (isspace(UCHAR(*p))) {
 315             if (*p == '\n') {
 316                 commentOK = 1;
 317             }
 318             p++;
 319         }
 320         if ((*p == '#') && commentOK) {
 321             do {
 322                 if (*p == '\\') {
 323                     /*
 324                      * If the script ends with backslash-newline, then
 325                      * this command isn't complete.
 326                      */
 327
 328                     if ((p[1] == '\n') && (p+2 == lastChar)) {
 329                         return p+2;
 330                     }
 331                     Tcl_Backslash(p, &length);
 332                     p += length;
 333                 } else {
 334                     p++;
 335                 }
 336             } while ((p != lastChar) && (*p != '\n'));
 337             continue;
 338         }
 339         p = TclWordEnd(p, lastChar, nested, &commentOK);
 340         if (p == lastChar) {
 341             return p;
 342         }
 343         p++;
 344         if (nested) {
 345             if (*p == ']') {
 346                 return p;
 347             }
 348         } else {
 349             if (p == lastChar) {
 350                 return p-1;
 351             }
 352         }
 353     }
 354 }
 355
 356 #endif /* Tcl8.3 and above. */