]> code.delx.au - gnu-emacs/blobdiff - src/intervals.c
Add #pragma alloca.
[gnu-emacs] / src / intervals.c
index f7560fb6b7a5e8a841bea525381a44458bc7f891..279d8e6739a5e12e130316090c6ee7c3b35a4bec 100644 (file)
@@ -1,5 +1,5 @@
 /* Code for doing intervals.
-   Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -76,7 +76,7 @@ create_root_interval (parent)
     {
       new->total_length = (BUF_Z (XBUFFER (parent))
                           - BUF_BEG (XBUFFER (parent)));
-      XBUFFER (parent)->intervals = new;
+      BUF_INTERVALS (XBUFFER (parent)) = new;
     }
   else if (STRINGP (parent))
     {
@@ -414,7 +414,7 @@ balance_possible_root_interval (interval)
   interval = balance_an_interval (interval);
 
   if (BUFFERP (parent))
-    XBUFFER (parent)->intervals = interval;
+    BUF_INTERVALS (XBUFFER (parent)) = interval;
   else if (STRINGP (parent))
     XSTRING (parent)->intervals = interval;
 
@@ -1052,7 +1052,7 @@ delete_interval (i)
        parent->parent = (INTERVAL) owner;
 
       if (BUFFERP (owner))
-       XBUFFER (owner)->intervals = parent;
+       BUF_INTERVALS (XBUFFER (owner)) = parent;
       else if (STRINGP (owner))
        XSTRING (owner)->intervals = parent;
       else
@@ -1153,7 +1153,7 @@ adjust_intervals_for_deletion (buffer, start, length)
      int start, length;
 {
   register int left_to_delete = length;
-  register INTERVAL tree = buffer->intervals;
+  register INTERVAL tree = BUF_INTERVALS (buffer);
   register int deleted;
 
   if (NULL_INTERVAL_P (tree))
@@ -1165,7 +1165,7 @@ adjust_intervals_for_deletion (buffer, start, length)
 
   if (length == TOTAL_LENGTH (tree))
     {
-      buffer->intervals = NULL_INTERVAL;
+      BUF_INTERVALS (buffer) = NULL_INTERVAL;
       return;
     }
 
@@ -1181,10 +1181,10 @@ adjust_intervals_for_deletion (buffer, start, length)
     {
       left_to_delete -= interval_deletion_adjustment (tree, start - 1,
                                                      left_to_delete);
-      tree = buffer->intervals;
+      tree = BUF_INTERVALS (buffer);
       if (left_to_delete == tree->total_length)
        {
-         buffer->intervals = NULL_INTERVAL;
+         BUF_INTERVALS (buffer) = NULL_INTERVAL;
          return;
        }
     }
@@ -1200,11 +1200,11 @@ offset_intervals (buffer, start, length)
      struct buffer *buffer;
      int start, length;
 {
-  if (NULL_INTERVAL_P (buffer->intervals) || length == 0)
+  if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0)
     return;
 
   if (length > 0)
-    adjust_intervals_for_insertion (buffer->intervals, start, length);
+    adjust_intervals_for_insertion (BUF_INTERVALS (buffer), start, length);
   else
     adjust_intervals_for_deletion (buffer, start, -length);
 }
@@ -1426,9 +1426,11 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit)
      int inherit;
 {
   register INTERVAL under, over, this, prev;
-  register INTERVAL tree = buffer->intervals;
+  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 (NULL_INTERVAL_P (source))
@@ -1441,8 +1443,8 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit)
                                make_number (position + length),
                                Qnil, buf);
        }
-      if (! NULL_INTERVAL_P (buffer->intervals))
-       buffer->intervals = balance_an_interval (buffer->intervals);
+      if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
+       BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
       return;
     }
 
@@ -1454,7 +1456,7 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit)
        {
          Lisp_Object buf;
          XSETBUFFER (buf, buffer);
-         buffer->intervals = reproduce_tree (source, buf);
+         BUF_INTERVALS (buffer) = reproduce_tree (source, buf);
          /* Explicitly free the old tree here.  */
 
          return;
