(JU+4E82): Add MJ036854 into `->ancient'.
[chise/xemacs-chise.git.1] / src / extents.c
index 910c0aa..be980e9 100644 (file)
@@ -406,7 +406,7 @@ typedef int Endpoint_Index;
 #define DE_MUST_BE_ATTACHED 2
 
 Lisp_Object Vlast_highlighted_extent;
 #define DE_MUST_BE_ATTACHED 2
 
 Lisp_Object Vlast_highlighted_extent;
-int mouse_highlight_priority;
+Fixnum mouse_highlight_priority;
 
 Lisp_Object Qextentp;
 Lisp_Object Qextent_live_p;
 
 Lisp_Object Qextentp;
 Lisp_Object Qextent_live_p;
@@ -1175,11 +1175,12 @@ detach_all_extents (Lisp_Object object)
              set_extent_start (e, -1);
              set_extent_end (e, -1);
            }
              set_extent_start (e, -1);
              set_extent_end (e, -1);
            }
+
+         /* But we need to clear all the lists containing extents or
+            havoc will result. */
+         extent_list_delete_all (data->extents);
        }
 
        }
 
-      /* But we need to clear all the lists containing extents or
-        havoc will result. */
-      extent_list_delete_all (data->extents);
       soe_invalidate (object);
     }
 }
       soe_invalidate (object);
     }
 }
@@ -1860,7 +1861,7 @@ extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
       case ME_ALL_EXTENTS_OPEN:        start_open = 1, end_open = 1; break;
       case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
       case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
       case ME_ALL_EXTENTS_OPEN:        start_open = 1, end_open = 1; break;
       case ME_ALL_EXTENTS_CLOSED_OPEN: start_open = 0, end_open = 1; break;
       case ME_ALL_EXTENTS_OPEN_CLOSED: start_open = 1, end_open = 0; break;
-      default: abort(); return 0;
+      default: ABORT(); return 0;
       }
 
   start = buffer_or_string_bytind_to_startind (obj, from,
       }
 
   start = buffer_or_string_bytind_to_startind (obj, from,
@@ -1895,7 +1896,7 @@ extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
        retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
        break;
       default:
        retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
        break;
       default:
-       abort(); return 0;
+       ABORT(); return 0;
       }
   return flags & ME_NEGATE_IN_REGION ? !retval : retval;
 }
       }
   return flags & ME_NEGATE_IN_REGION ? !retval : retval;
 }
@@ -2753,9 +2754,10 @@ invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
 
 face_index
 extent_fragment_update (struct window *w, struct extent_fragment *ef,
 
 face_index
 extent_fragment_update (struct window *w, struct extent_fragment *ef,
-                       Bytind pos)
+                       Bytind pos, Lisp_Object last_glyph)
 {
   int i;
 {
   int i;
+  int seen_glyph = NILP (last_glyph) ? 1 : 0;
   Extent_List *sel =
     buffer_or_string_stack_of_extents_force (ef->object)->extents;
   EXTENT lhe = 0;
   Extent_List *sel =
     buffer_or_string_stack_of_extents_force (ef->object)->extents;
   EXTENT lhe = 0;
@@ -2796,11 +2798,15 @@ extent_fragment_update (struct window *w, struct extent_fragment *ef,
       if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
        {
          Lisp_Object glyph = extent_begin_glyph (e);
       if (extent_start (e) == mempos && !NILP (extent_begin_glyph (e)))
        {
          Lisp_Object glyph = extent_begin_glyph (e);
-         struct glyph_block gb;
-
-         gb.glyph = glyph;
-         XSETEXTENT (gb.extent, e);
-         Dynarr_add (ef->begin_glyphs, gb);
+         if (seen_glyph) {
+           struct glyph_block gb;
+           
+           gb.glyph = glyph;
+           XSETEXTENT (gb.extent, e);
+           Dynarr_add (ef->begin_glyphs, gb);
+         }
+         else if (EQ (glyph, last_glyph))
+           seen_glyph = 1;
        }
     }
 
        }
     }
 
@@ -2811,11 +2817,15 @@ extent_fragment_update (struct window *w, struct extent_fragment *ef,
       if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
        {
          Lisp_Object glyph = extent_end_glyph (e);
       if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
        {
          Lisp_Object glyph = extent_end_glyph (e);
-         struct glyph_block gb;
+         if (seen_glyph) {
+           struct glyph_block gb;
 
 
-         gb.glyph = glyph;
-         XSETEXTENT (gb.extent, e);
-         Dynarr_add (ef->end_glyphs, gb);
+           gb.glyph = glyph;
+           XSETEXTENT (gb.extent, e);
+           Dynarr_add (ef->end_glyphs, gb);
+         }
+         else if (EQ (glyph, last_glyph))
+           seen_glyph = 1;
        }
     }
 
        }
     }
 
@@ -2951,8 +2961,8 @@ print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
     strcpy (bp, "detached");
   else
     sprintf (bp, "%ld, %ld",
     strcpy (bp, "detached");
   else
     sprintf (bp, "%ld, %ld",
-            (long) XINT (Fextent_start_position (obj)),
-            (long) XINT (Fextent_end_position (obj)));
+            XINT (Fextent_start_position (obj)),
+            XINT (Fextent_end_position (obj)));
   bp += strlen (bp);
   *bp++ = (extent_end_open_p (anc) ? ')': ']');
   if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
   bp += strlen (bp);
   *bp++ = (extent_end_open_p (anc) ? ')': ']');
   if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
@@ -2996,7 +3006,7 @@ print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
       Lisp_Object obj2 = Qnil;
 
       /* Destroyed extents have 't' in the object field, causing
       Lisp_Object obj2 = Qnil;
 
       /* Destroyed extents have 't' in the object field, causing
-        extent_object() to abort (maybe). */
+        extent_object() to ABORT (maybe). */
       if (EXTENT_LIVE_P (XEXTENT (obj)))
        obj2 = extent_object (XEXTENT (obj));
 
       if (EXTENT_LIVE_P (XEXTENT (obj)))
        obj2 = extent_object (XEXTENT (obj));
 
@@ -3426,7 +3436,7 @@ DEFUN ("next-extent-change", Fnext_extent_change, 1, 2, 0, /*
 Return the next position after POS where an extent begins or ends.
 If POS is at the end of the buffer or string, POS will be returned;
  otherwise a position greater than POS will always be returned.
 Return the next position after POS where an extent begins or ends.
 If POS is at the end of the buffer or string, POS will be returned;
  otherwise a position greater than POS will always be returned.
-If BUFFER is nil, the current buffer is assumed.
+If OBJECT is nil, the current buffer is assumed.
 */
        (pos, object))
 {
 */
        (pos, object))
 {
@@ -3843,6 +3853,7 @@ See documentation on `detach-extent' for a discussion of undo recording.
   get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
                                   GB_ALLOW_PAST_ACCESSIBLE);
 
   get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
                                   GB_ALLOW_PAST_ACCESSIBLE);
 
