Mercurial > hg > xemacs-beta

comparison src/select-common.h @ 647:b39c14581166

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2001-08-13 04:45:47 by ben] removal of unsigned, size_t, etc.
author ben
date Mon, 13 Aug 2001 04:46:48 +0000
parents
children fdefd0186b75
comparison
equal deleted inserted replaced
646:00c54252fe4f 647:b39c14581166
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 PROCESSING_X_CODE
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 /* PROCESSING_X_CODE */
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 When converting a Lisp number to C, it is assumed to be of format 16 if
51 it is an integer, and of format 32 if it is a cons of two integers.
52
53 When converting a vector of numbers from Elisp to C, it is assumed to be
54 of format 16 if every element in the vector is an integer, and is assumed
55 to be of format 32 if any element is a cons of two integers.
56
57 When converting an object to C, it may be of the form (SYMBOL . <data>)
58 where SYMBOL is what we should claim that the type is. Format and
59 representation are as above.
60
61 NOTE: Under Mule, when someone shoves us a string without a type, we
62 set the type to 'COMPOUND_TEXT and automatically convert to Compound
63 Text. If the string has a type, we assume that the user wants the
64 data sent as-is so we just do "binary" conversion.
65 */
66
67
68 static Lisp_Object
69 selection_data_to_lisp_data (struct device *d,
70 UChar_Binary *data,
71 Memory_Count size,
72 XE_ATOM_TYPE type,
73 int format)
74 {
75 #ifdef PROCESSING_X_CODE
76 if (type == DEVICE_XATOM_NULL (d))
77 return QNULL;
78
79 /* Convert any 8-bit data to a string, for compactness. */
80 else if (format == 8)
81 return make_ext_string ((Extbyte *) data, size,
82 type == DEVICE_XATOM_TEXT (d) ||
83 type == DEVICE_XATOM_COMPOUND_TEXT (d)
84 ? Qctext : Qbinary);
85
86 /* Convert a single atom to a Lisp Symbol.
87 Convert a set of atoms to a vector of symbols. */
88 else if (type == XA_ATOM)
89 #else
90 if (type == gdk_atom_intern ("NULL", 0))
91 return QNULL;
92
93 /* Convert any 8-bit data to a string, for compactness. */
94 else if (format == 8)
95 return make_ext_string ((Extbyte *) data, size,
96 ((type == gdk_atom_intern ("TEXT", FALSE)) ||
97 (type == gdk_atom_intern ("COMPOUND_TEXT", FALSE)))
98 ? Qctext : Qbinary);
99
100 /* Convert a single atom to a Lisp Symbol.
101 Convert a set of atoms to a vector of symbols. */
102 else if (type == gdk_atom_intern ("ATOM", FALSE))
103 #endif /* PROCESSING_X_CODE */
104 {
105 if (size == sizeof (XE_ATOM_TYPE))
106 return XE_ATOM_TO_SYMBOL (d, *((XE_ATOM_TYPE *) data));
107 else
108 {
109 Element_Count i;
110 Element_Count len = size / sizeof (XE_ATOM_TYPE);
111 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
112 for (i = 0; i < len; i++)
113 Faset (v, make_int (i), XE_ATOM_TO_SYMBOL (d, ((XE_ATOM_TYPE *) data) [i]));
114 return v;
115 }
116 }
117
118 /* Convert a single 16 or small 32 bit number to a Lisp Int.
119 If the number is > 16 bits, convert it to a cons of integers,
120 16 bits in each half.
121 */
122 else if (format == 32 && size == sizeof (long))
123 return word_to_lisp (((unsigned long *) data) [0]);
124 else if (format == 16 && size == sizeof (short))
125 return make_int ((int) (((unsigned short *) data) [0]));
126
127 /* Convert any other kind of data to a vector of numbers, represented
128 as above (as an integer, or a cons of two 16 bit integers).
129
130 #### Perhaps we should return the actual type to lisp as well.
131
132 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
133 ==> [4 4]
134
135 and perhaps it should be
136
137 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
138 ==> (SPAN . [4 4])
139
140 Right now the fact that the return type was SPAN is discarded before
141 lisp code gets to see it.
142 */
143 else if (format == 16)
144 {
145 Element_Count i;
146 Lisp_Object v = make_vector (size / 4, Qzero);
147 for (i = 0; i < size / 4; i++)
148 {
149 int j = (int) ((unsigned short *) data) [i];
150 Faset (v, make_int (i), make_int (j));
151 }
152 return v;
153 }
154 else
155 {
156 Element_Count i;
157 Lisp_Object v = make_vector (size / 4, Qzero);
158 for (i = 0; i < size / 4; i++)
159 {
160 unsigned long j = ((unsigned long *) data) [i];
161 Faset (v, make_int (i), word_to_lisp (j));
162 }
163 return v;
164 }
165 }
166
167
168 static void
169 lisp_data_to_selection_data (struct device *d,
170 Lisp_Object obj,
171 UChar_Binary **data_ret,
172 XE_ATOM_TYPE *type_ret,
173 Memory_Count *size_ret,
174 int *format_ret)
175 {
176 Lisp_Object type = Qnil;
177
178 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
179 {
180 type = XCAR (obj);
181 obj = XCDR (obj);
182 if (CONSP (obj) && NILP (XCDR (obj)))
183 obj = XCAR (obj);
184 }
185
186 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
187 { /* This is not the same as declining */
188 *format_ret = 32;
189 *size_ret = 0;
190 *data_ret = 0;
191 type = QNULL;
192 }
193 else if (STRINGP (obj))
194 {
195 const Extbyte *extval;
196 Extcount extvallen;
197
198 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
199 ALLOCA, (extval, extvallen),
200 (NILP (type) ? Qctext : Qbinary));
201 *format_ret = 8;
202 *size_ret = extvallen;
203 *data_ret = (UChar_Binary *) xmalloc (*size_ret);
204 memcpy (*data_ret, extval, *size_ret);
205 #ifdef MULE
206 if (NILP (type)) type = QCOMPOUND_TEXT;
207 #else
208 if (NILP (type)) type = QSTRING;
209 #endif
210 }
211 else if (CHARP (obj))
212 {
213 Bufbyte buf[MAX_EMCHAR_LEN];
214 Bytecount len;
215 const Extbyte *extval;
216 Extcount extvallen;
217
218 *format_ret = 8;
219 len = set_charptr_emchar (buf, XCHAR (obj));
220 TO_EXTERNAL_FORMAT (DATA, (buf, len),
221 ALLOCA, (extval, extvallen),
222 Qctext);
223 *size_ret = extvallen;
224 *data_ret = (UChar_Binary *) xmalloc (*size_ret);
225 memcpy (*data_ret, extval, *size_ret);
226 #ifdef MULE
227 if (NILP (type)) type = QCOMPOUND_TEXT;
228 #else
229 if (NILP (type)) type = QSTRING;
230 #endif
231 }
232 else if (SYMBOLP (obj))
233 {
234 *format_ret = 32;
235 *size_ret = 1;
236 *data_ret = (UChar_Binary *) xmalloc (sizeof (XE_ATOM_TYPE) + 1);
237 (*data_ret) [sizeof (XE_ATOM_TYPE)] = 0;
238 (*(XE_ATOM_TYPE **) data_ret) [0] = XE_SYMBOL_TO_ATOM (d, obj, 0);
239 if (NILP (type)) type = QATOM;
240 }
241 else if (INTP (obj) &&
242 XINT (obj) <= 0x7FFF &&
243 XINT (obj) >= -0x8000)
244 {
245 *format_ret = 16;
246 *size_ret = 1;
247 *data_ret = (UChar_Binary *) xmalloc (sizeof (short) + 1);
248 (*data_ret) [sizeof (short)] = 0;
249 (*(short **) data_ret) [0] = (short) XINT (obj);
250 if (NILP (type)) type = QINTEGER;
251 }
252 else if (INTP (obj) || CONSP (obj))
253 {
254 *format_ret = 32;
255 *size_ret = 1;
256 *data_ret = (UChar_Binary *) xmalloc (sizeof (long) + 1);
257 (*data_ret) [sizeof (long)] = 0;
258 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
259 if (NILP (type)) type = QINTEGER;
260 }
261 else if (VECTORP (obj))
262 {
263 /* Lisp Vectors may represent a set of ATOMs;
264 a set of 16 or 32 bit INTEGERs;
265 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
266 */
267 Element_Count i;
268
269 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
270 /* This vector is an ATOM set */
271 {
272 if (NILP (type)) type = QATOM;
273 *size_ret = XVECTOR_LENGTH (obj);
274 *format_ret = 32;
275 *data_ret = (UChar_Binary *) xmalloc ((*size_ret) * sizeof (XE_ATOM_TYPE));
276 for (i = 0; i < *size_ret; i++)
277 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
278 (*(XE_ATOM_TYPE **) data_ret) [i] =
279 XE_SYMBOL_TO_ATOM (d, XVECTOR_DATA (obj) [i], 0);
280 else
281 syntax_error
282 ("all elements of the vector must be of the same type", obj);
283 }
284 #if 0 /* #### MULTIPLE doesn't work yet */
285 else if (VECTORP (XVECTOR_DATA (obj) [0]))
286 /* This vector is an ATOM_PAIR set */
287 {
288 if (NILP (type)) type = QATOM_PAIR;
289 *size_ret = XVECTOR_LENGTH (obj);
290 *format_ret = 32;
291 *data_ret = (UChar_Binary *)
292 xmalloc ((*size_ret) * sizeof (XE_ATOM_TYPE) * 2);
293 for (i = 0; i < *size_ret; i++)
294 if (VECTORP (XVECTOR_DATA (obj) [i]))
295 {
296 Lisp_Object pair = XVECTOR_DATA (obj) [i];
297 if (XVECTOR_LENGTH (pair) != 2)
298 syntax_error
299 ("elements of the vector must be vectors of exactly two elements", pair);
300
301 (*(XE_ATOM_TYPE **) data_ret) [i * 2] =
302 XE_SYMBOL_TO_ATOM (d, XVECTOR_DATA (pair) [0], 0);
303 (*(XE_ATOM_TYPE **) data_ret) [(i * 2) + 1] =
304 XE_SYMBOL_TO_ATOM (d, XVECTOR_DATA (pair) [1], 0);
305 }
306 else
307 syntax_error
308 ("all elements of the vector must be of the same type", obj);
309 }
310 #endif
311 else
312 /* This vector is an INTEGER set, or something like it */
313 {
314 *size_ret = XVECTOR_LENGTH (obj);
315 if (NILP (type)) type = QINTEGER;
316 *format_ret = 16;
317 for (i = 0; i < *size_ret; i++)
318 if (CONSP (XVECTOR_DATA (obj) [i]))
319 *format_ret = 32;
320 else if (!INTP (XVECTOR_DATA (obj) [i]))
321 syntax_error
322 ("all elements of the vector must be integers or conses of integers", obj);
323
324 *data_ret = (UChar_Binary *) xmalloc (*size_ret * (*format_ret/8));
325 for (i = 0; i < *size_ret; i++)
326 if (*format_ret == 32)
327 (*((unsigned long **) data_ret)) [i] =
328 lisp_to_word (XVECTOR_DATA (obj) [i]);
329 else
330 (*((unsigned short **) data_ret)) [i] =
331 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
332 }
333 }
334 else
335 invalid_argument ("unrecognized selection data", obj);
336
337 *type_ret = XE_SYMBOL_TO_ATOM (d, type, 0);
338 }
339