]> code.delx.au - gnu-emacs/blobdiff - src/textprop.c
(Fprevious_single_char_property_change): Don't do arithmetic directly on lisp
[gnu-emacs] / src / textprop.c
index 14cebd69d6438bfe63254c1cc46ce2ddc12b2025..a14480bf2942028c58cf5b71291dd78c0fc8d784 100644 (file)
@@ -1,5 +1,5 @@
 /* Interface code for dealing with text properties.
-   Copyright (C) 1993, 1994, 1995, 1997 Free Software Foundation, Inc.
+   Copyright (C) 1993, 1994, 1995, 1997, 1999 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -46,8 +46,6 @@ Boston, MA 02111-1307, USA.  */
   necessary for the system to remain consistent.  This requirement
   is enforced by the subrs installing properties onto the intervals.  */
 
-/* The rest of the file is within this conditional */
-#ifdef USE_TEXT_PROPERTIES
 \f
 /* Types of hooks.  */
 Lisp_Object Qmouse_left;
@@ -71,6 +69,7 @@ Lisp_Object Qfront_sticky, Qrear_nonsticky;
 
 Lisp_Object Vinhibit_point_motion_hooks;
 Lisp_Object Vdefault_text_properties;
+Lisp_Object Vtext_property_default_nonsticky;
 
 /* verify_interval_modification saves insertion hooks here
    to be run later by report_interval_modification.  */
@@ -677,33 +676,37 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.")
 }
 
 
-/* Value is the position in OBJECT after POS where the value of
-   property PROP changes.  OBJECT must be a string or buffer.  If
-   OBJECT is nil, use the current buffer.  LIMIT if not nil limits the
-   search.  */
-
-Lisp_Object
-next_single_char_property_change (pos, prop, object, limit)
-     Lisp_Object prop, pos, object, limit;
+DEFUN ("next-single-char-property-change", Fnext_single_char_property_change,
+       Snext_single_char_property_change, 2, 4, 0,
+  "Return the position of next text property or overlay change for a specific property.\n\
+Scans characters forward from POSITION till it finds\n\
+a change in the PROP property, then returns the position of the change.\n\
+The optional third argument OBJECT is the string or buffer to scan.\n\
+The property values are compared with `eq'.\n\
+Return nil if the property is constant all the way to the end of OBJECT.\n\
+If the value is non-nil, it is a position greater than POSITION, never equal.\n\n\
+If the optional fourth argument LIMIT is non-nil, don't search\n\
+past position LIMIT; return LIMIT if nothing is found before LIMIT.")
+  (position, prop, object, limit)
+     Lisp_Object prop, position, object, limit;
 {
   if (STRINGP (object))
     {
-      pos = Fnext_single_property_change (pos, prop, object, limit);
-      if (NILP (pos))
+      position = Fnext_single_property_change (position, prop, object, limit);
+      if (NILP (position))
        {
          if (NILP (limit))
-           pos = make_number (XSTRING (object)->size);
+           position = make_number (XSTRING (object)->size);
          else
-           pos = limit;
+           position = limit;
        }
     }
   else
     {
       Lisp_Object initial_value, value;
-      struct buffer *old_current_buffer = NULL;
       int count = specpdl_ptr - specpdl;
 
-      if (!NILP (object))
+      if (! NILP (object))
        CHECK_BUFFER (object, 0);
       
       if (BUFFERP (object) && current_buffer != XBUFFER (object))
@@ -712,12 +715,22 @@ next_single_char_property_change (pos, prop, object, limit)
          Fset_buffer (object);
        }
 
-      initial_value = Fget_char_property (pos, prop, object);
+      initial_value = Fget_char_property (position, prop, object);
       
-      while (XFASTINT (pos) < XFASTINT (limit))
+      if (NILP (limit))
+       XSETFASTINT (limit, BUF_ZV (current_buffer));
+      else
+       CHECK_NUMBER_COERCE_MARKER (limit, 0);
+
+      for (;;)
        {
-         pos = Fnext_char_property_change (pos, limit);
-         value = Fget_char_property (pos, prop, object);
+         position = Fnext_char_property_change (position, limit);
+         if (XFASTINT (position) >= XFASTINT (limit)) {
+           position = limit;
+           break;
+         }
+
+         value = Fget_char_property (position, prop, object);
          if (!EQ (value, initial_value))
            break;
        }
@@ -725,10 +738,87 @@ next_single_char_property_change (pos, prop, object, limit)
       unbind_to (count, Qnil);
     }
 
