Mercurial > hg > xemacs-beta

comparison src/select-x.c @ 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 183866b06e0b
children fdefd0186b75
comparison
equal deleted inserted replaced
646:00c54252fe4f 647:b39c14581166
79 int x_selection_strict_motif_ownership; 79 int x_selection_strict_motif_ownership;
80 80
81 81
82 /* Utility functions */ 82 /* Utility functions */
83 83
84 static void lisp_data_to_selection_data (struct device *,
85 Lisp_Object obj,
86 unsigned char **data_ret,
87 Atom *type_ret,
88 unsigned int *size_ret,
89 int *format_ret);
90 static Lisp_Object selection_data_to_lisp_data (struct device *,
91 Extbyte *data,
92 size_t size,
93 Atom type,
94 int format);
95 static Lisp_Object x_get_window_property_as_lisp_data (Display *, 84 static Lisp_Object x_get_window_property_as_lisp_data (Display *,
96 Window, 85 Window,
97 Atom property, 86 Atom property,
98 Lisp_Object target_type, 87 Lisp_Object target_type,
99 Atom selection_atom); 88 Atom selection_atom);
140 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6; 129 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
141 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7; 130 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
142 #endif /* CUT_BUFFER_SUPPORT */ 131 #endif /* CUT_BUFFER_SUPPORT */
143 132
144 { 133 {
145 const char *nameext; 134 const Extbyte *nameext;
146 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext); 135 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
147 return XInternAtom (display, nameext, only_if_exists ? True : False); 136 return XInternAtom (display, nameext, only_if_exists ? True : False);
148 } 137 }
149 } 138 }
150 139
198 XFree (str); 187 XFree (str);
199 return intern (intstr); 188 return intern (intstr);
200 } 189 }
201 } 190 }
202 191
192 #define PROCESSING_X_CODE
193 #include "select-common.h"
194 #undef PROCESSING_X_CODE
203 195
204 /* Do protocol to assert ourself as a selection owner. 196 /* Do protocol to assert ourself as a selection owner.
205 */ 197 */
206 static Lisp_Object 198 static Lisp_Object
207 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value, 199 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
467 /* Convert our selection to the requested type, and put that data where the 459 /* Convert our selection to the requested type, and put that data where the
468 requestor wants it. Then tell them whether we've succeeded. 460 requestor wants it. Then tell them whether we've succeeded.
469 */ 461 */
470 static void 462 static void
471 x_reply_selection_request (XSelectionRequestEvent *event, int format, 463 x_reply_selection_request (XSelectionRequestEvent *event, int format,
472 unsigned char *data, int size, Atom type) 464 UChar_Binary *data, Memory_Count size, Atom type)
473 { 465 {
474 /* This function can GC */ 466 /* This function can GC */
475 XSelectionEvent reply; 467 XSelectionEvent reply;
476 Display *display = event->display; 468 Display *display = event->display;
477 struct device *d = get_device_from_display (display); 469 struct device *d = get_device_from_display (display);
478 Window window = event->requestor; 470 Window window = event->requestor;
479 int bytes_remaining; 471 Memory_Count bytes_remaining;
480 int format_bytes = format/8; 472 int format_bytes = format/8;
481 int max_bytes = SELECTION_QUANTUM (display); 473 Memory_Count max_bytes = SELECTION_QUANTUM (display);
482 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM; 474 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
483 475
484 reply.type = SelectionNotify; 476 reply.type = SelectionNotify;
485 reply.display = display; 477 reply.display = display;
486 reply.requestor = window; 478 reply.requestor = window;
519 #endif 511 #endif
520 prop_id = expect_property_change (display, window, reply.property, 512 prop_id = expect_property_change (display, window, reply.property,
521 PropertyDelete); 513 PropertyDelete);
522 514
523 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d), 515 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d),
524 32, PropModeReplace, (unsigned char *) 516 32, PropModeReplace, (UChar_Binary *)
525 &bytes_remaining, 1); 517 &bytes_remaining, 1);
526 XSelectInput (display, window, PropertyChangeMask); 518 XSelectInput (display, window, PropertyChangeMask);
527 /* Tell 'em the INCR data is there... */ 519 /* Tell 'em the INCR data is there... */
528 XSendEvent (display, window, False, 0L, (XEvent *) &reply); 520 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
529 XFlush (display); 521 XFlush (display);
533 */ 525 */
534 wait_for_property_change (prop_id); 526 wait_for_property_change (prop_id);
535 527
536 while (bytes_remaining) 528 while (bytes_remaining)
537 { 529 {
538 int i = ((bytes_remaining < max_bytes) 530 Memory_Count i = ((bytes_remaining < max_bytes)
539 ? bytes_remaining 531 ? bytes_remaining
540 : max_bytes); 532 : max_bytes);
541 prop_id = expect_property_change (display, window, reply.property, 533 prop_id = expect_property_change (display, window, reply.property,
542 PropertyDelete); 534 PropertyDelete);
543 #if 0 535 #if 0
630 count = specpdl_depth (); 622 count = specpdl_depth ();
631 record_unwind_protect (x_selection_request_lisp_error, 623 record_unwind_protect (x_selection_request_lisp_error,
632 make_opaque_ptr (event)); 624 make_opaque_ptr (event));
633 625
634 { 626 {
635 unsigned char *data; 627 UChar_Binary *data;
636 unsigned int size; 628 Memory_Count size;
637 int format; 629 int format;
638 Atom type; 630 Atom type;
639 lisp_data_to_selection_data (d, converted_selection, 631 lisp_data_to_selection_data (d, converted_selection,
640 &data, &type, &size, &format); 632 &data, &type, &size, &format);
641 633
846 838
847 static Lisp_Object 839 static Lisp_Object
848 copy_multiple_data (Lisp_Object obj) 840 copy_multiple_data (Lisp_Object obj)
849 { 841 {
850 Lisp_Object vec; 842 Lisp_Object vec;
851 int i; 843 Element_Count i;
852 int len; 844 Element_Count len;
853 if (CONSP (obj)) 845 if (CONSP (obj))
854 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj))); 846 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
855 847
856 CHECK_VECTOR (obj); 848 CHECK_VECTOR (obj);
857 len = XVECTOR_LENGTH (obj); 849 len = XVECTOR_LENGTH (obj);
952 } 944 }
953 945
954 946
955 static void 947 static void
956 x_get_window_property (Display *display, Window window, Atom property, 948 x_get_window_property (Display *display, Window window, Atom property,
957 Extbyte **data_ret, int *bytes_ret, 949 UChar_Binary **data_ret, Memory_Count *bytes_ret,
958 Atom *actual_type_ret, int *actual_format_ret, 950 Atom *actual_type_ret, int *actual_format_ret,
959 unsigned long *actual_size_ret, int delete_p) 951 unsigned long *actual_size_ret, int delete_p)
960 { 952 {
961 size_t total_size; 953 Memory_Count total_size;
962 unsigned long bytes_remaining; 954 unsigned long bytes_remaining;
963 int offset = 0; 955 Memory_Count offset = 0;
964 unsigned char *tmp_data = 0; 956 UChar_Binary *tmp_data = 0;
965 int result; 957 int result;
966 int buffer_size = SELECTION_QUANTUM (display); 958 Memory_Count buffer_size = SELECTION_QUANTUM (display);
967 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM; 959 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
968 960
969 /* First probe the thing to find out how big it is. */ 961 /* First probe the thing to find out how big it is. */
970 result = XGetWindowProperty (display, window, property, 962 result = XGetWindowProperty (display, window, property,
971 0, 0, False, AnyPropertyType, 963 0, 0, False, AnyPropertyType,
987 *bytes_ret = 0; 979 *bytes_ret = 0;
988 return; 980 return;
989 } 981 }
990 982
991 total_size = bytes_remaining + 1; 983 total_size = bytes_remaining + 1;
992 *data_ret = (Extbyte *) xmalloc (total_size); 984 *data_ret = (UChar_Binary *) xmalloc (total_size);
993 985
994 /* Now read, until we've gotten it all. */ 986 /* Now read, until we've gotten it all. */
995 while (bytes_remaining) 987 while (bytes_remaining)
996 { 988 {
997 #if 0 989 #if 0
998 int last = bytes_remaining; 990 Memory_Count last = bytes_remaining;
999 #endif 991 #endif
1000 result = 992 result =
1001 XGetWindowProperty (display, window, property, 993 XGetWindowProperty (display, window, property,
1002 offset/4, buffer_size/4, 994 offset/4, buffer_size/4,
1003 (delete_p ? True : False), 995 (delete_p ? True : False),
1023 1015
1024 static void 1016 static void
1025 receive_incremental_selection (Display *display, Window window, Atom property, 1017 receive_incremental_selection (Display *display, Window window, Atom property,
1026 /* this one is for error messages only */ 1018 /* this one is for error messages only */
1027 Lisp_Object target_type, 1019 Lisp_Object target_type,
1028 unsigned int min_size_bytes, 1020 Memory_Count min_size_bytes,
1029 Extbyte **data_ret, int *size_bytes_ret, 1021 UChar_Binary **data_ret,
1022 Memory_Count *size_bytes_ret,
1030 Atom *type_ret, int *format_ret, 1023 Atom *type_ret, int *format_ret,
1031 unsigned long *size_ret) 1024 unsigned long *size_ret)
1032 { 1025 {
1033 /* This function can GC */ 1026 /* This function can GC */
1034 int offset = 0; 1027 Memory_Count offset = 0;
1035 int prop_id; 1028 int prop_id;
1036 *size_bytes_ret = min_size_bytes; 1029 *size_bytes_ret = min_size_bytes;
1037 *data_ret = (Extbyte *) xmalloc (*size_bytes_ret); 1030 *data_ret = (UChar_Binary *) xmalloc (*size_bytes_ret);
1038 #if 0 1031 #if 0
1039 stderr_out ("\nread INCR %d\n", min_size_bytes); 1032 stderr_out ("\nread INCR %d\n", min_size_bytes);
1040 #endif 1033 #endif
1041 /* At this point, we have read an INCR property, and deleted it (which 1034 /* At this point, we have read an INCR property, and deleted it (which
1042 is how we ack its receipt: the sending window will be selecting 1035 is how we ack its receipt: the sending window will be selecting
1048 */ 1041 */
1049 prop_id = expect_property_change (display, window, property, 1042 prop_id = expect_property_change (display, window, property,
1050 PropertyNewValue); 1043 PropertyNewValue);
1051 while (1) 1044 while (1)
1052 { 1045 {
1053 Extbyte *tmp_data; 1046 UChar_Binary *tmp_data;
1054 int tmp_size_bytes; 1047 Memory_Count tmp_size_bytes;
1055 wait_for_property_change (prop_id); 1048 wait_for_property_change (prop_id);
1056 /* expect it again immediately, because x_get_window_property may 1049 /* expect it again immediately, because x_get_window_property may
1057 .. no it won't, I don't get it. 1050 .. no it won't, I don't get it.
1058 .. Ok, I get it now, the Xt code that implements INCR is broken. 1051 .. Ok, I get it now, the Xt code that implements INCR is broken.
1059 */ 1052 */
1080 #if 0 1073 #if 0
1081 stderr_out (" read INCR realloc %d -> %d\n", 1074 stderr_out (" read INCR realloc %d -> %d\n",
1082 *size_bytes_ret, offset + tmp_size_bytes); 1075 *size_bytes_ret, offset + tmp_size_bytes);
1083 #endif 1076 #endif
1084 *size_bytes_ret = offset + tmp_size_bytes; 1077 *size_bytes_ret = offset + tmp_size_bytes;
1085 *data_ret = (Extbyte *) xrealloc (*data_ret, *size_bytes_ret); 1078 *data_ret = (UChar_Binary *) xrealloc (*data_ret, *size_bytes_ret);
1086 } 1079 }
1087 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes); 1080 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
1088 offset += tmp_size_bytes; 1081 offset += tmp_size_bytes;
1089 xfree (tmp_data); 1082 xfree (tmp_data);
1090 } 1083 }
1101 { 1094 {
1102 /* This function can GC */ 1095 /* This function can GC */
1103 Atom actual_type; 1096 Atom actual_type;
1104 int actual_format; 1097 int actual_format;
1105 unsigned long actual_size; 1098 unsigned long actual_size;
1106 Extbyte *data = NULL; 1099 UChar_Binary *data = NULL;
1107 int bytes = 0; 1100 Memory_Count bytes = 0;
1108 Lisp_Object val; 1101 Lisp_Object val;
1109 struct device *d = get_device_from_display (display); 1102 struct device *d = get_device_from_display (display);
1110 1103
1111 x_get_window_property (display, window, property, &data, &bytes, 1104 x_get_window_property (display, window, property, &data, &bytes,
1112 &actual_type, &actual_format, &actual_size, 1); 1105 &actual_type, &actual_format, &actual_size, 1);
1130 1123
1131 if (actual_type == DEVICE_XATOM_INCR (d)) 1124 if (actual_type == DEVICE_XATOM_INCR (d))
1132 { 1125 {
1133 /* Ok, that data wasn't *the* data, it was just the beginning. */ 1126 /* Ok, that data wasn't *the* data, it was just the beginning. */
1134 1127
1135 unsigned int min_size_bytes = * ((unsigned int *) data); 1128 Memory_Count min_size_bytes =
1129 /* careful here. */
1130 (Memory_Count) (* ((unsigned int *) data));
1136 xfree (data); 1131 xfree (data);
1137 receive_incremental_selection (display, window, property, target_type, 1132 receive_incremental_selection (display, window, property, target_type,
1138 min_size_bytes, &data, &bytes, 1133 min_size_bytes, &data, &bytes,
1139 &actual_type, &actual_format, 1134 &actual_type, &actual_format,
1140 &actual_size); 1135 &actual_size);
1146 actual_type, actual_format); 1141 actual_type, actual_format);
1147 1142
1148 xfree (data); 1143 xfree (data);
1149 return val; 1144 return val;
1150 } 1145 }
1151
1152 /* #### These are going to move into Lisp code(!) with the aid of
1153 some new functions I'm working on - ajh */
1154
1155 /* These functions convert from the selection data read from the server into
1156 something that we can use from elisp, and vice versa.
1157
1158 Type: Format: Size: Elisp Type:
1159 ----- ------- ----- -----------
1160 * 8 * String
1161 ATOM 32 1 Symbol
1162 ATOM 32 > 1 Vector of Symbols
1163 * 16 1 Integer
1164 * 16 > 1 Vector of Integers
1165 * 32 1 if <=16 bits: Integer
1166 if > 16 bits: Cons of top16, bot16
1167 * 32 > 1 Vector of the above
1168
1169 When converting a Lisp number to C, it is assumed to be of format 16 if
1170 it is an integer, and of format 32 if it is a cons of two integers.
1171
1172 When converting a vector of numbers from Elisp to C, it is assumed to be
1173 of format 16 if every element in the vector is an integer, and is assumed
1174 to be of format 32 if any element is a cons of two integers.
1175
1176 When converting an object to C, it may be of the form (SYMBOL . <data>)
1177 where SYMBOL is what we should claim that the type is. Format and
1178 representation are as above.
1179
1180 NOTE: Under Mule, when someone shoves us a string without a type, we
1181 set the type to 'COMPOUND_TEXT and automatically convert to Compound
1182 Text. If the string has a type, we assume that the user wants the
1183 data sent as-is so we just do "binary" conversion.
1184 */
1185
1186
1187 static Lisp_Object
1188 selection_data_to_lisp_data (struct device *d,
1189 Extbyte *data,
1190 size_t size,
1191 Atom type,
1192 int format)
1193 {
1194 if (type == DEVICE_XATOM_NULL (d))
1195 return QNULL;
1196
1197 /* Convert any 8-bit data to a string, for compactness. */
1198 else if (format == 8)
1199 return make_ext_string (data, size,
1200 type == DEVICE_XATOM_TEXT (d) ||
1201 type == DEVICE_XATOM_COMPOUND_TEXT (d)
1202 ? Qctext : Qbinary);
1203
1204 /* Convert a single atom to a Lisp Symbol.
1205 Convert a set of atoms to a vector of symbols. */
1206 else if (type == XA_ATOM)
1207 {
1208 if (size == sizeof (Atom))
1209 return x_atom_to_symbol (d, *((Atom *) data));
1210 else
1211 {
1212 int i;
1213 int len = size / sizeof (Atom);
1214 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
1215 for (i = 0; i < len; i++)
1216 Faset (v, make_int (i), x_atom_to_symbol (d, ((Atom *) data) [i]));
1217 return v;
1218 }
1219 }
1220
1221 /* Convert a single 16 or small 32 bit number to a Lisp Int.
1222 If the number is > 16 bits, convert it to a cons of integers,
1223 16 bits in each half.
1224 */
1225 else if (format == 32 && size == sizeof (long))
1226 return word_to_lisp (((unsigned long *) data) [0]);
1227 else if (format == 16 && size == sizeof (short))
1228 return make_int ((int) (((unsigned short *) data) [0]));
1229
1230 /* Convert any other kind of data to a vector of numbers, represented
1231 as above (as an integer, or a cons of two 16 bit integers).
1232
1233 #### Perhaps we should return the actual type to lisp as well.
1234
1235 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1236 ==> [4 4]
1237
1238 and perhaps it should be
1239
1240 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1241 ==> (SPAN . [4 4])
1242
1243 Right now the fact that the return type was SPAN is discarded before
1244 lisp code gets to see it.
1245 */
1246 else if (format == 16)
1247 {
1248 int i;
1249 Lisp_Object v = make_vector (size / 4, Qzero);
1250 for (i = 0; i < (int) size / 4; i++)
1251 {
1252 int j = (int) ((unsigned short *) data) [i];
1253 Faset (v, make_int (i), make_int (j));
1254 }
1255 return v;
1256 }
1257 else
1258 {
1259 int i;
1260 Lisp_Object v = make_vector (size / 4, Qzero);
1261 for (i = 0; i < (int) size / 4; i++)
1262 {
1263 unsigned long j = ((unsigned long *) data) [i];
1264 Faset (v, make_int (i), word_to_lisp (j));
1265 }
1266 return v;
1267 }
1268 }
1269
1270
1271 static void
1272 lisp_data_to_selection_data (struct device *d,
1273 Lisp_Object obj,
1274 unsigned char **data_ret,
1275 Atom *type_ret,
1276 unsigned int *size_ret,
1277 int *format_ret)
1278 {
1279 Lisp_Object type = Qnil;
1280
1281 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1282 {
1283 type = XCAR (obj);
1284 obj = XCDR (obj);
1285 if (CONSP (obj) && NILP (XCDR (obj)))
1286 obj = XCAR (obj);
1287 }
1288
1289 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1290 { /* This is not the same as declining */
1291 *format_ret = 32;
1292 *size_ret = 0;
1293 *data_ret = 0;
1294 type = QNULL;
1295 }
1296 else if (STRINGP (obj))
1297 {
1298 const Extbyte *extval;
1299 Extcount extvallen;
1300
1301 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
1302 ALLOCA, (extval, extvallen),
1303 (NILP (type) ? Qctext : Qbinary));
1304 *format_ret = 8;
1305 *size_ret = extvallen;
1306 *data_ret = (unsigned char *) xmalloc (*size_ret);
1307 memcpy (*data_ret, extval, *size_ret);
1308 #ifdef MULE
1309 if (NILP (type)) type = QCOMPOUND_TEXT;
1310 #else
1311 if (NILP (type)) type = QSTRING;
1312 #endif
1313 }
1314 else if (CHARP (obj))
1315 {
1316 Bufbyte buf[MAX_EMCHAR_LEN];
1317 Bytecount len;
1318 const Extbyte *extval;
1319 Extcount extvallen;
1320
1321 *format_ret = 8;
1322 len = set_charptr_emchar (buf, XCHAR (obj));
1323 TO_EXTERNAL_FORMAT (DATA, (buf, len),
1324 ALLOCA, (extval, extvallen),
1325 Qctext);
1326 *size_ret = extvallen;
1327 *data_ret = (unsigned char *) xmalloc (*size_ret);
1328 memcpy (*data_ret, extval, *size_ret);
1329 #ifdef MULE
1330 if (NILP (type)) type = QCOMPOUND_TEXT;
1331 #else
1332 if (NILP (type)) type = QSTRING;
1333 #endif
1334 }
1335 else if (SYMBOLP (obj))
1336 {
1337 *format_ret = 32;
1338 *size_ret = 1;
1339 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1340 (*data_ret) [sizeof (Atom)] = 0;
1341 (*(Atom **) data_ret) [0] = symbol_to_x_atom (d, obj, 0);
1342 if (NILP (type)) type = QATOM;
1343 }
1344 else if (INTP (obj) &&
1345 XINT (obj) <= 0x7FFF &&
1346 XINT (obj) >= -0x8000)
1347 {
1348 *format_ret = 16;
1349 *size_ret = 1;
1350 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1351 (*data_ret) [sizeof (short)] = 0;
1352 (*(short **) data_ret) [0] = (short) XINT (obj);
1353 if (NILP (type)) type = QINTEGER;
1354 }
1355 else if (INTP (obj) || CONSP (obj))
1356 {
1357 *format_ret = 32;
1358 *size_ret = 1;
1359 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1360 (*data_ret) [sizeof (long)] = 0;
1361 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
1362 if (NILP (type)) type = QINTEGER;
1363 }
1364 else if (VECTORP (obj))
1365 {
1366 /* Lisp Vectors may represent a set of ATOMs;
1367 a set of 16 or 32 bit INTEGERs;
1368 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1369 */
1370 int i;
1371
1372 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
1373 /* This vector is an ATOM set */
1374 {
1375 if (NILP (type)) type = QATOM;
1376 *size_ret = XVECTOR_LENGTH (obj);
1377 *format_ret = 32;
1378 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1379 for (i = 0; i < (int) (*size_ret); i++)
1380 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
1381 (*(Atom **) data_ret) [i] =
1382 symbol_to_x_atom (d, XVECTOR_DATA (obj) [i], 0);
1383 else
1384 syntax_error
1385 ("all elements of the vector must be of the same type", obj);
1386 }
1387 #if 0 /* #### MULTIPLE doesn't work yet */
1388 else if (VECTORP (XVECTOR_DATA (obj) [0]))
1389 /* This vector is an ATOM_PAIR set */
1390 {
1391 if (NILP (type)) type = QATOM_PAIR;
1392 *size_ret = XVECTOR_LENGTH (obj);
1393 *format_ret = 32;
1394 *data_ret = (unsigned char *)
1395 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1396 for (i = 0; i < *size_ret; i++)
1397 if (VECTORP (XVECTOR_DATA (obj) [i]))
1398 {
1399 Lisp_Object pair = XVECTOR_DATA (obj) [i];
1400 if (XVECTOR_LENGTH (pair) != 2)
1401 syntax_error
1402 ("elements of the vector must be vectors of exactly two elements", pair);
1403
1404 (*(Atom **) data_ret) [i * 2] =
1405 symbol_to_x_atom (d, XVECTOR_DATA (pair) [0], 0);
1406 (*(Atom **) data_ret) [(i * 2) + 1] =
1407 symbol_to_x_atom (d, XVECTOR_DATA (pair) [1], 0);
1408 }
1409 else
1410 syntax_error
1411 ("all elements of the vector must be of the same type", obj);
1412 }
1413 #endif
1414 else
1415 /* This vector is an INTEGER set, or something like it */
1416 {
1417 *size_ret = XVECTOR_LENGTH (obj);
1418 if (NILP (type)) type = QINTEGER;
1419 *format_ret = 16;
1420 for (i = 0; i < (int) (*size_ret); i++)
1421 if (CONSP (XVECTOR_DATA (obj) [i]))
1422 *format_ret = 32;
1423 else if (!INTP (XVECTOR_DATA (obj) [i]))
1424 syntax_error
1425 ("all elements of the vector must be integers or conses of integers", obj);
1426
1427 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1428 for (i = 0; i < (int) (*size_ret); i++)
1429 if (*format_ret == 32)
1430 (*((unsigned long **) data_ret)) [i] =
1431 lisp_to_word (XVECTOR_DATA (obj) [i]);
1432 else
1433 (*((unsigned short **) data_ret)) [i] =
1434 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
1435 }
1436 }
1437 else
1438 invalid_argument ("unrecognized selection data", obj);
1439
1440 *type_ret = symbol_to_x_atom (d, type, 0);
1441 }
1442
1443 1146
1444 1147
1445 /* Called from the event loop to handle SelectionNotify events. 1148 /* Called from the event loop to handle SelectionNotify events.
1446 I don't think this needs to be reentrant. 1149 I don't think this needs to be reentrant.
1447 */ 1150 */
1539 { 1242 {
1540 struct device *d = decode_x_device (Qnil); 1243 struct device *d = decode_x_device (Qnil);
1541 Display *display = DEVICE_X_DISPLAY (d); 1244 Display *display = DEVICE_X_DISPLAY (d);
1542 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ 1245 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1543 Atom cut_buffer_atom; 1246 Atom cut_buffer_atom;
1544 Extbyte *data; 1247 UChar_Binary *data;
1545 int bytes; 1248 Memory_Count bytes;
1546 Atom type; 1249 Atom type;
1547 int format; 1250 int format;
1548 unsigned long size; 1251 unsigned long size;
1549 Lisp_Object ret; 1252 Lisp_Object ret;
1550 1253
1563 /* We cheat - if the string contains an ESC character, that's 1266 /* We cheat - if the string contains an ESC character, that's
1564 technically not allowed in a STRING, so we assume it's 1267 technically not allowed in a STRING, so we assume it's
1565 COMPOUND_TEXT that we stored there ourselves earlier, 1268 COMPOUND_TEXT that we stored there ourselves earlier,
1566 in x-store-cutbuffer-internal */ 1269 in x-store-cutbuffer-internal */
1567 ret = (bytes ? 1270 ret = (bytes ?
1568 make_ext_string (data, bytes, 1271 make_ext_string ((Extbyte *) data, bytes,
1569 memchr (data, 0x1b, bytes) ? 1272 memchr (data, 0x1b, bytes) ?
1570 Qctext : Qbinary) 1273 Qctext : Qbinary)
1571 : Qnil); 1274 : Qnil);
1572 xfree (data); 1275 xfree (data);
1573 return ret; 1276 return ret;
1584 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */ 1287 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1585 Atom cut_buffer_atom; 1288 Atom cut_buffer_atom;
1586 const Bufbyte *data = XSTRING_DATA (string); 1289 const Bufbyte *data = XSTRING_DATA (string);
1587 Bytecount bytes = XSTRING_LENGTH (string); 1290 Bytecount bytes = XSTRING_LENGTH (string);
1588 Bytecount bytes_remaining; 1291 Bytecount bytes_remaining;
1589 int max_bytes = SELECTION_QUANTUM (display); 1292 Memory_Count max_bytes = SELECTION_QUANTUM (display);
1590 #ifdef MULE 1293 #ifdef MULE
1591 const Bufbyte *ptr, *end; 1294 const Bufbyte *ptr, *end;
1592 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII; 1295 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
1593 #endif 1296 #endif
1594 1297
1641 1344
1642 bytes_remaining = bytes; 1345 bytes_remaining = bytes;
1643 1346
1644 while (bytes_remaining) 1347 while (bytes_remaining)
1645 { 1348 {
1646 int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes; 1349 Memory_Count chunk =
1350 bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
1647 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8, 1351 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
1648 (bytes_remaining == bytes 1352 (bytes_remaining == bytes
1649 ? PropModeReplace : PropModeAppend), 1353 ? PropModeReplace : PropModeAppend),
1650 data, chunk); 1354 data, chunk);
1651 data += chunk; 1355 data += chunk;