/*
 * tkMacOSXDraw.c --
 *
 *	This file contains functions that perform drawing to Xlib windows. Most
 *	of the functions simple emulate Xlib functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright 2001-2009, Apple Inc.
 * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright 2014 Marc Culler.
 *
 * See the file "license.terms" for information on usage and redistribution

/*
 * tkMacOSXDraw.c --
 *
 *	This file contains functions that perform drawing to Xlib windows. Most
 *	of the functions simply emulate Xlib functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright 2001-2009, Apple Inc.
 * Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright 2014 Marc Culler.
 *
 * See the file "license.terms" for information on usage and redistribution

 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new
				   value. May be NULL even if length > 0. */
    int length)			/* Length of the array of bytes, which must
				   be >= 0. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
................................................................................
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	int attempt;

	if (needed <= INT_MAX/2) {

	    /* Try to allocate double the total space that is needed. */


	    attempt = 2 * needed;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {

	    /* Try to allocate double the increment that is needed (plus). */


	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = len + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {

	    /* Last chance: Try to allocate exactly what is needed. */


	    attempt = needed;
	    ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
................................................................................
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    int count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;	/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
................................................................................
     */

    resultPtr = Tcl_NewObj();
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, (size_t) length);

    /*
     * Pack the data into the result object. Note that we can skip the
     * error checking during this pass, since we have already parsed the
     * string once.
     */

    arg = 2;
    format = TclGetString(objv[1]);
    cursor = buffer;
    maxPos = cursor;
    while (*format != 0) {
................................................................................
		TclListObjGetElements(interp, objv[arg], &listc, &listv);
		if (count == BINARY_ALL) {
		    count = listc;
		}
	    }
	    arg++;
	    for (i = 0; i < count; i++) {
		if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case 'x':
................................................................................
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    int count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;	/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    int offset, size, length;

................................................................................

	    /*
	     * Trim trailing nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {
		while (size > 0) {
		    if (src[size-1] != '\0' && src[size-1] != ' ') {
			break;
		    }
		    size--;
		}
	    }

	    /*
................................................................................

	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double)FLT_MAX) {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;
................................................................................

static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */
    int flags,			/* Format field flags */
    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned
				 * value objects, or NULL if too many
				 * different numbers have been scanned. */
{
    long value;
    float fvalue;
    double dvalue;
    Tcl_WideUInt uwvalue;

    /*
................................................................................
		    + (buffer[1] << 16)
		    + (((long) buffer[0]) << 24));
	}

	/*
	 * Check to see if the value was sign extended properly on systems
	 * where an int is more than 32-bits.

	 * We avoid caching unsigned integers as we cannot distinguish between
	 * 32bit signed and unsigned in the hash (short and char are ok).
	 */

	if (flags & BINARY_UNSIGNED) {
	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
	}
	if ((value & (((unsigned) 1)<<31)) && (value > 0)) {
	    value -= (((unsigned) 1)<<31);
	    value -= (((unsigned) 1)<<31);
	}

    returnNumericObject:
	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewLongObj(value);
	} else {
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
................................................................................
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = Tcl_GetByteArrayFromObj(objv[1], &count);
    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
    for (offset = 0; offset < count; ++offset) {
	*cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)];
	*cursor++ = HexDigits[(data[offset] & 0x0f)];
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i=0 ; i<2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit((int) c)) {
................................................................................
	    c -= '0';
	    if (c > 9) {
		c += ('0' - 'A') + 10;
	    }
	    if (c > 16) {
		c += ('A' - 'a');
	    }
	    value |= (c & 0xf);
	}
	if (i < 2) {
	    cut++;
	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
................................................................................
{
    Tcl_Obj *resultObj;
    unsigned char *data, *cursor, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    int wrapcharlen = 1;
    int offset, i, index, size, outindex = 0, count = 0;
    enum {OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc%2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
    if (count > 0) {
	size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));

	    if (size % maxlen == 0) {
		adjusted -= wrapcharlen;
	    }
	    size = adjusted;
	}
	cursor = Tcl_SetByteArrayLength(resultObj, size);
	limit = cursor + size;
	for (offset = 0; offset < count; offset+=3) {
	    unsigned char d[3] = {0, 0, 0};

	    for (i = 0; i < 3 && offset+i < count; ++i) {
		d[i] = data[offset + i];
	    }
	    OUTPUT(B64Digits[d[0] >> 2]);
	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
	    if (offset+1 < count) {
		OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
	    } else {
		OUTPUT(B64Digits[64]);
	    }
	    if (offset+2 < count) {
		OUTPUT(B64Digits[d[2] & 0x3f]);
	    } else {
................................................................................
    int lineLength = 61;
    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
    const unsigned char *wrapchar = SingleNewline;
    int wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc%2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) {

		return TCL_ERROR;
	    }
	    if (lineLength < 3 || lineLength > 85) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen);
	    break;
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    resultObj = Tcl_NewObj();
    offset = 0;
    data = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
................................................................................
    while (offset < count) {
	int lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i=0 ; i<lineLen ; i++) {
	    n <<= 8;
	    n |= data[offset++];
	    for (bits += 8; bits > 6 ; bits -= 6) {
		*cursor++ = UueDigits[(n >> (bits-6)) & 0x3f];
	    }
	}
	if (bits > 0) {
	    n <<= 8;
	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
	    bits = 0;
	}
	for (j=0 ; j<wrapcharlen ; ++j) {
	    *cursor++ = wrapchar[j];
	}
    }

    /*
     * Fix the length of the output bytearray.
     */

    Tcl_SetByteArrayLength(resultObj, cursor-start);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, size, count = 0, strict = 0, lineLen;
    unsigned char c;
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

    /*
     * The decoding loop. First, we get the length of line (strictly, the
................................................................................
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i=0 ; i<4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
................................................................................
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc-1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc-1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

	/*
................................................................................

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {
		if (strict && i <= 1) {

		    /* single resp. unfulfilled char (each 4th next single char)
		     * is rather bad64 error case in strict mode */


		    goto bad64;
		}
		cut += 3;
		break;
	    }

	    /*
................................................................................
	     * because they're only valid as the last character or two of the
	     * final block of input. Unless strict mode is enabled, skip any
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		     value <<= 6;
		     cut++;
		} else if (!strict && TclIsSpaceProc(c)) {
		     i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=' && (

		!strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */
	    ) {


		value <<= 6;
		if (i) cut++;


	    } else if (strict || !TclIsSpaceProc(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
................................................................................
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new value.
				 * May be NULL even if length > 0. */
    int length)			/* Length of the array of bytes, which must
				 * be >= 0. */
{
    ByteArray *byteArrayPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
................................................................................
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	int attempt;

	if (needed <= INT_MAX/2) {
	    /*
	     * Try to allocate double the total space that is needed.
	     */

	    attempt = 2 * needed;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Try to allocate double the increment that is needed (plus).
	     */

	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = len + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	     */

	    attempt = needed;
	    ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
................................................................................
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    int count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
................................................................................
     */

    resultPtr = Tcl_NewObj();
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, (size_t) length);

    /*
     * Pack the data into the result object. Note that we can skip the error
     * checking during this pass, since we have already parsed the string
     * once.
     */

    arg = 2;
    format = TclGetString(objv[1]);
    cursor = buffer;
    maxPos = cursor;
    while (*format != 0) {
................................................................................
		TclListObjGetElements(interp, objv[arg], &listc, &listv);
		if (count == BINARY_ALL) {
		    count = listc;
		}
	    }
	    arg++;
	    for (i = 0; i < count; i++) {
		if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case 'x':
................................................................................
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    int count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    const char *errorString;
    const char *str;
    int offset, size, length;

................................................................................

	    /*
	     * Trim trailing nulls and spaces, if necessary.
	     */

	    if (cmd == 'A') {
		while (size > 0) {
		    if (src[size - 1] != '\0' && src[size - 1] != ' ') {
			break;
		    }
		    size--;
		}
	    }

	    /*
................................................................................

	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double) FLT_MAX) {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;
................................................................................

static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */
    int flags,			/* Format field flags */
    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned value
				 * objects, or NULL if too many different
				 * numbers have been scanned. */
{
    long value;
    float fvalue;
    double dvalue;
    Tcl_WideUInt uwvalue;

    /*
................................................................................
		    + (buffer[1] << 16)
		    + (((long) buffer[0]) << 24));
	}

	/*
	 * Check to see if the value was sign extended properly on systems
	 * where an int is more than 32-bits.
	 *
	 * We avoid caching unsigned integers as we cannot distinguish between
	 * 32bit signed and unsigned in the hash (short and char are ok).
	 */

	if (flags & BINARY_UNSIGNED) {
	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
	}
	if ((value & (((unsigned) 1) << 31)) && (value > 0)) {
	    value -= (((unsigned) 1) << 31);
	    value -= (((unsigned) 1) << 31);
	}

    returnNumericObject:
	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewLongObj(value);
	} else {
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
................................................................................
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = Tcl_GetByteArrayFromObj(objv[1], &count);
    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
    for (offset = 0; offset < count; ++offset) {
	*cursor++ = HexDigits[(data[offset] >> 4) & 0x0f];
	*cursor++ = HexDigits[data[offset] & 0x0f];
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i = 0 ; i < 2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit((int) c)) {
................................................................................
	    c -= '0';
	    if (c > 9) {
		c += ('0' - 'A') + 10;
	    }
	    if (c > 16) {
		c += ('A' - 'a');
	    }
	    value |= c & 0xf;
	}
	if (i < 2) {
	    cut++;
	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
................................................................................
{
    Tcl_Obj *resultObj;
    unsigned char *data, *cursor, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    int wrapcharlen = 1;
    int offset, i, index, size, outindex = 0, count = 0;
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen);
	    if (wrapcharlen == 0) {
		maxlen = 0;
	    }
	    break;
	}
    }

    resultObj = Tcl_NewObj();
    data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count);
    if (count > 0) {
	size = (((count * 4) / 3) + 3) & ~3;	/* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));

	    if (size % maxlen == 0) {
		adjusted -= wrapcharlen;
	    }
	    size = adjusted;
	}
	cursor = Tcl_SetByteArrayLength(resultObj, size);
	limit = cursor + size;
	for (offset = 0; offset < count; offset += 3) {
	    unsigned char d[3] = {0, 0, 0};

	    for (i = 0; i < 3 && offset + i < count; ++i) {
		d[i] = data[offset + i];
	    }
	    OUTPUT(B64Digits[d[0] >> 2]);
	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
	    if (offset + 1 < count) {
		OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]);
	    } else {
		OUTPUT(B64Digits[64]);
	    }
	    if (offset+2 < count) {
		OUTPUT(B64Digits[d[2] & 0x3f]);
	    } else {
................................................................................
    int lineLength = 61;
    const unsigned char SingleNewline[] = { (unsigned char) '\n' };
    const unsigned char *wrapchar = SingleNewline;
    int wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1],
		    &lineLength) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (lineLength < 3 || lineLength > 85) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = Tcl_GetByteArrayFromObj(objv[i + 1], &wrapcharlen);
	    break;
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    resultObj = Tcl_NewObj();
    offset = 0;
    data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
................................................................................
    while (offset < count) {
	int lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i = 0 ; i < lineLen ; i++) {
	    n <<= 8;
	    n |= data[offset++];
	    for (bits += 8; bits > 6 ; bits -= 6) {
		*cursor++ = UueDigits[(n >> (bits - 6)) & 0x3f];
	    }
	}
	if (bits > 0) {
	    n <<= 8;
	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f];
	    bits = 0;
	}
	for (j = 0 ; j < wrapcharlen ; ++j) {
	    *cursor++ = wrapchar[j];
	}
    }

    /*
     * Fix the length of the output bytearray.
     */

    Tcl_SetByteArrayLength(resultObj, cursor - start);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, size, count = 0, strict = 0, lineLen;
    unsigned char c;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

    /*
     * The decoding loop. First, we get the length of line (strictly, the
................................................................................
	    lineLen = (c - 32) & 0x3f;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i = 0 ; i < 4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
................................................................................
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    datastart = data = (unsigned char *)
	    TclGetStringFromObj(objv[objc - 1], &count);
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

	/*
................................................................................

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {
		if (strict && i <= 1) {
		    /*
		     * Single resp. unfulfilled char (each 4th next single
		     * char) is rather bad64 error case in strict mode.
		     */

		    goto bad64;
		}
		cut += 3;
		break;
	    }

	    /*
................................................................................
	     * because they're only valid as the last character or two of the
	     * final block of input. Unless strict mode is enabled, skip any
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		    value <<= 6;
		    cut++;
		} else if (!strict && TclIsSpaceProc(c)) {
		    i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3f);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3f);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3f);
	    } else if (c == '+') {
		value = (value << 6) | 0x3e;
	    } else if (c == '/') {
		value = (value << 6) | 0x3f;
	    } else if (c == '=' && (!strict || i > 1)) {
		/*
		 * "=" and "a=" is rather bad64 error case in strict mode.

		 */

		value <<= 6;
		if (i) {
		    cut++;
		}
	    } else if (strict || !TclIsSpaceProc(c)) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xff);
................................................................................
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

CMAKE_MINIMUM_REQUIRED ( VERSION 3.2 FATAL_ERROR )
if(POLICY CMP0074)
  cmake_policy(SET CMP0074 NEW)
endif()



## ===========================================================================
##  Project Information
## ===========================================================================
PROJECT ( tkdnd )
## Package version information:
SET ( PKG_NAME          ${PROJECT_NAME} )








SET ( PKG_MAJOR_VERSION 2 )
SET ( PKG_MINOR_VERSION 9 )
SET ( PKG_BUILD_VERSION 0 )
## Author:
SET ( PKG_VENDOR        "Georgios Petasis" )

