X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f99f7826a0303f7a40864571be7cbf84f3d4ee62..2bfa3d3e1fb347ba76bddf77f3e288049635821d:/src/textprop.c diff --git a/src/textprop.c b/src/textprop.c index e5d4fe06c6..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. @@ -93,15 +93,25 @@ 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); } @@ -226,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, @@ -436,16 +446,14 @@ add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object, if (set_type == TEXT_PROPERTY_PREPEND) Fsetcar (this_cdr, Fcons (val1, Fcar (this_cdr))); else - nconc2 (Fcar (this_cdr), Fcons (val1, Qnil)); + 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, - Fcons (val1, Fcons (Fcar (this_cdr), Qnil))); + Fsetcar (this_cdr, list2 (val1, Fcar (this_cdr))); else - Fsetcar (this_cdr, - Fcons (Fcar (this_cdr), Fcons (val1, Qnil))); + Fsetcar (this_cdr, list2 (Fcar (this_cdr), val1)); } } changed = 1; @@ -804,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); @@ -845,7 +853,7 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT. */) break; } - unbind_to (count, Qnil); + dynwind_end (); } return position; @@ -887,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); @@ -938,7 +946,7 @@ position LIMIT; return LIMIT if nothing is found before reaching LIMIT. */) } } - unbind_to (count, Qnil); + dynwind_end (); } return position; @@ -1194,7 +1202,7 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end, do { if (got >= len) - RETURN_UNGCPRO (Qnil); + return Qnil; len -= got; i = next_interval (i); got = LENGTH (i); @@ -1215,9 +1223,9 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end, 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 @@ -1308,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; } @@ -1332,23 +1338,29 @@ 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. -The third argument FACE specifies the face to add. -If any text in the region already has any face properties, this new -face property will be added to the front of the face property list. -If the optional fourth argument APPENDP is non-nil, append to the end -of the face property list instead. -If the optional fifth argument OBJECT is a buffer (or nil, which means -the current buffer), START and END are buffer positions (integers or +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 appendp, Lisp_Object object) + Lisp_Object append, Lisp_Object object) { - add_text_properties_1 (start, end, - Fcons (Qface, Fcons (face, Qnil)), - object, - NILP (appendp)? TEXT_PROPERTY_PREPEND: - TEXT_PROPERTY_APPEND); + add_text_properties_1 (start, end, list2 (Qface, face), object, + (NILP (append) + ? TEXT_PROPERTY_PREPEND + : TEXT_PROPERTY_APPEND)); return Qnil; } @@ -1362,7 +1374,8 @@ into it. */) 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; @@ -1408,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); @@ -1563,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 @@ -1672,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 (;;) { @@ -1698,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), @@ -1711,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), @@ -1722,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; + } } } @@ -1813,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 @@ -1849,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) @@ -1863,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 @@ -1929,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)); @@ -1938,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); @@ -2007,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); @@ -2311,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 @@ -2343,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); @@ -2376,25 +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 (&Sadd_face_text_property); - defsubr (&Sremove_text_properties); - defsubr (&Sremove_list_of_text_properties); - defsubr (&Stext_property_any); - defsubr (&Stext_property_not_all); }