]> code.delx.au - gnu-emacs/blobdiff - src/textprop.c
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
[gnu-emacs] / src / textprop.c
index f96e6bb6e7d39bc8396d36fa0f75933b32fa6e8a..b43503dfdb8c3b00be104a1db859a35002c37ce2 100644 (file)
@@ -1,5 +1,6 @@
 /* Interface code for dealing with text properties.
-   Copyright (C) 1993, 1994, 1995, 1997, 1999 Free Software Foundation, Inc.
+   Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001
+   Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -75,6 +76,18 @@ Lisp_Object Vtext_property_default_nonsticky;
    to be run later by report_interval_modification.  */
 Lisp_Object interval_insert_behind_hooks;
 Lisp_Object interval_insert_in_front_hooks;
+
+
+/* Signal a `text-read-only' error.  This function makes it easier
+   to capture that error in GDB by putting a breakpoint on it.  */
+
+static void
+text_read_only ()
+{
+  Fsignal (Qtext_read_only, Qnil);
+}
+
+
 \f
 /* Extract the interval at the position pointed to by BEGIN from
    OBJECT, a string or buffer.  Additionally, check that the positions
@@ -557,17 +570,22 @@ If POSITION is at the end of OBJECT, the value is nil.")
   return textget (Ftext_properties_at (position, object), prop);
 }
 
-DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
-  "Return the value of POSITION's property PROP, in OBJECT.\n\
-OBJECT is optional and defaults to the current buffer.\n\
-If POSITION is at the end of OBJECT, the value is nil.\n\
-If OBJECT is a buffer, then overlay properties are considered as well as\n\
-text properties.\n\
-If OBJECT is a window, then that window's buffer is used, but window-specific\n\
-overlays are considered only if they are associated with OBJECT.")
-  (position, prop, object)
+/* Return the value of POSITION's property PROP, in OBJECT.
+   OBJECT is optional and defaults to the current buffer.
+   If OVERLAY is non-0, then in the case that the returned property is from
+   an overlay, the overlay found is returned in *OVERLAY, otherwise nil is
+   returned in *OVERLAY.
+   If POSITION is at the end of OBJECT, the value is nil.
+   If OBJECT is a buffer, then overlay properties are considered as well as
+   text properties.
+   If OBJECT is a window, then that window's buffer is used, but
+   window-specific overlays are considered only if they are associated
+   with OBJECT. */
+Lisp_Object
+get_char_property_and_overlay (position, prop, object, overlay)
      Lisp_Object position, object;
      register Lisp_Object prop;
+     Lisp_Object *overlay;
 {
   struct window *w = 0;
 
@@ -597,7 +615,7 @@ overlays are considered only if they are associated with OBJECT.")
       overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
 
       noverlays = overlays_at (posn, 0, &overlay_vec, &len,
-                              &next_overlay, NULL);
+                              &next_overlay, NULL, 0);
 
       /* If there are more than 40,
         make enough space for all, and try again.  */
@@ -606,7 +624,7 @@ overlays are considered only if they are associated with OBJECT.")
          len = noverlays;
          overlay_vec = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
          noverlays = overlays_at (posn, 0, &overlay_vec, &len,
-                                  &next_overlay, NULL);
+                                  &next_overlay, NULL, 0);
        }
       noverlays = sort_overlays (overlay_vec, noverlays, w);
 
@@ -617,20 +635,45 @@ overlays are considered only if they are associated with OBJECT.")
        {
          tem = Foverlay_get (overlay_vec[noverlays], prop);
          if (!NILP (tem))
-           return (tem);
+           {
+             if (overlay)
+               /* Return the overlay we got the property from.  */
+               *overlay = overlay_vec[noverlays];
+             return tem;
+           }
        }
     }
+
+  if (overlay)
+    /* Indicate that the return value is not from an overlay.  */
+    *overlay = Qnil;
+
   /* Not a buffer, or no appropriate overlay, so fall through to the
      simpler case.  */