## ===========================================================================
##  User options...
## ===========================================================================
set(with-tclsh "" CACHE FILEPATH "location of a working tclsh executable")
................................................................................
    INCLUDE_DIRECTORIES ( /System/Library/Frameworks/Tk.framework/Versions/8.5/Headers/tk-private )
    INCLUDE_DIRECTORIES ( /System/Library/Frameworks/Tk.framework/Versions/8.5/Headers/tk-private )
    ADD_DEFINITIONS     ( -DMAC_TK_COCOA -DMAC_OSX_TK)
    ADD_DEFINITIONS     ( -DMAC_OSX_TK )
    ADD_DEFINITIONS     ( -std=gnu99 )
    ADD_DEFINITIONS     ( -x objective-c )
    ADD_DEFINITIONS     ( -fobjc-gc  )
    ADD_DEFINITIONS     ( -fno-objc-arc )
    ADD_DEFINITIONS     ( -fobjc-arc )
    LINK_LIBRARIES      ( ${COCOA_LIBRARY} )
    SET ( PKG_SOURCES macosx/macdnd.m )
  ELSE ( APPLE )
    INCLUDE_DIRECTORIES ( unix )
    SET ( PKG_SOURCES unix/TkDND_XDND.c unix/tkUnixSelect.c unix/Cursors.c )
    MESSAGE ( STATUS "Searching for X11..." )
................................................................................
       "${CMAKE_SHARED_LINKER_FLAGS} -static-libstdc++" )
  ENDIF (FLAG_static_libstdcpp )
ENDIF ( MINGW )

## Arange project version information...
SET ( PKG_VERSION
     "${PKG_MAJOR_VERSION}.${PKG_MINOR_VERSION}.${PKG_BUILD_VERSION}" )
SET ( PKG_VERSION
     "${PKG_MAJOR_VERSION}.${PKG_MINOR_VERSION}" )
SET ( PKG_NAME_VERSION  ${PKG_NAME}-${PKG_VERSION} )
SET ( PKG_HOME_DIR      ${PROJECT_SOURCE_DIR} )

## Greet the user...
MESSAGE ( STATUS "===========================================================" )
MESSAGE ( STATUS " Welcome to the ${PKG_NAME} ${PKG_VERSION} build system!" )
MESSAGE ( STATUS "  * Selected generator:  ${CMAKE_GENERATOR}" )
................................................................................
SET ( PKG_TARGET_LIB_NAME ${PKG_NAME}${PKG_VERSION} )
MESSAGE ( STATUS "      + Shared Library: ${PKG_NAME}" )
ADD_LIBRARY ( ${PKG_TARGET_LIB_NAME} SHARED ${PKG_SOURCES} )

## ===========================================================================
##  Generate the pkgIndex.tcl file...
## ===========================================================================
FILE ( WRITE library/pkgIndex.tcl 
"package ifneeded ${PKG_NAME} ${PKG_VERSION} \\
  \"source \\{$dir/tkdnd.tcl\\} ; \\
   tkdnd::initialise \\{$dir\\} lib${PKG_TARGET_LIB_NAME}[info sharedlibextension] ${PKG_NAME}\"
   
package ifneeded tkdnd::utils ${PKG_VERSION} \\
  \"source \\{$dir/tkdnd_utils.tcl\\} ; \\
   package provide tkdnd::utils ${PKG_VERSION}\"" )

## ===========================================================================
##  Declare the package install targets...
## ===========================================================================

CMAKE_MINIMUM_REQUIRED ( VERSION 3.2 FATAL_ERROR )
if(POLICY CMP0074)
  cmake_policy(SET CMP0074 NEW)
endif()

SET ( TKDND_TOP_DIR "${CMAKE_CURRENT_SOURCE_DIR}" )

## ===========================================================================
##  Project Information
## ===========================================================================
PROJECT ( tkdnd )
## Package version information:
SET ( PKG_NAME          ${PROJECT_NAME} )

SET ( TKDND_VERSION "2.9.2" )
STRING ( REGEX MATCH "([0-9]+)\.([0-9]+)\.([0-9]+)" _ ${TKDND_VERSION} )
SET ( TKDND_MAJOR_VERSION ${CMAKE_MATCH_1} )
SET ( TKDND_MINOR_VERSION ${CMAKE_MATCH_2} )
SET ( TKDND_PATCH_VERSION ${CMAKE_MATCH_3} )
MESSAGE ( STATUS "TKDND version: ${TKDND_MAJOR_VERSION}.${TKDND_MINOR_VERSION}.${TKDND_PATCH_VERSION}" )

SET ( PKG_MAJOR_VERSION ${TKDND_MAJOR_VERSION} )
SET ( PKG_MINOR_VERSION ${TKDND_MINOR_VERSION} )
SET ( PKG_BUILD_VERSION ${TKDND_PATCH_VERSION} )
## Author:
SET ( PKG_VENDOR        "Georgios Petasis" )

## ===========================================================================
##  User options...
## ===========================================================================
set(with-tclsh "" CACHE FILEPATH "location of a working tclsh executable")
................................................................................
    INCLUDE_DIRECTORIES ( /System/Library/Frameworks/Tk.framework/Versions/8.5/Headers/tk-private )
    INCLUDE_DIRECTORIES ( /System/Library/Frameworks/Tk.framework/Versions/8.5/Headers/tk-private )
    ADD_DEFINITIONS     ( -DMAC_TK_COCOA -DMAC_OSX_TK)
    ADD_DEFINITIONS     ( -DMAC_OSX_TK )
    ADD_DEFINITIONS     ( -std=gnu99 )
    ADD_DEFINITIONS     ( -x objective-c )
    ADD_DEFINITIONS     ( -fobjc-gc  )

    ADD_DEFINITIONS     ( -fobjc-arc )
    LINK_LIBRARIES      ( ${COCOA_LIBRARY} )
    SET ( PKG_SOURCES macosx/macdnd.m )
  ELSE ( APPLE )
    INCLUDE_DIRECTORIES ( unix )
    SET ( PKG_SOURCES unix/TkDND_XDND.c unix/tkUnixSelect.c unix/Cursors.c )
    MESSAGE ( STATUS "Searching for X11..." )
................................................................................
       "${CMAKE_SHARED_LINKER_FLAGS} -static-libstdc++" )
  ENDIF (FLAG_static_libstdcpp )
ENDIF ( MINGW )

## Arange project version information...
SET ( PKG_VERSION
     "${PKG_MAJOR_VERSION}.${PKG_MINOR_VERSION}.${PKG_BUILD_VERSION}" )
#SET ( PKG_VERSION
#     "${PKG_MAJOR_VERSION}.${PKG_MINOR_VERSION}" )
SET ( PKG_NAME_VERSION  ${PKG_NAME}-${PKG_VERSION} )
SET ( PKG_HOME_DIR      ${PROJECT_SOURCE_DIR} )

## Greet the user...
MESSAGE ( STATUS "===========================================================" )
MESSAGE ( STATUS " Welcome to the ${PKG_NAME} ${PKG_VERSION} build system!" )
MESSAGE ( STATUS "  * Selected generator:  ${CMAKE_GENERATOR}" )
................................................................................
SET ( PKG_TARGET_LIB_NAME ${PKG_NAME}${PKG_VERSION} )
MESSAGE ( STATUS "      + Shared Library: ${PKG_NAME}" )
ADD_LIBRARY ( ${PKG_TARGET_LIB_NAME} SHARED ${PKG_SOURCES} )

## ===========================================================================
##  Generate the pkgIndex.tcl file...
## ===========================================================================
FILE ( WRITE library/pkgIndex.tcl
"package ifneeded ${PKG_NAME} ${PKG_VERSION} \\
  \"source \\{$dir/tkdnd.tcl\\} ; \\
   tkdnd::initialise \\{$dir\\} lib${PKG_TARGET_LIB_NAME}[info sharedlibextension] ${PKG_NAME}\"

package ifneeded tkdnd::utils ${PKG_VERSION} \\
  \"source \\{$dir/tkdnd_utils.tcl\\} ; \\
   package provide tkdnd::utils ${PKG_VERSION}\"" )

## ===========================================================================
##  Declare the package install targets...
## ===========================================================================

2018-12-23  Petasis George  <petasis@iit.demokritos.gr>
	* .travis.yml: make install & deployment to GitHub.

	* .appveyor.yml: Set tclsh for IronTcl. Deployment to GitHub.

2018-12-22  Petasis George  <petasis@iit.demokritos.gr>
	* .appveyor.yml: Added a command to install project after build.
................................................................................

	* library/tkdnd.tcl: Fixes in ::tkdnd::drag_source(): The TkDND_Drag
	binding tag is now placed before the widget class.
	**** POTENTIAL INCOMPATIBILITY **** for applications relying on the
	previous behaviour (the tag was added as the last one).

	* library/tkdnd_compat.tcl: Fixes for the TkDND 1.x compatibility layer.
	
	* library/tkdnd_windows.tcl: Fixed two typos.
	
	* win/TkDND_OleDND.cpp: Fixed a bug in TkDND_DoDragDropObjCmd(), where
	Tcl_SetResult() was not used correctly. Calles changed to
	Tcl_SetObjResult().

	* win/TkDND_OleDND.h: Fixed a memory leak in Drop(), where
	Tcl_IncrRefCount() was called instead of the correct
	Tcl_DecrRefCount().

2019-04-16  Petasis George  <petasis@iit.demokritos.gr>
	* Version 2.9.2 released.

	* demos/basic.tcl: Merged pull request #29.
	(https://github.com/petasis/tkdnd/pull/29)

	* configure.ac: configure reads version from VERSION. Added
	TEA_PATH_X, to link with the X11 library. Fixed bug #27.
	(https://github.com/petasis/tkdnd/issues/27)

	* VERSION:
	* CMakeLists.txt: Added a VERSION file. CMake reads version from this
	file. Merged pull request #28.
	(Fixes bug #26 https://github.com/petasis/tkdnd/issues/26).

2019-02-03  Petasis George  <petasis@iit.demokritos.gr>
	* library/tkdnd.tcl: Added conversion from utf-8 in
	::tkdnd::urn_unquote.

	* library/tkdnd_unix.tcl: Added support for comments in
	xdnd::normalise_data for the "text/uri-list" media type.

	* demos/dndSpy.tcl: Modified demo to also show data to be dropped
	during drag.

	* win/OleDND.h:
	* unix/TkDND_XDND.c
	* library/tkdnd_generic.tcl:
	* library/tkdnd_macosx.tcl:
	* library/tkdnd_unix.tcl:
	* library/tkdnd_windows.tcl: Provided a solution for bug #25.
	Under Windows and Unix, the dropped data is available for the
	<<DropEnter>> and <<DropPosition>> events (%D specifier).

2018-12-23  Petasis George  <petasis@iit.demokritos.gr>
	* .travis.yml: make install & deployment to GitHub.

	* .appveyor.yml: Set tclsh for IronTcl. Deployment to GitHub.

2018-12-22  Petasis George  <petasis@iit.demokritos.gr>
	* .appveyor.yml: Added a command to install project after build.
................................................................................

	* library/tkdnd.tcl: Fixes in ::tkdnd::drag_source(): The TkDND_Drag
	binding tag is now placed before the widget class.
	**** POTENTIAL INCOMPATIBILITY **** for applications relying on the
	previous behaviour (the tag was added as the last one).

	* library/tkdnd_compat.tcl: Fixes for the TkDND 1.x compatibility layer.

	* library/tkdnd_windows.tcl: Fixed two typos.

	* win/TkDND_OleDND.cpp: Fixed a bug in TkDND_DoDragDropObjCmd(), where
	Tcl_SetResult() was not used correctly. Calles changed to
	Tcl_SetObjResult().

	* win/TkDND_OleDND.h: Fixed a memory leak in Drop(), where
	Tcl_IncrRefCount() was called instead of the correct
	Tcl_DecrRefCount().

#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.63 for tkdnd 2.9.
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization.  ##
................................................................................
MFLAGS=
MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}

# Identity of this package.
PACKAGE_NAME='tkdnd'
PACKAGE_TARNAME='tkdnd'
PACKAGE_VERSION='2.9'
PACKAGE_STRING='tkdnd 2.9'
PACKAGE_BUGREPORT=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
................................................................................
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures tkdnd 2.9 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
................................................................................
  --x-includes=DIR    X include files are in DIR
  --x-libraries=DIR   X library files are in DIR
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of tkdnd 2.9:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
................................................................................
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
tkdnd configure 2.9
generated by GNU Autoconf 2.63

Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
fi
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by tkdnd $as_me 2.9, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
................................................................................

exec 6>&1

# Save the log message, to keep $[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by tkdnd $as_me 2.9, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@
................................................................................
$config_files

Report bugs to <bug-autoconf@gnu.org>."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
tkdnd config.status 2.9
configured by $0, generated by GNU Autoconf 2.63,
  with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2008 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.63 for tkdnd 2.9.2.
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization.  ##
................................................................................
MFLAGS=
MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}

# Identity of this package.
PACKAGE_NAME='tkdnd'
PACKAGE_TARNAME='tkdnd'
PACKAGE_VERSION='2.9.2'
PACKAGE_STRING='tkdnd 2.9.2'
PACKAGE_BUGREPORT=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
................................................................................
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures tkdnd 2.9.2 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
................................................................................
  --x-includes=DIR    X include files are in DIR
  --x-libraries=DIR   X library files are in DIR
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of tkdnd 2.9.2:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
................................................................................
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
tkdnd configure 2.9.2
generated by GNU Autoconf 2.63

Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
fi
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by tkdnd $as_me 2.9.2, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
................................................................................

exec 6>&1

# Save the log message, to keep $[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by tkdnd $as_me 2.9.2, which was
generated by GNU Autoconf 2.63.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@
................................................................................
$config_files

Report bugs to <bug-autoconf@gnu.org>."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_version="\\
tkdnd config.status 2.9.2
configured by $0, generated by GNU Autoconf 2.63,
  with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2008 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

# Set your package name and version numbers here.
#
# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
# set as provided.  These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
#-----------------------------------------------------------------------

AC_INIT([tkdnd], [2.9])

#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------

# Set your package name and version numbers here.
#
# This initializes the environment with PACKAGE_NAME and PACKAGE_VERSION
# set as provided.  These will also be added as -D defs in your Makefile
# so you can encode the package version directly into the source files.
#-----------------------------------------------------------------------

AC_INIT([tkdnd], [2.9.2])

#--------------------------------------------------------------------
# Call TEA_INIT as the first TEA_ macro to set up initial vars.
# This will define a ${TEA_PLATFORM} variable == "unix" or "windows"
# as well as PKG_LIB_FILE and PKG_STUB_LIB_FILE.
#--------------------------------------------------------------------

  switch $event {
    <<DragInitCmd>> {return [list copy $type $data]}
    <<DragEndCmd>>  {puts "Drag action: $action (type: $type)"}
  }
};# drag_source

