]> code.delx.au - gnu-emacs/blobdiff - src/textprop.c
* frame.c (x_set_alpha) [NS_IMPL_COCOA]: Call x_set_frame_alpha.
[gnu-emacs] / src / textprop.c
index fd70f039d226504ff065b899432480570104660a..120c42843febc4d887791abe74942f36cfe9ad74 100644 (file)
@@ -1,13 +1,13 @@
 /* Interface code for dealing with text properties.
    Copyright (C) 1993, 1994, 1995, 1997, 1999, 2000, 2001, 2002, 2003,
-                 2004, 2005, 2006 Free Software Foundation, Inc.
+                 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
-GNU Emacs is free software; you can redistribute it and/or modify
+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 2, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, 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
@@ -15,9 +15,7 @@ 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, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.  */
+along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <config.h>
 #include "lisp.h"
@@ -201,9 +199,9 @@ validate_plist (list)
     {
       register int i;
       register Lisp_Object tail;
-      for (i = 0, tail = list; !NILP (tail); i++)
+      for (i = 0, tail = list; CONSP (tail); i++)
        {
-         tail = Fcdr (tail);
+         tail = XCDR (tail);
          QUIT;
        }
       if (i & 1)
@@ -226,18 +224,18 @@ interval_has_all_properties (plist, i)
   register int found;
 
   /* Go through each element of PLIST.  */
-  for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
+  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
     {
-      sym1 = Fcar (tail1);
+      sym1 = XCAR (tail1);
       found = 0;
 
       /* Go through I's plist, looking for sym1 */
-      for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
-       if (EQ (sym1, Fcar (tail2)))
+      for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
+       if (EQ (sym1, XCAR (tail2)))
          {
            /* Found the same property on both lists.  If the
               values are unequal, return zero.  */
-           if (! EQ (Fcar (Fcdr (tail1)), Fcar (Fcdr (tail2))))
+           if (! EQ (Fcar (XCDR (tail1)), Fcar (XCDR (tail2))))
              return 0;
 
            /* Property has same value on both lists;  go to next one.  */
@@ -263,13 +261,13 @@ interval_has_some_properties (plist, i)
   register Lisp_Object tail1, tail2, sym;
 
   /* Go through each element of PLIST.  */
-  for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
+  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
     {
-      sym = Fcar (tail1);
+      sym = XCAR (tail1);
 
       /* Go through i's plist, looking for tail1 */
-      for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
-       if (EQ (sym, Fcar (tail2)))
+      for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
+       if (EQ (sym, XCAR (tail2)))
          return 1;
     }
 
@@ -287,12 +285,12 @@ interval_has_some_properties_list (list, i)
   register Lisp_Object tail1, tail2, sym;
 
   /* Go through each element of LIST.  */
-  for (tail1 = list; ! NILP (tail1); tail1 = XCDR (tail1))
+  for (tail1 = list; CONSP (tail1); tail1 = XCDR (tail1))
     {
       sym = Fcar (tail1);
 
       /* Go through i's plist, looking for tail1 */
-      for (tail2 = i->plist; ! NILP (tail2); tail2 = XCDR (XCDR (tail2)))
+      for (tail2 = i->plist; CONSP (tail2); tail2 = XCDR (XCDR (tail2)))
        if (EQ (sym, XCAR (tail2)))
          return 1;
     }
@@ -391,21 +389,21 @@ add_properties (plist, i, object)
   GCPRO3 (tail1, sym1, val1);
 
   /* Go through each element of PLIST.  */
-  for (tail1 = plist; ! NILP (tail1); tail1 = Fcdr (Fcdr (tail1)))
+  for (tail1 = plist; CONSP (tail1); tail1 = Fcdr (XCDR (tail1)))
     {
-      sym1 = Fcar (tail1);
-      val1 = Fcar (Fcdr (tail1));
+      sym1 = XCAR (tail1);
+      val1 = Fcar (XCDR (tail1));
       found = 0;
 
       /* Go through I's plist, looking for sym1 */
-      for (tail2 = i->plist; ! NILP (tail2); tail2 = Fcdr (Fcdr (tail2)))
-       if (EQ (sym1, Fcar (tail2)))
+      for (tail2 = i->plist; CONSP (tail2); tail2 = Fcdr (XCDR (tail2)))
+       if (EQ (sym1, XCAR (tail2)))
          {
            /* No need to gcpro, because tail2 protects this
               and it must be a cons cell (we get an error otherwise).  */
            register Lisp_Object this_cdr;
 
-           this_cdr = Fcdr (tail2);
+           this_cdr = XCDR (tail2);
            /* Found the property.  Now check its value.  */
            found = 1;
 
@@ -646,6 +644,10 @@ get_char_property_and_overlay (position, prop, object, overlay)
       Lisp_Object *overlay_vec;
       struct buffer *obuf = current_buffer;
 
+      if (XINT (position) < BUF_BEGV (XBUFFER (object))
+         || XINT (position) > BUF_ZV (XBUFFER (object)))
+       xsignal1 (Qargs_out_of_range, position);
+
       set_buffer_temp (XBUFFER (object));
 
       GET_OVERLAYS_AT (XINT (position), overlay_vec, noverlays, NULL, 0);
@@ -713,7 +715,7 @@ POSITION is at the end of OBJECT, both car and cdr are nil.  */)
   Lisp_Object overlay;
   Lisp_Object val
     = get_char_property_and_overlay (position, prop, object, &overlay);
-  return Fcons(val, overlay);
+  return Fcons (val, overlay);
 }
 
 \f
@@ -881,7 +883,7 @@ back past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
       if (NILP (position))
        {
          if (NILP (limit))
-           position = make_number (SCHARS (object));
+           position = make_number (0);
          else
            {
              CHECK_NUMBER (limit);
@@ -1001,17 +1003,16 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
         && (NILP (limit) || next->position < XFASTINT (limit)))
     next = next_interval (next);
 
-  if (NULL_INTERVAL_P (next))
+  if (NULL_INTERVAL_P (next)
+      || (next->position
+         >= (INTEGERP (limit)
+             ? XFASTINT (limit)
+             : (STRINGP (object)
+                ? SCHARS (object)
+                : BUF_ZV (XBUFFER (object))))))
     return limit;
-  if (NILP (limit))
-    XSETFASTINT (limit, (STRINGP (object)
-                        ? SCHARS (object)
-                        : BUF_ZV (XBUFFER (object))));
-  if (!(next->position < XFASTINT (limit)))
-    return limit;
-
-  XSETFASTINT (position, next->position);
-  return position;
+  else
+    return make_number (next->position);
 }
 
 /* Return 1 if there's a change in some property between BEG and END.  */
@@ -1083,16 +1084,16 @@ past position LIMIT; return LIMIT if nothing is found before LIMIT.  */)
         && (NILP (limit) || next->position < XFASTINT (limit)))
     next = next_interval (next);
 
-  if (NULL_INTERVAL_P (next))
+  if (NULL_INTERVAL_P (next)
+      || (next->position
+         >= (INTEGERP (limit)
+             ? XFASTINT (limit)
+             : (STRINGP (object)
+                ? SCHARS (object)
+                : BUF_ZV (XBUFFER (object))))))
     return limit;
-  if (NILP (limit))
-    XSETFASTINT (limit, (STRINGP (object)
-                        ? SCHARS (object)
-                        : BUF_ZV (XBUFFER (object))));
-  if (!(next->position < XFASTINT (limit)))
-    return limit;
-
-  return make_number (next->position);
+  else
+    return make_number (next->position);
 }
 
 DEFUN ("previous-property-change", Fprevious_property_change,
@@ -1132,14 +1133,15 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT.  */)
         && (NILP (limit)
             || (previous->position + LENGTH (previous) > XFASTINT (limit))))
     previous = previous_interval (previous);