@@ -1474,7 +1476,7 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit)
        some zero length intervals.  Eventually, do something clever
        about inserting properly.  For now, just waste the old intervals.  */
     {
-      buffer->intervals = reproduce_tree (source, tree->parent);
+      BUF_INTERVALS (buffer) = reproduce_tree (source, tree->parent);
       /* Explicitly free the old tree here.  */
 
       return;
@@ -1534,14 +1536,15 @@ graft_intervals_into_buffer (source, position, length, buffer, inherit)
       over = next_interval (over);
     }
 
-  if (! NULL_INTERVAL_P (buffer->intervals))
-    buffer->intervals = balance_an_interval (buffer->intervals);
+  if (! NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
+    BUF_INTERVALS (buffer) = balance_an_interval (BUF_INTERVALS (buffer));
   return;
 }
 
 /* Get the value of property PROP from PLIST,
    which is the plist of an interval.
-   We check for direct properties and for categories with property PROP.  */
+   We check for direct properties, for categories with property PROP, 
+   and for PROP appearing on the default-text-properties list.  */
 
 Lisp_Object
 textget (plist, prop)
@@ -1565,28 +1568,13 @@ textget (plist, prop)
        }
     }
 
-  return fallback;
-}
-
-/* Get the value of property PROP from PLIST,
-   which is the plist of an interval.
-   We check for direct properties only! */
-
-Lisp_Object
-textget_direct (plist, prop)
-     Lisp_Object plist;
-     register Lisp_Object prop;
-{
-  register Lisp_Object tail;
-
-  for (tail = plist; !NILP (tail); tail = Fcdr (Fcdr (tail)))
-    {
-      if (EQ (prop, Fcar (tail)))
-       return Fcar (Fcdr (tail));
-    }
-
+  if (! NILP (fallback))
+    return fallback;
+  if (CONSP (Vdefault_text_properties))
+    return Fplist_get (Vdefault_text_properties, prop);
   return Qnil;
 }
+
 \f
 /* Set point in BUFFER to POSITION.  If the target position is 
    before an intangible character, move to an ok place.  */
@@ -1600,9 +1588,11 @@ set_point (position, buffer)
   int buffer_point;
   register Lisp_Object obj;
   int backwards = (position < BUF_PT (buffer)) ? 1 : 0;
-  int old_position = buffer->text.pt;
+  int old_position = BUF_PT (buffer);
 
-  if (position == buffer->text.pt)
+  buffer->point_before_scroll = Qnil;
+
+  if (position == BUF_PT (buffer))
     return;
 
   /* Check this now, before checking if the buffer has any intervals.
@@ -1611,16 +1601,17 @@ set_point (position, buffer)
   if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
     abort ();
 
-  if (NULL_INTERVAL_P (buffer->intervals))
+  if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)))
     {
-      buffer->text.pt = position;
+      
+      BUF_PT (buffer) = position;
       return;
     }
 
   /* Set TO to the interval containing the char after POSITION,
      and TOPREV to the interval containing the char before POSITION.
      Either one may be null.  They may be equal.  */
-  to = find_interval (buffer->intervals, position);
+  to = find_interval (BUF_INTERVALS (buffer), position);
   if (position == BUF_BEGV (buffer))
     toprev = 0;
   else if (to->position == position)
@@ -1636,7 +1627,7 @@ set_point (position, buffer)
      and FROMPREV to the interval containing the char before PT.
      Either one may be null.  They may be equal.  */
   /* We could cache this and save time.  */
-  from = find_interval (buffer->intervals, buffer_point);
+  from = find_interval (BUF_INTERVALS (buffer), buffer_point);
   if (buffer_point == BUF_BEGV (buffer))
     fromprev = 0;
   else if (from->position == BUF_PT (buffer))