# Add some custom clipboard formats...
if {[tk windowingsystem] eq "x11"} {
  frame .colors
  foreach color {red green blue navy} {
    pack [label .colors.$color -text $color -fg white -bg $color] \

      -side left -padx 2
    tkdnd::drag_source register .colors.$color
    bind .colors.$color <<DragInitCmd>> \
      "list copy DND_Color $color"
  }
  grid .colors -sticky snew -columnspan 2
}

# Create a widget that can be a drop target.
grid [label .drop_target -text {Drop Target:} -bg yellow] \
     [label .drop_target_value -text {                  }] -sticky snew

# Register .drop_target as a drop target of every type!
tkdnd::drop_target register .drop_target *
................................................................................
              Drop_Type Cross_Platform_Drop_Type
              Pressed_Keys Data}
# Add the various events...
bind .drop_target <<DropEnter>>      $cmd
bind .drop_target <<DropPosition>>   $cmd
bind .drop_target <<DropLeave>>      $cmd

# Add the generic <<Drop>> event. This will be called when more specilised
# drop event is not found for the drop.
bind .drop_target <<Drop>>           $cmd

# Add a specialised <<Drop>> event, when will be called if a file is dropped.
bind .drop_target <<Drop:DND_Files>> $cmd

# Add a special drop command for DND_Color...
................................................................................
  }
  switch -glob $Event {
    <<DropEnter>>      {$Widget configure -bg green}
    <<DropLeave>>      {$Widget configure -bg yellow}
    <<Drop:DND_Color>> {
      $Widget configure -bg yellow
      .drop_target_value configure -text $Data
      ## Convert data into a Tk color: the color data is a list of 4 elements
      ## (red green blue opacity), expressed as Hex numbers...
      set color "#"
      for {set i 0} {$i < 3} {incr i} {
        ## Just remove the 0x prefix...
        append color [string range [lindex $Data $i] 2 end]
      }
      .drop_target_value configure -background $color -foreground white

  switch $event {
    <<DragInitCmd>> {return [list copy $type $data]}
    <<DragEndCmd>>  {puts "Drag action: $action (type: $type)"}
  }
};# drag_source

# Add some custom clipboard formats...

frame .colours
foreach colour {red green blue navy} {

  pack [label .colours.$colour -text $colour -fg white -bg $colour] \
    -side left -padx 2
  tkdnd::drag_source register .colours.$colour
  bind .colours.$colour <<DragInitCmd>> \
   "list copy DND_Color $colour"
}
grid .colours -sticky snew -columnspan 2


# Create a widget that can be a drop target.
grid [label .drop_target -text {Drop Target:} -bg yellow] \
     [label .drop_target_value -text {                  }] -sticky snew

# Register .drop_target as a drop target of every type!
tkdnd::drop_target register .drop_target *
................................................................................
              Drop_Type Cross_Platform_Drop_Type
              Pressed_Keys Data}
# Add the various events...
bind .drop_target <<DropEnter>>      $cmd
bind .drop_target <<DropPosition>>   $cmd
bind .drop_target <<DropLeave>>      $cmd

# Add the generic <<Drop>> event. This will be called when more specialised
# drop event is not found for the drop.
bind .drop_target <<Drop>>           $cmd

# Add a specialised <<Drop>> event, when will be called if a file is dropped.
bind .drop_target <<Drop:DND_Files>> $cmd

# Add a special drop command for DND_Color...
................................................................................
  }
  switch -glob $Event {
    <<DropEnter>>      {$Widget configure -bg green}
    <<DropLeave>>      {$Widget configure -bg yellow}
    <<Drop:DND_Color>> {
      $Widget configure -bg yellow
      .drop_target_value configure -text $Data
      ## Convert data into a Tk color: the colour data is a list of 4 elements
      ## (red green blue opacity), expressed as Hex numbers...
      set color "#"
      for {set i 0} {$i < 3} {incr i} {
        ## Just remove the 0x prefix...
        append color [string range [lindex $Data $i] 2 end]
      }
      .drop_target_value configure -background $color -foreground white

  set package_info "Found tkdnd package version $version\n\
                  \nPackage loading info:\n\n[package ifneeded tkdnd $version]"

}

## Place a listbox. This will be our drop target, which will also display the
## types supported by the drag source...
pack [listbox .typeList -height 25 -width 50] -side left -padx 2 -pady 2 \
        -fill y -expand 0
## A text widget to display the dropped data...
pack [text .data -height 25 -width 80] -side left -padx 2 -pady 2 -fill both \
        -expand 1
.data insert end $package_info

pack [button .exit -text {  Exit  } -command exit] -side bottom -pady 5 -padx 5






proc FillTypeListbox {listbox types type codes code actions action mods} {
    $listbox delete 0 end
    $listbox insert end {}
    $listbox insert end {        --- Types ---}
    $listbox itemconfigure end -foreground white -background red
    foreach t $types c $codes {
................................................................................
    $listbox insert end " * Current Action: \"$action\"..."
    $listbox itemconfigure end -foreground blue -background $::bg

    $listbox insert end {}
    $listbox insert end " * Modifiers: \"$mods\""
    $listbox itemconfigure end -foreground brown -background $::bg
}







proc FillData {text Data type code} {
    $text configure -state normal
    $text delete 1.0 end
    $text insert end "\n   --- Dropped Data --- (Type = \"$type\" $code)\n\n\n"
    ## Can the text be split as a list?
    switch -glob [tkdnd::platform_independent_type $type] {
      FileGroupDescriptor* {
................................................................................
update
set bg [.typeList cget -background]
set abg #8fbc8f

set type *
dnd bindtarget .typeList $type <DragEnter> ".typeList configure -bg $abg
FillTypeListbox .typeList %t %T %c %C %a %A %m

return \[lindex %a 0\]"
dnd bindtarget .typeList $type <Drag> \
        [dnd bindtarget .typeList $type <DragEnter>]
dnd bindtarget .typeList $type <Drop> \
        ".typeList configure -bg $bg; FillData .data %D %T %C"
dnd bindtarget .typeList $type <DragLeave> \
        ".typeList configure -bg $bg"

  set package_info "Found tkdnd package version $version\n\
                  \nPackage loading info:\n\n[package ifneeded tkdnd $version]"

}

## Place a listbox. This will be our drop target, which will also display the
## types supported by the drag source...
listbox .typeList -height 20 -width 50

## A text widget to display the dropped data...
text .data -height 20 -width 60

.data insert end $package_info
text .position -height 5 -width 50
button .exit -text {  Exit  } -command exit

grid .typeList .data - -sticky snew -padx 2 -pady 2
grid columnconfigure . 1 -weight 1
grid columnconfigure . 2 -weight 1
grid .position - .exit -sticky snew -padx 2 -pady 2

proc FillTypeListbox {listbox types type codes code actions action mods} {
    $listbox delete 0 end
    $listbox insert end {}
    $listbox insert end {        --- Types ---}
    $listbox itemconfigure end -foreground white -background red
    foreach t $types c $codes {
................................................................................
    $listbox insert end " * Current Action: \"$action\"..."
    $listbox itemconfigure end -foreground blue -background $::bg

    $listbox insert end {}
    $listbox insert end " * Modifiers: \"$mods\""
    $listbox itemconfigure end -foreground brown -background $::bg
}
proc FillPosition {text X Y data} {
  $text configure -state normal
  $text delete 1.0 end
  $text insert end "Position: (x=$X, y=$Y) Data Preview:\n"
  $text insert end \"$data\"
  $text configure -state disabled
};# FillPosition
proc FillData {text Data type code} {
    $text configure -state normal
    $text delete 1.0 end
    $text insert end "\n   --- Dropped Data --- (Type = \"$type\" $code)\n\n\n"
    ## Can the text be split as a list?
    switch -glob [tkdnd::platform_independent_type $type] {
      FileGroupDescriptor* {
................................................................................
update
set bg [.typeList cget -background]
set abg #8fbc8f

set type *
dnd bindtarget .typeList $type <DragEnter> ".typeList configure -bg $abg
FillTypeListbox .typeList %t %T %c %C %a %A %m
FillPosition    .position %X %Y %D
return \[lindex %a 0\]"
dnd bindtarget .typeList $type <Drag> \
        [dnd bindtarget .typeList $type <DragEnter>]
dnd bindtarget .typeList $type <Drop> \
        ".typeList configure -bg $bg; FillData .data %D %T %C"
dnd bindtarget .typeList $type <DragLeave> \
        ".typeList configure -bg $bg"

  return default
};# generic::HandleEnter

# ----------------------------------------------------------------------------
#  Command generic::HandlePosition
# ----------------------------------------------------------------------------
proc generic::HandlePosition { drop_target drag_source pressedkeys
                               rootX rootY } {
  variable _types
  variable _typelist
  variable _codelist
  variable _actionlist
  variable _pressedkeys
  variable _action
  variable _common_drag_source_types
................................................................................
  set _pressedkeys $pressedkeys

  ## Does the new drop target support any of our new types?
  # foreach {common_drag_source_types common_drop_target_types} \
  #         [GetWindowCommonTypes $drop_target $_typelist] {break}
  foreach {drop_target common_drag_source_types common_drop_target_types} \
          [FindWindowWithCommonTypes $drop_target $_typelist] {break}


  # debug "\t($_drop_target) -> ($drop_target)"
  if {$drop_target != $_drop_target} {
    if {[string length $_drop_target]} {
      ## Call the <<DropLeave>> event.
      # debug "\t<<DropLeave>> on $_drop_target"
      set cmd [bind $_drop_target <<DropLeave>>]
................................................................................
        set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
          %CST \{$_common_drag_source_types\} \
          %CTT \{$_common_drop_target_types\} \
          %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
          %ST  \{$_typelist\}    %TT \{$_types\} \
          %A   $_action          %a  \{$_actionlist\} \
          %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
          %D   \{\}              %e  <<DropEnter>> \
          %L   \{$_typelist\}    %%  % \
          %t   \{$_typelist\}    %T  \{[lindex $_common_drag_source_types 0]\} \
          %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
          ] $cmd]
        set _action [uplevel \#0 $cmd]
        switch -exact -- $_action {
          copy - move - link - ask - private - refuse_drop - default {}
................................................................................
      set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
        %CST \{$_common_drag_source_types\} \
        %CTT \{$_common_drop_target_types\} \
        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
        %ST  \{$_typelist\}    %TT \{$_types\} \
        %A   $_action          %a  \{$_actionlist\} \
        %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
        %D   \{\}              %e  <<DropPosition>> \
        %L   \{$_typelist\}    %%  % \
        %t   \{$_typelist\}    %T  \{[lindex $_common_drag_source_types 0]\} \
        %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
        ] $cmd]
      set _action [uplevel \#0 $cmd]
    }
  }

  return default
};# generic::HandleEnter

# ----------------------------------------------------------------------------
#  Command generic::HandlePosition
# ----------------------------------------------------------------------------
proc generic::HandlePosition { drop_target drag_source pressedkeys
                               rootX rootY { time 0 } } {
  variable _types
  variable _typelist
  variable _codelist
  variable _actionlist
  variable _pressedkeys
  variable _action
  variable _common_drag_source_types
................................................................................
  set _pressedkeys $pressedkeys

  ## Does the new drop target support any of our new types?
  # foreach {common_drag_source_types common_drop_target_types} \
  #         [GetWindowCommonTypes $drop_target $_typelist] {break}
  foreach {drop_target common_drag_source_types common_drop_target_types} \
          [FindWindowWithCommonTypes $drop_target $_typelist] {break}
  set data [GetDroppedData $time]

  # debug "\t($_drop_target) -> ($drop_target)"
  if {$drop_target != $_drop_target} {
    if {[string length $_drop_target]} {
      ## Call the <<DropLeave>> event.
      # debug "\t<<DropLeave>> on $_drop_target"
      set cmd [bind $_drop_target <<DropLeave>>]
................................................................................
        set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
          %CST \{$_common_drag_source_types\} \
          %CTT \{$_common_drop_target_types\} \
          %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
          %ST  \{$_typelist\}    %TT \{$_types\} \
          %A   $_action          %a  \{$_actionlist\} \
          %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
          %D   [list $data]      %e  <<DropEnter>> \
          %L   \{$_typelist\}    %%  % \
          %t   \{$_typelist\}    %T  \{[lindex $_common_drag_source_types 0]\} \
          %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
          ] $cmd]
        set _action [uplevel \#0 $cmd]
        switch -exact -- $_action {
          copy - move - link - ask - private - refuse_drop - default {}
................................................................................
      set cmd [string map [list %W $drop_target %X $rootX %Y $rootY \
        %CST \{$_common_drag_source_types\} \
        %CTT \{$_common_drop_target_types\} \
        %CPT \{[lindex [platform_independent_type [lindex $_common_drag_source_types 0]] 0]\} \
        %ST  \{$_typelist\}    %TT \{$_types\} \
        %A   $_action          %a  \{$_actionlist\} \
        %b   \{$_pressedkeys\} %m  \{$_pressedkeys\} \
        %D   [list $data]      %e  <<DropPosition>> \
        %L   \{$_typelist\}    %%  % \
        %t   \{$_typelist\}    %T  \{[lindex $_common_drag_source_types 0]\} \
        %c   \{$_codelist\}    %C  \{[lindex $_codelist 0]\} \
        ] $cmd]
      set _action [uplevel \#0 $cmd]
    }
  }

  };# initialise

};# namespace macdnd

# ----------------------------------------------------------------------------
#  Command macdnd::HandleEnter
# ----------------------------------------------------------------------------
proc macdnd::HandleEnter { path drag_source typelist } {
  variable _pressedkeys
  variable _actionlist
  set _pressedkeys 1
  set _actionlist  { copy move link ask private }

  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
           $_actionlist $_pressedkeys
};# macdnd::HandleEnter

# ----------------------------------------------------------------------------
#  Command macdnd::HandlePosition
# ----------------------------------------------------------------------------

  };# initialise

};# namespace macdnd

# ----------------------------------------------------------------------------
#  Command macdnd::HandleEnter
# ----------------------------------------------------------------------------
proc macdnd::HandleEnter { path drag_source typelist { data {} } } {
  variable _pressedkeys
  variable _actionlist
  set _pressedkeys 1
  set _actionlist  { copy move link ask private }
  ::tkdnd::generic::SetDroppedData $data
  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
           $_actionlist $_pressedkeys
};# macdnd::HandleEnter

# ----------------------------------------------------------------------------
#  Command macdnd::HandlePosition
# ----------------------------------------------------------------------------

  };# initialise

};# namespace xdnd

# ----------------------------------------------------------------------------
#  Command xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndEnter { path drag_source typelist } {
  variable _pressedkeys
  variable _actionlist

  set _pressedkeys 1
  set _actionlist  { copy move link ask private }



  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
           $_actionlist $_pressedkeys
};# xdnd::HandleXdndEnter

# ----------------------------------------------------------------------------
#  Command xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndPosition { drop_target rootX rootY {drag_source {}} } {
  variable _pressedkeys

  variable _last_mouse_root_x; set _last_mouse_root_x $rootX
  variable _last_mouse_root_y; set _last_mouse_root_y $rootY





  ::tkdnd::generic::HandlePosition $drop_target $drag_source \
                                   $_pressedkeys $rootX $rootY
};# xdnd::HandleXdndPosition