-  if (NULL_INTERVAL_P (previous))
-    return limit;
-  if (NILP (limit))
-    XSETFASTINT (limit, (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))));
-  if (!(previous->position + LENGTH (previous) > XFASTINT (limit)))
-    return limit;
 
-  return make_number (previous->position + LENGTH (previous));
+  if (NULL_INTERVAL_P (previous)
+      || (previous->position + LENGTH (previous)
+         <= (INTEGERP (limit)
+             ? XFASTINT (limit)
+             : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
+    return limit;
+  else
+    return make_number (previous->position + LENGTH (previous));
 }
 
 DEFUN ("previous-single-property-change", Fprevious_single_property_change,
@@ -1184,14 +1186,15 @@ back past position LIMIT; return LIMIT if nothing is found until LIMIT.  */)
         && (NILP (limit)
             || (previous->position + LENGTH (previous) > XFASTINT (limit))))
     previous = previous_interval (previous);
-  if (NULL_INTERVAL_P (previous))
-    return limit;
-  if (NILP (limit))
-    XSETFASTINT (limit, (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))));
-  if (!(previous->position + LENGTH (previous) > XFASTINT (limit)))
-    return limit;
 
-  return make_number (previous->position + LENGTH (previous));
+  if (NULL_INTERVAL_P (previous)
+      || (previous->position + LENGTH (previous)
+         <= (INTEGERP (limit)
+             ? XFASTINT (limit)
+             : (STRINGP (object) ? 0 : BUF_BEGV (XBUFFER (object))))))
+    return limit;
+  else
+    return make_number (previous->position + LENGTH (previous));
 }
 \f
 /* Callers note, this can GC when OBJECT is a buffer (or nil).  */
