C++ Tcl_AppendResult函数代码示例

static int tcl_whom(ClientData cd, Tcl_Interp *irp,
                    int argc, char *argv[])
{
  int chan, i;
  char c[2], idle[11], work[20], *p;
  long tv = 0;
  EGG_CONST char *list[7];

  BADARGS(2, 2, " chan");

  if (argv[1][0] == '*')
    chan = -1;
  else {
    if ((argv[1][0] < '0') || (argv[1][0] > '9')) {
      Tcl_SetVar(interp, "chan", argv[1], 0);
      if ((Tcl_VarEval(interp, "assoc ", "$chan", NULL) != TCL_OK) ||
          !interp->result[0]) {
        Tcl_AppendResult(irp, "channel name is invalid", NULL);
        return TCL_ERROR;
      }
      chan = atoi(interp->result);
    } else
      chan = atoi(argv[1]);
    if ((chan < 0) || (chan > 199999)) {
      Tcl_AppendResult(irp, "channel out of range; must be 0 through 199999",
                       NULL);
      return TCL_ERROR;
    }
  }
  for (i = 0; i < dcc_total; i++)
    if (dcc[i].type == &DCC_CHAT) {
      if (dcc[i].u.chat->channel == chan || chan == -1) {
        c[0] = geticon(i);
        c[1] = 0;
        tv = (now - dcc[i].timeval) / 60;
        egg_snprintf(idle, sizeof idle, "%li", tv);
        list[0] = dcc[i].nick;
        list[1] = botnetnick;
        list[2] = dcc[i].host;
        list[3] = c;
        list[4] = idle;
        list[5] = dcc[i].u.chat->away ? dcc[i].u.chat->away : "";
        if (chan == -1) {
          egg_snprintf(work, sizeof work, "%d", dcc[i].u.chat->channel);
          list[6] = work;
        }
        p = Tcl_Merge((chan == -1) ? 7 : 6, list);
        Tcl_AppendElement(irp, p);
        Tcl_Free((char *) p);
      }
    }
  for (i = 0; i < parties; i++) {
    if (party[i].chan == chan || chan == -1) {
      c[0] = party[i].flag;
      c[1] = 0;
      if (party[i].timer == 0L)
        strcpy(idle, "0");
      else {
        tv = (now - party[i].timer) / 60;
        egg_snprintf(idle, sizeof idle, "%li", tv);
      }
      list[0] = party[i].nick;
      list[1] = party[i].bot;
      list[2] = party[i].from ? party[i].from : "";
      list[3] = c;
      list[4] = idle;
      list[5] = party[i].status & PLSTAT_AWAY ? party[i].away : "";
      if (chan == -1) {
        egg_snprintf(work, sizeof work, "%d", party[i].chan);
        list[6] = work;
      }
      p = Tcl_Merge((chan == -1) ? 7 : 6, list);
      Tcl_AppendElement(irp, p);
      Tcl_Free((char *) p);
    }
  }
  return TCL_OK;
}

static int
SetPixelFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    const Tcl_ObjType *typePtr;
    char *string, *rest;
    double d;
    int i, units;

    string = Tcl_GetString(objPtr);

    d = strtod(string, &rest);
    if (rest == string) {
	goto error;
    }
    while ((*rest != '\0') && isspace(UCHAR(*rest))) {
	rest++;
    }

    switch (*rest) {
    case '\0':
	units = -1;
	break;
    case 'm':
	units = 0;
	break;
    case 'c':
	units = 1;
	break;
    case 'i':
	units = 2;
	break;
    case 'p':
	units = 3;
	break;
    default:
	goto error;
    }

    /*
     * Free the old internalRep before setting the new one.
     */

    typePtr = objPtr->typePtr;
    if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	(*typePtr->freeIntRepProc)(objPtr);
    }

    objPtr->typePtr = &pixelObjType;

    i = (int) d;
    if ((units < 0) && (i == d)) {
	SET_SIMPLEPIXEL(objPtr, i);
    } else {
	PixelRep *pixelPtr = (PixelRep *) ckalloc(sizeof(PixelRep));

	pixelPtr->value = d;
	pixelPtr->units = units;
	pixelPtr->tkwin = NULL;
	pixelPtr->returnValue = i;
	SET_COMPLEXPIXEL(objPtr, pixelPtr);
    }
    return TCL_OK;

  error:
    if (interp != NULL) {
	/*
	 * Must copy string before resetting the result in case a caller is
	 * trying to convert the interpreter's result to pixels.
	 */

	char buf[100];

	sprintf(buf, "bad screen distance \"%.50s\"", string);
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, buf, NULL);
    }
    return TCL_ERROR;
}

