4 * This file manages the selection for the Tk toolkit,
5 * translating between the standard X ICCCM conventions
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.
19 static char rcsid
[] = "$Header: /user6/ouster/wish/RCS/tkSelect.c,v 1.27 92/08/10 15:03:03 ouster Exp $ SPRITE (Berkeley)";
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).
36 typedef struct RetrievalInfo
{
37 Tcl_Interp
*interp
; /* Interpreter for error reporting. */
38 TkWindow
*winPtr
; /* Window used as requestor for
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
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
53 struct RetrievalInfo
*nextPtr
;
54 /* Next in list of all pending
55 * selection retrievals. NULL means
59 static RetrievalInfo
*pendingRetrievals
= NULL
;
60 /* List of all retrievals currently
61 * being waited for. */
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
72 char *string
; /* Contents of selection are
73 * here. This space is malloc-ed. */
74 int bytesAvl
; /* Total number of bytes available
76 int bytesUsed
; /* Bytes currently in use in string,
77 * not including the terminating
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.
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
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
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
118 struct IncrInfo
*nextPtr
; /* Next in list of all INCR-style
119 * retrievals currently pending. */
122 static IncrInfo
*pendingIncrs
= NULL
;
123 /* List of all IncrInfo structures
124 * currently active. */
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.
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. */
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.
147 #define TK_SEL_BYTES_AT_ONCE 4000
148 #define TK_SEL_WORDS_AT_ONCE 1001
151 * Largest property that we'll accept when sending or receiving the
155 #define MAX_PROP_WORDS 100000
158 * Forward declarations for procedures defined in this file:
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
,
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
,
178 static void SelTimeoutProc
_ANSI_ARGS_((ClientData clientData
));
181 *--------------------------------------------------------------
183 * Tk_CreateSelHandler --
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.
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:
202 * proc(clientData, offset, buffer, maxBytes)
203 * ClientData clientData;
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.
223 *--------------------------------------------------------------
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). */
241 register TkSelHandler
*selPtr
;
242 TkWindow
*winPtr
= (TkWindow
*) tkwin
;
244 if (winPtr
->dispPtr
->multipleAtom
== None
) {
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.
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
;
260 if (selPtr
->target
== target
) {
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?
268 if (selPtr
->proc
== HandleTclCommand
) {
269 ckfree((char *) selPtr
->clientData
);
274 selPtr
->target
= target
;
275 selPtr
->format
= format
;
277 selPtr
->clientData
= clientData
;
278 if (format
== XA_STRING
) {
286 *--------------------------------------------------------------
290 * Arrange for tkwin to become the selection owner.
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).
302 *--------------------------------------------------------------
306 Tk_OwnSelection(tkwin
, proc
, clientData
)
307 Tk_Window tkwin
; /* Window to become new selection
309 Tk_LostSelProc
*proc
; /* Procedure to call when selection
310 * is taken away from tkwin. */
311 ClientData clientData
; /* Arbitrary one-word argument to
314 register TkWindow
*winPtr
= (TkWindow
*) tkwin
;
315 TkDisplay
*dispPtr
= winPtr
->dispPtr
;
317 if (dispPtr
->multipleAtom
== None
) {
321 winPtr
->selClearProc
= proc
;
322 winPtr
->selClearData
= clientData
;
323 if (dispPtr
->selectionOwner
!= tkwin
) {
324 TkWindow
*ownerPtr
= (TkWindow
*) dispPtr
->selectionOwner
;
326 if ((ownerPtr
!= NULL
)
327 && (ownerPtr
->selClearProc
!= NULL
)) {
328 (*ownerPtr
->selClearProc
)(ownerPtr
->selClearData
);
329 ownerPtr
->selClearProc
= NULL
;
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
);
340 *--------------------------------------------------------------
344 * Retrieve the selection and pass it off (in pieces,
345 * possibly) to a given procedure.
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.
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
360 * proc(clientData, interp, portion)
361 * ClientData clientData;
362 * Tcl_Interp *interp;
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.
379 *--------------------------------------------------------------
383 Tk_GetSelection(interp
, tkwin
, target
, proc
, clientData
)
384 Tcl_Interp
*interp
; /* Interpreter to use for reporting
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. */
396 TkWindow
*winPtr
= (TkWindow
*) tkwin
;
397 TkDisplay
*dispPtr
= winPtr
->dispPtr
;
399 if (dispPtr
->multipleAtom
== None
) {
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).
411 if (dispPtr
->selectionOwner
!= NULL
) {
412 register TkSelHandler
*selPtr
;
413 int offset
, result
, count
;
414 char buffer
[TK_SEL_BYTES_AT_ONCE
+1];
418 * Make sure that the selection predates the request
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";
430 for (selPtr
= ((TkWindow
*) dispPtr
->selectionOwner
)->selHandlerList
;
431 ; selPtr
= selPtr
->nextPtr
) {
432 if (selPtr
== NULL
) {
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");
442 Tcl_AppendResult(interp
, "selection doesn't exist",
443 " or form \"", Tk_GetAtomName(tkwin
, target
),
444 "\" not defined", (char *) NULL
);
448 return (*proc
)(clientData
, interp
, buffer
);
450 if (selPtr
->target
== target
) {
456 count
= (*selPtr
->proc
)(selPtr
->clientData
, offset
,
457 buffer
, TK_SEL_BYTES_AT_ONCE
);
461 if (count
> TK_SEL_BYTES_AT_ONCE
) {
462 panic("selection handler returned too many bytes");
464 buffer
[count
] = '\0';
465 result
= (*proc
)(clientData
, interp
, buffer
);
466 if (result
!= TCL_OK
) {
469 if (count
< TK_SEL_BYTES_AT_ONCE
) {
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).
484 retr
.interp
= interp
;
485 if ((winPtr
->flags
& TK_TOP_LEVEL
)
486 && (winPtr
->childList
!= NULL
)) {
487 winPtr
= winPtr
->childList
;
489 retr
.winPtr
= winPtr
;
490 retr
.property
= XA_PRIMARY
;
491 retr
.target
= target
;
493 retr
.clientData
= clientData
;
496 retr
.nextPtr
= pendingRetrievals
;
497 pendingRetrievals
= &retr
;
500 * Initiate the request for the selection.
503 XConvertSelection(winPtr
->display
, XA_PRIMARY
, target
,
504 retr
.property
, winPtr
->window
, TkCurrentTime(dispPtr
));
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.
512 retr
.timeout
= Tk_CreateTimerHandler(1000, SelTimeoutProc
,
514 while (retr
.result
== -1) {
517 Tk_DeleteTimerHandler(retr
.timeout
);
520 * Unregister the information about the selection retrieval
524 if (pendingRetrievals
== &retr
) {
525 pendingRetrievals
= retr
.nextPtr
;
527 RetrievalInfo
*retrPtr
;
529 for (retrPtr
= pendingRetrievals
; retrPtr
!= NULL
;
530 retrPtr
= retrPtr
->nextPtr
) {
531 if (retrPtr
->nextPtr
== &retr
) {
532 retrPtr
->nextPtr
= retr
.nextPtr
;
541 *--------------------------------------------------------------
545 * This procedure is invoked to process the "selection" Tcl
546 * command. See the user documentation for details on what
550 * A standard Tcl result.
553 * See the user documentation.
555 *--------------------------------------------------------------
559 Tk_SelectionCmd(clientData
, interp
, argc
, argv
)
560 ClientData clientData
; /* Main window associated with
562 Tcl_Interp
*interp
; /* Current interpreter. */
563 int argc
; /* Number of arguments. */
564 char **argv
; /* Argument strings. */
566 Tk_Window tkwin
= (Tk_Window
) clientData
;
572 sprintf(interp
->result
,
573 "wrong # args: should be \"%.50s [-window win] option ?arg arg ...?\"",
580 length
= strlen(argv
[0]);
582 if ((c
== '-') && (strncmp(argv
[0], "-window", length
) == 0)) {
584 ((tkwin
= Tk_NameToWindow(interp
, argv
[1], tkwin
)) == NULL
)) {
585 sprintf(interp
->result
, "bad arg to %s -window", cmd
);
588 argc
-= 2; argv
+= 2;
591 sprintf(interp
->result
, "not enough args to %s", cmd
);
596 length
= strlen(argv
[0]);
599 if ((c
== 'g') && (strncmp(argv
[0], "get", length
) == 0)) {
607 sprintf(interp
->result
,
608 "too may args: should be \"%.50s get ?type?\"",
613 target
= Tk_InternAtom(tkwin
, argv
[0]);
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
);
625 ckfree(getInfo
.string
);
628 } else if ((c
== 'h') && (strncmp(argv
[0], "handle", length
) == 0)) {
631 register CommandInfo
*cmdInfoPtr
;
636 if ((argc
< 2) || (argc
> 4)) {
637 Tcl_AppendResult(interp
, "wrong # args: should be \"", cmd
,
638 " handle window command ?type? ?format?\"", (char *) NULL
);
641 window
= Tk_NameToWindow(interp
, argv
[0], tkwin
);
642 if (window
== NULL
) {
646 target
= Tk_InternAtom(window
, argv
[2]);
651 format
= Tk_InternAtom(window
, argv
[3]);
655 cmdLength
= strlen(argv
[1]);
656 cmdInfoPtr
= (CommandInfo
*) ckalloc((unsigned) (sizeof(CommandInfo
)
658 cmdInfoPtr
->interp
= interp
;
659 cmdInfoPtr
->cmdLength
= cmdLength
;
660 strcpy(cmdInfoPtr
->command
, argv
[1]);
661 Tk_CreateSelHandler(window
, target
, HandleTclCommand
,
662 (ClientData
) cmdInfoPtr
, format
);
665 sprintf(interp
->result
,
666 "bad option to \"%.50s\": must be get or handle",
673 *----------------------------------------------------------------------
677 * This procedure is invoked just before a TkWindow is deleted.
678 * It performs selection-related cleanup.
684 * Frees up memory associated with the selection.
686 *----------------------------------------------------------------------
690 TkSelDeadWindow(winPtr
)
691 register TkWindow
*winPtr
; /* Window that's being deleted. */
693 register TkSelHandler
*selPtr
;
696 selPtr
= winPtr
->selHandlerList
;
697 if (selPtr
== NULL
) {
700 winPtr
->selHandlerList
= selPtr
->nextPtr
;
701 ckfree((char *) selPtr
);
703 winPtr
->selClearProc
= NULL
;
705 if (winPtr
->dispPtr
->selectionOwner
== (Tk_Window
) winPtr
) {
706 winPtr
->dispPtr
->selectionOwner
= NULL
;
711 *----------------------------------------------------------------------
715 * Initialize selection-related information for a display.
723 *----------------------------------------------------------------------
728 Tk_Window tkwin
; /* Window token (used to find
729 * display to initialize). */
731 register TkDisplay
*dispPtr
= ((TkWindow
*) tkwin
)->dispPtr
;
734 * Fetch commonly-used atoms.
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");
746 *--------------------------------------------------------------
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.
758 * Lots: depends on the type of event.
760 *--------------------------------------------------------------
764 TkSelEventProc(tkwin
, eventPtr
)
765 Tk_Window tkwin
; /* Window for which event was
767 register XEvent
*eventPtr
; /* X event: either SelectionClear,
768 * SelectionRequest, or
769 * SelectionNotify. */
771 register TkWindow
*winPtr
= (TkWindow
*) tkwin
;
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
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
;
798 * Case #2: SelectionNotify events. Call the relevant procedure
799 * to handle the incoming selection.
802 if (eventPtr
->type
== SelectionNotify
) {
803 register RetrievalInfo
*retrPtr
;
807 unsigned long numItems
, bytesAfter
;
809 for (retrPtr
= pendingRetrievals
; ; retrPtr
= retrPtr
->nextPtr
) {
810 if (retrPtr
== NULL
) {
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
) {
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
;
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
)) {
841 if (bytesAfter
!= 0) {
842 Tcl_SetResult(retrPtr
->interp
, "selection property too large",
844 retrPtr
->result
= TCL_ERROR
;
848 if ((type
== XA_STRING
) || (type
== winPtr
->dispPtr
->textAtom
)
849 || (type
== winPtr
->dispPtr
->compoundTextAtom
)) {
851 sprintf(retrPtr
->interp
->result
,
852 "bad format for string selection: wanted \"8\", got \"%d\"",
854 retrPtr
->result
= TCL_ERROR
;
857 retrPtr
->result
= (*retrPtr
->proc
)(retrPtr
->clientData
,
858 retrPtr
->interp
, propInfo
);
859 } else if (type
== winPtr
->dispPtr
->incrAtom
) {
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
868 retrPtr
->idleTime
= 0;
869 Tk_CreateEventHandler(tkwin
, PropertyChangeMask
, SelRcvIncrProc
,
870 (ClientData
) retrPtr
);
871 XDeleteProperty(Tk_Display(tkwin
), Tk_WindowId(tkwin
),
873 while (retrPtr
->result
== -1) {
876 Tk_DeleteEventHandler(tkwin
, PropertyChangeMask
, SelRcvIncrProc
,
877 (ClientData
) retrPtr
);
882 sprintf(retrPtr
->interp
->result
,
883 "bad format for selection: wanted \"32\", got \"%d\"",
885 retrPtr
->result
= TCL_ERROR
;
888 string
= SelCvtFromX((long *) propInfo
, (int) numItems
, type
,
890 retrPtr
->result
= (*retrPtr
->proc
)(retrPtr
->clientData
,
891 retrPtr
->interp
, string
);
899 * Case #3: SelectionRequest events. Call ConvertSelection to
903 if ((eventPtr
->type
== SelectionRequest
)
904 && (eventPtr
->xselectionrequest
.selection
== XA_PRIMARY
)) {
905 ConvertSelection(winPtr
, &eventPtr
->xselectionrequest
);
911 *--------------------------------------------------------------
915 * This procedure is invoked to process pieces of the
916 * selection as they arrive during "selection get"
920 * Always returns TCL_OK.
923 * Bytes get appended to the result currently stored
924 * in interp->result, and its memory area gets
925 * expanded if necessary.
927 *--------------------------------------------------------------
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. */
939 register GetInfo
*getInfoPtr
= (GetInfo
*) clientData
;
942 newLength
= strlen(portion
) + getInfoPtr
->bytesUsed
;
945 * Grow the result area if we've run out of space.
948 if (newLength
>= getInfoPtr
->bytesAvl
) {
951 getInfoPtr
->bytesAvl
*= 2;
952 if (getInfoPtr
->bytesAvl
<= newLength
) {
953 getInfoPtr
->bytesAvl
= newLength
+ 1;
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
;
963 * Append the new data to what was already there.
966 strcpy(getInfoPtr
->string
+ getInfoPtr
->bytesUsed
, portion
);
967 getInfoPtr
->bytesUsed
= newLength
;
972 *----------------------------------------------------------------------
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.
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.
990 *----------------------------------------------------------------------
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
1007 long *propPtr
, *longPtr
;
1008 #define MAX_ATOM_NAME_LENGTH 100
1009 char atomName
[MAX_ATOM_NAME_LENGTH
+1];
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
1017 * 2. If type is anything else, convert each field from an ASCII number
1018 * to a 32-bit binary number.
1022 for (p
= string
; *p
!= 0; p
++) {
1027 propPtr
= (long *) ckalloc((unsigned) numFields
*sizeof(long));
1030 * Convert the fields one-by-one.
1033 for (longPtr
= propPtr
, *numLongsPtr
= 0, p
= string
;
1034 ; longPtr
++, (*numLongsPtr
)++) {
1035 while (isspace(*p
)) {
1042 while ((*p
!= 0) && !isspace(*p
)) {
1045 if (type
== XA_ATOM
) {
1049 if (length
> MAX_ATOM_NAME_LENGTH
) {
1050 length
= MAX_ATOM_NAME_LENGTH
;
1052 strncpy(atomName
, field
, length
);
1053 atomName
[length
] = 0;
1054 *longPtr
= (long) Tk_InternAtom(tkwin
, atomName
);
1058 *longPtr
= strtol(field
, &dummy
, 0);
1065 *----------------------------------------------------------------------
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.
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
1082 *----------------------------------------------------------------------
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. */
1095 int resultSpace
, curSize
, fieldSize
;
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.
1105 resultSpace
= 12*numValues
;
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;
1116 if (curSize
+fieldSize
>= resultSpace
) {
1120 if (curSize
+fieldSize
>= resultSpace
) {
1121 resultSpace
= curSize
+ fieldSize
+ 1;
1123 newResult
= (char *) ckalloc((unsigned) resultSpace
);
1124 strcpy(newResult
, result
);
1129 result
[curSize
] = ' ';
1132 if (type
== XA_ATOM
) {
1133 strcpy(result
+curSize
, atomName
);
1135 sprintf(result
+curSize
, "%#x", *propPtr
);
1137 curSize
+= strlen(result
+curSize
);
1143 *----------------------------------------------------------------------
1145 * ConvertSelection --
1147 * This procedure is invoked to handle SelectionRequest events.
1148 * It responds to the requests, obeying the ICCCM protocols.
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.
1159 *----------------------------------------------------------------------
1163 ConvertSelection(winPtr
, eventPtr
)
1164 TkWindow
*winPtr
; /* Window that owns selection. */
1165 register XSelectionRequestEvent
*eventPtr
;
1166 /* Event describing request. */
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. */
1176 Tk_ErrorHandler errorHandler
;
1178 errorHandler
= Tk_CreateErrorHandler(eventPtr
->display
, -1, -1,-1,
1179 (int (*)()) NULL
, (ClientData
) NULL
);
1182 * Initialize the reply event.
1185 reply
.type
= SelectionNotify
;
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
;
1196 reply
.time
= eventPtr
->time
;
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
1205 if ((winPtr
->dispPtr
->selectionOwner
!= (Tk_Window
) winPtr
)
1206 || ((eventPtr
->time
< winPtr
->dispPtr
->selectionTime
)
1207 && (eventPtr
->time
!= CurrentTime
)
1208 && (winPtr
->dispPtr
->selectionTime
!= CurrentTime
))) {
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.
1218 info
.winPtr
= winPtr
;
1219 if (eventPtr
->target
!= winPtr
->dispPtr
->multipleAtom
) {
1221 singleInfo
[0] = reply
.target
;
1222 singleInfo
[1] = reply
.property
;
1223 info
.multAtoms
= singleInfo
;
1224 info
.numConversions
= 1;
1228 unsigned long bytesAfter
;
1231 info
.multAtoms
= NULL
;
1232 if (eventPtr
->property
== None
) {
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
);
1247 info
.numConversions
/= 2; /* Two atoms per conversion. */
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).
1257 info
.offsets
= (int *) ckalloc((unsigned) (info
.numConversions
*sizeof(int)));
1259 for (i
= 0; i
< info
.numConversions
; i
++) {
1260 Atom target
, property
;
1261 long buffer
[TK_SEL_WORDS_AT_ONCE
];
1262 register TkSelHandler
*selPtr
;
1264 target
= info
.multAtoms
[2*i
];
1265 property
= info
.multAtoms
[2*i
+ 1];
1266 info
.offsets
[i
] = -1;
1268 for (selPtr
= winPtr
->selHandlerList
; ; selPtr
= selPtr
->nextPtr
) {
1269 int numItems
, format
;
1273 if (selPtr
== NULL
) {
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.
1281 numItems
= DefaultSelection(winPtr
, target
, (char *) buffer
,
1282 TK_SEL_BYTES_AT_ONCE
, &type
);
1283 if (numItems
!= 0) {
1286 info
.multAtoms
[2*i
+ 1] = None
;
1288 } else if (selPtr
->target
== target
) {
1289 numItems
= (*selPtr
->proc
)(selPtr
->clientData
, 0,
1290 (char *) buffer
, TK_SEL_BYTES_AT_ONCE
);
1292 info
.multAtoms
[2*i
+ 1] = None
;
1295 if (numItems
> TK_SEL_BYTES_AT_ONCE
) {
1296 panic("selection handler returned too many bytes");
1298 ((char *) buffer
)[numItems
] = '\0';
1299 type
= selPtr
->format
;
1305 if (numItems
== TK_SEL_BYTES_AT_ONCE
) {
1307 type
= winPtr
->dispPtr
->incrAtom
;
1308 buffer
[0] = 10; /* Guess at # items avl. */
1310 propPtr
= (char *) buffer
;
1312 info
.offsets
[i
] = 0;
1313 } else if (type
== XA_STRING
) {
1314 propPtr
= (char *) buffer
;
1317 propPtr
= (char *) SelCvtToX((char *) buffer
,
1318 type
, (Tk_Window
) winPtr
, &numItems
);
1321 XChangeProperty(reply
.display
, reply
.requestor
,
1322 property
, type
, format
, PropModeReplace
,
1323 (unsigned char *) propPtr
, numItems
);
1324 if (propPtr
!= (char *) buffer
) {
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
1338 if (info
.numIncrs
> 0) {
1339 XSelectInput(reply
.display
, reply
.requestor
, PropertyChangeMask
);
1340 info
.timeout
= Tk_CreateTimerHandler(1000, IncrTimeoutProc
,
1341 (ClientData
) &info
);
1343 info
.reqWindow
= reply
.requestor
;
1344 info
.time
= winPtr
->dispPtr
->selectionTime
;
1345 info
.nextPtr
= pendingIncrs
;
1346 pendingIncrs
= &info
;
1349 XChangeProperty(reply
.display
, reply
.requestor
, reply
.property
,
1350 XA_ATOM
, 32, PropModeReplace
,
1351 (unsigned char *) info
.multAtoms
,
1352 (int) info
.numConversions
*2);
1356 * Not a MULTIPLE request. The first property in "multAtoms"
1357 * got set to None if there was an error in conversion.
1360 reply
.property
= info
.multAtoms
[1];
1362 XSendEvent(reply
.display
, reply
.requestor
, False
, 0, (XEvent
*) &reply
);
1363 Tk_DeleteErrorHandler(errorHandler
);
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.
1371 if (info
.numIncrs
> 0) {
1374 while (info
.numIncrs
> 0) {
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
;
1385 for (infoPtr2
= pendingIncrs
; infoPtr2
!= NULL
;
1386 infoPtr2
= infoPtr2
->nextPtr
) {
1387 if (infoPtr2
->nextPtr
== &info
) {
1388 infoPtr2
->nextPtr
= info
.nextPtr
;
1396 * All done. Cleanup and return.
1399 ckfree((char *) info
.offsets
);
1401 XFree((char *) info
.multAtoms
);
1406 * An error occurred. Send back a refusal message.
1410 reply
.property
= None
;
1411 XSendEvent(reply
.display
, reply
.requestor
, False
, 0, (XEvent
*) &reply
);
1412 Tk_DeleteErrorHandler(errorHandler
);
1417 *----------------------------------------------------------------------
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).
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.
1435 *----------------------------------------------------------------------
1439 SelRcvIncrProc(clientData
, eventPtr
)
1440 ClientData clientData
; /* Information about retrieval. */
1441 register XEvent
*eventPtr
; /* X PropertyChange event. */
1443 register RetrievalInfo
*retrPtr
= (RetrievalInfo
*) clientData
;
1447 unsigned long numItems
, bytesAfter
;
1449 if ((eventPtr
->xproperty
.atom
!= retrPtr
->property
)
1450 || (eventPtr
->xproperty
.state
!= PropertyNewValue
)
1451 || (retrPtr
->result
!= -1)) {
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
)) {
1462 if (bytesAfter
!= 0) {
1463 Tcl_SetResult(retrPtr
->interp
, "selection property too large",
1465 retrPtr
->result
= TCL_ERROR
;
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
)) {
1474 Tcl_SetResult(retrPtr
->interp
, (char *) NULL
, TCL_STATIC
);
1475 sprintf(retrPtr
->interp
->result
,
1476 "bad format for string selection: wanted \"8\", got \"%d\"",
1478 retrPtr
->result
= TCL_ERROR
;
1481 result
= (*retrPtr
->proc
)(retrPtr
->clientData
, retrPtr
->interp
,
1483 if (result
!= TCL_OK
) {
1484 retrPtr
->result
= result
;
1490 Tcl_SetResult(retrPtr
->interp
, (char *) NULL
, TCL_STATIC
);
1491 sprintf(retrPtr
->interp
->result
,
1492 "bad format for selection: wanted \"32\", got \"%d\"",
1494 retrPtr
->result
= TCL_ERROR
;
1497 string
= SelCvtFromX((long *) propInfo
, (int) numItems
, type
,
1498 (Tk_Window
) retrPtr
->winPtr
);
1499 result
= (*retrPtr
->proc
)(retrPtr
->clientData
, retrPtr
->interp
,
1501 if (result
!= TCL_OK
) {
1502 retrPtr
->result
= result
;
1509 retrPtr
->idleTime
= 0;
1513 *----------------------------------------------------------------------
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.
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.
1532 *----------------------------------------------------------------------
1536 TkSelPropProc(eventPtr
)
1537 register XEvent
*eventPtr
; /* X PropertyChange event. */
1539 register IncrInfo
*infoPtr
;
1542 register TkSelHandler
*selPtr
;
1543 long buffer
[TK_SEL_WORDS_AT_ONCE
];
1546 Tk_ErrorHandler errorHandler
;
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.
1554 if (eventPtr
->xproperty
.state
!= PropertyDelete
) {
1557 for (infoPtr
= pendingIncrs
; infoPtr
!= NULL
;
1558 infoPtr
= infoPtr
->nextPtr
) {
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.
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
)) {
1574 for (i
= 0; i
< infoPtr
->numConversions
; i
++) {
1575 if ((eventPtr
->xproperty
.atom
!= infoPtr
->multAtoms
[2*i
+ 1])
1576 || (infoPtr
->offsets
[i
] == -1)){
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
--;
1589 if (selPtr
->target
== target
) {
1590 if (infoPtr
->offsets
[i
] == -2) {
1592 ((char *) buffer
)[0] = 0;
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");
1604 ((char *) buffer
)[numItems
] = '\0';
1606 if (numItems
< TK_SEL_BYTES_AT_ONCE
) {
1607 if (numItems
<= 0) {
1608 infoPtr
->offsets
[i
] = -1;
1609 infoPtr
->numIncrs
--;
1611 infoPtr
->offsets
[i
] = -2;
1614 infoPtr
->offsets
[i
] += numItems
;
1616 if (selPtr
->format
== XA_STRING
) {
1617 propPtr
= (char *) buffer
;
1620 propPtr
= (char *) SelCvtToX((char *) buffer
,
1622 (Tk_Window
) infoPtr
->winPtr
,
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
) {
1646 *----------------------------------------------------------------------
1648 * HandleTclCommand --
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.
1655 * The return value is a count of the number of bytes actually
1659 * None except for things done by the Tcl command.
1661 *----------------------------------------------------------------------
1665 HandleTclCommand(clientData
, offset
, buffer
, maxBytes
)
1666 ClientData clientData
; /* Information about command to execute. */
1667 int offset
; /* Return selection bytes starting at this
1669 char *buffer
; /* Place to store converted selection. */
1670 int maxBytes
; /* Maximum # of bytes to store at buffer. */
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
];
1681 * First, generate a command by taking the command string
1682 * and appending the offset and maximum # of bytes.
1685 spaceNeeded
= cmdInfoPtr
->cmdLength
+ 30;
1686 if (spaceNeeded
< MAX_STATIC_SIZE
) {
1687 command
= staticSpace
;
1689 command
= (char *) ckalloc((unsigned) spaceNeeded
);
1691 sprintf(command
, "%s %d %d", cmdInfoPtr
->command
, offset
, maxBytes
);
1694 * Execute the command. Be sure to restore the state of the
1695 * interpreter after executing the command.
1698 oldFreeProc
= cmdInfoPtr
->interp
->freeProc
;
1699 if (oldFreeProc
!= 0) {
1700 oldResultString
= cmdInfoPtr
->interp
->result
;
1702 oldResultString
= (char *) ckalloc((unsigned)
1703 (strlen(cmdInfoPtr
->interp
->result
) + 1));
1704 strcpy(oldResultString
, cmdInfoPtr
->interp
->result
);
1705 oldFreeProc
= TCL_DYNAMIC
;
1707 cmdInfoPtr
->interp
->freeProc
= 0;
1708 if (Tcl_GlobalEval(cmdInfoPtr
->interp
, command
) == TCL_OK
) {
1709 length
= strlen(cmdInfoPtr
->interp
->result
);
1713 if (length
> maxBytes
) {
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
;
1722 if (command
!= staticSpace
) {
1730 *----------------------------------------------------------------------
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.
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.
1746 *----------------------------------------------------------------------
1750 SelTimeoutProc(clientData
)
1751 ClientData clientData
; /* Information about retrieval
1754 register RetrievalInfo
*retrPtr
= (RetrievalInfo
*) clientData
;
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.
1762 if (retrPtr
->result
!= -1) {
1765 retrPtr
->idleTime
++;
1766 if (retrPtr
->idleTime
>= 5) {
1769 * Use a careful procedure to store the error message, because
1770 * the result could already be partially filled in with a partial
1774 Tcl_SetResult(retrPtr
->interp
, "selection owner didn't respond",
1776 retrPtr
->result
= TCL_ERROR
;
1778 retrPtr
->timeout
= Tk_CreateTimerHandler(1000, SelTimeoutProc
,
1779 (ClientData
) retrPtr
);
1784 *----------------------------------------------------------------------
1786 * IncrTimeoutProc --
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.
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".
1800 *----------------------------------------------------------------------
1804 IncrTimeoutProc(clientData
)
1805 ClientData clientData
; /* Information about INCR-mode
1806 * selection retrieval for which
1807 * we are selection owner. */
1809 register IncrInfo
*infoPtr
= (IncrInfo
*) clientData
;
1811 infoPtr
->idleTime
++;
1812 if (infoPtr
->idleTime
>= 5) {
1813 infoPtr
->numIncrs
= 0;
1815 infoPtr
->timeout
= Tk_CreateTimerHandler(1000, IncrTimeoutProc
,
1816 (ClientData
) infoPtr
);
1821 *----------------------------------------------------------------------
1823 * DefaultSelection --
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
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.
1843 *----------------------------------------------------------------------
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. */
1855 if (target
== winPtr
->dispPtr
->timestampAtom
) {
1856 if (maxBytes
< 20) {
1859 sprintf(buffer
, "%#x", winPtr
->dispPtr
->selectionTime
);
1860 *typePtr
= XA_INTEGER
;
1861 return strlen(buffer
);
1864 if (target
== winPtr
->dispPtr
->targetsAtom
) {
1865 register TkSelHandler
*selPtr
;
1867 int length
, atomLength
;
1869 if (maxBytes
< 50) {
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
) {
1881 sprintf(buffer
+length
, " %s", atomString
);
1882 length
+= atomLength
;