-  return pos;
+  return position;
 }
 
+DEFUN ("previous-single-char-property-change",
+       Fprevious_single_char_property_change,
+       Sprevious_single_char_property_change, 2, 4, 0,
+  "Return the position of previous text property or overlay change for a specific property.\n\
+Scans characters backward from POSITION till it finds\n\
+a change in the PROP property, then returns the position of the change.\n\
+The optional third argument OBJECT is the string or buffer to scan.\n\
+The property values are compared with `eq'.\n\
+Return nil if the property is constant all the way to the start of OBJECT.\n\
+If the value is non-nil, it is a position less than POSITION, never equal.\n\n\
+If the optional fourth argument LIMIT is non-nil, don't search\n\
+back past position LIMIT; return LIMIT if nothing is found before LIMIT.")
+  (position, prop, object, limit)
+     Lisp_Object prop, position, object, limit;
+{
+  if (STRINGP (object))
+    {
+      position = Fprevious_single_property_change (position, prop, object, limit);
+      if (NILP (position))
+       {
+         if (NILP (limit))
+           position = make_number (XSTRING (object)->size);
+         else
+           position = limit;
+       }
+    }
+  else
+    {
+      int count = specpdl_ptr - specpdl;
 
+      if (! NILP (object))
+       CHECK_BUFFER (object, 0);
+      
+      if (BUFFERP (object) && current_buffer != XBUFFER (object))
+       {
+         record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+         Fset_buffer (object);
+       }
+      
+      if (NILP (limit))
+       XSETFASTINT (limit, BUF_BEGV (current_buffer));
+      else
+       CHECK_NUMBER_COERCE_MARKER (limit, 0);
+
+      if (XFASTINT (position) <= XFASTINT (limit))
+       position = limit;
+      else
+       {
+         Lisp_Object initial_value =
+           Fget_char_property (make_number (XFASTINT (position) - 1),
+                               prop, object);
+      
+         for (;;)
+           {
+             position = Fprevious_char_property_change (position, limit);
+
+             if (XFASTINT (position) <= XFASTINT (limit))
+               {
+                 position = limit;
+                 break;
+               }
+             else
+               {
+                 Lisp_Object value =
+                   Fget_char_property (make_number (XFASTINT (position) - 1),
+                                       prop, object);
+
+                 if (!EQ (value, initial_value))
+                   break;
+               }
+           }
+       }
+
+      unbind_to (count, Qnil);
+    }
+
+  return position;
+}
 \f
 DEFUN ("next-property-change", Fnext_property_change,
        Snext_property_change, 1, 3, 0,
@@ -1088,6 +1178,21 @@ The optional fourth argument, OBJECT,\n\
 is the string or buffer containing the text.")
   (start, end, properties, object)
      Lisp_Object start, end, properties, object;
+{
+  return set_text_properties (start, end, properties, object, Qt);
+}
+
+
+/* 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.
+   SIGNAL_AFTER_CHANGE_P nil means don't signal after changes.  Value
+   is non-nil if properties were replaced; it is nil if there weren't
+   any properties to replace.  */
+
+Lisp_Object
+set_text_properties (start, end, properties, object, signal_after_change_p)
+     Lisp_Object start, end, properties, object, signal_after_change_p;
 {
   register INTERVAL i, unchanged;
   register INTERVAL prev_changed = NULL_INTERVAL;
@@ -1150,7 +1255,7 @@ is the string or buffer containing the text.")
          copy_properties (unchanged, i);
          i = split_interval_left (i, len);
          set_properties (properties, i, object);
-         if (BUFFERP (object))
+         if (BUFFERP (object) && !NILP (signal_after_change_p))
            signal_after_change (XINT (start), XINT (end) - XINT (start),
                                 XINT (end) - XINT (start));
 
@@ -1161,7 +1266,7 @@ is the string or buffer containing the text.")
 
       if (LENGTH (i) == len)
        {
-         if (BUFFERP (object))
+         if (BUFFERP (object) && !NILP (signal_after_change_p))
            signal_after_change (XINT (start), XINT (end) - XINT (start),
                                 XINT (end) - XINT (start));
 
@@ -1190,7 +1295,7 @@ is the string or buffer containing the text.")
          set_properties (properties, i, object);
          if (!NULL_INTERVAL_P (prev_changed))
            merge_interval_left (i);
-         if (BUFFERP (object))
+         if (BUFFERP (object) && !NILP (signal_after_change_p))
            signal_after_change (XINT (start), XINT (end) - XINT (start),
                                 XINT (end) - XINT (start));
          return Qt;
@@ -1210,7 +1315,7 @@ is the string or buffer containing the text.")
       i = next_interval (i);
     }
 
-  if (BUFFERP (object))
+  if (BUFFERP (object) && !NILP (signal_after_change_p))
     signal_after_change (XINT (start), XINT (end) - XINT (start),
                         XINT (end) - XINT (start));
   return Qt;
@@ -1693,7 +1798,7 @@ verify_interval_modification (buf, start, end)
                      if (TMEM (Qread_only, tem)
                          || (NILP (Fplist_get (i->plist, Qread_only))
                              && TMEM (Qcategory, tem)))
-                       error ("Attempt to insert within read-only text");
+                       Fsignal (Qtext_read_only, Qnil);
                    }
                }
 
