Mercurial > hg > xemacs-beta

comparison src/select-xlike-inc.c @ 4984:f23cd0184dcf

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
xlike, doc changes -------------------- ChangeLog entries follow: -------------------- man/ChangeLog addition: 2010-02-05 Ben Wing <ben@xemacs.org> * internals/internals.texi (A Summary of the Various XEmacs Modules): * internals/internals.texi (Conversion to and from External Data): * internals/internals.texi (General Guidelines for Writing Mule-Aware Code): Correct names of files renamed common -> xlike. Fix up outdated explanation of old-style DFC conversion macros. Add a section on the different types of character and their uses, taken from a long comment in lisp.h. src/ChangeLog addition: 2010-02-05 Ben Wing <ben@xemacs.org> * depend: Regenerate. * make-src-depend (PrintPatternDeps): Remove refs to xgccache, no longer existent. * select-gtk.c (THIS_IS_GTK): * select-gtk.c (gtk_decline_selection_request): * select-x.c (THIS_IS_X): * select-xlike-inc.c: * select-xlike-inc.c (selection_data_to_lisp_data): Rename PROCESSING_X_CODE to THIS_IS_X and PROCESSING_GTK_CODE to THIS_SI_GTK for consistency with other xlike code. Rename select-xlike-inc.c from select-common.h, in keeping with xlike terminology.
author Ben Wing <ben@xemacs.org>
date Fri, 05 Feb 2010 12:11:12 -0600
parents src/select-common.h@304aebb79cd3
children 358aa3bb603f
comparison
equal deleted inserted replaced
4979:4234fd5a7b17 4984:f23cd0184dcf
1 /* Selection processing for XEmacs -- common btwn select-x.c and select-gtk.c
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: Not synched with FSF. */
22
23 #ifdef THIS_IS_X
24 #define XE_ATOM_TYPE Atom
25 #define XE_ATOM_TO_SYMBOL x_atom_to_symbol
26 #define XE_SYMBOL_TO_ATOM symbol_to_x_atom
27 #else
28 #define XE_ATOM_TYPE GdkAtom
29 #define XE_ATOM_TO_SYMBOL atom_to_symbol
30 #define XE_SYMBOL_TO_ATOM symbol_to_gtk_atom
31 #endif /* THIS_IS_X */
32
33 /* #### These are going to move into Lisp code(!) with the aid of
34 some new functions I'm working on - ajh */
35
36 /* These functions convert from the selection data read from the server into
37 something that we can use from elisp, and vice versa.
38
39 Type: Format: Size: Elisp Type:
40 ----- ------- ----- -----------
41 * 8 * String
42 ATOM 32 1 Symbol
43 ATOM 32 > 1 Vector of Symbols
44 * 16 1 Integer
45 * 16 > 1 Vector of Integers
46 * 32 1 if <=16 bits: Integer
47 if > 16 bits: Cons of top16, bot16
48 * 32 > 1 Vector of the above
49
50 NOTE NOTE NOTE:
51 Format == 32 means that the buffer will be C longs, which need not be
52 32-bit quantities. See the note in select-x.c (x_get_window_property).
53
54 When converting a Lisp number to C, it is assumed to be of format 16 if
55 it is an integer, and of format 32 if it is a cons of two integers.
56
57 When converting a vector of numbers from Elisp to C, it is assumed to be
58 of format 16 if every element in the vector is an integer, and is assumed
59 to be of format 32 if any element is a cons of two integers.
60
61 When converting an object to C, it may be of the form (SYMBOL . <data>)
62 where SYMBOL is what we should claim that the type is. Format and
63 representation are as above.
64
65 NOTE: Under Mule, when someone shoves us a string without a type, we
66 set the type to `COMPOUND_TEXT' and automatically convert to Compound
67 Text. If the string has a type, we assume that the user wants the
68 data sent as-is so we just do "binary" conversion.
69 */
70
71
72 static Lisp_Object
73 selection_data_to_lisp_data (struct device *d,
74 Rawbyte *data,
75 Bytecount size,
76 XE_ATOM_TYPE type,
77 int format)
78 {
79 #ifdef THIS_IS_X
80 if (type == DEVICE_XATOM_NULL (d))
81 return QNULL;
82
83 /* Convert any 8-bit data to a string, for compactness. */
84 else if (format == 8)
85 return make_extstring ((Extbyte *) data, size,
86 type == DEVICE_XATOM_TEXT (d) ||
87 type == DEVICE_XATOM_COMPOUND_TEXT (d)
88 ? Qctext : Qbinary);
89
90 /* Convert a single atom to a Lisp Symbol.
91 Convert a set of atoms to a vector of symbols. */
92 else if (type == XA_ATOM)
93 #else
94 if (type == gdk_atom_intern ("NULL", 0))
95 return QNULL;
96
97 /* Convert any 8-bit data to a string, for compactness. */
98 else if (format == 8)
99 return make_extstring ((Extbyte *) data, size,
100 ((type == gdk_atom_intern ("TEXT", FALSE)) ||
101 (type == gdk_atom_intern ("COMPOUND_TEXT", FALSE)))
102 ? Qctext : Qbinary);
103
104 /* Convert a single atom to a Lisp Symbol.
105 Convert a set of atoms to a vector of symbols. */
106 else if (type == gdk_atom_intern ("ATOM", FALSE))
107 #endif /* THIS_IS_X */
108 {
109 if (size == sizeof (XE_ATOM_TYPE))
110 return XE_ATOM_TO_SYMBOL (d, *((XE_ATOM_TYPE *) data));
111 else
112 {
113 Elemcount i;
114 Elemcount len = size / sizeof (XE_ATOM_TYPE);
115 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
116 for (i = 0; i < len; i++)
117 Faset (v, make_int (i), XE_ATOM_TO_SYMBOL (d, ((XE_ATOM_TYPE *) data) [i]));
118 return v;
119 }
120 }
121
122 /* Convert a single 16 or small 32 bit number to a Lisp Int.
123 If the number is > 16 bits, convert it to a cons of integers,
124 16 bits in each half.
125 */
126 else if (format == 32 && size == sizeof (long))
127 return word_to_lisp (((unsigned long *) data) [0]);
128 else if (format == 16 && size == sizeof (short))
129 return make_int ((int) (((unsigned short *) data) [0]));
130
131 /* Convert any other kind of data to a vector of numbers, represented
132 as above (as an integer, or a cons of two 16 bit integers).
133
134 #### Perhaps we should return the actual type to lisp as well.
135
136 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
137 ==> [4 4]
138
139 and perhaps it should be
140
141 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
142 ==> (SPAN . [4 4])
143
144 Right now the fact that the return type was SPAN is discarded before
145 lisp code gets to see it.
146 */
147 else if (format == 16)
148 {
149 Elemcount i;
150 Lisp_Object v = make_vector (size / 4, Qzero);
151 for (i = 0; i < size / 4; i++)
152 {
153 int j = (int) ((unsigned short *) data) [i];
154 Faset (v, make_int (i), make_int (j));
155 }
156 return v;
157 }
158 else
159 {
160 Elemcount i;
161 Lisp_Object v = make_vector (size / 4, Qzero);
162 for (i = 0; i < size / 4; i++)
163 {
164 unsigned long j = ((unsigned long *) data) [i];
165 Faset (v, make_int (i), word_to_lisp (j));
166 }
167 return v;
168 }
169 }
170
171
172 static void
173 lisp_data_to_selection_data (struct device *d,
174 Lisp_Object obj,
175 Rawbyte **data_ret,
176 XE_ATOM_TYPE *type_ret,
177 Bytecount *size_ret,
178 int *format_ret)
179 {
180 Lisp_Object type = Qnil;
181
182 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
183 {
184 type = XCAR (obj);
185 obj = XCDR (obj);
186 if (CONSP (obj) && NILP (XCDR (obj)))
187 obj = XCAR (obj);
188 }
189
190 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
191 { /* This is not the same as declining */
192 *format_ret = 32;
193 *size_ret = 0;
194 *data_ret = 0;
195 type = QNULL;
196 }
197 else if (STRINGP (obj))
198 {
199 const Extbyte *extval;
200 Bytecount extvallen;
201
202 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
203 ALLOCA, (extval, extvallen),
204 (NILP (type) ? Qctext : Qbinary));
205 *format_ret = 8;
206 *size_ret = extvallen;
207 *data_ret = xnew_rawbytes (*size_ret);
208 memcpy (*data_ret, extval, *size_ret);
209 #ifdef MULE
210 if (NILP (type)) type = QCOMPOUND_TEXT;
211 #else
212 if (NILP (type)) type = QSTRING;
213 #endif
214 }
215 else if (CHARP (obj))
216 {
217 Ibyte buf[MAX_ICHAR_LEN];
218 Bytecount len;
219 const Extbyte *extval;
220 Bytecount extvallen;
221
222 *format_ret = 8;
223 len = set_itext_ichar (buf, XCHAR (obj));
224 TO_EXTERNAL_FORMAT (DATA, (buf, len),
225 ALLOCA, (extval, extvallen),
226 Qctext);
227 *size_ret = extvallen;
228 *data_ret = xnew_rawbytes (*size_ret);
229 memcpy (*data_ret, extval, *size_ret);
230 #ifdef MULE
231 if (NILP (type)) type = QCOMPOUND_TEXT;
232 #else
233 if (NILP (type)) type = QSTRING;
234 #endif
235 }
236 else if (SYMBOLP (obj))
237 {
238 *format_ret = 32;
239 *size_ret = 1;
240 *data_ret = xnew_rawbytes (sizeof (XE_ATOM_TYPE) + 1);
241 (*data_ret) [sizeof (XE_ATOM_TYPE)] = 0;
242 (*(XE_ATOM_TYPE **) data_ret) [0] = XE_SYMBOL_TO_ATOM (d, obj, 0);
243 if (NILP (type)) type = QATOM;
244 }
245 else if (INTP (obj) &&
246 XINT (obj) <= 0x7FFF &&
247 XINT (obj) >= -0x8000)
248 {
249 *format_ret = 16;
250 *size_ret = 1;
251 *data_ret = xnew_rawbytes (sizeof (short) + 1);
252 (*data_ret) [sizeof (short)] = 0;
253 (*(short **) data_ret) [0] = (short) XINT (obj);
254 if (NILP (type)) type = QINTEGER;
255 }
256 else if (INTP (obj) || CONSP (obj))
257 {
258 *format_ret = 32;
259 *size_ret = 1;
260 *data_ret = xnew_rawbytes (sizeof (long) + 1);
261 (*data_ret) [sizeof (long)] = 0;
262 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
263 if (NILP (type)) type = QINTEGER;
264 }
265 else if (VECTORP (obj))
266 {
267 /* Lisp Vectors may represent a set of ATOMs;
268 a set of 16 or 32 bit INTEGERs;
269 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
270 */
271 Elemcount i;
272
273 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
274 /* This vector is an ATOM set */
275 {
276 if (NILP (type)) type = QATOM;
277 *size_ret = XVECTOR_LENGTH (obj);
278 *format_ret = 32;
279 *data_ret = xnew_rawbytes ((*size_ret) * sizeof (XE_ATOM_TYPE));
280 for (i = 0; i < *size_ret; i++)
281 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
282 (*(XE_ATOM_TYPE **) data_ret) [i] =
283 XE_SYMBOL_TO_ATOM (d, XVECTOR_DATA (obj) [i], 0);
284 else
285 syntax_error
286 ("all elements of the vector must be of the same type", obj);
287 }
288 #if 0 /* #### MULTIPLE doesn't work yet */
289 else if (VECTORP (XVECTOR_DATA (obj) [0]))
290 /* This vector is an ATOM_PAIR set */
291 {
292 if (NILP (type)) type = QATOM_PAIR;
293 *size_ret = XVECTOR_LENGTH (obj);
294 *format_ret = 32;
295 *data_ret =
296 xnew_rawbytes ((*size_ret) * sizeof (XE_ATOM_TYPE) * 2);
297 for (i = 0; i < *size_ret; i++)
298 if (VECTORP (XVECTOR_DATA (obj) [i]))
299 {
300 Lisp_Object pair = XVECTOR_DATA (obj) [i];
301 if (XVECTOR_LENGTH (pair) != 2)
302 syntax_error
303 ("elements of the vector must be vectors of exactly two elements", pair);
304
305 (*(XE_ATOM_TYPE **) data_ret) [i * 2] =
306 XE_SYMBOL_TO_ATOM (d, XVECTOR_DATA (pair) [0], 0);
307 (*(XE_ATOM_TYPE **) data_ret) [(i * 2) + 1] =
308 XE_SYMBOL_TO_ATOM (d, XVECTOR_DATA (pair) [1], 0);
309 }
310 else
311 syntax_error
312 ("all elements of the vector must be of the same type", obj);
313 }
314 #endif
315 else
316 /* This vector is an INTEGER set, or something like it */
317 {
318 *size_ret = XVECTOR_LENGTH (obj);
319 if (NILP (type)) type = QINTEGER;
320 *format_ret = 16;
321 for (i = 0; i < *size_ret; i++)
322 if (CONSP (XVECTOR_DATA (obj) [i]))
323 *format_ret = 32;
324 else if (!INTP (XVECTOR_DATA (obj) [i]))
325 syntax_error
326 ("all elements of the vector must be integers or conses of integers", obj);
327
328 *data_ret = xnew_rawbytes (*size_ret * (*format_ret/8));
329 for (i = 0; i < *size_ret; i++)
330 if (*format_ret == 32)
331 (*((unsigned long **) data_ret)) [i] =
332 lisp_to_word (XVECTOR_DATA (obj) [i]);
333 else
334 (*((unsigned short **) data_ret)) [i] =
335 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
336 }
337 }
338 else
339 invalid_argument ("unrecognized selection data", obj);
340
341 *type_ret = XE_SYMBOL_TO_ATOM (d, type, 0);
342 }
343