Mercurial > hg > xemacs-beta

comparison src/fns.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
34 #undef vector 34 #undef vector
35 #define vector ***** 35 #define vector *****
36 36
37 #include "lisp.h" 37 #include "lisp.h"
38 38
39 #ifdef HAVE_UNISTD_H 39 #include "sysfile.h"
40 #include <unistd.h>
41 #endif
42 #include <errno.h>
43 40
44 #include "buffer.h" 41 #include "buffer.h"
45 #include "bytecode.h" 42 #include "bytecode.h"
46 #include "device.h" 43 #include "device.h"
47 #include "events.h" 44 #include "events.h"
109 memory_hash (v->bits, 106 memory_hash (v->bits,
110 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) * 107 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) *
111 sizeof (long))); 108 sizeof (long)));
112 } 109 }
113 110
111 static size_t
112 size_bit_vector (const void *lheader)
113 {
114 Lisp_Bit_Vector *v = (Lisp_Bit_Vector *) lheader;
115 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits,
116 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)));
117 }
118
114 static const struct lrecord_description bit_vector_description[] = { 119 static const struct lrecord_description bit_vector_description[] = {
115 { XD_LISP_OBJECT, offsetof (Lisp_Bit_Vector, next) }, 120 { XD_LISP_OBJECT, offsetof (Lisp_Bit_Vector, next) },
116 { XD_END } 121 { XD_END }
117 }; 122 };
118 123
119 124
120 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bit-vector", bit_vector, 125 DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION ("bit-vector", bit_vector,
121 mark_bit_vector, print_bit_vector, 0, 126 mark_bit_vector, print_bit_vector, 0,
122 bit_vector_equal, bit_vector_hash, 127 bit_vector_equal, bit_vector_hash,
123 bit_vector_description, 128 bit_vector_description, size_bit_vector,
124 Lisp_Bit_Vector); 129 Lisp_Bit_Vector);
125 130
126 DEFUN ("identity", Fidentity, 1, 1, 0, /* 131 DEFUN ("identity", Fidentity, 1, 1, 0, /*
127 Return the argument unchanged. 132 Return the argument unchanged.
128 */ 133 */
129 (arg)) 134 (arg))
194 } 199 }
195 200
196 #endif /* LOSING_BYTECODE */ 201 #endif /* LOSING_BYTECODE */
197 202
198 void 203 void
199 check_losing_bytecode (CONST char *function, Lisp_Object seq) 204 check_losing_bytecode (const char *function, Lisp_Object seq)
200 { 205 {
201 if (COMPILED_FUNCTIONP (seq)) 206 if (COMPILED_FUNCTIONP (seq))
202 error_with_frob 207 error_with_frob
203 (seq, 208 (seq,
204 "As of 20.3, `%s' no longer works with compiled-function objects", 209 "As of 20.3, `%s' no longer works with compiled-function objects",
703 val = Qnil; 708 val = Qnil;
704 string_result = (Bufbyte *) alloca (total_length * MAX_EMCHAR_LEN); 709 string_result = (Bufbyte *) alloca (total_length * MAX_EMCHAR_LEN);
705 string_result_ptr = string_result; 710 string_result_ptr = string_result;
706 break; 711 break;
707 default: 712 default:
713 val = Qnil;
708 abort (); 714 abort ();
709 } 715 }
710 } 716 }
711 717
712 718
911 copy_string_extents (val, string, 0, bfr, blen); 917 copy_string_extents (val, string, 0, bfr, blen);
912 return val; 918 return val;
913 } 919 }
914 920
915 DEFUN ("subseq", Fsubseq, 2, 3, 0, /* 921 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
916 Return a subsequence of SEQ, starting at index FROM and ending before TO. 922 Return the subsequence of SEQUENCE starting at START and ending before END.
917 TO may be nil or omitted; then the subsequence runs to the end of SEQ. 923 END may be omitted; then the subsequence runs to the end of SEQUENCE.
918 If FROM or TO is negative, it counts from the end. 924 If START or END is negative, it counts from the end.
919 The resulting subsequence is always the same type as the original 925 The returned subsequence is always of the same type as SEQUENCE.
920 sequence. 926 If SEQUENCE is a string, relevant parts of the string-extent-data
921 If SEQ is a string, relevant parts of the string-extent-data are copied 927 are copied to the new string.
922 to the new string. 928 */
923 */ 929 (sequence, start, end))
924 (seq, from, to)) 930 {
925 { 931 EMACS_INT len, s, e;
926 EMACS_INT len, f, t; 932
927 933 if (STRINGP (sequence))
928 if (STRINGP (seq)) 934 return Fsubstring (sequence, start, end);
929 return Fsubstring (seq, from, to); 935
930 936 len = XINT (Flength (sequence));
931 if (!LISTP (seq) && !VECTORP (seq) && !BIT_VECTORP (seq)) 937
932 { 938 CHECK_INT (start);
933 check_losing_bytecode ("subseq", seq); 939 s = XINT (start);
934 seq = wrong_type_argument (Qsequencep, seq); 940 if (s < 0)
935 } 941 s = len + s;
936 942
937 len = XINT (Flength (seq)); 943 if (NILP (end))
938 944 e = len;
939 CHECK_INT (from);
940 f = XINT (from);
941 if (f < 0)
942 f = len + f;
943
944 if (NILP (to))
945 t = len;
946 else 945 else
947 { 946 {
948 CHECK_INT (to); 947 CHECK_INT (end);
949 t = XINT (to); 948 e = XINT (end);
950 if (t < 0) 949 if (e < 0)
951 t = len + t; 950 e = len + e;
952 } 951 }
953 952
954 if (!(0 <= f && f <= t && t <= len)) 953 if (!(0 <= s && s <= e && e <= len))
955 args_out_of_range_3 (seq, make_int (f), make_int (t)); 954 args_out_of_range_3 (sequence, make_int (s), make_int (e));
956 955
957 if (VECTORP (seq)) 956 if (VECTORP (sequence))
958 { 957 {
959 Lisp_Object result = make_vector (t - f, Qnil); 958 Lisp_Object result = make_vector (e - s, Qnil);
960 EMACS_INT i; 959 EMACS_INT i;
961 Lisp_Object *in_elts = XVECTOR_DATA (seq); 960 Lisp_Object *in_elts = XVECTOR_DATA (sequence);
962 Lisp_Object *out_elts = XVECTOR_DATA (result); 961 Lisp_Object *out_elts = XVECTOR_DATA (result);
963 962
964 for (i = f; i < t; i++) 963 for (i = s; i < e; i++)
965 out_elts[i - f] = in_elts[i]; 964 out_elts[i - s] = in_elts[i];
966 return result; 965 return result;
967 } 966 }
968 967 else if (LISTP (sequence))
969 if (LISTP (seq))
970 { 968 {
971 Lisp_Object result = Qnil; 969 Lisp_Object result = Qnil;
972 EMACS_INT i; 970 EMACS_INT i;
973 971
974 seq = Fnthcdr (make_int (f), seq); 972 sequence = Fnthcdr (make_int (s), sequence);
975 973
976 for (i = f; i < t; i++) 974 for (i = s; i < e; i++)
977 { 975 {
978 result = Fcons (Fcar (seq), result); 976 result = Fcons (Fcar (sequence), result);
979 seq = Fcdr (seq); 977 sequence = Fcdr (sequence);
980 } 978 }
981 979
982 return Fnreverse (result); 980 return Fnreverse (result);
983 } 981 }
984 982 else if (BIT_VECTORP (sequence))
985 /* bit vector */ 983 {
986 { 984 Lisp_Object result = make_bit_vector (e - s, Qzero);
987 Lisp_Object result = make_bit_vector (t - f, Qzero); 985 EMACS_INT i;
988 EMACS_INT i; 986
989 987 for (i = s; i < e; i++)
990 for (i = f; i < t; i++) 988 set_bit_vector_bit (XBIT_VECTOR (result), i - s,
991 set_bit_vector_bit (XBIT_VECTOR (result), i - f, 989 bit_vector_bit (XBIT_VECTOR (sequence), i));
992 bit_vector_bit (XBIT_VECTOR (seq), i)); 990 return result;
993 return result; 991 }
994 } 992 else
993 {
994 abort (); /* unreachable, since Flength (sequence) did not get
995 an error */
996 return Qnil;
997 }
995 } 998 }
996 999
997 1000
998 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /* 1001 DEFUN ("nthcdr", Fnthcdr, 2, 2, 0, /*
999 Take cdr N times on LIST, and return the result. 1002 Take cdr N times on LIST, and return the result.
1215 Return non-nil if ELT is an element of LIST. Comparison done with `equal'. 1218 Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
1216 The value is actually the tail of LIST whose car is ELT. 1219 The value is actually the tail of LIST whose car is ELT.
1217 */ 1220 */
1218 (elt, list)) 1221 (elt, list))
1219 { 1222 {
1220 Lisp_Object list_elt, tail;
1221 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) 1223 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1222 { 1224 {
1223 if (internal_equal (elt, list_elt, 0)) 1225 if (internal_equal (elt, list_elt, 0))
1224 return tail; 1226 return tail;
1225 } 1227 }
1232 This function is provided only for byte-code compatibility with v19. 1234 This function is provided only for byte-code compatibility with v19.
1233 Do not use it. 1235 Do not use it.
1234 */ 1236 */
1235 (elt, list)) 1237 (elt, list))
1236 { 1238 {
1237 Lisp_Object list_elt, tail;
1238 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) 1239 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1239 { 1240 {
1240 if (internal_old_equal (elt, list_elt, 0)) 1241 if (internal_old_equal (elt, list_elt, 0))
1241 return tail; 1242 return tail;
1242 } 1243 }
1247 Return non-nil if ELT is an element of LIST. Comparison done with `eq'. 1248 Return non-nil if ELT is an element of LIST. Comparison done with `eq'.
1248 The value is actually the tail of LIST whose car is ELT. 1249 The value is actually the tail of LIST whose car is ELT.
1249 */ 1250 */
1250 (elt, list)) 1251 (elt, list))
1251 { 1252 {
1252 Lisp_Object list_elt, tail;
1253 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) 1253 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1254 { 1254 {
1255 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) 1255 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1256 return tail; 1256 return tail;
1257 } 1257 }
1264 This function is provided only for byte-code compatibility with v19. 1264 This function is provided only for byte-code compatibility with v19.
1265 Do not use it. 1265 Do not use it.
1266 */ 1266 */
1267 (elt, list)) 1267 (elt, list))
1268 { 1268 {
1269 Lisp_Object list_elt, tail;
1270 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail) 1269 EXTERNAL_LIST_LOOP_3 (list_elt, list, tail)
1271 { 1270 {
1272 if (HACKEQ_UNSAFE (elt, list_elt)) 1271 if (HACKEQ_UNSAFE (elt, list_elt))
1273 return tail; 1272 return tail;
1274 } 1273 }
1276 } 1275 }
1277 1276
1278 Lisp_Object 1277 Lisp_Object
1279 memq_no_quit (Lisp_Object elt, Lisp_Object list) 1278 memq_no_quit (Lisp_Object elt, Lisp_Object list)
1280 { 1279 {
1281 Lisp_Object list_elt, tail;
1282 LIST_LOOP_3 (list_elt, list, tail) 1280 LIST_LOOP_3 (list_elt, list, tail)
1283 { 1281 {
1284 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt)) 1282 if (EQ_WITH_EBOLA_NOTICE (elt, list_elt))
1285 return tail; 1283 return tail;
1286 } 1284 }
1292 The value is actually the element of LIST whose car equals KEY. 1290 The value is actually the element of LIST whose car equals KEY.
1293 */ 1291 */
1294 (key, list)) 1292 (key, list))
1295 { 1293 {
1296 /* This function can GC. */ 1294 /* This function can GC. */
1297 Lisp_Object elt, elt_car, elt_cdr;
1298 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) 1295 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
1299 { 1296 {
1300 if (internal_equal (key, elt_car, 0)) 1297 if (internal_equal (key, elt_car, 0))
1301 return elt; 1298 return elt;
1302 } 1299 }
1308 The value is actually the element of LIST whose car equals KEY. 1305 The value is actually the element of LIST whose car equals KEY.
1309 */ 1306 */
1310 (key, list)) 1307 (key, list))
1311 { 1308 {
1312 /* This function can GC. */ 1309 /* This function can GC. */
1313 Lisp_Object elt, elt_car, elt_cdr;
1314 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) 1310 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
1315 { 1311 {
1316 if (internal_old_equal (key, elt_car, 0)) 1312 if (internal_old_equal (key, elt_car, 0))
1317 return elt; 1313 return elt;
1318 } 1314 }
1332 The value is actually the element of LIST whose car is KEY. 1328 The value is actually the element of LIST whose car is KEY.
1333 Elements of LIST that are not conses are ignored. 1329 Elements of LIST that are not conses are ignored.
1334 */ 1330 */
1335 (key, list)) 1331 (key, list))
1336 { 1332 {
1337 Lisp_Object elt, elt_car, elt_cdr;
1338 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) 1333 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
1339 { 1334 {
1340 if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) 1335 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1341 return elt; 1336 return elt;
1342 } 1337 }
1350 This function is provided only for byte-code compatibility with v19. 1345 This function is provided only for byte-code compatibility with v19.
1351 Do not use it. 1346 Do not use it.
1352 */ 1347 */
1353 (key, list)) 1348 (key, list))
1354 { 1349 {
1355 Lisp_Object elt, elt_car, elt_cdr;
1356 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) 1350 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
1357 { 1351 {
1358 if (HACKEQ_UNSAFE (key, elt_car)) 1352 if (HACKEQ_UNSAFE (key, elt_car))
1359 return elt; 1353 return elt;
1360 } 1354 }
1366 1360
1367 Lisp_Object 1361 Lisp_Object
1368 assq_no_quit (Lisp_Object key, Lisp_Object list) 1362 assq_no_quit (Lisp_Object key, Lisp_Object list)
1369 { 1363 {
1370 /* This cannot GC. */ 1364 /* This cannot GC. */
1371 Lisp_Object elt;
1372 LIST_LOOP_2 (elt, list) 1365 LIST_LOOP_2 (elt, list)
1373 { 1366 {
1374 Lisp_Object elt_car = XCAR (elt); 1367 Lisp_Object elt_car = XCAR (elt);
1375 if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) 1368 if (EQ_WITH_EBOLA_NOTICE (key, elt_car))
1376 return elt; 1369 return elt;
1382 Return non-nil if KEY is `equal' to the cdr of an element of LIST. 1375 Return non-nil if KEY is `equal' to the cdr of an element of LIST.
1383 The value is actually the element of LIST whose cdr equals KEY. 1376 The value is actually the element of LIST whose cdr equals KEY.
1384 */ 1377 */
1385 (key, list)) 1378 (key, list))
1386 { 1379 {
1387 Lisp_Object elt, elt_car, elt_cdr;
1388 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) 1380 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
1389 { 1381 {
1390 if (internal_equal (key, elt_cdr, 0)) 1382 if (internal_equal (key, elt_cdr, 0))
1391 return elt; 1383 return elt;
1392 } 1384 }
1397 Return non-nil if KEY is `old-equal' to the cdr of an element of LIST. 1389 Return non-nil if KEY is `old-equal' to the cdr of an element of LIST.
1398 The value is actually the element of LIST whose cdr equals KEY. 1390 The value is actually the element of LIST whose cdr equals KEY.
1399 */ 1391 */
1400 (key, list)) 1392 (key, list))
1401 { 1393 {
1402 Lisp_Object elt, elt_car, elt_cdr;
1403 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) 1394 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
1404 { 1395 {
1405 if (internal_old_equal (key, elt_cdr, 0)) 1396 if (internal_old_equal (key, elt_cdr, 0))
1406 return elt; 1397 return elt;
1407 } 1398 }
1412 Return non-nil if KEY is `eq' to the cdr of an element of LIST. 1403 Return non-nil if KEY is `eq' to the cdr of an element of LIST.
1413 The value is actually the element of LIST whose cdr is KEY. 1404 The value is actually the element of LIST whose cdr is KEY.
1414 */ 1405 */
1415 (key, list)) 1406 (key, list))
1416 { 1407 {
1417 Lisp_Object elt, elt_car, elt_cdr;
1418 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) 1408 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
1419 { 1409 {
1420 if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr)) 1410 if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr))
1421 return elt; 1411 return elt;
1422 } 1412 }
1427 Return non-nil if KEY is `old-eq' to the cdr of an element of LIST. 1417 Return non-nil if KEY is `old-eq' to the cdr of an element of LIST.
1428 The value is actually the element of LIST whose cdr is KEY. 1418 The value is actually the element of LIST whose cdr is KEY.
1429 */ 1419 */
1430 (key, list)) 1420 (key, list))
1431 { 1421 {
1432 Lisp_Object elt, elt_car, elt_cdr;
1433 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) 1422 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list)
1434 { 1423 {
1435 if (HACKEQ_UNSAFE (key, elt_cdr)) 1424 if (HACKEQ_UNSAFE (key, elt_cdr))
1436 return elt; 1425 return elt;
1437 } 1426 }
1441 /* Like Frassq, but caller must ensure that LIST is properly 1430 /* Like Frassq, but caller must ensure that LIST is properly
1442 nil-terminated and ebola-free. */ 1431 nil-terminated and ebola-free. */
1443 Lisp_Object 1432 Lisp_Object
1444 rassq_no_quit (Lisp_Object key, Lisp_Object list) 1433 rassq_no_quit (Lisp_Object key, Lisp_Object list)
1445 { 1434 {
1446 Lisp_Object elt;
1447 LIST_LOOP_2 (elt, list) 1435 LIST_LOOP_2 (elt, list)
1448 { 1436 {
1449 Lisp_Object elt_cdr = XCDR (elt); 1437 Lisp_Object elt_cdr = XCDR (elt);
1450 if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr)) 1438 if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr))
1451 return elt; 1439 return elt;
1462 of changing the value of `foo'. 1450 of changing the value of `foo'.
1463 Also see: `remove'. 1451 Also see: `remove'.
1464 */ 1452 */
1465 (elt, list)) 1453 (elt, list))
1466 { 1454 {
1467 Lisp_Object list_elt;
1468 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, 1455 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
1469 (internal_equal (elt, list_elt, 0))); 1456 (internal_equal (elt, list_elt, 0)));
1470 return list; 1457 return list;
1471 } 1458 }
1472 1459
1477 effect; therefore, write `(setq foo (old-delete element foo))' to be sure 1464 effect; therefore, write `(setq foo (old-delete element foo))' to be sure
1478 of changing the value of `foo'. 1465 of changing the value of `foo'.
1479 */ 1466 */
1480 (elt, list)) 1467 (elt, list))
1481 { 1468 {
1482 Lisp_Object list_elt;
1483 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, 1469 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
1484 (internal_old_equal (elt, list_elt, 0))); 1470 (internal_old_equal (elt, list_elt, 0)));
1485 return list; 1471 return list;
1486 } 1472 }
1487 1473
1492 effect; therefore, write `(setq foo (delq element foo))' to be sure of 1478 effect; therefore, write `(setq foo (delq element foo))' to be sure of
1493 changing the value of `foo'. 1479 changing the value of `foo'.
1494 */ 1480 */
1495 (elt, list)) 1481 (elt, list))
1496 { 1482 {
1497 Lisp_Object list_elt;
1498 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, 1483 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
1499 (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); 1484 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
1500 return list; 1485 return list;
1501 } 1486 }
1502 1487
1507 effect; therefore, write `(setq foo (old-delq element foo))' to be sure of 1492 effect; therefore, write `(setq foo (old-delq element foo))' to be sure of
1508 changing the value of `foo'. 1493 changing the value of `foo'.
1509 */ 1494 */
1510 (elt, list)) 1495 (elt, list))
1511 { 1496 {
1512 Lisp_Object list_elt;
1513 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list, 1497 EXTERNAL_LIST_LOOP_DELETE_IF (list_elt, list,
1514 (HACKEQ_UNSAFE (elt, list_elt))); 1498 (HACKEQ_UNSAFE (elt, list_elt)));
1515 return list; 1499 return list;
1516 } 1500 }
1517 1501
1519 nil-terminated and ebola-free. */ 1503 nil-terminated and ebola-free. */
1520 1504
1521 Lisp_Object 1505 Lisp_Object
1522 delq_no_quit (Lisp_Object elt, Lisp_Object list) 1506 delq_no_quit (Lisp_Object elt, Lisp_Object list)
1523 { 1507 {
1524 Lisp_Object list_elt;
1525 LIST_LOOP_DELETE_IF (list_elt, list, 1508 LIST_LOOP_DELETE_IF (list_elt, list,
1526 (EQ_WITH_EBOLA_NOTICE (elt, list_elt))); 1509 (EQ_WITH_EBOLA_NOTICE (elt, list_elt)));
1527 return list; 1510 return list;
1528 } 1511 }
1529 1512
1569 therefore, write `(setq foo (remassoc key foo))' to be sure of changing 1552 therefore, write `(setq foo (remassoc key foo))' to be sure of changing
1570 the value of `foo'. 1553 the value of `foo'.
1571 */ 1554 */
1572 (key, list)) 1555 (key, list))
1573 { 1556 {
1574 Lisp_Object elt;
1575 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, 1557 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
1576 (CONSP (elt) && 1558 (CONSP (elt) &&
1577 internal_equal (key, XCAR (elt), 0))); 1559 internal_equal (key, XCAR (elt), 0)));
1578 return list; 1560 return list;
1579 } 1561 }
1593 therefore, write `(setq foo (remassq key foo))' to be sure of changing 1575 therefore, write `(setq foo (remassq key foo))' to be sure of changing
1594 the value of `foo'. 1576 the value of `foo'.
1595 */ 1577 */
1596 (key, list)) 1578 (key, list))
1597 { 1579 {
1598 Lisp_Object elt;
1599 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, 1580 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
1600 (CONSP (elt) && 1581 (CONSP (elt) &&
1601 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); 1582 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
1602 return list; 1583 return list;
1603 } 1584 }
1605 /* no quit, no errors; be careful */ 1586 /* no quit, no errors; be careful */
1606 1587
1607 Lisp_Object 1588 Lisp_Object
1608 remassq_no_quit (Lisp_Object key, Lisp_Object list) 1589 remassq_no_quit (Lisp_Object key, Lisp_Object list)
1609 { 1590 {
1610 Lisp_Object elt;
1611 LIST_LOOP_DELETE_IF (elt, list, 1591 LIST_LOOP_DELETE_IF (elt, list,
1612 (CONSP (elt) && 1592 (CONSP (elt) &&
1613 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); 1593 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt))));
1614 return list; 1594 return list;
1615 } 1595 }
1621 therefore, write `(setq foo (remrassoc value foo))' to be sure of changing 1601 therefore, write `(setq foo (remrassoc value foo))' to be sure of changing
1622 the value of `foo'. 1602 the value of `foo'.
1623 */ 1603 */
1624 (value, list)) 1604 (value, list))
1625 { 1605 {
1626 Lisp_Object elt;
1627 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, 1606 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
1628 (CONSP (elt) && 1607 (CONSP (elt) &&
1629 internal_equal (value, XCDR (elt), 0))); 1608 internal_equal (value, XCDR (elt), 0)));
1630 return list; 1609 return list;
1631 } 1610 }
1637 therefore, write `(setq foo (remrassq value foo))' to be sure of changing 1616 therefore, write `(setq foo (remrassq value foo))' to be sure of changing
1638 the value of `foo'. 1617 the value of `foo'.
1639 */ 1618 */
1640 (value, list)) 1619 (value, list))
1641 { 1620 {
1642 Lisp_Object elt;
1643 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, 1621 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list,
1644 (CONSP (elt) && 1622 (CONSP (elt) &&
1645 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); 1623 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
1646 return list; 1624 return list;
1647 } 1625 }
1648 1626
1649 /* Like Fremrassq, fast and unsafe; be careful */ 1627 /* Like Fremrassq, fast and unsafe; be careful */
1650 Lisp_Object 1628 Lisp_Object
1651 remrassq_no_quit (Lisp_Object value, Lisp_Object list) 1629 remrassq_no_quit (Lisp_Object value, Lisp_Object list)
1652 { 1630 {
1653 Lisp_Object elt;
1654 LIST_LOOP_DELETE_IF (elt, list, 1631 LIST_LOOP_DELETE_IF (elt, list,
1655 (CONSP (elt) && 1632 (CONSP (elt) &&
1656 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); 1633 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt))));
1657 return list; 1634 return list;
1658 } 1635 }
1688 See also the function `nreverse', which is used more often. 1665 See also the function `nreverse', which is used more often.
1689 */ 1666 */
1690 (list)) 1667 (list))
1691 { 1668 {
1692 Lisp_Object reversed_list = Qnil; 1669 Lisp_Object reversed_list = Qnil;
1693 Lisp_Object elt;
1694 EXTERNAL_LIST_LOOP_2 (elt, list) 1670 EXTERNAL_LIST_LOOP_2 (elt, list)
1695 { 1671 {
1696 reversed_list = Fcons (elt, reversed_list); 1672 reversed_list = Fcons (elt, reversed_list);
1697 } 1673 }
1698 return reversed_list; 1674 return reversed_list;
2090 2066
2091 static Lisp_Object 2067 static Lisp_Object
2092 bad_bad_turtle (Lisp_Object *plist, Lisp_Object *badplace, Error_behavior errb) 2068 bad_bad_turtle (Lisp_Object *plist, Lisp_Object *badplace, Error_behavior errb)
2093 { 2069 {
2094 if (ERRB_EQ (errb, ERROR_ME)) 2070 if (ERRB_EQ (errb, ERROR_ME))
2095 /* #### Eek, this will probably result in another error
2096 when PLIST is printed out */
2097 return Fsignal (Qcircular_property_list, list1 (*plist)); 2071 return Fsignal (Qcircular_property_list, list1 (*plist));
2098 else 2072 else
2099 { 2073 {
2100 if (ERRB_EQ (errb, ERROR_ME_WARN)) 2074 if (ERRB_EQ (errb, ERROR_ME_WARN))
2101 { 2075 {
2366 } 2340 }
2367 2341
2368 DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /* 2342 DEFUN ("valid-plist-p", Fvalid_plist_p, 1, 1, 0, /*
2369 Given a plist, return non-nil if its format is correct. 2343 Given a plist, return non-nil if its format is correct.
2370 If it returns nil, `check-valid-plist' will signal an error when given 2344 If it returns nil, `check-valid-plist' will signal an error when given
2371 the plist; that means it's a malformed or circular plist or has non-symbols 2345 the plist; that means it's a malformed or circular plist.
2372 as keywords.
2373 */ 2346 */
2374 (plist)) 2347 (plist))
2375 { 2348 {
2376 Lisp_Object *tortoise; 2349 Lisp_Object *tortoise;
2377 Lisp_Object *hare; 2350 Lisp_Object *hare;
2444 properties on the list. 2417 properties on the list.
2445 */ 2418 */
2446 (lax_plist, prop, default_)) 2419 (lax_plist, prop, default_))
2447 { 2420 {
2448 Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME); 2421 Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME);
2449 if (UNBOUNDP (val)) 2422 return UNBOUNDP (val) ? default_ : val;
2450 return default_;
2451 return val;
2452 } 2423 }
2453 2424
2454 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /* 2425 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /*
2455 Change value in LAX-PLIST of PROP to VAL. 2426 Change value in LAX-PLIST of PROP to VAL.
2456 LAX-PLIST is a lax property list, which is a list of the form \(PROP1 2427 LAX-PLIST is a lax property list, which is a list of the form \(PROP1
2566 } 2537 }
2567 2538
2568 return head; 2539 return head;
2569 } 2540 }
2570 2541
2571 /* Symbol plists are directly accessible, so we need to protect against
2572 invalid property list structure */
2573
2574 static Lisp_Object
2575 symbol_getprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object default_)
2576 {
2577 Lisp_Object val = external_plist_get (&XSYMBOL (sym)->plist, propname,
2578 0, ERROR_ME);
2579 return UNBOUNDP (val) ? default_ : val;
2580 }
2581
2582 static void
2583 symbol_putprop (Lisp_Object sym, Lisp_Object propname, Lisp_Object value)
2584 {
2585 external_plist_put (&XSYMBOL (sym)->plist, propname, value, 0, ERROR_ME);
2586 }
2587
2588 static int
2589 symbol_remprop (Lisp_Object symbol, Lisp_Object propname)
2590 {
2591 return external_remprop (&XSYMBOL (symbol)->plist, propname, 0, ERROR_ME);
2592 }
2593
2594 /* We store the string's extent info as the first element of the string's
2595 property list; and the string's MODIFF as the first or second element
2596 of the string's property list (depending on whether the extent info
2597 is present), but only if the string has been modified. This is ugly
2598 but it reduces the memory allocated for the string in the vast
2599 majority of cases, where the string is never modified and has no
2600 extent info. */
2601
2602
2603 static Lisp_Object *
2604 string_plist_ptr (Lisp_String *s)
2605 {
2606 Lisp_Object *ptr = &s->plist;
2607
2608 if (CONSP (*ptr) && EXTENT_INFOP (XCAR (*ptr)))
2609 ptr = &XCDR (*ptr);
2610 if (CONSP (*ptr) && INTP (XCAR (*ptr)))
2611 ptr = &XCDR (*ptr);
2612 return ptr;
2613 }
2614
2615 static Lisp_Object
2616 string_getprop (Lisp_String *s, Lisp_Object property,
2617 Lisp_Object default_)
2618 {
2619 Lisp_Object val = external_plist_get (string_plist_ptr (s), property, 0,
2620 ERROR_ME);
2621 return UNBOUNDP (val) ? default_ : val;
2622 }
2623
2624 static void
2625 string_putprop (Lisp_String *s, Lisp_Object property,
2626 Lisp_Object value)
2627 {
2628 external_plist_put (string_plist_ptr (s), property, value, 0, ERROR_ME);
2629 }
2630
2631 static int
2632 string_remprop (Lisp_String *s, Lisp_Object property)
2633 {
2634 return external_remprop (string_plist_ptr (s), property, 0, ERROR_ME);
2635 }
2636
2637 static Lisp_Object
2638 string_plist (Lisp_String *s)
2639 {
2640 return *string_plist_ptr (s);
2641 }
2642
2643 DEFUN ("get", Fget, 2, 3, 0, /* 2542 DEFUN ("get", Fget, 2, 3, 0, /*
2644 Return the value of OBJECT's PROPNAME property. 2543 Return the value of OBJECT's PROPERTY property.
2645 This is the last VALUE stored with `(put OBJECT PROPNAME VALUE)'. 2544 This is the last VALUE stored with `(put OBJECT PROPERTY VALUE)'.
2646 If there is no such property, return optional third arg DEFAULT 2545 If there is no such property, return optional third arg DEFAULT
2647 \(which defaults to `nil'). OBJECT can be a symbol, face, extent, 2546 \(which defaults to `nil'). OBJECT can be a symbol, string, extent,
2648 or string. See also `put', `remprop', and `object-plist'. 2547 face, or glyph. See also `put', `remprop', and `object-plist'.
2649 */ 2548 */
2650 (object, propname, default_)) 2549 (object, property, default_))
2651 { 2550 {
2652 /* Various places in emacs call Fget() and expect it not to quit, 2551 /* Various places in emacs call Fget() and expect it not to quit,
2653 so don't quit. */ 2552 so don't quit. */
2654 2553 Lisp_Object val;
2655 /* It's easiest to treat symbols specially because they may not 2554
2656 be an lrecord */ 2555 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->getprop)
2657 if (SYMBOLP (object)) 2556 val = XRECORD_LHEADER_IMPLEMENTATION (object)->getprop (object, property);
2658 return symbol_getprop (object, propname, default_);
2659 else if (STRINGP (object))
2660 return string_getprop (XSTRING (object), propname, default_);
2661 else if (LRECORDP (object))
2662 {
2663 CONST struct lrecord_implementation *imp
2664 = XRECORD_LHEADER_IMPLEMENTATION (object);
2665 if (!imp->getprop)
2666 goto noprops;
2667
2668 {
2669 Lisp_Object val = (imp->getprop) (object, propname);
2670 if (UNBOUNDP (val))
2671 val = default_;
2672 return val;
2673 }
2674 }
2675 else 2557 else
2676 { 2558 signal_simple_error ("Object type has no properties", object);
2677 noprops: 2559
2678 signal_simple_error ("Object type has no properties", object); 2560 return UNBOUNDP (val) ? default_ : val;
2679 return Qnil; /* Not reached */
2680 }
2681 } 2561 }
2682 2562
2683 DEFUN ("put", Fput, 3, 3, 0, /* 2563 DEFUN ("put", Fput, 3, 3, 0, /*
2684 Store OBJECT's PROPNAME property with value VALUE. 2564 Set OBJECT's PROPERTY to VALUE.
2685 It can be retrieved with `(get OBJECT PROPNAME)'. OBJECT can be a 2565 It can be subsequently retrieved with `(get OBJECT PROPERTY)'.
2686 symbol, face, extent, or string. 2566 OBJECT can be a symbol, face, extent, or string.
2687
2688 For a string, no properties currently have predefined meanings. 2567 For a string, no properties currently have predefined meanings.
2689 For the predefined properties for extents, see `set-extent-property'. 2568 For the predefined properties for extents, see `set-extent-property'.
2690 For the predefined properties for faces, see `set-face-property'. 2569 For the predefined properties for faces, see `set-face-property'.
2691
2692 See also `get', `remprop', and `object-plist'. 2570 See also `get', `remprop', and `object-plist'.
2693 */ 2571 */
2694 (object, propname, value)) 2572 (object, property, value))
2695 { 2573 {
2696 CHECK_SYMBOL (propname);
2697 CHECK_LISP_WRITEABLE (object); 2574 CHECK_LISP_WRITEABLE (object);
2698 2575
2699 if (SYMBOLP (object)) 2576 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->putprop)
2700 symbol_putprop (object, propname, value); 2577 {
2701 else if (STRINGP (object)) 2578 if (! XRECORD_LHEADER_IMPLEMENTATION (object)->putprop
2702 string_putprop (XSTRING (object), propname, value); 2579 (object, property, value))
2703 else if (LRECORDP (object)) 2580 signal_simple_error ("Can't set property on object", property);
2704 {
2705 CONST struct lrecord_implementation
2706 *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
2707 if (imp->putprop)
2708 {
2709 if (! (imp->putprop) (object, propname, value))
2710 signal_simple_error ("Can't set property on object", propname);
2711 }
2712 else
2713 goto noprops;
2714 } 2581 }
2715 else 2582 else
2716 { 2583 signal_simple_error ("Object type has no settable properties", object);
2717 noprops:
2718 signal_simple_error ("Object type has no settable properties", object);
2719 }
2720 2584
2721 return value; 2585 return value;
2722 } 2586 }
2723 2587
2724 DEFUN ("remprop", Fremprop, 2, 2, 0, /* 2588 DEFUN ("remprop", Fremprop, 2, 2, 0, /*
2725 Remove from OBJECT's property list the property PROPNAME and its 2589 Remove, from OBJECT's property list, PROPERTY and its corresponding value.
2726 value. OBJECT can be a symbol, face, extent, or string. Returns 2590 OBJECT can be a symbol, string, extent, face, or glyph. Return non-nil
2727 non-nil if the property list was actually changed (i.e. if PROPNAME 2591 if the property list was actually modified (i.e. if PROPERTY was present
2728 was present in the property list). See also `get', `put', and 2592 in the property list). See also `get', `put', and `object-plist'.
2729 `object-plist'. 2593 */
2730 */ 2594 (object, property))
2731 (object, propname)) 2595 {
2732 { 2596 int ret = 0;
2733 int retval = 0; 2597
2734
2735 CHECK_SYMBOL (propname);
2736 CHECK_LISP_WRITEABLE (object); 2598 CHECK_LISP_WRITEABLE (object);
2737 2599
2738 if (SYMBOLP (object)) 2600 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->remprop)
2739 retval = symbol_remprop (object, propname); 2601 {
2740 else if (STRINGP (object)) 2602 ret = XRECORD_LHEADER_IMPLEMENTATION (object)->remprop (object, property);
2741 retval = string_remprop (XSTRING (object), propname); 2603 if (ret == -1)
2742 else if (LRECORDP (object)) 2604 signal_simple_error ("Can't remove property from object", property);
2743 {
2744 CONST struct lrecord_implementation
2745 *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
2746 if (imp->remprop)
2747 {
2748 retval = (imp->remprop) (object, propname);
2749 if (retval == -1)
2750 signal_simple_error ("Can't remove property from object",
2751 propname);
2752 }
2753 else
2754 goto noprops;
2755 } 2605 }
2756 else 2606 else
2757 { 2607 signal_simple_error ("Object type has no removable properties", object);
2758 noprops: 2608
2759 signal_simple_error ("Object type has no removable properties", object); 2609 return ret ? Qt : Qnil;
2760 }
2761
2762 return retval ? Qt : Qnil;
2763 } 2610 }
2764 2611
2765 DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /* 2612 DEFUN ("object-plist", Fobject_plist, 1, 1, 0, /*
2766 Return a property list of OBJECT's props. 2613 Return a property list of OBJECT's properties.
2767 For a symbol this is equivalent to `symbol-plist'. 2614 For a symbol, this is equivalent to `symbol-plist'.
2768 Do not modify the property list directly; this may or may not have 2615 OBJECT can be a symbol, string, extent, face, or glyph.
2769 the desired effects. (In particular, for a property with a special 2616 Do not modify the returned property list directly;
2770 interpretation, this will probably have no effect at all.) 2617 this may or may not have the desired effects. Use `put' instead.
2771 */ 2618 */
2772 (object)) 2619 (object))
2773 { 2620 {
2774 if (SYMBOLP (object)) 2621 if (LRECORDP (object) && XRECORD_LHEADER_IMPLEMENTATION (object)->plist)
2775 return Fsymbol_plist (object); 2622 return XRECORD_LHEADER_IMPLEMENTATION (object)->plist (object);
2776 else if (STRINGP (object))
2777 return string_plist (XSTRING (object));
2778 else if (LRECORDP (object))
2779 {
2780 CONST struct lrecord_implementation
2781 *imp = XRECORD_LHEADER_IMPLEMENTATION (object);
2782 if (imp->plist)
2783 return (imp->plist) (object);
2784 else
2785 signal_simple_error ("Object type has no properties", object);
2786 }
2787 else 2623 else
2788 signal_simple_error ("Object type has no properties", object); 2624 signal_simple_error ("Object type has no properties", object);
2789 2625
2790 return Qnil; 2626 return Qnil;
2791 } 2627 }
2802 /* Note that (equal 20 20.0) should be nil */ 2638 /* Note that (equal 20 20.0) should be nil */
2803 if (XTYPE (obj1) != XTYPE (obj2)) 2639 if (XTYPE (obj1) != XTYPE (obj2))
2804 return 0; 2640 return 0;
2805 if (LRECORDP (obj1)) 2641 if (LRECORDP (obj1))
2806 { 2642 {
2807 CONST struct lrecord_implementation 2643 const struct lrecord_implementation
2808 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1), 2644 *imp1 = XRECORD_LHEADER_IMPLEMENTATION (obj1),
2809 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2); 2645 *imp2 = XRECORD_LHEADER_IMPLEMENTATION (obj2);
2810 2646
2811 return (imp1 == imp2) && 2647 return (imp1 == imp2) &&
2812 /* EQ-ness of the objects was noticed above */ 2648 /* EQ-ness of the objects was noticed above */
3092 enough to hold the elts left to be traversed as well as the 2928 enough to hold the elts left to be traversed as well as the
3093 results computed so far. 2929 results computed so far.
3094 2930
3095 if (vals == 0) we don't have any free space available and 2931 if (vals == 0) we don't have any free space available and
3096 don't want to eat up any more stack with alloca(). 2932 don't want to eat up any more stack with alloca().
3097 So we use EXTERNAL_LIST_LOOP_3 and GCPRO the tail. */ 2933 So we use EXTERNAL_LIST_LOOP_3_NO_DECLARE and GCPRO the tail. */
3098 2934
3099 if (vals) 2935 if (vals)
3100 { 2936 {
3101 Lisp_Object *val = vals; 2937 Lisp_Object *val = vals;
3102 Lisp_Object elt;
3103 2938
3104 LIST_LOOP_2 (elt, sequence) 2939 LIST_LOOP_2 (elt, sequence)
3105 *val++ = elt; 2940 *val++ = elt;
3106 2941
3107 gcpro1.nvars = leni; 2942 gcpro1.nvars = leni;
3113 } 2948 }
3114 } 2949 }
3115 else 2950 else
3116 { 2951 {
3117 Lisp_Object elt, tail; 2952 Lisp_Object elt, tail;
2953 EMACS_INT len_unused;
3118 struct gcpro ngcpro1; 2954 struct gcpro ngcpro1;
3119 2955
3120 NGCPRO1 (tail); 2956 NGCPRO1 (tail);
3121 2957
3122 { 2958 {
3123 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) 2959 EXTERNAL_LIST_LOOP_4_NO_DECLARE (elt, sequence, tail, len_unused)
3124 { 2960 {
3125 args[1] = elt; 2961 args[1] = elt;
3126 Ffuncall (2, args); 2962 Ffuncall (2, args);
3127 } 2963 }
3128 } 2964 }
3166 result = Ffuncall (2, args); 3002 result = Ffuncall (2, args);
3167 if (vals) vals[gcpro1.nvars++] = result; 3003 if (vals) vals[gcpro1.nvars++] = result;
3168 } 3004 }
3169 } 3005 }
3170 else 3006 else
3171 abort(); /* cannot get here since Flength(sequence) did not get an error */ 3007 abort (); /* unreachable, since Flength (sequence) did not get an error */
3172 3008
3173 if (vals) 3009 if (vals)
3174 UNGCPRO; 3010 UNGCPRO;
3175 } 3011 }
3176 3012
3183 (function, sequence, separator)) 3019 (function, sequence, separator))
3184 { 3020 {
3185 size_t len = XINT (Flength (sequence)); 3021 size_t len = XINT (Flength (sequence));
3186 Lisp_Object *args; 3022 Lisp_Object *args;
3187 int i; 3023 int i;
3188 struct gcpro gcpro1;
3189 int nargs = len + len - 1; 3024 int nargs = len + len - 1;
3190 3025
3191 if (nargs < 0) return build_string (""); 3026 if (len == 0) return build_string ("");
3192 3027
3193 args = alloca_array (Lisp_Object, nargs); 3028 args = alloca_array (Lisp_Object, nargs);
3194 3029
3195 GCPRO1 (separator);
3196 mapcar1 (len, args, function, sequence); 3030 mapcar1 (len, args, function, sequence);
3197 UNGCPRO;
3198 3031
3199 for (i = len - 1; i >= 0; i--) 3032 for (i = len - 1; i >= 0; i--)
3200 args[i + i] = args[i]; 3033 args[i + i] = args[i];
3201 3034
3202 for (i = 1; i < nargs; i += 2) 3035 for (i = 1; i < nargs; i += 2)
3253 3086
3254 return sequence; 3087 return sequence;
3255 } 3088 }
3256 3089
3257 3090
3091
3092
3093 DEFUN ("replace-list", Freplace_list, 2, 2, 0, /*
3094 Destructively replace the list OLD with NEW.
3095 This is like (copy-sequence NEW) except that it reuses the
3096 conses in OLD as much as possible. If OLD and NEW are the same
3097 length, no consing will take place.
3098 */
3099 (old, new))
3100 {
3101 Lisp_Object tail, oldtail = old, prevoldtail = Qnil;
3102
3103 EXTERNAL_LIST_LOOP (tail, new)
3104 {
3105 if (!NILP (oldtail))
3106 {
3107 CHECK_CONS (oldtail);
3108 XCAR (oldtail) = XCAR (tail);
3109 }
3110 else if (!NILP (prevoldtail))
3111 {
3112 XCDR (prevoldtail) = Fcons (XCAR (tail), Qnil);
3113 prevoldtail = XCDR (prevoldtail);
3114 }
3115 else
3116 old = oldtail = Fcons (XCAR (tail), Qnil);
3117
3118 if (!NILP (oldtail))
3119 {
3120 prevoldtail = oldtail;
3121 oldtail = XCDR (oldtail);
3122 }
3123 }
3124
3125 if (!NILP (prevoldtail))
3126 XCDR (prevoldtail) = Qnil;
3127 else
3128 old = Qnil;
3129
3130 return old;
3131 }
3132
3133
3258 /* #### this function doesn't belong in this file! */ 3134 /* #### this function doesn't belong in this file! */
3135
3136 #ifdef HAVE_GETLOADAVG
3137 #ifdef HAVE_SYS_LOADAVG_H
3138 #include <sys/loadavg.h>
3139 #endif
3140 #else
3141 int getloadavg (double loadavg[], int nelem); /* Defined in getloadavg.c */
3142 #endif
3259 3143
3260 DEFUN ("load-average", Fload_average, 0, 1, 0, /* 3144 DEFUN ("load-average", Fload_average, 0, 1, 0, /*
3261 Return list of 1 minute, 5 minute and 15 minute load averages. 3145 Return list of 1 minute, 5 minute and 15 minute load averages.
3262 Each of the three load averages is multiplied by 100, 3146 Each of the three load averages is multiplied by 100,
3263 then converted to integer. 3147 then converted to integer.
3324 => ; Non-nil if this Emacs supports TTY frames. 3208 => ; Non-nil if this Emacs supports TTY frames.
3325 3209
3326 (featurep '(or (and xemacs 19.15) (and emacs 19.34))) 3210 (featurep '(or (and xemacs 19.15) (and emacs 19.34)))
3327 => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later. 3211 => ; Non-nil on XEmacs 19.15 and later, or FSF Emacs 19.34 and later.
3328 3212
3213 (featurep '(and xemacs 21.02))
3214 => ; Non-nil on XEmacs 21.2 and later.
3215
3329 NOTE: The advanced arguments of this function (anything other than a 3216 NOTE: The advanced arguments of this function (anything other than a
3330 symbol) are not yet supported by FSF Emacs. If you feel they are useful 3217 symbol) are not yet supported by FSF Emacs. If you feel they are useful
3331 for supporting multiple Emacs variants, lobby Richard Stallman at 3218 for supporting multiple Emacs variants, lobby Richard Stallman at
3332 <bug-gnu-emacs@prep.ai.mit.edu>. 3219 <bug-gnu-emacs@gnu.org>.
3333 */ 3220 */
3334 (fexp)) 3221 (fexp))
3335 { 3222 {
3336 #ifndef FEATUREP_SYNTAX 3223 #ifndef FEATUREP_SYNTAX
3337 CHECK_SYMBOL (fexp); 3224 CHECK_SYMBOL (fexp);
3857 Lisp_Object Qyes_or_no_p; 3744 Lisp_Object Qyes_or_no_p;
3858 3745
3859 void 3746 void
3860 syms_of_fns (void) 3747 syms_of_fns (void)
3861 { 3748 {
3749 INIT_LRECORD_IMPLEMENTATION (bit_vector);
3750
3862 defsymbol (&Qstring_lessp, "string-lessp"); 3751 defsymbol (&Qstring_lessp, "string-lessp");
3863 defsymbol (&Qidentity, "identity"); 3752 defsymbol (&Qidentity, "identity");
3864 defsymbol (&Qyes_or_no_p, "yes-or-no-p"); 3753 defsymbol (&Qyes_or_no_p, "yes-or-no-p");
3865 3754
3866 DEFSUBR (Fidentity); 3755 DEFSUBR (Fidentity);
3936 DEFSUBR (Fnconc); 3825 DEFSUBR (Fnconc);
3937 DEFSUBR (Fmapcar); 3826 DEFSUBR (Fmapcar);
3938 DEFSUBR (Fmapvector); 3827 DEFSUBR (Fmapvector);
3939 DEFSUBR (Fmapc_internal); 3828 DEFSUBR (Fmapc_internal);
3940 DEFSUBR (Fmapconcat); 3829 DEFSUBR (Fmapconcat);
3830 DEFSUBR (Freplace_list);
3941 DEFSUBR (Fload_average); 3831 DEFSUBR (Fload_average);
3942 DEFSUBR (Ffeaturep); 3832 DEFSUBR (Ffeaturep);
3943 DEFSUBR (Frequire); 3833 DEFSUBR (Frequire);
3944 DEFSUBR (Fprovide); 3834 DEFSUBR (Fprovide);
3945 DEFSUBR (Fbase64_encode_region); 3835 DEFSUBR (Fbase64_encode_region);