# ----------------------------------------------------------------------------
#  Command xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
................................................................................
#  Command xdnd::_HandleXdndDrop
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndDrop { time } {
  variable _pressedkeys
  variable _last_mouse_root_x
  variable _last_mouse_root_y
  ## Get the dropped data...
  ::tkdnd::generic::SetDroppedData [GetDroppedData $time]


  ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
                               $_last_mouse_root_x $_last_mouse_root_y $time
};# xdnd::HandleXdndDrop

# ----------------------------------------------------------------------------
#  Command xdnd::_GetDroppedData
# ----------------------------------------------------------------------------
proc xdnd::GetDroppedData { time } {


  set _drag_source              [::tkdnd::generic::GetDragSource]
  set _drop_target              [::tkdnd::generic::GetDropTarget]
  set _common_drag_source_types [::tkdnd::generic::GetDragSourceCommonTypes]






  if {![llength $_common_drag_source_types]} {
    error "no common data types between the drag source and drop target widgets"
  }
  ## Is drag source in this application?
  if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} {
    set _use_tk_selection 0
  } else {
................................................................................
      }
      ## Get rid of \r\n
      set string [string trim [string map {\r\n \n} $string]]
      set files {}
      foreach quoted_file [split $string] {
        set file [tkdnd::urn_unquote $quoted_file]
        switch -glob $file {

          file://*  {lappend files [string range $file 7 end]}
          ftp://*   -
          https://* -
          http://*  {lappend files $quoted_file}
          default   {lappend files $file}
        }
      }

  };# initialise

};# namespace xdnd

# ----------------------------------------------------------------------------
#  Command xdnd::HandleXdndEnter
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndEnter { path drag_source typelist time { data {} } } {
  variable _pressedkeys
  variable _actionlist
  variable _typelist
  set _pressedkeys 1
  set _actionlist  { copy move link ask private }
  set _typelist    $typelist
  # puts "xdnd::HandleXdndEnter: $time"
  ::tkdnd::generic::SetDroppedData $data
  ::tkdnd::generic::HandleEnter $path $drag_source $typelist $typelist \
           $_actionlist $_pressedkeys
};# xdnd::HandleXdndEnter

# ----------------------------------------------------------------------------
#  Command xdnd::HandleXdndPosition
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndPosition { drop_target rootX rootY time {drag_source {}} } {
  variable _pressedkeys
  variable _typelist
  variable _last_mouse_root_x; set _last_mouse_root_x $rootX
  variable _last_mouse_root_y; set _last_mouse_root_y $rootY
  # puts "xdnd::HandleXdndPosition: $time"
  ## Get the dropped data...
  catch {
    ::tkdnd::generic::SetDroppedData [GetPositionData $drop_target $_typelist $time]
  }
  ::tkdnd::generic::HandlePosition $drop_target $drag_source \
                                   $_pressedkeys $rootX $rootY
};# xdnd::HandleXdndPosition

# ----------------------------------------------------------------------------
#  Command xdnd::HandleXdndLeave
# ----------------------------------------------------------------------------
................................................................................
#  Command xdnd::_HandleXdndDrop
# ----------------------------------------------------------------------------
proc xdnd::HandleXdndDrop { time } {
  variable _pressedkeys
  variable _last_mouse_root_x
  variable _last_mouse_root_y
  ## Get the dropped data...
  ::tkdnd::generic::SetDroppedData [GetDroppedData \
    [::tkdnd::generic::GetDragSource] [::tkdnd::generic::GetDropTarget] \
    [::tkdnd::generic::GetDragSourceCommonTypes] $time]
  ::tkdnd::generic::HandleDrop {} {} $_pressedkeys \
                               $_last_mouse_root_x $_last_mouse_root_y $time
};# xdnd::HandleXdndDrop

# ----------------------------------------------------------------------------
#  Command xdnd::GetPositionData
# ----------------------------------------------------------------------------
proc xdnd::GetPositionData { drop_target typelist time } {
  foreach {drop_target common_drag_source_types common_drop_target_types} \
    [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
  GetDroppedData [::tkdnd::generic::GetDragSource] $drop_target \

    $common_drag_source_types $time
};# xdnd::GetPositionData

# ----------------------------------------------------------------------------
#  Command xdnd::GetDroppedData
# ----------------------------------------------------------------------------
proc xdnd::GetDroppedData { _drag_source _drop_target _common_drag_source_types time } {
  if {![llength $_common_drag_source_types]} {
    error "no common data types between the drag source and drop target widgets"
  }
  ## Is drag source in this application?
  if {[catch {winfo pathname -displayof $_drop_target $_drag_source} p]} {
    set _use_tk_selection 0
  } else {
................................................................................
      }
      ## Get rid of \r\n
      set string [string trim [string map {\r\n \n} $string]]
      set files {}
      foreach quoted_file [split $string] {
        set file [tkdnd::urn_unquote $quoted_file]
        switch -glob $file {
          \#*       {}
          file://*  {lappend files [string range $file 7 end]}
          ftp://*   -
          https://* -
          http://*  {lappend files $quoted_file}
          default   {lappend files $file}
        }
      }

};# namespace olednd

# ----------------------------------------------------------------------------
#  Command olednd::HandleDragEnter
# ----------------------------------------------------------------------------
proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys
                               rootX rootY codelist } {

  focus $drop_target
  ::tkdnd::generic::HandleEnter $drop_target 0 $typelist \
                                $codelist $actionlist $pressedkeys
  set action [::tkdnd::generic::HandlePosition $drop_target {} \
                                               $pressedkeys $rootX $rootY]
  if {$::tkdnd::_auto_update} {update idletasks}
  return $action
................................................................................
proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } {
  ::tkdnd::generic::SetDroppedData [normalise_data $type $data]
  set action [::tkdnd::generic::HandleDrop $drop_target {} \
                                           $pressedkeys $rootX $rootY 0]
  if {$::tkdnd::_auto_update} {update idletasks}
  return $action
};# olednd::HandleDrop










# ----------------------------------------------------------------------------
#  Command olednd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc olednd::GetDragSourceCommonTypes { drop_target } {
  ::tkdnd::generic::GetDragSourceCommonTypes
};# olednd::GetDragSourceCommonTypes

};# namespace olednd

# ----------------------------------------------------------------------------
#  Command olednd::HandleDragEnter
# ----------------------------------------------------------------------------
proc olednd::HandleDragEnter { drop_target typelist actionlist pressedkeys
                               rootX rootY codelist { data {} } } {
  ::tkdnd::generic::SetDroppedData $data
  focus $drop_target
  ::tkdnd::generic::HandleEnter $drop_target 0 $typelist \
                                $codelist $actionlist $pressedkeys
  set action [::tkdnd::generic::HandlePosition $drop_target {} \
                                               $pressedkeys $rootX $rootY]
  if {$::tkdnd::_auto_update} {update idletasks}
  return $action
................................................................................
proc olednd::HandleDrop { drop_target pressedkeys rootX rootY type data } {
  ::tkdnd::generic::SetDroppedData [normalise_data $type $data]
  set action [::tkdnd::generic::HandleDrop $drop_target {} \
                                           $pressedkeys $rootX $rootY 0]
  if {$::tkdnd::_auto_update} {update idletasks}
  return $action
};# olednd::HandleDrop

# ----------------------------------------------------------------------------
#  Command olednd::GetDataType
# ----------------------------------------------------------------------------
proc olednd::GetDataType { drop_target typelist } {
  foreach {drop_target common_drag_source_types common_drop_target_types} \
    [::tkdnd::generic::FindWindowWithCommonTypes $drop_target $typelist] {break}
  lindex $common_drag_source_types 0
};# olednd::GetDataType

# ----------------------------------------------------------------------------
#  Command olednd::GetDragSourceCommonTypes
# ----------------------------------------------------------------------------
proc olednd::GetDragSourceCommonTypes { drop_target } {
  ::tkdnd::generic::GetDragSourceCommonTypes
};# olednd::GetDragSourceCommonTypes

/*
 * TkDND_XDND.h -- Tk XDND Drag'n'Drop Protocol Implementation
 * 
 *    This file implements the unix portion of the drag&drop mechanism
 *    for the tk toolkit. The protocol in use under unix is the
 *    XDND protocol.
 *
 * This software is copyrighted by:
 * Georgios Petasis, Athens, Greece.
 * e-mail: petasisg@yahoo.gr, petasis@iit.demokritos.gr
................................................................................
 * that existing copyright notices are retained in all copies and that this
 * notice is included verbatim in any distributions. No written agreement,
 * license, or royalty fee is required for any of the authorized uses.
 * Modifications to this software may be copyrighted by their authors
 * and need not follow the licensing terms described here, provided that
 * the new terms are clearly indicated on the first page of each file where
 * they apply.
 * 
 * IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
 * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
 * ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
 * DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 * 
 * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
 * IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
 * NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
 * MODIFICATIONS.
 */
................................................................................
  if (children_return) XFree(children_return);
  return toplevel;
}; /* TkDND_GetToplevelFromWrapper */