int tclcommand_metadynamics_print_status(Tcl_Interp *interp)
{
  char buffer[TCL_DOUBLE_SPACE];
  /* metadynamics not initialized */
  if(meta_pid1 == -1 || meta_pid2 == -1) {
    Tcl_AppendResult(interp,"{ not initialized } ", (char *)NULL);
    return (TCL_OK);
  }

  /* metdynamics off */
  if(meta_switch == META_OFF) {
    Tcl_AppendResult(interp,"{ off } ", (char *)NULL);
    return (TCL_OK);
  }

  /* distance */
  if(meta_switch == META_DIST ) {
    sprintf(buffer,"%i", meta_pid1);
    Tcl_AppendResult(interp,"{ distance ",buffer, (char *)NULL);
    sprintf(buffer,"%i", meta_pid2);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    Tcl_PrintDouble(interp, meta_xi_min, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    Tcl_PrintDouble(interp, meta_xi_max, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    Tcl_PrintDouble(interp, meta_bias_height, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL); 
    Tcl_PrintDouble(interp, meta_bias_width, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    Tcl_PrintDouble(interp, meta_f_bound, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    sprintf(buffer,"%i", meta_xi_num_bins);
    Tcl_AppendResult(interp," ",buffer," } ", (char *)NULL);
  }

  /* relative_z */
  if(meta_switch == META_REL_Z ) {
    sprintf(buffer,"%i", meta_pid1);
    Tcl_AppendResult(interp,"{ relative_z ",buffer, (char *)NULL);
    sprintf(buffer,"%i", meta_pid2);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    Tcl_PrintDouble(interp, meta_xi_min, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    Tcl_PrintDouble(interp, meta_xi_max, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    Tcl_PrintDouble(interp, meta_bias_height, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL); 
    Tcl_PrintDouble(interp, meta_bias_width, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    Tcl_PrintDouble(interp, meta_f_bound, buffer);
    Tcl_AppendResult(interp," ",buffer, (char *)NULL);
    sprintf(buffer,"%i", meta_xi_num_bins);
    Tcl_AppendResult(interp," ",buffer," } ", (char *)NULL);
  }

  return (TCL_OK);
}

/** Reads a Tcl matrix and returns a C matrix.

    \param interp The Tcl interpreter
    \param data_in String containing a Tcl matrix of doubles
    \param data Pointer to the C matrix
    \param nrows Pointer to an int to store the height of the matrix
    \param ncols Pointer to an int to store the width of the matrix
    \return \em TCL_OK if everything went fine \em TCL_ERROR otherwise and 
            interp->result is set to an error message.

	    If \em TCL_OK is returned you have to make sure to free the memory
	    pointed to by data.
 */
int uwerr_read_matrix(Tcl_Interp *interp, char * data_in ,
		      double *** data, int * nrows, int * ncols)
{
  char ** row;
  char ** col;
  int tmp_ncols = -1, i, j, k;

  *nrows = *ncols = -1;

  if (Tcl_SplitList(interp, data_in, nrows, &row) == TCL_ERROR)
    return TCL_ERROR;

  if (*nrows < 1) {
    Tcl_AppendResult(interp, "first argument has to be a matrix.",
		     (char *)NULL);
    return TCL_ERROR;
  }

  if (!(*data = (double**)malloc(*nrows*sizeof(double*)))) {
    Tcl_AppendResult(interp, "Out of Memory.",
		     (char *)NULL);
    Tcl_Free((char *)row);
    return TCL_ERROR;
  }

  for (i = 0; i < *nrows; ++i) {
    tmp_ncols = -1;
    
    if (Tcl_SplitList(interp, row[i], &tmp_ncols, &col) == TCL_ERROR) {
      Tcl_Free((char*)row);
      return TCL_ERROR;
    }

    if (i == 0) {
      if (tmp_ncols < 1) {
	Tcl_AppendResult(interp, "first argument has to be a matrix.",
			 (char *)NULL);
	Tcl_Free((char *)col);
	Tcl_Free((char*)row);
	return TCL_ERROR;
      }

      *ncols = tmp_ncols;

    } else if (*ncols != tmp_ncols) {
      Tcl_AppendResult(interp, "number of columns changed.",
		       (char *)NULL);
      Tcl_Free((char *)col);
      Tcl_Free((char*)row);
      return TCL_ERROR;
    }

    if (!((*data)[i] = (double*)malloc(*ncols*sizeof(double)))) {
      Tcl_AppendResult(interp,"Out of Memory.",
		       (char *)NULL);
      Tcl_Free((char *)row);
      Tcl_Free((char *)col);
      for (k = 0; k < i; ++k)
	free((*data)[i]);
      free(*data);
      return TCL_ERROR;
    };

    for (j = 0; j < *ncols; ++j) {
      if (Tcl_GetDouble(interp, col[j], &((*data)[i][j])) == TCL_ERROR) {
	Tcl_Free((char *)col);
	Tcl_Free((char *)row);
	for (k = 0; k <= i; ++k)
	  free((*data)[i]);
	free(*data);
	return TCL_ERROR;
      }
    }

    Tcl_Free((char *)col);
  }

  Tcl_Free((char *)row);

  return TCL_OK;
}

//.........这里部分代码省略.........
 -herring { 15 20 25 30 } \
 -time { 40.0 35.0 30.0 25.0 } \
 -score { 0 0 0 0 } \
 -mirrored yes -conditions cloudy \
 -windy no -snowing no
 }
 {
 -course ingos_speedway \
 -description "nice long description" \
 -herring { 15 20 25 30 } \
 -time { 40.0 35.0 30.0 25.0 } \
 -score { 0 0 0 0 } \
 -mirrored yes -conditions cloudy \
 -windy no -snowing no
 }
 }
 }
 }
 }
 }

 \return  Tcl error code
 \author  jfpatry
 \date    Created:  2000-09-19
 \date    Modified: 2000-09-19
 */
static int events_cb( ClientData cd, Tcl_Interp *ip,
                      int argc, const char **argv )
{
    char *err_msg;
    const char **list = NULL;
    int num_events;
    list_elem_t last_event = NULL;
    int i;

    /* Make sure module has been initialized */
    check_assertion( initialized,
                     "course_mgr module not initialized" );

    if ( argc != 2 ) {
        err_msg = "Incorrect number of arguments";
        goto bail_events;
    }

    if ( Tcl_SplitList( ip, argv[1], &num_events, &list ) == TCL_ERROR ) {
        err_msg = "Argument is not a list";
        goto bail_events;
    }

    /* We currently only allow tux_events to be called once */
    last_event = get_list_tail( event_list );

    if ( last_event != NULL ) {
        err_msg = "tux_events has already been called; it can only be called "
                  "once.";
        goto bail_events;
    }

    for (i=0; i<num_events; i++) {
        event_data_t *data = create_event_data( ip, list[i], &err_msg );

        if ( data == NULL ) {
            goto bail_events;
        }

        last_event = insert_list_elem( event_list, last_event,
                                       (list_elem_data_t) data );
    }

    Tcl_Free( (char*) list );
    list = NULL;

    return TCL_OK;

bail_events:
    if ( list != NULL ) {
        Tcl_Free( (char*) list );
    }

    /* Clean out event list */
    if ( event_list != NULL ) {
        last_event = get_list_tail( event_list );
        while ( last_event != NULL ) {
            event_data_t *data;
            data = (event_data_t*) delete_list_elem( event_list,
                    last_event );
            free( data );
            last_event = get_list_tail( event_list );
        }
    }

    Tcl_AppendResult(
        ip,
        "Error in call to tux_events: ",
        err_msg,
        "\n",
        "Usage: tux_events { list of event data }",
        (NULL) );
    return TCL_ERROR;
}

Tk_Cursor
Tk_GetCursorFromData(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tk_Window tkwin,		/* Window in which cursor will be used. */
    const char *source,		/* Bitmap data for cursor shape. */
    const char *mask,		/* Bitmap data for cursor mask. */
    int width, int height,	/* Dimensions of cursor. */
    int xHot, int yHot,		/* Location of hot-spot in cursor. */
    Tk_Uid fg,			/* Foreground color for cursor. */
    Tk_Uid bg)			/* Background color for cursor. */
{
    DataKey dataKey;
    Tcl_HashEntry *dataHashPtr;
    register TkCursor *cursorPtr;
    int isNew;
    XColor fgColor, bgColor;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    if (!dispPtr->cursorInit) {
	CursorInit(dispPtr);
    }

    dataKey.source = source;
    dataKey.mask = mask;
    dataKey.width = width;
    dataKey.height = height;
    dataKey.xHot = xHot;
    dataKey.yHot = yHot;
    dataKey.fg = fg;
    dataKey.bg = bg;
    dataKey.display = Tk_Display(tkwin);
    dataHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorDataTable,
	    (char *) &dataKey, &isNew);
    if (!isNew) {
	cursorPtr = Tcl_GetHashValue(dataHashPtr);
	cursorPtr->resourceRefCount++;
	return cursorPtr->cursor;
    }

    /*
     * No suitable cursor exists yet. Make one using the data available and
     * add it to the database.
     */

    if (XParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) {
	Tcl_AppendResult(interp, "invalid color name \"", fg, "\"", NULL);
	goto error;
    }
    if (XParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) {
	Tcl_AppendResult(interp, "invalid color name \"", bg, "\"", NULL);
	goto error;
    }

    cursorPtr = TkCreateCursorFromData(tkwin, source, mask, width, height,
	    xHot, yHot, fgColor, bgColor);

    if (cursorPtr == NULL) {
	goto error;
    }

    cursorPtr->resourceRefCount = 1;
    cursorPtr->otherTable = &dispPtr->cursorDataTable;
    cursorPtr->hashPtr = dataHashPtr;
    cursorPtr->objRefCount = 0;
    cursorPtr->idHashPtr = Tcl_CreateHashEntry(&dispPtr->cursorIdTable,
	    (char *) cursorPtr->cursor, &isNew);
    cursorPtr->nextPtr = NULL;

    if (!isNew) {
	Tcl_Panic("cursor already registered in Tk_GetCursorFromData");
    }
    Tcl_SetHashValue(dataHashPtr, cursorPtr);
    Tcl_SetHashValue(cursorPtr->idHashPtr, cursorPtr);
    return cursorPtr->cursor;

  error:
    Tcl_DeleteHashEntry(dataHashPtr);
    return None;
}