-  return (Fget_text_property (position, prop, object));
+  return Fget_text_property (position, prop, object);
+}
+
+DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
+  "Return the value of POSITION's property PROP, in OBJECT.\n\
+OBJECT is optional and defaults to the current buffer.\n\
+If POSITION is at the end of OBJECT, the value is nil.\n\
+If OBJECT is a buffer, then overlay properties are considered as well as\n\
+text properties.\n\
+If OBJECT is a window, then that window's buffer is used, but window-specific\n\
+overlays are considered only if they are associated with OBJECT.")
+  (position, prop, object)
+     Lisp_Object position, object;
+     register Lisp_Object prop;
+{
+  return get_char_property_and_overlay (position, prop, object, 0);
 }
 \f
 DEFUN ("next-char-property-change", Fnext_char_property_change,
        Snext_char_property_change, 1, 2, 0,
   "Return the position of next text property or overlay change.\n\
-This scans characters forward from POSITION in OBJECT till it finds\n\
-a change in some text property, or the beginning or end of an overlay,\n\
-and returns the position of that.\n\
+This scans characters forward from POSITION till it finds a change in\n\
+some text property, or the beginning or end of an overlay, and returns\n\
+the position of that.\n\
 If none is found, the function returns (point-max).\n\
 \n\
 If the optional third argument LIMIT is non-nil, don't search\n\
@@ -653,9 +696,9 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.")
 DEFUN ("previous-char-property-change", Fprevious_char_property_change,
        Sprevious_char_property_change, 1, 2, 0,
   "Return the position of previous text property or overlay change.\n\
-Scans characters backward from POSITION in OBJECT till it finds\n\
-a change in some text property, or the beginning or end of an overlay,\n\
-and returns the position of that.\n\
+Scans characters backward from POSITION till it finds a change in some\n\
+text property, or the beginning or end of an overlay, and returns the\n\
+position of that.\n\
 If none is found, the function returns (point-max).\n\
 \n\
 If the optional third argument LIMIT is non-nil, don't search\n\
@@ -683,8 +726,8 @@ 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 property is constant all the way to the end of OBJECT, return the\n\
+last valid position in OBJECT.\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)
@@ -749,8 +792,8 @@ 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 property is constant all the way to the start of OBJECT, return the\n\
+first valid position in OBJECT.\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)
@@ -790,7 +833,8 @@ back past position LIMIT; return LIMIT if nothing is found before LIMIT.")
       else
        {
          Lisp_Object initial_value =
-           Fget_char_property (position - 1, prop, object);
+           Fget_char_property (make_number (XFASTINT (position) - 1),
+                               prop, object);
       
          for (;;)
            {
@@ -804,7 +848,8 @@ back past position LIMIT; return LIMIT if nothing is found before LIMIT.")
              else
                {
                  Lisp_Object value =
-                   Fget_char_property (position - 1, prop, object);
+                   Fget_char_property (make_number (XFASTINT (position) - 1),
+                                       prop, object);
 
                  if (!EQ (value, initial_value))
                    break;
@@ -1173,7 +1218,10 @@ DEFUN ("set-text-properties", Fset_text_properties,
   "Completely replace properties of text from START to END.\n\
 The third argument PROPERTIES is the new property list.\n\
 The optional fourth argument, OBJECT,\n\
-is the string or buffer containing the text.")
+is the string or buffer containing the text.\n\
+If OBJECT is omitted or nil, it defaults to the current buffer.\n\
+If PROPERTIES is nil, the effect is to remove all properties from\n\
+the designated part of OBJECT.")
   (start, end, properties, object)
      Lisp_Object start, end, properties, object;
 {
@@ -1690,7 +1738,7 @@ extend_property_ranges (list, old_end, new_end)
       end = XCAR (XCDR (item));
 
       if (EQ (end, old_end))
-       XCAR (XCDR (item)) = new_end;
+       XSETCAR (XCDR (item), new_end);
     }
 }
 
@@ -1752,7 +1800,7 @@ verify_interval_modification (buf, start, end)
   /* For an insert operation, check the two chars around the position.  */
   if (start == end)
     {
-      INTERVAL prev;
+      INTERVAL prev = NULL;
       Lisp_Object before, after;
 
       /* Set I to the interval containing the char after START,
@@ -1796,7 +1844,7 @@ verify_interval_modification (buf, start, end)
                      if (TMEM (Qread_only, tem)
                          || (NILP (Fplist_get (i->plist, Qread_only))
                              && TMEM (Qcategory, tem)))
-                       Fsignal (Qtext_read_only, Qnil);
+                       text_read_only ();
                    }
                }
 
@@ -1816,7 +1864,7 @@ verify_interval_modification (buf, start, end)
                      if (! TMEM (Qread_only, tem)
                          && (! NILP (Fplist_get (prev->plist,Qread_only))
                              || ! TMEM (Qcategory, tem)))
-                       Fsignal (Qtext_read_only, Qnil);
+                       text_read_only ();
                    }
                }
            }
@@ -1835,13 +1883,13 @@ verify_interval_modification (buf, start, end)
                  if (TMEM (Qread_only, tem)
                      || (NILP (Fplist_get (i->plist, Qread_only))
                          && TMEM (Qcategory, tem)))
-                   Fsignal (Qtext_read_only, Qnil);
+                   text_read_only ();
 
                  tem = textget (prev->plist, Qrear_nonsticky);
                  if (! TMEM (Qread_only, tem)
                      && (! NILP (Fplist_get (prev->plist, Qread_only))
                          || ! TMEM (Qcategory, tem)))
-                   Fsignal (Qtext_read_only, Qnil);
+                   text_read_only ();
                }
            }
        }
@@ -1863,13 +1911,16 @@ verify_interval_modification (buf, start, end)
       do
        {
          if (! INTERVAL_WRITABLE_P (i))
-           Fsignal (Qtext_read_only, Qnil);
+           text_read_only ();
 
-         mod_hooks = textget (i->plist, Qmodification_hooks);
-         if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
+         if (!inhibit_modification_hooks)
            {
-             hooks = Fcons (mod_hooks, hooks);
-             prev_mod_hooks = mod_hooks;
+             mod_hooks = textget (i->plist, Qmodification_hooks);
+             if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
+               {
+                 hooks = Fcons (mod_hooks, hooks);
+                 prev_mod_hooks = mod_hooks;
+               }
            }
 
          i = next_interval (i);
@@ -1877,15 +1928,18 @@ verify_interval_modification (buf, start, end)
       /* Keep going thru the interval containing the char before END.  */
       while (! NULL_INTERVAL_P (i) && i->position < end);
 
-      GCPRO1 (hooks);
-      hooks = Fnreverse (hooks);
-      while (! EQ (hooks, Qnil))
+      if (!inhibit_modification_hooks)
        {
-         call_mod_hooks (Fcar (hooks), make_number (start),
-                         make_number (end));
-         hooks = Fcdr (hooks);
+         GCPRO1 (hooks);
+         hooks = Fnreverse (hooks);
+         while (! EQ (hooks, Qnil))
+           {
+             call_mod_hooks (Fcar (hooks), make_number (start),
+                             make_number (end));
+             hooks = Fcdr (hooks);
+           }
+         UNGCPRO;
        }
-      UNGCPRO;
     }
 }