Window TkDND_GetVirtualRootWindowOfScreen(Tk_Window tkwin) {
  static Screen *screen, *save_screen = (Screen *)0;
  static Window root = (Window)0;
  
  screen = Tk_Screen(tkwin);
  if (screen != save_screen) {
    Display *dpy = DisplayOfScreen(screen);
    int i;
    Window rootReturn, parentReturn, *children;
    unsigned int numChildren;
    Atom __SWM_VROOT = Tk_InternAtom(tkwin, "__SWM_VROOT"),
         __SWM_ROOT  = Tk_InternAtom(tkwin, "__SWM_ROOT"),
         __WM_ROOT   = Tk_InternAtom(tkwin, "__WM_ROOT");
    
    root = RootWindowOfScreen(screen);
    
    /* go look for a virtual root */
    if (XQueryTree(dpy, root, &rootReturn, &parentReturn,
                   &children, &numChildren)) {
      for (i = 0; i < numChildren; i++) {
        Atom actual_type;
        int actual_format;
        unsigned long nitems, bytesafter;
        Window *newRoot = (Window *)0;
    
        if (
             (XGetWindowProperty(dpy, children[i],
                __WM_ROOT, 0, (long) 1, False, XA_WINDOW,
                &actual_type, &actual_format, &nitems, &bytesafter,
                (unsigned char **) &newRoot) == Success
                && newRoot && (actual_type == XA_WINDOW)) ||
             (XGetWindowProperty(dpy, children[i],
................................................................................
int TkDND_HandleXdndEnter(Tk_Window tkwin, XEvent *xevent) {
  Tcl_Interp *interp = Tk_Interp(tkwin);
  Tk_Window toplevel;
  Atom *typelist = NULL;
  int i, version = (int) XDND_ENTER_VERSION(xevent);
  Window drag_source;
  // Window drop_toplevel, drop_window;
  Tcl_Obj* objv[4], *element;


  if (interp == NULL) return False;
  if (version > XDND_VERSION) return False;
#if XDND_VERSION >= 3
  if (version < 3) return False;
#endif

................................................................................
  objv[1] = Tcl_NewStringObj(Tk_PathName(toplevel), -1);
  objv[2] = Tcl_NewLongObj(drag_source);
  objv[3] = Tcl_NewListObj(0, NULL);
  for (i=0; typelist[i] != None; ++i) {
    element = Tcl_NewStringObj(Tk_GetAtomName(tkwin, typelist[i]), -1);
    Tcl_ListObjAppendElement(NULL, objv[3], element);
  }

  TkDND_Eval(4);
  Tcl_Free((char *) typelist);
  return True;
} /* TkDND_HandleXdndEnter */

int TkDND_HandleXdndPosition(Tk_Window tkwin, XEvent *xevent) {
  Tcl_Interp *interp = Tk_Interp(tkwin);
  Tk_Window mouse_tkwin = NULL, toplevel;
  Window drag_source, virtual_root, src_w, dest_w, child;
  Tcl_Obj* result;
  Tcl_Obj* objv[5];
  int rootX, rootY, dx = 0, dy = 0, src_x, src_y, dest_x, dest_y, i, index, status, w, h;
  XEvent response;
  Display *display;
  int width = 1, height = 1;
  static char *DropActions[] = {
    "copy", "move", "link", "ask",  "private", "refuse_drop", "default",
    (char *) NULL
  };
  enum dropactions {
    ActionCopy, ActionMove, ActionLink, ActionAsk, ActionPrivate,
    refuse_drop, ActionDefault
  };

/*Time time;
  Atom action;*/

  if (interp == NULL || tkwin == NULL) return False;






  drag_source = XDND_POSITION_SOURCE_WIN(xevent);
  /* Get the coordinates from the event... */
  rootX  = XDND_POSITION_ROOT_X(xevent);
  rootY  = XDND_POSITION_ROOT_Y(xevent);
  /* Get the time from the event... */
  /* time   = XDND_POSITION_TIME(xevent); */
................................................................................
  /* Ask the Tk widget whether it will accept the drop... */
  index = refuse_drop;
  if (mouse_tkwin != NULL) {
    objv[0] = Tcl_NewStringObj("tkdnd::xdnd::HandleXdndPosition", -1);
    objv[1] = Tcl_NewStringObj(Tk_PathName(mouse_tkwin), -1);
    objv[2] = Tcl_NewIntObj(rootX);
    objv[3] = Tcl_NewIntObj(rootY);

    objv[4] = Tcl_NewLongObj(drag_source);
    TkDND_Status_Eval(5);
    if (status == TCL_OK) {
      /* Get the returned action... */
      result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
      status = Tcl_GetIndexFromObj(interp, result, (const char **) DropActions,
                              "dropactions", 0, &index);
      Tcl_DecrRefCount(result);
      if (status != TCL_OK) index = refuse_drop;
................................................................................
      break;
    case ActionLink:
      XDND_STATUS_ACTION(&response) = Tk_InternAtom(tkwin, "XdndActionLink");
      break;
    case ActionAsk:
      XDND_STATUS_ACTION(&response) = Tk_InternAtom(tkwin, "XdndActionAsk");
      break;
    case ActionPrivate: 
      XDND_STATUS_ACTION(&response) = Tk_InternAtom(tkwin, "XdndActionPrivate");
      break;
    case refuse_drop: {
      XDND_STATUS_WILL_ACCEPT_SET(&response, 0); /* Refuse drop. */
    }
  }
  XSendEvent(response.xany.display, response.xclient.window,
................................................................................
  return True;
} /* TkDND_HandleXdndPosition */

int TkDND_HandleXdndLeave(Tk_Window tkwin, XEvent *xevent) {
  Tcl_Interp *interp = Tk_Interp(tkwin);
  Tcl_Obj* objv[1];
  int i;
  if (interp == NULL) return False; 
  objv[0] = Tcl_NewStringObj("tkdnd::xdnd::HandleXdndLeave", -1);
  TkDND_Eval(1);
  return True;
} /* TkDND_HandleXdndLeave */

int TkDND_HandleXdndDrop(Tk_Window tkwin, XEvent *xevent) {
  XEvent finished;
................................................................................
    "copy", "move", "link", "ask",  "private", "refuse_drop", "default",
    (char *) NULL
  };
  enum dropactions {
    ActionCopy, ActionMove, ActionLink, ActionAsk, ActionPrivate,
    refuse_drop, ActionDefault
  };
    
  if (interp == NULL) return False;
  if (XDND_DROP_TIME(xevent) != 0) {
    time = ((sizeof(Time) == 8 && XDND_DROP_TIME(xevent) < 0)
             ? (unsigned int) (XDND_DROP_TIME(xevent))
             :  XDND_DROP_TIME(xevent));
  }

................................................................................
            Tk_InternAtom(tkwin, "XdndActionMove");    break;
      case ActionLink:
        XDND_FINISHED_ACTION(&finished) =
            Tk_InternAtom(tkwin, "XdndActionLink");    break;
      case ActionAsk:
        XDND_FINISHED_ACTION(&finished) =
            Tk_InternAtom(tkwin, "XdndActionAsk");     break;
      case ActionPrivate: 
        XDND_FINISHED_ACTION(&finished) =
            Tk_InternAtom(tkwin, "XdndActionPrivate"); break;
      case refuse_drop: {
        XDND_FINISHED_ACCEPTED_NO(&finished); /* Drop canceled. */
        XDND_FINISHED_ACTION(&finished) = None;
      }
    }
................................................................................
} /* TkDND_HandleXdndDrop */

int TkDND_HandleXdndStatus(Tk_Window tkwin, XEvent *xevent) {
  Tcl_Interp *interp = Tk_Interp(tkwin);
  Tcl_Obj *objv[2], *key, *value;
  int i;
  Atom action;
  if (interp == NULL) return False; 
  objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_HandleXdndStatus", -1);
  objv[1] = Tcl_NewDictObj();
  /* data.l[0] contains the XID of the target window */
  TkDND_Dict_PutLong(objv[1], "target", xevent->xclient.data.l[0]);
  /* data.l[1] bit 0 is set if the current target will accept the drop */
  TkDND_Dict_PutInt(objv[1], "accept", XDND_STATUS_WILL_ACCEPT(xevent) ? 1:0);
  /* data.l[1] bit 1 is set if the target wants XdndPosition messages while
................................................................................
  } else {
    TkDND_Dict_Put(objv[1], "action", "refuse_drop");
  }
  TkDND_Dict_PutInt(objv[1], "x", XDND_STATUS_RECT_X(xevent));
  TkDND_Dict_PutInt(objv[1], "y", XDND_STATUS_RECT_Y(xevent));
  TkDND_Dict_PutInt(objv[1], "w", XDND_STATUS_RECT_WIDTH(xevent));
  TkDND_Dict_PutInt(objv[1], "h", XDND_STATUS_RECT_HEIGHT(xevent));
  
  TkDND_Eval(2);
  return True;
} /* TkDND_HandleXdndStatus */

int TkDND_HandleXdndFinished(Tk_Window tkwin, XEvent *xevent) {
   Tcl_Interp *interp = Tk_Interp(tkwin);
  Tcl_Obj *objv[2], *key, *value;
  int i;
  Atom action;
  if (interp == NULL) return False; 
  objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_HandleXdndFinished", -1);
  objv[1] = Tcl_NewDictObj();
  /* data.l[0] contains the XID of the target window */
  TkDND_Dict_PutLong(objv[1], "target", xevent->xclient.data.l[0]);
  /* data.l[1] bit 0 is set if the current target accepted the drop and
   *  successfully performed the accepted drop action */
  TkDND_Dict_PutInt(objv[1], "accept", (XDND_FINISHED_ACCEPTED(xevent))?1:0);
................................................................................
#endif /* DEBUG_CLIENTMESSAGE_HANDLER */
    return TkDND_HandleXdndLeave(tkwin, xevent);
  } else if (xevent->xclient.message_type == Tk_InternAtom(tkwin, "XdndDrop")) {
#ifdef DEBUG_CLIENTMESSAGE_HANDLER
    printf("XDND_HandleClientMessage: Received XdndDrop (%s)\n", Tk_PathName(tkwin));
#endif /* DEBUG_CLIENTMESSAGE_HANDLER */
    return TkDND_HandleXdndDrop(tkwin, xevent);
  } else if (xevent->xclient.message_type == 
                                         Tk_InternAtom(tkwin, "XdndFinished")) {
#ifdef DEBUG_CLIENTMESSAGE_HANDLER
    printf("XDND_HandleClientMessage: Received XdndFinished (%s)\n", Tk_PathName(tkwin));
#endif /* DEBUG_CLIENTMESSAGE_HANDLER */
    return TkDND_HandleXdndFinished(tkwin, xevent);
  } else {
#ifdef TKDND_ENABLE_MOTIF_DROPS
................................................................................
        break;
    }
    if (count < 2) {
        Tcl_AppendResult(interp, "value for \"", string,
                                 "\" missing", NULL);
        return TCL_ERROR;
    }
    
    if (Tcl_GetIndexFromObj(interp, objs[0], (const char **) getOptionStrings,
            "option", 0, &getIndex) != TCL_OK) {
        return TCL_ERROR;
    }
    
    switch ((enum getOptions) getIndex) {
    case GET_DISPLAYOF:
        path = Tcl_GetString(objs[1]);
        break;
    case GET_SELECTION:
        selName = Tcl_GetString(objs[1]);
        break;
................................................................................
  switch (eventPtr->type) {
    case MotionNotify:
      TkDND_Dict_Put(dict,     "type",   "MotionNotify");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xmotion.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xmotion.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xmotion.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xmotion.y_root);
      TkDND_Dict_PutWideInt(dict, "time",    eventPtr->xmotion.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xmotion.state);
      break;
    case ButtonPress:
      TkDND_Dict_Put(dict,     "type",   "ButtonPress");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xbutton.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xbutton.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xbutton.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xbutton.y_root);
      TkDND_Dict_PutWideInt(dict, "time",    eventPtr->xbutton.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xbutton.state);
      TkDND_Dict_PutInt(dict,  "button",  eventPtr->xbutton.button);
      break;
    case ButtonRelease:
      TkDND_Dict_Put(dict,     "type",   "ButtonRelease");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xbutton.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xbutton.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xbutton.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xbutton.y_root);
      TkDND_Dict_PutWideInt(dict, "time",    eventPtr->xbutton.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xbutton.state);
      TkDND_Dict_PutInt(dict,  "button",  eventPtr->xbutton.button);
      break;
    case KeyPress:
      TkDND_Dict_Put(dict,     "type",   "KeyPress");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xkey.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xkey.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xkey.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xkey.y_root);
      TkDND_Dict_PutWideInt(dict, "time",    eventPtr->xkey.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xkey.state);
      TkDND_Dict_PutInt(dict,  "keycode", eventPtr->xkey.keycode);
      main_window = Tk_MainWindow(interp);
#ifdef TKDND_USE_XKEYCODETOKEYSYM
      keysym = XKeycodeToKeysym(Tk_Display(main_window),
                                eventPtr->xkey.keycode, 0);
      TkDND_Dict_Put(dict,     "keysym",   XKeysymToString(keysym));
................................................................................
      break;
    case KeyRelease:
      TkDND_Dict_Put(dict,     "type",   "KeyRelease");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xkey.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xkey.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xkey.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xkey.y_root);
      TkDND_Dict_PutWideInt(dict, "time",    eventPtr->xkey.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xkey.state);
      TkDND_Dict_PutInt(dict,  "keycode", eventPtr->xkey.keycode);
      main_window = Tk_MainWindow(interp);
#ifdef TKDND_USE_XKEYCODETOKEYSYM
      keysym = XKeycodeToKeysym(Tk_Display(main_window),
                                eventPtr->xkey.keycode, 0);
      TkDND_Dict_Put(dict,     "keysym",   XKeysymToString(keysym));
................................................................................
      TkDND_Dict_Put(dict,     "keysym",   XKeysymToString(keysym[0]));
      XFree(keysym);
#endif /* TKDND_USE_XKEYCODETOKEYSYM */
      break;
    case EnterNotify:
      return 0;
      TkDND_Dict_Put(dict, "type", "EnterNotify");
      TkDND_Dict_PutWideInt(dict, "time",    eventPtr->xcrossing.time);
      break;
    case LeaveNotify:
      return 0;
      TkDND_Dict_Put(dict, "type", "LeaveNotify");
      TkDND_Dict_PutWideInt(dict, "time",    eventPtr->xcrossing.time);
      break;
    case SelectionRequest:
      main_window = Tk_MainWindow(interp);
      TkDND_Dict_Put(dict, "type", "SelectionRequest");
      TkDND_Dict_PutWideInt(dict, "time",     eventPtr->xselectionrequest.time);
      TkDND_Dict_PutLong(dict, "owner",    eventPtr->xselectionrequest.owner);
      TkDND_Dict_PutLong(dict, "requestor",
                                eventPtr->xselectionrequest.requestor);
      TkDND_Dict_Put(dict,     "selection",
            Tk_GetAtomName(main_window, eventPtr->xselectionrequest.selection));
      TkDND_Dict_Put(dict,     "target",
            Tk_GetAtomName(main_window, eventPtr->xselectionrequest.target));
................................................................................
  unsigned char *retval;
  Tcl_Obj **type;

  if (objc != 5) {
    Tcl_WrongNumArgs(interp, 1, objv, "source target proxy types_len");
    return TCL_ERROR;
  }
  
  source = TkDND_TkWin(objv[1]);
  if (!source) return TCL_ERROR;
  if (Tcl_GetLongFromObj(interp, objv[2], (long *) &target) != TCL_OK) {
    return TCL_ERROR;
  }
  if (Tcl_GetLongFromObj(interp, objv[3], (long *) &proxy) != TCL_OK) {
    return TCL_ERROR;
................................................................................
                  TCL_STATIC);
    return TCL_ERROR;
  }
  tv = (int *)retval;
  if (tv) {
    if (*tv < target_version) target_version = *tv;
    XFree(tv);
  } 

  memset (&event, 0, sizeof(XEvent));
  event.type                    = ClientMessage;
  event.xclient.window          = target;
  event.xclient.format          = 32;
  event.xclient.message_type    = Tk_InternAtom(source, "XdndEnter");
  XDND_ENTER_SOURCE_WIN(&event) = Tk_WindowId(source);
................................................................................
  Display *display;
  int rootx, rooty, status, index;

  if (objc != 7) {
    Tcl_WrongNumArgs(interp, 1, objv, "source target proxy rootx rooty action");
    return TCL_ERROR;
  }
  
  source = TkDND_TkWin(objv[1]);
  if (!source) return TCL_ERROR;
  if (Tcl_GetLongFromObj(interp, objv[2], (long *) &target) != TCL_OK) {
    return TCL_ERROR;
  }
  if (Tcl_GetLongFromObj(interp, objv[3], (long *) &proxy) != TCL_OK) {
    return TCL_ERROR;
................................................................................
          Tk_InternAtom(source, "XdndActionMove");    break;
    case ActionLink:
      XDND_POSITION_ACTION(&event) =
          Tk_InternAtom(source, "XdndActionLink");    break;
    case ActionAsk:
      XDND_POSITION_ACTION(&event) =
          Tk_InternAtom(source, "XdndActionAsk");     break;
    case ActionPrivate: 
      XDND_POSITION_ACTION(&event) =
          Tk_InternAtom(source, "XdndActionPrivate"); break;
  }

  XSendEvent(display, proxy, False, NoEventMask, &event);

  return TCL_OK;
................................................................................
#endif

int DLLEXPORT Tkdnd_Init(Tcl_Interp *interp) {
  int major, minor, patchlevel;
  Tcl_CmdInfo info;

  if (
#ifdef USE_TCL_STUBS 
      Tcl_InitStubs(interp, "8.3", 0)
#else
      Tcl_PkgRequire(interp, "Tcl", "8.3", 0)
#endif /* USE_TCL_STUBS */
            == NULL) {
            return TCL_ERROR;
  }
................................................................................
  }

  if (Tcl_CreateObjCommand(interp, "_unregister_generic_event_handler",
           (Tcl_ObjCmdProc*) TkDND_UnregisterGenericEventHandlerObjCmd,
           (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) {
    return TCL_ERROR;
  }
  
  if (Tcl_CreateObjCommand(interp, "_announce_type_list",
           (Tcl_ObjCmdProc*) TkDND_AnnounceTypeListObjCmd,
           (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) {
    return TCL_ERROR;
  }

  if (Tcl_CreateObjCommand(interp, "_announce_action_list",

/*
 * TkDND_XDND.h -- Tk XDND Drag'n'Drop Protocol Implementation
 *
 *    This file implements the unix portion of the drag&drop mechanism
 *    for the tk toolkit. The protocol in use under unix is the
 *    XDND protocol.
 *
 * This software is copyrighted by:
 * Georgios Petasis, Athens, Greece.
 * e-mail: petasisg@yahoo.gr, petasis@iit.demokritos.gr
................................................................................
 * that existing copyright notices are retained in all copies and that this
 * notice is included verbatim in any distributions. No written agreement,
 * license, or royalty fee is required for any of the authorized uses.
 * Modifications to this software may be copyrighted by their authors
 * and need not follow the licensing terms described here, provided that
 * the new terms are clearly indicated on the first page of each file where
 * they apply.
 *
 * IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
 * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
 * ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
 * DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 *
 * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
 * IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
 * NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
 * MODIFICATIONS.
 */
................................................................................
  if (children_return) XFree(children_return);
  return toplevel;
}; /* TkDND_GetToplevelFromWrapper */

Window TkDND_GetVirtualRootWindowOfScreen(Tk_Window tkwin) {
  static Screen *screen, *save_screen = (Screen *)0;
  static Window root = (Window)0;

  screen = Tk_Screen(tkwin);
  if (screen != save_screen) {
    Display *dpy = DisplayOfScreen(screen);
    int i;
    Window rootReturn, parentReturn, *children;
    unsigned int numChildren;
    Atom __SWM_VROOT = Tk_InternAtom(tkwin, "__SWM_VROOT"),
         __SWM_ROOT  = Tk_InternAtom(tkwin, "__SWM_ROOT"),
         __WM_ROOT   = Tk_InternAtom(tkwin, "__WM_ROOT");

    root = RootWindowOfScreen(screen);

    /* go look for a virtual root */
    if (XQueryTree(dpy, root, &rootReturn, &parentReturn,
                   &children, &numChildren)) {
      for (i = 0; i < numChildren; i++) {
        Atom actual_type;
        int actual_format;
        unsigned long nitems, bytesafter;
        Window *newRoot = (Window *)0;

        if (
             (XGetWindowProperty(dpy, children[i],
                __WM_ROOT, 0, (long) 1, False, XA_WINDOW,
                &actual_type, &actual_format, &nitems, &bytesafter,
                (unsigned char **) &newRoot) == Success
                && newRoot && (actual_type == XA_WINDOW)) ||
             (XGetWindowProperty(dpy, children[i],
................................................................................
int TkDND_HandleXdndEnter(Tk_Window tkwin, XEvent *xevent) {
  Tcl_Interp *interp = Tk_Interp(tkwin);
  Tk_Window toplevel;
  Atom *typelist = NULL;
  int i, version = (int) XDND_ENTER_VERSION(xevent);
  Window drag_source;
  // Window drop_toplevel, drop_window;
  Tcl_Obj* objv[5], *element;
  Time time = CurrentTime;

  if (interp == NULL) return False;
  if (version > XDND_VERSION) return False;
#if XDND_VERSION >= 3
  if (version < 3) return False;
#endif

................................................................................
  objv[1] = Tcl_NewStringObj(Tk_PathName(toplevel), -1);
  objv[2] = Tcl_NewLongObj(drag_source);
  objv[3] = Tcl_NewListObj(0, NULL);
  for (i=0; typelist[i] != None; ++i) {
    element = Tcl_NewStringObj(Tk_GetAtomName(tkwin, typelist[i]), -1);
    Tcl_ListObjAppendElement(NULL, objv[3], element);
  }
  objv[4] = Tcl_NewLongObj(time);
  TkDND_Eval(5);
  Tcl_Free((char *) typelist);
  return True;
} /* TkDND_HandleXdndEnter */

int TkDND_HandleXdndPosition(Tk_Window tkwin, XEvent *xevent) {
  Tcl_Interp *interp = Tk_Interp(tkwin);
  Tk_Window mouse_tkwin = NULL, toplevel;
  Window drag_source, virtual_root, src_w, dest_w, child;
  Tcl_Obj* result;
  Tcl_Obj* objv[6];
  int rootX, rootY, dx = 0, dy = 0, src_x, src_y, dest_x, dest_y, i, index, status, w, h;
  XEvent response;
  Display *display;
  int width = 1, height = 1;
  static char *DropActions[] = {
    "copy", "move", "link", "ask",  "private", "refuse_drop", "default",
    (char *) NULL
  };
  enum dropactions {
    ActionCopy, ActionMove, ActionLink, ActionAsk, ActionPrivate,
    refuse_drop, ActionDefault
  };
  Time time = CurrentTime;
/*Time time;
  Atom action;*/

  if (interp == NULL || tkwin == NULL) return False;
  if (XDND_POSITION_TIME(xevent) != 0) {
    time = ((sizeof(Time) == 8 && XDND_POSITION_TIME(xevent) < 0)
             ? (unsigned int) (XDND_POSITION_TIME(xevent))
             :  XDND_POSITION_TIME(xevent));
  }

  drag_source = XDND_POSITION_SOURCE_WIN(xevent);
  /* Get the coordinates from the event... */
  rootX  = XDND_POSITION_ROOT_X(xevent);
  rootY  = XDND_POSITION_ROOT_Y(xevent);
  /* Get the time from the event... */
  /* time   = XDND_POSITION_TIME(xevent); */
................................................................................
  /* Ask the Tk widget whether it will accept the drop... */
  index = refuse_drop;
  if (mouse_tkwin != NULL) {
    objv[0] = Tcl_NewStringObj("tkdnd::xdnd::HandleXdndPosition", -1);
    objv[1] = Tcl_NewStringObj(Tk_PathName(mouse_tkwin), -1);
    objv[2] = Tcl_NewIntObj(rootX);
    objv[3] = Tcl_NewIntObj(rootY);
    objv[4] = Tcl_NewLongObj(time);
    objv[5] = Tcl_NewLongObj(drag_source);
    TkDND_Status_Eval(6);
    if (status == TCL_OK) {
      /* Get the returned action... */
      result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
      status = Tcl_GetIndexFromObj(interp, result, (const char **) DropActions,
                              "dropactions", 0, &index);
      Tcl_DecrRefCount(result);
      if (status != TCL_OK) index = refuse_drop;
................................................................................
      break;
    case ActionLink:
      XDND_STATUS_ACTION(&response) = Tk_InternAtom(tkwin, "XdndActionLink");
      break;
    case ActionAsk:
      XDND_STATUS_ACTION(&response) = Tk_InternAtom(tkwin, "XdndActionAsk");
      break;
    case ActionPrivate:
      XDND_STATUS_ACTION(&response) = Tk_InternAtom(tkwin, "XdndActionPrivate");
      break;
    case refuse_drop: {
      XDND_STATUS_WILL_ACCEPT_SET(&response, 0); /* Refuse drop. */
    }
  }
  XSendEvent(response.xany.display, response.xclient.window,
................................................................................
  return True;
} /* TkDND_HandleXdndPosition */

int TkDND_HandleXdndLeave(Tk_Window tkwin, XEvent *xevent) {
  Tcl_Interp *interp = Tk_Interp(tkwin);
  Tcl_Obj* objv[1];
  int i;
  if (interp == NULL) return False;
  objv[0] = Tcl_NewStringObj("tkdnd::xdnd::HandleXdndLeave", -1);
  TkDND_Eval(1);
  return True;
} /* TkDND_HandleXdndLeave */

int TkDND_HandleXdndDrop(Tk_Window tkwin, XEvent *xevent) {
  XEvent finished;
................................................................................
    "copy", "move", "link", "ask",  "private", "refuse_drop", "default",
    (char *) NULL
  };
  enum dropactions {
    ActionCopy, ActionMove, ActionLink, ActionAsk, ActionPrivate,
    refuse_drop, ActionDefault
  };

  if (interp == NULL) return False;
  if (XDND_DROP_TIME(xevent) != 0) {
    time = ((sizeof(Time) == 8 && XDND_DROP_TIME(xevent) < 0)
             ? (unsigned int) (XDND_DROP_TIME(xevent))
             :  XDND_DROP_TIME(xevent));
  }

................................................................................
            Tk_InternAtom(tkwin, "XdndActionMove");    break;
      case ActionLink:
        XDND_FINISHED_ACTION(&finished) =
            Tk_InternAtom(tkwin, "XdndActionLink");    break;
      case ActionAsk:
        XDND_FINISHED_ACTION(&finished) =
            Tk_InternAtom(tkwin, "XdndActionAsk");     break;
      case ActionPrivate:
        XDND_FINISHED_ACTION(&finished) =
            Tk_InternAtom(tkwin, "XdndActionPrivate"); break;
      case refuse_drop: {
        XDND_FINISHED_ACCEPTED_NO(&finished); /* Drop canceled. */
        XDND_FINISHED_ACTION(&finished) = None;
      }
    }
................................................................................
} /* TkDND_HandleXdndDrop */

int TkDND_HandleXdndStatus(Tk_Window tkwin, XEvent *xevent) {
  Tcl_Interp *interp = Tk_Interp(tkwin);
  Tcl_Obj *objv[2], *key, *value;
  int i;
  Atom action;
  if (interp == NULL) return False;
  objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_HandleXdndStatus", -1);
  objv[1] = Tcl_NewDictObj();
  /* data.l[0] contains the XID of the target window */
  TkDND_Dict_PutLong(objv[1], "target", xevent->xclient.data.l[0]);
  /* data.l[1] bit 0 is set if the current target will accept the drop */
  TkDND_Dict_PutInt(objv[1], "accept", XDND_STATUS_WILL_ACCEPT(xevent) ? 1:0);
  /* data.l[1] bit 1 is set if the target wants XdndPosition messages while
................................................................................
  } else {
    TkDND_Dict_Put(objv[1], "action", "refuse_drop");
  }
  TkDND_Dict_PutInt(objv[1], "x", XDND_STATUS_RECT_X(xevent));
  TkDND_Dict_PutInt(objv[1], "y", XDND_STATUS_RECT_Y(xevent));
  TkDND_Dict_PutInt(objv[1], "w", XDND_STATUS_RECT_WIDTH(xevent));
  TkDND_Dict_PutInt(objv[1], "h", XDND_STATUS_RECT_HEIGHT(xevent));

  TkDND_Eval(2);
  return True;
} /* TkDND_HandleXdndStatus */

int TkDND_HandleXdndFinished(Tk_Window tkwin, XEvent *xevent) {
   Tcl_Interp *interp = Tk_Interp(tkwin);
  Tcl_Obj *objv[2], *key, *value;
  int i;
  Atom action;
  if (interp == NULL) return False;
  objv[0] = Tcl_NewStringObj("tkdnd::xdnd::_HandleXdndFinished", -1);
  objv[1] = Tcl_NewDictObj();
  /* data.l[0] contains the XID of the target window */
  TkDND_Dict_PutLong(objv[1], "target", xevent->xclient.data.l[0]);
  /* data.l[1] bit 0 is set if the current target accepted the drop and
   *  successfully performed the accepted drop action */
  TkDND_Dict_PutInt(objv[1], "accept", (XDND_FINISHED_ACCEPTED(xevent))?1:0);
................................................................................
#endif /* DEBUG_CLIENTMESSAGE_HANDLER */
    return TkDND_HandleXdndLeave(tkwin, xevent);
  } else if (xevent->xclient.message_type == Tk_InternAtom(tkwin, "XdndDrop")) {
#ifdef DEBUG_CLIENTMESSAGE_HANDLER
    printf("XDND_HandleClientMessage: Received XdndDrop (%s)\n", Tk_PathName(tkwin));
#endif /* DEBUG_CLIENTMESSAGE_HANDLER */
    return TkDND_HandleXdndDrop(tkwin, xevent);
  } else if (xevent->xclient.message_type ==
                                         Tk_InternAtom(tkwin, "XdndFinished")) {
#ifdef DEBUG_CLIENTMESSAGE_HANDLER
    printf("XDND_HandleClientMessage: Received XdndFinished (%s)\n", Tk_PathName(tkwin));
#endif /* DEBUG_CLIENTMESSAGE_HANDLER */
    return TkDND_HandleXdndFinished(tkwin, xevent);
  } else {
#ifdef TKDND_ENABLE_MOTIF_DROPS
................................................................................
        break;
    }
    if (count < 2) {
        Tcl_AppendResult(interp, "value for \"", string,
                                 "\" missing", NULL);
        return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objs[0], (const char **) getOptionStrings,
            "option", 0, &getIndex) != TCL_OK) {
        return TCL_ERROR;
    }

    switch ((enum getOptions) getIndex) {
    case GET_DISPLAYOF:
        path = Tcl_GetString(objs[1]);
        break;
    case GET_SELECTION:
        selName = Tcl_GetString(objs[1]);
        break;
................................................................................
  switch (eventPtr->type) {
    case MotionNotify:
      TkDND_Dict_Put(dict,     "type",   "MotionNotify");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xmotion.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xmotion.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xmotion.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xmotion.y_root);
      TkDND_Dict_PutWideInt(dict, "time", eventPtr->xmotion.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xmotion.state);
      break;
    case ButtonPress:
      TkDND_Dict_Put(dict,     "type",   "ButtonPress");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xbutton.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xbutton.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xbutton.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xbutton.y_root);
      TkDND_Dict_PutWideInt(dict, "time", eventPtr->xbutton.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xbutton.state);
      TkDND_Dict_PutInt(dict,  "button",  eventPtr->xbutton.button);
      break;
    case ButtonRelease:
      TkDND_Dict_Put(dict,     "type",   "ButtonRelease");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xbutton.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xbutton.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xbutton.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xbutton.y_root);
      TkDND_Dict_PutWideInt(dict, "time", eventPtr->xbutton.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xbutton.state);
      TkDND_Dict_PutInt(dict,  "button",  eventPtr->xbutton.button);
      break;
    case KeyPress:
      TkDND_Dict_Put(dict,     "type",   "KeyPress");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xkey.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xkey.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xkey.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xkey.y_root);
      TkDND_Dict_PutWideInt(dict, "time", eventPtr->xkey.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xkey.state);
      TkDND_Dict_PutInt(dict,  "keycode", eventPtr->xkey.keycode);
      main_window = Tk_MainWindow(interp);
#ifdef TKDND_USE_XKEYCODETOKEYSYM
      keysym = XKeycodeToKeysym(Tk_Display(main_window),
                                eventPtr->xkey.keycode, 0);
      TkDND_Dict_Put(dict,     "keysym",   XKeysymToString(keysym));
................................................................................
      break;
    case KeyRelease:
      TkDND_Dict_Put(dict,     "type",   "KeyRelease");
      TkDND_Dict_PutInt(dict,  "x",       eventPtr->xkey.x);
      TkDND_Dict_PutInt(dict,  "y",       eventPtr->xkey.y);
      TkDND_Dict_PutInt(dict,  "x_root",  eventPtr->xkey.x_root);
      TkDND_Dict_PutInt(dict,  "y_root",  eventPtr->xkey.y_root);
      TkDND_Dict_PutWideInt(dict, "time", eventPtr->xkey.time);
      TkDND_AddStateInformation(interp,   dict,     eventPtr->xkey.state);
      TkDND_Dict_PutInt(dict,  "keycode", eventPtr->xkey.keycode);
      main_window = Tk_MainWindow(interp);
#ifdef TKDND_USE_XKEYCODETOKEYSYM
      keysym = XKeycodeToKeysym(Tk_Display(main_window),
                                eventPtr->xkey.keycode, 0);
      TkDND_Dict_Put(dict,     "keysym",   XKeysymToString(keysym));
................................................................................
      TkDND_Dict_Put(dict,     "keysym",   XKeysymToString(keysym[0]));
      XFree(keysym);
#endif /* TKDND_USE_XKEYCODETOKEYSYM */
      break;
    case EnterNotify:
      return 0;
      TkDND_Dict_Put(dict, "type", "EnterNotify");
      TkDND_Dict_PutWideInt(dict, "time",  eventPtr->xcrossing.time);
      break;
    case LeaveNotify:
      return 0;
      TkDND_Dict_Put(dict, "type", "LeaveNotify");
      TkDND_Dict_PutWideInt(dict, "time",  eventPtr->xcrossing.time);
      break;
    case SelectionRequest:
      main_window = Tk_MainWindow(interp);
      TkDND_Dict_Put(dict, "type", "SelectionRequest");
      TkDND_Dict_PutWideInt(dict, "time",  eventPtr->xselectionrequest.time);
      TkDND_Dict_PutLong(dict, "owner",    eventPtr->xselectionrequest.owner);
      TkDND_Dict_PutLong(dict, "requestor",
                                eventPtr->xselectionrequest.requestor);
      TkDND_Dict_Put(dict,     "selection",
            Tk_GetAtomName(main_window, eventPtr->xselectionrequest.selection));
      TkDND_Dict_Put(dict,     "target",
            Tk_GetAtomName(main_window, eventPtr->xselectionrequest.target));
................................................................................
  unsigned char *retval;
  Tcl_Obj **type;

  if (objc != 5) {
    Tcl_WrongNumArgs(interp, 1, objv, "source target proxy types_len");
    return TCL_ERROR;
  }

  source = TkDND_TkWin(objv[1]);
  if (!source) return TCL_ERROR;
  if (Tcl_GetLongFromObj(interp, objv[2], (long *) &target) != TCL_OK) {
    return TCL_ERROR;
  }
  if (Tcl_GetLongFromObj(interp, objv[3], (long *) &proxy) != TCL_OK) {
    return TCL_ERROR;
................................................................................
                  TCL_STATIC);
    return TCL_ERROR;
  }
  tv = (int *)retval;
  if (tv) {
    if (*tv < target_version) target_version = *tv;
    XFree(tv);
  }

  memset (&event, 0, sizeof(XEvent));
  event.type                    = ClientMessage;
  event.xclient.window          = target;
  event.xclient.format          = 32;
  event.xclient.message_type    = Tk_InternAtom(source, "XdndEnter");
  XDND_ENTER_SOURCE_WIN(&event) = Tk_WindowId(source);
................................................................................
  Display *display;
  int rootx, rooty, status, index;

  if (objc != 7) {
    Tcl_WrongNumArgs(interp, 1, objv, "source target proxy rootx rooty action");
    return TCL_ERROR;
  }

  source = TkDND_TkWin(objv[1]);
  if (!source) return TCL_ERROR;
  if (Tcl_GetLongFromObj(interp, objv[2], (long *) &target) != TCL_OK) {
    return TCL_ERROR;
  }
  if (Tcl_GetLongFromObj(interp, objv[3], (long *) &proxy) != TCL_OK) {
    return TCL_ERROR;
................................................................................
          Tk_InternAtom(source, "XdndActionMove");    break;
    case ActionLink:
      XDND_POSITION_ACTION(&event) =
          Tk_InternAtom(source, "XdndActionLink");    break;
    case ActionAsk:
      XDND_POSITION_ACTION(&event) =
          Tk_InternAtom(source, "XdndActionAsk");     break;
    case ActionPrivate:
      XDND_POSITION_ACTION(&event) =
          Tk_InternAtom(source, "XdndActionPrivate"); break;
  }

  XSendEvent(display, proxy, False, NoEventMask, &event);

  return TCL_OK;
................................................................................
#endif

int DLLEXPORT Tkdnd_Init(Tcl_Interp *interp) {
  int major, minor, patchlevel;
  Tcl_CmdInfo info;

  if (
#ifdef USE_TCL_STUBS
      Tcl_InitStubs(interp, "8.3", 0)
#else
      Tcl_PkgRequire(interp, "Tcl", "8.3", 0)
#endif /* USE_TCL_STUBS */
            == NULL) {
            return TCL_ERROR;
  }
................................................................................
  }

  if (Tcl_CreateObjCommand(interp, "_unregister_generic_event_handler",
           (Tcl_ObjCmdProc*) TkDND_UnregisterGenericEventHandlerObjCmd,
           (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) {
    return TCL_ERROR;
  }

  if (Tcl_CreateObjCommand(interp, "_announce_type_list",
           (Tcl_ObjCmdProc*) TkDND_AnnounceTypeListObjCmd,
           (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL) == NULL) {
    return TCL_ERROR;
  }

  if (Tcl_CreateObjCommand(interp, "_announce_action_list",

## Location of the Tcl installation:
TCL			= C:\Program Files\Tcl
TCL_VERSION		= 8.5  # or 8.6
TCL_VERSION_NO_DOTS	= 85   # or 86
MACHINE			= I386 # or AMD64 

TKDND_VERSION		= 2.9
TKDND_VERSION_NO_DOTS	= 29

##
## Usage:
## nmake -f Makefile
##

##

## Location of the Tcl installation:
TCL			= C:\Program Files\Tcl
TCL_VERSION		= 8.5  # or 8.6
TCL_VERSION_NO_DOTS	= 85   # or 86
MACHINE			= I386 # or AMD64 

TKDND_VERSION		= 2.9.2
TKDND_VERSION_NO_DOTS	= 292

##
## Usage:
## nmake -f Makefile
##

##

      drop_active(false),
#endif
      typelist(NULL), actionlist(NULL), codelist(NULL)
#ifdef DND_DRAGOVER_SKIP_EVENTS
      , last_effect(DROPEFFECT_NONE), last_X(0), last_Y(0), last_keyState(0),
      skip_if_unchanged(false)
#endif /* DND_DRAGOVER_SKIP_EVENTS */

    { }; /* TkDND_DropTarget */

    virtual ~TkDND_DropTarget(void) {
      if (typelist   != NULL) Tcl_DecrRefCount(typelist);
      if (actionlist != NULL) Tcl_DecrRefCount(actionlist);
      if (codelist   != NULL) Tcl_DecrRefCount(codelist);
    }; /* ~TkDND_DropTarget */

................................................................................
      if (grfKeyState & MK_MBUTTON)
        Tcl_ListObjAppendElement(NULL,pressedkeys,Tcl_NewStringObj("2", -1));
      if (grfKeyState & MK_LBUTTON)
        Tcl_ListObjAppendElement(NULL,pressedkeys,Tcl_NewStringObj("1", -1));
      return pressedkeys;
    }; /* GetPressedKeys */





































































    DWORD SendDragEnter(POINTL pt, DWORD grfKeyState) {
      Tcl_Obj *objv[8], *result;
      DWORD effect = DROPEFFECT_NONE;
      static const char *DropActions[] = {
        "copy", "move", "link", "ask",  "private", "refuse_drop",
        "default",
        (char *) NULL
      };
      enum dropactions {
................................................................................
      };
      int i, status, index = (enum dropactions) refuse_drop;
#ifdef DND_USE_ACTIVE
      if (drop_active) {
        return DROPEFFECT_COPY;
      }
#endif












      objv[0] = Tcl_NewStringObj("::tkdnd::olednd::HandleDragEnter", -1);
      objv[1] = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
      objv[2] = typelist;
      objv[3] = actionlist;
      objv[4] = GetPressedKeys(grfKeyState);
      objv[5] = Tcl_NewLongObj(pt.x);
      objv[6] = Tcl_NewLongObj(pt.y);
      objv[7] = codelist;

      TkDND_Status_Eval(8);
      if (status == TCL_OK) {
        /* Get the returned action... */
        result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
        status = Tcl_GetIndexFromObj(interp, result, (const char **)DropActions,
                                     "dropactions", 0, &index);
        Tcl_DecrRefCount(result);
        if (status != TCL_OK) index = (enum dropactions) ActionDefault;
................................................................................
      objv[1] = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
      objv[2] = GetPressedKeys(grfKeyState);
      objv[3] = Tcl_NewLongObj(pt.x);
      objv[4] = Tcl_NewLongObj(pt.y);
      objv[5] = type;
      objv[6] = data;
      TkDND_Status_Eval(7);
      index = (enum dropactions) refuse_drop;
      if (status == TCL_OK) {
        /* Get the returned action... */
        result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
        status = Tcl_GetIndexFromObj(interp, result, (const char **)DropActions,
                                     "dropactions", 0, &index);
        Tcl_DecrRefCount(result);
        if (status != TCL_OK) index = (enum dropactions) refuse_drop;
................................................................................
      if (*pdwEffect & DROPEFFECT_MOVE)
        Tcl_ListObjAppendElement(NULL,actionlist,Tcl_NewStringObj("move", -1));
      if (*pdwEffect & DROPEFFECT_LINK)
        Tcl_ListObjAppendElement(NULL,actionlist,Tcl_NewStringObj("link", -1));

      // We are ready to pass the info to the Tcl level, and get the desired
      // action.
      *pdwEffect = SendDragEnter(pt, grfKeyState);
      return S_OK;
    }; /* DragEnter */

    STDMETHODIMP DragOver(DWORD grfKeyState, POINTL pt, DWORD *pdwEffect) {
      /*
       * This event will be delivered when the mouse is over tkwin. Ensure that
       * the part the mouse is in, is not overlapped by another window...
................................................................................
      if (codelist   != NULL) {Tcl_DecrRefCount(codelist);   codelist   = NULL;}
      return S_OK;
    }; /* DragLeave */

    STDMETHODIMP Drop(IDataObject *pDataObject, DWORD grfKeyState,
                      POINTL pt, DWORD *pdwEffect) {
      Tcl_Obj *objv[7], *result, **typeObj, *data = NULL, *type = NULL;
      int i, type_index, status, index, typeObjc;
      static const char *DropTypes[] = {
        "CF_UNICODETEXT", "CF_TEXT", "CF_HDROP",
        "CF_HTML", "HTML Format",
        "CF_RTF", "CF_RTFTEXT", "Rich Text Format",
        "FileGroupDescriptorW", "FileGroupDescriptor",
        "UniformResourceLocator", "UniformResourceLocatorW",
        (char *) NULL
      };
      enum droptypes {
        TYPE_CF_UNICODETEXT, TYPE_CF_TEXT, TYPE_CF_HDROP,
        TYPE_CF_HTML, TYPE_CF_HTMLFORMAT,
        TYPE_CF_RTF, TYPE_CF_RTFTEXT, TYPE_CF_RICHTEXTFORMAT,
        TYPE_FILEGROUPDESCRIPTORW, TYPE_FILEGROUPDESCRIPTOR,
        TYPE_UNIFORMRESOURCELOCATOR, TYPE_UNIFORMRESOURCELOCATORW
      };
      *pdwEffect = DROPEFFECT_NONE;
#ifdef DND_USE_ACTIVE
      if (!drop_active) return S_OK;
      drop_active = false;
#endif
      // Get the drop format list.
      objv[0] = Tcl_NewStringObj("::tkdnd::olednd::GetDragSourceCommonTypes", -1);
................................................................................
      objv[1] = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
      TkDND_Status_Eval(2); if (status != TCL_OK) return S_OK;
      result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
      status = Tcl_ListObjGetElements(interp, result, &typeObjc, &typeObj);
      if (status != TCL_OK) {Tcl_DecrRefCount(result); return S_OK;}
      // Try to get the data.
      for (type_index = 0; type_index < typeObjc; ++type_index) {
        status = Tcl_GetIndexFromObj(interp, typeObj[type_index],
                             (const char **)DropTypes, "droptypes", 0, &index);
        if (status == TCL_OK) {
          switch ((enum droptypes) index) {
            case TYPE_CF_UNICODETEXT:
              data = GetData_CF_UNICODETEXT(pDataObject); break;
            case TYPE_CF_HTML:
            case TYPE_CF_HTMLFORMAT:
            case TYPE_CF_RTF:
            case TYPE_CF_RTFTEXT:
            case TYPE_CF_RICHTEXTFORMAT:
              data = GetData_Bytearray(pDataObject, typeObj[type_index]);
              break;
            case TYPE_CF_TEXT:
              data = GetData_CF_TEXT(pDataObject); break;
            case TYPE_CF_HDROP:
              data = GetData_CF_HDROP(pDataObject); break;
            case TYPE_UNIFORMRESOURCELOCATORW:
              data = GetData_UniformResourceLocator(pDataObject); break;
            case TYPE_UNIFORMRESOURCELOCATOR:
              data = GetData_UniformResourceLocatorW(pDataObject); break;
            case TYPE_FILEGROUPDESCRIPTORW:
              // Get a directory where we can store files...
              objv[0]=Tcl_NewStringObj("tkdnd::GetDropFileTempDirectory", -1);
              TkDND_Status_Eval(1);
              if (status == TCL_OK) {
                strcpy((char *) szTempStr, Tcl_GetStringResult(interp));
                data = GetData_FileGroupDescriptorW(pDataObject);
              }
              break;
            case TYPE_FILEGROUPDESCRIPTOR:
              // Get a directory where we can store files...
              objv[0] = Tcl_NewStringObj("tkdnd::GetDropFileTempDirectory", -1);
              TkDND_Status_Eval(1);
              if (status == TCL_OK) {
                strcpy((char *) szTempStr, Tcl_GetStringResult(interp));
                data = GetData_FileGroupDescriptor(pDataObject);
              }
              break;
          }
        }
        if (data != NULL) {
          type = typeObj[type_index]; Tcl_IncrRefCount(type);
          break; // We have got the data!
        }
      }

      if (data == NULL) {

      drop_active(false),
#endif
      typelist(NULL), actionlist(NULL), codelist(NULL)
#ifdef DND_DRAGOVER_SKIP_EVENTS
      , last_effect(DROPEFFECT_NONE), last_X(0), last_Y(0), last_keyState(0),
      skip_if_unchanged(false)
#endif /* DND_DRAGOVER_SKIP_EVENTS */
    {
    }; /* TkDND_DropTarget */

    virtual ~TkDND_DropTarget(void) {
      if (typelist   != NULL) Tcl_DecrRefCount(typelist);
      if (actionlist != NULL) Tcl_DecrRefCount(actionlist);
      if (codelist   != NULL) Tcl_DecrRefCount(codelist);
    }; /* ~TkDND_DropTarget */

................................................................................
      if (grfKeyState & MK_MBUTTON)
        Tcl_ListObjAppendElement(NULL,pressedkeys,Tcl_NewStringObj("2", -1));
      if (grfKeyState & MK_LBUTTON)
        Tcl_ListObjAppendElement(NULL,pressedkeys,Tcl_NewStringObj("1", -1));
      return pressedkeys;
    }; /* GetPressedKeys */

    /* Returns a new Tcl_Obj, or NULL. Returned object must be freed! */
    Tcl_Obj *GetData(IDataObject *pDataObject, Tcl_Obj* typeObj) {
      Tcl_Obj *data = NULL;
      int i, status, index;
      static const char *DropTypes[] = {
        "CF_UNICODETEXT", "CF_TEXT", "CF_HDROP",
        "CF_HTML", "HTML Format",
        "CF_RTF", "CF_RTFTEXT", "Rich Text Format",
        "FileGroupDescriptorW", "FileGroupDescriptor",
        "UniformResourceLocator", "UniformResourceLocatorW",
        (char *) NULL
      };
      enum droptypes {
        TYPE_CF_UNICODETEXT, TYPE_CF_TEXT, TYPE_CF_HDROP,
        TYPE_CF_HTML, TYPE_CF_HTMLFORMAT,
        TYPE_CF_RTF, TYPE_CF_RTFTEXT, TYPE_CF_RICHTEXTFORMAT,
        TYPE_FILEGROUPDESCRIPTORW, TYPE_FILEGROUPDESCRIPTOR,
        TYPE_UNIFORMRESOURCELOCATOR, TYPE_UNIFORMRESOURCELOCATORW
      };
      status = Tcl_GetIndexFromObj(interp, typeObj,
                           (const char **)DropTypes, "droptypes", 0, &index);
      if (status == TCL_OK) {
        switch ((enum droptypes) index) {
          case TYPE_CF_UNICODETEXT:
            data = GetData_CF_UNICODETEXT(pDataObject); break;
          case TYPE_CF_HTML:
          case TYPE_CF_HTMLFORMAT:
          case TYPE_CF_RTF:
          case TYPE_CF_RTFTEXT:
          case TYPE_CF_RICHTEXTFORMAT:
            data = GetData_Bytearray(pDataObject, typeObj);
            break;
          case TYPE_CF_TEXT:
            data = GetData_CF_TEXT(pDataObject); break;
          case TYPE_CF_HDROP:
            data = GetData_CF_HDROP(pDataObject); break;
          case TYPE_UNIFORMRESOURCELOCATORW:
            data = GetData_UniformResourceLocator(pDataObject); break;
          case TYPE_UNIFORMRESOURCELOCATOR:
            data = GetData_UniformResourceLocatorW(pDataObject); break;
          case TYPE_FILEGROUPDESCRIPTORW: {
            // Get a directory where we can store files...
            Tcl_Obj *objv[1];
            objv[0]=Tcl_NewStringObj("tkdnd::GetDropFileTempDirectory", -1);
            TkDND_Status_Eval(1);
            if (status == TCL_OK) {
              strcpy((char *) szTempStr, Tcl_GetStringResult(interp));
              data = GetData_FileGroupDescriptorW(pDataObject);
            }
            break;
          }
          case TYPE_FILEGROUPDESCRIPTOR: {
            // Get a directory where we can store files...
            Tcl_Obj *objv[1];
            objv[0] = Tcl_NewStringObj("tkdnd::GetDropFileTempDirectory", -1);
            TkDND_Status_Eval(1);
            if (status == TCL_OK) {
              strcpy((char *) szTempStr, Tcl_GetStringResult(interp));
              data = GetData_FileGroupDescriptor(pDataObject);
            }
            break;
          }
        }
      }
      return data;
    }; /* GetData */

    DWORD SendDragEnter(IDataObject *pDataObject,
                        POINTL pt, DWORD grfKeyState) {
      Tcl_Obj *objv[9], *result, *data = NULL;
      DWORD effect = DROPEFFECT_NONE;
      static const char *DropActions[] = {
        "copy", "move", "link", "ask",  "private", "refuse_drop",
        "default",
        (char *) NULL
      };
      enum dropactions {
................................................................................
      };
      int i, status, index = (enum dropactions) refuse_drop;
#ifdef DND_USE_ACTIVE
      if (drop_active) {
        return DROPEFFECT_COPY;
      }
#endif
      /* Get a type to convert data... */
      objv[0] = Tcl_NewStringObj("::tkdnd::olednd::GetDataType", -1);
      objv[1] = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
      objv[2] = typelist;
      TkDND_Status_Eval(3);
      if (status == TCL_OK) {
        /* Get the returned type... */
        result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
        data = GetData(pDataObject, result);
        Tcl_DecrRefCount(result);
      }
      if (data == NULL) data = Tcl_NewStringObj("", 0);
      objv[0] = Tcl_NewStringObj("::tkdnd::olednd::HandleDragEnter", -1);
      objv[1] = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
      objv[2] = typelist;
      objv[3] = actionlist;
      objv[4] = GetPressedKeys(grfKeyState);
      objv[5] = Tcl_NewLongObj(pt.x);
      objv[6] = Tcl_NewLongObj(pt.y);
      objv[7] = codelist;
      objv[8] = data;
      TkDND_Status_Eval(9);
      if (status == TCL_OK) {
        /* Get the returned action... */
        result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
        status = Tcl_GetIndexFromObj(interp, result, (const char **)DropActions,
                                     "dropactions", 0, &index);
        Tcl_DecrRefCount(result);
        if (status != TCL_OK) index = (enum dropactions) ActionDefault;
................................................................................
      objv[1] = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
      objv[2] = GetPressedKeys(grfKeyState);
      objv[3] = Tcl_NewLongObj(pt.x);
      objv[4] = Tcl_NewLongObj(pt.y);
      objv[5] = type;
      objv[6] = data;
      TkDND_Status_Eval(7);

      if (status == TCL_OK) {
        /* Get the returned action... */
        result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
        status = Tcl_GetIndexFromObj(interp, result, (const char **)DropActions,
                                     "dropactions", 0, &index);
        Tcl_DecrRefCount(result);
        if (status != TCL_OK) index = (enum dropactions) refuse_drop;
................................................................................
      if (*pdwEffect & DROPEFFECT_MOVE)
        Tcl_ListObjAppendElement(NULL,actionlist,Tcl_NewStringObj("move", -1));
      if (*pdwEffect & DROPEFFECT_LINK)
        Tcl_ListObjAppendElement(NULL,actionlist,Tcl_NewStringObj("link", -1));

      // We are ready to pass the info to the Tcl level, and get the desired
      // action.
      *pdwEffect = SendDragEnter(pDataObject, pt, grfKeyState);
      return S_OK;
    }; /* DragEnter */

    STDMETHODIMP DragOver(DWORD grfKeyState, POINTL pt, DWORD *pdwEffect) {
      /*
       * This event will be delivered when the mouse is over tkwin. Ensure that
       * the part the mouse is in, is not overlapped by another window...
................................................................................
      if (codelist   != NULL) {Tcl_DecrRefCount(codelist);   codelist   = NULL;}
      return S_OK;
    }; /* DragLeave */

    STDMETHODIMP Drop(IDataObject *pDataObject, DWORD grfKeyState,
                      POINTL pt, DWORD *pdwEffect) {
      Tcl_Obj *objv[7], *result, **typeObj, *data = NULL, *type = NULL;
      int i, type_index, status, typeObjc;















      *pdwEffect = DROPEFFECT_NONE;
#ifdef DND_USE_ACTIVE
      if (!drop_active) return S_OK;
      drop_active = false;
#endif
      // Get the drop format list.
      objv[0] = Tcl_NewStringObj("::tkdnd::olednd::GetDragSourceCommonTypes", -1);
................................................................................
      objv[1] = Tcl_NewStringObj(Tk_PathName(tkwin), -1);
      TkDND_Status_Eval(2); if (status != TCL_OK) return S_OK;
      result = Tcl_GetObjResult(interp); Tcl_IncrRefCount(result);
      status = Tcl_ListObjGetElements(interp, result, &typeObjc, &typeObj);
      if (status != TCL_OK) {Tcl_DecrRefCount(result); return S_OK;}
      // Try to get the data.
      for (type_index = 0; type_index < typeObjc; ++type_index) {











        data = GetData(pDataObject, typeObj[type_index]);





























        if (data != NULL) {
          type = typeObj[type_index]; Tcl_IncrRefCount(type);
          break; // We have got the data!
        }
      }

      if (data == NULL) {

}

# We use a photo image to draw libVLC media player
set photo [image create photo -width 320 -height 240]
set display [label .tkvlc -image $photo -background white -takefocus 1]
pack $display -fill both -expand 1

# Iinitialize libVLC
tkvlc::init tkvlc0 $photo

bind $display <1> {
    if {[tkvlc0 isplaying]} {
        tkvlc0 pause
    } else {
        tkvlc0 play
    }
}

wm protocol . WM_DELETE_WINDOW quitApp

}

# We use a photo image to draw libVLC media player
set photo [image create photo -width 320 -height 240]
set display [label .tkvlc -image $photo -background white -takefocus 1]
pack $display -fill both -expand 1

# Initialize libVLC
tkvlc::init tkvlc0 $photo

bind $display <1> {
    if {[tkvlc0 isplaying]} {
        tkvlc0 pause
    } else {
        tkvlc0 play
    }
}

wm protocol . WM_DELETE_WINDOW quitApp