Mercurial > hg > xemacs-beta
comparison src/fns.c @ 444:576fb035e263 r21-2-37
Import from CVS: tag r21-2-37
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:36:19 +0200 |
parents | abe6d1db359e |
children | d7a9135ec789 |
comparison
equal
deleted
inserted
replaced
443:a8296e22da4e | 444:576fb035e263 |
---|---|
268 \(Under XEmacs, `equal' also ignores text properties and extents in | 268 \(Under XEmacs, `equal' also ignores text properties and extents in |
269 strings, but this is not the case under FSF Emacs 19. In FSF Emacs 20 | 269 strings, but this is not the case under FSF Emacs 19. In FSF Emacs 20 |
270 `equal' is the same as in XEmacs, in that respect.) | 270 `equal' is the same as in XEmacs, in that respect.) |
271 Symbols are also allowed; their print names are used instead. | 271 Symbols are also allowed; their print names are used instead. |
272 */ | 272 */ |
273 (s1, s2)) | 273 (string1, string2)) |
274 { | 274 { |
275 Bytecount len; | 275 Bytecount len; |
276 Lisp_String *p1, *p2; | 276 Lisp_String *p1, *p2; |
277 | 277 |
278 if (SYMBOLP (s1)) | 278 if (SYMBOLP (string1)) |
279 p1 = XSYMBOL (s1)->name; | 279 p1 = XSYMBOL (string1)->name; |
280 else | 280 else |
281 { | 281 { |
282 CHECK_STRING (s1); | 282 CHECK_STRING (string1); |
283 p1 = XSTRING (s1); | 283 p1 = XSTRING (string1); |
284 } | 284 } |
285 | 285 |
286 if (SYMBOLP (s2)) | 286 if (SYMBOLP (string2)) |
287 p2 = XSYMBOL (s2)->name; | 287 p2 = XSYMBOL (string2)->name; |
288 else | 288 else |
289 { | 289 { |
290 CHECK_STRING (s2); | 290 CHECK_STRING (string2); |
291 p2 = XSTRING (s2); | 291 p2 = XSTRING (string2); |
292 } | 292 } |
293 | 293 |
294 return (((len = string_length (p1)) == string_length (p2)) && | 294 return (((len = string_length (p1)) == string_length (p2)) && |
295 !memcmp (string_data (p1), string_data (p2), len)) ? Qt : Qnil; | 295 !memcmp (string_data (p1), string_data (p2), len)) ? Qt : Qnil; |
296 } | 296 } |
316 Unicode is a good first step towards solving this problem. In fact, | 316 Unicode is a good first step towards solving this problem. In fact, |
317 it is quite likely that a collation table exists (or will exist) for | 317 it is quite likely that a collation table exists (or will exist) for |
318 Unicode. When Unicode support is added to XEmacs/Mule, this problem | 318 Unicode. When Unicode support is added to XEmacs/Mule, this problem |
319 may be solved. | 319 may be solved. |
320 */ | 320 */ |
321 (s1, s2)) | 321 (string1, string2)) |
322 { | 322 { |
323 Lisp_String *p1, *p2; | 323 Lisp_String *p1, *p2; |
324 Charcount end, len2; | 324 Charcount end, len2; |
325 int i; | 325 int i; |
326 | 326 |
327 if (SYMBOLP (s1)) | 327 if (SYMBOLP (string1)) |
328 p1 = XSYMBOL (s1)->name; | 328 p1 = XSYMBOL (string1)->name; |
329 else | 329 else |
330 { | 330 { |
331 CHECK_STRING (s1); | 331 CHECK_STRING (string1); |
332 p1 = XSTRING (s1); | 332 p1 = XSTRING (string1); |
333 } | 333 } |
334 | 334 |
335 if (SYMBOLP (s2)) | 335 if (SYMBOLP (string2)) |
336 p2 = XSYMBOL (s2)->name; | 336 p2 = XSYMBOL (string2)->name; |
337 else | 337 else |
338 { | 338 { |
339 CHECK_STRING (s2); | 339 CHECK_STRING (string2); |
340 p2 = XSTRING (s2); | 340 p2 = XSTRING (string2); |
341 } | 341 } |
342 | 342 |
343 end = string_char_length (p1); | 343 end = string_char_length (p1); |
344 len2 = string_char_length (p2); | 344 len2 = string_char_length (p2); |
345 if (end > len2) | 345 if (end > len2) |
433 static Lisp_Object concat (int nargs, Lisp_Object *args, | 433 static Lisp_Object concat (int nargs, Lisp_Object *args, |
434 enum concat_target_type target_type, | 434 enum concat_target_type target_type, |
435 int last_special); | 435 int last_special); |
436 | 436 |
437 Lisp_Object | 437 Lisp_Object |
438 concat2 (Lisp_Object s1, Lisp_Object s2) | 438 concat2 (Lisp_Object string1, Lisp_Object string2) |
439 { | 439 { |
440 Lisp_Object args[2]; | 440 Lisp_Object args[2]; |
441 args[0] = s1; | 441 args[0] = string1; |
442 args[1] = s2; | 442 args[1] = string2; |
443 return concat (2, args, c_string, 0); | 443 return concat (2, args, c_string, 0); |
444 } | 444 } |
445 | 445 |
446 Lisp_Object | 446 Lisp_Object |
447 concat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) | 447 concat3 (Lisp_Object string1, Lisp_Object string2, Lisp_Object string3) |
448 { | 448 { |
449 Lisp_Object args[3]; | 449 Lisp_Object args[3]; |
450 args[0] = s1; | 450 args[0] = string1; |
451 args[1] = s2; | 451 args[1] = string2; |
452 args[2] = s3; | 452 args[2] = string3; |
453 return concat (3, args, c_string, 0); | 453 return concat (3, args, c_string, 0); |
454 } | 454 } |
455 | 455 |
456 Lisp_Object | 456 Lisp_Object |
457 vconcat2 (Lisp_Object s1, Lisp_Object s2) | 457 vconcat2 (Lisp_Object vec1, Lisp_Object vec2) |
458 { | 458 { |
459 Lisp_Object args[2]; | 459 Lisp_Object args[2]; |
460 args[0] = s1; | 460 args[0] = vec1; |
461 args[1] = s2; | 461 args[1] = vec2; |
462 return concat (2, args, c_vector, 0); | 462 return concat (2, args, c_vector, 0); |
463 } | 463 } |
464 | 464 |
465 Lisp_Object | 465 Lisp_Object |
466 vconcat3 (Lisp_Object s1, Lisp_Object s2, Lisp_Object s3) | 466 vconcat3 (Lisp_Object vec1, Lisp_Object vec2, Lisp_Object vec3) |
467 { | 467 { |
468 Lisp_Object args[3]; | 468 Lisp_Object args[3]; |
469 args[0] = s1; | 469 args[0] = vec1; |
470 args[1] = s2; | 470 args[1] = vec2; |
471 args[2] = s3; | 471 args[2] = vec3; |
472 return concat (3, args, c_vector, 0); | 472 return concat (3, args, c_vector, 0); |
473 } | 473 } |
474 | 474 |
475 DEFUN ("append", Fappend, 0, MANY, 0, /* | 475 DEFUN ("append", Fappend, 0, MANY, 0, /* |
476 Concatenate all the arguments and make the result a list. | 476 Concatenate all the arguments and make the result a list. |
893 } | 893 } |
894 return arg; | 894 return arg; |
895 } | 895 } |
896 | 896 |
897 DEFUN ("substring", Fsubstring, 2, 3, 0, /* | 897 DEFUN ("substring", Fsubstring, 2, 3, 0, /* |
898 Return a substring of STRING, starting at index FROM and ending before TO. | 898 Return the substring of STRING starting at START and ending before END. |
899 TO may be nil or omitted; then the substring runs to the end of STRING. | 899 END may be nil or omitted; then the substring runs to the end of STRING. |
900 If FROM or TO is negative, it counts from the end. | 900 If START or END is negative, it counts from the end. |
901 Relevant parts of the string-extent-data are copied in the new string. | 901 Relevant parts of the string-extent-data are copied to the new string. |
902 */ | 902 */ |
903 (string, from, to)) | 903 (string, start, end)) |
904 { | 904 { |
905 Charcount ccfr, ccto; | 905 Charcount ccstart, ccend; |
906 Bytecount bfr, blen; | 906 Bytecount bstart, blen; |
907 Lisp_Object val; | 907 Lisp_Object val; |
908 | 908 |
909 CHECK_STRING (string); | 909 CHECK_STRING (string); |
910 CHECK_INT (from); | 910 CHECK_INT (start); |
911 get_string_range_char (string, from, to, &ccfr, &ccto, | 911 get_string_range_char (string, start, end, &ccstart, &ccend, |
912 GB_HISTORICAL_STRING_BEHAVIOR); | 912 GB_HISTORICAL_STRING_BEHAVIOR); |
913 bfr = charcount_to_bytecount (XSTRING_DATA (string), ccfr); | 913 bstart = charcount_to_bytecount (XSTRING_DATA (string), ccstart); |
914 blen = charcount_to_bytecount (XSTRING_DATA (string) + bfr, ccto - ccfr); | 914 blen = charcount_to_bytecount (XSTRING_DATA (string) + bstart, ccend - ccstart); |
915 val = make_string (XSTRING_DATA (string) + bfr, blen); | 915 val = make_string (XSTRING_DATA (string) + bstart, blen); |
916 /* Copy any applicable extent information into the new string: */ | 916 /* Copy any applicable extent information into the new string. */ |
917 copy_string_extents (val, string, 0, bfr, blen); | 917 copy_string_extents (val, string, 0, bstart, blen); |
918 return val; | 918 return val; |
919 } | 919 } |
920 | 920 |
921 DEFUN ("subseq", Fsubseq, 2, 3, 0, /* | 921 DEFUN ("subseq", Fsubseq, 2, 3, 0, /* |
922 Return the subsequence of SEQUENCE starting at START and ending before END. | 922 Return the subsequence of SEQUENCE starting at START and ending before END. |
1183 Return a copy of LIST with the last N (default 1) elements removed. | 1183 Return a copy of LIST with the last N (default 1) elements removed. |
1184 If LIST has N or fewer elements, nil is returned. | 1184 If LIST has N or fewer elements, nil is returned. |
1185 */ | 1185 */ |
1186 (list, n)) | 1186 (list, n)) |
1187 { | 1187 { |
1188 int int_n; | 1188 EMACS_INT int_n; |
1189 | 1189 |
1190 CHECK_LIST (list); | 1190 CHECK_LIST (list); |
1191 | 1191 |
1192 if (NILP (n)) | 1192 if (NILP (n)) |
1193 int_n = 1; | 1193 int_n = 1; |
1284 } | 1284 } |
1285 return Qnil; | 1285 return Qnil; |
1286 } | 1286 } |
1287 | 1287 |
1288 DEFUN ("assoc", Fassoc, 2, 2, 0, /* | 1288 DEFUN ("assoc", Fassoc, 2, 2, 0, /* |
1289 Return non-nil if KEY is `equal' to the car of an element of LIST. | 1289 Return non-nil if KEY is `equal' to the car of an element of ALIST. |
1290 The value is actually the element of LIST whose car equals KEY. | 1290 The value is actually the element of ALIST whose car equals KEY. |
1291 */ | 1291 */ |
1292 (key, list)) | 1292 (key, alist)) |
1293 { | 1293 { |
1294 /* This function can GC. */ | 1294 /* This function can GC. */ |
1295 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) | 1295 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
1296 { | 1296 { |
1297 if (internal_equal (key, elt_car, 0)) | 1297 if (internal_equal (key, elt_car, 0)) |
1298 return elt; | 1298 return elt; |
1299 } | 1299 } |
1300 return Qnil; | 1300 return Qnil; |
1301 } | 1301 } |
1302 | 1302 |
1303 DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* | 1303 DEFUN ("old-assoc", Fold_assoc, 2, 2, 0, /* |
1304 Return non-nil if KEY is `old-equal' to the car of an element of LIST. | 1304 Return non-nil if KEY is `old-equal' to the car of an element of ALIST. |
1305 The value is actually the element of LIST whose car equals KEY. | 1305 The value is actually the element of ALIST whose car equals KEY. |
1306 */ | 1306 */ |
1307 (key, list)) | 1307 (key, alist)) |
1308 { | 1308 { |
1309 /* This function can GC. */ | 1309 /* This function can GC. */ |
1310 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) | 1310 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
1311 { | 1311 { |
1312 if (internal_old_equal (key, elt_car, 0)) | 1312 if (internal_old_equal (key, elt_car, 0)) |
1313 return elt; | 1313 return elt; |
1314 } | 1314 } |
1315 return Qnil; | 1315 return Qnil; |
1316 } | 1316 } |
1317 | 1317 |
1318 Lisp_Object | 1318 Lisp_Object |
1319 assoc_no_quit (Lisp_Object key, Lisp_Object list) | 1319 assoc_no_quit (Lisp_Object key, Lisp_Object alist) |
1320 { | 1320 { |
1321 int speccount = specpdl_depth (); | 1321 int speccount = specpdl_depth (); |
1322 specbind (Qinhibit_quit, Qt); | 1322 specbind (Qinhibit_quit, Qt); |
1323 return unbind_to (speccount, Fassoc (key, list)); | 1323 return unbind_to (speccount, Fassoc (key, alist)); |
1324 } | 1324 } |
1325 | 1325 |
1326 DEFUN ("assq", Fassq, 2, 2, 0, /* | 1326 DEFUN ("assq", Fassq, 2, 2, 0, /* |
1327 Return non-nil if KEY is `eq' to the car of an element of LIST. | 1327 Return non-nil if KEY is `eq' to the car of an element of ALIST. |
1328 The value is actually the element of LIST whose car is KEY. | 1328 The value is actually the element of ALIST whose car is KEY. |
1329 Elements of LIST that are not conses are ignored. | 1329 Elements of ALIST that are not conses are ignored. |
1330 */ | 1330 */ |
1331 (key, list)) | 1331 (key, alist)) |
1332 { | 1332 { |
1333 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) | 1333 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
1334 { | 1334 { |
1335 if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) | 1335 if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) |
1336 return elt; | 1336 return elt; |
1337 } | 1337 } |
1338 return Qnil; | 1338 return Qnil; |
1339 } | 1339 } |
1340 | 1340 |
1341 DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* | 1341 DEFUN ("old-assq", Fold_assq, 2, 2, 0, /* |
1342 Return non-nil if KEY is `old-eq' to the car of an element of LIST. | 1342 Return non-nil if KEY is `old-eq' to the car of an element of ALIST. |
1343 The value is actually the element of LIST whose car is KEY. | 1343 The value is actually the element of ALIST whose car is KEY. |
1344 Elements of LIST that are not conses are ignored. | 1344 Elements of ALIST that are not conses are ignored. |
1345 This function is provided only for byte-code compatibility with v19. | 1345 This function is provided only for byte-code compatibility with v19. |
1346 Do not use it. | 1346 Do not use it. |
1347 */ | 1347 */ |
1348 (key, list)) | 1348 (key, alist)) |
1349 { | 1349 { |
1350 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) | 1350 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
1351 { | 1351 { |
1352 if (HACKEQ_UNSAFE (key, elt_car)) | 1352 if (HACKEQ_UNSAFE (key, elt_car)) |
1353 return elt; | 1353 return elt; |
1354 } | 1354 } |
1355 return Qnil; | 1355 return Qnil; |
1357 | 1357 |
1358 /* Like Fassq but never report an error and do not allow quits. | 1358 /* Like Fassq but never report an error and do not allow quits. |
1359 Use only on lists known never to be circular. */ | 1359 Use only on lists known never to be circular. */ |
1360 | 1360 |
1361 Lisp_Object | 1361 Lisp_Object |
1362 assq_no_quit (Lisp_Object key, Lisp_Object list) | 1362 assq_no_quit (Lisp_Object key, Lisp_Object alist) |
1363 { | 1363 { |
1364 /* This cannot GC. */ | 1364 /* This cannot GC. */ |
1365 LIST_LOOP_2 (elt, list) | 1365 LIST_LOOP_2 (elt, alist) |
1366 { | 1366 { |
1367 Lisp_Object elt_car = XCAR (elt); | 1367 Lisp_Object elt_car = XCAR (elt); |
1368 if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) | 1368 if (EQ_WITH_EBOLA_NOTICE (key, elt_car)) |
1369 return elt; | 1369 return elt; |
1370 } | 1370 } |
1371 return Qnil; | 1371 return Qnil; |
1372 } | 1372 } |
1373 | 1373 |
1374 DEFUN ("rassoc", Frassoc, 2, 2, 0, /* | 1374 DEFUN ("rassoc", Frassoc, 2, 2, 0, /* |
1375 Return non-nil if KEY is `equal' to the cdr of an element of LIST. | 1375 Return non-nil if VALUE is `equal' to the cdr of an element of ALIST. |
1376 The value is actually the element of LIST whose cdr equals KEY. | 1376 The value is actually the element of ALIST whose cdr equals VALUE. |
1377 */ | 1377 */ |
1378 (key, list)) | 1378 (value, alist)) |
1379 { | 1379 { |
1380 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) | 1380 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
1381 { | 1381 { |
1382 if (internal_equal (key, elt_cdr, 0)) | 1382 if (internal_equal (value, elt_cdr, 0)) |
1383 return elt; | 1383 return elt; |
1384 } | 1384 } |
1385 return Qnil; | 1385 return Qnil; |
1386 } | 1386 } |
1387 | 1387 |
1388 DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* | 1388 DEFUN ("old-rassoc", Fold_rassoc, 2, 2, 0, /* |
1389 Return non-nil if KEY is `old-equal' to the cdr of an element of LIST. | 1389 Return non-nil if VALUE is `old-equal' to the cdr of an element of ALIST. |
1390 The value is actually the element of LIST whose cdr equals KEY. | 1390 The value is actually the element of ALIST whose cdr equals VALUE. |
1391 */ | 1391 */ |
1392 (key, list)) | 1392 (value, alist)) |
1393 { | 1393 { |
1394 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) | 1394 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
1395 { | 1395 { |
1396 if (internal_old_equal (key, elt_cdr, 0)) | 1396 if (internal_old_equal (value, elt_cdr, 0)) |
1397 return elt; | 1397 return elt; |
1398 } | 1398 } |
1399 return Qnil; | 1399 return Qnil; |
1400 } | 1400 } |
1401 | 1401 |
1402 DEFUN ("rassq", Frassq, 2, 2, 0, /* | 1402 DEFUN ("rassq", Frassq, 2, 2, 0, /* |
1403 Return non-nil if KEY is `eq' to the cdr of an element of LIST. | 1403 Return non-nil if VALUE is `eq' to the cdr of an element of ALIST. |
1404 The value is actually the element of LIST whose cdr is KEY. | 1404 The value is actually the element of ALIST whose cdr is VALUE. |
1405 */ | 1405 */ |
1406 (key, list)) | 1406 (value, alist)) |
1407 { | 1407 { |
1408 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) | 1408 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
1409 { | 1409 { |
1410 if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr)) | 1410 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr)) |
1411 return elt; | 1411 return elt; |
1412 } | 1412 } |
1413 return Qnil; | 1413 return Qnil; |
1414 } | 1414 } |
1415 | 1415 |
1416 DEFUN ("old-rassq", Fold_rassq, 2, 2, 0, /* | 1416 DEFUN ("old-rassq", Fold_rassq, 2, 2, 0, /* |
1417 Return non-nil if KEY is `old-eq' to the cdr of an element of LIST. | 1417 Return non-nil if VALUE is `old-eq' to the cdr of an element of ALIST. |
1418 The value is actually the element of LIST whose cdr is KEY. | 1418 The value is actually the element of ALIST whose cdr is VALUE. |
1419 */ | 1419 */ |
1420 (key, list)) | 1420 (value, alist)) |
1421 { | 1421 { |
1422 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, list) | 1422 EXTERNAL_ALIST_LOOP_4 (elt, elt_car, elt_cdr, alist) |
1423 { | 1423 { |
1424 if (HACKEQ_UNSAFE (key, elt_cdr)) | 1424 if (HACKEQ_UNSAFE (value, elt_cdr)) |
1425 return elt; | 1425 return elt; |
1426 } | 1426 } |
1427 return Qnil; | 1427 return Qnil; |
1428 } | 1428 } |
1429 | 1429 |
1430 /* Like Frassq, but caller must ensure that LIST is properly | 1430 /* Like Frassq, but caller must ensure that ALIST is properly |
1431 nil-terminated and ebola-free. */ | 1431 nil-terminated and ebola-free. */ |
1432 Lisp_Object | 1432 Lisp_Object |
1433 rassq_no_quit (Lisp_Object key, Lisp_Object list) | 1433 rassq_no_quit (Lisp_Object value, Lisp_Object alist) |
1434 { | 1434 { |
1435 LIST_LOOP_2 (elt, list) | 1435 LIST_LOOP_2 (elt, alist) |
1436 { | 1436 { |
1437 Lisp_Object elt_cdr = XCDR (elt); | 1437 Lisp_Object elt_cdr = XCDR (elt); |
1438 if (EQ_WITH_EBOLA_NOTICE (key, elt_cdr)) | 1438 if (EQ_WITH_EBOLA_NOTICE (value, elt_cdr)) |
1439 return elt; | 1439 return elt; |
1440 } | 1440 } |
1441 return Qnil; | 1441 return Qnil; |
1442 } | 1442 } |
1443 | 1443 |
1544 } | 1544 } |
1545 return list; | 1545 return list; |
1546 } | 1546 } |
1547 | 1547 |
1548 DEFUN ("remassoc", Fremassoc, 2, 2, 0, /* | 1548 DEFUN ("remassoc", Fremassoc, 2, 2, 0, /* |
1549 Delete by side effect any elements of LIST whose car is `equal' to KEY. | 1549 Delete by side effect any elements of ALIST whose car is `equal' to KEY. |
1550 The modified LIST is returned. If the first member of LIST has a car | 1550 The modified ALIST is returned. If the first member of ALIST has a car |
1551 that is `equal' to KEY, there is no way to remove it by side effect; | 1551 that is `equal' to KEY, there is no way to remove it by side effect; |
1552 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 |
1553 the value of `foo'. | 1553 the value of `foo'. |
1554 */ | 1554 */ |
1555 (key, list)) | 1555 (key, alist)) |
1556 { | 1556 { |
1557 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, | 1557 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist, |
1558 (CONSP (elt) && | 1558 (CONSP (elt) && |
1559 internal_equal (key, XCAR (elt), 0))); | 1559 internal_equal (key, XCAR (elt), 0))); |
1560 return list; | 1560 return alist; |
1561 } | 1561 } |
1562 | 1562 |
1563 Lisp_Object | 1563 Lisp_Object |
1564 remassoc_no_quit (Lisp_Object key, Lisp_Object list) | 1564 remassoc_no_quit (Lisp_Object key, Lisp_Object alist) |
1565 { | 1565 { |
1566 int speccount = specpdl_depth (); | 1566 int speccount = specpdl_depth (); |
1567 specbind (Qinhibit_quit, Qt); | 1567 specbind (Qinhibit_quit, Qt); |
1568 return unbind_to (speccount, Fremassoc (key, list)); | 1568 return unbind_to (speccount, Fremassoc (key, alist)); |
1569 } | 1569 } |
1570 | 1570 |
1571 DEFUN ("remassq", Fremassq, 2, 2, 0, /* | 1571 DEFUN ("remassq", Fremassq, 2, 2, 0, /* |
1572 Delete by side effect any elements of LIST whose car is `eq' to KEY. | 1572 Delete by side effect any elements of ALIST whose car is `eq' to KEY. |
1573 The modified LIST is returned. If the first member of LIST has a car | 1573 The modified ALIST is returned. If the first member of ALIST has a car |
1574 that is `eq' to KEY, there is no way to remove it by side effect; | 1574 that is `eq' to KEY, there is no way to remove it by side effect; |
1575 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 |
1576 the value of `foo'. | 1576 the value of `foo'. |
1577 */ | 1577 */ |
1578 (key, list)) | 1578 (key, alist)) |
1579 { | 1579 { |
1580 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, | 1580 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist, |
1581 (CONSP (elt) && | 1581 (CONSP (elt) && |
1582 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); | 1582 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); |
1583 return list; | 1583 return alist; |
1584 } | 1584 } |
1585 | 1585 |
1586 /* no quit, no errors; be careful */ | 1586 /* no quit, no errors; be careful */ |
1587 | 1587 |
1588 Lisp_Object | 1588 Lisp_Object |
1589 remassq_no_quit (Lisp_Object key, Lisp_Object list) | 1589 remassq_no_quit (Lisp_Object key, Lisp_Object alist) |
1590 { | 1590 { |
1591 LIST_LOOP_DELETE_IF (elt, list, | 1591 LIST_LOOP_DELETE_IF (elt, alist, |
1592 (CONSP (elt) && | 1592 (CONSP (elt) && |
1593 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); | 1593 EQ_WITH_EBOLA_NOTICE (key, XCAR (elt)))); |
1594 return list; | 1594 return alist; |
1595 } | 1595 } |
1596 | 1596 |
1597 DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /* | 1597 DEFUN ("remrassoc", Fremrassoc, 2, 2, 0, /* |
1598 Delete by side effect any elements of LIST whose cdr is `equal' to VALUE. | 1598 Delete by side effect any elements of ALIST whose cdr is `equal' to VALUE. |
1599 The modified LIST is returned. If the first member of LIST has a car | 1599 The modified ALIST is returned. If the first member of ALIST has a car |
1600 that is `equal' to VALUE, there is no way to remove it by side effect; | 1600 that is `equal' to VALUE, there is no way to remove it by side effect; |
1601 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 |
1602 the value of `foo'. | 1602 the value of `foo'. |
1603 */ | 1603 */ |
1604 (value, list)) | 1604 (value, alist)) |
1605 { | 1605 { |
1606 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, | 1606 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist, |
1607 (CONSP (elt) && | 1607 (CONSP (elt) && |
1608 internal_equal (value, XCDR (elt), 0))); | 1608 internal_equal (value, XCDR (elt), 0))); |
1609 return list; | 1609 return alist; |
1610 } | 1610 } |
1611 | 1611 |
1612 DEFUN ("remrassq", Fremrassq, 2, 2, 0, /* | 1612 DEFUN ("remrassq", Fremrassq, 2, 2, 0, /* |
1613 Delete by side effect any elements of LIST whose cdr is `eq' to VALUE. | 1613 Delete by side effect any elements of ALIST whose cdr is `eq' to VALUE. |
1614 The modified LIST is returned. If the first member of LIST has a car | 1614 The modified ALIST is returned. If the first member of ALIST has a car |
1615 that is `eq' to VALUE, there is no way to remove it by side effect; | 1615 that is `eq' to VALUE, there is no way to remove it by side effect; |
1616 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 |
1617 the value of `foo'. | 1617 the value of `foo'. |
1618 */ | 1618 */ |
1619 (value, list)) | 1619 (value, alist)) |
1620 { | 1620 { |
1621 EXTERNAL_LIST_LOOP_DELETE_IF (elt, list, | 1621 EXTERNAL_LIST_LOOP_DELETE_IF (elt, alist, |
1622 (CONSP (elt) && | 1622 (CONSP (elt) && |
1623 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); | 1623 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); |
1624 return list; | 1624 return alist; |
1625 } | 1625 } |
1626 | 1626 |
1627 /* Like Fremrassq, fast and unsafe; be careful */ | 1627 /* Like Fremrassq, fast and unsafe; be careful */ |
1628 Lisp_Object | 1628 Lisp_Object |
1629 remrassq_no_quit (Lisp_Object value, Lisp_Object list) | 1629 remrassq_no_quit (Lisp_Object value, Lisp_Object alist) |
1630 { | 1630 { |
1631 LIST_LOOP_DELETE_IF (elt, list, | 1631 LIST_LOOP_DELETE_IF (elt, alist, |
1632 (CONSP (elt) && | 1632 (CONSP (elt) && |
1633 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); | 1633 EQ_WITH_EBOLA_NOTICE (value, XCDR (elt)))); |
1634 return list; | 1634 return alist; |
1635 } | 1635 } |
1636 | 1636 |
1637 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* | 1637 DEFUN ("nreverse", Fnreverse, 1, 1, 0, /* |
1638 Reverse LIST by destructively modifying cdr pointers. | 1638 Reverse LIST by destructively modifying cdr pointers. |
1639 Return the beginning of the reversed list. | 1639 Return the beginning of the reversed list. |
1687 { | 1687 { |
1688 struct gcpro gcpro1, gcpro2, gcpro3; | 1688 struct gcpro gcpro1, gcpro2, gcpro3; |
1689 Lisp_Object back, tem; | 1689 Lisp_Object back, tem; |
1690 Lisp_Object front = list; | 1690 Lisp_Object front = list; |
1691 Lisp_Object len = Flength (list); | 1691 Lisp_Object len = Flength (list); |
1692 int length = XINT (len); | 1692 |
1693 | 1693 if (XINT (len) < 2) |
1694 if (length < 2) | |
1695 return list; | 1694 return list; |
1696 | 1695 |
1697 XSETINT (len, (length / 2) - 1); | 1696 len = make_int (XINT (len) / 2 - 1); |
1698 tem = Fnthcdr (len, list); | 1697 tem = Fnthcdr (len, list); |
1699 back = Fcdr (tem); | 1698 back = Fcdr (tem); |
1700 Fsetcdr (tem, Qnil); | 1699 Fsetcdr (tem, Qnil); |
1701 | 1700 |
1702 GCPRO3 (front, back, lisp_arg); | 1701 GCPRO3 (front, back, lisp_arg); |
1733 Sort LIST, stably, comparing elements using PREDICATE. | 1732 Sort LIST, stably, comparing elements using PREDICATE. |
1734 Returns the sorted list. LIST is modified by side effects. | 1733 Returns the sorted list. LIST is modified by side effects. |
1735 PREDICATE is called with two elements of LIST, and should return T | 1734 PREDICATE is called with two elements of LIST, and should return T |
1736 if the first element is "less" than the second. | 1735 if the first element is "less" than the second. |
1737 */ | 1736 */ |
1738 (list, pred)) | 1737 (list, predicate)) |
1739 { | 1738 { |
1740 return list_sort (list, pred, merge_pred_function); | 1739 return list_sort (list, predicate, merge_pred_function); |
1741 } | 1740 } |
1742 | 1741 |
1743 Lisp_Object | 1742 Lisp_Object |
1744 merge (Lisp_Object org_l1, Lisp_Object org_l2, | 1743 merge (Lisp_Object org_l1, Lisp_Object org_l2, |
1745 Lisp_Object pred) | 1744 Lisp_Object pred) |
2265 } | 2264 } |
2266 | 2265 |
2267 DEFUN ("plist-get", Fplist_get, 2, 3, 0, /* | 2266 DEFUN ("plist-get", Fplist_get, 2, 3, 0, /* |
2268 Extract a value from a property list. | 2267 Extract a value from a property list. |
2269 PLIST is a property list, which is a list of the form | 2268 PLIST is a property list, which is a list of the form |
2270 \(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value | 2269 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...). |
2271 corresponding to the given PROP, or DEFAULT if PROP is not | 2270 PROPERTY is usually a symbol. |
2272 one of the properties on the list. | 2271 This function returns the value corresponding to the PROPERTY, |
2273 */ | 2272 or DEFAULT if PROPERTY is not one of the properties on the list. |
2274 (plist, prop, default_)) | 2273 */ |
2275 { | 2274 (plist, property, default_)) |
2276 Lisp_Object val = external_plist_get (&plist, prop, 0, ERROR_ME); | 2275 { |
2277 return UNBOUNDP (val) ? default_ : val; | 2276 Lisp_Object value = external_plist_get (&plist, property, 0, ERROR_ME); |
2277 return UNBOUNDP (value) ? default_ : value; | |
2278 } | 2278 } |
2279 | 2279 |
2280 DEFUN ("plist-put", Fplist_put, 3, 3, 0, /* | 2280 DEFUN ("plist-put", Fplist_put, 3, 3, 0, /* |
2281 Change value in PLIST of PROP to VAL. | 2281 Change value in PLIST of PROPERTY to VALUE. |
2282 PLIST is a property list, which is a list of the form \(PROP1 VALUE1 | 2282 PLIST is a property list, which is a list of the form |
2283 PROP2 VALUE2 ...). PROP is usually a symbol and VAL is any object. | 2283 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...). |
2284 If PROP is already a property on the list, its value is set to VAL, | 2284 PROPERTY is usually a symbol and VALUE is any object. |
2285 otherwise the new PROP VAL pair is added. The new plist is returned; | 2285 If PROPERTY is already a property on the list, its value is set to VALUE, |
2286 use `(setq x (plist-put x prop val))' to be sure to use the new value. | 2286 otherwise the new PROPERTY VALUE pair is added. |
2287 The PLIST is modified by side effects. | 2287 The new plist is returned; use `(setq x (plist-put x property value))' |
2288 */ | 2288 to be sure to use the new value. PLIST is modified by side effect. |
2289 (plist, prop, val)) | 2289 */ |
2290 { | 2290 (plist, property, value)) |
2291 external_plist_put (&plist, prop, val, 0, ERROR_ME); | 2291 { |
2292 external_plist_put (&plist, property, value, 0, ERROR_ME); | |
2292 return plist; | 2293 return plist; |
2293 } | 2294 } |
2294 | 2295 |
2295 DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /* | 2296 DEFUN ("plist-remprop", Fplist_remprop, 2, 2, 0, /* |
2296 Remove from PLIST the property PROP and its value. | 2297 Remove from PLIST the property PROPERTY and its value. |
2297 PLIST is a property list, which is a list of the form \(PROP1 VALUE1 | 2298 PLIST is a property list, which is a list of the form |
2298 PROP2 VALUE2 ...). PROP is usually a symbol. The new plist is | 2299 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2 ...). |
2299 returned; use `(setq x (plist-remprop x prop val))' to be sure to use | 2300 PROPERTY is usually a symbol. |
2300 the new value. The PLIST is modified by side effects. | 2301 The new plist is returned; use `(setq x (plist-remprop x property))' |
2301 */ | 2302 to be sure to use the new value. PLIST is modified by side effect. |
2302 (plist, prop)) | 2303 */ |
2303 { | 2304 (plist, property)) |
2304 external_remprop (&plist, prop, 0, ERROR_ME); | 2305 { |
2306 external_remprop (&plist, property, 0, ERROR_ME); | |
2305 return plist; | 2307 return plist; |
2306 } | 2308 } |
2307 | 2309 |
2308 DEFUN ("plist-member", Fplist_member, 2, 2, 0, /* | 2310 DEFUN ("plist-member", Fplist_member, 2, 2, 0, /* |
2309 Return t if PROP has a value specified in PLIST. | 2311 Return t if PROPERTY has a value specified in PLIST. |
2310 */ | 2312 */ |
2311 (plist, prop)) | 2313 (plist, property)) |
2312 { | 2314 { |
2313 Lisp_Object val = Fplist_get (plist, prop, Qunbound); | 2315 Lisp_Object value = Fplist_get (plist, property, Qunbound); |
2314 return UNBOUNDP (val) ? Qnil : Qt; | 2316 return UNBOUNDP (value) ? Qnil : Qt; |
2315 } | 2317 } |
2316 | 2318 |
2317 DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /* | 2319 DEFUN ("check-valid-plist", Fcheck_valid_plist, 1, 1, 0, /* |
2318 Given a plist, signal an error if there is anything wrong with it. | 2320 Given a plist, signal an error if there is anything wrong with it. |
2319 This means that it's a malformed or circular plist. | 2321 This means that it's a malformed or circular plist. |
2407 return head; | 2409 return head; |
2408 } | 2410 } |
2409 | 2411 |
2410 DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /* | 2412 DEFUN ("lax-plist-get", Flax_plist_get, 2, 3, 0, /* |
2411 Extract a value from a lax property list. | 2413 Extract a value from a lax property list. |
2412 | 2414 LAX-PLIST is a lax property list, which is a list of the form |
2413 LAX-PLIST is a lax property list, which is a list of the form \(PROP1 | 2415 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between |
2414 VALUE1 PROP2 VALUE2...), where comparisons between properties is done | 2416 properties is done using `equal' instead of `eq'. |
2415 using `equal' instead of `eq'. This function returns the value | 2417 PROPERTY is usually a symbol. |
2416 corresponding to the given PROP, or DEFAULT if PROP is not one of the | 2418 This function returns the value corresponding to PROPERTY, |
2417 properties on the list. | 2419 or DEFAULT if PROPERTY is not one of the properties on the list. |
2418 */ | 2420 */ |
2419 (lax_plist, prop, default_)) | 2421 (lax_plist, property, default_)) |
2420 { | 2422 { |
2421 Lisp_Object val = external_plist_get (&lax_plist, prop, 1, ERROR_ME); | 2423 Lisp_Object value = external_plist_get (&lax_plist, property, 1, ERROR_ME); |
2422 return UNBOUNDP (val) ? default_ : val; | 2424 return UNBOUNDP (value) ? default_ : value; |
2423 } | 2425 } |
2424 | 2426 |
2425 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /* | 2427 DEFUN ("lax-plist-put", Flax_plist_put, 3, 3, 0, /* |
2426 Change value in LAX-PLIST of PROP to VAL. | 2428 Change value in LAX-PLIST of PROPERTY to VALUE. |
2427 LAX-PLIST is a lax property list, which is a list of the form \(PROP1 | 2429 LAX-PLIST is a lax property list, which is a list of the form |
2428 VALUE1 PROP2 VALUE2...), where comparisons between properties is done | 2430 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between |
2429 using `equal' instead of `eq'. PROP is usually a symbol and VAL is | 2431 properties is done using `equal' instead of `eq'. |
2430 any object. If PROP is already a property on the list, its value is | 2432 PROPERTY is usually a symbol and VALUE is any object. |
2431 set to VAL, otherwise the new PROP VAL pair is added. The new plist | 2433 If PROPERTY is already a property on the list, its value is set to |
2432 is returned; use `(setq x (lax-plist-put x prop val))' to be sure to | 2434 VALUE, otherwise the new PROPERTY VALUE pair is added. |
2433 use the new value. The LAX-PLIST is modified by side effects. | 2435 The new plist is returned; use `(setq x (lax-plist-put x property value))' |
2434 */ | 2436 to be sure to use the new value. LAX-PLIST is modified by side effect. |
2435 (lax_plist, prop, val)) | 2437 */ |
2436 { | 2438 (lax_plist, property, value)) |
2437 external_plist_put (&lax_plist, prop, val, 1, ERROR_ME); | 2439 { |
2440 external_plist_put (&lax_plist, property, value, 1, ERROR_ME); | |
2438 return lax_plist; | 2441 return lax_plist; |
2439 } | 2442 } |
2440 | 2443 |
2441 DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /* | 2444 DEFUN ("lax-plist-remprop", Flax_plist_remprop, 2, 2, 0, /* |
2442 Remove from LAX-PLIST the property PROP and its value. | 2445 Remove from LAX-PLIST the property PROPERTY and its value. |
2443 LAX-PLIST is a lax property list, which is a list of the form \(PROP1 | 2446 LAX-PLIST is a lax property list, which is a list of the form |
2444 VALUE1 PROP2 VALUE2...), where comparisons between properties is done | 2447 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between |
2445 using `equal' instead of `eq'. PROP is usually a symbol. The new | 2448 properties is done using `equal' instead of `eq'. |
2446 plist is returned; use `(setq x (lax-plist-remprop x prop val))' to be | 2449 PROPERTY is usually a symbol. |
2447 sure to use the new value. The LAX-PLIST is modified by side effects. | 2450 The new plist is returned; use `(setq x (lax-plist-remprop x property))' |
2448 */ | 2451 to be sure to use the new value. LAX-PLIST is modified by side effect. |
2449 (lax_plist, prop)) | 2452 */ |
2450 { | 2453 (lax_plist, property)) |
2451 external_remprop (&lax_plist, prop, 1, ERROR_ME); | 2454 { |
2455 external_remprop (&lax_plist, property, 1, ERROR_ME); | |
2452 return lax_plist; | 2456 return lax_plist; |
2453 } | 2457 } |
2454 | 2458 |
2455 DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /* | 2459 DEFUN ("lax-plist-member", Flax_plist_member, 2, 2, 0, /* |
2456 Return t if PROP has a value specified in LAX-PLIST. | 2460 Return t if PROPERTY has a value specified in LAX-PLIST. |
2457 LAX-PLIST is a lax property list, which is a list of the form \(PROP1 | 2461 LAX-PLIST is a lax property list, which is a list of the form |
2458 VALUE1 PROP2 VALUE2...), where comparisons between properties is done | 2462 \(PROPERTY1 VALUE1 PROPERTY2 VALUE2...), where comparisons between |
2459 using `equal' instead of `eq'. | 2463 properties is done using `equal' instead of `eq'. |
2460 */ | 2464 */ |
2461 (lax_plist, prop)) | 2465 (lax_plist, property)) |
2462 { | 2466 { |
2463 return UNBOUNDP (Flax_plist_get (lax_plist, prop, Qunbound)) ? Qnil : Qt; | 2467 return UNBOUNDP (Flax_plist_get (lax_plist, property, Qunbound)) ? Qnil : Qt; |
2464 } | 2468 } |
2465 | 2469 |
2466 DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /* | 2470 DEFUN ("canonicalize-lax-plist", Fcanonicalize_lax_plist, 1, 2, 0, /* |
2467 Destructively remove any duplicate entries from a lax plist. | 2471 Destructively remove any duplicate entries from a lax plist. |
2468 In such cases, the first entry applies. | 2472 In such cases, the first entry applies. |
2677 They must have the same data type. | 2681 They must have the same data type. |
2678 Conses are compared by comparing the cars and the cdrs. | 2682 Conses are compared by comparing the cars and the cdrs. |
2679 Vectors and strings are compared element by element. | 2683 Vectors and strings are compared element by element. |
2680 Numbers are compared by value. Symbols must match exactly. | 2684 Numbers are compared by value. Symbols must match exactly. |
2681 */ | 2685 */ |
2682 (obj1, obj2)) | 2686 (object1, object2)) |
2683 { | 2687 { |
2684 return internal_equal (obj1, obj2, 0) ? Qt : Qnil; | 2688 return internal_equal (object1, object2, 0) ? Qt : Qnil; |
2685 } | 2689 } |
2686 | 2690 |
2687 DEFUN ("old-equal", Fold_equal, 2, 2, 0, /* | 2691 DEFUN ("old-equal", Fold_equal, 2, 2, 0, /* |
2688 Return t if two Lisp objects have similar structure and contents. | 2692 Return t if two Lisp objects have similar structure and contents. |
2689 They must have the same data type. | 2693 They must have the same data type. |
2691 this is known as the "char-int confoundance disease." See `eq' and | 2695 this is known as the "char-int confoundance disease." See `eq' and |
2692 `old-eq'.) | 2696 `old-eq'.) |
2693 This function is provided only for byte-code compatibility with v19. | 2697 This function is provided only for byte-code compatibility with v19. |
2694 Do not use it. | 2698 Do not use it. |
2695 */ | 2699 */ |
2696 (obj1, obj2)) | 2700 (object1, object2)) |
2697 { | 2701 { |
2698 return internal_old_equal (obj1, obj2, 0) ? Qt : Qnil; | 2702 return internal_old_equal (object1, object2, 0) ? Qt : Qnil; |
2699 } | 2703 } |
2700 | 2704 |
2701 | 2705 |
2702 DEFUN ("fillarray", Ffillarray, 2, 2, 0, /* | 2706 DEFUN ("fillarray", Ffillarray, 2, 2, 0, /* |
2703 Destructively modify ARRAY by replacing each element with ITEM. | 2707 Destructively modify ARRAY by replacing each element with ITEM. |
2733 bump_string_modiff (array); | 2737 bump_string_modiff (array); |
2734 } | 2738 } |
2735 else if (VECTORP (array)) | 2739 else if (VECTORP (array)) |
2736 { | 2740 { |
2737 Lisp_Object *p = XVECTOR_DATA (array); | 2741 Lisp_Object *p = XVECTOR_DATA (array); |
2738 int len = XVECTOR_LENGTH (array); | 2742 size_t len = XVECTOR_LENGTH (array); |
2739 CHECK_LISP_WRITEABLE (array); | 2743 CHECK_LISP_WRITEABLE (array); |
2740 while (len--) | 2744 while (len--) |
2741 *p++ = item; | 2745 *p++ = item; |
2742 } | 2746 } |
2743 else if (BIT_VECTORP (array)) | 2747 else if (BIT_VECTORP (array)) |
2744 { | 2748 { |
2745 Lisp_Bit_Vector *v = XBIT_VECTOR (array); | 2749 Lisp_Bit_Vector *v = XBIT_VECTOR (array); |
2746 int len = bit_vector_length (v); | 2750 size_t len = bit_vector_length (v); |
2747 int bit; | 2751 int bit; |
2748 CHECK_BIT (item); | 2752 CHECK_BIT (item); |
2753 bit = XINT (item); | |
2749 CHECK_LISP_WRITEABLE (array); | 2754 CHECK_LISP_WRITEABLE (array); |
2750 bit = XINT (item); | |
2751 while (len--) | 2755 while (len--) |
2752 set_bit_vector_bit (v, len, bit); | 2756 set_bit_vector_bit (v, len, bit); |
2753 } | 2757 } |
2754 else | 2758 else |
2755 { | 2759 { |
2780 | 2784 |
2781 if (CONSP (args[0])) | 2785 if (CONSP (args[0])) |
2782 { | 2786 { |
2783 /* (setcdr (last args[0]) args[1]) */ | 2787 /* (setcdr (last args[0]) args[1]) */ |
2784 Lisp_Object tortoise, hare; | 2788 Lisp_Object tortoise, hare; |
2785 int count; | 2789 size_t count; |
2786 | 2790 |
2787 for (hare = tortoise = args[0], count = 0; | 2791 for (hare = tortoise = args[0], count = 0; |
2788 CONSP (XCDR (hare)); | 2792 CONSP (XCDR (hare)); |
2789 hare = XCDR (hare), count++) | 2793 hare = XCDR (hare), count++) |
2790 { | 2794 { |
2849 Lisp_Object next = args[argnum]; | 2853 Lisp_Object next = args[argnum]; |
2850 retry_next: | 2854 retry_next: |
2851 if (CONSP (next) || argnum == nargs -1) | 2855 if (CONSP (next) || argnum == nargs -1) |
2852 { | 2856 { |
2853 /* (setcdr (last val) next) */ | 2857 /* (setcdr (last val) next) */ |
2854 int count; | 2858 size_t count; |
2855 | 2859 |
2856 for (count = 0; | 2860 for (count = 0; |
2857 CONSP (XCDR (last_cons)); | 2861 CONSP (XCDR (last_cons)); |
2858 last_cons = XCDR (last_cons), count++) | 2862 last_cons = XCDR (last_cons), count++) |
2859 { | 2863 { |
2903 mapcar1 (size_t leni, Lisp_Object *vals, | 2907 mapcar1 (size_t leni, Lisp_Object *vals, |
2904 Lisp_Object function, Lisp_Object sequence) | 2908 Lisp_Object function, Lisp_Object sequence) |
2905 { | 2909 { |
2906 Lisp_Object result; | 2910 Lisp_Object result; |
2907 Lisp_Object args[2]; | 2911 Lisp_Object args[2]; |
2908 int i; | |
2909 struct gcpro gcpro1; | 2912 struct gcpro gcpro1; |
2910 | 2913 |
2911 if (vals) | 2914 if (vals) |
2912 { | 2915 { |
2913 GCPRO1 (vals[0]); | 2916 GCPRO1 (vals[0]); |
2933 So we use EXTERNAL_LIST_LOOP_3_NO_DECLARE and GCPRO the tail. */ | 2936 So we use EXTERNAL_LIST_LOOP_3_NO_DECLARE and GCPRO the tail. */ |
2934 | 2937 |
2935 if (vals) | 2938 if (vals) |
2936 { | 2939 { |
2937 Lisp_Object *val = vals; | 2940 Lisp_Object *val = vals; |
2941 size_t i; | |
2938 | 2942 |
2939 LIST_LOOP_2 (elt, sequence) | 2943 LIST_LOOP_2 (elt, sequence) |
2940 *val++ = elt; | 2944 *val++ = elt; |
2941 | 2945 |
2942 gcpro1.nvars = leni; | 2946 gcpro1.nvars = leni; |
2967 } | 2971 } |
2968 } | 2972 } |
2969 else if (VECTORP (sequence)) | 2973 else if (VECTORP (sequence)) |
2970 { | 2974 { |
2971 Lisp_Object *objs = XVECTOR_DATA (sequence); | 2975 Lisp_Object *objs = XVECTOR_DATA (sequence); |
2976 size_t i; | |
2972 for (i = 0; i < leni; i++) | 2977 for (i = 0; i < leni; i++) |
2973 { | 2978 { |
2974 args[1] = *objs++; | 2979 args[1] = *objs++; |
2975 result = Ffuncall (2, args); | 2980 result = Ffuncall (2, args); |
2976 if (vals) vals[gcpro1.nvars++] = result; | 2981 if (vals) vals[gcpro1.nvars++] = result; |
2994 } | 2999 } |
2995 } | 3000 } |
2996 else if (BIT_VECTORP (sequence)) | 3001 else if (BIT_VECTORP (sequence)) |
2997 { | 3002 { |
2998 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); | 3003 Lisp_Bit_Vector *v = XBIT_VECTOR (sequence); |
3004 size_t i; | |
2999 for (i = 0; i < leni; i++) | 3005 for (i = 0; i < leni; i++) |
3000 { | 3006 { |
3001 args[1] = make_int (bit_vector_bit (v, i)); | 3007 args[1] = make_int (bit_vector_bit (v, i)); |
3002 result = Ffuncall (2, args); | 3008 result = Ffuncall (2, args); |
3003 if (vals) vals[gcpro1.nvars++] = result; | 3009 if (vals) vals[gcpro1.nvars++] = result; |
3016 SEPARATOR results in spaces between the values returned by FUNCTION. | 3022 SEPARATOR results in spaces between the values returned by FUNCTION. |
3017 SEQUENCE may be a list, a vector, a bit vector, or a string. | 3023 SEQUENCE may be a list, a vector, a bit vector, or a string. |
3018 */ | 3024 */ |
3019 (function, sequence, separator)) | 3025 (function, sequence, separator)) |
3020 { | 3026 { |
3021 size_t len = XINT (Flength (sequence)); | 3027 EMACS_INT len = XINT (Flength (sequence)); |
3022 Lisp_Object *args; | 3028 Lisp_Object *args; |
3023 int i; | 3029 EMACS_INT i; |
3024 int nargs = len + len - 1; | 3030 EMACS_INT nargs = len + len - 1; |
3025 | 3031 |
3026 if (len == 0) return build_string (""); | 3032 if (len == 0) return build_string (""); |
3027 | 3033 |
3028 args = alloca_array (Lisp_Object, nargs); | 3034 args = alloca_array (Lisp_Object, nargs); |
3029 | 3035 |
3310 If feature FEATURE is not loaded, load it from FILENAME. | 3316 If feature FEATURE is not loaded, load it from FILENAME. |
3311 If FEATURE is not a member of the list `features', then the feature | 3317 If FEATURE is not a member of the list `features', then the feature |
3312 is not loaded; so load the file FILENAME. | 3318 is not loaded; so load the file FILENAME. |
3313 If FILENAME is omitted, the printname of FEATURE is used as the file name. | 3319 If FILENAME is omitted, the printname of FEATURE is used as the file name. |
3314 */ | 3320 */ |
3315 (feature, file_name)) | 3321 (feature, filename)) |
3316 { | 3322 { |
3317 Lisp_Object tem; | 3323 Lisp_Object tem; |
3318 CHECK_SYMBOL (feature); | 3324 CHECK_SYMBOL (feature); |
3319 tem = Fmemq (feature, Vfeatures); | 3325 tem = Fmemq (feature, Vfeatures); |
3320 LOADHIST_ATTACH (Fcons (Qrequire, feature)); | 3326 LOADHIST_ATTACH (Fcons (Qrequire, feature)); |
3326 | 3332 |
3327 /* Value saved here is to be restored into Vautoload_queue */ | 3333 /* Value saved here is to be restored into Vautoload_queue */ |
3328 record_unwind_protect (un_autoload, Vautoload_queue); | 3334 record_unwind_protect (un_autoload, Vautoload_queue); |
3329 Vautoload_queue = Qt; | 3335 Vautoload_queue = Qt; |
3330 | 3336 |
3331 call4 (Qload, NILP (file_name) ? Fsymbol_name (feature) : file_name, | 3337 call4 (Qload, NILP (filename) ? Fsymbol_name (feature) : filename, |
3332 Qnil, Qt, Qnil); | 3338 Qnil, Qt, Qnil); |
3333 | 3339 |
3334 tem = Fmemq (feature, Vfeatures); | 3340 tem = Fmemq (feature, Vfeatures); |
3335 if (NILP (tem)) | 3341 if (NILP (tem)) |
3336 error ("Required feature %s was not provided", | 3342 error ("Required feature %s was not provided", |
3585 if ((len) > MAX_ALLOCA) \ | 3591 if ((len) > MAX_ALLOCA) \ |
3586 unbind_to (speccount, Qnil); \ | 3592 unbind_to (speccount, Qnil); \ |
3587 } while (0) | 3593 } while (0) |
3588 | 3594 |
3589 DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /* | 3595 DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /* |
3590 Base64-encode the region between BEG and END. | 3596 Base64-encode the region between START and END. |
3591 Return the length of the encoded text. | 3597 Return the length of the encoded text. |
3592 Optional third argument NO-LINE-BREAK means do not break long lines | 3598 Optional third argument NO-LINE-BREAK means do not break long lines |
3593 into shorter lines. | 3599 into shorter lines. |
3594 */ | 3600 */ |
3595 (beg, end, no_line_break)) | 3601 (start, end, no_line_break)) |
3596 { | 3602 { |
3597 Bufbyte *encoded; | 3603 Bufbyte *encoded; |
3598 Bytind encoded_length; | 3604 Bytind encoded_length; |
3599 Charcount allength, length; | 3605 Charcount allength, length; |
3600 struct buffer *buf = current_buffer; | 3606 struct buffer *buf = current_buffer; |
3601 Bufpos begv, zv, old_pt = BUF_PT (buf); | 3607 Bufpos begv, zv, old_pt = BUF_PT (buf); |
3602 Lisp_Object input; | 3608 Lisp_Object input; |
3603 int speccount = specpdl_depth(); | 3609 int speccount = specpdl_depth(); |
3604 | 3610 |
3605 get_buffer_range_char (buf, beg, end, &begv, &zv, 0); | 3611 get_buffer_range_char (buf, start, end, &begv, &zv, 0); |
3606 barf_if_buffer_read_only (buf, begv, zv); | 3612 barf_if_buffer_read_only (buf, begv, zv); |
3607 | 3613 |
3608 /* We need to allocate enough room for encoding the text. | 3614 /* We need to allocate enough room for encoding the text. |
3609 We need 33 1/3% more space, plus a newline every 76 | 3615 We need 33 1/3% more space, plus a newline every 76 |
3610 characters, and then we round up. */ | 3616 characters, and then we round up. */ |
3637 return make_int (encoded_length); | 3643 return make_int (encoded_length); |
3638 } | 3644 } |
3639 | 3645 |
3640 DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 2, 0, /* | 3646 DEFUN ("base64-encode-string", Fbase64_encode_string, 1, 2, 0, /* |
3641 Base64 encode STRING and return the result. | 3647 Base64 encode STRING and return the result. |
3648 Optional argument NO-LINE-BREAK means do not break long lines | |
3649 into shorter lines. | |
3642 */ | 3650 */ |
3643 (string, no_line_break)) | 3651 (string, no_line_break)) |
3644 { | 3652 { |
3645 Charcount allength, length; | 3653 Charcount allength, length; |
3646 Bytind encoded_length; | 3654 Bytind encoded_length; |
3665 XMALLOC_UNBIND (encoded, allength, speccount); | 3673 XMALLOC_UNBIND (encoded, allength, speccount); |
3666 return result; | 3674 return result; |
3667 } | 3675 } |
3668 | 3676 |
3669 DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /* | 3677 DEFUN ("base64-decode-region", Fbase64_decode_region, 2, 2, "r", /* |
3670 Base64-decode the region between BEG and END. | 3678 Base64-decode the region between START and END. |
3671 Return the length of the decoded text. | 3679 Return the length of the decoded text. |
3672 If the region can't be decoded, return nil and don't modify the buffer. | 3680 If the region can't be decoded, return nil and don't modify the buffer. |
3673 Characters out of the base64 alphabet are ignored. | 3681 Characters out of the base64 alphabet are ignored. |
3674 */ | 3682 */ |
3675 (beg, end)) | 3683 (start, end)) |
3676 { | 3684 { |
3677 struct buffer *buf = current_buffer; | 3685 struct buffer *buf = current_buffer; |
3678 Bufpos begv, zv, old_pt = BUF_PT (buf); | 3686 Bufpos begv, zv, old_pt = BUF_PT (buf); |
3679 Bufbyte *decoded; | 3687 Bufbyte *decoded; |
3680 Bytind decoded_length; | 3688 Bytind decoded_length; |
3681 Charcount length, cc_decoded_length; | 3689 Charcount length, cc_decoded_length; |
3682 Lisp_Object input; | 3690 Lisp_Object input; |
3683 int speccount = specpdl_depth(); | 3691 int speccount = specpdl_depth(); |
3684 | 3692 |
3685 get_buffer_range_char (buf, beg, end, &begv, &zv, 0); | 3693 get_buffer_range_char (buf, start, end, &begv, &zv, 0); |
3686 barf_if_buffer_read_only (buf, begv, zv); | 3694 barf_if_buffer_read_only (buf, begv, zv); |
3687 | 3695 |
3688 length = zv - begv; | 3696 length = zv - begv; |
3689 | 3697 |
3690 input = make_lisp_buffer_input_stream (buf, begv, zv, 0); | 3698 input = make_lisp_buffer_input_stream (buf, begv, zv, 0); |