/* parser for hole cluster analyzation:
   analyze holes <prob_part_type_number> <mesh_size>.
   Needs feature LENNARD_JONES compiled in. */
int tclcommand_analyze_parse_holes(Tcl_Interp *interp, int argc, char **argv)
{
  int i,j;
  int probe_part_type;
  int mesh_size=1, meshdim[3];
  double freevol=0.0;
  char buffer[TCL_INTEGER_SPACE+TCL_DOUBLE_SPACE];

  IntList mesh;

  int n_holes;
  int **holes;
  int max_size=0;
  int *surface;

#ifndef LENNARD_JONES
   Tcl_AppendResult(interp, "analyze holes needs feature LENNARD_JONES compiled in.\n", (char *)NULL);
    return TCL_ERROR;
#endif

  /* check # of parameters */
  if (argc < 2) {
    Tcl_AppendResult(interp, "analyze holes needs 2 parameters:\n", (char *)NULL);
    Tcl_AppendResult(interp, "<prob_part_type_number> <mesh_size>", (char *)NULL);
    return TCL_ERROR;
  }

  /* check parameter types */
  if( (! ARG_IS_I(0, probe_part_type)) ||
      (! ARG_IS_I(1, mesh_size))  ) {
    Tcl_AppendResult(interp, "analyze holes needs 2 parameters of type and meaning:\n", (char *)NULL);
    Tcl_AppendResult(interp, "INT INT\n", (char *)NULL);
    Tcl_AppendResult(interp, "<prob_part_type_number> <mesh_size>", (char *)NULL);
    return TCL_ERROR;
  }

  /* check parameter values */
  if( probe_part_type > n_particle_types || probe_part_type < 0 ) {
    Tcl_AppendResult(interp, "analyze holes: probe particle type number does not exist", (char *)NULL);
    return TCL_ERROR;
  }
  if( mesh_size < 1  ) {
    Tcl_AppendResult(interp, "analyze holes: mesh size must be positive (min=1)", (char *)NULL);
    return TCL_ERROR;
  }

  /* preparation */
  updatePartCfg(WITHOUT_BONDS);
  meshdim[0]=mesh_size;
  meshdim[1]=mesh_size;
  meshdim[2]=mesh_size;
  alloc_intlist(&mesh, (meshdim[0]*meshdim[1]*meshdim[2]));

  /* perform free space identification*/
  create_free_volume_grid(mesh, meshdim, probe_part_type);
  /* perfrom hole cluster algorithm */
  n_holes = cluster_free_volume_grid(mesh, meshdim, &holes);
  /* surface to volume ratio */
  surface = (int *) malloc(sizeof(int)*(n_holes+1));
  cluster_free_volume_surface(mesh, meshdim, n_holes, holes, surface);
  /* calculate accessible volume / max size*/
  for ( i=0; i<=n_holes; i++ ) { 
    freevol += holes[i][0];
    if ( holes[i][0]> max_size ) max_size = holes[i][0];
  }

  /* Append result to tcl interpreter */
  Tcl_AppendResult(interp, "{ n_holes mean_hole_size max_hole_size free_volume_fraction { sizes } { surfaces }  { element_lists } } ", (char *)NULL);

  Tcl_AppendResult(interp, "{", (char *)NULL);

  /* number of holes */
  sprintf(buffer,"%d ",n_holes+1); Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
  /* mean hole size */
  sprintf(buffer,"%f ",freevol/(n_holes+1.0)); Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
  /* max hole size */
  sprintf(buffer,"%d ",max_size); Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
  /* free volume fraction */
  sprintf(buffer,"%f ",freevol/(meshdim[0]*meshdim[1]*meshdim[2]));
  Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
  /* hole sizes */
  Tcl_AppendResult(interp, "{ ", (char *)NULL);
  for ( i=0; i<=n_holes; i++ ) { 
    sprintf(buffer,"%d ",holes[i][0]); Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
  }
  Tcl_AppendResult(interp, "} ", (char *)NULL);
  /* hole surfaces */
  Tcl_AppendResult(interp, "{ ", (char *)NULL);
  for ( i=0; i<=n_holes; i++ ) { 
    sprintf(buffer,"%d ",surface[i]); Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
  }
  Tcl_AppendResult(interp, "} ", (char *)NULL);
  /* hole elements */ 
  Tcl_AppendResult(interp, "{ ", (char *)NULL);
  for ( i=0; i<=n_holes; i++ ) { 
    Tcl_AppendResult(interp, "{ ", (char *)NULL);
    for ( j=1; j <= holes[i][0]; j++ ) {
//.........这里部分代码省略.........

/* parser for necklace cluster analyzation:
   analyze necklace <pearl_treshold> <back_dist> <space_dist> <first> <length> 
 */
int tclcommand_analyze_parse_necklace(Tcl_Interp *interp, int argc, char **argv)
{
  double space_dist;
  int first,length;
  Particle *part;
  Cluster *cluster;
  char buffer[TCL_INTEGER_SPACE];
  int n_pearls;

  /* check # of parameters */
  if (argc < 5) {
    Tcl_AppendResult(interp, "analyze necklace needs 5 parameters:\n", (char *)NULL);
    Tcl_AppendResult(interp, "<pearl_treshold> <back_dist> <space_dist> <first> <length>", (char *)NULL);
    return TCL_ERROR;
  }

  /* check parameter types */
  if( (! ARG_IS_I(0, pearl_treshold)) ||
      (! ARG_IS_I(1, backbone_distance))  ||
      (! ARG_IS_D(2, space_dist))     ||
      (! ARG_IS_I(3, first))          ||
      (! ARG_IS_I(4, length)) ) {
    Tcl_AppendResult(interp, "analyze necklace needs 5 parameters of type and meaning:\n", (char *)NULL);
    Tcl_AppendResult(interp, "INT INT DOUBLE INT INT\n", (char *)NULL);
    Tcl_AppendResult(interp, "<pearl_treshold> <back_dist> <space_dist> <first> <length>", (char *)NULL);
    return TCL_ERROR;
  }

  /* check parameter values */
  if( pearl_treshold < 10 ) {
    Tcl_AppendResult(interp, "analyze necklace: pearl_treshold should be >= 10", (char *)NULL);
    return TCL_ERROR;
  }
  if( backbone_distance < 2 ) {
    Tcl_AppendResult(interp, "analyze necklace: backbone_dist should be >= 2", (char *)NULL);
    return TCL_ERROR;
  }
  if( space_dist <= 0.0 ) {
    Tcl_AppendResult(interp, "analyze necklace: space_dist must be positive", (char *)NULL);
    return TCL_ERROR;
  }
  if( first < 0 ) {
    Tcl_AppendResult(interp, "analyze necklace: identity of first particle can not be negative", (char *)NULL);
    return TCL_ERROR;
  }
  if( first+length > n_total_particles+1) {
    Tcl_AppendResult(interp, "analyze necklace: identity of last particle out of partCfg array", (char *)NULL);
    return TCL_ERROR;
  }

  /* preparation */
  space_distance2 = SQR(space_dist);
  sortPartCfg();
  part = &partCfg[first];

  /* perform necklace cluster algorithm */
  n_pearls = analyze_necklace(part, length) ;

  /* Append result to tcl interpreter */
  sprintf(buffer,"%d",n_pearls);
  Tcl_AppendResult(interp, buffer, " pearls { ", (char *)NULL);
  if( n_pearls > 0 ) {
    cluster = first_cluster;
    sprintf(buffer,"%d",cluster->size);
    Tcl_AppendResult(interp, buffer, " ",(char *)NULL);
    cluster = cluster->next;
    while(cluster->prev != last_cluster) { 
      sprintf(buffer,"%d",cluster->size);
      Tcl_AppendResult(interp, buffer, " ",(char *)NULL);
      cluster = cluster->next;
    }
  }
  Tcl_AppendResult(interp, "} ", (char *)NULL);

   /* free analyzation memory */
  cluster_free();
  
  return (TCL_OK);
}

/*
 *---------------------------------------------------------------------------
 *
 * HtmlImageServerGet --
 *
 *     Retrieve an HtmlImage2 object for the image at URL zUrl from 
 *     an image-server. The caller should match this call with a single
 *     HtmlImageFree() when the image object is no longer required.
 *
 *     If the image is not already in the cache, the Tcl script 
 *     configured as the widget -imagecmd is invoked. If this command
 *     raises an error or returns an invalid result, then this function 
 *     returns NULL. A Tcl back-ground error is propagated in this case 
 *     also.
 *
 * Results:
 *     Pointer to HtmlImage2 object containing the image from zUrl, or
 *     NULL, if zUrl was invalid for some reason.
 *
 * Side effects:
 *     May invoke -imagecmd script.
 *
 *---------------------------------------------------------------------------
 */
HtmlImage2 *
HtmlImageServerGet (HtmlImageServer *p, const char *zUrl) 
{
    Tcl_Obj *pImageCmd = p->pTree->options.imagecmd;
    Tcl_Interp *interp = p->pTree->interp;
    Tcl_HashEntry *pEntry = 0;
    HtmlImage2 *pImage = 0;

    /* Try to find the requested image in the hash table. */
    if (pImageCmd) {
        int new_entry;
        pEntry = Tcl_CreateHashEntry(&p->aImage, zUrl, &new_entry);
        if (new_entry) {
            Tcl_Obj *pEval;
            Tcl_Obj *pResult;
            int rc;
            int nObj;
            Tcl_Obj **apObj = 0;
            Tk_Image img;
           
	    /* The image could not be found in the hash table and an 
             * -imagecmd callback is configured. The callback script 
             * must be executed to obtain an image. Build up a script 
             * in pEval and execute it. Put the result in variable pResult.
             */
            pEval = Tcl_DuplicateObj(pImageCmd);
            Tcl_IncrRefCount(pEval);
            Tcl_ListObjAppendElement(interp, pEval, Tcl_NewStringObj(zUrl, -1));
            rc = Tcl_EvalObjEx(interp, pEval, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
            Tcl_DecrRefCount(pEval);
            if (rc != TCL_OK) {
                goto image_get_out;
            }
            pResult = Tcl_GetObjResult(interp);
    
            /* Read the result into array apObj. If the result was
             * not a valid Tcl list, return NULL and raise a background
             * error about the badly formed list.
             */
            rc = Tcl_ListObjGetElements(interp, pResult, &nObj, &apObj);
            if (rc != TCL_OK) {
                goto image_get_out;
            }
            if (nObj==0) {
                Tcl_DeleteHashEntry(pEntry);
                goto image_unavailable;
            }

            pImage = HtmlNew(HtmlImage2);
            if (nObj == 1 || nObj == 2) {
                img = Tk_GetImage(
                    interp, p->pTree->tkwin, Tcl_GetString(apObj[0]),
                    imageChanged, pImage
                );
            }
            if ((nObj != 1 && nObj != 2) || !img) {
                Tcl_ResetResult(interp);
                Tcl_AppendResult(interp,  "-imagecmd returned bad value", 0);
                HtmlFree(pImage);
                pImage = 0;
                goto image_get_out;
            }

            Tcl_SetHashValue(pEntry, (ClientData)pImage);
            Tcl_IncrRefCount(apObj[0]);
            pImage->pImageName = apObj[0];
            if (nObj == 2) {
                Tcl_IncrRefCount(apObj[1]);
                pImage->pDelete = apObj[1];
            }
            pImage->pImageServer = p;
            pImage->zUrl = Tcl_GetHashKey(&p->aImage, pEntry);
            pImage->image = img;
            Tk_SizeOfImage(pImage->image, &pImage->width, &pImage->height);
            pImage->isValid = 1;
            HtmlImagePixmap(pImage);
//.........这里部分代码省略.........

int
Tclae_Init(Tcl_Interp *interp)
{
    OSErr		err;
    SInt32		attr;
    
    //Check for AppleEvents
    err = Gestalt(gestaltAppleEventsAttr, &attr);
    if ((err != noErr)
    ||  !(attr & (1 << gestaltAppleEventsPresent))) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "The AppleEvent Manager is either missing or misbehaving",
			 (char *) NULL);
    }
    err = AEObjectInit();
    
    
    if (Tcl_InitStubs(interp, "8.0", 0) == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
	if (TCL_VERSION[0] == '7') {
	    if (Tcl_PkgRequire(interp, "Tcl", "8.0", 0) == NULL) {
		return TCL_ERROR;
	    }
	}
    }
    
    if (Tcl_PkgProvide(interp, TCLAE_NAME, TCLAE_BASIC_VERSION) != TCL_OK) {
		return TCL_ERROR;
    }

    /* Why?!? */
    Tcl_SetVar(interp, "tclAE_version", TCLAE_VERSION, TCL_GLOBAL_ONLY);
    
    tclAE_macRoman_encoding = Tcl_GetEncoding(interp,"macRoman");
    
    TclaeInitAEAddresses();
    TclaeInitAEDescs();
    TclaeInitEventHandlers(interp);
    TclaeInitCoercionHandlers(interp);
    TclaeInitObjectAccessors(interp);
    
    /* Define Tcl commands */
    
    Tcl_CreateObjCommand(interp, "tclAE::build", Tclae_BuildCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::send", Tclae_SendCmd, NULL, 0L);
    
    /* Handler commands */
    
    Tcl_CreateObjCommand(interp, "tclAE::getCoercionHandler", Tclae_GetCoercionHandlerCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getEventHandler", Tclae_GetEventHandlerCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::installCoercionHandler", Tclae_InstallCoercionHandlerCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::installEventHandler", Tclae_InstallEventHandlerCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::removeCoercionHandler", Tclae_RemoveCoercionHandlerCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::removeEventHandler", Tclae_RemoveEventHandlerCmd, NULL, 0L);
    
    /* Target commands */
    
#if !TARGET_API_MAC_CARBON  && !defined(TCLAE_NO_EPPC) // das 25/10/00: Carbonization
    Tcl_CreateObjCommand(interp, "tclAE::IPCListPorts", Tclae_IPCListPortsCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::PPCBrowser", Tclae_PPCBrowserCmd, NULL, 0L);
#endif
    
#if TARGET_API_MAC_CARBON	
    Tcl_CreateObjCommand(interp, "tclAE::getPOSIXPath", Tclae_GetPOSIXPathCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getHFSPath", Tclae_GetHFSPathCmd, NULL, 0L);
#endif

    Tcl_CreateObjCommand(interp, "tclAE::launch", Tclae_LaunchCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::processes", Tclae_ProcessesCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::remoteProcessResolverGetProcesses", Tclae_RemoteProcessResolverGetProcessesCmd, NULL, 0L);
    
    /* AEDesc commands */
    
    Tcl_CreateObjCommand(interp, "tclAE::coerceData", Tclae_CoerceDataCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::coerceDesc", Tclae_CoerceDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::countItems", Tclae_CountItemsCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::createDesc", Tclae_CreateDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::createList", Tclae_CreateListCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::deleteItem", Tclae_DeleteItemCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::deleteKeyDesc", Tclae_DeleteKeyDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::duplicateDesc", Tclae_DuplicateDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getAttributeData", Tclae_GetAttributeDataCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getAttributeDesc", Tclae_GetAttributeDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getData", Tclae_GetDataCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getDescType", Tclae_GetDescTypeCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getKeyData", Tclae_GetKeyDataCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getKeyDesc", Tclae_GetKeyDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getNthData", Tclae_GetNthDataCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::getNthDesc", Tclae_GetNthDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::putData", Tclae_PutDataCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::putDesc", Tclae_PutDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::putKeyData", Tclae_PutKeyDataCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::putKeyDesc", Tclae_PutKeyDescCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::replaceDescData", Tclae_ReplaceDescDataCmd, NULL, 0L);
    Tcl_CreateObjCommand(interp, "tclAE::setDescType", Tclae_SetDescTypeCmd, NULL, 0L);
    
    Tcl_CreateObjCommand(interp, "tclAE::_private::_getAEDesc", Tclae__GetAEDescCmd, NULL, 0L);
    
//.........这里部分代码省略.........

static int
PyAggImagePhoto(ClientData clientdata, Tcl_Interp* interp,
                int argc, char **argv)
{
    Tk_PhotoHandle photo;
    Tk_PhotoImageBlock block;
    PyObject* aggo;

    // vars for blitting
    PyObject* bboxo;

    unsigned long aggl, bboxl;
    bool has_bbox;
    agg::int8u *destbuffer;
    double l, b, r, t;
    int destx, desty, destwidth, destheight, deststride;
    //unsigned long tmp_ptr;

    long mode;
    long nval;
    if (Tk_MainWindow(interp) == NULL)
    {
        // Will throw a _tkinter.TclError with "this isn't a Tk application"
        return TCL_ERROR;
    }

    if (argc != 5)
    {
        Tcl_AppendResult(interp, "usage: ", argv[0],
                         " destPhoto srcImage", (char *) NULL);
        return TCL_ERROR;
    }

    /* get Tcl PhotoImage handle */
    photo = Tk_FindPhoto(interp, argv[1]);
    if (photo == NULL)
    {
        Tcl_AppendResult(interp, "destination photo must exist", (char *) NULL);
        return TCL_ERROR;
    }
    /* get array (or object that can be converted to array) pointer */
    if (sscanf(argv[2], "%lu", &aggl) != 1)
    {
        Tcl_AppendResult(interp, "error casting pointer", (char *) NULL);
        return TCL_ERROR;
    }
    aggo = (PyObject*)aggl;
    //aggo = (PyObject*)atol(argv[2]);

    //std::stringstream agg_ptr_ss;
    //agg_ptr_ss.str(argv[2]);
    //agg_ptr_ss >> tmp_ptr;
    //aggo = (PyObject*)tmp_ptr;
    RendererAgg *aggRenderer = (RendererAgg *)aggo;
    int srcheight = (int)aggRenderer->get_height();

    /* XXX insert aggRenderer type check */

    /* get array mode (0=mono, 1=rgb, 2=rgba) */
    mode = atol(argv[3]);
    if ((mode != 0) && (mode != 1) && (mode != 2))
    {
        Tcl_AppendResult(interp, "illegal image mode", (char *) NULL);
        return TCL_ERROR;
    }

    /* check for bbox/blitting */
    if (sscanf(argv[4], "%lu", &bboxl) != 1)
    {
        Tcl_AppendResult(interp, "error casting pointer", (char *) NULL);
        return TCL_ERROR;
    }
    bboxo = (PyObject*)bboxl;

    //bboxo = (PyObject*)atol(argv[4]);
    //std::stringstream bbox_ptr_ss;
    //bbox_ptr_ss.str(argv[4]);
    //bbox_ptr_ss >> tmp_ptr;
    //bboxo = (PyObject*)tmp_ptr;
    if (py_convert_bbox(bboxo, l, b, r, t))
    {
        has_bbox = true;

        destx = (int)l;
        desty = srcheight - (int)t;
        destwidth = (int)(r - l);
        destheight = (int)(t - b);
        deststride = 4 * destwidth;

        destbuffer = new agg::int8u[deststride*destheight];
        if (destbuffer == NULL)
        {
            throw Py::MemoryError("_tkagg could not allocate memory for destbuffer");
        }

        agg::rendering_buffer destrbuf;
        destrbuf.attach(destbuffer, destwidth, destheight, deststride);
        pixfmt destpf(destrbuf);
        renderer_base destrb(destpf);

//.........这里部分代码省略.........

int
Pg_execute(ClientData cData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
{
	Pg_ConnectionId *connid;
	PGconn	   *conn;
	PGresult   *result;
	int			i;
	int			tupno;
	int			ntup;
	int			loop_rc;
	CONST84 char *oid_varname = NULL;
	CONST84 char *array_varname = NULL;
	char		buf[64];

	char	   *usage = "Wrong # of arguments\n"
	"pg_execute ?-array arrayname? ?-oid varname? "
	"connection queryString ?loop_body?";

	/*
	 * First we parse the options
	 */
	i = 1;
	while (i < argc)
	{
		if (argv[i][0] != '-')
			break;

		if (strcmp(argv[i], "-array") == 0)
		{
			/*
			 * The rows should appear in an array vs. to single variables
			 */
			i++;
			if (i == argc)
			{
				Tcl_SetResult(interp, usage, TCL_VOLATILE);
				return TCL_ERROR;
			}
			array_varname = argv[i++];
			continue;
		}

		if (strcmp(argv[i], "-oid") == 0)
		{
			/*
			 * We should place PQoidValue() somewhere
			 */
			i++;
			if (i == argc)
			{
				Tcl_SetResult(interp, usage, TCL_VOLATILE);
				return TCL_ERROR;
			}
			oid_varname = argv[i++];
			continue;
		}

		Tcl_AppendResult(interp, "Unknown option '", argv[i], "'", NULL);
		return TCL_ERROR;
	}

	/*
	 * Check that after option parsing at least 'connection' and 'query'
	 * are left
	 */
	if (argc - i < 2)
	{
		Tcl_SetResult(interp, usage, TCL_VOLATILE);
		return TCL_ERROR;
	}

	/*
	 * Get the connection and make sure no COPY command is pending
	 */
	conn = PgGetConnectionId(interp, argv[i++], &connid);
	if (conn == (PGconn *) NULL)
		return TCL_ERROR;

	if (connid->res_copyStatus != RES_COPY_NONE)
	{
		Tcl_SetResult(interp, "Attempt to query while COPY in progress", TCL_STATIC);
		return TCL_ERROR;
	}

	/*
	 * Execute the query
	 */
	result = PQexec(conn, argv[i++]);

	/*
	 * Transfer any notify events from libpq to Tcl event queue.
	 */
	PgNotifyTransferEvents(connid);

	/*
	 * Check for errors
	 */
	if (result == NULL)
	{
		Tcl_SetResult(interp, PQerrorMessage(conn), TCL_VOLATILE);
//.........这里部分代码省略.........

//.........这里部分代码省略.........
	    dirName = ".";
	} else {
	    dirName = Tcl_DStringValue(&dsOrig);

	    /*
	     * Make sure we have a trailing directory delimiter.
	     */

	    if (dirName[dirLength-1] != '/') {
		dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
		dirLength++;
	    }
	}

	/*
	 * Now open the directory for reading and iterate over the contents.
	 */

	native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);

	if ((TclOSstat(native, &statBuf) != 0)		/* INTL: Native. */
		|| !S_ISDIR(statBuf.st_mode)) {
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DStringFree(&ds);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_OK;
	}

	d = opendir(native);				/* INTL: Native. */
	if (d == NULL) {
	    Tcl_DStringFree(&ds);
	    if (interp != NULL) {
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "couldn't read directory \"",
			Tcl_DStringValue(&dsOrig), "\": ",
			Tcl_PosixError(interp), (char *) NULL);
	    }
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_ERROR;
	}

	nativeDirLen = Tcl_DStringLength(&ds);

	/*
	 * Check to see if -type or the pattern requests hidden files.
	 */

	matchHiddenPat = (pattern[0] == '.')
		|| ((pattern[0] == '\\') && (pattern[1] == '.'));
	matchHidden = matchHiddenPat 
		|| (types && (types->perm & TCL_GLOB_PERM_HIDDEN));
	while ((entryPtr = TclOSreaddir(d)) != NULL) {	/* INTL: Native. */
	    Tcl_DString utfDs;
	    CONST char *utfname;

	    /*
	     * Skip this file if it doesn't agree with the hidden parameters
	     * requested by the user (via -type or pattern).
	     */

	    if (*entryPtr->d_name == '.') {
		if (!matchHidden) continue;
	    } else {
#ifdef MAC_OSX_TCL
		if (matchHiddenPat) continue;

int adress_set(Tcl_Interp *interp,int argc, char **argv){
   int topo=-1,i,wf=0,set_center=0;
   double width[2],center[3];
   char buffer[3*TCL_DOUBLE_SPACE];
   argv+=2;argc-=2;

   for(i=0;i<3;i++) center[i]=box_l[i]/2;

   if (argc < 2) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp, "Wrong # of args! adress set needs at least 2 arguments\n", (char *)NULL);
      Tcl_AppendResult(interp, "Usage: adress set topo [0|1|2|3] width X.X Y.Y (center X.X Y.Y Z.Z) (wf [0|1])\n", (char *)NULL);
      Tcl_AppendResult(interp, "topo:   0 - switched off (no more values needed)\n", (char *)NULL);
      Tcl_AppendResult(interp, "        1 - constant (weight will be first value of width)\n", (char *)NULL);
      Tcl_AppendResult(interp, "        2 - divided in one direction (default x, or give a negative center coordinate\n", (char *)NULL);
      Tcl_AppendResult(interp, "        3 - spherical topology\n", (char *)NULL);
      Tcl_AppendResult(interp, "width:  X.X  - half of size of ex zone(r0/2 in the papers)\n", (char *)NULL);
      Tcl_AppendResult(interp, "        Y.Y  - size of hybrid zone (d in the papers)\n", (char *)NULL);
      Tcl_AppendResult(interp, "        Note: Only one value need for topo 1 \n", (char *)NULL);
      Tcl_AppendResult(interp, "center: center of the ex zone (default middle of the box) \n", (char *)NULL);
      Tcl_AppendResult(interp, "        Note: x|y|x X.X for topo 2  \n", (char *)NULL);
      Tcl_AppendResult(interp, "        Note: X.X Y.Y Z.Z for topo 3  \n", (char *)NULL);
      Tcl_AppendResult(interp, "wf:     0 - cos weighting function (default)\n", (char *)NULL);
      Tcl_AppendResult(interp, "        1 - polynom weighting function\n", (char *)NULL);
      Tcl_AppendResult(interp, "ALWAYS set box_l first !!!", (char *)NULL);
      return (TCL_ERROR);
   }

   //parse topo
   if ( (argc<2) || (!ARG0_IS_S("topo"))  || (!ARG1_IS_I(topo)) || (topo < 0) || (topo > 3) ) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp, "expected \'topo 0|1|2|3\'\n", (char *)NULL);
      return (TCL_ERROR);
   }
   argv+=2;argc-=2;
   
   //stop if topo is 0
   if (topo==0) {
      adress_vars[0]=0.0;
      mpi_bcast_parameter(FIELD_ADRESS);
      return TCL_OK;
   }

   //parse width
   if ( (argc>1) && (ARG0_IS_S("width")) ) {
      if (topo==1) {
         if ( (!ARG1_IS_D(width[0])) || (width[0]<0) ){
            Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, "expected \'width X.X (X.X non-negative)\'", (char *)NULL);
            return (TCL_ERROR);
         }
         if ((width[0]> 1.0) || (width[0]< 0.0)) {
            Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, "for constant topo, first width must be between 0 and 1", (char *)NULL);
            return (TCL_ERROR);
         }
         //stop if topo is 1
         adress_vars[0]=1;
         adress_vars[1]=width[0];
         mpi_bcast_parameter(FIELD_ADRESS);
         return TCL_OK;
      }
      else {//topo 2 and 3 are left over
         if ( (argc<3) || (!ARG1_IS_D(width[0])) || (width[0]<0) ||(!ARG_IS_D(2,width[1])) || (width[1]<0) ){
            Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, "expected \'width X.X Y.Y (both non-negative)\'", (char *)NULL);
            return (TCL_ERROR);
         }
         argv+=3;argc-=3;
      }
   }
   else{
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp, "expected \'width\'", (char *)NULL);
      return (TCL_ERROR);
   }

   while (argc!=0){
      if (ARG0_IS_S("wf")){
         if ( (argc<2) || (!ARG1_IS_I(wf)) || (wf < 0) || (wf > 1) ){
            Tcl_ResetResult(interp);
            Tcl_AppendResult(interp, "expected \'wf 0|1\'", (char *)NULL);
            return (TCL_ERROR);
         }
         else{
            argv+=2;argc-=2;
         }
      }
      else if (ARG0_IS_S("center")){
         if (topo == 2) {
            if ( (argc<3) || ( (!ARG1_IS_S("x"))&&(!ARG1_IS_S("y"))&&(!ARG1_IS_S("z")) ) || (!ARG_IS_D(2,center[1])) ){
               Tcl_ResetResult(interp);
               Tcl_AppendResult(interp, "expected \'center x|y|z X.X\'", (char *)NULL);
               return (TCL_ERROR);
            }
            if (ARG1_IS_S("x")) center[0]=0;
            else if  (ARG1_IS_S("y")) center[0]=1;
            else center[0]=2;
            if ( (center[1]<0) || (center[1]>box_l[(int)center[0]]) ) {
               Tcl_ResetResult(interp);
//.........这里部分代码省略.........

/*!
 tux_open_courses Tcl callback
 \author  jfpatry
 \date    Created:  2000-09-19
 \date    Modified: 2000-09-19
 */
static int open_courses_cb( ClientData cd, Tcl_Interp *ip,
                            int argc, const char **argv )
{
    char *err_msg;
    const char **list = NULL;
    int num_courses;
    list_elem_t last_elem = NULL;
    list_elem_t last_speed_elem = NULL;
    list_elem_t last_score_elem = NULL;
    int i, j;
    char preview_file[100];

    check_assertion( initialized,
                     "course_mgr module not initialized" );

    if ( argc != 2 ) {
        err_msg = "Wrong number of arguments";
        goto bail_open_courses;
    }

    if ( Tcl_SplitList( ip, argv[1], &num_courses, &list ) == TCL_ERROR ) {
        err_msg = "Argument is not a list";
        goto bail_open_courses;
    }

    /* Add items to end of list */
    last_elem = get_list_tail( open_course_list );
    last_speed_elem = get_list_tail( speed_course_list );
    last_score_elem = get_list_tail( score_course_list );

    for ( i=0; i<num_courses; i++ ) {
        open_course_data_t *data;
        data = create_open_course_data( ip, list[i], &err_msg );

#ifdef __ANDROID__
        sprintf(preview_file, "courses/%s/preview.jpg", data->course);
#else
        sprintf(preview_file, "%s/courses/%s/preview.jpg", getparam_data_dir(), data->course);
#endif

        load_texture(data->course, preview_file, 1);
        bind_texture(data->course, data->course);

        if ( data == NULL ) {
            goto bail_open_courses;
        }

        last_elem = insert_list_elem(
                        open_course_list,
                        last_elem,
                        (list_elem_data_t) data );
        if(data->speed)
        {
            last_speed_elem = insert_list_elem(
                                  speed_course_list,
                                  last_speed_elem,
                                  (list_elem_data_t) data );
        }
        if(data->score)
        {
            last_score_elem = insert_list_elem(
                                  score_course_list,
                                  last_score_elem,
                                  (list_elem_data_t) data );
        }

    }

    Tcl_Free( (char*) list );
    list = NULL;

    return TCL_OK;

bail_open_courses:

    /* We'll leave the data that was successfully added in the list. */

    Tcl_AppendResult(
        ip,
        "Error in call to tux_open_courses: ",
        err_msg,
        "\n",
        "Usage: tux_open_courses { list of open courses }",
        (NULL) );
    return TCL_ERROR;
}