void
TkSelInit(
Tk_Window tkwin) /* Window token (used to find display to
* initialize). */
{
register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
/*
* Fetch commonly-used atoms.
*/
dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION");
dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW");
dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD");
/*
* Using UTF8_STRING instead of the XA_UTF8_STRING macro allows us to
* support older X servers that didn't have UTF8_STRING yet. This is
* necessary on Unix systems. For more information, see:
* http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11
*/
#if !(defined(__WIN32__) || defined(MAC_OSX_TK))
dispPtr->utf8Atom = Tk_InternAtom(tkwin, "UTF8_STRING");
#else
dispPtr->utf8Atom = (Atom) NULL;
#endif
}
void
XSetSelectionOwner(
Display* display, /* X Display. */
Atom selection, /* What selection to own. */
Window owner, /* Window to be the owner. */
Time time) /* The current time? */
{
Tk_Window tkwin;
TkDisplay *dispPtr;
/*
* This is a gross hack because the Tk_InternAtom interface is broken.
* It expects a Tk_Window, even though it only needs a Tk_Display.
*/
tkwin = (Tk_Window) TkGetMainInfoList()->winPtr;
if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) {
/*
* Only claim and empty the clipboard if we aren't already the
* owner of the clipboard.
*/
dispPtr = TkGetMainInfoList()->winPtr->dispPtr;
if (dispPtr->clipboardActive) {
return;
}
ZeroScrap();
}
}
int
XSetSelectionOwner(
Display *display,
Atom selection,
Window owner,
Time time)
{
HWND hwnd = owner ? TkWinGetHWND(owner) : NULL;
Tk_Window tkwin;
/*
* This is a gross hack because the Tk_InternAtom interface is broken. It
* expects a Tk_Window, even though it only needs a Tk_Display.
*/
tkwin = (Tk_Window) TkGetMainInfoList()->winPtr;
if (selection == Tk_InternAtom(tkwin, "CLIPBOARD")) {
/*
* Only claim and empty the clipboard if we aren't already the owner
* of the clipboard.
*/
if (GetClipboardOwner() != hwnd) {
UpdateClipboard(hwnd);
}
}
return Success;
}
void
TkSuspendClipboard()
{
TkClipboardTarget *targetPtr;
TkClipboardBuffer *cbPtr;
TkDisplay *dispPtr;
char *buffer, *p, *endPtr, *buffPtr;
long length;
dispPtr = tkDisplayList;
if ((dispPtr == NULL) || !dispPtr->clipboardActive) {
return;
}
for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
targetPtr = targetPtr->nextPtr) {
if (targetPtr->type == XA_STRING)
break;
}
if (targetPtr != NULL) {
length = 0;
for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
cbPtr = cbPtr->nextPtr) {
length += cbPtr->length;
}
buffer = ckalloc(length);
buffPtr = buffer;
for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
cbPtr = cbPtr->nextPtr) {
for (p = cbPtr->buffer, endPtr = p + cbPtr->length;
p < endPtr; p++) {
if (*p == '\n') {
*buffPtr++ = '\r';
} else {
*buffPtr++ = *p;
}
}
}
ZeroScrap();
PutScrap(length, 'TEXT', buffer);
ckfree(buffer);
}
/*
* The system now owns the scrap. We tell Tk that it has
* lost the selection so that it will look for it the next time
* it needs it. (Window list NULL if quiting.)
*/
if (tkMainWindowList != NULL) {
Tk_ClearSelection((Tk_Window) tkMainWindowList->winPtr,
Tk_InternAtom((Tk_Window) tkMainWindowList->winPtr,
"CLIPBOARD"));
}
return;
}
void
TkGenWMDestroyEvent(
Tk_Window tkwin)
{
XEvent event;
event.xany.serial = LastKnownRequestProcessed(Tk_Display(tkwin));
event.xany.send_event = False;
event.xany.display = Tk_Display(tkwin);
event.xclient.window = Tk_WindowId(tkwin);
event.xclient.type = ClientMessage;
event.xclient.message_type = Tk_InternAtom(tkwin, "WM_PROTOCOLS");
event.xclient.format = 32;
event.xclient.data.l[0] = Tk_InternAtom(tkwin, "WM_DELETE_WINDOW");
Tk_HandleEvent(&event);
}
int
TkSelGetSelection(
Tcl_Interp *interp, /* Interpreter to use for reporting
* errors. */
Tk_Window tkwin, /* Window on whose behalf to retrieve
* the selection (determines display
* from which to retrieve). */
Atom selection, /* Selection to retrieve. */
Atom target, /* Desired form in which selection
* is to be returned. */
Tk_GetSelProc *proc, /* Procedure to call to process the
* selection, once it has been retrieved. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
int result;
long length, offset = 0;
Handle handle;
if ((selection == Tk_InternAtom(tkwin, "CLIPBOARD"))
&& (target == XA_STRING)) {
/*
* Get the scrap from the Macintosh global clipboard.
*/
handle = NewHandle(1);
length = GetScrap(handle, 'TEXT', &offset);
if (length > 0) {
Tcl_DString encodedText;
SetHandleSize(handle, (Size) length + 1);
HLock(handle);
(*handle)[length] = '\0';
Tcl_ExternalToUtfDString(NULL, *handle, length, &encodedText);
result = (*proc)(clientData, interp,
Tcl_DStringValue(&encodedText));
Tcl_DStringFree(&encodedText);
HUnlock(handle);
DisposeHandle(handle);
return result;
}
DisposeHandle(handle);
}
Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
" selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
"\" not defined", (char *) NULL);
return TCL_ERROR;
}
static int
TestclipboardObjCmd(
ClientData clientData, /* Main window for application. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument values. */
{
Tk_Window tkwin = (Tk_Window) clientData;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, NULL);
return TCL_ERROR;
}
return TkSelGetSelection(interp, tkwin, Tk_InternAtom(tkwin, "CLIPBOARD"),
XA_STRING, SetSelectionResult, NULL);
}
void
TkWmProtocolEventProc(
TkWindow *winPtr, /* Window to which the event was sent. */
XEvent *eventPtr) /* X event. */
{
WmInfo *wmPtr;
ProtocolHandler *protPtr;
Tcl_Interp *interp;
Atom protocol;
int result;
wmPtr = winPtr->wmInfoPtr;
if (wmPtr == NULL) {
return;
}
protocol = (Atom) eventPtr->xclient.data.l[0];
for (protPtr = wmPtr->protPtr; protPtr != NULL;
protPtr = protPtr->nextPtr) {
if (protocol == protPtr->protocol) {
Tcl_Preserve(protPtr);
interp = protPtr->interp;
Tcl_Preserve(interp);
result = Tcl_EvalEx(interp, protPtr->command, -1, TCL_EVAL_GLOBAL);
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp, "\n (command for \"");
Tcl_AddErrorInfo(interp,
Tk_GetAtomName((Tk_Window) winPtr, protocol));
Tcl_AddErrorInfo(interp, "\" window manager protocol)");
Tcl_BackgroundError(interp);
}
Tcl_Release(interp);
Tcl_Release(protPtr);
return;
}
}
/*
* No handler was present for this protocol. If this is a WM_DELETE_WINDOW
* message then just destroy the window.
*/
if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
Tk_DestroyWindow((Tk_Window) winPtr);
}
}
int
Tk_SelectionObjCmd(
ClientData clientData, /* Main window associated with
* interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tk_Window tkwin = clientData;
char *path = NULL;
Atom selection;
char *selName = NULL, *string;
int count, index;
Tcl_Obj **objs;
static const char *const optionStrings[] = {
"clear", "get", "handle", "own", NULL
};
enum options {
SELECTION_CLEAR, SELECTION_GET, SELECTION_HANDLE, SELECTION_OWN
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case SELECTION_CLEAR: {
static const char *const clearOptionStrings[] = {
"-displayof", "-selection", NULL
};
enum clearOptions { CLEAR_DISPLAYOF, CLEAR_SELECTION };
int clearIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], clearOptionStrings,
"option", 0, &clearIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum clearOptions) clearIndex) {
case CLEAR_DISPLAYOF:
path = Tcl_GetString(objs[1]);
break;
case CLEAR_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
}
}
if (count == 1) {
path = Tcl_GetString(objs[0]);
} else if (count > 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
return TCL_ERROR;
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
Tk_ClearSelection(tkwin, selection);
break;
}
case SELECTION_GET: {
Atom target;
char *targetName = NULL;
Tcl_DString selBytes;
int result;
static const char *const getOptionStrings[] = {
"-displayof", "-selection", "-type", NULL
};
enum getOptions { GET_DISPLAYOF, GET_SELECTION, GET_TYPE };
int getIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count>0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], 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;
case GET_TYPE:
targetName = Tcl_GetString(objs[1]);
break;
}
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count > 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
return TCL_ERROR;
} else if (count == 1) {
target = Tk_InternAtom(tkwin, Tcl_GetString(objs[0]));
} else if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
Tcl_DStringInit(&selBytes);
result = Tk_GetSelection(interp, tkwin, selection, target,
SelGetProc, &selBytes);
if (result == TCL_OK) {
Tcl_DStringResult(interp, &selBytes);
} else {
Tcl_DStringFree(&selBytes);
}
return result;
}
case SELECTION_HANDLE: {
Atom target, format;
char *targetName = NULL;
char *formatName = NULL;
register CommandInfo *cmdInfoPtr;
int cmdLength;
static const char *const handleOptionStrings[] = {
"-format", "-selection", "-type", NULL
};
enum handleOptions {
HANDLE_FORMAT, HANDLE_SELECTION, HANDLE_TYPE
};
int handleIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0],handleOptionStrings,
"option", 0, &handleIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum handleOptions) handleIndex) {
case HANDLE_FORMAT:
formatName = Tcl_GetString(objs[1]);
break;
case HANDLE_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
case HANDLE_TYPE:
targetName = Tcl_GetString(objs[1]);
break;
}
}
if ((count < 2) || (count > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? window command");
return TCL_ERROR;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count > 2) {
target = Tk_InternAtom(tkwin, Tcl_GetString(objs[2]));
} else if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
if (count > 3) {
format = Tk_InternAtom(tkwin, Tcl_GetString(objs[3]));
} else if (formatName != NULL) {
format = Tk_InternAtom(tkwin, formatName);
} else {
format = XA_STRING;
}
string = Tcl_GetStringFromObj(objs[1], &cmdLength);
if (cmdLength == 0) {
Tk_DeleteSelHandler(tkwin, selection, target);
} else {
cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
sizeof(CommandInfo) - 3 + cmdLength));
cmdInfoPtr->interp = interp;
cmdInfoPtr->charOffset = 0;
cmdInfoPtr->byteOffset = 0;
cmdInfoPtr->buffer[0] = '\0';
cmdInfoPtr->cmdLength = cmdLength;
strcpy(cmdInfoPtr->command, string);
Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
cmdInfoPtr, format);
}
return TCL_OK;
}
case SELECTION_OWN: {
register LostCommand *lostPtr;
char *script = NULL;
int cmdLength;
static const char *const ownOptionStrings[] = {
"-command", "-displayof", "-selection", NULL
};
enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION };
int ownIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], ownOptionStrings,
"option", 0, &ownIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum ownOptions) ownIndex) {
case OWN_COMMAND:
script = Tcl_GetString(objs[1]);
break;
case OWN_DISPLAYOF:
path = Tcl_GetString(objs[1]);
break;
case OWN_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
}
}
if (count > 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? ?window?");
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count == 0) {
TkSelectionInfo *infoPtr;
TkWindow *winPtr;
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
winPtr = (TkWindow *)tkwin;
for (infoPtr = winPtr->dispPtr->selectionInfoPtr;
infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
if (infoPtr->selection == selection) {
break;
}
}
/*
* Ignore the internal clipboard window.
*/
if ((infoPtr != NULL)
&& (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC);
}
return TCL_OK;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
if (count == 2) {
script = Tcl_GetString(objs[1]);
}
if (script == NULL) {
Tk_OwnSelection(tkwin, selection, NULL, NULL);
return TCL_OK;
}
cmdLength = strlen(script);
lostPtr = (LostCommand *)
ckalloc((unsigned) (sizeof(LostCommand) - 3 + cmdLength));
lostPtr->interp = interp;
strcpy(lostPtr->command, script);
Tk_OwnSelection(tkwin, selection, LostSelection, lostPtr);
return TCL_OK;
}
}
return TCL_OK;
}
int
TkSelGetSelection(
Tcl_Interp *interp, /* Interpreter to use for reporting
* errors. */
Tk_Window tkwin, /* Window on whose behalf to retrieve
* the selection (determines display
* from which to retrieve). */
Atom selection, /* Selection to retrieve. */
Atom target, /* Desired form in which selection
* is to be returned. */
Tk_GetSelProc *proc, /* Procedure to call to process the
* selection, once it has been retrieved. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
int result;
int err;
long length;
ScrapRef scrapRef;
char * buf;
if ((selection == Tk_InternAtom(tkwin, "CLIPBOARD"))
&& (target == XA_STRING)) {
/*
* Get the scrap from the Macintosh global clipboard.
*/
err=GetCurrentScrap(&scrapRef);
if (err != noErr) {
Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
" GetCurrentScrap failed.", (char *) NULL);
return TCL_ERROR;
}
err=GetScrapFlavorSize(scrapRef,'TEXT',&length);
if (err != noErr) {
Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
" GetScrapFlavorSize failed.", (char *) NULL);
return TCL_ERROR;
}
if (length > 0) {
Tcl_DString encodedText;
buf = (char *)ckalloc(length+1);
buf[length] = 0;
err = GetScrapFlavorData(scrapRef, 'TEXT', &length, buf);
if (err != noErr) {
Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
" GetScrapFlavorData failed.", (char *) NULL);
return TCL_ERROR;
}
Tcl_ExternalToUtfDString(TkMacOSXCarbonEncoding, buf, length,
&encodedText);
result = (*proc)(clientData, interp,
Tcl_DStringValue(&encodedText));
Tcl_DStringFree(&encodedText);
ckfree(buf);
return result;
}
}
Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
" selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
"\" not defined", (char *) NULL);
return TCL_ERROR;
}
void
TkSuspendClipboard()
{
TkClipboardTarget *targetPtr;
TkClipboardBuffer *cbPtr;
TkDisplay *dispPtr;
char *buffer, *p, *endPtr, *buffPtr;
long length;
ScrapRef scrapRef;
dispPtr = TkGetDisplayList();
if ((dispPtr == NULL) || !dispPtr->clipboardActive) {
return;
}
for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
targetPtr = targetPtr->nextPtr) {
if (targetPtr->type == XA_STRING)
break;
}
if (targetPtr != NULL) {
Tcl_DString encodedText;
length = 0;
for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
cbPtr = cbPtr->nextPtr) {
length += cbPtr->length;
}
buffer = ckalloc(length);
buffPtr = buffer;
for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
cbPtr = cbPtr->nextPtr) {
for (p = cbPtr->buffer, endPtr = p + cbPtr->length;
p < endPtr; p++) {
if (*p == '\n') {
*buffPtr++ = '\r';
} else {
*buffPtr++ = *p;
}
}
}
ClearCurrentScrap();
GetCurrentScrap(&scrapRef);
Tcl_UtfToExternalDString(TkMacOSXCarbonEncoding, buffer, length, &encodedText);
PutScrapFlavor(scrapRef, 'TEXT', 0, Tcl_DStringLength(&encodedText), Tcl_DStringValue(&encodedText) );
Tcl_DStringFree(&encodedText);
ckfree(buffer);
}
/*
* The system now owns the scrap. We tell Tk that it has
* lost the selection so that it will look for it the next time
* it needs it. (Window list NULL if quiting.)
*/
if (TkGetMainInfoList() != NULL) {
Tk_ClearSelection((Tk_Window) TkGetMainInfoList()->winPtr,
Tk_InternAtom((Tk_Window) TkGetMainInfoList()->winPtr,
"CLIPBOARD"));
}
return;
}
int
Tk_ClipboardObjCmd(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
Tk_Window tkwin = (Tk_Window) clientData;
const char *path = NULL;
Atom selection;
static const char *const optionStrings[] = { "append", "clear", "get", NULL };
enum options { CLIPBOARD_APPEND, CLIPBOARD_CLEAR, CLIPBOARD_GET };
int index, i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case CLIPBOARD_APPEND: {
Atom target, format;
const char *targetName = NULL;
const char *formatName = NULL;
const char *string;
static const char *const appendOptionStrings[] = {
"-displayof", "-format", "-type", NULL
};
enum appendOptions { APPEND_DISPLAYOF, APPEND_FORMAT, APPEND_TYPE };
int subIndex, length;
for (i = 2; i < objc - 1; i++) {
string = Tcl_GetStringFromObj(objv[i], &length);
if (string[0] != '-') {
break;
}
/*
* If the argument is "--", it signifies the end of arguments.
*/
if (string[1] == '-' && length == 2) {
i++;
break;
}
if (Tcl_GetIndexFromObj(interp, objv[i], appendOptionStrings,
"option", 0, &subIndex) != TCL_OK) {
return TCL_ERROR;
}
/*
* Increment i so that it points to the value for the flag instead
* of the flag itself.
*/
i++;
if (i >= objc) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
switch ((enum appendOptions) subIndex) {
case APPEND_DISPLAYOF:
path = Tcl_GetString(objv[i]);
break;
case APPEND_FORMAT:
formatName = Tcl_GetString(objv[i]);
break;
case APPEND_TYPE:
targetName = Tcl_GetString(objv[i]);
break;
}
}
if (objc - i != 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? data");
return TCL_ERROR;
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
if (formatName != NULL) {
format = Tk_InternAtom(tkwin, formatName);
} else {
format = XA_STRING;
}
return Tk_ClipboardAppend(interp, tkwin, target, format,
Tcl_GetString(objv[i]));
}
case CLIPBOARD_CLEAR: {
static const char *const clearOptionStrings[] = { "-displayof", NULL };
enum clearOptions { CLEAR_DISPLAYOF };
int subIndex;
if (objc != 2 && objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
return TCL_ERROR;
}
if (objc == 4) {
if (Tcl_GetIndexFromObj(interp, objv[2], clearOptionStrings,
"option", 0, &subIndex) != TCL_OK) {
return TCL_ERROR;
}
if ((enum clearOptions) subIndex == CLEAR_DISPLAYOF) {
path = Tcl_GetString(objv[3]);
}
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
return Tk_ClipboardClear(interp, tkwin);
}
case CLIPBOARD_GET: {
Atom target;
const char *targetName = NULL;
Tcl_DString selBytes;
int result;
const char *string;
static const char *const getOptionStrings[] = {
"-displayof", "-type", NULL
};
enum getOptions { APPEND_DISPLAYOF, APPEND_TYPE };
int subIndex;
for (i = 2; i < objc; i++) {
string = Tcl_GetString(objv[i]);
if (string[0] != '-') {
break;
}
if (Tcl_GetIndexFromObj(interp, objv[i], getOptionStrings,
"option", 0, &subIndex) != TCL_OK) {
return TCL_ERROR;
}
i++;
if (i >= objc) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
switch ((enum getOptions) subIndex) {
case APPEND_DISPLAYOF:
path = Tcl_GetString(objv[i]);
break;
case APPEND_TYPE:
targetName = Tcl_GetString(objv[i]);
break;
}
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
selection = Tk_InternAtom(tkwin, "CLIPBOARD");
if (objc - i > 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
return TCL_ERROR;
} else if (objc - i == 1) {
target = Tk_InternAtom(tkwin, Tcl_GetString(objv[i]));
} else if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
Tcl_DStringInit(&selBytes);
result = Tk_GetSelection(interp, tkwin, selection, target,
ClipboardGetProc, &selBytes);
if (result == TCL_OK) {
Tcl_DStringResult(interp, &selBytes);
} else {
Tcl_DStringFree(&selBytes);
}
return result;
}
}
return TCL_OK;
}
int
TkSelGetSelection(
Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
Tk_Window tkwin, /* Window on whose behalf to retrieve the
* selection (determines display from which to
* retrieve). */
Atom selection, /* Selection to retrieve. */
Atom target, /* Desired form in which selection is to be
* returned. */
Tk_GetSelProc *proc, /* Procedure to call to process the selection,
* once it has been retrieved. */
ClientData clientData) /* Arbitrary value to pass to proc. */
{
char *data, *destPtr;
Tcl_DString ds;
HGLOBAL handle;
Tcl_Encoding encoding;
int result, locale;
if ((selection != Tk_InternAtom(tkwin, "CLIPBOARD"))
|| (target != XA_STRING)
|| !OpenClipboard(NULL)) {
goto error;
}
/*
* Attempt to get the data in Unicode form if available as this is less
* work that CF_TEXT.
*/
result = TCL_ERROR;
if (IsClipboardFormatAvailable(CF_UNICODETEXT)) {
handle = GetClipboardData(CF_UNICODETEXT);
if (!handle) {
CloseClipboard();
goto error;
}
data = GlobalLock(handle);
Tcl_DStringInit(&ds);
Tcl_UniCharToUtfDString((Tcl_UniChar *)data,
Tcl_UniCharLen((Tcl_UniChar *)data), &ds);
GlobalUnlock(handle);
} else if (IsClipboardFormatAvailable(CF_TEXT)) {
/*
* Determine the encoding to use to convert this text.
*/
if (IsClipboardFormatAvailable(CF_LOCALE)) {
handle = GetClipboardData(CF_LOCALE);
if (!handle) {
CloseClipboard();
goto error;
}
/*
* Get the locale identifier, determine the proper code page to
* use, and find the corresponding encoding.
*/
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, "cp######", -1);
data = GlobalLock(handle);
/*
* Even though the documentation claims that GetLocaleInfo expects
* an LCID, on Windows 9x it really seems to expect a LanguageID.
*/
locale = LANGIDFROMLCID(*((int*)data));
GetLocaleInfoA(locale, LOCALE_IDEFAULTANSICODEPAGE,
Tcl_DStringValue(&ds)+2, Tcl_DStringLength(&ds)-2);
GlobalUnlock(handle);
encoding = Tcl_GetEncoding(NULL, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
} else {
encoding = NULL;
}
/*
* Fetch the text and convert it to UTF.
*/
handle = GetClipboardData(CF_TEXT);
if (!handle) {
if (encoding) {
Tcl_FreeEncoding(encoding);
}
CloseClipboard();
goto error;
}
data = GlobalLock(handle);
Tcl_ExternalToUtfDString(encoding, data, -1, &ds);
GlobalUnlock(handle);
if (encoding) {
Tcl_FreeEncoding(encoding);
}
} else {
CloseClipboard();
goto error;
}
/*
* Translate CR/LF to LF.
*/
data = destPtr = Tcl_DStringValue(&ds);
while (*data) {
if (data[0] == '\r' && data[1] == '\n') {
data++;
} else {
*destPtr++ = *data++;
}
}
*destPtr = '\0';
/*
* Pass the data off to the selection procedure.
*/
result = proc(clientData, interp, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
CloseClipboard();
return result;
error:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s selection doesn't exist or form \"%s\" not defined",
Tk_GetAtomName(tkwin, selection), Tk_GetAtomName(tkwin, target)));
Tcl_SetErrorCode(interp, "TK", "SELECTION", "EXISTS", NULL);
return TCL_ERROR;
}
