]> git.zerfleddert.de Git - micropolis/blame - src/tk/tkselect.c
remove executable bit from sounds
[micropolis] / src / tk / tkselect.c
CommitLineData
6a5fa4e0
MG
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
19static 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
36typedef 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
59static 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
71typedef 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
87typedef 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
122static 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
132typedef 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
161static void ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
162 XSelectionRequestEvent *eventPtr));
163static int DefaultSelection _ANSI_ARGS_((TkWindow *winPtr,
164 Atom target, char *buffer, int maxBytes,
165 Atom *typePtr));
166static int HandleTclCommand _ANSI_ARGS_((ClientData clientData,
167 int offset, char *buffer, int maxBytes));
168static void IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
169static char * SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
170 Atom type, Tk_Window tkwin));
171static long * SelCvtToX _ANSI_ARGS_((char *string, Atom type,
172 Tk_Window tkwin, int *numLongsPtr));
173static int SelGetProc _ANSI_ARGS_((ClientData clientData,
174 Tcl_Interp *interp, char *portion));
175static void SelInit _ANSI_ARGS_((Tk_Window tkwin));
176static void SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
177 XEvent *eventPtr));
178static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
179\f
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
226void
227Tk_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\f
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
305void
306Tk_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\f
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
382int
383Tk_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\f
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
558int
559Tk_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\f
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
689void
690TkSelDeadWindow(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\f
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
726static void
727SelInit(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\f
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
763void
764TkSelEventProc(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\f
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 */
931static int
932SelGetProc(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\f
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
993static long *
994SelCvtToX(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\f
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
1085static char *
1086SelCvtFromX(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\f
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
1162static void
1163ConvertSelection(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\f
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
1438static void
1439SelRcvIncrProc(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\f
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
1535void
1536TkSelPropProc(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\f
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
1664static int
1665HandleTclCommand(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\f
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
1749static void
1750SelTimeoutProc(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\f
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
1803static void
1804IncrTimeoutProc(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\f
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
1846static int
1847DefaultSelection(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}
Impressum, Datenschutz