annotate src/select-gtk.c @ 617:af57a77cbc92

[xemacs-hg @ 2001-06-18 07:09:50 by ben] --------------------------------------------------------------- DOCUMENTATION FIXES: --------------------------------------------------------------- eval.c: Correct documentation. elhash.c: Doc correction. --------------------------------------------------------------- LISP OBJECT CLEANUP: --------------------------------------------------------------- bytecode.h, buffer.h, casetab.h, chartab.h, console-msw.h, console.h, database.c, device.h, eldap.h, elhash.h, events.h, extents.h, faces.h, file-coding.h, frame.h, glyphs.h, gui-x.h, gui.h, keymap.h, lisp-disunion.h, lisp-union.h, lisp.h, lrecord.h, lstream.h, mule-charset.h, objects.h, opaque.h, postgresql.h, process.h, rangetab.h, specifier.h, toolbar.h, tooltalk.h, ui-gtk.h: Add wrap_* to all objects (it was already there for a few of them) -- an expression to encapsulate a pointer into a Lisp object, rather than the inconvenient XSET*. "wrap" was chosen because "make" as in make_int(), make_char() is not appropriate. (It implies allocation. The issue does not exist for ints and chars because they are not allocated.) Full error checking has been added to these expressions. When used without error checking, non-union build, use of these expressions will incur no loss of efficiency. (In fact, XSET* is now defined in terms of wrap_* in a non-union build.) In a union build, you will also get no loss of efficiency provided that you have a decent optimizing compiler, and a compiler that either understands inlines or automatically inlines those particular functions. (And since people don't normally do their production builds on union, it doesn't matter.) Update the sample Lisp object definition in lrecord.h accordingly. dumper.c: Fix places in dumper that referenced wrap_object to reference its new name, wrap_pointer_1. buffer.c, bufslots.h, conslots.h, console.c, console.h, devslots.h, device.c, device.h, frame.c, frame.h, frameslots.h, window.c, window.h, winslots.h: -- Extract out the Lisp objects of `struct device' into devslots.h, just like for the other structures. -- Extract out the remaining (not copied into the window config) Lisp objects in `struct window' into winslots.h; use different macros (WINDOW_SLOT vs. WINDOW_SAVED_SLOT) to differentiate them. -- Eliminate the `dead' flag of `struct frame', since it duplicates information already available in `framemeths', and fix FRAME_LIVE_P accordingly. (Devices and consoles already work this way.) -- In *slots.h, switch to system where MARKED_SLOT is automatically undef'd at the end of the file. (Follows what winslots.h already does.) -- Update the comments at the beginning of *slots.h to be accurate. -- When making any of the above objects dead, zero it out entirely and reset all Lisp object slots to Qnil. (We were already doing this somewhat, but not consistently.) This (1) Eliminates the possibility of extra objects hanging around that ought to be GC'd, (2) Causes an immediate crash if anyone tries to access a structure in one of these objects, (3) Ensures consistent behavior wrt dead objects. dialog-msw.c: Use internal_object_printer, since this object should not escape. --------------------------------------------------------------- FIXING A CRASH THAT I HIT ONCE (AND A RELATED BAD BEHAVIOR): --------------------------------------------------------------- eval.c: Fix up some comments about the FSF implementation. Fix two nasty bugs: (1) condition_case_unwind frees the conses sitting in the catch->tag slot too quickly, resulting in a crash that I hit. (2) catches need to be unwound one at a time when calling unwind-protect code, rather than all at once at the end; otherwise, incorrect behavior can result. (A comment shows exactly how.) backtrace.h: Improve comment about FSF differences in the handler stack. --------------------------------------------------------------- FIXING A CRASH THAT I REPEATEDLY HIT WHEN USING THE MOUSE WHEEL UNDER MSWINDOWS: --------------------------------------------------------------- Basic idea: My crash is due either to a dead, non-marked, GC-collected frame inside of a window mirror, or a prematurely freed window mirror. We need to mark the Lisp objects inside of window mirrors. Tracking the lifespan of window mirrors and scrollbar instances is extremely hard, and there may well be lurking bugs where such objects are freed too soon. The only safe way to fix these problems (and it fixes both problems at once) is to make both of these structures Lisp objects. lrecord.h, emacs.c, inline.c, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, scrollbar.h, symsinit.h: Make scrollbar instances actual Lisp objects. Mark the window mirrors in them. inline.c needs to know about scrollbar.h now. Record the new type in lrecord.h. Fix up scrollbar-*.c appropriately. Create a hash table in scrollbar-msw.c so that the scrollbar instances stored in scrollbar HWND's are properly GC-protected. Create complex_vars_of_scrollbar_mswindows() to create the hash table at startup, and call it from emacs.c. Don't store the scrollbar instance as a property of the GTK scrollbar, as it's not used and if we did this, we'd have to separately GC-protect it in a hash table, like in MS Windows. lrecord.h, frame.h, frame.c, frameslots.h, redisplay.c, window.c, window.h: Move mark_window_mirror from redisplay.c to window.c. Make window mirrors actual Lisp objects. Tell lrecord.h about them. Change the window mirror member of struct frame from a pointer to a Lisp object, and add XWINDOW_MIRROR in appropriate places. Mark the scrollbar instances in the window mirror. redisplay.c, redisplay.h, alloc.c: Delete mark_redisplay. Don't call mark_redisplay. We now mark frame-specific structures in mark_frame. NOTE: I also deleted an extremely questionable call to update_frame_window_mirrors(). It was extremely questionable before, and now totally impossible, since it will create Lisp objects during redisplay. frame.c: Mark the scrollbar instances, which are now Lisp objects. Call mark_gutter() here, not in mark_redisplay(). gutter.c: Update comments about correct marking. --------------------------------------------------------------- ISSUES BROUGHT UP BY MARTIN: --------------------------------------------------------------- buffer.h: Put back these macros the way Steve T and I think they ought to be. I already explained in a previous changelog entry why I think these macros should be the way I'd defined them. Once again: We fix these macros so they don't care about the type of their lvalues. The non-C-string equivalents of these already function in the same way, and it's correct because it should be OK to pass in a CBufbyte *, a BufByte *, a Char_Binary *, an UChar_Binary *, etc. The whole reason for these different types is to work around errors caused by signed-vs-unsigned non-matching types. Any possible error that might be caught in a DFC macro would also be caught wherever the argument is used elsewhere. So creating multiple macro versions would add no useful error-checking and just further complicate an already complicated area. As for Martin's "ANSI aliasing" bug, XEmacs is not ANSI-aliasing clean and probably never will be. Unless the board agrees to change XEmacs in this way (and we really don't want to go down that road), this is not a bug. sound.h: Undo Martin's type change. signal.c: Fix problem identified by Martin with Linux and g++ due to non-standard declaration of setitimer(). systime.h: Update the docs for "qxe_" to point out why making the encapsulation explicit is always the right way to go. (setitimer() itself serves as an example.) For 21.4: update-elc-2.el: Correct misplaced parentheses, making lisp/mule not get recompiled.
author ben
date Mon, 18 Jun 2001 07:10:32 +0000
parents 183866b06e0b
children b39c14581166
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
1 /* GTK selection processing for XEmacs
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
3
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
4 This file is part of XEmacs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
5
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
9 later version.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
10
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
14 for more details.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
15
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
20
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
21 /* Synched up with: Not synched with FSF. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
22
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
23 /* Authorship:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
24
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
25 Written by Kevin Gallo for FSF Emacs.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
26 Rewritten for mswindows by Jonathan Harris, December 1997 for 21.0.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
27 Rewritten for GTK by William Perry, April 2000 for 21.1
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
28 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
29
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
30
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
31 #include <config.h>
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
32 #include "lisp.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
33 #include "events.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
34 #include "buffer.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
35 #include "device.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
36 #include "console-gtk.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
37 #include "select.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
38 #include "opaque.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
39 #include "frame.h"
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
40
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
41 static Lisp_Object Vretrieved_selection;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
42 static gboolean waiting_for_selection;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
43 Lisp_Object Vgtk_sent_selection_hooks;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
44
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
45 static Lisp_Object atom_to_symbol (struct device *d, GdkAtom atom);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
46 static GdkAtom symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
47
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
48 static void lisp_data_to_selection_data (struct device *,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
49 Lisp_Object obj,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
50 unsigned char **data_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
51 GdkAtom *type_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
52 unsigned int *size_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
53 int *format_ret);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
54 static Lisp_Object selection_data_to_lisp_data (struct device *,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
55 Extbyte *data,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
56 size_t size,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
57 GdkAtom type,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
58 int format);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
59
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
60 /* Set the selection data to GDK_NONE and NULL data, meaning we were
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
61 ** unable to do what they wanted.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
62 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
63 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
64 gtk_decline_selection_request (GtkSelectionData *data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
65 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
66 gtk_selection_data_set (data, GDK_NONE, 0, NULL, 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
67 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
68
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
69 /* Used as an unwind-protect clause so that, if a selection-converter signals
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
70 an error, we tell the requestor that we were unable to do what they wanted
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
71 before we throw to top-level or go into the debugger or whatever.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
72 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
73 struct _selection_closure
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
74 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
75 GtkSelectionData *data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
76 gboolean successful;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
77 };
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
78
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
79 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
80 gtk_selection_request_lisp_error (Lisp_Object closure)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
81 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
82 struct _selection_closure *cl = (struct _selection_closure *)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
83 get_opaque_ptr (closure);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
84
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
85 free_opaque_ptr (closure);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
86 if (cl->successful == TRUE)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
87 return Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
88 gtk_decline_selection_request (cl->data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
89 return Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
90 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
91
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
92 /* This provides the current selection to a requester.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
93 **
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
94 ** This is connected to the selection_get() signal of the application
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
95 ** shell in device-gtk.c:gtk_init_device().
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
96 **
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
97 ** This is radically different than the old selection code (21.1.x),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
98 ** but has been modeled after the X code, and appears to work.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
99 **
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
100 ** WMP Feb 12 2001
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
101 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
102 void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
103 emacs_gtk_selection_handle (GtkWidget *widget,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
104 GtkSelectionData *selection_data,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
105 guint info,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
106 guint time_stamp,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
107 gpointer data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
108 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
109 /* This function can GC */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
110 struct gcpro gcpro1, gcpro2;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
111 Lisp_Object temp_obj;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
112 Lisp_Object selection_symbol;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
113 Lisp_Object target_symbol = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
114 Lisp_Object converted_selection = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
115 guint32 local_selection_time;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
116 Lisp_Object successful_p = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
117 int count;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
118 struct device *d = decode_gtk_device (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
119 struct _selection_closure *cl = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
120
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
121 GCPRO2 (converted_selection, target_symbol);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
122
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
123 selection_symbol = atom_to_symbol (d, selection_data->selection);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
124 target_symbol = atom_to_symbol (d, selection_data->target);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
125
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
126 #if 0 /* #### MULTIPLE doesn't work yet */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
127 if (EQ (target_symbol, QMULTIPLE))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
128 target_symbol = fetch_multiple_target (selection_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
129 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
130
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
131 temp_obj = Fget_selection_timestamp (selection_symbol);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
132
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
133 if (NILP (temp_obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
134 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
135 /* We don't appear to have the selection. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
136 gtk_decline_selection_request (selection_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
137
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
138 goto DONE_LABEL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
139 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
140
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
141 local_selection_time = * (guint32 *) XOPAQUE_DATA (temp_obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
142
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
143 if (time_stamp != GDK_CURRENT_TIME &&
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
144 local_selection_time > time_stamp)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
145 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
146 /* Someone asked for the selection, and we have one, but not the one
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
147 they're looking for. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
148 gtk_decline_selection_request (selection_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
149 goto DONE_LABEL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
150 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
151
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
152 converted_selection = select_convert_out (selection_symbol,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
153 target_symbol, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
154
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
155 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
156 if (NILP (converted_selection))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
157 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
158 /* We don't appear to have a selection in that data type. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
159 gtk_decline_selection_request (selection_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
160 goto DONE_LABEL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
161 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
162
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
163 count = specpdl_depth ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
164
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
165 cl = (struct _selection_closure *) xmalloc (sizeof (*cl));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
166 cl->data = selection_data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
167 cl->successful = FALSE;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
168
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
169 record_unwind_protect (gtk_selection_request_lisp_error,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
170 make_opaque_ptr (cl));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
171
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
172 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
173 unsigned char *data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
174 unsigned int size;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
175 int format;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
176 GdkAtom type;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
177 lisp_data_to_selection_data (d, converted_selection,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
178 &data, &type, &size, &format);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
179
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
180 gtk_selection_data_set (selection_data, type, format, data, size);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
181 successful_p = Qt;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
182 /* Tell x_selection_request_lisp_error() it's cool. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
183 cl->successful = TRUE;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
184 xfree (data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
185 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
186
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
187 unbind_to (count, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
188
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
189 DONE_LABEL:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
190
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
191 if (cl) xfree (cl);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
192
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
193 UNGCPRO;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
194
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
195 /* Let random lisp code notice that the selection has been asked for. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
196 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
197 Lisp_Object val = Vgtk_sent_selection_hooks;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
198 if (!UNBOUNDP (val) && !NILP (val))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
199 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
200 Lisp_Object rest;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
201 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
202 for (rest = val; !NILP (rest); rest = Fcdr (rest))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
203 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
204 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
205 call3 (val, selection_symbol, target_symbol, successful_p);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
206 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
207 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
208 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
209
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
210
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
211
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
212 static GtkWidget *reading_selection_reply;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
213 static GdkAtom reading_which_selection;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
214 static int selection_reply_timed_out;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
215
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
216 /* Gets the current selection owned by another application */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
217 void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
218 emacs_gtk_selection_received (GtkWidget *widget,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
219 GtkSelectionData *selection_data,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
220 gpointer user_data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
221 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
222 waiting_for_selection = FALSE;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
223 Vretrieved_selection = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
224
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
225 reading_selection_reply = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
226
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
227 signal_fake_event ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
228
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
229 if (selection_data->length < 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
230 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
231 return;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
232 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
233
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
234 Vretrieved_selection =
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
235 selection_data_to_lisp_data (NULL,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
236 selection_data->data,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
237 selection_data->length,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
238 selection_data->type,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
239 selection_data->format);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
240 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
241
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
242 static int
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
243 selection_reply_done (void *ignore)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
244 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
245 return !reading_selection_reply;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
246 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
247
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
248 /* Do protocol to read selection-data from the server.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
249 Converts this to lisp data and returns it.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
250 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
251 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
252 gtk_get_foreign_selection (Lisp_Object selection_symbol,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
253 Lisp_Object target_type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
254 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
255 /* This function can GC */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
256 struct device *d = decode_gtk_device (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
257 GtkWidget *requestor = DEVICE_GTK_APP_SHELL (d);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
258 guint32 requestor_time = DEVICE_GTK_MOUSE_TIMESTAMP (d);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
259 GdkAtom selection_atom = symbol_to_gtk_atom (d, selection_symbol, 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
260 int speccount;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
261 GdkAtom type_atom = symbol_to_gtk_atom (d, (CONSP (target_type) ?
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
262 XCAR (target_type) : target_type), 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
263
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
264 gtk_selection_convert (requestor, selection_atom, type_atom,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
265 requestor_time);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
266
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
267 signal_fake_event ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
268
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
269 /* Block until the reply has been read. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
270 reading_selection_reply = requestor;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
271 reading_which_selection = selection_atom;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
272 selection_reply_timed_out = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
273
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
274 speccount = specpdl_depth ();
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
275
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
276 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
277 /* add a timeout handler */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
278 if (gtk_selection_timeout > 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
279 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
280 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
281 Qx_selection_reply_timeout_internal,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
282 Qnil, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
283 record_unwind_protect (Fdisable_timeout, id);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
284 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
285 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
286
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
287 /* This is ^Gable */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
288 wait_delaying_user_input (selection_reply_done, 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
289
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
290 if (selection_reply_timed_out)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
291 signal_error (Qselection_conversion_error, "timed out waiting for reply from selection owner", Qunbound);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
292
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
293 unbind_to (speccount, Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
294
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
295 /* otherwise, the selection is waiting for us on the requested property. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
296 return select_convert_in (selection_symbol,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
297 target_type,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
298 Vretrieved_selection);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
299 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
300
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
301
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
302 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
303 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
304 gtk_get_window_property (struct device *d, GtkWidget *window, GdkAtom property,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
305 Extbyte **data_ret, int *bytes_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
306 GdkAtom *actual_type_ret, int *actual_format_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
307 unsigned long *actual_size_ret, int delete_p)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
308 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
309 size_t total_size;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
310 unsigned long bytes_remaining;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
311 int offset = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
312 unsigned char *tmp_data = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
313 int result;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
314 int buffer_size = SELECTION_QUANTUM (display);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
315 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
316
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
317 /* First probe the thing to find out how big it is. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
318 result = XGetWindowProperty (display, window, property,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
319 0, 0, False, AnyPropertyType,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
320 actual_type_ret, actual_format_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
321 actual_size_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
322 &bytes_remaining, &tmp_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
323 if (result != Success)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
324 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
325 *data_ret = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
326 *bytes_ret = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
327 return;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
328 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
329 XFree ((char *) tmp_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
330
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
331 if (*actual_type_ret == None || *actual_format_ret == 0)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
332 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
333 if (delete_p) XDeleteProperty (display, window, property);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
334 *data_ret = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
335 *bytes_ret = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
336 return;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
337 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
338
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
339 total_size = bytes_remaining + 1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
340 *data_ret = (Extbyte *) xmalloc (total_size);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
341
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
342 /* Now read, until we've gotten it all. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
343 while (bytes_remaining)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
344 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
345 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
346 int last = bytes_remaining;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
347 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
348 result =
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
349 XGetWindowProperty (display, window, property,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
350 offset/4, buffer_size/4,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
351 (delete_p ? True : False),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
352 AnyPropertyType,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
353 actual_type_ret, actual_format_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
354 actual_size_ret, &bytes_remaining, &tmp_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
355 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
356 stderr_out ("<< read %d\n", last-bytes_remaining);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
357 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
358 /* If this doesn't return Success at this point, it means that
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
359 some clod deleted the selection while we were in the midst of
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
360 reading it. Deal with that, I guess....
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
361 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
362 if (result != Success) break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
363 *actual_size_ret *= *actual_format_ret / 8;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
364 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
365 offset += *actual_size_ret;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
366 XFree ((char *) tmp_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
367 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
368 *bytes_ret = offset;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
369 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
370
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
371
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
372 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
373 receive_incremental_selection (Display *display, Window window, Atom property,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
374 /* this one is for error messages only */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
375 Lisp_Object target_type,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
376 unsigned int min_size_bytes,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
377 Extbyte **data_ret, int *size_bytes_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
378 Atom *type_ret, int *format_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
379 unsigned long *size_ret)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
380 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
381 /* This function can GC */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
382 int offset = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
383 int prop_id;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
384 *size_bytes_ret = min_size_bytes;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
385 *data_ret = (Extbyte *) xmalloc (*size_bytes_ret);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
386 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
387 stderr_out ("\nread INCR %d\n", min_size_bytes);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
388 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
389 /* At this point, we have read an INCR property, and deleted it (which
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
390 is how we ack its receipt: the sending window will be selecting
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
391 PropertyNotify events on our window to notice this).
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
392
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
393 Now, we must loop, waiting for the sending window to put a value on
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
394 that property, then reading the property, then deleting it to ack.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
395 We are done when the sender places a property of length 0.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
396 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
397 prop_id = expect_property_change (display, window, property,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
398 PropertyNewValue);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
399 while (1)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
400 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
401 Extbyte *tmp_data;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
402 int tmp_size_bytes;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
403 wait_for_property_change (prop_id);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
404 /* expect it again immediately, because x_get_window_property may
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
405 .. no it won't, I don't get it.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
406 .. Ok, I get it now, the Xt code that implements INCR is broken.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
407 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
408 prop_id = expect_property_change (display, window, property,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
409 PropertyNewValue);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
410 x_get_window_property (display, window, property,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
411 &tmp_data, &tmp_size_bytes,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
412 type_ret, format_ret, size_ret, 1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
413
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
414 if (tmp_size_bytes == 0) /* we're done */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
415 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
416 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
417 stderr_out (" read INCR done\n");
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
418 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
419 unexpect_property_change (prop_id);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
420 if (tmp_data) xfree (tmp_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
421 break;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
422 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
423 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
424 stderr_out (" read INCR %d\n", tmp_size_bytes);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
425 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
426 if (*size_bytes_ret < offset + tmp_size_bytes)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
427 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
428 #if 0
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
429 stderr_out (" read INCR realloc %d -> %d\n",
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
430 *size_bytes_ret, offset + tmp_size_bytes);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
431 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
432 *size_bytes_ret = offset + tmp_size_bytes;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
433 *data_ret = (Extbyte *) xrealloc (*data_ret, *size_bytes_ret);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
434 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
435 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
436 offset += tmp_size_bytes;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
437 xfree (tmp_data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
438 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
439 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
440
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
441
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
442 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
443 gtk_get_window_property_as_lisp_data (struct device *d,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
444 GtkWidget *window,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
445 GdkAtom property,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
446 /* next two for error messages only */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
447 Lisp_Object target_type,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
448 GdkAtom selection_atom)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
449 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
450 /* This function can GC */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
451 Atom actual_type;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
452 int actual_format;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
453 unsigned long actual_size;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
454 Extbyte *data = NULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
455 int bytes = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
456 Lisp_Object val;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
457 struct device *d = get_device_from_display (display);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
458
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
459 x_get_window_property (display, window, property, &data, &bytes,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
460 &actual_type, &actual_format, &actual_size, 1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
461 if (! data)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
462 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
463 if (XGetSelectionOwner (display, selection_atom))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
464 /* there is a selection owner */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
465 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
466 "selection owner couldn't convert",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
467 Fcons (Qunbound,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
468 Fcons (x_atom_to_symbol (d, selection_atom),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
469 actual_type ?
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
470 list2 (target_type,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
471 x_atom_to_symbol (d, actual_type)) :
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
472 list1 (target_type))));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
473 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
474 signal_error (Qselection_conversion_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
475 "no selection",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
476 x_atom_to_symbol (d, selection_atom));
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
477 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
478
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
479 if (actual_type == DEVICE_XATOM_INCR (d))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
480 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
481 /* Ok, that data wasn't *the* data, it was just the beginning. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
482
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
483 unsigned int min_size_bytes = * ((unsigned int *) data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
484 xfree (data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
485 receive_incremental_selection (display, window, property, target_type,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
486 min_size_bytes, &data, &bytes,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
487 &actual_type, &actual_format,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
488 &actual_size);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
489 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
490
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
491 /* It's been read. Now convert it to a lisp object in some semi-rational
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
492 manner. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
493 val = selection_data_to_lisp_data (d, data, bytes,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
494 actual_type, actual_format);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
495
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
496 xfree (data);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
497 return val;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
498 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
499 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
500
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
501
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
502 static GdkAtom
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
503 symbol_to_gtk_atom (struct device *d, Lisp_Object sym, int only_if_exists)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
504 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
505 if (NILP (sym)) return GDK_SELECTION_PRIMARY;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
506 if (EQ (sym, Qt)) return GDK_SELECTION_SECONDARY;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
507 if (EQ (sym, QPRIMARY)) return GDK_SELECTION_PRIMARY;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
508 if (EQ (sym, QSECONDARY)) return GDK_SELECTION_SECONDARY;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
509
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
510 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
511 const char *nameext;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
512 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
513 return gdk_atom_intern (nameext, only_if_exists ? TRUE : FALSE);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
514 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
515 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
516
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
517 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
518 atom_to_symbol (struct device *d, GdkAtom atom)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
519 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
520 if (atom == GDK_SELECTION_PRIMARY) return (QPRIMARY);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
521 if (atom == GDK_SELECTION_SECONDARY) return (QSECONDARY);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
522
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
523 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
524 char *intstr;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
525 char *str = gdk_atom_name (atom);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
526
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
527 if (! str) return Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
528
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
529 TO_INTERNAL_FORMAT (C_STRING, str,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
530 C_STRING_ALLOCA, intstr,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
531 Qctext);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
532 g_free (str);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
533 return intern (intstr);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
534 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
535 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
536
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
537 /* #### These are going to move into Lisp code(!) with the aid of
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
538 some new functions I'm working on - ajh */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
539
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
540 /* These functions convert from the selection data read from the server into
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
541 something that we can use from elisp, and vice versa.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
542
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
543 Type: Format: Size: Elisp Type:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
544 ----- ------- ----- -----------
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
545 * 8 * String
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
546 ATOM 32 1 Symbol
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
547 ATOM 32 > 1 Vector of Symbols
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
548 * 16 1 Integer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
549 * 16 > 1 Vector of Integers
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
550 * 32 1 if <=16 bits: Integer
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
551 if > 16 bits: Cons of top16, bot16
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
552 * 32 > 1 Vector of the above
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
553
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
554 When converting a Lisp number to C, it is assumed to be of format 16 if
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
555 it is an integer, and of format 32 if it is a cons of two integers.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
556
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
557 When converting a vector of numbers from Elisp to C, it is assumed to be
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
558 of format 16 if every element in the vector is an integer, and is assumed
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
559 to be of format 32 if any element is a cons of two integers.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
560
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
561 When converting an object to C, it may be of the form (SYMBOL . <data>)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
562 where SYMBOL is what we should claim that the type is. Format and
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
563 representation are as above.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
564
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
565 NOTE: Under Mule, when someone shoves us a string without a type, we
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
566 set the type to 'COMPOUND_TEXT and automatically convert to Compound
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
567 Text. If the string has a type, we assume that the user wants the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
568 data sent as-is so we just do "binary" conversion.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
569 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
570
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
571
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
572 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
573 selection_data_to_lisp_data (struct device *d,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
574 Extbyte *data,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
575 size_t size,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
576 GdkAtom type,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
577 int format)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
578 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
579 if (type == gdk_atom_intern ("NULL", 0))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
580 return QNULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
581
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
582 /* Convert any 8-bit data to a string, for compactness. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
583 else if (format == 8)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
584 return make_ext_string (data, size,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
585 ((type == gdk_atom_intern ("TEXT", FALSE)) ||
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
586 (type == gdk_atom_intern ("COMPOUND_TEXT", FALSE)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
587 ? Qctext : Qbinary);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
588
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
589 /* Convert a single atom to a Lisp Symbol.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
590 Convert a set of atoms to a vector of symbols. */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
591 else if (type == gdk_atom_intern ("ATOM", FALSE))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
592 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
593 if (size == sizeof (GdkAtom))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
594 return atom_to_symbol (d, *((GdkAtom *) data));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
595 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
596 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
597 int i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
598 int len = size / sizeof (GdkAtom);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
599 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
600 for (i = 0; i < len; i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
601 Faset (v, make_int (i), atom_to_symbol (d, ((GdkAtom *) data) [i]));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
602 return v;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
603 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
604 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
605
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
606 /* Convert a single 16 or small 32 bit number to a Lisp Int.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
607 If the number is > 16 bits, convert it to a cons of integers,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
608 16 bits in each half.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
609 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
610 else if (format == 32 && size == sizeof (long))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
611 return word_to_lisp (((unsigned long *) data) [0]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
612 else if (format == 16 && size == sizeof (short))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
613 return make_int ((int) (((unsigned short *) data) [0]));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
614
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
615 /* Convert any other kind of data to a vector of numbers, represented
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
616 as above (as an integer, or a cons of two 16 bit integers).
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
617
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
618 #### Perhaps we should return the actual type to lisp as well.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
619
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
620 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
621 ==> [4 4]
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
622
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
623 and perhaps it should be
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
624
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
625 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
626 ==> (SPAN . [4 4])
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
627
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
628 Right now the fact that the return type was SPAN is discarded before
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
629 lisp code gets to see it.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
630 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
631 else if (format == 16)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
632 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
633 int i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
634 Lisp_Object v = make_vector (size / 4, Qzero);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
635 for (i = 0; i < (int) size / 4; i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
636 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
637 int j = (int) ((unsigned short *) data) [i];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
638 Faset (v, make_int (i), make_int (j));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
639 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
640 return v;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
641 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
642 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
643 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
644 int i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
645 Lisp_Object v = make_vector (size / 4, Qzero);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
646 for (i = 0; i < (int) size / 4; i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
647 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
648 unsigned long j = ((unsigned long *) data) [i];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
649 Faset (v, make_int (i), word_to_lisp (j));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
650 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
651 return v;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
652 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
653 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
654
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
655
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
656 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
657 lisp_data_to_selection_data (struct device *d,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
658 Lisp_Object obj,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
659 unsigned char **data_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
660 GdkAtom *type_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
661 unsigned int *size_ret,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
662 int *format_ret)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
663 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
664 Lisp_Object type = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
665
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
666 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
667 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
668 type = XCAR (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
669 obj = XCDR (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
670 if (CONSP (obj) && NILP (XCDR (obj)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
671 obj = XCAR (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
672 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
673
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
674 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
675 { /* This is not the same as declining */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
676 *format_ret = 32;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
677 *size_ret = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
678 *data_ret = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
679 type = QNULL;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
680 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
681 else if (STRINGP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
682 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
683 const Extbyte *extval;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
684 Extcount extvallen;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
685
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
686 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
687 ALLOCA, (extval, extvallen),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
688 (NILP (type) ? Qctext : Qbinary));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
689 *format_ret = 8;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
690 *size_ret = extvallen;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
691 *data_ret = (unsigned char *) xmalloc (*size_ret);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
692 memcpy (*data_ret, extval, *size_ret);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
693 #ifdef MULE
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
694 if (NILP (type)) type = QCOMPOUND_TEXT;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
695 #else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
696 if (NILP (type)) type = QSTRING;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
697 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
698 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
699 else if (CHARP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
700 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
701 Bufbyte buf[MAX_EMCHAR_LEN];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
702 Bytecount len;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
703 const Extbyte *extval;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
704 Extcount extvallen;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
705
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
706 *format_ret = 8;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
707 len = set_charptr_emchar (buf, XCHAR (obj));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
708 TO_EXTERNAL_FORMAT (DATA, (buf, len),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
709 ALLOCA, (extval, extvallen),
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
710 Qctext);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
711 *size_ret = extvallen;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
712 *data_ret = (unsigned char *) xmalloc (*size_ret);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
713 memcpy (*data_ret, extval, *size_ret);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
714 #ifdef MULE
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
715 if (NILP (type)) type = QCOMPOUND_TEXT;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
716 #else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
717 if (NILP (type)) type = QSTRING;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
718 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
719 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
720 else if (SYMBOLP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
721 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
722 *format_ret = 32;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
723 *size_ret = 1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
724 *data_ret = (unsigned char *) xmalloc (sizeof (GdkAtom) + 1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
725 (*data_ret) [sizeof (GdkAtom)] = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
726 (*(GdkAtom **) data_ret) [0] = symbol_to_gtk_atom (d, obj, 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
727 if (NILP (type)) type = QATOM;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
728 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
729 else if (INTP (obj) &&
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
730 XINT (obj) <= 0x7FFF &&
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
731 XINT (obj) >= -0x8000)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
732 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
733 *format_ret = 16;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
734 *size_ret = 1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
735 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
736 (*data_ret) [sizeof (short)] = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
737 (*(short **) data_ret) [0] = (short) XINT (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
738 if (NILP (type)) type = QINTEGER;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
739 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
740 else if (INTP (obj) || CONSP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
741 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
742 *format_ret = 32;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
743 *size_ret = 1;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
744 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
745 (*data_ret) [sizeof (long)] = 0;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
746 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
747 if (NILP (type)) type = QINTEGER;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
748 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
749 else if (VECTORP (obj))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
750 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
751 /* Lisp Vectors may represent a set of ATOMs;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
752 a set of 16 or 32 bit INTEGERs;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
753 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
754 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
755 int i;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
756
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
757 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
758 /* This vector is an ATOM set */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
759 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
760 if (NILP (type)) type = QATOM;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
761 *size_ret = XVECTOR_LENGTH (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
762 *format_ret = 32;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
763 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (GdkAtom));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
764 for (i = 0; i < (int) (*size_ret); i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
765 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
766 (*(GdkAtom **) data_ret) [i] =
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
767 symbol_to_gtk_atom (d, XVECTOR_DATA (obj) [i], 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
768 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
769 syntax_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
770 ("all elements of the vector must be of the same type", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
771 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
772 #if 0 /* #### MULTIPLE doesn't work yet */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
773 else if (VECTORP (XVECTOR_DATA (obj) [0]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
774 /* This vector is an ATOM_PAIR set */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
775 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
776 if (NILP (type)) type = QATOM_PAIR;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
777 *size_ret = XVECTOR_LENGTH (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
778 *format_ret = 32;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
779 *data_ret = (unsigned char *)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
780 xmalloc ((*size_ret) * sizeof (Atom) * 2);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
781 for (i = 0; i < *size_ret; i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
782 if (VECTORP (XVECTOR_DATA (obj) [i]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
783 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
784 Lisp_Object pair = XVECTOR_DATA (obj) [i];
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
785 if (XVECTOR_LENGTH (pair) != 2)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
786 syntax_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
787 ("elements of the vector must be vectors of exactly two elements", pair);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
788
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
789 (*(GdkAtom **) data_ret) [i * 2] =
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
790 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [0], 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
791 (*(GdkAtom **) data_ret) [(i * 2) + 1] =
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
792 symbol_to_gtk_atom (d, XVECTOR_DATA (pair) [1], 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
793 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
794 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
795 syntax_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
796 ("all elements of the vector must be of the same type", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
797 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
798 #endif
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
799 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
800 /* This vector is an INTEGER set, or something like it */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
801 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
802 *size_ret = XVECTOR_LENGTH (obj);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
803 if (NILP (type)) type = QINTEGER;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
804 *format_ret = 16;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
805 for (i = 0; i < (int) (*size_ret); i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
806 if (CONSP (XVECTOR_DATA (obj) [i]))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
807 *format_ret = 32;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
808 else if (!INTP (XVECTOR_DATA (obj) [i]))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
809 syntax_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
810 ("all elements of the vector must be integers or conses of integers", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
811
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
812 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
813 for (i = 0; i < (int) (*size_ret); i++)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
814 if (*format_ret == 32)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
815 (*((unsigned long **) data_ret)) [i] =
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
816 lisp_to_word (XVECTOR_DATA (obj) [i]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
817 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
818 (*((unsigned short **) data_ret)) [i] =
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
819 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
820 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
821 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
822 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 462
diff changeset
823 invalid_argument ("unrecognized selection data", obj);
462
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
824
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
825 *type_ret = symbol_to_gtk_atom (d, type, 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
826 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
827
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
828
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
829
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
830 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
831 gtk_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
832 Lisp_Object how_to_add, Lisp_Object selection_type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
833 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
834 struct device *d = decode_gtk_device (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
835 GtkWidget *selecting_window = GTK_WIDGET (DEVICE_GTK_APP_SHELL (d));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
836 Lisp_Object selection_time;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
837 /* Use the time of the last-read mouse or keyboard event.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
838 For selection purposes, we use this as a sleazy way of knowing what the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
839 current time is in server-time. This assumes that the most recently read
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
840 mouse or keyboard event has something to do with the assertion of the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
841 selection, which is probably true.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
842 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
843 guint32 thyme = DEVICE_GTK_MOUSE_TIMESTAMP (d);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
844 GdkAtom selection_atom;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
845
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
846 CHECK_SYMBOL (selection_name);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
847 selection_atom = symbol_to_gtk_atom (d, selection_name, 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
848
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
849 gtk_selection_owner_set (selecting_window,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
850 selection_atom,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
851 thyme);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
852
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
853 /* We do NOT use time_to_lisp() here any more, like we used to.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
854 That assumed equivalence of time_t and Time, which is not
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
855 necessarily the case (e.g. under OSF on the Alphas, where
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
856 Time is a 64-bit quantity and time_t is a 32-bit quantity).
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
857
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
858 Opaque pointers are the clean way to go here.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
859 */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
860 selection_time = make_opaque (&thyme, sizeof (thyme));
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
861
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
862 return selection_time;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
863 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
864
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
865 static void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
866 gtk_disown_selection (Lisp_Object selection, Lisp_Object timeval)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
867 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
868 struct device *d = decode_gtk_device (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
869 GdkAtom selection_atom;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
870 guint32 timestamp;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
871
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
872 CHECK_SYMBOL (selection);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
873 selection_atom = symbol_to_gtk_atom (d, selection, 0);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
874
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
875 if (NILP (timeval))
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
876 timestamp = DEVICE_GTK_MOUSE_TIMESTAMP (d);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
877 else
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
878 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
879 time_t the_time;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
880 lisp_to_time (timeval, &the_time);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
881 timestamp = (guint32) the_time;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
882 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
883
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
884 gtk_selection_owner_set (NULL, selection_atom, timestamp);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
885 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
886
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
887 static Lisp_Object
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
888 gtk_selection_exists_p (Lisp_Object selection,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
889 Lisp_Object selection_type)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
890 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
891 struct device *d = decode_gtk_device (Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
892
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
893 return (gdk_selection_owner_get (symbol_to_gtk_atom (d, selection, 0)) ? Qt : Qnil);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
894 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
895
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
896
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
897
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
898 /************************************************************************/
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
899 /* initialization */
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
900 /************************************************************************/
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
901
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
902 void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
903 syms_of_select_gtk (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
904 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
905 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
906
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
907 void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
908 console_type_create_select_gtk (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
909 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
910 CONSOLE_HAS_METHOD (gtk, own_selection);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
911 CONSOLE_HAS_METHOD (gtk, disown_selection);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
912 CONSOLE_HAS_METHOD (gtk, selection_exists_p);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
913 CONSOLE_HAS_METHOD (gtk, get_foreign_selection);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
914 }
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
915
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
916 void
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
917 vars_of_select_gtk (void)
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
918 {
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
919 staticpro (&Vretrieved_selection);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
920 Vretrieved_selection = Qnil;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
921
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
922 DEFVAR_LISP ("gtk-sent-selection-hooks", &Vgtk_sent_selection_hooks /*
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
923 A function or functions to be called after we have responded to some
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
924 other client's request for the value of a selection that we own. The
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
925 function(s) will be called with four arguments:
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
926 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
927 - the name of the selection-type which we were requested to convert the
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
928 selection into before sending (for example, STRING or LENGTH);
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
929 - and whether we successfully transmitted the selection.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
930 We might have failed (and declined the request) for any number of reasons,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
931 including being asked for a selection that we no longer own, or being asked
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
932 to convert into a type that we don't know about or that is inappropriate.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
933 This hook doesn't let you change the behavior of emacs's selection replies,
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
934 it merely informs you that they have happened.
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
935 */ );
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
936 Vgtk_sent_selection_hooks = Qunbound;
0784d089fdc9 Import from CVS: tag r21-2-46
cvs
parents:
diff changeset
937 }