![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tkselect.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / src / tk|
Return to tkselect.c CVS log | Up to [Micropolis - Activity] / micropolis / src / tk |
1.1 root 1: /*
2: * tkSelect.c --
3: *
4: * This file manages the selection for the Tk toolkit,
5: * translating between the standard X ICCCM conventions
6: * and Tcl commands.
7: *
8: * Copyright 1990 Regents of the University of California.
9: * Permission to use, copy, modify, and distribute this
10: * software and its documentation for any purpose and without
11: * fee is hereby granted, provided that the above copyright
12: * notice appear in all copies. The University of California
13: * makes no representations about the suitability of this
14: * software for any purpose. It is provided "as is" without
15: * express or implied warranty.
16: */
17:
18: #ifndef lint
19: static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkSelect.c,v 1.27 92/08/10 15:03:03 ouster Exp $ SPRITE (Berkeley)";
20: #endif
21:
22: #include "tkconfig.h"
23: #include "tkint.h"
24:
25: /*
26: * When the selection is being retrieved, one of the following
27: * structures is present on a list of pending selection retrievals.
28: * The structure is used to communicate between the background
29: * procedure that requests the selection and the foreground
30: * event handler that processes the events in which the selection
31: * is returned. There is a list of such structures so that there
32: * can be multiple simultaneous selection retrievals (e.g. on
33: * different displays).
34: */
35:
36: typedef struct RetrievalInfo {
37: Tcl_Interp *interp; /* Interpreter for error reporting. */
38: TkWindow *winPtr; /* Window used as requestor for
39: * selection. */
40: Atom property; /* Property where selection will appear. */
41: Atom target; /* Desired form for selection. */
42: int (*proc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
43: char *portion)); /* Procedure to call to handle pieces
44: * of selection. */
45: ClientData clientData; /* Argument for proc. */
46: int result; /* Initially -1. Set to a Tcl
47: * return value once the selection
48: * has been retrieved. */
49: Tk_TimerToken timeout; /* Token for current timeout procedure. */
50: int idleTime; /* Number of seconds that have gone by
51: * without hearing anything from the
52: * selection owner. */
53: struct RetrievalInfo *nextPtr;
54: /* Next in list of all pending
55: * selection retrievals. NULL means
56: * end of list. */
57: } RetrievalInfo;
58:
59: static RetrievalInfo *pendingRetrievals = NULL;
60: /* List of all retrievals currently
61: * being waited for. */
62:
63: /*
64: * When "selection get" is being used to retrieve the selection,
65: * the following data structure is used for communication between
66: * Tk_SelectionCmd and SelGetProc. Its purpose is to keep track
67: * of the selection contents, which are gradually assembled in a
68: * string.
69: */
70:
71: typedef struct {
72: char *string; /* Contents of selection are
73: * here. This space is malloc-ed. */
74: int bytesAvl; /* Total number of bytes available
75: * at string. */
76: int bytesUsed; /* Bytes currently in use in string,
77: * not including the terminating
78: * NULL. */
79: } GetInfo;
80:
81: /*
82: * When handling INCR-style selection retrievals, the selection owner
83: * uses the following data structure to communicate between the
84: * ConvertSelection procedure and TkSelPropProc.
85: */
86:
87: typedef struct IncrInfo {
88: TkWindow *winPtr; /* Window that owns selection. */
89: Atom *multAtoms; /* Information about conversions to
90: * perform: one or more pairs of
91: * (target, property). This either
92: * points to a retrieved property (for
93: * MULTIPLE retrievals) or to a static
94: * array. */
95: unsigned long numConversions;
96: /* Number of entries in offsets (same as
97: * # of pairs in multAtoms). */
98: int *offsets; /* One entry for each pair in
99: * multAtoms; -1 means all data has
100: * been transferred for this
101: * conversion. -2 means only the
102: * final zero-length transfer still
103: * has to be done. Otherwise it is the
104: * offset of the next chunk of data
105: * to transfer. This array is malloc-ed. */
106: int numIncrs; /* Number of entries in offsets that
107: * aren't -1 (i.e. # of INCR-mode transfers
108: * not yet completed). */
109: Tk_TimerToken timeout; /* Token for timer procedure. */
110: int idleTime; /* Number of seconds since we heard
111: * anything from the selection
112: * requestor. */
113: Window reqWindow; /* Requestor's window id. */
114: Time time; /* Timestamp corresponding to
115: * selection at beginning of request;
116: * used to abort transfer if selection
117: * changes. */
118: struct IncrInfo *nextPtr; /* Next in list of all INCR-style
119: * retrievals currently pending. */
120: } IncrInfo;
121:
122: static IncrInfo *pendingIncrs = NULL;
123: /* List of all IncrInfo structures
124: * currently active. */
125:
126: /*
127: * When a selection handler is set up by invoking "selection handle",
128: * one of the following data structures is set up to hold information
129: * about the command to invoke and its interpreter.
130: */
131:
132: typedef struct {
133: Tcl_Interp *interp; /* Interpreter in which to invoke command. */
134: int cmdLength; /* # of non-NULL bytes in command. */
135: char command[4]; /* Command to invoke. Actual space is
136: * allocated as large as necessary. This
137: * must be the last entry in the structure. */
138: } CommandInfo;
139:
140: /*
141: * Chunk size for retrieving selection. It's defined both in
142: * words and in bytes; the word size is used to allocate
143: * buffer space that's guaranteed to be word-aligned and that
144: * has an extra character for the terminating NULL.
145: */
146:
147: #define TK_SEL_BYTES_AT_ONCE 4000
148: #define TK_SEL_WORDS_AT_ONCE 1001
149:
150: /*
151: * Largest property that we'll accept when sending or receiving the
152: * selection:
153: */
154:
155: #define MAX_PROP_WORDS 100000
156:
157: /*
158: * Forward declarations for procedures defined in this file:
159: */
160:
161: static void ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
162: XSelectionRequestEvent *eventPtr));
163: static int DefaultSelection _ANSI_ARGS_((TkWindow *winPtr,
164: Atom target, char *buffer, int maxBytes,
165: Atom *typePtr));
166: static int HandleTclCommand _ANSI_ARGS_((ClientData clientData,
167: int offset, char *buffer, int maxBytes));
168: static void IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
169: static char * SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
170: Atom type, Tk_Window tkwin));
171: static long * SelCvtToX _ANSI_ARGS_((char *string, Atom type,
172: Tk_Window tkwin, int *numLongsPtr));
173: static int SelGetProc _ANSI_ARGS_((ClientData clientData,
174: Tcl_Interp *interp, char *portion));
175: static void SelInit _ANSI_ARGS_((Tk_Window tkwin));
176: static void SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
177: XEvent *eventPtr));
178: static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
179:
180: /*
181: *--------------------------------------------------------------
182: *
183: * Tk_CreateSelHandler --
184: *
185: * This procedure is called to register a procedure
186: * as the handler for selection requests of a particular
187: * target type on a particular window.
188: *
189: * Results:
190: * None.
191: *
192: * Side effects:
193: * In the future, whenever the selection is in tkwin's
194: * window and someone requests the selection in the
195: * form given by target, proc will be invoked to provide
196: * part or all of the selection in the given form. If
197: * there was already a handler declared for the given
198: * window and target type, then it is replaced. Proc
199: * should have the following form:
200: *
201: * int
202: * proc(clientData, offset, buffer, maxBytes)
203: * ClientData clientData;
204: * int offset;
205: * char *buffer;
206: * int maxBytes;
207: * {
208: * }
209: *
210: * The clientData argument to proc will be the same as
211: * the clientData argument to this procedure. The offset
212: * argument indicates which portion of the selection to
213: * return: skip the first offset bytes. Buffer is a
214: * pointer to an area in which to place the converted
215: * selection, and maxBytes gives the number of bytes
216: * available at buffer. Proc should place the selection
217: * in buffer as a string, and return a count of the number
218: * of bytes of selection actually placed in buffer (not
219: * including the terminating NULL character). If the
220: * return value equals maxBytes, this is a sign that there
221: * is probably still more selection information available.
222: *
223: *--------------------------------------------------------------
224: */
225:
226: void
227: Tk_CreateSelHandler(tkwin, target, proc, clientData, format)
228: Tk_Window tkwin; /* Token for window. */
229: Atom target; /* The kind of selection conversions
230: * that can be handled by proc,
231: * e.g. TARGETS or XA_STRING. */
232: Tk_SelectionProc *proc; /* Procedure to invoke to convert
233: * selection to type "target". */
234: ClientData clientData; /* Value to pass to proc. */
235: Atom format; /* Format in which the selection
236: * information should be returned to
237: * the requestor. XA_STRING is best by
238: * far, but anything listed in the ICCCM
239: * will be tolerated (blech). */
240: {
241: register TkSelHandler *selPtr;
242: TkWindow *winPtr = (TkWindow *) tkwin;
243:
244: if (winPtr->dispPtr->multipleAtom == None) {
245: SelInit(tkwin);
246: }
247:
248: /*
249: * See if there's already a handler for this target on
250: * this window. If so, re-use it. If not, create a new one.
251: */
252:
253: for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
254: if (selPtr == NULL) {
255: selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
256: selPtr->nextPtr = winPtr->selHandlerList;
257: winPtr->selHandlerList = selPtr;
258: break;
259: }
260: if (selPtr->target == target) {
261:
262: /*
263: * Special case: when replacing handler created by
264: * "selection handle" free up memory. Should there be a
265: * callback to allow other clients to do this too?
266: */
267:
268: if (selPtr->proc == HandleTclCommand) {
269: ckfree((char *) selPtr->clientData);
270: }
271: break;
272: }
273: }
274: selPtr->target = target;
275: selPtr->format = format;
276: selPtr->proc = proc;
277: selPtr->clientData = clientData;
278: if (format == XA_STRING) {
279: selPtr->size = 8;
280: } else {
281: selPtr->size = 32;
282: }
283: }
284:
285: /*
286: *--------------------------------------------------------------
287: *
288: * Tk_OwnSelection --
289: *
290: * Arrange for tkwin to become the selection owner.
291: *
292: * Results:
293: * None.
294: *
295: * Side effects:
296: * From now on, requests for the selection will be
297: * directed to procedures associated with tkwin (they
298: * must have been declared with calls to Tk_CreateSelHandler).
299: * When the selection is lost by this window, proc will
300: * be invoked (see the manual entry for details).
301: *
302: *--------------------------------------------------------------
303: */
304:
305: void
306: Tk_OwnSelection(tkwin, proc, clientData)
307: Tk_Window tkwin; /* Window to become new selection
308: * owner. */
309: Tk_LostSelProc *proc; /* Procedure to call when selection
310: * is taken away from tkwin. */
311: ClientData clientData; /* Arbitrary one-word argument to
312: * pass to proc. */
313: {
314: register TkWindow *winPtr = (TkWindow *) tkwin;
315: TkDisplay *dispPtr = winPtr->dispPtr;
316:
317: if (dispPtr->multipleAtom == None) {
318: SelInit(tkwin);
319: }
320:
321: winPtr->selClearProc = proc;
322: winPtr->selClearData = clientData;
323: if (dispPtr->selectionOwner != tkwin) {
324: TkWindow *ownerPtr = (TkWindow *) dispPtr->selectionOwner;
325:
326: if ((ownerPtr != NULL)
327: && (ownerPtr->selClearProc != NULL)) {
328: (*ownerPtr->selClearProc)(ownerPtr->selClearData);
329: ownerPtr->selClearProc = NULL;
330: }
331: }
332: dispPtr->selectionOwner = tkwin;
333: dispPtr->selectionSerial = NextRequest(winPtr->display);
334: dispPtr->selectionTime = TkCurrentTime(dispPtr);
335: XSetSelectionOwner(winPtr->display, XA_PRIMARY, winPtr->window,
336: dispPtr->selectionTime);
337: }
338:
339: /*
340: *--------------------------------------------------------------
341: *
342: * Tk_GetSelection --
343: *
344: * Retrieve the selection and pass it off (in pieces,
345: * possibly) to a given procedure.
346: *
347: * Results:
348: * The return value is a standard Tcl return value.
349: * If an error occurs (such as no selection exists)
350: * then an error message is left in interp->result.
351: *
352: * Side effects:
353: * The standard X11 protocols are used to retrieve the
354: * selection. When it arrives, it is passed to proc. If
355: * the selection is very large, it will be passed to proc
356: * in several pieces. Proc should have the following
357: * structure:
358: *
359: * int
360: * proc(clientData, interp, portion)
361: * ClientData clientData;
362: * Tcl_Interp *interp;
363: * char *portion;
364: * {
365: * }
366: *
367: * The interp and clientData arguments to proc will be the
368: * same as the corresponding arguments to Tk_GetSelection.
369: * The portion argument points to a character string
370: * containing part of the selection, and numBytes indicates
371: * the length of the portion, not including the terminating
372: * NULL character. If the selection arrives in several pieces,
373: * the "portion" arguments in separate calls will contain
374: * successive parts of the selection. Proc should normally
375: * return TCL_OK. If it detects an error then it should return
376: * TCL_ERROR and leave an error message in interp->result; the
377: * remainder of the selection retrieval will be aborted.
378: *
379: *--------------------------------------------------------------
380: */
381:
382: int
383: Tk_GetSelection(interp, tkwin, target, proc, clientData)
384: Tcl_Interp *interp; /* Interpreter to use for reporting
385: * errors. */
386: Tk_Window tkwin; /* Window on whose behalf to retrieve
387: * the selection (determines display
388: * from which to retrieve). */
389: Atom target; /* Desired form in which selection
390: * is to be returned. */
391: Tk_GetSelProc *proc; /* Procedure to call to process the
392: * selection, once it has been retrieved. */
393: ClientData clientData; /* Arbitrary value to pass to proc. */
394: {
395: RetrievalInfo retr;
396: TkWindow *winPtr = (TkWindow *) tkwin;
397: TkDisplay *dispPtr = winPtr->dispPtr;
398:
399: if (dispPtr->multipleAtom == None) {
400: SelInit(tkwin);
401: }
402:
403: /*
404: * If the selection is owned by a window managed by this
405: * process, then call the retrieval procedure directly,
406: * rather than going through the X server (it's dangerous
407: * to go through the X server in this case because it could
408: * result in deadlock if an INCR-style selection results).
409: */
410:
411: if (dispPtr->selectionOwner != NULL) {
412: register TkSelHandler *selPtr;
413: int offset, result, count;
414: char buffer[TK_SEL_BYTES_AT_ONCE+1];
415: Time time;
416:
417: /*
418: * Make sure that the selection predates the request
419: * time.
420: */
421:
422: time = TkCurrentTime(dispPtr);
423: if ((time < dispPtr->selectionTime)
424: && (time != CurrentTime)
425: && (dispPtr->selectionTime != CurrentTime)) {
426: interp->result = "selection changed before it could be retrieved";
427: return TCL_ERROR;
428: }
429:
430: for (selPtr = ((TkWindow *) dispPtr->selectionOwner)->selHandlerList;
431: ; selPtr = selPtr->nextPtr) {
432: if (selPtr == NULL) {
433: Atom type;
434:
435: count = DefaultSelection((TkWindow *) dispPtr->selectionOwner,
436: target, buffer, TK_SEL_BYTES_AT_ONCE, &type);
437: if (count > TK_SEL_BYTES_AT_ONCE) {
438: panic("selection handler returned too many bytes");
439: }
440: if (count < 0) {
441: cantget:
442: Tcl_AppendResult(interp, "selection doesn't exist",
443: " or form \"", Tk_GetAtomName(tkwin, target),
444: "\" not defined", (char *) NULL);
445: return TCL_ERROR;
446: }
447: buffer[count] = 0;
448: return (*proc)(clientData, interp, buffer);
449: }
450: if (selPtr->target == target) {
451: break;
452: }
453: }
454: offset = 0;
455: while (1) {
456: count = (*selPtr->proc)(selPtr->clientData, offset,
457: buffer, TK_SEL_BYTES_AT_ONCE);
458: if (count < 0) {
459: goto cantget;
460: }
461: if (count > TK_SEL_BYTES_AT_ONCE) {
462: panic("selection handler returned too many bytes");
463: }
464: buffer[count] = '\0';
465: result = (*proc)(clientData, interp, buffer);
466: if (result != TCL_OK) {
467: return result;
468: }
469: if (count < TK_SEL_BYTES_AT_ONCE) {
470: return TCL_OK;
471: }
472: offset += count;
473: }
474: }
475:
476: /*
477: * The selection is owned by some other process. To
478: * retrieve it, first record information about the retrieval
479: * in progress. Also, try to use a non-top-level window
480: * as the requestor (property changes on this window may
481: * be monitored by a window manager, which will waste time).
482: */
483:
484: retr.interp = interp;
485: if ((winPtr->flags & TK_TOP_LEVEL)
486: && (winPtr->childList != NULL)) {
487: winPtr = winPtr->childList;
488: }
489: retr.winPtr = winPtr;
490: retr.property = XA_PRIMARY;
491: retr.target = target;
492: retr.proc = proc;
493: retr.clientData = clientData;
494: retr.result = -1;
495: retr.idleTime = 0;
496: retr.nextPtr = pendingRetrievals;
497: pendingRetrievals = &retr;
498:
499: /*
500: * Initiate the request for the selection.
501: */
502:
503: XConvertSelection(winPtr->display, XA_PRIMARY, target,
504: retr.property, winPtr->window, TkCurrentTime(dispPtr));
505:
506: /*
507: * Enter a loop processing X events until the selection
508: * has been retrieved and processed. If no response is
509: * received within a few seconds, then timeout.
510: */
511:
512: retr.timeout = Tk_CreateTimerHandler(1000, SelTimeoutProc,
513: (ClientData) &retr);
514: while (retr.result == -1) {
515: Tk_DoOneEvent(0);
516: }
517: Tk_DeleteTimerHandler(retr.timeout);
518:
519: /*
520: * Unregister the information about the selection retrieval
521: * in progress.
522: */
523:
524: if (pendingRetrievals == &retr) {
525: pendingRetrievals = retr.nextPtr;
526: } else {
527: RetrievalInfo *retrPtr;
528:
529: for (retrPtr = pendingRetrievals; retrPtr != NULL;
530: retrPtr = retrPtr->nextPtr) {
531: if (retrPtr->nextPtr == &retr) {
532: retrPtr->nextPtr = retr.nextPtr;
533: break;
534: }
535: }
536: }
537: return retr.result;
538: }
539:
540: /*
541: *--------------------------------------------------------------
542: *
543: * Tk_SelectionCmd --
544: *
545: * This procedure is invoked to process the "selection" Tcl
546: * command. See the user documentation for details on what
547: * it does.
548: *
549: * Results:
550: * A standard Tcl result.
551: *
552: * Side effects:
553: * See the user documentation.
554: *
555: *--------------------------------------------------------------
556: */
557:
558: int
559: Tk_SelectionCmd(clientData, interp, argc, argv)
560: ClientData clientData; /* Main window associated with
561: * interpreter. */
562: Tcl_Interp *interp; /* Current interpreter. */
563: int argc; /* Number of arguments. */
564: char **argv; /* Argument strings. */
565: {
566: Tk_Window tkwin = (Tk_Window) clientData;
567: int length;
568: char *cmd = argv[0];
569: char c;
570:
571: if (argc < 2) {
572: sprintf(interp->result,
573: "wrong # args: should be \"%.50s [-window win] option ?arg arg ...?\"",
574: cmd);
575: return TCL_ERROR;
576: }
577:
578: argc--; argv++;
579: c = argv[0][0];
580: length = strlen(argv[0]);
581:
582: if ((c == '-') && (strncmp(argv[0], "-window", length) == 0)) {
583: if ((argc < 2) ||
584: ((tkwin = Tk_NameToWindow(interp, argv[1], tkwin)) == NULL)) {
585: sprintf(interp->result, "bad arg to %s -window", cmd);
586: return TCL_ERROR;
587: }
588: argc -= 2; argv += 2;
589:
590: if (argc == 0) {
591: sprintf(interp->result, "not enough args to %s", cmd);
592: return TCL_ERROR;
593: }
594:
595: c = argv[0][0];
596: length = strlen(argv[0]);
597: }
598:
599: if ((c == 'g') && (strncmp(argv[0], "get", length) == 0)) {
600: Atom target;
601: GetInfo getInfo;
602: int result;
603:
604: argc--; argv++;
605:
606: if (argc > 1) {
607: sprintf(interp->result,
608: "too may args: should be \"%.50s get ?type?\"",
609: cmd);
610: return TCL_ERROR;
611: }
612: if (argc == 1) {
613: target = Tk_InternAtom(tkwin, argv[0]);
614: } else {
615: target = XA_STRING;
616: }
617: getInfo.string = (char *) ckalloc(100);
618: getInfo.bytesAvl = 100;
619: getInfo.bytesUsed = 0;
620: result = Tk_GetSelection(interp, tkwin, target, SelGetProc,
621: (ClientData) &getInfo);
622: if (result == TCL_OK) {
623: Tcl_SetResult(interp, getInfo.string, TCL_DYNAMIC);
624: } else {
625: ckfree(getInfo.string);
626: }
627: return result;
628: } else if ((c == 'h') && (strncmp(argv[0], "handle", length) == 0)) {
629: Tk_Window window;
630: Atom target, format;
631: register CommandInfo *cmdInfoPtr;
632: int cmdLength;
633:
634: argc--; argv++;
635:
636: if ((argc < 2) || (argc > 4)) {
637: Tcl_AppendResult(interp, "wrong # args: should be \"", cmd,
638: " handle window command ?type? ?format?\"", (char *) NULL);
639: return TCL_ERROR;
640: }
641: window = Tk_NameToWindow(interp, argv[0], tkwin);
642: if (window == NULL) {
643: return TCL_ERROR;
644: }
645: if (argc > 2) {
646: target = Tk_InternAtom(window, argv[2]);
647: } else {
648: target = XA_STRING;
649: }
650: if (argc > 3) {
651: format = Tk_InternAtom(window, argv[3]);
652: } else {
653: format = XA_STRING;
654: }
655: cmdLength = strlen(argv[1]);
656: cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (sizeof(CommandInfo)
657: + cmdLength));
658: cmdInfoPtr->interp = interp;
659: cmdInfoPtr->cmdLength = cmdLength;
660: strcpy(cmdInfoPtr->command, argv[1]);
661: Tk_CreateSelHandler(window, target, HandleTclCommand,
662: (ClientData) cmdInfoPtr, format);
663: return TCL_OK;
664: } else {
665: sprintf(interp->result,
666: "bad option to \"%.50s\": must be get or handle",
667: cmd);
668: return TCL_ERROR;
669: }
670: }
671:
672: /*
673: *----------------------------------------------------------------------
674: *
675: * TkSelDeadWindow --
676: *
677: * This procedure is invoked just before a TkWindow is deleted.
678: * It performs selection-related cleanup.
679: *
680: * Results:
681: * None.
682: *
683: * Side effects:
684: * Frees up memory associated with the selection.
685: *
686: *----------------------------------------------------------------------
687: */
688:
689: void
690: TkSelDeadWindow(winPtr)
691: register TkWindow *winPtr; /* Window that's being deleted. */
692: {
693: register TkSelHandler *selPtr;
694:
695: while (1) {
696: selPtr = winPtr->selHandlerList;
697: if (selPtr == NULL) {
698: break;
699: }
700: winPtr->selHandlerList = selPtr->nextPtr;
701: ckfree((char *) selPtr);
702: }
703: winPtr->selClearProc = NULL;
704:
705: if (winPtr->dispPtr->selectionOwner == (Tk_Window) winPtr) {
706: winPtr->dispPtr->selectionOwner = NULL;
707: }
708: }
709:
710: /*
711: *----------------------------------------------------------------------
712: *
713: * SelInit --
714: *
715: * Initialize selection-related information for a display.
716: *
717: * Results:
718: * None.
719: *
720: * Side effects:
721: * .
722: *
723: *----------------------------------------------------------------------
724: */
725:
726: static void
727: SelInit(tkwin)
728: Tk_Window tkwin; /* Window token (used to find
729: * display to initialize). */
730: {
731: register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
732:
733: /*
734: * Fetch commonly-used atoms.
735: */
736:
737: dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
738: dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
739: dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
740: dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
741: dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
742: dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
743: }
744:
745: /*
746: *--------------------------------------------------------------
747: *
748: * TkSelEventProc --
749: *
750: * This procedure is invoked whenever a selection-related
751: * event occurs. It does the lion's share of the work
752: * in implementing the selection protocol.
753: *
754: * Results:
755: * None.
756: *
757: * Side effects:
758: * Lots: depends on the type of event.
759: *
760: *--------------------------------------------------------------
761: */
762:
763: void
764: TkSelEventProc(tkwin, eventPtr)
765: Tk_Window tkwin; /* Window for which event was
766: * targeted. */
767: register XEvent *eventPtr; /* X event: either SelectionClear,
768: * SelectionRequest, or
769: * SelectionNotify. */
770: {
771: register TkWindow *winPtr = (TkWindow *) tkwin;
772:
773: /*
774: * Case #1: SelectionClear events. Invoke clear procedure
775: * for window that just lost the selection. This code is a
776: * bit tricky, because any callbacks to due selection changes
777: * between windows managed by the process have already been
778: * made. Thus, ignore the event unless it refers to the
779: * window that's currently the selection owner and the event
780: * was generated after the server saw the SetSelectionOwner
781: * request.
782: */
783:
784: if (eventPtr->type == SelectionClear) {
785: if ((eventPtr->xselectionclear.selection == XA_PRIMARY)
786: && (winPtr->dispPtr->selectionOwner == tkwin)
787: && (eventPtr->xselectionclear.serial
788: >= winPtr->dispPtr->selectionSerial)
789: && (winPtr->selClearProc != NULL)) {
790: (*winPtr->selClearProc)(winPtr->selClearData);
791: winPtr->selClearProc = NULL;
792: winPtr->dispPtr->selectionOwner = NULL;
793: }
794: return;
795: }
796:
797: /*
798: * Case #2: SelectionNotify events. Call the relevant procedure
799: * to handle the incoming selection.
800: */
801:
802: if (eventPtr->type == SelectionNotify) {
803: register RetrievalInfo *retrPtr;
804: char *propInfo;
805: Atom type;
806: int format, result;
807: unsigned long numItems, bytesAfter;
808:
809: for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
810: if (retrPtr == NULL) {
811: return;
812: }
813: if ((retrPtr->winPtr == winPtr)
814: && (eventPtr->xselection.selection == XA_PRIMARY)
815: && (retrPtr->target == eventPtr->xselection.target)
816: && (retrPtr->result == -1)) {
817: if (retrPtr->property == eventPtr->xselection.property) {
818: break;
819: }
820: if (eventPtr->xselection.property == None) {
821: Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
822: Tcl_AppendResult(retrPtr->interp,
823: "selection doesn't exist or form \"",
824: Tk_GetAtomName(tkwin, retrPtr->target),
825: "\" not defined", (char *) NULL);
826: retrPtr->result = TCL_ERROR;
827: return;
828: }
829: }
830: }
831:
832: propInfo = NULL;
833: result = XGetWindowProperty(eventPtr->xselection.display,
834: eventPtr->xselection.requestor, retrPtr->property,
835: 0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
836: &type, &format, &numItems, &bytesAfter,
837: (unsigned char **) &propInfo);
838: if ((result != Success) || (type == None)) {
839: return;
840: }
841: if (bytesAfter != 0) {
842: Tcl_SetResult(retrPtr->interp, "selection property too large",
843: TCL_STATIC);
844: retrPtr->result = TCL_ERROR;
845: XFree(propInfo);
846: return;
847: }
848: if ((type == XA_STRING) || (type == winPtr->dispPtr->textAtom)
849: || (type == winPtr->dispPtr->compoundTextAtom)) {
850: if (format != 8) {
851: sprintf(retrPtr->interp->result,
852: "bad format for string selection: wanted \"8\", got \"%d\"",
853: format);
854: retrPtr->result = TCL_ERROR;
855: return;
856: }
857: retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
858: retrPtr->interp, propInfo);
859: } else if (type == winPtr->dispPtr->incrAtom) {
860:
861: /*
862: * It's a !?#@!?!! INCR-style reception. Arrange to receive
863: * the selection in pieces, using the ICCCM protocol, then
864: * hang around until either the selection is all here or a
865: * timeout occurs.
866: */
867:
868: retrPtr->idleTime = 0;
869: Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
870: (ClientData) retrPtr);
871: XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
872: retrPtr->property);
873: while (retrPtr->result == -1) {
874: Tk_DoOneEvent(0);
875: }
876: Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
877: (ClientData) retrPtr);
878: } else {
879: char *string;
880:
881: if (format != 32) {
882: sprintf(retrPtr->interp->result,
883: "bad format for selection: wanted \"32\", got \"%d\"",
884: format);
885: retrPtr->result = TCL_ERROR;
886: return;
887: }
888: string = SelCvtFromX((long *) propInfo, (int) numItems, type,
889: (Tk_Window) winPtr);
890: retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
891: retrPtr->interp, string);
892: ckfree(string);
893: }
894: XFree(propInfo);
895: return;
896: }
897:
898: /*
899: * Case #3: SelectionRequest events. Call ConvertSelection to
900: * do the dirty work.
901: */
902:
903: if ((eventPtr->type == SelectionRequest)
904: && (eventPtr->xselectionrequest.selection == XA_PRIMARY)) {
905: ConvertSelection(winPtr, &eventPtr->xselectionrequest);
906: return;
907: }
908: }
909:
910: /*
911: *--------------------------------------------------------------
912: *
913: * SelGetProc --
914: *
915: * This procedure is invoked to process pieces of the
916: * selection as they arrive during "selection get"
917: * commands.
918: *
919: * Results:
920: * Always returns TCL_OK.
921: *
922: * Side effects:
923: * Bytes get appended to the result currently stored
924: * in interp->result, and its memory area gets
925: * expanded if necessary.
926: *
927: *--------------------------------------------------------------
928: */
929:
930: /* ARGSUSED */
931: static int
932: SelGetProc(clientData, interp, portion)
933: ClientData clientData; /* Information about partially-
934: * assembled result. */
935: Tcl_Interp *interp; /* Interpreter used for error
936: * reporting (not used). */
937: char *portion; /* New information to be appended. */
938: {
939: register GetInfo *getInfoPtr = (GetInfo *) clientData;
940: int newLength;
941:
942: newLength = strlen(portion) + getInfoPtr->bytesUsed;
943:
944: /*
945: * Grow the result area if we've run out of space.
946: */
947:
948: if (newLength >= getInfoPtr->bytesAvl) {
949: char *newString;
950:
951: getInfoPtr->bytesAvl *= 2;
952: if (getInfoPtr->bytesAvl <= newLength) {
953: getInfoPtr->bytesAvl = newLength + 1;
954: }
955: newString = (char *) ckalloc((unsigned) getInfoPtr->bytesAvl);
956: memcpy((VOID *) newString, (VOID *) getInfoPtr->string,
957: getInfoPtr->bytesUsed);
958: ckfree(getInfoPtr->string);
959: getInfoPtr->string = newString;
960: }
961:
962: /*
963: * Append the new data to what was already there.
964: */
965:
966: strcpy(getInfoPtr->string + getInfoPtr->bytesUsed, portion);
967: getInfoPtr->bytesUsed = newLength;
968: return TCL_OK;
969: }
970:
971: /*
972: *----------------------------------------------------------------------
973: *
974: * SelCvtToX --
975: *
976: * Given a selection represented as a string (the normal Tcl form),
977: * convert it to the ICCCM-mandated format for X, depending on
978: * the type argument. This procedure and SelCvtFromX are inverses.
979: *
980: * Results:
981: * The return value is a malloc'ed buffer holding a value
982: * equivalent to "string", but formatted as for "type". It is
983: * the caller's responsibility to free the string when done with
984: * it. The word at *numLongsPtr is filled in with the number of
985: * 32-bit words returned in the result.
986: *
987: * Side effects:
988: * None.
989: *
990: *----------------------------------------------------------------------
991: */
992:
993: static long *
994: SelCvtToX(string, type, tkwin, numLongsPtr)
995: char *string; /* String representation of selection. */
996: Atom type; /* Atom specifying the X format that is
997: * desired for the selection. Should not
998: * be XA_STRING (if so, don't bother calling
999: * this procedure at all). */
1000: Tk_Window tkwin; /* Window that governs atom conversion. */
1001: int *numLongsPtr; /* Number of 32-bit words contained in the
1002: * result. */
1003: {
1004: register char *p;
1005: char *field;
1006: int numFields;
1007: long *propPtr, *longPtr;
1008: #define MAX_ATOM_NAME_LENGTH 100
1009: char atomName[MAX_ATOM_NAME_LENGTH+1];
1010:
1011: /*
1012: * The string is assumed to consist of fields separated by spaces.
1013: * The property gets generated by converting each field to an
1014: * integer number, in one of two ways:
1015: * 1. If type is XA_ATOM, convert each field to its corresponding
1016: * atom.
1017: * 2. If type is anything else, convert each field from an ASCII number
1018: * to a 32-bit binary number.
1019: */
1020:
1021: numFields = 1;
1022: for (p = string; *p != 0; p++) {
1023: if (isspace(*p)) {
1024: numFields++;
1025: }
1026: }
1027: propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
1028:
1029: /*
1030: * Convert the fields one-by-one.
1031: */
1032:
1033: for (longPtr = propPtr, *numLongsPtr = 0, p = string;
1034: ; longPtr++, (*numLongsPtr)++) {
1035: while (isspace(*p)) {
1036: p++;
1037: }
1038: if (*p == 0) {
1039: break;
1040: }
1041: field = p;
1042: while ((*p != 0) && !isspace(*p)) {
1043: p++;
1044: }
1045: if (type == XA_ATOM) {
1046: int length;
1047:
1048: length = p - field;
1049: if (length > MAX_ATOM_NAME_LENGTH) {
1050: length = MAX_ATOM_NAME_LENGTH;
1051: }
1052: strncpy(atomName, field, length);
1053: atomName[length] = 0;
1054: *longPtr = (long) Tk_InternAtom(tkwin, atomName);
1055: } else {
1056: char *dummy;
1057:
1058: *longPtr = strtol(field, &dummy, 0);
1059: }
1060: }
1061: return propPtr;
1062: }
1063:
1064: /*
1065: *----------------------------------------------------------------------
1066: *
1067: * SelCvtFromX --
1068: *
1069: * Given an X property value, formatted as a collection of 32-bit
1070: * values according to "type" and the ICCCM conventions, convert
1071: * the value to a string suitable for manipulation by Tcl. This
1072: * procedure is the inverse of SelCvtToX.
1073: *
1074: * Results:
1075: * The return value is the string equivalent of "property". It is
1076: * malloc-ed and should be freed by the caller when no longer
1077: * needed.
1078: *
1079: * Side effects:
1080: * None.
1081: *
1082: *----------------------------------------------------------------------
1083: */
1084:
1085: static char *
1086: SelCvtFromX(propPtr, numValues, type, tkwin)
1087: register long *propPtr; /* Property value from X. */
1088: int numValues; /* Number of 32-bit values in property. */
1089: Atom type; /* Type of property Should not be
1090: * XA_STRING (if so, don't bother calling
1091: * this procedure at all). */
1092: Tk_Window tkwin; /* Window to use for atom conversion. */
1093: {
1094: char *result;
1095: int resultSpace, curSize, fieldSize;
1096: char *atomName;
1097:
1098: /*
1099: * Convert each long in the property to a string value, which is
1100: * either the name of an atom (if type is XA_ATOM) or a hexadecimal
1101: * string. Make an initial guess about the size of the result, but
1102: * be prepared to enlarge the result if necessary.
1103: */
1104:
1105: resultSpace = 12*numValues;
1106: curSize = 0;
1107: atomName = ""; /* Not needed, but eliminates compiler warning. */
1108: result = (char *) ckalloc((unsigned) resultSpace);
1109: for ( ; numValues > 0; propPtr++, numValues--) {
1110: if (type == XA_ATOM) {
1111: atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
1112: fieldSize = strlen(atomName) + 1;
1113: } else {
1114: fieldSize = 12;
1115: }
1116: if (curSize+fieldSize >= resultSpace) {
1117: char *newResult;
1118:
1119: resultSpace *= 2;
1120: if (curSize+fieldSize >= resultSpace) {
1121: resultSpace = curSize + fieldSize + 1;
1122: }
1123: newResult = (char *) ckalloc((unsigned) resultSpace);
1124: strcpy(newResult, result);
1125: ckfree(result);
1126: result = newResult;
1127: }
1128: if (curSize != 0) {
1129: result[curSize] = ' ';
1130: curSize++;
1131: }
1132: if (type == XA_ATOM) {
1133: strcpy(result+curSize, atomName);
1134: } else {
1135: sprintf(result+curSize, "%#x", *propPtr);
1136: }
1137: curSize += strlen(result+curSize);
1138: }
1139: return result;
1140: }
1141:
1142: /*
1143: *----------------------------------------------------------------------
1144: *
1145: * ConvertSelection --
1146: *
1147: * This procedure is invoked to handle SelectionRequest events.
1148: * It responds to the requests, obeying the ICCCM protocols.
1149: *
1150: * Results:
1151: * None.
1152: *
1153: * Side effects:
1154: * Properties are created for the selection requestor, and a
1155: * SelectionNotify event is generated for the selection
1156: * requestor. In the event of long selections, this procedure
1157: * implements INCR-mode transfers, using the ICCCM protocol.
1158: *
1159: *----------------------------------------------------------------------
1160: */
1161:
1162: static void
1163: ConvertSelection(winPtr, eventPtr)
1164: TkWindow *winPtr; /* Window that owns selection. */
1165: register XSelectionRequestEvent *eventPtr;
1166: /* Event describing request. */
1167: {
1168: XSelectionEvent reply; /* Used to notify requestor that
1169: * selection info is ready. */
1170: int multiple; /* Non-zero means a MULTIPLE request
1171: * is being handled. */
1172: IncrInfo info; /* State of selection conversion. */
1173: Atom singleInfo[2]; /* info.multAtoms points here except
1174: * for multiple conversions. */
1175: int i;
1176: Tk_ErrorHandler errorHandler;
1177:
1178: errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
1179: (int (*)()) NULL, (ClientData) NULL);
1180:
1181: /*
1182: * Initialize the reply event.
1183: */
1184:
1185: reply.type = SelectionNotify;
1186: reply.serial = 0;
1187: reply.send_event = True;
1188: reply.display = eventPtr->display;
1189: reply.requestor = eventPtr->requestor;
1190: reply.selection = XA_PRIMARY;
1191: reply.target = eventPtr->target;
1192: reply.property = eventPtr->property;
1193: if (reply.property == None) {
1194: reply.property = reply.target;
1195: }
1196: reply.time = eventPtr->time;
1197:
1198: /*
1199: * Watch out for races between conversion requests and
1200: * selection ownership changes: reject the conversion
1201: * request if it's for the wrong window or the wrong
1202: * time.
1203: */
1204:
1205: if ((winPtr->dispPtr->selectionOwner != (Tk_Window) winPtr)
1206: || ((eventPtr->time < winPtr->dispPtr->selectionTime)
1207: && (eventPtr->time != CurrentTime)
1208: && (winPtr->dispPtr->selectionTime != CurrentTime))) {
1209: goto refuse;
1210: }
1211:
1212: /*
1213: * Figure out which kind(s) of conversion to perform. If handling
1214: * a MULTIPLE conversion, then read the property describing which
1215: * conversions to perform.
1216: */
1217:
1218: info.winPtr = winPtr;
1219: if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
1220: multiple = 0;
1221: singleInfo[0] = reply.target;
1222: singleInfo[1] = reply.property;
1223: info.multAtoms = singleInfo;
1224: info.numConversions = 1;
1225: } else {
1226: Atom type;
1227: int format, result;
1228: unsigned long bytesAfter;
1229:
1230: multiple = 1;
1231: info.multAtoms = NULL;
1232: if (eventPtr->property == None) {
1233: goto refuse;
1234: }
1235: result = XGetWindowProperty(eventPtr->display,
1236: eventPtr->requestor, eventPtr->property,
1237: 0, MAX_PROP_WORDS, False, XA_ATOM,
1238: &type, &format, &info.numConversions, &bytesAfter,
1239: (unsigned char **) &info.multAtoms);
1240: if ((result != Success) || (bytesAfter != 0) || (format != 32)
1241: || (type == None)) {
1242: if (info.multAtoms != NULL) {
1243: XFree((char *) info.multAtoms);
1244: }
1245: goto refuse;
1246: }
1247: info.numConversions /= 2; /* Two atoms per conversion. */
1248: }
1249:
1250: /*
1251: * Loop through all of the requested conversions, and either return
1252: * the entire converted selection, if it can be returned in a single
1253: * bunch, or return INCR information only (the actual selection will
1254: * be returned below).
1255: */
1256:
1257: info.offsets = (int *) ckalloc((unsigned) (info.numConversions*sizeof(int)));
1258: info.numIncrs = 0;
1259: for (i = 0; i < info.numConversions; i++) {
1260: Atom target, property;
1261: long buffer[TK_SEL_WORDS_AT_ONCE];
1262: register TkSelHandler *selPtr;
1263:
1264: target = info.multAtoms[2*i];
1265: property = info.multAtoms[2*i + 1];
1266: info.offsets[i] = -1;
1267:
1268: for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
1269: int numItems, format;
1270: char *propPtr;
1271: Atom type;
1272:
1273: if (selPtr == NULL) {
1274:
1275: /*
1276: * Nobody seems to know about this kind of request. If
1277: * it's of a sort that we can handle without any help, do
1278: * it. Otherwise mark the request as an errror.
1279: */
1280:
1281: numItems = DefaultSelection(winPtr, target, (char *) buffer,
1282: TK_SEL_BYTES_AT_ONCE, &type);
1283: if (numItems != 0) {
1284: goto gotStuff;
1285: }
1286: info.multAtoms[2*i + 1] = None;
1287: break;
1288: } else if (selPtr->target == target) {
1289: numItems = (*selPtr->proc)(selPtr->clientData, 0,
1290: (char *) buffer, TK_SEL_BYTES_AT_ONCE);
1291: if (numItems < 0) {
1292: info.multAtoms[2*i + 1] = None;
1293: break;
1294: }
1295: if (numItems > TK_SEL_BYTES_AT_ONCE) {
1296: panic("selection handler returned too many bytes");
1297: }
1298: ((char *) buffer)[numItems] = '\0';
1299: type = selPtr->format;
1300: } else {
1301: continue;
1302: }
1303:
1304: gotStuff:
1305: if (numItems == TK_SEL_BYTES_AT_ONCE) {
1306: info.numIncrs++;
1307: type = winPtr->dispPtr->incrAtom;
1308: buffer[0] = 10; /* Guess at # items avl. */
1309: numItems = 1;
1310: propPtr = (char *) buffer;
1311: format = 32;
1312: info.offsets[i] = 0;
1313: } else if (type == XA_STRING) {
1314: propPtr = (char *) buffer;
1315: format = 8;
1316: } else {
1317: propPtr = (char *) SelCvtToX((char *) buffer,
1318: type, (Tk_Window) winPtr, &numItems);
1319: format = 32;
1320: }
1321: XChangeProperty(reply.display, reply.requestor,
1322: property, type, format, PropModeReplace,
1323: (unsigned char *) propPtr, numItems);
1324: if (propPtr != (char *) buffer) {
1325: ckfree(propPtr);
1326: }
1327: break;
1328: }
1329: }
1330:
1331: /*
1332: * Send an event back to the requestor to indicate that the
1333: * first stage of conversion is complete (everything is done
1334: * except for long conversions that have to be done in INCR
1335: * mode).
1336: */
1337:
1338: if (info.numIncrs > 0) {
1339: XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
1340: info.timeout = Tk_CreateTimerHandler(1000, IncrTimeoutProc,
1341: (ClientData) &info);
1342: info.idleTime = 0;
1343: info.reqWindow = reply.requestor;
1344: info.time = winPtr->dispPtr->selectionTime;
1345: info.nextPtr = pendingIncrs;
1346: pendingIncrs = &info;
1347: }
1348: if (multiple) {
1349: XChangeProperty(reply.display, reply.requestor, reply.property,
1350: XA_ATOM, 32, PropModeReplace,
1351: (unsigned char *) info.multAtoms,
1352: (int) info.numConversions*2);
1353: } else {
1354:
1355: /*
1356: * Not a MULTIPLE request. The first property in "multAtoms"
1357: * got set to None if there was an error in conversion.
1358: */
1359:
1360: reply.property = info.multAtoms[1];
1361: }
1362: XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
1363: Tk_DeleteErrorHandler(errorHandler);
1364:
1365: /*
1366: * Handle any remaining INCR-mode transfers. This all happens
1367: * in callbacks to TkSelPropProc, so just wait until the number
1368: * of uncompleted INCR transfers drops to zero.
1369: */
1370:
1371: if (info.numIncrs > 0) {
1372: IncrInfo *infoPtr2;
1373:
1374: while (info.numIncrs > 0) {
1375: Tk_DoOneEvent(0);
1376: }
1377: Tk_DeleteTimerHandler(info.timeout);
1378: errorHandler = Tk_CreateErrorHandler(winPtr->display,
1379: -1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
1380: XSelectInput(reply.display, reply.requestor, 0L);
1381: Tk_DeleteErrorHandler(errorHandler);
1382: if (pendingIncrs == &info) {
1383: pendingIncrs = info.nextPtr;
1384: } else {
1385: for (infoPtr2 = pendingIncrs; infoPtr2 != NULL;
1386: infoPtr2 = infoPtr2->nextPtr) {
1387: if (infoPtr2->nextPtr == &info) {
1388: infoPtr2->nextPtr = info.nextPtr;
1389: break;
1390: }
1391: }
1392: }
1393: }
1394:
1395: /*
1396: * All done. Cleanup and return.
1397: */
1398:
1399: ckfree((char *) info.offsets);
1400: if (multiple) {
1401: XFree((char *) info.multAtoms);
1402: }
1403: return;
1404:
1405: /*
1406: * An error occurred. Send back a refusal message.
1407: */
1408:
1409: refuse:
1410: reply.property = None;
1411: XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
1412: Tk_DeleteErrorHandler(errorHandler);
1413: return;
1414: }
1415:
1416: /*
1417: *----------------------------------------------------------------------
1418: *
1419: * SelRcvIncrProc --
1420: *
1421: * This procedure handles the INCR protocol on the receiving
1422: * side. It is invoked in response to property changes on
1423: * the requestor's window (which hopefully are because a new
1424: * chunk of the selection arrived).
1425: *
1426: * Results:
1427: * None.
1428: *
1429: * Side effects:
1430: * If a new piece of selection has arrived, a procedure is
1431: * invoked to deal with that piece. When the whole selection
1432: * is here, a flag is left for the higher-level procedure that
1433: * initiated the selection retrieval.
1434: *
1435: *----------------------------------------------------------------------
1436: */
1437:
1438: static void
1439: SelRcvIncrProc(clientData, eventPtr)
1440: ClientData clientData; /* Information about retrieval. */
1441: register XEvent *eventPtr; /* X PropertyChange event. */
1442: {
1443: register RetrievalInfo *retrPtr = (RetrievalInfo *) clientData;
1444: char *propInfo;
1445: Atom type;
1446: int format, result;
1447: unsigned long numItems, bytesAfter;
1448:
1449: if ((eventPtr->xproperty.atom != retrPtr->property)
1450: || (eventPtr->xproperty.state != PropertyNewValue)
1451: || (retrPtr->result != -1)) {
1452: return;
1453: }
1454: propInfo = NULL;
1455: result = XGetWindowProperty(eventPtr->xproperty.display,
1456: eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
1457: True, (Atom) AnyPropertyType, &type, &format, &numItems,
1458: &bytesAfter, (unsigned char **) &propInfo);
1459: if ((result != Success) || (type == None)) {
1460: return;
1461: }
1462: if (bytesAfter != 0) {
1463: Tcl_SetResult(retrPtr->interp, "selection property too large",
1464: TCL_STATIC);
1465: retrPtr->result = TCL_ERROR;
1466: goto done;
1467: }
1468: if (numItems == 0) {
1469: retrPtr->result = TCL_OK;
1470: } else if ((type == XA_STRING)
1471: || (type == retrPtr->winPtr->dispPtr->textAtom)
1472: || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
1473: if (format != 8) {
1474: Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
1475: sprintf(retrPtr->interp->result,
1476: "bad format for string selection: wanted \"8\", got \"%d\"",
1477: format);
1478: retrPtr->result = TCL_ERROR;
1479: goto done;
1480: }
1481: result = (*retrPtr->proc)(retrPtr->clientData, retrPtr->interp,
1482: propInfo);
1483: if (result != TCL_OK) {
1484: retrPtr->result = result;
1485: }
1486: } else {
1487: char *string;
1488:
1489: if (format != 32) {
1490: Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
1491: sprintf(retrPtr->interp->result,
1492: "bad format for selection: wanted \"32\", got \"%d\"",
1493: format);
1494: retrPtr->result = TCL_ERROR;
1495: goto done;
1496: }
1497: string = SelCvtFromX((long *) propInfo, (int) numItems, type,
1498: (Tk_Window) retrPtr->winPtr);
1499: result = (*retrPtr->proc)(retrPtr->clientData, retrPtr->interp,
1500: string);
1501: if (result != TCL_OK) {
1502: retrPtr->result = result;
1503: }
1504: ckfree(string);
1505: }
1506:
1507: done:
1508: XFree(propInfo);
1509: retrPtr->idleTime = 0;
1510: }
1511:
1512: /*
1513: *----------------------------------------------------------------------
1514: *
1515: * TkSelPropProc --
1516: *
1517: * This procedure is invoked when property-change events
1518: * occur on windows not known to the toolkit. Its function
1519: * is to implement the sending side of the INCR selection
1520: * retrieval protocol when the selection requestor deletes
1521: * the property containing a part of the selection.
1522: *
1523: * Results:
1524: * None.
1525: *
1526: * Side effects:
1527: * If the property that is receiving the selection was just
1528: * deleted, then a new piece of the selection is fetched and
1529: * placed in the property, until eventually there's no more
1530: * selection to fetch.
1531: *
1532: *----------------------------------------------------------------------
1533: */
1534:
1535: void
1536: TkSelPropProc(eventPtr)
1537: register XEvent *eventPtr; /* X PropertyChange event. */
1538: {
1539: register IncrInfo *infoPtr;
1540: int i, format;
1541: Atom target;
1542: register TkSelHandler *selPtr;
1543: long buffer[TK_SEL_WORDS_AT_ONCE];
1544: int numItems;
1545: char *propPtr;
1546: Tk_ErrorHandler errorHandler;
1547:
1548: /*
1549: * See if this event announces the deletion of a property being
1550: * used for an INCR transfer. If so, then add the next chunk of
1551: * data to the property.
1552: */
1553:
1554: if (eventPtr->xproperty.state != PropertyDelete) {
1555: return;
1556: }
1557: for (infoPtr = pendingIncrs; infoPtr != NULL;
1558: infoPtr = infoPtr->nextPtr) {
1559:
1560: /*
1561: * To avoid races between selection conversions and
1562: * changes in selection ownership, make sure the window
1563: * and timestamp for the current selection match those
1564: * in the INCR request.
1565: */
1566:
1567: if ((infoPtr->reqWindow != eventPtr->xproperty.window)
1568: || (infoPtr->winPtr->dispPtr->selectionOwner
1569: != (Tk_Window) infoPtr->winPtr)
1570: || (infoPtr->winPtr->dispPtr->selectionTime
1571: != infoPtr->time)) {
1572: continue;
1573: }
1574: for (i = 0; i < infoPtr->numConversions; i++) {
1575: if ((eventPtr->xproperty.atom != infoPtr->multAtoms[2*i + 1])
1576: || (infoPtr->offsets[i] == -1)){
1577: continue;
1578: }
1579: target = infoPtr->multAtoms[2*i];
1580: infoPtr->idleTime = 0;
1581: for (selPtr = infoPtr->winPtr->selHandlerList; ;
1582: selPtr = selPtr->nextPtr) {
1583: if (selPtr == NULL) {
1584: infoPtr->multAtoms[2*i + 1] = None;
1585: infoPtr->offsets[i] = -1;
1586: infoPtr->numIncrs --;
1587: return;
1588: }
1589: if (selPtr->target == target) {
1590: if (infoPtr->offsets[i] == -2) {
1591: numItems = 0;
1592: ((char *) buffer)[0] = 0;
1593: } else {
1594: numItems = (*selPtr->proc)(selPtr->clientData,
1595: infoPtr->offsets[i], (char *) buffer,
1596: TK_SEL_BYTES_AT_ONCE);
1597: if (numItems > TK_SEL_BYTES_AT_ONCE) {
1598: panic("selection handler returned too many bytes");
1599: } else {
1600: if (numItems < 0) {
1601: numItems = 0;
1602: }
1603: }
1604: ((char *) buffer)[numItems] = '\0';
1605: }
1606: if (numItems < TK_SEL_BYTES_AT_ONCE) {
1607: if (numItems <= 0) {
1608: infoPtr->offsets[i] = -1;
1609: infoPtr->numIncrs--;
1610: } else {
1611: infoPtr->offsets[i] = -2;
1612: }
1613: } else {
1614: infoPtr->offsets[i] += numItems;
1615: }
1616: if (selPtr->format == XA_STRING) {
1617: propPtr = (char *) buffer;
1618: format = 8;
1619: } else {
1620: propPtr = (char *) SelCvtToX((char *) buffer,
1621: selPtr->format,
1622: (Tk_Window) infoPtr->winPtr,
1623: &numItems);
1624: format = 32;
1625: }
1626: errorHandler = Tk_CreateErrorHandler(
1627: eventPtr->xproperty.display, -1, -1, -1,
1628: (int (*)()) NULL, (ClientData) NULL);
1629: XChangeProperty(eventPtr->xproperty.display,
1630: eventPtr->xproperty.window,
1631: eventPtr->xproperty.atom, selPtr->format,
1632: format, PropModeReplace,
1633: (unsigned char *) propPtr, numItems);
1634: Tk_DeleteErrorHandler(errorHandler);
1635: if (propPtr != (char *) buffer) {
1636: ckfree(propPtr);
1637: }
1638: return;
1639: }
1640: }
1641: }
1642: }
1643: }
1644:
1645: /*
1646: *----------------------------------------------------------------------
1647: *
1648: * HandleTclCommand --
1649: *
1650: * This procedure acts as selection handler for handlers created
1651: * by the "selection handle" command. It invokes a Tcl command to
1652: * retrieve the selection.
1653: *
1654: * Results:
1655: * The return value is a count of the number of bytes actually
1656: * stored at buffer.
1657: *
1658: * Side effects:
1659: * None except for things done by the Tcl command.
1660: *
1661: *----------------------------------------------------------------------
1662: */
1663:
1664: static int
1665: HandleTclCommand(clientData, offset, buffer, maxBytes)
1666: ClientData clientData; /* Information about command to execute. */
1667: int offset; /* Return selection bytes starting at this
1668: * offset. */
1669: char *buffer; /* Place to store converted selection. */
1670: int maxBytes; /* Maximum # of bytes to store at buffer. */
1671: {
1672: register CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
1673: char *oldResultString;
1674: Tcl_FreeProc *oldFreeProc;
1675: int spaceNeeded, length;
1676: #define MAX_STATIC_SIZE 100
1677: char staticSpace[MAX_STATIC_SIZE];
1678: char *command;
1679:
1680: /*
1681: * First, generate a command by taking the command string
1682: * and appending the offset and maximum # of bytes.
1683: */
1684:
1685: spaceNeeded = cmdInfoPtr->cmdLength + 30;
1686: if (spaceNeeded < MAX_STATIC_SIZE) {
1687: command = staticSpace;
1688: } else {
1689: command = (char *) ckalloc((unsigned) spaceNeeded);
1690: }
1691: sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
1692:
1693: /*
1694: * Execute the command. Be sure to restore the state of the
1695: * interpreter after executing the command.
1696: */
1697:
1698: oldFreeProc = cmdInfoPtr->interp->freeProc;
1699: if (oldFreeProc != 0) {
1700: oldResultString = cmdInfoPtr->interp->result;
1701: } else {
1702: oldResultString = (char *) ckalloc((unsigned)
1703: (strlen(cmdInfoPtr->interp->result) + 1));
1704: strcpy(oldResultString, cmdInfoPtr->interp->result);
1705: oldFreeProc = TCL_DYNAMIC;
1706: }
1707: cmdInfoPtr->interp->freeProc = 0;
1708: if (Tcl_GlobalEval(cmdInfoPtr->interp, command) == TCL_OK) {
1709: length = strlen(cmdInfoPtr->interp->result);
1710: } else {
1711: length = 0;
1712: }
1713: if (length > maxBytes) {
1714: length = maxBytes;
1715: }
1716: memcpy((VOID *) buffer, (VOID *) cmdInfoPtr->interp->result, length);
1717: buffer[length] = '\0';
1718: Tcl_FreeResult(cmdInfoPtr->interp);
1719: cmdInfoPtr->interp->result = oldResultString;
1720: cmdInfoPtr->interp->freeProc = oldFreeProc;
1721:
1722: if (command != staticSpace) {
1723: ckfree(command);
1724: }
1725:
1726: return length;
1727: }
1728:
1729: /*
1730: *----------------------------------------------------------------------
1731: *
1732: * SelTimeoutProc --
1733: *
1734: * This procedure is invoked once every second while waiting for
1735: * the selection to be returned. After a while it gives up and
1736: * aborts the selection retrieval.
1737: *
1738: * Results:
1739: * None.
1740: *
1741: * Side effects:
1742: * A new timer callback is created to call us again in another
1743: * second, unless time has expired, in which case an error is
1744: * recorded for the retrieval.
1745: *
1746: *----------------------------------------------------------------------
1747: */
1748:
1749: static void
1750: SelTimeoutProc(clientData)
1751: ClientData clientData; /* Information about retrieval
1752: * in progress. */
1753: {
1754: register RetrievalInfo *retrPtr = (RetrievalInfo *) clientData;
1755:
1756: /*
1757: * Make sure that the retrieval is still in progress. Then
1758: * see how long it's been since any sort of response was received
1759: * from the other side.
1760: */
1761:
1762: if (retrPtr->result != -1) {
1763: return;
1764: }
1765: retrPtr->idleTime++;
1766: if (retrPtr->idleTime >= 5) {
1767:
1768: /*
1769: * Use a careful procedure to store the error message, because
1770: * the result could already be partially filled in with a partial
1771: * selection return.
1772: */
1773:
1774: Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
1775: TCL_STATIC);
1776: retrPtr->result = TCL_ERROR;
1777: } else {
1778: retrPtr->timeout = Tk_CreateTimerHandler(1000, SelTimeoutProc,
1779: (ClientData) retrPtr);
1780: }
1781: }
1782:
1783: /*
1784: *----------------------------------------------------------------------
1785: *
1786: * IncrTimeoutProc --
1787: *
1788: * This procedure is invoked once a second while sending the
1789: * selection to a requestor in INCR mode. After a while it
1790: * gives up and aborts the selection operation.
1791: *
1792: * Results:
1793: * None.
1794: *
1795: * Side effects:
1796: * A new timeout gets registered so that this procedure gets
1797: * called again in another second, unless too many seconds
1798: * have elapsed, in which case infoPtr is marked as "all done".
1799: *
1800: *----------------------------------------------------------------------
1801: */
1802:
1803: static void
1804: IncrTimeoutProc(clientData)
1805: ClientData clientData; /* Information about INCR-mode
1806: * selection retrieval for which
1807: * we are selection owner. */
1808: {
1809: register IncrInfo *infoPtr = (IncrInfo *) clientData;
1810:
1811: infoPtr->idleTime++;
1812: if (infoPtr->idleTime >= 5) {
1813: infoPtr->numIncrs = 0;
1814: } else {
1815: infoPtr->timeout = Tk_CreateTimerHandler(1000, IncrTimeoutProc,
1816: (ClientData) infoPtr);
1817: }
1818: }
1819:
1820: /*
1821: *----------------------------------------------------------------------
1822: *
1823: * DefaultSelection --
1824: *
1825: * This procedure is called to generate selection information
1826: * for a few standard targets such as TIMESTAMP and TARGETS.
1827: * It is invoked only if no handler has been declared by the
1828: * application.
1829: *
1830: * Results:
1831: * If "target" is a standard target understood by this procedure,
1832: * the selection is converted to that form and stored as a
1833: * character string in buffer. The type of the selection (e.g.
1834: * STRING or ATOM) is stored in *typePtr, and the return value is
1835: * a count of the # of non-NULL bytes at buffer. If the target
1836: * wasn't understood, or if there isn't enough space at buffer
1837: * to hold the entire selection (no INCR-mode transfers for this
1838: * stuff!), then -1 is returned.
1839: *
1840: * Side effects:
1841: * None.
1842: *
1843: *----------------------------------------------------------------------
1844: */
1845:
1846: static int
1847: DefaultSelection(winPtr, target, buffer, maxBytes, typePtr)
1848: TkWindow *winPtr; /* Window that owns selection. */
1849: Atom target; /* Desired form of selection. */
1850: char *buffer; /* Place to put selection characters. */
1851: int maxBytes; /* Maximum # of bytes to store at buffer. */
1852: Atom *typePtr; /* Store here the type of the selection,
1853: * for use in converting to proper X format. */
1854: {
1855: if (target == winPtr->dispPtr->timestampAtom) {
1856: if (maxBytes < 20) {
1857: return -1;
1858: }
1859: sprintf(buffer, "%#x", winPtr->dispPtr->selectionTime);
1860: *typePtr = XA_INTEGER;
1861: return strlen(buffer);
1862: }
1863:
1864: if (target == winPtr->dispPtr->targetsAtom) {
1865: register TkSelHandler *selPtr;
1866: char *atomString;
1867: int length, atomLength;
1868:
1869: if (maxBytes < 50) {
1870: return -1;
1871: }
1872: strcpy(buffer, "TARGETS MULTIPLE TIMESTAMP");
1873: length = strlen(buffer);
1874: for (selPtr = winPtr->selHandlerList; selPtr != NULL;
1875: selPtr = selPtr->nextPtr) {
1876: atomString = Tk_GetAtomName((Tk_Window) winPtr, selPtr->target);
1877: atomLength = strlen(atomString) + 1;
1878: if ((length + atomLength) >= maxBytes) {
1879: return -1;
1880: }
1881: sprintf(buffer+length, " %s", atomString);
1882: length += atomLength;
1883: }
1884: *typePtr = XA_ATOM;
1885: return length;
1886: }
1887:
1888: return -1;
1889: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.