Mercurial > emacs

comparison src/textprop.c @ 22344:2ec50b4767ed

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handle the new convention that `position' values in a string's intervals start from zero. (validate_interval_range, interval_of, Fnext_property_change) (property_change_between_p, Fnext_single_property_change) (Fprevious_property_change, Fprevious_single_property_change): (Ftext_property_any, Ftext_property_not_all): Implement that. Undo previous change.
author Karl Heuer <kwzh@gnu.org>
date Wed, 03 Jun 1998 14:45:03 +0000
parents e179bf1418b7
children cf1cbb0e5d5b
comparison
equal deleted inserted replaced
22343:542ccfb606c3 22344:2ec50b4767ed
148 register struct Lisp_String *s = XSTRING (object); 148 register struct Lisp_String *s = XSTRING (object);
149 149
150 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end) 150 if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end)
151 && XINT (*end) <= s->size)) 151 && XINT (*end) <= s->size))
152 args_out_of_range (*begin, *end); 152 args_out_of_range (*begin, *end);
153 /* User-level Positions in strings start with 0, 153 XSETFASTINT (*begin, XFASTINT (*begin));
154 but the interval code always wants positions starting with 1. */
155 XSETFASTINT (*begin, XFASTINT (*begin) + 1);
156 if (begin != end) 154 if (begin != end)
157 XSETFASTINT (*end, XFASTINT (*end) + 1); 155 XSETFASTINT (*end, XFASTINT (*end));
158 i = s->intervals; 156 i = s->intervals;
159 157
160 if (s->size == 0) 158 if (s->size == 0)
161 return NULL_INTERVAL; 159 return NULL_INTERVAL;
162 160
477 i->plist = Qnil; 475 i->plist = Qnil;
478 return 1; 476 return 1;
479 } 477 }
480 #endif 478 #endif
481 479
482 /* Returns the interval of the POSITION in OBJECT. 480 /* Returns the interval of POSITION in OBJECT.
483 POSITION is BEG-based. */ 481 POSITION is BEG-based. */
484 482
485 INTERVAL 483 INTERVAL
486 interval_of (position, object) 484 interval_of (position, object)
487 int position; 485 int position;
507 } 505 }
508 else 506 else
509 { 507 {
510 register struct Lisp_String *s = XSTRING (object); 508 register struct Lisp_String *s = XSTRING (object);
511 509
512 /* We expect position to be 1-based. */ 510 beg = 0;
513 beg = BEG; 511 end = s->size;
514 end = s->size + BEG;
515 i = s->intervals; 512 i = s->intervals;
516 } 513 }
517 514
518 if (!(beg <= position && position <= end)) 515 if (!(beg <= position && position <= end))
519 args_out_of_range (make_number (position), make_number (position)); 516 args_out_of_range (make_number (position), make_number (position));
714 if (NULL_INTERVAL_P (next)) 711 if (NULL_INTERVAL_P (next))
715 XSETFASTINT (position, (STRINGP (object) 712 XSETFASTINT (position, (STRINGP (object)
716 ? XSTRING (object)->size 713 ? XSTRING (object)->size
717 : BUF_ZV (XBUFFER (object)))); 714 : BUF_ZV (XBUFFER (object))));
718 else 715 else
719 XSETFASTINT (position, next->position - (STRINGP (object))); 716 XSETFASTINT (position, next->position);
720 return position; 717 return position;
721 } 718 }
722 719
723 if (NULL_INTERVAL_P (i)) 720 if (NULL_INTERVAL_P (i))
724 return limit; 721 return limit;
725 722
726 next = next_interval (i); 723 next = next_interval (i);
727 724
728 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next) 725 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)
729 && (NILP (limit) 726 && (NILP (limit) || next->position < XFASTINT (limit)))
730 || next->position - (STRINGP (object)) < XFASTINT (limit)))
731 next = next_interval (next); 727 next = next_interval (next);
732 728
733 if (NULL_INTERVAL_P (next)) 729 if (NULL_INTERVAL_P (next))
734 return limit; 730 return limit;
735 if (! NILP (limit) 731 if (! NILP (limit) && !(next->position < XFASTINT (limit)))
736 && !(next->position - (STRINGP (object)) < XFASTINT (limit)))
737 return limit; 732 return limit;
738 733
739 XSETFASTINT (position, next->position - (STRINGP (object))); 734 XSETFASTINT (position, next->position);
740 return position; 735 return position;
741 } 736 }
742 737
743 /* Return 1 if there's a change in some property between BEG and END. */ 738 /* Return 1 if there's a change in some property between BEG and END. */
744 739
760 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next)) 755 while (! NULL_INTERVAL_P (next) && intervals_equal (i, next))
761 { 756 {
762 next = next_interval (next); 757 next = next_interval (next);
763 if (NULL_INTERVAL_P (next)) 758 if (NULL_INTERVAL_P (next))
764 return 0; 759 return 0;
765 if (next->position - (STRINGP (object)) >= end) 760 if (next->position >= end)
766 return 0; 761 return 0;
767 } 762 }
768 763
769 if (NULL_INTERVAL_P (next)) 764 if (NULL_INTERVAL_P (next))
770 return 0; 765 return 0;
801 796
802 here_val = textget (i->plist, prop); 797 here_val = textget (i->plist, prop);
803 next = next_interval (i); 798 next = next_interval (i);
804 while (! NULL_INTERVAL_P (next) 799 while (! NULL_INTERVAL_P (next)
805 && EQ (here_val, textget (next->plist, prop)) 800 && EQ (here_val, textget (next->plist, prop))
806 && (NILP (limit) || next->position - (STRINGP (object)) < XFASTINT (limit))) 801 && (NILP (limit) || next->position < XFASTINT (limit)))
807 next = next_interval (next); 802 next = next_interval (next);
808 803
809 if (NULL_INTERVAL_P (next)) 804 if (NULL_INTERVAL_P (next))
810 return limit; 805 return limit;
811 if (! NILP (limit) 806 if (! NILP (limit) && !(next->position < XFASTINT (limit)))
812 && !(next->position - (STRINGP (object)) < XFASTINT (limit)))
813 return limit; 807 return limit;
814 808
815 XSETFASTINT (position, next->position - (STRINGP (object))); 809 return make_number (next->position);
816 return position;
817 } 810 }
818 811
819 DEFUN ("previous-property-change", Fprevious_property_change, 812 DEFUN ("previous-property-change", Fprevious_property_change,
820 Sprevious_property_change, 1, 3, 0, 813 Sprevious_property_change, 1, 3, 0,
821 "Return the position of previous property change.\n\ 814 "Return the position of previous property change.\n\
846 i = previous_interval (i); 839 i = previous_interval (i);
847 840
848 previous = previous_interval (i); 841 previous = previous_interval (i);
849 while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i) 842 while (! NULL_INTERVAL_P (previous) && intervals_equal (previous, i)
850 && (NILP (limit) 843 && (NILP (limit)
851 || (previous->position + LENGTH (previous) - (STRINGP (object)) 844 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
852 > XFASTINT (limit))))
853 previous = previous_interval (previous); 845 previous = previous_interval (previous);
854 if (NULL_INTERVAL_P (previous)) 846 if (NULL_INTERVAL_P (previous))
855 return limit; 847 return limit;
856 if (!NILP (limit) 848 if (!NILP (limit)
857 && !(previous->position + LENGTH (previous) - (STRINGP (object)) 849 && !(previous->position + LENGTH (previous) > XFASTINT (limit)))
858 > XFASTINT (limit)))
859 return limit; 850 return limit;
860 851
861 XSETFASTINT (position, (previous->position + LENGTH (previous) 852 return make_number (previous->position + LENGTH (previous));
862 - (STRINGP (object))));
863 return position;
864 } 853 }
865 854
866 DEFUN ("previous-single-property-change", Fprevious_single_property_change, 855 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
867 Sprevious_single_property_change, 2, 4, 0, 856 Sprevious_single_property_change, 2, 4, 0,
868 "Return the position of previous property change for a specific property.\n\ 857 "Return the position of previous property change for a specific property.\n\
898 here_val = textget (i->plist, prop); 887 here_val = textget (i->plist, prop);
899 previous = previous_interval (i); 888 previous = previous_interval (i);
900 while (! NULL_INTERVAL_P (previous) 889 while (! NULL_INTERVAL_P (previous)
901 && EQ (here_val, textget (previous->plist, prop)) 890 && EQ (here_val, textget (previous->plist, prop))
902 && (NILP (limit) 891 && (NILP (limit)
903 || (previous->position + LENGTH (previous) - (STRINGP (object)) 892 || (previous->position + LENGTH (previous) > XFASTINT (limit))))
904 > XFASTINT (limit))))
905 previous = previous_interval (previous); 893 previous = previous_interval (previous);
906 if (NULL_INTERVAL_P (previous)) 894 if (NULL_INTERVAL_P (previous))
907 return limit; 895 return limit;
908 if (!NILP (limit) 896 if (!NILP (limit)
909 && !(previous->position + LENGTH (previous) - (STRINGP (object)) 897 && !(previous->position + LENGTH (previous) > XFASTINT (limit)))
910 > XFASTINT (limit)))
911 return limit; 898 return limit;
912 899
913 XSETFASTINT (position, (previous->position + LENGTH (previous) 900 return make_number (previous->position + LENGTH (previous));
914 - (STRINGP (object))));
915 return position;
916 } 901 }
917 902
918 /* Callers note, this can GC when OBJECT is a buffer (or nil). */ 903 /* Callers note, this can GC when OBJECT is a buffer (or nil). */
919 904
920 DEFUN ("add-text-properties", Fadd_text_properties, 905 DEFUN ("add-text-properties", Fadd_text_properties,
1292 if (EQ (textget (i->plist, property), value)) 1277 if (EQ (textget (i->plist, property), value))
1293 { 1278 {
1294 pos = i->position; 1279 pos = i->position;
1295 if (pos < XINT (start)) 1280 if (pos < XINT (start))
1296 pos = XINT (start); 1281 pos = XINT (start);
1297 return make_number (pos - (STRINGP (object))); 1282 return make_number (pos);
1298 } 1283 }
1299 i = next_interval (i); 1284 i = next_interval (i);
1300 } 1285 }
1301 return Qnil; 1286 return Qnil;
1302 } 1287 }
1328 break; 1313 break;
1329 if (! EQ (textget (i->plist, property), value)) 1314 if (! EQ (textget (i->plist, property), value))
1330 { 1315 {
1331 if (i->position > s) 1316 if (i->position > s)
1332 s = i->position; 1317 s = i->position;
1333 return make_number (s - (STRINGP (object))); 1318 return make_number (s);
1334 } 1319 }
1335 i = next_interval (i); 1320 i = next_interval (i);
1336 } 1321 }
1337 return Qnil; 1322 return Qnil;
1338 } 1323 }
1339 1324
1340 #if 0 /* You can use set-text-properties for this. */
1341
1342 DEFUN ("erase-text-properties", Ferase_text_properties,
1343 Serase_text_properties, 2, 3, 0,
1344 "Remove all properties from the text from START to END.\n\
1345 The optional third argument, OBJECT,\n\
1346 is the string or buffer containing the text.")
1347 (start, end, object)
1348 Lisp_Object start, end, object;
1349 {
1350 register INTERVAL i;
1351 register INTERVAL prev_changed = NULL_INTERVAL;
1352 register int s, len, modified;
1353
1354 if (NILP (object))
1355 XSETBUFFER (object, current_buffer);
1356
1357 i = validate_interval_range (object, &start, &end, soft);
1358 if (NULL_INTERVAL_P (i))
1359 return Qnil;
1360
1361 s = XINT (start);
1362 len = XINT (end) - s;
1363
1364 if (i->position != s)
1365 {
1366 register int got;
1367 register INTERVAL unchanged = i;
1368
1369 /* If there are properties here, then this text will be modified. */
1370 if (! NILP (i->plist))
1371 {
1372 i = split_interval_right (unchanged, s - unchanged->position);
1373 i->plist = Qnil;
1374 modified++;
1375
1376 if (LENGTH (i) > len)
1377 {
1378 i = split_interval_right (i, len);
1379 copy_properties (unchanged, i);
1380 return Qt;
1381 }
1382
1383 if (LENGTH (i) == len)
1384 return Qt;
1385
1386 got = LENGTH (i);
1387 }
1388 /* If the text of I is without any properties, and contains
1389 LEN or more characters, then we may return without changing
1390 anything.*/
1391 else if (LENGTH (i) - (s - i->position) <= len)
1392 return Qnil;
1393 /* The amount of text to change extends past I, so just note
1394 how much we've gotten. */
1395 else
1396 got = LENGTH (i) - (s - i->position);
1397
1398 len -= got;
1399 prev_changed = i;
1400 i = next_interval (i);
1401 }
1402
1403 /* We are starting at the beginning of an interval, I. */
1404 while (len > 0)
1405 {
1406 if (LENGTH (i) >= len)
1407 {
1408 /* If I has no properties, simply merge it if possible. */
1409 if (NILP (i->plist))
1410 {
1411 if (! NULL_INTERVAL_P (prev_changed))
1412 merge_interval_left (i);
1413
1414 return modified ? Qt : Qnil;
1415 }
1416
1417 if (LENGTH (i) > len)
1418 i = split_interval_left (i, len);
1419 if (! NULL_INTERVAL_P (prev_changed))
1420 merge_interval_left (i);
1421 else
1422 i->plist = Qnil;
1423
1424 return Qt;
1425 }
1426
1427 /* Here if we still need to erase past the end of I */
1428 len -= LENGTH (i);
1429 if (NULL_INTERVAL_P (prev_changed))
1430 {
1431 modified += erase_properties (i);
1432 prev_changed = i;
1433 }
1434 else
1435 {
1436 modified += ! NILP (i->plist);
1437 /* Merging I will give it the properties of PREV_CHANGED. */
1438 prev_changed = i = merge_interval_left (i);
1439 }
1440
1441 i = next_interval (i);
1442 }
1443
1444 return modified ? Qt : Qnil;
1445 }
1446 #endif /* 0 */
1447
1448 /* I don't think this is the right interface to export; how often do you 1325 /* I don't think this is the right interface to export; how often do you
1449 want to do something like this, other than when you're copying objects 1326 want to do something like this, other than when you're copying objects
1450 around? 1327 around?
1451 1328
1452 I think it would be better to have a pair of functions, one which 1329 I think it would be better to have a pair of functions, one which
1458 Optional sixth argument PROP causes only that property to be copied. 1335 Optional sixth argument PROP causes only that property to be copied.
1459 Properties are copied to DEST as if by `add-text-properties'. 1336 Properties are copied to DEST as if by `add-text-properties'.
1460 Return t if any property value actually changed, nil otherwise. */ 1337 Return t if any property value actually changed, nil otherwise. */
1461 1338
1462 /* Note this can GC when DEST is a buffer. */ 1339 /* Note this can GC when DEST is a buffer. */
1463 1340
1464 Lisp_Object 1341 Lisp_Object
1465 copy_text_properties (start, end, src, pos, dest, prop) 1342 copy_text_properties (start, end, src, pos, dest, prop)
1466 Lisp_Object start, end, src, pos, dest, prop; 1343 Lisp_Object start, end, src, pos, dest, prop;
1467 { 1344 {
1468 INTERVAL i; 1345 INTERVAL i;