@@ -1649,24 +1640,28 @@ set_point (position, buffer)
   /* Moving within an interval.  */
   if (to == from && toprev == fromprev && INTERVAL_VISIBLE_P (to))
     {
-      buffer->text.pt = position;
+      BUF_PT (buffer) = position;
       return;
     }
 
-  /* If the new position is between two intangible characters,
-     move forward or backward across all such characters.  */
+  /* If the new position is between two intangible characters
+     with the same intangible property value,
+     move forward or backward until a change in that property.  */
   if (NILP (Vinhibit_point_motion_hooks) && ! NULL_INTERVAL_P (to)
       && ! NULL_INTERVAL_P (toprev))
     {
       if (backwards)
        {
-         /* Make sure the following character is intangible
-            if the previous one is.  */
-         if (toprev == to
-             || ! NILP (textget (to->plist, Qintangible)))
-           /* Ok, that is so.  Back up across intangible text.  */
-           while (! NULL_INTERVAL_P (toprev)
-                  && ! NILP (textget (toprev->plist, Qintangible)))
+         Lisp_Object intangible_propval;
+         intangible_propval = textget (to->plist, Qintangible);
+
+         /* If following char is intangible,
+            skip back over all chars with matching intangible property.  */
+         if (! NILP (intangible_propval))
+           while (to == toprev
+                  || ((! NULL_INTERVAL_P (toprev)
+                       && EQ (textget (toprev->plist, Qintangible),
+                              intangible_propval))))
              {
                to = toprev;
                toprev = previous_interval (toprev);
@@ -1682,13 +1677,16 @@ set_point (position, buffer)
        }
       else
        {
-         /* Make sure the previous character is intangible
-            if the following one is.  */
-         if (toprev == to
-             || ! NILP (textget (toprev->plist, Qintangible)))
-           /* Ok, that is so.  Advance across intangible text.  */
-           while (! NULL_INTERVAL_P (to)
-                  && ! NILP (textget (to->plist, Qintangible)))
+         Lisp_Object intangible_propval;
+         intangible_propval = textget (toprev->plist, Qintangible);
+
+         /* If previous char is intangible,
+            skip fwd over all chars with matching intangible property.  */
+         if (! NILP (intangible_propval))
+           while (to == toprev
+                  || ((! NULL_INTERVAL_P (to)
+                       && EQ (textget (to->plist, Qintangible),
+                              intangible_propval))))
              {
                toprev = to;
                to = next_interval (to);
@@ -1698,12 +1696,13 @@ set_point (position, buffer)
                  position = to->position;
              }
        }
-      /* Here TO is the interval after the stopping point
-        and TOPREV is the interval before the stopping point.
-        One or the other may be null.  */
     }
 
-  buffer->text.pt = position;
+  /* Here TO is the interval after the stopping point
+     and TOPREV is the interval before the stopping point.
+     One or the other may be null.  */
+
+  BUF_PT (buffer) = position;
 
   /* We run point-left and point-entered hooks here, iff the
      two intervals are not equivalent.  These hooks take
@@ -1751,7 +1750,7 @@ temp_set_point (position, buffer)
      int position;
      struct buffer *buffer;
 {
-  buffer->text.pt = position;
+  BUF_PT (buffer) = position;
 }
 \f
 /* Return the proper local map for position POSITION in BUFFER.
@@ -1763,223 +1762,39 @@ get_local_map (position, buffer)
      register int position;
      register struct buffer *buffer;
 {
-  register INTERVAL interval;
-  Lisp_Object prop, tem;
-
-  if (NULL_INTERVAL_P (buffer->intervals))
-    return current_buffer->keymap;
+  Lisp_Object prop, tem, lispy_position, lispy_buffer;
+  int old_begv, old_zv;
 
   /* Perhaps we should just change `position' to the limit.  */
   if (position > BUF_Z (buffer) || position < BUF_BEG (buffer))
     abort ();
 
-  interval = find_interval (buffer->intervals, position);
-  prop = textget (interval->plist, Qlocal_map);
-  if (NILP (prop))
-    return current_buffer->keymap;
+  /* Ignore narrowing, so that a local map continues to be valid even if
+     the visible region contains no characters and hence no properties.  */
+  old_begv = BUF_BEGV (buffer);
+  old_zv = BUF_ZV (buffer);
+  BUF_BEGV (buffer) = BUF_BEG (buffer);
+  BUF_ZV (buffer) = BUF_Z (buffer);
+
+  /* There are no properties at the end of the buffer, so in that case
+     check for a local map on the last character of the buffer instead.  */
+  if (position == BUF_Z (buffer) && BUF_Z (buffer) > BUF_BEG (buffer))
+    --position;
+  XSETFASTINT (lispy_position, position);
+  XSETBUFFER (lispy_buffer, buffer);
+  prop = Fget_char_property (lispy_position, Qlocal_map, lispy_buffer);
+
+  BUF_BEGV (buffer) = old_begv;
+  BUF_ZV (buffer) = old_zv;
 
   /* Use the local map only if it is valid.  */
-  tem = Fkeymapp (prop);
-  if (!NILP (tem))
+  if (!NILP (prop)
+      && (tem = Fkeymapp (prop), !NILP (tem)))
     return prop;
 
-  return current_buffer->keymap;
+  return buffer->keymap;
 }
 \f
