tclutil.c

CMX990 demonstration board (DE9901)

   */

  nestingLevel = 0;
  flags = 0;
  if (string == NULL) {
    string = "";
  }
  p = string;
  if ((*p == '{') || (*p == '"') || (*p == 0)) {
    flags |= USE_BRACES;
  }
  for ( ; *p != 0; p++) {
    switch (*p) {
    case '{':
      nestingLevel++;
      break;
    case '}':
      nestingLevel--;
      if (nestingLevel < 0) {
        flags |= TCL_DONT_USE_BRACES|BRACES_UNMATCHED;
      }
      break;
    case '[':
    case '$':
    case ';':
    case ' ':
    case '\f':
    case '\n':
    case '\r':
    case '\t':
    case '\v':
      flags |= USE_BRACES;
      break;
    case '\\':
      if ((p[1] == 0) || (p[1] == '\n')) {
        flags = TCL_DONT_USE_BRACES;
      } else {
        int size;

        (void) Tcl_Backslash(p, &size);
        p += size-1;
        flags |= USE_BRACES;
      }
      break;
    }
  }
  if (nestingLevel != 0) {
    flags = TCL_DONT_USE_BRACES | BRACES_UNMATCHED;
  }
  *flagPtr = flags;

  /*
   * Allow enough space to backslash every character plus leave
   * two spaces for braces.
   */

  return 2*(p-string) + 2;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConvertElement --
 *
 *	This is a companion procedure to Tcl_ScanElement.  Given the
 *	information produced by Tcl_ScanElement, this procedure converts
 *	a string to a list element equal to that string.
 *
 * Results:
 *	Information is copied to *dst in the form of a list element
 *	identical to src (i.e. if Tcl_SplitList is applied to dst it
 *	will produce a string identical to src).  The return value is
 *	a count of the number of characters copied (not including the
 *	terminating NULL character).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int Tcl_ConvertElement(char *src, char *dst, int flags)
  //  register char *src;		/* Source information for list element. */
  //char *dst;			/* Place to put list-ified element. */
  //int flags;			/* Flags produced by Tcl_ScanElement. */
{
  register char *p = dst;

  /*
   * See the comment block at the beginning of the Tcl_ScanElement
   * code for details of how this works.
   */

  if (src == NULL) {
    src = "";
  }
  if ((flags & USE_BRACES) && !(flags & TCL_DONT_USE_BRACES)) {
    *p = '{';
    p++;
    for ( ; *src != 0; src++, p++) {
      *p = *src;
    }
    *p = '}';
    p++;
  } else if (*src == 0) {
    /*
     * If string is empty but can't use braces, then use special
     * backslash sequence that maps to empty string.
     */

    p[0] = '\\';
    p[1] = '0';
    p += 2;
  } else {
    for (; *src != 0 ; src++) {
      switch (*src) {
      case ']':
      case '[':
      case '$':
      case ';':
      case ' ':
      case '\\':
      case '"':
        *p = '\\';
        p++;
        break;
      case '{':
      case '}':
        if (flags & BRACES_UNMATCHED) {
          *p = '\\';
          p++;
        }
        break;
      case '\f':
        *p = '\\';
        p++;
        *p = 'f';
        p++;
        continue;
      case '\n':
        *p = '\\';
        p++;
        *p = 'n';
        p++;
        continue;
      case '\r':
        *p = '\\';
        p++;
        *p = 'r';
        p++;
        continue;
      case '\t':
        *p = '\\';
        p++;
        *p = 't';
        p++;
        continue;
      case '\v':
        *p = '\\';
        p++;
        *p = 'v';
        p++;
        continue;
      }
      *p = *src;
      p++;
    }
  }
  *p = '\0';
  return p-dst;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Merge --
 *
 *	Given a collection of strings, merge them together into a
 *	single string that has proper Tcl list structured (i.e.
 *	Tcl_SplitList may be used to retrieve strings equal to the
 *	original elements, and Tcl_Eval will parse the string back
 *	into its original elements).
 *
 * Results:
 *	The return value is the address of a dynamically-allocated
 *	string containing the merged list.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *Tcl_Merge(int argc, char **argv)
  //  int argc;			/* How many strings to merge. */
  //char **argv;		/* Array of string values. */
{
#   define LOCAL_SIZE 20
  int localFlags[LOCAL_SIZE], *flagPtr;
  int numChars;
  char *result;
  register char *dst;
  int i;

  /*
   * Pass 1: estimate space, gather flags.
   */

  if (argc <= LOCAL_SIZE) {
    flagPtr = localFlags;
  } else {
    flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
  }
  numChars = 1;
  for (i = 0; i < argc; i++) {
    numChars += Tcl_ScanElement(argv[i], &flagPtr[i]) + 1;
  }

  /*
   * Pass two: copy into the result area.
   */

  result = (char *) ckalloc((unsigned) numChars);
  dst = result;
  for (i = 0; i < argc; i++) {
    numChars = Tcl_ConvertElement(argv[i], dst, flagPtr[i]);
    dst += numChars;
    *dst = ' ';
    dst++;
  }
  if (dst == result) {
    *dst = 0;
  } else {
    dst[-1] = 0;
  }

  if (flagPtr != localFlags) {
    ckfree((char *) flagPtr);
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Concat --
 *
 *	Concatenate a set of strings into a single large string.
 *
 * Results:
 *	The return value is dynamically-allocated string containing
 *	a concatenation of all the strings in argv, with spaces between
 *	the original argv elements.
 *
 * Side effects:
 *	Memory is allocated for the result;  the caller is responsible
 *	for freeing the memory.
 *
 *----------------------------------------------------------------------
 */

char *Tcl_Concat(int argc, char **argv)
  //int argc;			/* Number of strings to concatenate. */
  //char **argv;		/* Array of strings to concatenate. */
{
  int totalSize, i;
  register char *p;
  char *result;

  for (totalSize = 1, i = 0; i < argc; i++) {
    totalSize += strlen(argv[i]) + 1;
  }
  result = (char *) ckalloc((unsigned) totalSize);
  if (argc == 0) {
    *result = '\0';
    return result;
  }
  for (p = result, i = 0; i < argc; i++) {
    char *element;
    int length;

    /*
     * Clip white space off the front and back of the string
     * to generate a neater result, and ignore any empty
     * elements.
     */

    element = argv[i];
    while (isspace(*element)) {
      element++;
    }
    for (length = strlen(element);
         (length > 0) && (isspace(element[length-1]));
         length--) {
      /* Null loop body. */
    }
    if (length == 0) {
      continue;
    }
    (void) strncpy(p, element, length);
    p += length;
    *p = ' ';
    p++;
  }
  if (p != result) {
    p[-1] = 0;
  } else {
    *p = 0;
  }
  return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StringMatch --
 *
 *	See if a particular string matches a particular pattern.
 *
 * Results:
 *	The return value is 1 if string matches pattern, and
 *	0 otherwise.  The matching operation permits the following
 *	special characters in the pattern: *?\[] (see the manual
 *	entry for details on what these mean).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int Tcl_StringMatch(char *string, char *pattern)
  //  register char *string;	/* String. */
  //register char *pattern;	/* Pattern, which may contain
  //                       * special characters. */
{
  char c2;

  while (1) {
    /* See if we're at the end of both the pattern and the string.
     * If so, we succeeded.  If we're at the end of the pattern
     * but not at the end of the string, we failed.
     */
	
    if (*pattern == 0) {
      if (*string == 0) {
        return 1;
      } else {
        return 0;
      }
    }
    if ((*string == 0) && (*pattern != '*')) {
      return 0;
    }

    /* Check for a "*" as the next pattern character.  It matches
     * any substring.  We handle this by calling ourselves
     * recursively for each postfix of string, until either we
     * match or we reach the end of the string.
     */
	
    if (*pattern == '*') {
      pattern += 1;
      if (*pattern == 0) {
        return 1;
      }
      while (1) {
        if (Tcl_StringMatch(string, pattern)) {
          return 1;
        }
        if (*string == 0) {
          return 0;
        }
        string += 1;
      }
    }
    
    /* Check for a "?" as the next pattern character.  It matches
     * any single character.
     */

    if (*pattern == '?') {
      goto thisCharOK;
    }

    /* Check for a "[" as the next pattern character.  It is followed
     * by a list of characters that are acceptable, or by a range
     * (two characters separated by "-").
     */
	
    if (*pattern == '[') {
      pattern += 1;
      while (1) {
        if ((*pattern == ']') || (*pattern == 0)) {
          return 0;
        }
        if (*pattern == *string) {
          break;
        }
        if (pattern[1] == '-') {
          c2 = pattern[2];
          if (c2 == 0) {
            return 0;
          }
          if ((*pattern <= *string) && (c2 >= *string)) {
            break;
          }
          if ((*pattern >= *string) && (c2 <= *string)) {
            break;
          }
          pattern += 2;
        }
        pattern += 1;
      }
      while ((*pattern != ']') && (*pattern != 0)) {
        pattern += 1;
      }
      goto thisCharOK;
    }
    
    /* If the next pattern character is '/', just strip off the '/'
     * so we do exact matching on the character that follows.
     */
	
    if (*pattern == '\\') {
      pattern += 1;
      if (*pattern == 0) {
        return 0;
      }
    }

    /* There's no special character.  Just make sure that the next
     * characters of each string match.
     */
	
    if (*pattern != *string) {
      return 0;
    }

  thisCharOK: pattern += 1;
    string += 1;
  }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetResult --
 *
 *	Arrange for "string" to be the Tcl return value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	interp->result is left pointing either to "string" (if "copy" is 0)
 *	or to a copy of string.
 *
 *----------------------------------------------------------------------
 */
void Tcl_SetResult(Tcl_Interp *interp, char *string, Tcl_FreeProc *freeProc)
  //  Tcl_Interp *interp;		/* Interpreter with which to associate the
  //				 * return value. */
  //char *string;		/* Value to be returned.  If NULL,
  //                         * the result is set to an empty string. */
  //Tcl_FreeProc *freeProc;	/* Gives information about the string:
  //                        * TCL_STATIC, TCL_VOLATILE, or the address
  //                       * of a Tcl_FreeProc such as free. */
{
  register Interp *iPtr = (Interp *) interp;
  int length;
  Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
  char *oldResult = iPtr->result;