Initial revision

1 files changed, 1529 insertions, 0 deletions

diff --git a/src/intervals.c b/src/intervals.c
new file mode 100644
index 00000000000..8a985199f8e
--- /dev/null
+++ b/src/intervals.c
@@ -0,0 +1,1529 @@
+/* Code for doing intervals.
+   Copyright (C) 1991, 1992 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 1, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+
+/* NOTES:
+
+   Have to ensure that we can't put symbol nil on a plist, or some
+   functions may work incorrectly.
+
+   An idea:  Have the owner of the tree keep count of splits and/or
+   insertion lengths (in intervals), and balance after every N.
+
+   Need to call *_left_hook when buffer is killed.
+
+   Scan for zero-length, or 0-length to see notes about handling
+   zero length interval-markers.
+
+   There are comments around about freeing intervals.  It might be
+   faster to explicitly free them (put them on the free list) than
+   to GC them.
+
+*/
+
+
+#include "config.h"
+#include "lisp.h"
+#include "intervals.h"
+#include "buffer.h"
+#include "screen.h"
+
+/* Factor for weight-balancing interval trees. */
+Lisp_Object interval_balance_threshold;
+
+/* Utility functions for intervals. */
+
+
+/* Create the root interval of some object, a buffer or string. */
+
+INTERVAL
+create_root_interval (parent)
+     Lisp_Object parent;
+{
+  INTERVAL new = make_interval ();
+
+  if (XTYPE (parent) == Lisp_Buffer)
+    {
+      new->total_length = BUF_Z (XBUFFER (parent)) - 1;
+      XBUFFER (parent)->intervals = new;
+    }
+  else if (XTYPE (parent) == Lisp_String)
+    {
+      new->total_length = XSTRING (parent)->size;
+      XSTRING (parent)->intervals = new;
+    }
+
+  new->parent = (INTERVAL) parent;
+  new->position = 1;
+
+  return new;
+}
+
+/* Make the interval TARGET have exactly the properties of SOURCE */
+
+void
+copy_properties (source, target)
+     register INTERVAL source, target;
+{
+  if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
+    return;
+
+  COPY_INTERVAL_CACHE (source, target);
+  target->plist = Fcopy_sequence (source->plist);
+}
+
+/* Merge the properties of interval SOURCE into the properties
+   of interval TARGET. */
+
+static void
+merge_properties (source, target)
+     register INTERVAL source, target;
+{
+  register Lisp_Object o, sym, val;
+
+  if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
+    return;
+
+  MERGE_INTERVAL_CACHE (source, target);
+
+  o = source->plist;
+  while (! EQ (o, Qnil))
+    {
+      sym = Fcar (o);
+      val = Fmemq (sym, target->plist);
+
+      if (NILP (val))
+        {
+          o = Fcdr (o);
+          val = Fcar (o);
+          target->plist = Fcons (sym, Fcons (val, target->plist));
+          o = Fcdr (o);
+        }
+      else
+        o = Fcdr (Fcdr (o));
+    }
+}
+
+/* Return 1 if the two intervals have the same properties,
+   0 otherwise. */
+
+int
+intervals_equal (i0, i1)
+     INTERVAL i0, i1;
+{
+  register Lisp_Object i0_cdr, i0_sym, i1_val;
+  register i1_len;
+
+  if (DEFAULT_INTERVAL_P (i0) && DEFAULT_INTERVAL_P (i1))
+    return 1;
+
+  i1_len = XFASTINT (Flength (i1->plist));
+  if (i1_len & 0x1)             /* Paranoia -- plists are always even */
+    abort ();
+  i1_len /= 2;
+  i0_cdr = i0->plist;
+  while (!NILP (i0_cdr))
+    {
+      /* Lengths of the two plists were unequal */
+      if (i1_len == 0)
+        return 0;
+
+      i0_sym = Fcar (i0_cdr);
+      i1_val = Fmemq (i0_sym, i1->plist);
+
+      /* i0 has something i1 doesn't */
+      if (EQ (i1_val, Qnil))
+        return 0;
+
+      /* i0 and i1 both have sym, but it has different values in each */
+      i0_cdr = Fcdr (i0_cdr);
+      if (! Fequal (i1_val, Fcar (i0_cdr)))
+        return 0;
+
+      i0_cdr = Fcdr (i0_cdr);
+      i1_len--;
+    }
+
+  /* Lengths of the two plists were unequal */
+  if (i1_len > 0)
+    return 0;
+
+  return 1;
+}
+
+static int icount;
+static int idepth;
+static int zero_length;
+
+static int depth;
+
+/* Traverse an interval tree TREE, performing FUNCTION on each node.
+
+   Perhaps we should pass the depth as an argument. */
+
+void
+traverse_intervals (tree, position, function)
+     INTERVAL tree;
+     int position;
+     void (* function) ();
+{
+  if (NULL_INTERVAL_P (tree))
+    return;
+
+  depth++;
+  traverse_intervals (tree->left, position, function);
+  position += LEFT_TOTAL_LENGTH (tree);
+  tree->position = position;
+  (*function) (tree);
+  position += LENGTH (tree);
+  traverse_intervals (tree->right, position, function);
+  depth--;
+}
+
+#if 0
+/* These functions are temporary, for debugging purposes only. */
+
+INTERVAL search_interval, found_interval;
+
+void
+check_for_interval (i)
+     register INTERVAL i;
+{
+  if (i == search_interval)
+    {
+      found_interval = i;
+      icount++;
+    }
+}
+
+INTERVAL
+search_for_interval (i, tree)
+     register INTERVAL i, tree;
+{
+  icount = 0;
+  search_interval = i;
+  found_interval = NULL_INTERVAL;
+  traverse_intervals (tree, 1, &check_for_interval);
+  return found_interval;
+}
+
+static void
+inc_interval_count (i)
+     INTERVAL i;
+{
+  icount++;
+  if (LENGTH (i) == 0)
+    zero_length++;
+  if (depth > idepth)
+    idepth = depth;
+}
+
+int
+count_intervals (i)
+     register INTERVAL i;
+{
+  icount = 0;
+  idepth = 0;
+  zero_length = 0;
+  traverse_intervals (i, 1, &inc_interval_count);
+
+  return icount;
+}
+
+static INTERVAL
+root_interval (interval)
+     INTERVAL interval;
+{
+  register INTERVAL i = interval;
+
+  while (! ROOT_INTERVAL_P (i))
+    i = i->parent;
+
+  return i;
+}
+#endif
+
+/* Assuming that a left child exists, perform the following operation:
+
+     A            B
+    / \          / \
+   B       =>       A
+  / \              / \
+     c            c
+*/
+
+static INTERVAL
+rotate_right (interval)
+     INTERVAL interval;
+{
+  INTERVAL i;
+  INTERVAL B = interval->left;
+  int len = LENGTH (interval);
+
+  /* Deal with any Parent of A;  make it point to B. */
+  if (! ROOT_INTERVAL_P (interval))
+    if (AM_LEFT_CHILD (interval))
+      interval->parent->left = interval->left;
+    else
+      interval->parent->right = interval->left;
+  interval->left->parent = interval->parent;
+
+  /* B gets the same length as A, since it get A's position in the tree. */
+  interval->left->total_length = interval->total_length;
+
+  /* B becomes the parent of A. */
+  i = interval->left->right;
+  interval->left->right = interval;
+  interval->parent = interval->left;
+
+  /* A gets c as left child. */
+  interval->left = i;
+  if (! NULL_INTERVAL_P (i))
+    i->parent = interval;
+  interval->total_length = (len + LEFT_TOTAL_LENGTH (interval)
+                            + RIGHT_TOTAL_LENGTH (interval));
+
+  return B;
+}
+
+/* Assuming that a right child exists, perform the following operation:
+
+    A               B   
+   / \             / \  
+      B    =>     A
+     / \         / \    
+    c               c
+*/
+
+static INTERVAL
+rotate_left (interval)
+     INTERVAL interval;
+{
+  INTERVAL i;
+  INTERVAL B = interval->right;
+  int len = LENGTH (interval);
+
+  /* Deal with the parent of A. */
+  if (! ROOT_INTERVAL_P (interval))
+    if (AM_LEFT_CHILD (interval))
+      interval->parent->left = interval->right;
+    else
+      interval->parent->right = interval->right;
+  interval->right->parent = interval->parent;
+
+  /* B must have the same total length of A. */
+  interval->right->total_length = interval->total_length;
+
+  /* Make B the parent of A */
+  i = interval->right->left;
+  interval->right->left = interval;
+  interval->parent = interval->right;
+
+  /* Make A point to c */
+  interval->right = i;
+  if (! NULL_INTERVAL_P (i))
+    i->parent = interval;
+  interval->total_length = (len + LEFT_TOTAL_LENGTH (interval)
+                            + RIGHT_TOTAL_LENGTH (interval));
+
+  return B;
+}
+
+/* Split an interval into two.  The second (RIGHT) half is returned as
+   the new interval.  The size and position of the interval being split are
+   stored within it, having been found by find_interval ().  The properties
+   are reset;  it is up to the caller to do the right thing.
+
+   Note that this does not change the position of INTERVAL;  if it is a root,
+   it is still a root after this operation. */
+
+INTERVAL
+split_interval_right (interval, relative_position)
+     INTERVAL interval;
+     int relative_position;
+{
+  INTERVAL new = make_interval ();
+  int position = interval->position;
+  int new_length = LENGTH (interval) - relative_position + 1;
+
+  new->position = position + relative_position - 1;
+  new->parent = interval;
+#if 0
+  copy_properties (interval, new);
+#endif
+
+  if (LEAF_INTERVAL_P (interval) || NULL_RIGHT_CHILD (interval))
+    {
+      interval->right = new;
+      new->total_length = new_length;
+
+      return new;
+    }
+
+  /* Insert the new node between INTERVAL and its right child. */
+  new->right = interval->right;
+  interval->right->parent = new;
+  interval->right = new;
+
+  new->total_length = new_length + new->right->total_length;
+
+  return new;
+}
+
+/* Split an interval into two.  The first (LEFT) half is returned as
+   the new interval.  The size and position of the interval being split
+   are stored within it, having been found by find_interval ().  The
+   properties are reset;  it is up to the caller to do the right thing.
+
+   Note that this does not change the position of INTERVAL in the tree;  if it
+   is a root, it is still a root after this operation.  */
+
+INTERVAL
+split_interval_left (interval, relative_position)
+     INTERVAL interval;
+     int relative_position;
+{
+  INTERVAL new = make_interval ();
+  int position = interval->position;
+  int new_length = relative_position - 1;
+
+#if 0
+  copy_properties (interval, new);
+#endif
+
+  new->position = interval->position;
+
+  interval->position = interval->position + relative_position - 1;
+  new->parent = interval;
+
+  if (NULL_LEFT_CHILD (interval))
+    {
+      interval->left = new;
+      new->total_length = new_length;
+
+      return new;
+    }
+
+  /* Insert the new node between INTERVAL and its left child. */
+  new->left = interval->left;
+  new->left->parent = new;
+  interval->left = new;
+  new->total_length = LENGTH (new) + LEFT_TOTAL_LENGTH (new);
+
+  return new;
+}
+
+/* Find the interval containing POSITION in TREE.  POSITION is relative
+   to the start of TREE. */
+
+INTERVAL
+find_interval (tree, position)
+     register INTERVAL tree;
+     register int position;
+{
+  register int relative_position = position;
+
+  if (NULL_INTERVAL_P (tree))
+    return NULL_INTERVAL;
+
+  if (position > TOTAL_LENGTH (tree))
+    abort ();                   /* Paranoia */
+#if 0
+    position = TOTAL_LENGTH (tree);
+#endif
+
+  while (1)
+    {
+      if (relative_position <= LEFT_TOTAL_LENGTH (tree))
+        {
+          tree = tree->left;
+        }
+      else if (relative_position > (TOTAL_LENGTH (tree)
+                                    - RIGHT_TOTAL_LENGTH (tree)))
+        {
+          relative_position -= (TOTAL_LENGTH (tree)
+                                - RIGHT_TOTAL_LENGTH (tree));
+          tree = tree->right;
+        }
+      else
+        {
+          tree->position = LEFT_TOTAL_LENGTH (tree)
+                           + position - relative_position + 1;
+          return tree;
+        }
+    }
+}
+
+/* Find the succeeding interval (lexicographically) to INTERVAL.
+   Sets the `position' field based on that of INTERVAL.
+
+   Note that those values are only correct if they were also correct
+   in INTERVAL. */
+
+INTERVAL
+next_interval (interval)
+     register INTERVAL interval;
+{
+  register INTERVAL i = interval;
+  register int next_position;
+
+  if (NULL_INTERVAL_P (i))
+    return NULL_INTERVAL;
+  next_position = interval->position + LENGTH (interval);
+
+  if (! NULL_RIGHT_CHILD (i))
+    {
+      i = i->right;
+      while (! NULL_LEFT_CHILD (i))
+        i = i->left;
+
+      i->position = next_position;
+      return i;
+    }
+
+  while (! NULL_PARENT (i))
+    {
+      if (AM_LEFT_CHILD (i))
+        {
+          i = i->parent;
+          i->position = next_position;
+          return i;
+        }
+
+      i = i->parent;
+    }
+
+  return NULL_INTERVAL;
+}
+
+/* Find the preceding interval (lexicographically) to INTERVAL.
+   Sets the `position' field based on that of INTERVAL.
+
+   Note that those values are only correct if they were also correct
+   in INTERVAL. */
+
+INTERVAL
+previous_interval (interval)
+     register INTERVAL interval;
+{
+  register INTERVAL i;
+  register position_of_previous;
+
+  if (NULL_INTERVAL_P (interval))
+    return NULL_INTERVAL;
+
+  if (! NULL_LEFT_CHILD (interval))
+    {
+      i = interval->left;
+      while (! NULL_RIGHT_CHILD (i))
+        i = i->right;
+
+      i->position = interval->position - LENGTH (i);
+      return i;
+    }
+
+  i = interval;
+  while (! NULL_PARENT (i))
+    {
+      if (AM_RIGHT_CHILD (i))
+        {
+          i = i->parent;
+
+          i->position = interval->position - LENGTH (i);
+          return i;
+        }
+      i = i->parent;
+    }
+
+  return NULL_INTERVAL;
+}
+
+/* Traverse a path down the interval tree TREE to the interval
+   containing POSITION, adjusting all nodes on the path for
+   an addition of LENGTH characters.  Insertion between two intervals
+   (i.e., point == i->position, where i is second interval) means
+   text goes into second interval.
+
+   Modifications are needed to handle the hungry bits -- after simply
+   finding the interval at position (don't add length going down),
+   if it's the beginning of the interval, get the previous interval
+   and check the hugry bits of both.  Then add the length going back up
+   to the root. */
+
+static INTERVAL
+adjust_intervals_for_insertion (tree, position, length)
+     INTERVAL tree;
+     int position, length;
+{
+  register int relative_position;
+  register INTERVAL this;
+
+  if (TOTAL_LENGTH (tree) == 0) /* Paranoia */
+    abort ();
+
+  /* If inserting at point-max of a buffer, that position
+     will be out of range */
+  if (position > TOTAL_LENGTH (tree))
+    position = TOTAL_LENGTH (tree);
+  relative_position = position;
+  this = tree;
+
+  while (1)
+    {
+      if (relative_position <= LEFT_TOTAL_LENGTH (this))
+        {
+          this->total_length += length;
+          this = this->left;
+        }
+      else if (relative_position > (TOTAL_LENGTH (this)
+                                    - RIGHT_TOTAL_LENGTH (this)))
+        {
+          relative_position -= (TOTAL_LENGTH (this)
+                                - RIGHT_TOTAL_LENGTH (this));
+          this->total_length += length;
+          this = this->right;
+        }
+      else
+        {
+          /* If we are to use zero-length intervals as buffer pointers,
+             then this code will have to change. */
+          this->total_length += length;
+          this->position = LEFT_TOTAL_LENGTH (this)
+                           + position - relative_position + 1;
+          return tree;
+        }
+    }
+}
+
+/* Merge interval I with its lexicographic successor. Note that
+   this does not deal with the properties, or delete I. */
+
+INTERVAL
+merge_interval_right (i)
+     register INTERVAL i;
+{
+  register int absorb = LENGTH (i);
+
+  /* Zero out this interval. */
+  i->total_length -= absorb;
+
+  /* Find the succeeding interval. */
+  if (! NULL_RIGHT_CHILD (i))      /* It's below us.  Add absorb
+                                      as we descend. */
+    {
+      i = i->right;
+      while (! NULL_LEFT_CHILD (i))
+        {
+          i->total_length += absorb;
+          i = i->left;
+        }
+
+      i->total_length += absorb;
+      return i;
+    }
+
+  while (! NULL_PARENT (i))        /* It's above us.  Subtract as
+                                      we ascend. */
+    {
+      if (AM_LEFT_CHILD (i))
+        {
+          i = i->parent;
+          return i;
+        }
+
+      i = i->parent;
+      i->total_length -= absorb;
+    }
+
+  return NULL_INTERVAL;
+}
+
+/* Merge interval I with its lexicographic predecessor. Note that
+   this does not deal with the properties, or delete I.*/
+
+INTERVAL
+merge_interval_left (i)
+     register INTERVAL i;
+{
+  register int absorb = LENGTH (i);
+
+  /* Zero out this interval. */
+  i->total_length -= absorb;
+
+  /* Find the preceding interval. */
+  if (! NULL_LEFT_CHILD (i))    /* It's below us. Go down,
+                                   adding ABSORB as we go. */
+    {
+      i = i->left;
+      while (! NULL_RIGHT_CHILD (i))
+        {
+          i->total_length += absorb;
+          i = i->right;
+        }
+
+      i->total_length += absorb;
+      return i;
+    }
+
+  while (! NULL_PARENT (i))     /* It's above us.  Go up,
+                                   subtracting ABSORB. */
+    {
+      if (AM_RIGHT_CHILD (i))
+        {
+          i = i->parent;
+          return i;
+        }
+
+      i = i->parent;
+      i->total_length -= absorb;
+    }
+
+  return NULL_INTERVAL;
+}
+
+/* Delete an interval node from its btree by merging its subtrees
+   into one subtree which is returned.  Caller is responsible for
+   storing the resulting subtree into its parent. */
+
+static INTERVAL
+delete_node (i)
+     register INTERVAL i;
+{
+  register INTERVAL migrate, this;
+  register int migrate_amt;
+
+  if (NULL_INTERVAL_P (i->left))
+    return i->right;
+  if (NULL_INTERVAL_P (i->right))
+    return i->left;
+
+  migrate = i->left;
+  migrate_amt = i->left->total_length;
+  this = i->right;
+  this->total_length += migrate_amt;
+  while (! NULL_INTERVAL_P (this->left))
+    {
+      this = this->left;
+      this->total_length += migrate_amt;
+    }
+  this->left = migrate;
+  migrate->parent = this;
+
+  return i->right;
+}
+
+/* Delete interval I from its tree by calling `delete_node'
+   and properly connecting the resultant subtree.
+
+   I is presumed to be empty; that is, no adjustments are made
+   for the length of I. */
+
+void
+delete_interval (i)
+     register INTERVAL i;
+{
+  register INTERVAL parent;
+  int amt = LENGTH (i);
+
+  if (amt > 0)                  /* Only used on zero-length intervals now. */
+    abort ();
+
+  if (ROOT_INTERVAL_P (i))
+    {
+      Lisp_Object owner = (Lisp_Object) i->parent;
+      parent = delete_node (i);
+      if (! NULL_INTERVAL_P (parent))
+        parent->parent = (INTERVAL) owner;
+
+      if (XTYPE (owner) == Lisp_Buffer)
+        XBUFFER (owner)->intervals = parent;
+      else if (XTYPE (owner) == Lisp_String)
+        XSTRING (owner)->intervals = parent;
+      else
+        abort ();
+
+      return;
+    }
+
+  parent = i->parent;
+  if (AM_LEFT_CHILD (i))
+    {
+      parent->left = delete_node (i);
+      if (! NULL_INTERVAL_P (parent->left))
+        parent->left->parent = parent;
+    }
+  else
+    {
+      parent->right = delete_node (i);
+      if (! NULL_INTERVAL_P (parent->right))
+        parent->right->parent = parent;
+    }
+}
+
+/* Recurse down to the interval containing FROM.  Then delete as much
+   as possible (up to AMOUNT) from that interval, adjusting parental
+   intervals on the way up.  If an interval is zeroed out, then
+   it is deleted.
+
+   Returns the amount deleted. */
+
+static int
+interval_deletion_adjustment (tree, from, amount)
+     register INTERVAL tree;
+     register int from, amount;
+{
+  register int relative_position = from;
+
+  if (NULL_INTERVAL_P (tree))
+    return 0;
+
+  /* Left branch */
+  if (relative_position <= LEFT_TOTAL_LENGTH (tree))
+    {
+      int subtract = interval_deletion_adjustment (tree->left,
+                                                   relative_position,
+                                                   amount);
+      tree->total_length -= subtract;
+      return subtract;
+    }
+  /* Right branch */
+  else if (relative_position > (TOTAL_LENGTH (tree)
+                                - RIGHT_TOTAL_LENGTH (tree)))
+    {
+      int subtract;
+
+      relative_position -= (tree->total_length
+                            - RIGHT_TOTAL_LENGTH (tree));
+      subtract = interval_deletion_adjustment (tree->right,
+                                               relative_position,
+                                               amount);
+      tree->total_length -= subtract;
+      return subtract;
+    }
+  /* Here -- this node */
+  else
+    {
+      /* If this is a zero-length, marker interval, then
+         we must skip it. */
+
+      if (relative_position == LEFT_TOTAL_LENGTH (tree) + 1)
+        {
+          /* This means we're deleting from the beginning of this interval. */
+          register int my_amount = LENGTH (tree);
+
+          if (amount < my_amount)
+            {
+              tree->total_length -= amount;
+              return amount;
+            }
+          else
+            {
+              tree->total_length -= my_amount;
+              if (LENGTH (tree) != 0)
+                abort ();       /* Paranoia */
+
+              delete_interval (tree);
+              return my_amount;
+            }
+        }
+      else                      /* Deleting starting in the middle. */
+        {
+          register int my_amount = ((tree->total_length
+                                     - RIGHT_TOTAL_LENGTH (tree))
+                                    - relative_position + 1);
+
+          if (amount <= my_amount)
+            {
+              tree->total_length -= amount;
+              return amount;
+            }
+          else
+            {
+              tree->total_length -= my_amount;
+              return my_amount;
+            }
+        }
+    }
+
+  abort ();
+}
+
+static void
+adjust_intervals_for_deletion (buffer, start, length)
+     struct buffer *buffer;
+     int start, length;
+{
+  register int left_to_delete = length;
+  register INTERVAL tree = buffer->intervals;
+  register int deleted;
+
+  if (NULL_INTERVAL_P (tree))
+    return;
+
+  if (length == TOTAL_LENGTH (tree))
+    {
+      buffer->intervals = NULL_INTERVAL;
+      return;
+    }
+
+  if (ONLY_INTERVAL_P (tree))
+    {
+      tree->total_length -= length;
+      return;
+    }
+
+  if (start > TOTAL_LENGTH (tree))
+    start = TOTAL_LENGTH (tree);
+  while (left_to_delete > 0)
+    {
+      left_to_delete -= interval_deletion_adjustment (tree, start,
+                                                      left_to_delete);
+      tree = buffer->intervals;
+      if (left_to_delete == tree->total_length)
+        {
+          buffer->intervals = NULL_INTERVAL;
+          return;
+        }
+    }
+}
+
+/* Note that all intervals in OBJECT after START have slid by LENGTH. */
+
+INLINE void
+offset_intervals (buffer, start, length)
+     struct buffer *buffer;
+     int start, length;
+{
+  if (NULL_INTERVAL_P (buffer->intervals) || length == 0)
+    return;
+
+  if (length > 0)
+    adjust_intervals_for_insertion (buffer->intervals, start, length);
+  else
+    adjust_intervals_for_deletion (buffer, start, -length);
+}
+
+static INTERVAL
+reproduce_tree (source, parent)
+     INTERVAL source, parent;
+{
+  register INTERVAL t = make_interval ();
+
+  bcopy (source, t, INTERVAL_SIZE);
+  copy_properties (source, t);
+  t->parent = parent;
+  if (! NULL_LEFT_CHILD (source))
+    t->left = reproduce_tree (source->left, t);
+  if (! NULL_RIGHT_CHILD (source))
+    t->right = reproduce_tree (source->right, t);
+
+  return t;
+}
+
+static INTERVAL
+make_new_interval (intervals, start, length)
+     INTERVAL intervals;
+     int start, length;
+{
+  INTERVAL slot;
+
+  slot = find_interval (intervals, start);
+  if (start + length > slot->position + LENGTH (slot))
+    error ("Interval would overlap");
+
+  if (start == slot->position && length == LENGTH (slot))
+    return slot;
+
+  if (slot->position == start)
+    {
+      /* New right node. */
+      split_interval_right (slot, length + 1);
+      return slot;
+    }
+
+  if (slot->position + LENGTH (slot) == start + length)
+    {
+      /* New left node. */
+      split_interval_left (slot, LENGTH (slot) - length + 1);
+      return slot;
+    }
+
+  /* Convert interval SLOT into three intervals. */
+  split_interval_left (slot, start - slot->position + 1);
+  split_interval_right (slot, length + 1);
+  return slot;
+}
+
+void
+map_intervals (source, destination, position)
+     INTERVAL source, destination;
+     int position;
+{
+  register INTERVAL i, t;
+
+  if (NULL_INTERVAL_P (source))
+    return;
+  i = find_interval (destination, position);
+  if (NULL_INTERVAL_P (i))
+    return;
+
+  t = find_interval (source, 1);
+  while (! NULL_INTERVAL_P (t))
+    {
+      i = make_new_interval (destination, position, LENGTH (t));
+      position += LENGTH (t);
+      copy_properties (t, i);
+      t = next_interval (t);
+    }
+}
+
+/* Insert the intervals of NEW_TREE into BUFFER at POSITION.
+
+   This is used in insdel.c when inserting Lisp_Strings into
+   the buffer.  The text corresponding to NEW_TREE is already in
+   the buffer when this is called.  The intervals of new tree are
+   those belonging to the string being inserted;  a copy is not made.
+
+   If the inserted text had no intervals associated, this function
+   simply returns -- offset_intervals should handle placing the
+   text in the correct interval, depending on the hungry bits.
+
+   If the inserted text had properties (intervals), then there are two
+   cases -- either insertion happened in the middle of some interval,
+   or between two intervals.
+
+   If the text goes into the middle of an interval, then new
+   intervals are created in the middle with only the properties of
+   the new text, *unless* the macro MERGE_INSERTIONS is true, in
+   which case the new text has the union of its properties and those
+   of the text into which it was inserted.
+
+   If the text goes between two intervals, then if neither interval
+   had its appropriate hungry property set (front_hungry, rear_hungry),
+   the new text has only its properties.  If one of the hungry properties
+   is set, then the new text "sticks" to that region and its properties
+   depend on merging as above.  If both the preceding and succeding
+   intervals to the new text are "hungry", then the new text retains
+   only its properties, as if neither hungry property were set.  Perhaps
+   we should consider merging all three sets of properties onto the new
+   text... */
+
+void
+graft_intervals_into_buffer (new_tree, position, b)
+     INTERVAL new_tree;
+     int position;
+     struct buffer *b;
+{
+  register INTERVAL under, over, this;
+  register INTERVAL tree = b->intervals;
+
+  /* If the new text has no properties, it becomes part of whatever
+    interval it was inserted into. */
+  if (NULL_INTERVAL_P (new_tree))
+    return;
+
+  /* Paranoia -- the text has already been added, so this buffer
+     should be of non-zero length. */
+  if (TOTAL_LENGTH (tree) == 0)
+    abort ();
+
+  if (NULL_INTERVAL_P (tree))
+    {
+      /* The inserted text constitutes the whole buffer, so
+         simply copy over the interval structure. */
+      if (BUF_Z (b) == TOTAL_LENGTH (new_tree))
+        {
+          b->intervals = reproduce_tree (new_tree, tree->parent);
+          /* Explicitly free the old tree here. */
+
+          return;
+        }
+
+      /* Create an interval tree in which to place a copy
+         of the intervals of the inserted string. */
+      {
+        Lisp_Object buffer;
+        XSET (buffer, Lisp_Buffer, b);
+        create_root_interval (buffer);
+      }
+    }
+  else
+    if (TOTAL_LENGTH (tree) == TOTAL_LENGTH (new_tree))
+
+    /* If the buffer contains only the new string, but
+       there was already some interval tree there, then it may be
+       some zero length intervals.  Eventually, do something clever
+       about inserting properly.  For now, just waste the old intervals. */
+    {
+      b->intervals = reproduce_tree (new_tree, tree->parent);
+      /* Explicitly free the old tree here. */
+
+      return;
+    }
+
+  this = under = find_interval (tree, position);
+  if (NULL_INTERVAL_P (under))  /* Paranoia */
+    abort ();
+  over = find_interval (new_tree, 1);
+
+  /* Insertion between intervals */
+  if (position == under->position)
+    {
+      /* First interval -- none precede it. */
+      if (position == 1)
+        {
+          if (! under->front_hungry)
+            /* The inserted string keeps its own properties. */
+            while (! NULL_INTERVAL_P (over))
+            {
+              position = LENGTH (over) + 1;
+              this = split_interval_left (this, position);
+              copy_properties (over, this);
+              over = next_interval (over);
+            }
+          else
+            /* This string sticks to under */
+            while (! NULL_INTERVAL_P (over))
+            {
+              position = LENGTH (over) + 1;
+              this = split_interval_left (this, position);
+              copy_properties (under, this);
+              if (MERGE_INSERTIONS (under))
+                merge_properties (over, this);
+              over = next_interval (over);
+            }
+        }
+       else
+        {
+          INTERVAL prev = previous_interval (under);
+          if (NULL_INTERVAL_P (prev))
+            abort ();
+
+          if (prev->rear_hungry)
+            {
+              if (under->front_hungry)
+                /* The intervals go inbetween as the two hungry
+                   properties cancel each other.  Should we change
+                   this policy? */
+                while (! NULL_INTERVAL_P (over))
+                  {
+                    position = LENGTH (over) + 1;
+                    this = split_interval_left (this, position);
+                    copy_properties (over, this);
+                    over = next_interval (over);
+                  }
+              else
+                /* The intervals stick to prev */
+                while (! NULL_INTERVAL_P (over))
+                  {
+                    position = LENGTH (over) + 1;
+                    this = split_interval_left (this, position);
+                    copy_properties (prev, this);
+                    if (MERGE_INSERTIONS (prev))
+                      merge_properties (over, this);
+                    over = next_interval (over);
+                  }
+            }
+          else
+            {
+              if (under->front_hungry)
+                /* The intervals stick to under */
+                while (! NULL_INTERVAL_P (over))
+                  {
+                    position = LENGTH (over) + 1;
+                    this = split_interval_left (this, position);
+                    copy_properties (under, this);
+                    if (MERGE_INSERTIONS (under))
+                      merge_properties (over, this);
+                    over = next_interval (over);
+                  }
+              else
+                /* The intervals go inbetween */
+                while (! NULL_INTERVAL_P (over))
+                  {
+                    position = LENGTH (over) + 1;
+                    this = split_interval_left (this, position);
+                    copy_properties (over, this);
+                    over = next_interval (over);
+                  }
+            }
+        }
+
+      b->intervals = balance_intervals (b->intervals);
+      return;
+    }
+
+  /* Here for insertion in the middle of an interval. */
+
+  if (TOTAL_LENGTH (new_tree) < LENGTH (this))
+    {
+      INTERVAL end_unchanged
+        = split_interval_right (this, TOTAL_LENGTH (new_tree) + 1);
+      copy_properties (under, end_unchanged);
+    }
+
+  position = position - tree->position + 1;
+  while (! NULL_INTERVAL_P (over))
+    {
+      this = split_interval_right (under, position);
+      copy_properties (over, this);
+      if (MERGE_INSERTIONS (under))
+        merge_properties (under, this);
+
+      position = LENGTH (over) + 1;
+      over = next_interval (over);
+    }
+
+  b->intervals = balance_intervals (b->intervals);
+  return;
+}
+
+/* Intervals can have properties which are hooks to call.  Look for
+   the property HOOK on interval I, and if found, call its value as
+   a function.*/
+
+void
+run_hooks (i, hook)
+     INTERVAL i;
+     Lisp_Object hook;
+{
+  register Lisp_Object tail = i->plist;
+  register Lisp_Object sym, val;
+
+  while (! NILP (tail))
+    {
+      sym = Fcar (tail);
+      if (EQ (sym, hook))
+        {
+          Lisp_Object begin, end;
+          XFASTINT (begin) = i->position;
+          XFASTINT (end) = i->position + LENGTH (i) - 1;
+          val = Fcar (Fcdr (tail));
+          call2 (val, begin, end);
+          return;
+        }
+
+      tail = Fcdr (Fcdr (tail));
+    }
+}
+
+/* Set point in BUFFER to POSITION.  If the target position is in
+   an invisible interval which is not displayed with a special glyph,
+   skip intervals until we find one.  Point may be at the first
+   position of an invisible interval, if it is displayed with a
+   special glyph.
+
+   This is the only place `PT' is an lvalue in all of emacs. */
+
+void
+set_point (position, buffer)
+     register int position;
+     register struct buffer *buffer;
+{
+  register INTERVAL to, from, target;
+  register int iposition = position;
+  int buffer_point;
+  register Lisp_Object obj;
+  int backwards = (position < BUF_PT (buffer)) ? 1 : 0;
+
+  if (position == buffer->text.pt)
+    return;
+
+  if (NULL_INTERVAL_P (buffer->intervals))
+    {
+      buffer->text.pt = position;
+      return;
+    }
+
+  /* Perhaps we should just change `position' to the limit. */
+  if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
+    abort ();
+
+  /* Position Z is really one past the last char in the buffer.  */
+  if (position == BUF_Z (buffer))
+    iposition = position - 1;
+
+  to = find_interval (buffer->intervals, iposition);
+  buffer_point =(BUF_PT (buffer) == BUF_Z (buffer)
+                 ? BUF_Z (buffer) - 1
+                 : BUF_PT (buffer));
+  from = find_interval (buffer->intervals, buffer_point);
+  if (NULL_INTERVAL_P (to) || NULL_INTERVAL_P (from))
+    abort ();                   /* Paranoia */
+
+  /* Moving within an interval */
+  if (to == from && INTERVAL_VISIBLE_P (to))
+    {
+      buffer->text.pt = position;
+      return;
+    }
+
+  /* Here for the case of moving into another interval. */
+
+  target = to;
+  while (! INTERVAL_VISIBLE_P (to) && ! DISPLAY_INVISIBLE_GLYPH (to)
+         && ! NULL_INTERVAL_P (to))
+    to = (backwards ? previous_interval (to) : next_interval (to));
+  if (NULL_INTERVAL_P (to))
+    return;
+
+  /* Here we know we are actually moving to another interval. */
+  if (INTERVAL_VISIBLE_P (to))
+    {
+      /* If we skipped some intervals, go to the closest point
+         in the interval we've stopped at. */
+      if (to != target)
+        buffer->text.pt = (backwards
+                           ? to->position + LENGTH (to) - 1
+                           : to->position);
+      else
+        buffer->text.pt = position;
+    }
+  else
+    buffer->text.pt = to->position;
+
+  /* We should run point-left and point-entered hooks here, iff the
+     two intervals are not equivalent. */
+}
+
+/* Check for read-only intervals.  Call the modification hooks if any.
+   Check for the range START up to (but not including) TO.
+
+   First all intervals of the region are checked that they are
+   modifiable, then all the modification hooks are called in
+   lexicographic order. */
+
+void
+verify_interval_modification (buf, start, end)
+     struct buffer *buf;
+     int start, end;
+{
+  register INTERVAL intervals = buf->intervals;
+  register INTERVAL i;
+  register Lisp_Object hooks = Qnil;
+
+  if (NULL_INTERVAL_P (intervals))
+    return;
+
+  if (start > end)
+    {
+      int temp = start;
+      start = end;
+      end = temp;
+    }
+
+  if (start == BUF_Z (buf))
+    {
+      if (BUF_Z (buf) == 1)
+        abort ();
+
+      i = find_interval (intervals, start - 1);
+      if (! END_HUNGRY_P (i))
+        return;
+    }
+  else
+    i = find_interval (intervals, start);
+
+  do
+    {
+      register Lisp_Object mod_hook;
+      if (! INTERVAL_WRITABLE_P (i))
+        error ("Attempt to write in a protected interval");
+      mod_hook = Fget (Qmodification, i->plist);
+      if (! EQ (mod_hook, Qnil))
+        hooks = Fcons (mod_hook, hooks);
+      i = next_interval (i);
+    }
+  while (! NULL_INTERVAL_P (i) && i->position <= end);
+
+  hooks = Fnreverse (hooks);
+  while (! EQ (hooks, Qnil))
+    call2 (Fcar (hooks), i->position, i->position + LENGTH (i) - 1);
+}
+
+/* Balance an interval node if the amount of text in its left and right
+   subtrees differs by more than the percentage specified by
+   `interval-balance-threshold'. */
+
+static INTERVAL
+balance_an_interval (i)
+     INTERVAL i;
+{
+  register int total_children_size = (LEFT_TOTAL_LENGTH (i)
+                                      + RIGHT_TOTAL_LENGTH (i));
+  register int threshold = (XFASTINT (interval_balance_threshold)
+                            * (total_children_size / 100));
+
+  if (LEFT_TOTAL_LENGTH (i) > RIGHT_TOTAL_LENGTH (i)
+      && (LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i)) > threshold)
+    return rotate_right (i);
+
+  if (LEFT_TOTAL_LENGTH (i) > RIGHT_TOTAL_LENGTH (i)
+      && (LEFT_TOTAL_LENGTH (i) - RIGHT_TOTAL_LENGTH (i)) > threshold)
+    return rotate_right (i);
+
+#if 0
+  if (LEFT_TOTAL_LENGTH (i) >
+      (RIGHT_TOTAL_LENGTH (i) + XINT (interval_balance_threshold)))
+    return rotate_right (i);
+
+  if (RIGHT_TOTAL_LENGTH (i) >
+      (LEFT_TOTAL_LENGTH (i) + XINT (interval_balance_threshold)))
+    return rotate_left (i);
+#endif
+
+  return i;
+}
+
+/* Balance the interval tree TREE.  Balancing is by weight
+   (the amount of text). */
+
+INTERVAL
+balance_intervals (tree)
+     register INTERVAL tree;
+{
+  register INTERVAL new_tree;
+
+  if (NULL_INTERVAL_P (tree))
+    return NULL_INTERVAL;
+
+  new_tree = tree;
+  do
+    {
+      tree = new_tree;
+      new_tree = balance_an_interval (new_tree);
+    }
+  while (new_tree != tree);
+
+  return new_tree;
+}
+
+/* Produce an interval tree reflecting the interval structure in
+   TREE from START to START + LENGTH. */
+
+static INTERVAL
+copy_intervals (tree, start, length)
+     INTERVAL tree;
+     int start, length;
+{
+  register INTERVAL i, new, t;
+  register int got;
+
+  if (NULL_INTERVAL_P (tree) || length <= 0)
+    return NULL_INTERVAL;
+
+  i = find_interval (tree, start);
+  if (NULL_INTERVAL_P (i) || LENGTH (i) == 0)
+    abort ();
+
+  /* If there is only one interval and it's the default, return nil. */
+  if ((start - i->position + 1 + length) < LENGTH (i)
+      && DEFAULT_INTERVAL_P (i))
+    return NULL_INTERVAL;
+
+  new = make_interval ();
+  new->position = 1;
+  got = (LENGTH (i) - (start - i->position));
+  new->total_length = got;
+  copy_properties (i, new);
+
+  t = new;
+  while (got < length)
+    {
+      i = next_interval (i);
+      t->right = make_interval ();
+      t->right->parent = t;
+      t->right->position = t->position + got - 1;
+
+      t = t->right;
+      t->total_length = length - got;
+      copy_properties (i, t);
+      got += LENGTH (i);
+    }
+
+  if (got > length)
+    t->total_length -= (got - length);
+
+  return balance_intervals (new);
+}
+
+/* Give buffer SINK the properties of buffer SOURCE from POSITION
+   to END.  The properties are attached to SINK starting at position AT.
+
+   No range checking is done. */
+
+void
+insert_interval_copy (source, position, end, sink, at)
+     struct buffer *source, *sink;
+     register int position, end, at;
+{
+  INTERVAL interval_copy = copy_intervals (source->intervals,
+                                           position, end - position);
+  graft_intervals_into_buffer (interval_copy, at, sink);
+}
+
+/* Give STRING the properties of BUFFER from POSITION to LENGTH. */
+
+void
+copy_intervals_to_string (string, buffer, position, length)
+     Lisp_Object string, buffer;
+     int position, length;
+{
+  INTERVAL interval_copy = copy_intervals (XBUFFER (buffer)->intervals,
+                                           position, length);
+  if (NULL_INTERVAL_P (interval_copy))
+    return;
+
+  interval_copy->parent = (INTERVAL) string;
+  XSTRING (string)->intervals = interval_copy;
+}
+
+INTERVAL
+make_string_interval (string, start, length)
+     struct Lisp_String *string;
+     int start, length;
+{
+  if (start < 1 || start > string->size)
+    error ("Interval index out of range");
+  if (length < 1 || length > string->size - start + 1)
+    error ("Interval won't fit");
+
+  if (length == 0)
+    return NULL_INTERVAL;
+
+  return make_new_interval (string->intervals, start, length);
+}
+
+/* Create an interval of length LENGTH in buffer BUF at position START.  */
+
+INTERVAL
+make_buffer_interval (buf, start, length)
+     struct buffer *buf;
+     int start, length;
+{
+  if (start < BUF_BEG (buf) || start > BUF_Z (buf))
+    error ("Interval index out of range");
+  if (length < 1 || length > BUF_Z (buf) - start)
+    error ("Interval won't fit");
+
+  if (length == 0)
+    return NULL_INTERVAL;
+
+  return make_new_interval (buf->intervals, start, length);
+}