]> code.delx.au - gnu-emacs/blobdiff - src/intervals.c
2002-08-11 Andrew Choi <akochoi@shaw.ca>
[gnu-emacs] / src / intervals.c
index 06d6d5995bdbab7c950b43c741cfc3cff28db21e..9ed2a651f55fc0416605369517585d8c2b278973 100644 (file)
@@ -1,5 +1,5 @@
 /* Code for doing intervals.
-   Copyright (C) 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc.
+   Copyright (C) 1993, 1994, 1995, 1997, 1998, 2002 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -80,8 +80,8 @@ create_root_interval (parent)
     }
   else if (STRINGP (parent))
     {
-      new->total_length = XSTRING (parent)->size;
-      XSTRING (parent)->intervals = new;
+      new->total_length = SCHARS (parent);
+      STRING_SET_INTERVALS (parent, new);
       new->position = 0;
     }
 
@@ -188,24 +188,47 @@ intervals_equal (i0, i1)
 \f
 
 /* Traverse an interval tree TREE, performing FUNCTION on each node.
+   No guarantee is made about the order of traversal.
    Pass FUNCTION two args: an interval, and ARG.  */
 
 void
-traverse_intervals (tree, position, depth, function, arg)
+traverse_intervals_noorder (tree, function, arg)
      INTERVAL tree;
-     int position, depth;
      void (* function) P_ ((INTERVAL, Lisp_Object));
      Lisp_Object arg;
 {
-  if (NULL_INTERVAL_P (tree))
-    return;
+  /* Minimize stack usage.  */
+  while (!NULL_INTERVAL_P (tree))
+    {
+      (*function) (tree, arg);
+      if (NULL_INTERVAL_P (tree->right))
+       tree = tree->left;
+      else
+       {
+         traverse_intervals_noorder (tree->left, function, arg);
+         tree = tree->right;
+       }
+    }
+}
+
+/* Traverse an interval tree TREE, performing FUNCTION on each node.
+   Pass FUNCTION two args: an interval, and ARG.  */
 
-  traverse_intervals (tree->left, position, depth + 1, function, arg);
-  position += LEFT_TOTAL_LENGTH (tree);
-  tree->position = position;
-  (*function) (tree, arg);
-  position += LENGTH (tree);
-  traverse_intervals (tree->right, position, depth + 1,  function, arg);
+void
+traverse_intervals (tree, position, function, arg)
+     INTERVAL tree;
+     int position;
+     void (* function) P_ ((INTERVAL, Lisp_Object));
+     Lisp_Object arg;
+{
+  while (!NULL_INTERVAL_P (tree))
+    {
+      traverse_intervals (tree->left, position, function, arg);
+      position += LEFT_TOTAL_LENGTH (tree);
+      tree->position = position;
+      (*function) (tree, arg);
+      position += LENGTH (tree); tree = tree->right;
+    }
 }
 \f
 #if 0
@@ -236,7 +259,7 @@ search_for_interval (i, tree)
   icount = 0;
   search_interval = i;
   found_interval = NULL_INTERVAL;
-  traverse_intervals (tree, 1, 0, &check_for_interval, Qnil);
+  traverse_intervals_noorder (tree, &check_for_interval, Qnil);
   return found_interval;
 }
 
@@ -258,7 +281,7 @@ count_intervals (i)
   icount = 0;
   idepth = 0;
   zero_length = 0;
-  traverse_intervals (i, 1, 0, &inc_interval_count, Qnil);
+  traverse_intervals_noorder (i, &inc_interval_count, Qnil);
 
   return icount;
 }
@@ -285,7 +308,7 @@ root_interval (interval)
      c           c
 */
 