+  buffer_or_string_extent_info_force (buffer_or_string);
   set_extent_endpoints (ext, s, e, buffer_or_string);
   return extent;
 }
   set_extent_endpoints (ext, s, e, buffer_or_string);
   return extent;
 }
@@ -4567,34 +4578,43 @@ process_extents_for_insertion_mapper (EXTENT extent, void *arg)
 #ifdef ERROR_CHECK_EXTENTS
   if (extent_start (extent) > indice &&
       extent_start (extent) < indice + closure->length)
 #ifdef ERROR_CHECK_EXTENTS
   if (extent_start (extent) > indice &&
       extent_start (extent) < indice + closure->length)
-    abort ();
+    ABORT ();
   if (extent_end (extent) > indice &&
       extent_end (extent) < indice + closure->length)
   if (extent_end (extent) > indice &&
       extent_end (extent) < indice + closure->length)
-    abort ();
+    ABORT ();
 #endif
 
   /* The extent-adjustment code adjusted the extent's endpoints as if
 #endif
 
   /* The extent-adjustment code adjusted the extent's endpoints as if
-     they were markers -- endpoints at the gap (i.e. the insertion
-     point) go to the left of the insertion point, which is correct
-     for [) extents.  We need to fix the other kinds of extents.
+     all extents were closed-open -- endpoints at the insertion point
+     remain unchanged.  We need to fix the other kinds of extents:
 
 
-     Note that both conditions below will hold for zero-length (]
-     extents at the gap.  Zero-length () extents would get adjusted
-     such that their start is greater than their end; we treat them
-     as [) extents.  This is unfortunately an inelegant part of the
-     extent model, but there is no way around it. */
+     1. Start position of start-open extents needs to be moved.
+
+     2. End position of end-closed extents needs to be moved.
+
+     Note that both conditions hold for zero-length (] extents at the
+     insertion point.  But under these rules, zero-length () extents
+     would get adjusted such that their start is greater than their
+     end; instead of allowing that, we treat them as [) extents by
+     modifying condition #1 to not fire nothing when dealing with a
+     zero-length open-open extent.
+
+     Existence of zero-length open-open extents is unfortunately an
+     inelegant part of the extent model, but there is no way around
+     it. */
 
   {
 
   {
-    Memind new_start, new_end;
+    Memind new_start = extent_start (extent);
+    Memind new_end   = extent_end (extent);
 
 
-    new_start = extent_start (extent);
-    new_end = extent_end (extent);
-    if (indice == extent_start (extent) && extent_start_open_p (extent) &&
-       /* coerce zero-length () extents to [) */
-       new_start != new_end)
+    if (indice == extent_start (extent) && extent_start_open_p (extent)
+       /* zero-length () extents are exempt; see comment above. */
+       && !(new_start == new_end && extent_end_open_p (extent))
+       )
       new_start += closure->length;
     if (indice == extent_end (extent) && !extent_end_open_p (extent))
       new_end += closure->length;
       new_start += closure->length;
     if (indice == extent_end (extent) && !extent_end_open_p (extent))
       new_end += closure->length;
+
     set_extent_endpoints_1 (extent, new_start, new_end);
   }
 
     set_extent_endpoints_1 (extent, new_start, new_end);
   }
 