-/* Call the modification hook functions in LIST, each with START and END.  */
-
-static void
-call_mod_hooks (list, start, end)
-     Lisp_Object list, start, end;
-{
-  struct gcpro gcpro1;
-  GCPRO1 (list);
-  while (!NILP (list))
-    {
-      call2 (Fcar (list), start, end);
-      list = Fcdr (list);
-    }
-  UNGCPRO;
-}
-
-/* Check for read-only intervals and signal an error if we find one.
-   Then check for any modification hooks in the range START up to
-   (but not including) END.  Create a list of all these hooks in
-   lexicographic order, eliminating consecutive extra copies of the
-   same hook.  Then call those hooks in order, with START and END - 1
-   as arguments.  */
-
-void
-verify_interval_modification (buf, start, end)
-     struct buffer *buf;
-     int start, end;
-{
-  register INTERVAL intervals = buf->intervals;
-  register INTERVAL i, prev;
-  Lisp_Object hooks;
-  register Lisp_Object prev_mod_hooks;
-  Lisp_Object mod_hooks;
-  struct gcpro gcpro1;
-
-  hooks = Qnil;
-  prev_mod_hooks = Qnil;
-  mod_hooks = Qnil;
-
-  if (NULL_INTERVAL_P (intervals))
-    return;
-
-  if (start > end)
-    {
-      int temp = start;
-      start = end;
-      end = temp;
-    }
-
-  /* For an insert operation, check the two chars around the position.  */
-  if (start == end)
-    {
-      INTERVAL prev;
-      Lisp_Object before, after;
-
-      /* Set I to the interval containing the char after START,
-        and PREV to the interval containing the char before START.
-        Either one may be null.  They may be equal.  */
-      i = find_interval (intervals, start);
-
-      if (start == BUF_BEGV (buf))
-       prev = 0;
-      else if (i->position == start)
-       prev = previous_interval (i);
-      else if (i->position < start)
-       prev = i;
-      if (start == BUF_ZV (buf))
-       i = 0;
-
-      /* If Vinhibit_read_only is set and is not a list, we can
-        skip the read_only checks.  */
-      if (NILP (Vinhibit_read_only) || CONSP (Vinhibit_read_only))
-       {
-         /* If I and PREV differ we need to check for the read-only
-            property together with its stickyness. If either I or
-            PREV are 0, this check is all we need.
-            We have to take special care, since read-only may be
-            indirectly defined via the category property.  */
-         if (i != prev)
-           {
-             if (! NULL_INTERVAL_P (i))
-               {
-                 after = textget (i->plist, Qread_only);
-                 
-                 /* If interval I is read-only and read-only is
-                    front-sticky, inhibit insertion.
-                    Check for read-only as well as category.  */
-                 if (! NILP (after)
-                     && NILP (Fmemq (after, Vinhibit_read_only)))
-                   {
-                     Lisp_Object tem;
-
-                     tem = textget (i->plist, Qfront_sticky);
-                     if (TMEM (Qread_only, tem)
-                         || (NILP (textget_direct (i->plist, Qread_only))
-                             && TMEM (Qcategory, tem)))
-                       error ("Attempt to insert within read-only text");
-                   }
-               }
-
-             if (! NULL_INTERVAL_P (prev))
-               {
-                 before = textget (prev->plist, Qread_only);
-                 
-                 /* If interval PREV is read-only and read-only isn't
-                    rear-nonsticky, inhibit insertion.
-                    Check for read-only as well as category.  */
-                 if (! NILP (before)
-                     && NILP (Fmemq (before, Vinhibit_read_only)))
-                   {
-                     Lisp_Object tem;
-
-                     tem = textget (prev->plist, Qrear_nonsticky);
-                     if (! TMEM (Qread_only, tem)
-                         && (! NILP (textget_direct (prev->plist,Qread_only))
-                             || ! TMEM (Qcategory, tem)))
-                       error ("Attempt to insert within read-only text");
-                   }
-               }
-           }
-         else if (! NULL_INTERVAL_P (i))
-           {
-             after = textget (i->plist, Qread_only);
-                 
-             /* If interval I is read-only and read-only is
-                front-sticky, inhibit insertion.
-                Check for read-only as well as category.  */
-             if (! NILP (after) && NILP (Fmemq (after, Vinhibit_read_only)))
-               {
-                 Lisp_Object tem;
-
-                 tem = textget (i->plist, Qfront_sticky);
-                 if (TMEM (Qread_only, tem)
-                     || (NILP (textget_direct (i->plist, Qread_only))
-                         && TMEM (Qcategory, tem)))
-                   error ("Attempt to insert within read-only text");
-
-                 tem = textget (prev->plist, Qrear_nonsticky);
-                 if (! TMEM (Qread_only, tem)
-                     && (! NILP (textget_direct (prev->plist, Qread_only))
-                         || ! TMEM (Qcategory, tem)))
-                   error ("Attempt to insert within read-only text");
-               }
-           }
-       }
-
-      /* Run both insert hooks (just once if they're the same).  */
-      if (!NULL_INTERVAL_P (prev))
-       prev_mod_hooks = textget (prev->plist, Qinsert_behind_hooks);
-      if (!NULL_INTERVAL_P (i))
-       mod_hooks = textget (i->plist, Qinsert_in_front_hooks);
-      GCPRO1 (mod_hooks);
-      if (! NILP (prev_mod_hooks))
-       call_mod_hooks (prev_mod_hooks, make_number (start),
-                       make_number (end));
-      UNGCPRO;
-      if (! NILP (mod_hooks) && ! EQ (mod_hooks, prev_mod_hooks))
-       call_mod_hooks (mod_hooks, make_number (start), make_number (end));
-    }
-  else
-    {
-      /* Loop over intervals on or next to START...END,
-        collecting their hooks.  */
-
-      i = find_interval (intervals, start);
-      do
-       {
-         if (! INTERVAL_WRITABLE_P (i))
-           error ("Attempt to modify read-only text");
-
-         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);
-       }
-      /* 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))
-       {
-         call_mod_hooks (Fcar (hooks), make_number (start),
-                         make_number (end));
-         hooks = Fcdr (hooks);
-       }
-      UNGCPRO;
-    }
-}
-
 /* Produce an interval tree reflecting the intervals in
    TREE from START to START + LENGTH.  */
 
@@ -2030,7 +1845,7 @@ copy_intervals_to_string (string, buffer, position, length)
      Lisp_Object string, buffer;
      int position, length;
 {
-  INTERVAL interval_copy = copy_intervals (XBUFFER (buffer)->intervals,
+  INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (XBUFFER (buffer)),
                                           position, length);
   if (NULL_INTERVAL_P (interval_copy))
     return;