@@ -1253,7 +1256,7 @@ Return t if any property value actually changed, nil otherwise.  */)
     }
 
   if (BUFFERP (object))
-    modify_region (XBUFFER (object), XINT (start), XINT (end));
+    modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
 
   /* We are at the beginning of interval I, with LEN chars to scan.  */
   for (;;)
@@ -1393,7 +1396,7 @@ set_text_properties (start, end, properties, object, signal_after_change_p)
     }
 
   if (BUFFERP (object))
-    modify_region (XBUFFER (object), XINT (start), XINT (end));
+    modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
 
   set_text_properties_1 (start, end, properties, object, i);
 
@@ -1501,7 +1504,7 @@ the current buffer), START and END are buffer positions (integers or
 markers).  If OBJECT is a string, START and END are 0-based indices into it.
 Return t if any property was actually removed, nil otherwise.
 
-Use set-text-properties if you want to remove all text properties.  */)
+Use `set-text-properties' if you want to remove all text properties.  */)
      (start, end, properties, object)
      Lisp_Object start, end, properties, object;
 {
@@ -1541,7 +1544,7 @@ Use set-text-properties if you want to remove all text properties.  */)
     }
 
   if (BUFFERP (object))
-    modify_region (XBUFFER (object), XINT (start), XINT (end));
+    modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
 
   /* We are at the beginning of an interval, with len to scan */
   for (;;)
@@ -1632,8 +1635,8 @@ Return t if any property was actually removed, nil otherwise.  */)
      The flag `modified' records if changes have been made.
      When object is a buffer, we must call modify_region before changes are
      made and signal_after_change when we are done.
-     We call modify_region before calling remove_properties iff modified == 0,
-     and we call signal_after_change before returning iff modified != 0. */
+     We call modify_region before calling remove_properties if modified == 0,
+     and we call signal_after_change before returning if modified != 0. */
   for (;;)
     {
       if (i == 0)
@@ -1655,7 +1658,7 @@ Return t if any property was actually removed, nil otherwise.  */)
          if (LENGTH (i) == len)
            {
              if (!modified && BUFFERP (object))
-               modify_region (XBUFFER (object), XINT (start), XINT (end));
+               modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
              remove_properties (Qnil, properties, i, object);
              if (BUFFERP (object))
                signal_after_change (XINT (start), XINT (end) - XINT (start),
@@ -1668,7 +1671,7 @@ Return t if any property was actually removed, nil otherwise.  */)
          i = split_interval_left (i, len);
          copy_properties (unchanged, i);
          if (!modified && BUFFERP (object))
-           modify_region (XBUFFER (object), XINT (start), XINT (end));
+           modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
          remove_properties (Qnil, properties, i, object);
          if (BUFFERP (object))
            signal_after_change (XINT (start), XINT (end) - XINT (start),
@@ -1679,7 +1682,7 @@ Return t if any property was actually removed, nil otherwise.  */)
       if (interval_has_some_properties_list (properties, i))
        {
          if (!modified && BUFFERP (object))
-           modify_region (XBUFFER (object), XINT (start), XINT (end));
+           modify_region (XBUFFER (object), XINT (start), XINT (end), 1);
          remove_properties (Qnil, properties, i, object);
          modified = 1;
        }
@@ -1964,10 +1967,10 @@ text_property_list (object, start, end, prop)
          plist = i->plist;
 
          if (!NILP (prop))
-           for (; !NILP (plist); plist = Fcdr (Fcdr (plist)))
-             if (EQ (Fcar (plist), prop))
+           for (; CONSP (plist); plist = Fcdr (XCDR (plist)))
+             if (EQ (XCAR (plist), prop))
                {
-                 plist = Fcons (prop, Fcons (Fcar (Fcdr (plist)), Qnil));
+                 plist = Fcons (prop, Fcons (Fcar (XCDR (plist)), Qnil));
                  break;
                }
 
@@ -2291,8 +2294,8 @@ Each element has the form (PROPERTY . NONSTICKINESS).
 
 If a character in a buffer has PROPERTY, new text inserted adjacent to
 the character doesn't inherit PROPERTY if NONSTICKINESS is non-nil,
-inherits it if NONSTICKINESS is nil.  The front-sticky and
-rear-nonsticky properties of the character overrides NONSTICKINESS.  */);
+inherits it if NONSTICKINESS is nil.  The `front-sticky' and
+`rear-nonsticky' properties of the character override NONSTICKINESS.  */);
   /* Text property `syntax-table' should be nonsticky by default.  */
   Vtext_property_default_nonsticky
     = Fcons (Fcons (intern ("syntax-table"), Qt), Qnil);