@@ -4719,7 +4739,7 @@ report_extent_modification_mapper (EXTENT extent, void *arg)
      unbind_to (closure.speccount, Qnil).  This is because
      map_extents_bytind() unbinds before, and with a smaller
      speccount.  The additional unbind_to() in
      unbind_to (closure.speccount, Qnil).  This is because
      map_extents_bytind() unbinds before, and with a smaller
      speccount.  The additional unbind_to() in
-     report_extent_modification() would cause XEmacs to abort.  */
+     report_extent_modification() would cause XEmacs to ABORT.  */
   if (closure->speccount == -1)
     {
       closure->speccount = specpdl_depth ();
   if (closure->speccount == -1)
     {
       closure->speccount = specpdl_depth ();
@@ -4916,7 +4936,7 @@ canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
 
 /* Do we need a lisp-level function ? */
 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
 
 /* Do we need a lisp-level function ? */
 DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
-       2,2,0,/*
+       2,2,0, /*
 Note: This feature is experimental!
 
 Set initial-redisplay-function of EXTENT to the function
 Note: This feature is experimental!
 
 Set initial-redisplay-function of EXTENT to the function
@@ -5045,7 +5065,7 @@ glyph_layout_to_symbol (glyph_layout layout)
     case GL_INSIDE_MARGIN:  return Qinside_margin;
     case GL_WHITESPACE:            return Qwhitespace;
     default:
     case GL_INSIDE_MARGIN:  return Qinside_margin;
     case GL_WHITESPACE:            return Qwhitespace;
     default:
-      abort ();
+      ABORT ();
       return Qnil; /* unreached */
     }
 }
       return Qnil; /* unreached */
     }
 }
@@ -5332,7 +5352,14 @@ The following symbols have predefined meanings:
                     `inside-margin', or `outside-margin') of the extent's
                     begin glyph.
 
                     `inside-margin', or `outside-margin') of the extent's
                     begin glyph.
 
- end-glyph-layout The layout policy of the extent's end glyph.
+ end-glyph-layout   The layout policy of the extent's end glyph.
+
+ syntax-table       A cons or a syntax table object.  If a cons, the car must
+                    be an integer (interpreted as a syntax code, applicable to
+                   all characters in the extent).  Otherwise, syntax of
+                   characters in the extent is looked up in the syntax table.
+                   You should use the text property API to manipulate this
+                   property.  (This may be required in the future.)
 */
        (extent, property, value))
 {
 */
        (extent, property, value))
 {
@@ -5437,6 +5464,7 @@ For a list of built-in properties, see `set-extent-property'.
 
 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
 Return EXTENT's value for property PROPERTY.
 
 DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
 Return EXTENT's value for property PROPERTY.
+If no such property exists, DEFAULT is returned.
 See `set-extent-property' for the built-in property names.
 */
        (extent, property, default_))
 See `set-extent-property' for the built-in property names.
 */
        (extent, property, default_))
@@ -6596,7 +6624,7 @@ Scans characters forward from POS till it finds a change in the PROP
  argument OBJECT is the buffer or string to scan (defaults to the current
  buffer).
 The property values are compared with `eq'.
  argument OBJECT is the buffer or string to scan (defaults to the current
  buffer).
 The property values are compared with `eq'.
-Return nil if the property is constant all the way to the end of BUFFER.
+Return nil if the property is constant all the way to the end of OBJECT.
 If the value is non-nil, it is a position greater than POS, never equal.
 
 If the optional fourth argument LIMIT is non-nil, don't search
 If the value is non-nil, it is a position greater than POS, never equal.
 
 If the optional fourth argument LIMIT is non-nil, don't search
@@ -6663,7 +6691,7 @@ Scans characters backward from POS till it finds a change in the PROP
  argument OBJECT is the buffer or string to scan (defaults to the current
  buffer).
 The property values are compared with `eq'.
  argument OBJECT is the buffer or string to scan (defaults to the current
  buffer).
 The property values are compared with `eq'.
-Return nil if the property is constant all the way to the start of BUFFER.
+Return nil if the property is constant all the way to the start of OBJECT.
 If the value is non-nil, it is a position less than POS, never equal.
 
 If the optional fourth argument LIMIT is non-nil, don't search back
 If the value is non-nil, it is a position less than POS, never equal.
 
 If the optional fourth argument LIMIT is non-nil, don't search back