[Emacs-diffs] trunk r113020: Implement new function `add-face-text-property'

[Lars Ingebrigtsen]

------------------------------------------------------------
revno: 113020
revision-id: address@hidden
parent: address@hidden
committer: Lars Magne Ingebrigtsen <address@hidden>
branch nick: trunk
timestamp: Mon 2013-06-17 17:28:22 +0200
message:
  Implement new function `add-face-text-property'
  
  * doc/lispref/text.texi (Changing Properties): Document 
`add-face-text-property'.
  
  * src/textprop.c (property_set_type): New enum.
  (add_properties): Allow appending/prepending text properties.
  (add_text_properties_1): Factored out of Fadd_text_properties.
  (Fadd_text_properties): Moved all the code into
  add_text_properties_1.
  (Fadd_face_text_property): New function that calls
  add_text_properties_1.
modified:
  doc/lispref/ChangeLog          changelog-20091113204419-o5vbwnq5f7feedwu-6155
  doc/lispref/text.texi          text.texi-20091113204419-o5vbwnq5f7feedwu-6215
  etc/NEWS                       news-20100311060928-aoit31wvzf25yr1z-1
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/textprop.c                 textprop.c-20091113204419-o5vbwnq5f7feedwu-512

=== modified file 'doc/lispref/ChangeLog'
--- a/doc/lispref/ChangeLog     2013-06-17 15:07:45 +0000
+++ b/doc/lispref/ChangeLog     2013-06-17 15:28:22 +0000
@@ -1,3 +1,7 @@
+2013-06-17  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * text.texi (Changing Properties): Document `add-face-text-property'.
+
 2013-06-17  Kenichi Handa  <address@hidden>
 
        * display.texi (Face Attributes): Refer to "Low-Level font" (not

=== modified file 'doc/lispref/text.texi'
--- a/doc/lispref/text.texi     2013-04-06 07:39:48 +0000
+++ b/doc/lispref/text.texi     2013-06-17 15:28:22 +0000
@@ -2805,6 +2805,28 @@
 Do not rely on the return value of this function.
 @end defun
 
address@hidden add-face-text-property start end face &optional appendp object
address@hidden text attributes can be combined.  If you want to make a
+section both italic and green, you can either define a new face that
+have those attributes, or you can add both these attributes separately
+to text:
+
address@hidden
+(add-face-text-property @var{start} @var{end} 'italic)
+(add-face-text-property @var{start} @var{end} '(:foreground "#00ff00"))
address@hidden example
+
+The attribute is (by default) prepended to the list of face
+attributes, and the first attribute of the same type takes
+presedence.  So if you have two @code{:foreground} specifications, the
+first one will take effect.
+
+If you pass in @var{appendp}, the attribute will be appended instead
+of prepended, which means that it will have no effect if there is
+already an attribute of the same type.
+
address@hidden defun
+
   The easiest way to make a string with text properties
 is with @code{propertize}:
 

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2013-06-17 00:52:24 +0000
+++ b/etc/NEWS  2013-06-17 15:28:22 +0000
@@ -103,6 +103,9 @@
 using the scroll bar (i.e. dragging the thumb down even when the end
 of the buffer is visible).
 
+** New function `add-face-text-property' has been added, which can be
+used to conveniently prepend/append new face attributes to text.
+
 ** In compiled Lisp files, the header no longer includes a timestamp.
 
 ** Multi-monitor support has been added.

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2013-06-17 06:03:19 +0000
+++ b/src/ChangeLog     2013-06-17 15:28:22 +0000
@@ -1,3 +1,13 @@
+2013-06-17  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * textprop.c (property_set_type): New enum.
+       (add_properties): Allow appending/prepending text properties.
+       (add_text_properties_1): Factored out of Fadd_text_properties.
+       (Fadd_text_properties): Moved all the code into
+       add_text_properties_1.
+       (Fadd_face_text_property): New function that calls
+       add_text_properties_1.
+
 2013-06-17  Paul Eggert  <address@hidden>
 
        Move functions from lisp.h to individual modules when possible.

=== modified file 'src/textprop.c'
--- a/src/textprop.c    2013-06-17 06:03:19 +0000
+++ b/src/textprop.c    2013-06-17 15:28:22 +0000
@@ -60,6 +60,13 @@
 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;
 
@@ -370,7 +377,8 @@
    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;
@@ -416,7 +424,30 @@
              }
 
            /* 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), Fcons (val1, Qnil));
+             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)));
+               else
+                 Fsetcar (this_cdr,
+                          Fcons (Fcar (this_cdr), Fcons (val1, Qnil)));
+             }
+           }
            changed = 1;
            break;
          }
@@ -1124,19 +1155,12 @@
     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;
@@ -1230,7 +1254,7 @@
 
          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));
@@ -1241,7 +1265,7 @@
          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));
@@ -1249,13 +1273,31 @@
        }
 
       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.
@@ -1287,6 +1329,29 @@
 }
 
 
+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
+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)
+{
+  add_text_properties_1 (start, end,
+                        Fcons (Qface, Fcons (face, Qnil)),
+                        object,
+                        NILP (appendp)? 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.
@@ -2292,6 +2357,7 @@
   DEFSYM (Qforeground, "foreground");
   DEFSYM (Qbackground, "background");
   DEFSYM (Qfont, "font");
+  DEFSYM (Qface, "face");
   DEFSYM (Qstipple, "stipple");
   DEFSYM (Qunderline, "underline");
   DEFSYM (Qread_only, "read-only");
@@ -2326,6 +2392,7 @@
   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);