1/* 2 * tkUnixSelect.c -- 3 * 4 * This file contains X specific routines for manipulating 5 * selections. 6 * 7 * Copyright (c) 1995-1997 Sun Microsystems, Inc. 8 * 9 * See the file "license.terms" for information on usage and redistribution 10 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 11 * 12 * RCS: @(#) $Id: tkUnixSelect.c,v 1.11.2.1 2005/11/22 11:32:37 dkf Exp $ 13 */ 14 15#include "tkInt.h" 16#include "tkSelect.h" 17 18typedef struct ConvertInfo { 19 int offset; /* The starting byte offset into the selection 20 * for the next chunk; -1 means all data has 21 * been transferred for this conversion. -2 22 * means only the final zero-length transfer 23 * still has to be done. Otherwise it is the 24 * offset of the next chunk of data to 25 * transfer. */ 26 Tcl_EncodingState state; /* The encoding state needed across chunks. */ 27 char buffer[TCL_UTF_MAX]; /* A buffer to hold part of a UTF character 28 * that is split across chunks.*/ 29} ConvertInfo; 30 31/* 32 * When handling INCR-style selection retrievals, the selection owner 33 * uses the following data structure to communicate between the 34 * ConvertSelection procedure and TkSelPropProc. 35 */ 36 37typedef struct IncrInfo { 38 TkWindow *winPtr; /* Window that owns selection. */ 39 Atom selection; /* Selection that is being retrieved. */ 40 Atom *multAtoms; /* Information about conversions to 41 * perform: one or more pairs of 42 * (target, property). This either 43 * points to a retrieved property (for 44 * MULTIPLE retrievals) or to a static 45 * array. */ 46 unsigned long numConversions; 47 /* Number of entries in converts (same as 48 * # of pairs in multAtoms). */ 49 ConvertInfo *converts; /* One entry for each pair in multAtoms. 50 * This array is malloc-ed. */ 51 char **tempBufs; /* One pointer for each pair in multAtoms; 52 * each pointer is either NULL, or it points 53 * to a small bit of character data that was 54 * left over from the previous chunk. */ 55 Tcl_EncodingState *state; /* One state info per pair in multAtoms: 56 * State info for encoding conversions 57 * that span multiple buffers. */ 58 int *flags; /* One state flag per pair in multAtoms: 59 * Encoding flags, set to TCL_ENCODING_START 60 * at the beginning of an INCR transfer. */ 61 int numIncrs; /* Number of entries in converts that 62 * aren't -1 (i.e. # of INCR-mode transfers 63 * not yet completed). */ 64 Tcl_TimerToken timeout; /* Token for timer procedure. */ 65 int idleTime; /* Number of seconds since we heard 66 * anything from the selection 67 * requestor. */ 68 Window reqWindow; /* Requestor's window id. */ 69 Time time; /* Timestamp corresponding to 70 * selection at beginning of request; 71 * used to abort transfer if selection 72 * changes. */ 73 struct IncrInfo *nextPtr; /* Next in list of all INCR-style 74 * retrievals currently pending. */ 75} IncrInfo; 76 77 78typedef struct ThreadSpecificData { 79 IncrInfo *pendingIncrs; /* List of all incr structures 80 * currently active. */ 81} ThreadSpecificData; 82static Tcl_ThreadDataKey dataKey; 83 84/* 85 * Largest property that we'll accept when sending or receiving the 86 * selection: 87 */ 88 89#define MAX_PROP_WORDS 100000 90 91static TkSelRetrievalInfo *pendingRetrievals = NULL; 92 /* List of all retrievals currently 93 * being waited for. */ 94 95/* 96 * Forward declarations for procedures defined in this file: 97 */ 98 99static void ConvertSelection _ANSI_ARGS_((TkWindow *winPtr, 100 XSelectionRequestEvent *eventPtr)); 101static void IncrTimeoutProc _ANSI_ARGS_((ClientData clientData)); 102static void SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues, 103 Atom type, Tk_Window tkwin, Tcl_DString *dsPtr)); 104static long * SelCvtToX _ANSI_ARGS_((char *string, Atom type, 105 Tk_Window tkwin, int *numLongsPtr)); 106static int SelectionSize _ANSI_ARGS_((TkSelHandler *selPtr)); 107static void SelRcvIncrProc _ANSI_ARGS_((ClientData clientData, 108 XEvent *eventPtr)); 109static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData)); 110 111/* 112 *---------------------------------------------------------------------- 113 * 114 * TkSelGetSelection -- 115 * 116 * Retrieve the specified selection from another process. 117 * 118 * Results: 119 * The return value is a standard Tcl return value. 120 * If an error occurs (such as no selection exists) 121 * then an error message is left in the interp's result. 122 * 123 * Side effects: 124 * None. 125 * 126 *---------------------------------------------------------------------- 127 */ 128 129int 130TkSelGetSelection(interp, tkwin, selection, target, proc, clientData) 131 Tcl_Interp *interp; /* Interpreter to use for reporting 132 * errors. */ 133 Tk_Window tkwin; /* Window on whose behalf to retrieve 134 * the selection (determines display 135 * from which to retrieve). */ 136 Atom selection; /* Selection to retrieve. */ 137 Atom target; /* Desired form in which selection 138 * is to be returned. */ 139 Tk_GetSelProc *proc; /* Procedure to call to process the 140 * selection, once it has been retrieved. */ 141 ClientData clientData; /* Arbitrary value to pass to proc. */ 142{ 143 TkSelRetrievalInfo retr; 144 TkWindow *winPtr = (TkWindow *) tkwin; 145 TkDisplay *dispPtr = winPtr->dispPtr; 146 147 /* 148 * The selection is owned by some other process. To 149 * retrieve it, first record information about the retrieval 150 * in progress. Use an internal window as the requestor. 151 */ 152 153 retr.interp = interp; 154 if (dispPtr->clipWindow == NULL) { 155 int result; 156 157 result = TkClipInit(interp, dispPtr); 158 if (result != TCL_OK) { 159 return result; 160 } 161 } 162 retr.winPtr = (TkWindow *) dispPtr->clipWindow; 163 retr.selection = selection; 164 retr.property = selection; 165 retr.target = target; 166 retr.proc = proc; 167 retr.clientData = clientData; 168 retr.result = -1; 169 retr.idleTime = 0; 170 retr.encFlags = TCL_ENCODING_START; 171 retr.nextPtr = pendingRetrievals; 172 Tcl_DStringInit(&retr.buf); 173 pendingRetrievals = &retr; 174 175 /* 176 * Initiate the request for the selection. Note: can't use 177 * TkCurrentTime for the time. If we do, and this application hasn't 178 * received any X events in a long time, the current time will be way 179 * in the past and could even predate the time when the selection was 180 * made; if this happens, the request will be rejected. 181 */ 182 183 XConvertSelection(winPtr->display, retr.selection, retr.target, 184 retr.property, retr.winPtr->window, CurrentTime); 185 186 /* 187 * Enter a loop processing X events until the selection 188 * has been retrieved and processed. If no response is 189 * received within a few seconds, then timeout. 190 */ 191 192 retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc, 193 (ClientData) &retr); 194 while (retr.result == -1) { 195 Tcl_DoOneEvent(0); 196 } 197 Tcl_DeleteTimerHandler(retr.timeout); 198 199 /* 200 * Unregister the information about the selection retrieval 201 * in progress. 202 */ 203 204 if (pendingRetrievals == &retr) { 205 pendingRetrievals = retr.nextPtr; 206 } else { 207 TkSelRetrievalInfo *retrPtr; 208 209 for (retrPtr = pendingRetrievals; retrPtr != NULL; 210 retrPtr = retrPtr->nextPtr) { 211 if (retrPtr->nextPtr == &retr) { 212 retrPtr->nextPtr = retr.nextPtr; 213 break; 214 } 215 } 216 } 217 Tcl_DStringFree(&retr.buf); 218 return retr.result; 219} 220 221/* 222 *---------------------------------------------------------------------- 223 * 224 * TkSelPropProc -- 225 * 226 * This procedure is invoked when property-change events 227 * occur on windows not known to the toolkit. Its function 228 * is to implement the sending side of the INCR selection 229 * retrieval protocol when the selection requestor deletes 230 * the property containing a part of the selection. 231 * 232 * Results: 233 * None. 234 * 235 * Side effects: 236 * If the property that is receiving the selection was just 237 * deleted, then a new piece of the selection is fetched and 238 * placed in the property, until eventually there's no more 239 * selection to fetch. 240 * 241 *---------------------------------------------------------------------- 242 */ 243 244void 245TkSelPropProc(eventPtr) 246 register XEvent *eventPtr; /* X PropertyChange event. */ 247{ 248 register IncrInfo *incrPtr; 249 register TkSelHandler *selPtr; 250 int i, length, numItems; 251 Atom target, formatType; 252 long buffer[TK_SEL_WORDS_AT_ONCE]; 253 TkDisplay *dispPtr = TkGetDisplay(eventPtr->xany.display); 254 Tk_ErrorHandler errorHandler; 255 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 256 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 257 258 /* 259 * See if this event announces the deletion of a property being 260 * used for an INCR transfer. If so, then add the next chunk of 261 * data to the property. 262 */ 263 264 if (eventPtr->xproperty.state != PropertyDelete) { 265 return; 266 } 267 for (incrPtr = tsdPtr->pendingIncrs; incrPtr != NULL; 268 incrPtr = incrPtr->nextPtr) { 269 if (incrPtr->reqWindow != eventPtr->xproperty.window) { 270 continue; 271 } 272 273 /* 274 * For each conversion that has been requested, handle any 275 * chunks that haven't been transmitted yet. 276 */ 277 278 for (i = 0; i < incrPtr->numConversions; i++) { 279 if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1]) 280 || (incrPtr->converts[i].offset == -1)) { 281 continue; 282 } 283 target = incrPtr->multAtoms[2*i]; 284 incrPtr->idleTime = 0; 285 286 /* 287 * Look for a matching selection handler. 288 */ 289 290 for (selPtr = incrPtr->winPtr->selHandlerList; ; 291 selPtr = selPtr->nextPtr) { 292 if (selPtr == NULL) { 293 /* 294 * No handlers match, so mark the conversion as done. 295 */ 296 297 incrPtr->multAtoms[2*i + 1] = None; 298 incrPtr->converts[i].offset = -1; 299 incrPtr->numIncrs --; 300 return; 301 } 302 if ((selPtr->target == target) 303 && (selPtr->selection == incrPtr->selection)) { 304 break; 305 } 306 } 307 308 /* 309 * We found a handler, so get the next chunk from it. 310 */ 311 312 formatType = selPtr->format; 313 if (incrPtr->converts[i].offset == -2) { 314 /* 315 * We already got the last chunk, so send a null chunk 316 * to indicate that we are finished. 317 */ 318 319 numItems = 0; 320 length = 0; 321 } else { 322 TkSelInProgress ip; 323 ip.selPtr = selPtr; 324 ip.nextPtr = TkSelGetInProgress(); 325 TkSelSetInProgress(&ip); 326 327 /* 328 * Copy any bytes left over from a partial character at the end 329 * of the previous chunk into the beginning of the buffer. 330 * Pass the rest of the buffer space into the selection 331 * handler. 332 */ 333 334 length = strlen(incrPtr->converts[i].buffer); 335 strcpy((char *)buffer, incrPtr->converts[i].buffer); 336 337 numItems = (*selPtr->proc)(selPtr->clientData, 338 incrPtr->converts[i].offset, 339 ((char *) buffer) + length, 340 TK_SEL_BYTES_AT_ONCE - length); 341 TkSelSetInProgress(ip.nextPtr); 342 if (ip.selPtr == NULL) { 343 /* 344 * The selection handler deleted itself. 345 */ 346 347 return; 348 } 349 if (numItems < 0) { 350 numItems = 0; 351 } 352 numItems += length; 353 if (numItems > TK_SEL_BYTES_AT_ONCE) { 354 panic("selection handler returned too many bytes"); 355 } 356 } 357 ((char *) buffer)[numItems] = 0; 358 359 errorHandler = Tk_CreateErrorHandler(eventPtr->xproperty.display, 360 -1, -1, -1, (int (*)()) NULL, (ClientData) NULL); 361 /* 362 * Encode the data using the proper format for each type. 363 */ 364 365 if ((formatType == XA_STRING) 366 || (dispPtr && formatType==dispPtr->utf8Atom) 367 || (dispPtr && formatType==dispPtr->compoundTextAtom)) { 368 Tcl_DString ds; 369 int encodingCvtFlags; 370 int srcLen, dstLen, result, srcRead, dstWrote, soFar; 371 char *src, *dst; 372 Tcl_Encoding encoding; 373 374 /* 375 * Set up the encoding state based on the format and whether 376 * this is the first and/or last chunk. 377 */ 378 379 encodingCvtFlags = 0; 380 if (incrPtr->converts[i].offset == 0) { 381 encodingCvtFlags |= TCL_ENCODING_START; 382 } 383 if (numItems < TK_SEL_BYTES_AT_ONCE) { 384 encodingCvtFlags |= TCL_ENCODING_END; 385 } 386 if (formatType == XA_STRING) { 387 encoding = Tcl_GetEncoding(NULL, "iso8859-1"); 388 } else if (dispPtr && formatType==dispPtr->utf8Atom) { 389 encoding = Tcl_GetEncoding(NULL, "utf-8"); 390 } else { 391 encoding = Tcl_GetEncoding(NULL, "iso2022"); 392 } 393 394 /* 395 * Now convert the data. 396 */ 397 398 src = (char *)buffer; 399 srcLen = numItems; 400 Tcl_DStringInit(&ds); 401 dst = Tcl_DStringValue(&ds); 402 dstLen = ds.spaceAvl - 1; 403 404 405 /* 406 * Now convert the data, growing the destination buffer 407 * as needed. 408 */ 409 410 while (1) { 411 result = Tcl_UtfToExternal(NULL, encoding, 412 src, srcLen, encodingCvtFlags, 413 &incrPtr->converts[i].state, 414 dst, dstLen, &srcRead, &dstWrote, NULL); 415 soFar = dst + dstWrote - Tcl_DStringValue(&ds); 416 encodingCvtFlags &= ~TCL_ENCODING_START; 417 src += srcRead; 418 srcLen -= srcRead; 419 if (result != TCL_CONVERT_NOSPACE) { 420 Tcl_DStringSetLength(&ds, soFar); 421 break; 422 } 423 if (Tcl_DStringLength(&ds) == 0) { 424 Tcl_DStringSetLength(&ds, dstLen); 425 } 426 Tcl_DStringSetLength(&ds, 2 * Tcl_DStringLength(&ds) + 1); 427 dst = Tcl_DStringValue(&ds) + soFar; 428 dstLen = Tcl_DStringLength(&ds) - soFar - 1; 429 } 430 Tcl_DStringSetLength(&ds, soFar); 431 432 if (encoding) { 433 Tcl_FreeEncoding(encoding); 434 } 435 436 /* 437 * Set the property to the encoded string value. 438 */ 439 440 XChangeProperty(eventPtr->xproperty.display, 441 eventPtr->xproperty.window, eventPtr->xproperty.atom, 442 formatType, 8, PropModeReplace, 443 (unsigned char *) Tcl_DStringValue(&ds), 444 Tcl_DStringLength(&ds)); 445 446 /* 447 * Preserve any left-over bytes. 448 */ 449 450 if (srcLen > TCL_UTF_MAX) { 451 panic("selection conversion left too many bytes unconverted"); 452 } 453 memcpy(incrPtr->converts[i].buffer, src, (size_t) srcLen+1); 454 Tcl_DStringFree(&ds); 455 } else { 456 /* 457 * Set the property to the encoded string value. 458 */ 459 460 char *propPtr = (char *) SelCvtToX((char *) buffer, 461 formatType, (Tk_Window) incrPtr->winPtr, 462 &numItems); 463 464 if (propPtr == NULL) { 465 numItems = 0; 466 } 467 XChangeProperty(eventPtr->xproperty.display, 468 eventPtr->xproperty.window, eventPtr->xproperty.atom, 469 formatType, 32, PropModeReplace, 470 (unsigned char *) propPtr, numItems); 471 if (propPtr != NULL) { 472 ckfree(propPtr); 473 } 474 } 475 Tk_DeleteErrorHandler(errorHandler); 476 477 /* 478 * Compute the next offset value. If this was the last chunk, 479 * then set the offset to -2. If this was an empty chunk, 480 * then set the offset to -1 to indicate we are done. 481 */ 482 483 if (numItems < TK_SEL_BYTES_AT_ONCE) { 484 if (numItems <= 0) { 485 incrPtr->converts[i].offset = -1; 486 incrPtr->numIncrs--; 487 } else { 488 incrPtr->converts[i].offset = -2; 489 } 490 } else { 491 /* 492 * Advance over the selection data that was consumed 493 * this time. 494 */ 495 496 incrPtr->converts[i].offset += numItems - length; 497 } 498 return; 499 } 500 } 501} 502 503/* 504 *-------------------------------------------------------------- 505 * 506 * TkSelEventProc -- 507 * 508 * This procedure is invoked whenever a selection-related 509 * event occurs. It does the lion's share of the work 510 * in implementing the selection protocol. 511 * 512 * Results: 513 * None. 514 * 515 * Side effects: 516 * Lots: depends on the type of event. 517 * 518 *-------------------------------------------------------------- 519 */ 520 521void 522TkSelEventProc(tkwin, eventPtr) 523 Tk_Window tkwin; /* Window for which event was 524 * targeted. */ 525 register XEvent *eventPtr; /* X event: either SelectionClear, 526 * SelectionRequest, or 527 * SelectionNotify. */ 528{ 529 register TkWindow *winPtr = (TkWindow *) tkwin; 530 TkDisplay *dispPtr = winPtr->dispPtr; 531 Tcl_Interp *interp; 532 533 /* 534 * Case #1: SelectionClear events. 535 */ 536 537 if (eventPtr->type == SelectionClear) { 538 TkSelClearSelection(tkwin, eventPtr); 539 } 540 541 /* 542 * Case #2: SelectionNotify events. Call the relevant procedure 543 * to handle the incoming selection. 544 */ 545 546 if (eventPtr->type == SelectionNotify) { 547 register TkSelRetrievalInfo *retrPtr; 548 char *propInfo; 549 Atom type; 550 int format, result; 551 unsigned long numItems, bytesAfter; 552 Tcl_DString ds; 553 554 for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) { 555 if (retrPtr == NULL) { 556 return; 557 } 558 if ((retrPtr->winPtr == winPtr) 559 && (retrPtr->selection == eventPtr->xselection.selection) 560 && (retrPtr->target == eventPtr->xselection.target) 561 && (retrPtr->result == -1)) { 562 if (retrPtr->property == eventPtr->xselection.property) { 563 break; 564 } 565 if (eventPtr->xselection.property == None) { 566 Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC); 567 Tcl_AppendResult(retrPtr->interp, 568 Tk_GetAtomName(tkwin, retrPtr->selection), 569 " selection doesn't exist or form \"", 570 Tk_GetAtomName(tkwin, retrPtr->target), 571 "\" not defined", (char *) NULL); 572 retrPtr->result = TCL_ERROR; 573 return; 574 } 575 } 576 } 577 578 propInfo = NULL; 579 result = XGetWindowProperty(eventPtr->xselection.display, 580 eventPtr->xselection.requestor, retrPtr->property, 581 0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType, 582 &type, &format, &numItems, &bytesAfter, 583 (unsigned char **) &propInfo); 584 if ((result != Success) || (type == None)) { 585 return; 586 } 587 if (bytesAfter != 0) { 588 Tcl_SetResult(retrPtr->interp, "selection property too large", 589 TCL_STATIC); 590 retrPtr->result = TCL_ERROR; 591 XFree(propInfo); 592 return; 593 } 594 if ((type == XA_STRING) || (type == dispPtr->textAtom) 595 || (type == dispPtr->compoundTextAtom)) { 596 Tcl_Encoding encoding; 597 if (format != 8) { 598 char buf[64 + TCL_INTEGER_SPACE]; 599 600 sprintf(buf, 601 "bad format for string selection: wanted \"8\", got \"%d\"", 602 format); 603 Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); 604 retrPtr->result = TCL_ERROR; 605 return; 606 } 607 interp = retrPtr->interp; 608 Tcl_Preserve((ClientData) interp); 609 610 /* 611 * Convert the X selection data into UTF before passing it 612 * to the selection callback. Note that the COMPOUND_TEXT 613 * uses a modified iso2022 encoding, not the current system 614 * encoding. For now we'll just blindly apply the iso2022 615 * encoding. This is probably wrong, but it's a placeholder 616 * until we figure out what we're really supposed to do. For 617 * STRING, we need to use Latin-1 instead. Again, it's not 618 * really the full iso8859-1 space, but this is close enough. 619 */ 620 621 if (type == dispPtr->compoundTextAtom) { 622 encoding = Tcl_GetEncoding(NULL, "iso2022"); 623 } else { 624 encoding = Tcl_GetEncoding(NULL, "iso8859-1"); 625 } 626 Tcl_ExternalToUtfDString(encoding, propInfo, (int)numItems, &ds); 627 if (encoding) { 628 Tcl_FreeEncoding(encoding); 629 } 630 631 retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, 632 interp, Tcl_DStringValue(&ds)); 633 Tcl_DStringFree(&ds); 634 Tcl_Release((ClientData) interp); 635 } else if (type == dispPtr->utf8Atom) { 636 /* 637 * The X selection data is in UTF-8 format already. 638 * We can't guarantee that propInfo is NULL-terminated, 639 * so we might have to copy the string. 640 */ 641 char *propData = propInfo; 642 643 if (format != 8) { 644 char buf[64 + TCL_INTEGER_SPACE]; 645 646 sprintf(buf, 647 "bad format for string selection: wanted \"8\", got \"%d\"", 648 format); 649 Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); 650 retrPtr->result = TCL_ERROR; 651 return; 652 } 653 654 if (propInfo[numItems] != '\0') { 655 propData = ckalloc((size_t) numItems + 1); 656 strcpy(propData, propInfo); 657 propData[numItems] = '\0'; 658 } 659 retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, 660 retrPtr->interp, propData); 661 if (propData != propInfo) { 662 ckfree((char *) propData); 663 } 664 } else if (type == dispPtr->incrAtom) { 665 666 /* 667 * It's a !?#@!?!! INCR-style reception. Arrange to receive 668 * the selection in pieces, using the ICCCM protocol, then 669 * hang around until either the selection is all here or a 670 * timeout occurs. 671 */ 672 673 retrPtr->idleTime = 0; 674 Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc, 675 (ClientData) retrPtr); 676 XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin), 677 retrPtr->property); 678 while (retrPtr->result == -1) { 679 Tcl_DoOneEvent(0); 680 } 681 Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc, 682 (ClientData) retrPtr); 683 } else { 684 Tcl_DString ds; 685 686 if (format != 32) { 687 char buf[64 + TCL_INTEGER_SPACE]; 688 689 sprintf(buf, 690 "bad format for selection: wanted \"32\", got \"%d\"", 691 format); 692 Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); 693 retrPtr->result = TCL_ERROR; 694 return; 695 } 696 Tcl_DStringInit(&ds); 697 SelCvtFromX((long *) propInfo, (int) numItems, type, 698 (Tk_Window) winPtr, &ds); 699 interp = retrPtr->interp; 700 Tcl_Preserve((ClientData) interp); 701 retrPtr->result = (*retrPtr->proc)(retrPtr->clientData, 702 interp, Tcl_DStringValue(&ds)); 703 Tcl_Release((ClientData) interp); 704 Tcl_DStringFree(&ds); 705 } 706 XFree(propInfo); 707 return; 708 } 709 710 /* 711 * Case #3: SelectionRequest events. Call ConvertSelection to 712 * do the dirty work. 713 */ 714 715 if (eventPtr->type == SelectionRequest) { 716 ConvertSelection(winPtr, &eventPtr->xselectionrequest); 717 return; 718 } 719} 720 721/* 722 *---------------------------------------------------------------------- 723 * 724 * SelTimeoutProc -- 725 * 726 * This procedure is invoked once every second while waiting for 727 * the selection to be returned. After a while it gives up and 728 * aborts the selection retrieval. 729 * 730 * Results: 731 * None. 732 * 733 * Side effects: 734 * A new timer callback is created to call us again in another 735 * second, unless time has expired, in which case an error is 736 * recorded for the retrieval. 737 * 738 *---------------------------------------------------------------------- 739 */ 740 741static void 742SelTimeoutProc(clientData) 743 ClientData clientData; /* Information about retrieval 744 * in progress. */ 745{ 746 register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; 747 748 /* 749 * Make sure that the retrieval is still in progress. Then 750 * see how long it's been since any sort of response was received 751 * from the other side. 752 */ 753 754 if (retrPtr->result != -1) { 755 return; 756 } 757 retrPtr->idleTime++; 758 if (retrPtr->idleTime >= 5) { 759 760 /* 761 * Use a careful procedure to store the error message, because 762 * the result could already be partially filled in with a partial 763 * selection return. 764 */ 765 766 Tcl_SetResult(retrPtr->interp, "selection owner didn't respond", 767 TCL_STATIC); 768 retrPtr->result = TCL_ERROR; 769 } else { 770 retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc, 771 (ClientData) retrPtr); 772 } 773} 774 775/* 776 *---------------------------------------------------------------------- 777 * 778 * ConvertSelection -- 779 * 780 * This procedure is invoked to handle SelectionRequest events. 781 * It responds to the requests, obeying the ICCCM protocols. 782 * 783 * Results: 784 * None. 785 * 786 * Side effects: 787 * Properties are created for the selection requestor, and a 788 * SelectionNotify event is generated for the selection 789 * requestor. In the event of long selections, this procedure 790 * implements INCR-mode transfers, using the ICCCM protocol. 791 * 792 *---------------------------------------------------------------------- 793 */ 794 795static void 796ConvertSelection(winPtr, eventPtr) 797 TkWindow *winPtr; /* Window that received the 798 * conversion request; may not be 799 * selection's current owner, be we 800 * set it to the current owner. */ 801 register XSelectionRequestEvent *eventPtr; 802 /* Event describing request. */ 803{ 804 XSelectionEvent reply; /* Used to notify requestor that 805 * selection info is ready. */ 806 int multiple; /* Non-zero means a MULTIPLE request 807 * is being handled. */ 808 IncrInfo incr; /* State of selection conversion. */ 809 Atom singleInfo[2]; /* incr.multAtoms points here except 810 * for multiple conversions. */ 811 int i; 812 Tk_ErrorHandler errorHandler; 813 TkSelectionInfo *infoPtr; 814 TkSelInProgress ip; 815 ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 816 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); 817 818 errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1, 819 (int (*)()) NULL, (ClientData) NULL); 820 821 /* 822 * Initialize the reply event. 823 */ 824 825 reply.type = SelectionNotify; 826 reply.serial = 0; 827 reply.send_event = True; 828 reply.display = eventPtr->display; 829 reply.requestor = eventPtr->requestor; 830 reply.selection = eventPtr->selection; 831 reply.target = eventPtr->target; 832 reply.property = eventPtr->property; 833 if (reply.property == None) { 834 reply.property = reply.target; 835 } 836 reply.time = eventPtr->time; 837 838 for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL; 839 infoPtr = infoPtr->nextPtr) { 840 if (infoPtr->selection == eventPtr->selection) 841 break; 842 } 843 if (infoPtr == NULL) { 844 goto refuse; 845 } 846 winPtr = (TkWindow *) infoPtr->owner; 847 848 /* 849 * Figure out which kind(s) of conversion to perform. If handling 850 * a MULTIPLE conversion, then read the property describing which 851 * conversions to perform. 852 */ 853 854 incr.winPtr = winPtr; 855 incr.selection = eventPtr->selection; 856 if (eventPtr->target != winPtr->dispPtr->multipleAtom) { 857 multiple = 0; 858 singleInfo[0] = reply.target; 859 singleInfo[1] = reply.property; 860 incr.multAtoms = singleInfo; 861 incr.numConversions = 1; 862 } else { 863 Atom type; 864 int format, result; 865 unsigned long bytesAfter; 866 867 multiple = 1; 868 incr.multAtoms = NULL; 869 if (eventPtr->property == None) { 870 goto refuse; 871 } 872 result = XGetWindowProperty(eventPtr->display, 873 eventPtr->requestor, eventPtr->property, 874 0, MAX_PROP_WORDS, False, XA_ATOM, 875 &type, &format, &incr.numConversions, &bytesAfter, 876 (unsigned char **) &incr.multAtoms); 877 if ((result != Success) || (bytesAfter != 0) || (format != 32) 878 || (type == None)) { 879 if (incr.multAtoms != NULL) { 880 XFree((char *) incr.multAtoms); 881 } 882 goto refuse; 883 } 884 incr.numConversions /= 2; /* Two atoms per conversion. */ 885 } 886 887 /* 888 * Loop through all of the requested conversions, and either return 889 * the entire converted selection, if it can be returned in a single 890 * bunch, or return INCR information only (the actual selection will 891 * be returned below). 892 */ 893 894 incr.converts = (ConvertInfo *) ckalloc((unsigned) 895 (incr.numConversions*sizeof(ConvertInfo))); 896 incr.numIncrs = 0; 897 for (i = 0; i < incr.numConversions; i++) { 898 Atom target, property, type; 899 long buffer[TK_SEL_WORDS_AT_ONCE]; 900 register TkSelHandler *selPtr; 901 int numItems, format; 902 char *propPtr; 903 904 target = incr.multAtoms[2*i]; 905 property = incr.multAtoms[2*i + 1]; 906 incr.converts[i].offset = -1; 907 incr.converts[i].buffer[0] = '\0'; 908 909 for (selPtr = winPtr->selHandlerList; selPtr != NULL; 910 selPtr = selPtr->nextPtr) { 911 if ((selPtr->target == target) 912 && (selPtr->selection == eventPtr->selection)) { 913 break; 914 } 915 } 916 917 if (selPtr == NULL) { 918 /* 919 * Nobody seems to know about this kind of request. If 920 * it's of a sort that we can handle without any help, do 921 * it. Otherwise mark the request as an errror. 922 */ 923 924 numItems = TkSelDefaultSelection(infoPtr, target, (char *) buffer, 925 TK_SEL_BYTES_AT_ONCE, &type); 926 if (numItems < 0) { 927 incr.multAtoms[2*i + 1] = None; 928 continue; 929 } 930 } else { 931 ip.selPtr = selPtr; 932 ip.nextPtr = TkSelGetInProgress(); 933 TkSelSetInProgress(&ip); 934 type = selPtr->format; 935 numItems = (*selPtr->proc)(selPtr->clientData, 0, 936 (char *) buffer, TK_SEL_BYTES_AT_ONCE); 937 TkSelSetInProgress(ip.nextPtr); 938 if ((ip.selPtr == NULL) || (numItems < 0)) { 939 incr.multAtoms[2*i + 1] = None; 940 continue; 941 } 942 if (numItems > TK_SEL_BYTES_AT_ONCE) { 943 panic("selection handler returned too many bytes"); 944 } 945 ((char *) buffer)[numItems] = '\0'; 946 } 947 948 /* 949 * Got the selection; store it back on the requestor's property. 950 */ 951 952 if (numItems == TK_SEL_BYTES_AT_ONCE) { 953 /* 954 * Selection is too big to send at once; start an 955 * INCR-mode transfer. 956 */ 957 958 incr.numIncrs++; 959 type = winPtr->dispPtr->incrAtom; 960 buffer[0] = SelectionSize(selPtr); 961 if (buffer[0] == 0) { 962 incr.multAtoms[2*i + 1] = None; 963 continue; 964 } 965 numItems = 1; 966 propPtr = (char *) buffer; 967 format = 32; 968 incr.converts[i].offset = 0; 969 XChangeProperty(reply.display, reply.requestor, 970 property, type, format, PropModeReplace, 971 (unsigned char *) propPtr, numItems); 972 } else if (type == winPtr->dispPtr->utf8Atom) { 973 /* 974 * This matches selection requests of type UTF8_STRING, 975 * which allows us to pass our utf-8 information untouched. 976 */ 977 978 XChangeProperty(reply.display, reply.requestor, 979 property, type, 8, PropModeReplace, 980 (unsigned char *) buffer, numItems); 981 } else if ((type == XA_STRING) 982 || (type == winPtr->dispPtr->compoundTextAtom)) { 983 Tcl_DString ds; 984 Tcl_Encoding encoding; 985 986 /* 987 * STRING is Latin-1, COMPOUND_TEXT is an iso2022 variant. 988 * We need to convert the selection text into these external 989 * forms before modifying the property. 990 */ 991 992 if (type == XA_STRING) { 993 encoding = Tcl_GetEncoding(NULL, "iso8859-1"); 994 } else { 995 encoding = Tcl_GetEncoding(NULL, "iso2022"); 996 } 997 Tcl_UtfToExternalDString(encoding, (char*)buffer, -1, &ds); 998 XChangeProperty(reply.display, reply.requestor, 999 property, type, 8, PropModeReplace, 1000 (unsigned char *) Tcl_DStringValue(&ds), 1001 Tcl_DStringLength(&ds)); 1002 if (encoding) { 1003 Tcl_FreeEncoding(encoding); 1004 } 1005 Tcl_DStringFree(&ds); 1006 } else { 1007 propPtr = (char *) SelCvtToX((char *) buffer, 1008 type, (Tk_Window) winPtr, &numItems); 1009 if (propPtr == NULL) { 1010 goto refuse; 1011 } 1012 format = 32; 1013 XChangeProperty(reply.display, reply.requestor, 1014 property, type, format, PropModeReplace, 1015 (unsigned char *) propPtr, numItems); 1016 ckfree(propPtr); 1017 } 1018 } 1019 1020 /* 1021 * Send an event back to the requestor to indicate that the 1022 * first stage of conversion is complete (everything is done 1023 * except for long conversions that have to be done in INCR 1024 * mode). 1025 */ 1026 1027 if (incr.numIncrs > 0) { 1028 XSelectInput(reply.display, reply.requestor, PropertyChangeMask); 1029 incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, 1030 (ClientData) &incr); 1031 incr.idleTime = 0; 1032 incr.reqWindow = reply.requestor; 1033 incr.time = infoPtr->time; 1034 incr.nextPtr = tsdPtr->pendingIncrs; 1035 tsdPtr->pendingIncrs = &incr; 1036 } 1037 if (multiple) { 1038 XChangeProperty(reply.display, reply.requestor, reply.property, 1039 XA_ATOM, 32, PropModeReplace, 1040 (unsigned char *) incr.multAtoms, 1041 (int) incr.numConversions*2); 1042 } else { 1043 1044 /* 1045 * Not a MULTIPLE request. The first property in "multAtoms" 1046 * got set to None if there was an error in conversion. 1047 */ 1048 1049 reply.property = incr.multAtoms[1]; 1050 } 1051 XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply); 1052 Tk_DeleteErrorHandler(errorHandler); 1053 1054 /* 1055 * Handle any remaining INCR-mode transfers. This all happens 1056 * in callbacks to TkSelPropProc, so just wait until the number 1057 * of uncompleted INCR transfers drops to zero. 1058 */ 1059 1060 if (incr.numIncrs > 0) { 1061 IncrInfo *incrPtr2; 1062 1063 while (incr.numIncrs > 0) { 1064 Tcl_DoOneEvent(0); 1065 } 1066 Tcl_DeleteTimerHandler(incr.timeout); 1067 errorHandler = Tk_CreateErrorHandler(winPtr->display, 1068 -1, -1,-1, (int (*)()) NULL, (ClientData) NULL); 1069 XSelectInput(reply.display, reply.requestor, 0L); 1070 Tk_DeleteErrorHandler(errorHandler); 1071 if (tsdPtr->pendingIncrs == &incr) { 1072 tsdPtr->pendingIncrs = incr.nextPtr; 1073 } else { 1074 for (incrPtr2 = tsdPtr->pendingIncrs; incrPtr2 != NULL; 1075 incrPtr2 = incrPtr2->nextPtr) { 1076 if (incrPtr2->nextPtr == &incr) { 1077 incrPtr2->nextPtr = incr.nextPtr; 1078 break; 1079 } 1080 } 1081 } 1082 } 1083 1084 /* 1085 * All done. Cleanup and return. 1086 */ 1087 1088 ckfree((char *) incr.converts); 1089 if (multiple) { 1090 XFree((char *) incr.multAtoms); 1091 } 1092 return; 1093 1094 /* 1095 * An error occurred. Send back a refusal message. 1096 */ 1097 1098 refuse: 1099 reply.property = None; 1100 XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply); 1101 Tk_DeleteErrorHandler(errorHandler); 1102 return; 1103} 1104 1105/* 1106 *---------------------------------------------------------------------- 1107 * 1108 * SelRcvIncrProc -- 1109 * 1110 * This procedure handles the INCR protocol on the receiving 1111 * side. It is invoked in response to property changes on 1112 * the requestor's window (which hopefully are because a new 1113 * chunk of the selection arrived). 1114 * 1115 * Results: 1116 * None. 1117 * 1118 * Side effects: 1119 * If a new piece of selection has arrived, a procedure is 1120 * invoked to deal with that piece. When the whole selection 1121 * is here, a flag is left for the higher-level procedure that 1122 * initiated the selection retrieval. 1123 * 1124 *---------------------------------------------------------------------- 1125 */ 1126 1127static void 1128SelRcvIncrProc(clientData, eventPtr) 1129 ClientData clientData; /* Information about retrieval. */ 1130 register XEvent *eventPtr; /* X PropertyChange event. */ 1131{ 1132 register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData; 1133 char *propInfo; 1134 Atom type; 1135 int format, result; 1136 unsigned long numItems, bytesAfter; 1137 Tcl_Interp *interp; 1138 1139 if ((eventPtr->xproperty.atom != retrPtr->property) 1140 || (eventPtr->xproperty.state != PropertyNewValue) 1141 || (retrPtr->result != -1)) { 1142 return; 1143 } 1144 propInfo = NULL; 1145 result = XGetWindowProperty(eventPtr->xproperty.display, 1146 eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS, 1147 True, (Atom) AnyPropertyType, &type, &format, &numItems, 1148 &bytesAfter, (unsigned char **) &propInfo); 1149 if ((result != Success) || (type == None)) { 1150 return; 1151 } 1152 if (bytesAfter != 0) { 1153 Tcl_SetResult(retrPtr->interp, "selection property too large", 1154 TCL_STATIC); 1155 retrPtr->result = TCL_ERROR; 1156 goto done; 1157 } 1158 if ((type == XA_STRING) 1159 || (type == retrPtr->winPtr->dispPtr->textAtom) 1160 || (type == retrPtr->winPtr->dispPtr->utf8Atom) 1161 || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) { 1162 char *dst, *src; 1163 int srcLen, dstLen, srcRead, dstWrote, soFar; 1164 Tcl_Encoding encoding; 1165 Tcl_DString *dstPtr, temp; 1166 1167 if (format != 8) { 1168 char buf[64 + TCL_INTEGER_SPACE]; 1169 1170 sprintf(buf, 1171 "bad format for string selection: wanted \"8\", got \"%d\"", 1172 format); 1173 Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); 1174 retrPtr->result = TCL_ERROR; 1175 goto done; 1176 } 1177 interp = retrPtr->interp; 1178 Tcl_Preserve((ClientData) interp); 1179 1180 if (type == retrPtr->winPtr->dispPtr->compoundTextAtom) { 1181 encoding = Tcl_GetEncoding(NULL, "iso2022"); 1182 } else if (type == retrPtr->winPtr->dispPtr->utf8Atom) { 1183 encoding = Tcl_GetEncoding(NULL, "utf-8"); 1184 } else { 1185 encoding = Tcl_GetEncoding(NULL, "iso8859-1"); 1186 } 1187 1188 /* 1189 * Check to see if there is any data left over from the previous 1190 * chunk. If there is, copy the old data and the new data into 1191 * a new buffer. 1192 */ 1193 1194 Tcl_DStringInit(&temp); 1195 if (Tcl_DStringLength(&retrPtr->buf) > 0) { 1196 Tcl_DStringAppend(&temp, Tcl_DStringValue(&retrPtr->buf), 1197 Tcl_DStringLength(&retrPtr->buf)); 1198 if (numItems > 0) { 1199 Tcl_DStringAppend(&temp, propInfo, (int)numItems); 1200 } 1201 src = Tcl_DStringValue(&temp); 1202 srcLen = Tcl_DStringLength(&temp); 1203 } else if (numItems == 0) { 1204 /* 1205 * There is no new data, so we're done. 1206 */ 1207 1208 retrPtr->result = TCL_OK; 1209 Tcl_Release((ClientData) interp); 1210 goto done; 1211 } else { 1212 src = propInfo; 1213 srcLen = numItems; 1214 } 1215 1216 /* 1217 * Set up the destination buffer so we can use as much space as 1218 * is available. 1219 */ 1220 1221 dstPtr = &retrPtr->buf; 1222 dst = Tcl_DStringValue(dstPtr); 1223 dstLen = dstPtr->spaceAvl - 1; 1224 1225 /* 1226 * Now convert the data, growing the destination buffer as needed. 1227 */ 1228 1229 while (1) { 1230 result = Tcl_ExternalToUtf(NULL, encoding, src, srcLen, 1231 retrPtr->encFlags, &retrPtr->encState, 1232 dst, dstLen, &srcRead, &dstWrote, NULL); 1233 soFar = dst + dstWrote - Tcl_DStringValue(dstPtr); 1234 retrPtr->encFlags &= ~TCL_ENCODING_START; 1235 src += srcRead; 1236 srcLen -= srcRead; 1237 if (result != TCL_CONVERT_NOSPACE) { 1238 Tcl_DStringSetLength(dstPtr, soFar); 1239 break; 1240 } 1241 if (Tcl_DStringLength(dstPtr) == 0) { 1242 Tcl_DStringSetLength(dstPtr, dstLen); 1243 } 1244 Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1); 1245 dst = Tcl_DStringValue(dstPtr) + soFar; 1246 dstLen = Tcl_DStringLength(dstPtr) - soFar - 1; 1247 } 1248 Tcl_DStringSetLength(dstPtr, soFar); 1249 1250 result = (*retrPtr->proc)(retrPtr->clientData, interp, 1251 Tcl_DStringValue(dstPtr)); 1252 Tcl_Release((ClientData) interp); 1253 1254 /* 1255 * Copy any unused data into the destination buffer so we can 1256 * pick it up next time around. 1257 */ 1258 1259 Tcl_DStringSetLength(dstPtr, 0); 1260 Tcl_DStringAppend(dstPtr, src, srcLen); 1261 1262 Tcl_DStringFree(&temp); 1263 if (encoding) { 1264 Tcl_FreeEncoding(encoding); 1265 } 1266 if (result != TCL_OK) { 1267 retrPtr->result = result; 1268 } 1269 } else if (numItems == 0) { 1270 retrPtr->result = TCL_OK; 1271 } else { 1272 Tcl_DString ds; 1273 1274 if (format != 32) { 1275 char buf[64 + TCL_INTEGER_SPACE]; 1276 1277 sprintf(buf, 1278 "bad format for selection: wanted \"32\", got \"%d\"", 1279 format); 1280 Tcl_SetResult(retrPtr->interp, buf, TCL_VOLATILE); 1281 retrPtr->result = TCL_ERROR; 1282 goto done; 1283 } 1284 Tcl_DStringInit(&ds); 1285 SelCvtFromX((long *) propInfo, (int) numItems, type, 1286 (Tk_Window) retrPtr->winPtr, &ds); 1287 interp = retrPtr->interp; 1288 Tcl_Preserve((ClientData) interp); 1289 result = (*retrPtr->proc)(retrPtr->clientData, interp, 1290 Tcl_DStringValue(&ds)); 1291 Tcl_Release((ClientData) interp); 1292 Tcl_DStringFree(&ds); 1293 if (result != TCL_OK) { 1294 retrPtr->result = result; 1295 } 1296 } 1297 1298 done: 1299 XFree(propInfo); 1300 retrPtr->idleTime = 0; 1301} 1302 1303/* 1304 *---------------------------------------------------------------------- 1305 * 1306 * SelectionSize -- 1307 * 1308 * This procedure is called when the selection is too large to 1309 * send in a single buffer; it computes the total length of 1310 * the selection in bytes. 1311 * 1312 * Results: 1313 * The return value is the number of bytes in the selection 1314 * given by selPtr. 1315 * 1316 * Side effects: 1317 * The selection is retrieved from its current owner (this is 1318 * the only way to compute its size). 1319 * 1320 *---------------------------------------------------------------------- 1321 */ 1322 1323static int 1324SelectionSize(selPtr) 1325 TkSelHandler *selPtr; /* Information about how to retrieve 1326 * the selection whose size is wanted. */ 1327{ 1328 char buffer[TK_SEL_BYTES_AT_ONCE+1]; 1329 int size, chunkSize; 1330 TkSelInProgress ip; 1331 1332 size = TK_SEL_BYTES_AT_ONCE; 1333 ip.selPtr = selPtr; 1334 ip.nextPtr = TkSelGetInProgress(); 1335 TkSelSetInProgress(&ip); 1336 do { 1337 chunkSize = (*selPtr->proc)(selPtr->clientData, size, 1338 (char *) buffer, TK_SEL_BYTES_AT_ONCE); 1339 if (ip.selPtr == NULL) { 1340 size = 0; 1341 break; 1342 } 1343 size += chunkSize; 1344 } while (chunkSize == TK_SEL_BYTES_AT_ONCE); 1345 TkSelSetInProgress(ip.nextPtr); 1346 return size; 1347} 1348 1349/* 1350 *---------------------------------------------------------------------- 1351 * 1352 * IncrTimeoutProc -- 1353 * 1354 * This procedure is invoked once a second while sending the 1355 * selection to a requestor in INCR mode. After a while it 1356 * gives up and aborts the selection operation. 1357 * 1358 * Results: 1359 * None. 1360 * 1361 * Side effects: 1362 * A new timeout gets registered so that this procedure gets 1363 * called again in another second, unless too many seconds 1364 * have elapsed, in which case incrPtr is marked as "all done". 1365 * 1366 *---------------------------------------------------------------------- 1367 */ 1368 1369static void 1370IncrTimeoutProc(clientData) 1371 ClientData clientData; /* Information about INCR-mode 1372 * selection retrieval for which 1373 * we are selection owner. */ 1374{ 1375 register IncrInfo *incrPtr = (IncrInfo *) clientData; 1376 1377 incrPtr->idleTime++; 1378 if (incrPtr->idleTime >= 5) { 1379 incrPtr->numIncrs = 0; 1380 } else { 1381 incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, 1382 (ClientData) incrPtr); 1383 } 1384} 1385 1386/* 1387 *---------------------------------------------------------------------- 1388 * 1389 * SelCvtToX -- 1390 * 1391 * Given a selection represented as a string (the normal Tcl form), 1392 * convert it to the ICCCM-mandated format for X, depending on 1393 * the type argument. This procedure and SelCvtFromX are inverses. 1394 * 1395 * Results: 1396 * The return value is a malloc'ed buffer holding a value 1397 * equivalent to "string", but formatted as for "type". It is 1398 * the caller's responsibility to free the string when done with 1399 * it. The word at *numLongsPtr is filled in with the number of 1400 * 32-bit words returned in the result. 1401 * 1402 * Side effects: 1403 * None. 1404 * 1405 *---------------------------------------------------------------------- 1406 */ 1407 1408static long * 1409SelCvtToX(string, type, tkwin, numLongsPtr) 1410 char *string; /* String representation of selection. */ 1411 Atom type; /* Atom specifying the X format that is 1412 * desired for the selection. Should not 1413 * be XA_STRING (if so, don't bother calling 1414 * this procedure at all). */ 1415 Tk_Window tkwin; /* Window that governs atom conversion. */ 1416 int *numLongsPtr; /* Number of 32-bit words contained in the 1417 * result. */ 1418{ 1419 const char **field; 1420 int numFields, i; 1421 long *propPtr; 1422 1423 /* 1424 * The string is assumed to consist of fields separated by spaces. The 1425 * property gets generated by converting each field to an integer number, 1426 * in one of two ways: 1427 * 1. If type is XA_ATOM, convert each field to its corresponding atom. 1428 * 2. If type is anything else, convert each field from an ASCII number to 1429 * a 32-bit binary number. 1430 */ 1431 1432 if (Tcl_SplitList(NULL, string, &numFields, &field) != TCL_OK) { 1433 return NULL; 1434 } 1435 propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long)); 1436 1437 /* 1438 * Convert the fields one-by-one. 1439 */ 1440 1441 for (i=0 ; i<numFields ; i++) { 1442 if (type == XA_ATOM) { 1443 propPtr[i] = (long) Tk_InternAtom(tkwin, field[i]); 1444 } else { 1445 char *dummy; 1446 1447 /* 1448 * If this fails to parse a number, we just plunge on regardless 1449 * anyway. 1450 */ 1451 1452 propPtr[i] = strtol(field[i], &dummy, 0); 1453 } 1454 } 1455 1456 /* 1457 * Release the parsed list. 1458 */ 1459 1460 ckfree((char *) field); 1461 *numLongsPtr = i; 1462 return propPtr; 1463} 1464 1465/* 1466 *---------------------------------------------------------------------- 1467 * 1468 * SelCvtFromX -- 1469 * 1470 * Given an X property value, formatted as a collection of 32-bit 1471 * values according to "type" and the ICCCM conventions, convert 1472 * the value to a string suitable for manipulation by Tcl. This 1473 * procedure is the inverse of SelCvtToX. 1474 * 1475 * Results: 1476 * The return value (stored in a Tcl_DString) is the string equivalent of 1477 * "property". It is up to the caller to initialize and free the DString. 1478 * 1479 * Side effects: 1480 * None. 1481 * 1482 *---------------------------------------------------------------------- 1483 */ 1484 1485static void 1486SelCvtFromX(propPtr, numValues, type, tkwin, dsPtr) 1487 register long *propPtr; /* Property value from X. */ 1488 int numValues; /* Number of 32-bit values in property. */ 1489 Atom type; /* Type of property Should not be 1490 * XA_STRING (if so, don't bother calling 1491 * this procedure at all). */ 1492 Tk_Window tkwin; /* Window to use for atom conversion. */ 1493 Tcl_DString *dsPtr; /* Where to store the converted string. */ 1494{ 1495 /* 1496 * Convert each long in the property to a string value, which is either 1497 * the name of an atom (if type is XA_ATOM) or a hexadecimal string. We 1498 * build the list in a Tcl_DString because this is easier than trying to 1499 * get the quoting correct ourselves; this is tricky because atoms can 1500 * contain spaces in their names (encountered when the atoms are really 1501 * MIME types). [Bug 1353414] 1502 */ 1503 1504 for ( ; numValues > 0; propPtr++, numValues--) { 1505 if (type == XA_ATOM) { 1506 Tcl_DStringAppendElement(dsPtr, 1507 Tk_GetAtomName(tkwin, (Atom) *propPtr)); 1508 } else { 1509 char buf[12]; 1510 1511 sprintf(buf, "0x%x", (unsigned int) *propPtr); 1512 Tcl_DStringAppendElement(dsPtr, buf); 1513 } 1514 } 1515} 1516