*** empty log message ***
[emacs.git] / src / xselect.c.old
blobaa415afc66338708e43e09fe65fd3d6aa47fbc90
1 /* X Selection processing for emacs
2    Copyright (C) 1990, 1992 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING.  If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
20 #include "config.h"
21 #include "lisp.h"
22 #include "xterm.h"
23 #include "buffer.h"
24 #include "frame.h"
26 #ifdef HAVE_X11
28 /* Macros for X Selections */
29 #define MAX_SELECTION(dpy) (((dpy)->max_request_size << 2) - 100)
30 #define SELECTION_LENGTH(len,format) ((len) * ((format) >> 2))
32 /* The timestamp of the last input event we received from the X server.  */
33 unsigned long last_event_timestamp;
35 /* t if a mouse button is depressed. */
36 extern Lisp_Object Vmouse_grabbed;
38 /* When emacs became the PRIMARY selection owner. */
39 Time x_begin_selection_own;
41 /* When emacs became the SECONDARY selection owner. */
42 Time x_begin_secondary_selection_own;
44 /* When emacs became the CLIPBOARD selection owner. */
45 Time x_begin_clipboard_own;
47 /* The value of the current CLIPBOARD selection. */
48 Lisp_Object Vx_clipboard_value;
50 /* The value of the current PRIMARY selection. */
51 Lisp_Object Vx_selection_value;
53 /* The value of the current SECONDARY selection. */
54 Lisp_Object Vx_secondary_selection_value;
56 /* Types of selections we may make.  Note that Qcut_buffer0 isn't really
57    a selection, but it acts like one for the sake of Fx_own_selection and
58    Fx_selection_value.  */
59 Lisp_Object Qprimary, Qsecondary, Qclipboard, Qcut_buffer0;
61 /* Emacs' selection property identifiers. */
62 Atom Xatom_emacs_selection;
63 Atom Xatom_emacs_secondary_selection;
65 /* Clipboard selection atom. */
66 Atom Xatom_clipboard_selection;
68 /* Clipboard atom. */
69 Atom Xatom_clipboard;
71 /* Atom for indicating incremental selection transfer. */
72 Atom Xatom_incremental;
74 /* Atom for indicating multiple selection request list */
75 Atom Xatom_multiple;
77 /* Atom for what targets emacs handles. */
78 Atom Xatom_targets;
80 /* Atom for indicating timstamp selection request */
81 Atom Xatom_timestamp;
83 /* Atom requesting we delete our selection. */
84 Atom Xatom_delete;
86 /* Selection magic. */
87 Atom Xatom_insert_selection;
89 /* Type of property for INSERT_SELECTION. */
90 Atom Xatom_pair;
92 /* More selection magic. */
93 Atom Xatom_insert_property;
95 /* Atom for indicating property type TEXT */
96 Atom Xatom_text;
98 /* Kinds of protocol things we may receive. */
99 Atom Xatom_wm_take_focus;
100 Atom Xatom_wm_save_yourself;
101 Atom Xatom_wm_delete_window;
103 /* Communication with window managers. */
104 Atom Xatom_wm_protocols;
106 /* These are to handle incremental selection transfer. */
107 Window incr_requestor;
108 Atom incr_property;
109 int incr_nbytes;
110 unsigned char *incr_value;
111 unsigned char *incr_ptr;
113 /* SELECTION OWNER CODE */
116 /* Request selection ownership if we do not already have it. */
118 static int
119 own_selection (selection_type, time)
120      Atom selection_type;
121      Time time;
123   Window owner_window, selecting_window;
125   if ((EQ (selection_type, Qprimary) && !NILP (Vx_selection_value))
126       || ((EQ (selection_type, Qsecondary)) && !NILP (Vx_secondary_selection_value))
127       || ((EQ (selection_type, Qclipboard)) && !NILP (Vx_clipboard_value)))
128     return 1;
130   selecting_window = selected_frame->display.x->window_desc;
131   XSetSelectionOwner (x_current_display, selection_type,
132                       selecting_window, time);
133   owner_window = XGetSelectionOwner (x_current_display, selection_type);
135       if (owner_window != selecting_window)
136     return 0;
138   return 1;
141 /* Become the selection owner and make our data the selection value.
142    If we are already the owner, merely change data and timestamp values.
143    This avoids generating SelectionClear events for ourselves. */
145 DEFUN ("x-own-selection", Fx_own_selection, Sx_own_selection,
146   1, 2, "",
147   "Make STRING the selection value.  Default is the primary selection,\n\
148 but optional second argument TYPE may specify secondary or clipboard.\n\
150 TYPE may also be cut-buffer0, indicating that Emacs should set the X\n\
151 cut buffer 0 to STRING.  This is for compatibility with older X\n\
152 applications which still use the cut buffers; new applications should\n\
153 use X selections.")
154   (string, type)
155      register Lisp_Object string, type;
157   Atom selection_type;
158   Lisp_Object val;
159   Time event_time = last_event_timestamp;
160   CHECK_STRING (string, 0);
162   if (NILP (type) || EQ (type, Qprimary))
163     {
164       BLOCK_INPUT;
165       if (own_selection (XA_PRIMARY, event_time))
166         {
167           x_begin_selection_own = event_time;
168           val = Vx_selection_value = string;
169         }
170       UNBLOCK_INPUT;
171     }
172   else if (EQ (type, Qsecondary))
173     {
174       BLOCK_INPUT;
175       if (own_selection (XA_SECONDARY, event_time))
176         {
177           x_begin_secondary_selection_own = event_time;
178           val = Vx_secondary_selection_value = string;
179         }
180       UNBLOCK_INPUT;
181     }
182   else if (EQ (type, Qclipboard))
183     {
184       BLOCK_INPUT;
185       if (own_selection (Xatom_clipboard, event_time))
186         {
187           x_begin_clipboard_own = event_time;
188           val = Vx_clipboard_value = string;
189         }
190       UNBLOCK_INPUT;
191     }
192   else if (EQ (type, Qcut_buffer0))
193     {
194       BLOCK_INPUT;
195       XStoreBytes (x_current_display,
196                    (char *) XSTRING (string)->data,
197                    XSTRING (string)->size);
198       UNBLOCK_INPUT;
199     }
200   else
201     error ("Invalid X selection type");
203   return val;
206 /* Clear our selection ownership data, as some other client has
207    become the owner. */
209 void
210 x_disown_selection (old_owner, selection, changed_owner_time)
211      Window *old_owner;
212      Atom selection;
213      Time changed_owner_time;
215   struct frame *s = x_window_to_frame (old_owner);
217   if (s)                        /* We are the owner */
218     {
219       if (selection == XA_PRIMARY)
220         {
221           x_begin_selection_own = 0;
222           Vx_selection_value = Qnil;
223         }
224       else if (selection == XA_SECONDARY)
225         {
226           x_begin_secondary_selection_own = 0;
227           Vx_secondary_selection_value = Qnil;
228         }
229       else if (selection == Xatom_clipboard)
230         {
231           x_begin_clipboard_own = 0;
232           Vx_clipboard_value = Qnil;
233         }
234       else
235         abort ();
236     }
237   else
238     abort ();                   /* Inconsistent state. */
241 int x_selection_alloc_error;
242 int x_converting_selection;
244 /* Reply to some client's request for our selection data.  Data is
245    placed in a property supplied by the requesting window.
247    If the data exceeds the maximum amount the server can send,
248    then prepare to send it incrementally, and reply to the client with
249    the total size of the data.
251    But first, check for all the other crufty stuff we could get. */
253 void
254 x_answer_selection_request (event)
255      XSelectionRequestEvent event;
257   Time emacs_own_time;
258   Lisp_Object selection_value;
259   XSelectionEvent evt;
260   int format = 8;               /* We have only byte sized (text) data. */
262   evt.type = SelectionNotify;   /* Construct reply event */
263   evt.display = event.display;
264   evt.requestor = event.requestor;
265   evt.selection = event.selection;
266   evt.time = event.time;
267   evt.target = event.target;
269   if (event.selection == XA_PRIMARY)
270     {
271       emacs_own_time = x_begin_selection_own;
272       selection_value = Vx_selection_value;
273     }
274   else if (event.selection == XA_SECONDARY)
275     {
276       emacs_own_time = x_begin_secondary_selection_own;
277       selection_value = Vx_secondary_selection_value;
278     }
279   else if (event.selection == Xatom_clipboard)
280     {
281       emacs_own_time = x_begin_clipboard_own;
282       selection_value = Vx_clipboard_value;
283     }
284   else
285     abort ();
287   if (event.time != CurrentTime
288       && event.time < emacs_own_time)
289     evt.property = None;
290   else
291     {
292       if (event.property == None)       /* obsolete client */
293         evt.property = event.target;
294       else
295         evt.property = event.property;
296     }
298   if (event.target == Xatom_targets)          /* Send List of target atoms */
299     {
300     }
301   else if (event.target == Xatom_multiple)    /* Recvd list: <target, prop> */
302     {
303       Atom type;
304       int return_format;
305       unsigned long items, bytes_left;
306       unsigned char *data;
307       int result, i;
309       if (event.property == 0   /* 0 == NILP */
310           || event.property == None)
311         return;
313       result = XGetWindowProperty (event.display, event.requestor,
314                                    event.property, 0L, 10000000L,
315                                    True, Xatom_pair, &type, &return_format,
316                                    &items, &bytes_left, &data);
318       if (result == Success && type == Xatom_pair)
319         for (i = items; i > 0; i--)
320           {
321             /* Convert each element of the list. */
322           }
324       (void) XSendEvent (x_current_display, evt.requestor, False,
325                          0L, (XEvent *) &evt);
326       return;
327     }
328   else if (event.target == Xatom_timestamp)   /* Send ownership timestamp */
329     {
330       if (! emacs_own_time)
331         abort ();
333       format = 32;
334       XChangeProperty (evt.display, evt.requestor, evt.property,
335                        evt.target, format, PropModeReplace,
336                        (unsigned char *) &emacs_own_time, 1);
337       return;
338     }
339   else if (event.target == Xatom_delete)      /* Delete our selection. */
340     {
341       if (EQ (Qnil, selection_value))
342         abort ();
344       x_disown_selection (event.owner, event.selection, event.time);
346       /* Now return property of type NILP, length 0. */
347       XChangeProperty (event.display, event.requestor, event.property,
348                        0, format, PropModeReplace, (unsigned char *) 0, 0);
349       return;
350     }
351   else if (event.target == Xatom_insert_selection)
352     {
353       Atom type;
354       int return_format;
355       unsigned long items, bytes_left;
356       unsigned char *data;
357       int result = XGetWindowProperty (event.display, event.requestor,
358                                        event.property, 0L, 10000000L,
359                                        True, Xatom_pair, &type, &return_format,
360                                        &items, &bytes_left, &data);
361       if (result == Success && type == Xatom_pair)
362         {
363           /* Convert the first atom to (a selection) to the target
364              indicated by the second atom. */
365         }
366     }
367   else if (event.target == Xatom_insert_property)
368     {
369       Atom type;
370       int return_format;
371       unsigned long items, bytes_left;
372       unsigned char *data;
373       int result = XGetWindowProperty (event.display, event.requestor,
374                                        event.property, 0L, 10000000L,
375                                        True, XA_STRING, &type, &return_format,
376                                        &items, &bytes_left, &data);
378       if (result == Success && type == XA_STRING && return_format == 8)
379         {
380           if (event.selection == Xatom_emacs_selection)
381             Vx_selection_value = make_string (data);
382           else if (event.selection == Xatom_emacs_secondary_selection)
383             Vx_secondary_selection_value = make_string (data);
384           else if (event.selection == Xatom_clipboard_selection)
385             Vx_clipboard_value = make_string (data);
386           else
387             abort ();
388         }
390       return;
391     }
392   else if ((event.target == Xatom_text
393             || event.target == XA_STRING))
394     {
395       int size = XSTRING (selection_value)->size;
396       unsigned char *data = XSTRING (selection_value)->data;
397                 
398       if (EQ (Qnil, selection_value))
399         abort ();
401       /* Place data on requestor window's property. */
402       if (SELECTION_LENGTH (size, format)
403           <= MAX_SELECTION (x_current_display))
404         {
405           x_converting_selection = 1;
406           XChangeProperty (evt.display, evt.requestor, evt.property,
407                            evt.target, format, PropModeReplace,
408                            data, size);
409           if (x_selection_alloc_error)
410             {
411               x_selection_alloc_error = 0;
412               abort ();
413             }
414           x_converting_selection = 0;
415         }
416       else  /* Send incrementally */
417         {
418           evt.target = Xatom_incremental;
419           incr_requestor = evt.requestor;
420           incr_property = evt.property;
421           x_converting_selection = 1;
423           /* Need to handle Alloc errors on these requests. */
424           XChangeProperty (evt.display, incr_requestor, incr_property,
425                            Xatom_incremental, 32,
426                            PropModeReplace,
427                            (unsigned char *) &size, 1);
428           if (x_selection_alloc_error)
429             {
430               x_selection_alloc_error = 0;
431               x_converting_selection = 0;
432               abort ();
433               /* Now abort the send. */
434             }
436           incr_nbytes = size;
437           incr_value = data;
438           incr_ptr = data;
440           /* Ask for notification when requestor deletes property. */
441           XSelectInput (x_current_display, incr_requestor, PropertyChangeMask);
443           /* If we're sending incrementally, perhaps block here
444              until all sent? */
445         }
446     }
447   else
448     evt.property = None;
450   /* Don't do this if there was an Alloc error:  abort the transfer
451      by sending None. */
452   (void) XSendEvent (x_current_display, evt.requestor, False,
453                      0L, (XEvent *) &evt);
456 /* Send an increment of selection data in response to a PropertyNotify event.
457    The increment is placed in a property on the requestor's window.
458    When the requestor has processed the increment, it deletes the property,
459    which sends us another PropertyNotify event.
461    When there is no more data to send, we send a zero-length increment. */
463 void
464 x_send_incremental (event)
465      XPropertyEvent event;
467   if (incr_requestor
468       && incr_requestor == event.window
469       && incr_property == event.atom
470       && event.state == PropertyDelete)
471     {
472       int format = 8;
473       int length = MAX_SELECTION (x_current_display);
474       int bytes_left = (incr_nbytes - (incr_ptr - incr_value));
475                 
476       if (length > bytes_left)  /* Also sends 0 len when finished. */
477         length = bytes_left;
478       XChangeProperty (x_current_display, incr_requestor,
479                        incr_property, XA_STRING, format,
480                        PropModeAppend, incr_ptr, length);
481       if (x_selection_alloc_error)
482         {
483           x_selection_alloc_error = 0;
484           x_converting_selection = 0;
485           /* Abandon the transmission. */
486           abort ();
487         }
488       if (length > 0)
489         incr_ptr += length;
490       else
491         {                       /* Everything's sent */
492           XSelectInput (x_current_display, incr_requestor, 0L);
493           incr_requestor = (Window) 0;
494           incr_property = (Atom) 0;
495           incr_nbytes = 0;
496           incr_value = (unsigned char *) 0;
497           incr_ptr = (unsigned char *) 0;
498           x_converting_selection = 0;
499         }
500     }
503 /* SELECTION REQUESTOR CODE */
505 /* Predicate function used to match a requested event. */
507 Bool
508 XCheckSelectionEvent (dpy, event, window)
509      Display *dpy;
510      XEvent *event;
511      char *window;
513   if (event->type == SelectionNotify)
514     if (event->xselection.requestor == (Window) window)
515       return True;
517   return False;
520 /* Request a selection value from its owner.  This will block until
521    all the data is arrived. */
523 static Lisp_Object
524 get_selection_value (type)
525      Atom type;
527   XEvent event;
528   Lisp_Object val;
529   Time requestor_time;          /* Timestamp of selection request. */
530   Window requestor_window;
532   BLOCK_INPUT;
533   requestor_time = last_event_timestamp;
534   requestor_window = selected_frame->display.x->window_desc;
535   XConvertSelection (x_current_display, type, XA_STRING,
536                      Xatom_emacs_selection, requestor_window, requestor_time);
537   XIfEvent (x_current_display,
538             &event,
539             XCheckSelectionEvent,
540             (char *) requestor_window);
541   val = x_selection_arrival (&event, requestor_window, requestor_time);
542   UNBLOCK_INPUT;
544   return val;
547 /* Request a selection value from the owner.  If we are the owner,
548    simply return our selection value.  If we are not the owner, this
549    will block until all of the data has arrived. */
551 DEFUN ("x-selection-value", Fx_selection_value, Sx_selection_value,
552   0, 1, "",
553   "Return the value of one of the selections.  Default is the primary\n\
554 selection, but optional argument TYPE may specify secondary or clipboard.")
555   (type)
556      register Lisp_Object type;
558   Atom selection_type;
560   if (NILP (type) || EQ (type, Qprimary))
561     {
562       if (!NILP (Vx_selection_value))
563     return Vx_selection_value;
565       return get_selection_value (XA_PRIMARY);
566     }
567   else if (EQ (type, Qsecondary))
568     {
569       if (!NILP (Vx_secondary_selection_value))
570         return Vx_secondary_selection_value;
572       return get_selection_value (XA_SECONDARY);
573     }
574   else if (EQ (type, Qclipboard))
575     {
576       if (!NILP (Vx_clipboard_value))
577         return Vx_clipboard_value;
579       return get_selection_value (Xatom_clipboard);
580     }
581   else if (EQ (type, Qcut_buffer0))
582     {
583       char *data;
584       int size;
585       Lisp_Object string;
587       BLOCK_INPUT;
588       data = XFetchBytes (x_current_display, &size);
589       if (data == 0)
590         string = Qnil;
591       else
592         string = make_string (data, size);
593       UNBLOCK_INPUT;
594       
595       return string;
596     }
597   else
598     error ("Invalid X selection type");
601 Lisp_Object
602 x_selection_arrival (event, requestor_window, requestor_time)
603      register XSelectionEvent *event;
604      Window requestor_window;
605      Time requestor_time;
607   int result;
608   Atom type, selection;
609   int format;
610   unsigned long items;
611   unsigned long bytes_left;
612   unsigned char *data = 0;
613   int offset = 0;
615   if (event->selection == XA_PRIMARY)
616     selection = Xatom_emacs_selection;
617   else if (event->selection == XA_SECONDARY)
618     selection = Xatom_emacs_secondary_selection;
619   else if (event->selection == Xatom_clipboard)
620     selection = Xatom_clipboard_selection;
621   else
622     abort ();
624   if (event->requestor == requestor_window
625       && event->time == requestor_time
626       && event->property != None)
627     if (event->target != Xatom_incremental)
628       {
629         unsigned char *return_string =
630           (unsigned char *) alloca (MAX_SELECTION (x_current_display));
632         do
633           {
634             result = XGetWindowProperty (x_current_display, requestor_window,
635                                          event->property, 0L,
636                                          10000000L, True, XA_STRING,
637                                          &type, &format, &items,
638                                          &bytes_left, &data);
639             if (result == Success && type == XA_STRING && format == 8
640                 && offset < MAX_SELECTION (x_current_display))
641               {
642                 bcopy (data, return_string + offset, items);
643                 offset += items;
644               }
645             XFree ((char *) data);
646           }
647         while (bytes_left);
649         return make_string (return_string, offset);
650       }
651     else  /* Prepare incremental transfer. */
652       {
653         unsigned char *increment_value;
654         unsigned char *increment_ptr;
655         int total_size;
656         int *increment_nbytes = 0;
658         result = XGetWindowProperty (x_current_display, requestor_window,
659                                      selection, 0L, 10000000L, False,
660                                      event->property, &type, &format,
661                                      &items, &bytes_left,
662                                      (unsigned char **) &increment_nbytes);
663         if (result == Success)
664           {
665             XPropertyEvent property_event;
667             total_size = *increment_nbytes;
668             increment_value = (unsigned char *) alloca (total_size);
669             increment_ptr = increment_value;
671             XDeleteProperty (x_current_display, event->requestor,
672                              event->property);
673             XFlush (x_current_display);
674             XFree ((char *) increment_nbytes);
676             do
677               {                 /* NOTE: this blocks. */
678                 XWindowEvent (x_current_display, requestor_window,
679                               PropertyChangeMask,
680                               (XEvent *) &property_event);
682                 if (property_event.atom == selection
683                     && property_event.state == PropertyNewValue)
684                   do
685                     {
686                       result = XGetWindowProperty (x_current_display,
687                                                    requestor_window,
688                                                    selection, 0L,
689                                                    10000000L, True,
690                                                    AnyPropertyType,
691                                                    &type, &format,
692                                                    &items, &bytes_left,
693                                                    &data);
694                       if (result == Success && type == XA_STRING
695                           && format == 8)
696                         {
697                           bcopy (data, increment_ptr, items);
698                           increment_ptr += items;
699                         }
700                     }
701                 while (bytes_left);
703               }
704             while (increment_ptr < (increment_value + total_size));
706             return make_string (increment_value,
707                                 (increment_ptr - increment_value));
708           }
709       }
711   return Qnil;
714 void
715 syms_of_xselect ()
717   DEFVAR_LISP ("x-selection-value", &Vx_selection_value,
718                "The value of emacs' last cut-string.");
719   Vx_selection_value = Qnil;
721   DEFVAR_LISP ("x-secondary-selection-value", &Vx_secondary_selection_value,
722                "The value of emacs' last secondary cut-string.");
723   Vx_secondary_selection_value = Qnil;
725   DEFVAR_LISP ("x-clipboard-value", &Vx_clipboard_value,
726                "The string emacs last sent to the clipboard.");
727   Vx_clipboard_value = Qnil;
729   Qprimary = intern ("primary");
730   staticpro (&Qprimary);
731   Qsecondary = intern ("secondary");
732   staticpro (&Qsecondary);
733   Qclipboard = intern ("clipboard");
734   staticpro (&Qclipboard);
735   Qcut_buffer0 = intern ("cut-buffer0");
736   staticpro (&Qcut_buffer0);
738   defsubr (&Sx_own_selection);
739   defsubr (&Sx_selection_value);
741 #endif  /* X11 */