Make add-face-text-property not be destructive on strings

* src/textprop.c (add_properties): Take a parameter to say whether
it's allowed to be destructive or not (bug#20153).
(add_text_properties_1): Ditto.
(Fadd_face_text_property): Use this to say that it shouldn't
modify face properties on strings destructively.  This avoids
altering the face properties of one string when altering them on a
copy of the string.

1 files changed, 23 insertions, 9 deletions

diff --git a/src/textprop.c b/src/textprop.c
index d36b9e14a69..13cd87ac473 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -358,12 +358,15 @@ set_properties (Lisp_Object properties, INTERVAL interval, Lisp_Object object)
 
    OBJECT should be the string or buffer the interval is in.
 
+   If DESTRUCTIVE, the function is allowed to reuse list values in the
+   properties.
+
    Return true if this changes I (i.e., if any members of PLIST
    are actually added to I's plist) */
 
 static bool
 add_properties (Lisp_Object plist, INTERVAL i, Lisp_Object object,
-                enum property_set_type set_type)
+                enum property_set_type set_type, bool destructive)
 {
   Lisp_Object tail1, tail2, sym1, val1;
   bool changed = false;
@@ -414,7 +417,15 @@ 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), list1 (val1));
+                  {
+                    /* Appending. */
+                    if (destructive)
+                      nconc2 (Fcar (this_cdr), list1 (val1));
+                    else
+                      Fsetcar (this_cdr, CALLN (Fappend,
+                                                Fcar (this_cdr),
+                                                list1 (val1)));
+                  }
               else {
                 /* The previous value is a single value, so make it
                    into a list. */
@@ -1140,7 +1151,8 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT.  */)
 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) {
+                       enum property_set_type set_type,
+                       bool destructive) {
   /* Ensure we run the modification hooks for the right buffer,
      without switching buffers twice (bug 36190).  FIXME: Switching
      buffers is slow and often unnecessary.  */
@@ -1150,7 +1162,8 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
       record_unwind_current_buffer ();
       set_buffer_internal (XBUFFER (object));
       return unbind_to (count, add_text_properties_1 (start, end, properties,
-                                                      object, set_type));
+                                                      object, set_type,
+                                                      destructive));
     }
 
   INTERVAL i, unchanged;
@@ -1236,7 +1249,7 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
 
           if (LENGTH (i) == len)
             {
-              add_properties (properties, i, object, set_type);
+              add_properties (properties, i, object, set_type, destructive);
               if (BUFFERP (object))
                 signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
                                      XFIXNUM (end) - XFIXNUM (start));
@@ -1247,7 +1260,7 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
           unchanged = i;
           i = split_interval_left (unchanged, len);
           copy_properties (unchanged, i);
-          add_properties (properties, i, object, set_type);
+          add_properties (properties, i, object, set_type, destructive);
           if (BUFFERP (object))
             signal_after_change (XFIXNUM (start), XFIXNUM (end) - XFIXNUM (start),
                                  XFIXNUM (end) - XFIXNUM (start));
@@ -1255,7 +1268,7 @@ add_text_properties_1 (Lisp_Object start, Lisp_Object end,
         }
 
       len -= LENGTH (i);
-      modified |= add_properties (properties, i, object, set_type);
+      modified |= add_properties (properties, i, object, set_type, destructive);
       i = next_interval (i);
     }
 }
@@ -1275,7 +1288,7 @@ Return t if any property value actually changed, nil otherwise.  */)
    Lisp_Object object)
 {
   return add_text_properties_1 (start, end, properties, object,
-                                TEXT_PROPERTY_REPLACE);
+                                TEXT_PROPERTY_REPLACE, true);
 }
 
 /* Callers note, this can GC when OBJECT is a buffer (or nil).  */
@@ -1337,7 +1350,8 @@ into it.  */)
   add_text_properties_1 (start, end, properties, object,
                          (NILP (append)
                           ? TEXT_PROPERTY_PREPEND
-                          : TEXT_PROPERTY_APPEND));
+                          : TEXT_PROPERTY_APPEND),
+                         !STRINGP (object));
   return Qnil;
 }