-static INTERVAL
+static INLINE INTERVAL
 rotate_right (interval)
      INTERVAL interval;
 {
@@ -331,7 +354,7 @@ rotate_right (interval)
     c               c
 */
 
-static INTERVAL
+static INLINE INTERVAL
 rotate_left (interval)
      INTERVAL interval;
 {
@@ -429,7 +452,7 @@ balance_possible_root_interval (interval)
       if (BUFFERP (parent))
        BUF_INTERVALS (XBUFFER (parent)) = interval;
       else if (STRINGP (parent))
-       XSTRING (parent)->intervals = interval;
+       STRING_SET_INTERVALS (parent, interval);
     }
 
   return interval;
@@ -1112,7 +1135,7 @@ merge_properties_sticky (pleft, pright)
       tmp = Fassq (sym, Vtext_property_default_nonsticky);
       use_left = (lpresent
                  && ! (TMEM (sym, lrear)
-                       || CONSP (tmp) && ! NILP (XCDR (tmp))));
+                       || (CONSP (tmp) && ! NILP (XCDR (tmp)))));
       use_right = (TMEM (sym, rfront)
                   || (CONSP (tmp) && NILP (XCDR (tmp))));
       if (use_left && use_right)
@@ -1257,7 +1280,7 @@ delete_interval (i)
       if (BUFFERP (owner))
        BUF_INTERVALS (XBUFFER (owner)) = parent;
       else if (STRINGP (owner))
-       XSTRING (owner)->intervals = parent;
+       STRING_SET_INTERVALS (owner, parent);
       else
        abort ();
 
