X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/61655fd96ce959e47ad8d047387e5585843fc789..2bfa3d3e1fb347ba76bddf77f3e288049635821d:/src/textprop.c?ds=sidebyside diff --git a/src/textprop.c b/src/textprop.c index cc364d5a38..d7b58c9134 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -1,5 +1,5 @@ /* Interface code for dealing with text properties. - Copyright (C) 1993-1995, 1997, 1999-2013 Free Software Foundation, + Copyright (C) 1993-1995, 1997, 1999-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -60,6 +60,13 @@ Lisp_Object Qinvisible, Qintangible, Qmouse_face; static Lisp_Object Qread_only; Lisp_Object Qminibuffer_prompt; +enum property_set_type +{ + TEXT_PROPERTY_REPLACE, + TEXT_PROPERTY_PREPEND, + TEXT_PROPERTY_APPEND +}; + /* Sticky properties. */ Lisp_Object Qfront_sticky, Qrear_nonsticky; @@ -86,18 +93,36 @@ text_read_only (Lisp_Object propval) xsignal0 (Qtext_read_only); } -/* Prepare to modify the region of BUFFER from START to END. */ +/* Prepare to modify the text properties of BUFFER from START to END. */ static void -modify_region (Lisp_Object buffer, Lisp_Object start, Lisp_Object end) +modify_text_properties (Lisp_Object buffer, Lisp_Object start, Lisp_Object end) { + ptrdiff_t b = XINT (start), e = XINT (end); struct buffer *buf = XBUFFER (buffer), *old = current_buffer; set_buffer_internal (buf); - modify_region_1 (XINT (start), XINT (end), true); + + prepare_to_modify_buffer_1 (b, e, NULL); + + BUF_COMPUTE_UNCHANGED (buf, b - 1, e); + if (MODIFF <= SAVE_MODIFF) + record_first_change (); + MODIFF++; + + bset_point_before_scroll (current_buffer, Qnil); + set_buffer_internal (old); } +/* Complain if object is not string or buffer type. */ + +static void +CHECK_STRING_OR_BUFFER (Lisp_Object x) +{ + CHECK_TYPE (STRINGP (x) || BUFFERP (x), Qbuffer_or_string_p, x); +} + /* Extract the interval at the position pointed to by BEGIN from OBJECT, a string or buffer. Additionally, check that the positions pointed to by BEGIN and END are within the bounds of OBJECT, and @@ -211,7 +236,7 @@ validate_plist (Lisp_Object list) return list; } - return Fcons (list, Fcons (Qnil, Qnil)); + return list2 (list, Qnil); } /* Return true if interval I has all the properties, @@ -362,7 +387,8 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object) are actually added to I's plist) */ static bool -add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object) +add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object, + enum property_set_type set_type) { Lisp_Object tail1, tail2, sym1, val1; bool changed = 0; @@ -408,7 +434,28 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object) } /* I's property has a different value -- change it */ - Fsetcar (this_cdr, val1); + if (set_type == TEXT_PROPERTY_REPLACE) + Fsetcar (this_cdr, val1); + else { + if (CONSP (Fcar (this_cdr)) && + /* Special-case anonymous face properties. */ + (! EQ (sym1, Qface) || + NILP (Fkeywordp (Fcar (Fcar (this_cdr)))))) + /* The previous value is a list, so prepend (or + append) the new value to this list. */ + if (set_type == TEXT_PROPERTY_PREPEND) + Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr))); + else + nconc2 (Fcar (this_cdr), list1 (val1)); + else { + /* The previous value is a single value, so make it + into a list. */ + if (set_type == TEXT_PROPERTY_PREPEND) + Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr))); + else + Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1)); + } + } changed = 1; break; } @@ -765,7 +812,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) else { Lisp_Object initial_value, value; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); if (! NILP (object)) CHECK_BUFFER (object); @@ -806,7 +853,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) break; } - unbind_to (count, Qnil); + dynwind_end (); } return position; @@ -848,7 +895,7 @@ position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */) } else { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); if (! NILP (object)) CHECK_BUFFER (object); @@ -899,7 +946,7 @@ position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */) } } - unbind_to (count, Qnil); + dynwind_end (); } return position; @@ -1116,19 +1163,12 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT. */) return make_number (previous->position + LENGTH (previous)); } -/* Callers note, this can GC when OBJECT is a buffer (or nil). */ +/* Used by add-text-properties and add-face-text-property. */ -DEFUN ("add-text-properties", Fadd_text_properties, - Sadd_text_properties, 3, 4, 0, - doc: /* Add properties to the text from START to END. -The third argument PROPERTIES is a property list -specifying the property values to add. If the optional fourth argument -OBJECT is a buffer (or nil, which means the current buffer), -START and END are buffer positions (integers or markers). -If OBJECT is a string, START and END are 0-based indices into it. -Return t if any property value actually changed, nil otherwise. */) - (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object) -{ +static Lisp_Object +add_text_properties_1 (Lisp_Object start, Lisp_Object end, + Lisp_Object properties, Lisp_Object object, + enum property_set_type set_type) { INTERVAL i, unchanged; ptrdiff_t s, len; bool modified = 0; @@ -1162,7 +1202,7 @@ Return t if any property value actually changed, nil otherwise. */) do { if (got >= len) - RETURN_UNGCPRO (Qnil); + return Qnil; len -= got; i = next_interval (i); got = LENGTH (i); @@ -1183,9 +1223,9 @@ Return t if any property value actually changed, nil otherwise. */) ptrdiff_t prev_total_length = TOTAL_LENGTH (i); ptrdiff_t prev_pos = i->position; - modify_region (object, start, end); + modify_text_properties (object, start, end); /* If someone called us recursively as a side effect of - modify_region, and changed the intervals behind our back + modify_text_properties, and changed the intervals behind our back (could happen if lock_file, called by prepare_to_modify_buffer, triggers redisplay, and that calls add-text-properties again in the same buffer), we cannot continue with I, because its @@ -1222,7 +1262,7 @@ Return t if any property value actually changed, nil otherwise. */) if (LENGTH (i) == len) { - add_properties (properties, i, object); + add_properties (properties, i, object, set_type); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), XINT (end) - XINT (start)); @@ -1233,7 +1273,7 @@ Return t if any property value actually changed, nil otherwise. */) unchanged = i; i = split_interval_left (unchanged, len); copy_properties (unchanged, i); - add_properties (properties, i, object); + add_properties (properties, i, object, set_type); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), XINT (end) - XINT (start)); @@ -1241,13 +1281,31 @@ Return t if any property value actually changed, nil otherwise. */) } len -= LENGTH (i); - modified |= add_properties (properties, i, object); + modified |= add_properties (properties, i, object, set_type); i = next_interval (i); } } /* Callers note, this can GC when OBJECT is a buffer (or nil). */ +DEFUN ("add-text-properties", Fadd_text_properties, + Sadd_text_properties, 3, 4, 0, + doc: /* Add properties to the text from START to END. +The third argument PROPERTIES is a property list +specifying the property values to add. If the optional fourth argument +OBJECT is a buffer (or nil, which means the current buffer), +START and END are buffer positions (integers or markers). +If OBJECT is a string, START and END are 0-based indices into it. +Return t if any property value actually changed, nil otherwise. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object properties, + Lisp_Object object) +{ + return add_text_properties_1 (start, end, properties, object, + TEXT_PROPERTY_REPLACE); +} + +/* Callers note, this can GC when OBJECT is a buffer (or nil). */ + DEFUN ("put-text-property", Fput_text_property, Sput_text_property, 4, 5, 0, doc: /* Set one property of the text from START to END. @@ -1258,9 +1316,7 @@ the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it. */) (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object) { - Fadd_text_properties (start, end, - Fcons (property, Fcons (value, Qnil)), - object); + Fadd_text_properties (start, end, list2 (property, value), object); return Qnil; } @@ -1279,6 +1335,35 @@ the designated part of OBJECT. */) } +DEFUN ("add-face-text-property", Fadd_face_text_property, + Sadd_face_text_property, 3, 5, 0, + doc: /* Add the face property to the text from START to END. +FACE specifies the face to add. It should be a valid value of the +`face' property (typically a face name or a plist of face attributes +and values). + +If any text in the region already has a non-nil `face' property, those +face(s) are retained. This is done by setting the `face' property to +a list of faces, with FACE as the first element (by default) and the +pre-existing faces as the remaining elements. + +If optional fourth argument APPEND is non-nil, append FACE to the end +of the face list instead. + +If optional fifth argument OBJECT is a buffer (or nil, which means the +current buffer), START and END are buffer positions (integers or +markers). If OBJECT is a string, START and END are 0-based indices +into it. */) + (Lisp_Object start, Lisp_Object end, Lisp_Object face, + Lisp_Object append, Lisp_Object object) +{ + add_text_properties_1 (start, end, list2 (Qface, face), object, + (NILP (append) + ? TEXT_PROPERTY_PREPEND + : TEXT_PROPERTY_APPEND)); + return Qnil; +} + /* Replace properties of text from START to END with new list of properties PROPERTIES. OBJECT is the buffer or string containing the text. OBJECT nil means use the current buffer. @@ -1289,7 +1374,8 @@ the designated part of OBJECT. */) otherwise. */ Lisp_Object -set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object, Lisp_Object coherent_change_p) +set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, + Lisp_Object object, Lisp_Object coherent_change_p) { register INTERVAL i; Lisp_Object ostart, oend; @@ -1335,7 +1421,7 @@ set_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object properties, } if (BUFFERP (object) && !NILP (coherent_change_p)) - modify_region (object, start, end); + modify_text_properties (object, start, end); set_text_properties_1 (start, end, properties, object, i); @@ -1490,9 +1576,9 @@ Use `set-text-properties' if you want to remove all text properties. */) ptrdiff_t prev_total_length = TOTAL_LENGTH (i); ptrdiff_t prev_pos = i->position; - modify_region (object, start, end); + modify_text_properties (object, start, end); /* If someone called us recursively as a side effect of - modify_region, and changed the intervals behind our back + modify_text_properties, and changed the intervals behind our back (could happen if lock_file, called by prepare_to_modify_buffer, triggers redisplay, and that calls add-text-properties again in the same buffer), we cannot continue with I, because its @@ -1599,9 +1685,9 @@ Return t if any property was actually removed, nil otherwise. */) /* We are at the beginning of an interval, with len to scan. The flag `modified' records if changes have been made. - When object is a buffer, we must call modify_region before changes are - made and signal_after_change when we are done. - We call modify_region before calling remove_properties if modified == 0, + When object is a buffer, we must call modify_text_properties + before changes are made and signal_after_change when we are done. + We call modify_text_properties before calling remove_properties if modified == 0, and we call signal_after_change before returning if modified != 0. */ for (;;) { @@ -1625,7 +1711,7 @@ Return t if any property was actually removed, nil otherwise. */) else if (LENGTH (i) == len) { if (!modified && BUFFERP (object)) - modify_region (object, start, end); + modify_text_properties (object, start, end); remove_properties (Qnil, properties, i, object); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), @@ -1638,7 +1724,7 @@ Return t if any property was actually removed, nil otherwise. */) i = split_interval_left (i, len); copy_properties (unchanged, i); if (!modified && BUFFERP (object)) - modify_region (object, start, end); + modify_text_properties (object, start, end); remove_properties (Qnil, properties, i, object); if (BUFFERP (object)) signal_after_change (XINT (start), XINT (end) - XINT (start), @@ -1649,12 +1735,25 @@ Return t if any property was actually removed, nil otherwise. */) if (interval_has_some_properties_list (properties, i)) { if (!modified && BUFFERP (object)) - modify_region (object, start, end); + modify_text_properties (object, start, end); remove_properties (Qnil, properties, i, object); modified = 1; } len -= LENGTH (i); i = next_interval (i); + if (!i) + { + if (modified) + { + if (BUFFERP (object)) + signal_after_change (XINT (start), + XINT (end) - XINT (start), + XINT (end) - XINT (start)); + return Qt; + } + else + return Qnil; + } } } @@ -1740,32 +1839,30 @@ markers). If OBJECT is a string, START and END are 0-based indices into it. */ int text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer) { - Lisp_Object prev_pos, front_sticky; - bool is_rear_sticky = 1, is_front_sticky = 0; /* defaults */ + bool ignore_previous_character; + Lisp_Object prev_pos = make_number (XINT (pos) - 1); + Lisp_Object front_sticky; + bool is_rear_sticky = true, is_front_sticky = false; /* defaults */ Lisp_Object defalt = Fassq (prop, Vtext_property_default_nonsticky); if (NILP (buffer)) XSETBUFFER (buffer, current_buffer); - if (CONSP (defalt) && !NILP (XCDR (defalt))) - is_rear_sticky = 0; + ignore_previous_character = XINT (pos) <= BUF_BEGV (XBUFFER (buffer)); - if (XINT (pos) > BUF_BEGV (XBUFFER (buffer))) - /* Consider previous character. */ + if (ignore_previous_character || (CONSP (defalt) && !NILP (XCDR (defalt)))) + is_rear_sticky = false; + else { - Lisp_Object rear_non_sticky; - - prev_pos = make_number (XINT (pos) - 1); - rear_non_sticky = Fget_text_property (prev_pos, Qrear_nonsticky, buffer); + Lisp_Object rear_non_sticky + = Fget_text_property (prev_pos, Qrear_nonsticky, buffer); if (!NILP (CONSP (rear_non_sticky) ? Fmemq (prop, rear_non_sticky) : rear_non_sticky)) /* PROP is rear-non-sticky. */ - is_rear_sticky = 0; + is_rear_sticky = false; } - else - return 0; /* Consider following character. */ /* This signals an arg-out-of-range error if pos is outside the @@ -1776,7 +1873,7 @@ text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer) || (CONSP (front_sticky) && !NILP (Fmemq (prop, front_sticky)))) /* PROP is inherited from after. */ - is_front_sticky = 1; + is_front_sticky = true; /* Simple cases, where the properties are consistent. */ if (is_rear_sticky && !is_front_sticky) @@ -1790,7 +1887,7 @@ text_property_stickiness (Lisp_Object prop, Lisp_Object pos, Lisp_Object buffer) disambiguate. Basically, rear-sticky wins, _except_ if the property that would be inherited has a value of nil, in which case front-sticky wins. */ - if (XINT (pos) == BUF_BEGV (XBUFFER (buffer)) + if (ignore_previous_character || NILP (Fget_text_property (prev_pos, prop, buffer))) return 1; else @@ -1856,7 +1953,7 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_ { if (EQ (Fcar (plist), prop)) { - plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil)); + plist = list2 (prop, Fcar (Fcdr (plist))); break; } plist = Fcdr (Fcdr (plist)); @@ -1865,10 +1962,8 @@ copy_text_properties (Lisp_Object start, Lisp_Object end, Lisp_Object src, Lisp_ { /* Must defer modifications to the interval tree in case src and dest refer to the same string or buffer. */ - stuff = Fcons (Fcons (make_number (p), - Fcons (make_number (p + len), - Fcons (plist, Qnil))), - stuff); + stuff = Fcons (list3 (make_number (p), make_number (p + len), plist), + stuff); } i = next_interval (i); @@ -1934,14 +2029,13 @@ text_property_list (Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp for (; CONSP (plist); plist = Fcdr (XCDR (plist))) if (EQ (XCAR (plist), prop)) { - plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil)); + plist = list2 (prop, Fcar (XCDR (plist))); break; } if (!NILP (plist)) - result = Fcons (Fcons (make_number (s), - Fcons (make_number (s + len), - Fcons (plist, Qnil))), + result = Fcons (list3 (make_number (s), make_number (s + len), + plist), result); i = next_interval (i); @@ -2238,6 +2332,8 @@ report_interval_modification (Lisp_Object start, Lisp_Object end) void syms_of_textprop (void) { +#include "textprop.x" + DEFVAR_LISP ("default-text-properties", Vdefault_text_properties, doc: /* Property-list used as default values. The value of a property in this list is seen as the value for every @@ -2270,8 +2366,8 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and /* Text properties `syntax-table'and `display' should be nonsticky by default. */ Vtext_property_default_nonsticky - = Fcons (Fcons (intern_c_string ("syntax-table"), Qt), - Fcons (Fcons (intern_c_string ("display"), Qt), Qnil)); + = list2 (Fcons (intern_c_string ("syntax-table"), Qt), + Fcons (intern_c_string ("display"), Qt)); staticpro (&interval_insert_behind_hooks); staticpro (&interval_insert_in_front_hooks); @@ -2284,6 +2380,7 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and DEFSYM (Qforeground, "foreground"); DEFSYM (Qbackground, "background"); DEFSYM (Qfont, "font"); + DEFSYM (Qface, "face"); DEFSYM (Qstipple, "stipple"); DEFSYM (Qunderline, "underline"); DEFSYM (Qread_only, "read-only"); @@ -2302,24 +2399,4 @@ inherits it if NONSTICKINESS is nil. The `front-sticky' and DEFSYM (Qmouse_entered, "mouse-entered"); DEFSYM (Qpoint_left, "point-left"); DEFSYM (Qpoint_entered, "point-entered"); - - defsubr (&Stext_properties_at); - defsubr (&Sget_text_property); - defsubr (&Sget_char_property); - defsubr (&Sget_char_property_and_overlay); - defsubr (&Snext_char_property_change); - defsubr (&Sprevious_char_property_change); - defsubr (&Snext_single_char_property_change); - defsubr (&Sprevious_single_char_property_change); - defsubr (&Snext_property_change); - defsubr (&Snext_single_property_change); - defsubr (&Sprevious_property_change); - defsubr (&Sprevious_single_property_change); - defsubr (&Sadd_text_properties); - defsubr (&Sput_text_property); - defsubr (&Sset_text_properties); - defsubr (&Sremove_text_properties); - defsubr (&Sremove_list_of_text_properties); - defsubr (&Stext_property_any); - defsubr (&Stext_property_not_all); }