@@ -1713,7 +1818,7 @@ verify_interval_modification (buf, start, end)
                      if (! TMEM (Qread_only, tem)
                          && (! NILP (Fplist_get (prev->plist,Qread_only))
                              || ! TMEM (Qcategory, tem)))
-                       error ("Attempt to insert within read-only text");
+                       Fsignal (Qtext_read_only, Qnil);
                    }
                }
            }
@@ -1732,13 +1837,13 @@ verify_interval_modification (buf, start, end)
                  if (TMEM (Qread_only, tem)
                      || (NILP (Fplist_get (i->plist, Qread_only))
                          && TMEM (Qcategory, tem)))
-                   error ("Attempt to insert within read-only text");
+                   Fsignal (Qtext_read_only, Qnil);
 
                  tem = textget (prev->plist, Qrear_nonsticky);
                  if (! TMEM (Qread_only, tem)
                      && (! NILP (Fplist_get (prev->plist, Qread_only))
                          || ! TMEM (Qcategory, tem)))
-                   error ("Attempt to insert within read-only text");
+                   Fsignal (Qtext_read_only, Qnil);
                }
            }
        }
@@ -1760,7 +1865,7 @@ verify_interval_modification (buf, start, end)
       do
        {
          if (! INTERVAL_WRITABLE_P (i))
-           error ("Attempt to modify read-only text");
+           Fsignal (Qtext_read_only, Qnil);
 
          mod_hooks = textget (i->plist, Qmodification_hooks);
          if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
@@ -1817,6 +1922,17 @@ character that does not have its own value for that property.");
 This also inhibits the use of the `intangible' text property.");
   Vinhibit_point_motion_hooks = Qnil;
 
+  DEFVAR_LISP ("text-property-default-nonsticky",
+              &Vtext_property_default_nonsticky,
+    "Alist of properties vs the corresponding non-stickinesses.\n\
+Each element has the form (PROPERTY . NONSTICKINESS).\n\
+\n\
+If a character in a buffer has PROPERTY, new text inserted adjacent to\n\
+the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,\n\
+inherits it if NONSTICKINESS is nil.  The front-sticky and\n\
+rear-nonsticky properties of the character overrides NONSTICKINESS.");
+  Vtext_property_default_nonsticky = Qnil;
+
   staticpro (&interval_insert_behind_hooks);
   staticpro (&interval_insert_in_front_hooks);
   interval_insert_behind_hooks = Qnil;
@@ -1868,6 +1984,8 @@ This also inhibits the use of the `intangible' text property.");
   defsubr (&Sget_char_property);
   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);
@@ -1882,8 +2000,3 @@ This also inhibits the use of the `intangible' text property.");
 /*  defsubr (&Scopy_text_properties); */
 }
 
-#else
-
-lose -- this shouldn't be compiled if USE_TEXT_PROPERTIES isn't defined
-
-#endif /* USE_TEXT_PROPERTIES */