@@ -1657,24 +1680,22 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit)
 {
   register INTERVAL under, over, this, prev;
   register INTERVAL tree;
-  int middle;
 
   tree = BUF_INTERVALS (buffer);
 
-  /* If the new text has no properties, it becomes part of whatever
-     interval it was inserted into.  */
+  /* If the new text has no properties, then with inheritance it
+     becomes part of whatever interval it was inserted into.
+     To prevent inheritance, we must clear out the properties
+     of the newly inserted text.  */
   if (NULL_INTERVAL_P (source))
     {
       Lisp_Object buf;
-      if (!inherit && ! NULL_INTERVAL_P (tree))
+      if (!inherit && !NULL_INTERVAL_P (tree) && length > 0)
        {
-         int saved_inhibit_modification_hooks = inhibit_modification_hooks;
          XSETBUFFER (buf, buffer);
-         inhibit_modification_hooks = 1;
-         Fset_text_properties (make_number (position),
-                               make_number (position + length),
-                               Qnil, buf);
-         inhibit_modification_hooks = saved_inhibit_modification_hooks;
+         set_text_properties_1 (make_number (position),
+                                make_number (position + length),
+                                Qnil, buf, 0);
        }
       if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
        BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
@@ -1737,11 +1758,6 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit)
        = split_interval_left (this, position - under->position);
       copy_properties (under, end_unchanged);
       under->position = position;
-#if 0
-      /* This code has no effect.  */
-      prev = 0;
-      middle = 1;
-#endif /* 0 */
     }
   else
     {
@@ -1797,18 +1813,26 @@ textget (plist, prop)
      Lisp_Object plist;
      register Lisp_Object prop;
 {
-  register Lisp_Object tail, fallback;
-  fallback = Qnil;
+  return lookup_char_property (plist, prop, 1);
+}
 
-  for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
+Lisp_Object
+lookup_char_property (plist, prop, textprop)
+     Lisp_Object plist;
+     register Lisp_Object prop;
+     int textprop;
+{
+  register Lisp_Object tail, fallback = Qnil;
+
+  for (tail = plist; CONSP (tail); tail = Fcdr (XCDR (tail)))
     {
       register Lisp_Object tem;
-      tem = Fcar (tail);
+      tem = XCAR (tail);
       if (EQ (prop, tem))
-       return Fcar (Fcdr (tail));
+       return Fcar (XCDR (tail));
       if (EQ (tem, Qcategory))
        {
-         tem = Fcar (Fcdr (tail));
+         tem = Fcar (XCDR (tail));
          if (SYMBOLP (tem))
            fallback = Fget (tem, prop);
        }
@@ -1816,9 +1840,16 @@ textget (plist, prop)
 
   if (! NILP (fallback))
     return fallback;
-  if (CONSP (Vdefault_text_properties))
-    return Fplist_get (Vdefault_text_properties, prop);
-  return Qnil;
+  /* Check for alternative properties */
+  tail = Fassq (prop, Vchar_property_alias_alist);
+  if (NILP (tail))
+    return tail;
+  tail = XCDR (tail);
+  for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
+    fallback = Fplist_get (plist, XCAR (tail));
+  if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
+    fallback = Fplist_get (Vdefault_text_properties, prop);
+  return fallback;
 }
 
 \f
@@ -1867,6 +1898,52 @@ set_point (buffer, charpos)
   set_point_both (buffer, charpos, buf_charpos_to_bytepos (buffer, charpos));
 }
 
+/* If there's an invisible character at position POS + TEST_OFFS in the
+   current buffer, and the invisible property has a `stickiness' such that
+   inserting a character at position POS would inherit the property it,
+   return POS + ADJ, otherwise return POS.  If TEST_INTANG is non-zero,
+   then intangibility is required as well as invisibleness.
+
+   TEST_OFFS should be either 0 or -1, and ADJ should be either 1 or -1.
+
+   Note that `stickiness' is determined by overlay marker insertion types,
+   if the invisible property comes from an overlay.  */   
+
+static int
+adjust_for_invis_intang (pos, test_offs, adj, test_intang)
+     int pos, test_offs, adj, test_intang;
+{
+  Lisp_Object invis_propval, invis_overlay;
+  Lisp_Object test_pos;
+
+  if ((adj < 0 && pos + adj < BEGV) || (adj > 0 && pos + adj > ZV))
+    /* POS + ADJ would be beyond the buffer bounds, so do no adjustment.  */
+    return pos;
+
+  test_pos = make_number (pos + test_offs);
+
+  invis_propval
+    = get_char_property_and_overlay (test_pos, Qinvisible, Qnil,
+                                    &invis_overlay);
+
+  if ((!test_intang
+       || ! NILP (Fget_char_property (test_pos, Qintangible, Qnil)))
+      && TEXT_PROP_MEANS_INVISIBLE (invis_propval)
+      /* This next test is true if the invisible property has a stickiness
+        such that an insertion at POS would inherit it.  */
+      && (NILP (invis_overlay)
+         /* Invisible property is from a text-property.  */
+         ? (text_property_stickiness (Qinvisible, make_number (pos))
+            == (test_offs == 0 ? 1 : -1))
+         /* Invisible property is from an overlay.  */
+         : (test_offs == 0
+            ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
+            : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
+    pos += adj;
+
+  return pos;
+}
+
 /* Set point in BUFFER to CHARPOS, which corresponds to byte
    position BYTEPOS.  If the target position is 
    before an intangible character, move to an ok place.  */
@@ -1959,41 +2036,74 @@ set_point_both (buffer, charpos, bytepos)
         or end of the buffer, so don't bother checking in that case.  */
       && charpos != BEGV && charpos != ZV)
     {
-      Lisp_Object intangible_propval;
       Lisp_Object pos;
-
-      XSETINT (pos, charpos);
+      Lisp_Object intangible_propval;
 
       if (backwards)
        {
-         intangible_propval = Fget_char_property (make_number (charpos),
-                                                  Qintangible, Qnil);
+         /* If the preceeding character is both intangible and invisible,
+            and the invisible property is `rear-sticky', perturb it so
+            that the search starts one character earlier -- this ensures
+            that point can never move to the end of an invisible/
+            intangible/rear-sticky region.  */
+         charpos = adjust_for_invis_intang (charpos, -1, -1, 1);
+
+         XSETINT (pos, charpos);
 
          /* If following char is intangible,
             skip back over all chars with matching intangible property.  */
+
+         intangible_propval = Fget_char_property (pos, Qintangible, Qnil);
+
          if (! NILP (intangible_propval))
-           while (XINT (pos) > BUF_BEGV (buffer)
-                  && EQ (Fget_char_property (make_number (XINT (pos) - 1),
-                                             Qintangible, Qnil),
-                         intangible_propval))
-             pos = Fprevious_char_property_change (pos, Qnil);
+           {
+             while (XINT (pos) > BUF_BEGV (buffer)
+                    && EQ (Fget_char_property (make_number (XINT (pos) - 1),
+                                               Qintangible, Qnil),
+                           intangible_propval))
+               pos = Fprevious_char_property_change (pos, Qnil);
+
+             /* Set CHARPOS from POS, and if the final intangible character
+                that we skipped over is also invisible, and the invisible
+                property is `front-sticky', perturb it to be one character
+                earlier -- this ensures that point can never move to the
+                beginning of an invisible/intangible/front-sticky region.  */
+             charpos = adjust_for_invis_intang (XINT (pos), 0, -1, 0);
+           }
        }
       else
        {
+         /* If the following character is both intangible and invisible,
+            and the invisible property is `front-sticky', perturb it so
+            that the search starts one character later -- this ensures
+            that point can never move to the beginning of an
+            invisible/intangible/front-sticky region.  */
+         charpos = adjust_for_invis_intang (charpos, 0, 1, 1);
+
+         XSETINT (pos, charpos);
+
+         /* If preceding char is intangible,
+            skip forward over all chars with matching intangible property.  */
+
          intangible_propval = Fget_char_property (make_number (charpos - 1),
                                                   Qintangible, Qnil);
 
-         /* If following char is intangible,
-            skip forward over all chars with matching intangible property.  */
          if (! NILP (intangible_propval))
-           while (XINT (pos) < BUF_ZV (buffer)
-                  && EQ (Fget_char_property (pos, Qintangible, Qnil),
-                         intangible_propval))
-             pos = Fnext_char_property_change (pos, Qnil);
-
+           {
+             while (XINT (pos) < BUF_ZV (buffer)
+                    && EQ (Fget_char_property (pos, Qintangible, Qnil),
+                           intangible_propval))
+               pos = Fnext_char_property_change (pos, Qnil);
+
+             /* Set CHARPOS from POS, and if the final intangible character
+                that we skipped over is also invisible, and the invisible
+                property is `rear-sticky', perturb it to be one character
+                later -- this ensures that point can never move to the
+                end of an invisible/intangible/rear-sticky region.  */
+             charpos = adjust_for_invis_intang (XINT (pos), -1, 1, 0);
+           }
        }
 
-      charpos = XINT (pos);
       bytepos = buf_charpos_to_bytepos (buffer, charpos);
     }
 
@@ -2137,7 +2247,7 @@ get_property_and_range (pos, prop, val, start, end, object)
   else if (BUFFERP (object))
     i = find_interval (BUF_INTERVALS (XBUFFER (object)), pos);
   else if (STRINGP (object))
-    i = find_interval (XSTRING (object)->intervals, pos);
+    i = find_interval (STRING_INTERVALS (object), pos);
   else
     abort ();
 
@@ -2274,7 +2384,7 @@ copy_intervals_to_string (string, buffer, position, length)
     return;
 
   SET_INTERVAL_OBJECT (interval_copy, string);
-  XSTRING (string)->intervals = interval_copy;
+  STRING_SET_INTERVALS (string, interval_copy);
 }
 \f
 /* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
@@ -2286,10 +2396,10 @@ compare_string_intervals (s1, s2)
 {
   INTERVAL i1, i2;
   int pos = 0;
-  int end = XSTRING (s1)->size;
+  int end = SCHARS (s1);
 
-  i1 = find_interval (XSTRING (s1)->intervals, 0);
-  i2 = find_interval (XSTRING (s2)->intervals, 0);
+  i1 = find_interval (STRING_INTERVALS (s1), 0);
+  i2 = find_interval (STRING_INTERVALS (s2), 0);
 
   while (pos < end)
     {