XEmacs 21.2.30 "Hygeia".

[chise/xemacs-chise.git.1] / src / extents.c

/* Copyright (c) 1994, 1995 Free Software Foundation, Inc.
   Copyright (c) 1995 Sun Microsystems, Inc.
   Copyright (c) 1995, 1996 Ben Wing.

This file is part of XEmacs.

XEmacs 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.

XEmacs 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 XEmacs; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

/* Synched up with: Not in FSF. */

/* This file has been Mule-ized. */

/* Written by Ben Wing <ben@xemacs.org>.

   [Originally written by some people at Lucid.
   Hacked on by jwz.
   Start/end-open stuff added by John Rose (john.rose@eng.sun.com).
   Rewritten from scratch by Ben Wing, December 1994.] */

/* Commentary:

   Extents are regions over a buffer, with a start and an end position
   denoting the region of the buffer included in the extent.  In
   addition, either end can be closed or open, meaning that the endpoint
   is or is not logically included in the extent.  Insertion of a character
   at a closed endpoint causes the character to go inside the extent;
   insertion at an open endpoint causes the character to go outside.

   Extent endpoints are stored using memory indices (see insdel.c),
   to minimize the amount of adjusting that needs to be done when
   characters are inserted or deleted.

   (Formerly, extent endpoints at the gap could be either before or
   after the gap, depending on the open/closedness of the endpoint.
   The intent of this was to make it so that insertions would
   automatically go inside or out of extents as necessary with no
   further work needing to be done.  It didn't work out that way,
   however, and just ended up complexifying and buggifying all the
   rest of the code.)

   Extents are compared using memory indices.  There are two orderings
   for extents and both orders are kept current at all times.  The normal
   or "display" order is as follows:

   Extent A is "less than" extent B, that is, earlier in the display order,
   if:    A-start < B-start,
   or if: A-start = B-start, and A-end > B-end

   So if two extents begin at the same position, the larger of them is the
   earlier one in the display order (EXTENT_LESS is true).

   For the e-order, the same thing holds: Extent A is "less than" extent B
   in e-order, that is, later in the buffer,
   if:    A-end < B-end,
   or if: A-end = B-end, and A-start > B-start

   So if two extents end at the same position, the smaller of them is the
   earlier one in the e-order (EXTENT_E_LESS is true).

   The display order and the e-order are complementary orders: any
   theorem about the display order also applies to the e-order if you
   swap all occurrences of "display order" and "e-order", "less than"
   and "greater than", and "extent start" and "extent end".

   Extents can be zero-length, and will end up that way if their endpoints
   are explicitly set that way or if their detachable property is nil
   and all the text in the extent is deleted. (The exception is open-open
   zero-length extents, which are barred from existing because there is
   no sensible way to define their properties.  Deletion of the text in
   an open-open extent causes it to be converted into a closed-open
   extent.)  Zero-length extents are primarily used to represent
   annotations, and behave as follows:

   1) Insertion at the position of a zero-length extent expands the extent
   if both endpoints are closed; goes after the extent if it is closed-open;
   and goes before the extent if it is open-closed.

   2) Deletion of a character on a side of a zero-length extent whose
   corresponding endpoint is closed causes the extent to be detached if
   it is detachable; if the extent is not detachable or the corresponding
   endpoint is open, the extent remains in the buffer, moving as necessary.

   Note that closed-open, non-detachable zero-length extents behave exactly
   like markers and that open-closed, non-detachable zero-length extents
   behave like the "point-type" marker in Mule.


   #### The following information is wrong in places.

   More about the different orders:
   --------------------------------

   The extents in a buffer are ordered by "display order" because that
   is that order that the redisplay mechanism needs to process them in.
   The e-order is an auxiliary ordering used to facilitate operations
   over extents.  The operations that can be performed on the ordered
   list of extents in a buffer are

   1) Locate where an extent would go if inserted into the list.
   2) Insert an extent into the list.
   3) Remove an extent from the list.
   4) Map over all the extents that overlap a range.

   (4) requires being able to determine the first and last extents
   that overlap a range.

   NOTE: "overlap" is used as follows:

   -- two ranges overlap if they have at least one point in common.
      Whether the endpoints are open or closed makes a difference here.
   -- a point overlaps a range if the point is contained within the
      range; this is equivalent to treating a point P as the range
      [P, P].
   -- In the case of an *extent* overlapping a point or range, the
      extent is normally treated as having closed endpoints.  This
      applies consistently in the discussion of stacks of extents
      and such below.  Note that this definition of overlap is not
      necessarily consistent with the extents that `map-extents'
      maps over, since `map-extents' sometimes pays attention to
      whether the endpoints of an extents are open or closed.
      But for our purposes, it greatly simplifies things to treat
      all extents as having closed endpoints.

   First, define >, <, <=, etc. as applied to extents to mean
     comparison according to the display order.  Comparison between an
     extent E and an index I means comparison between E and the range
     [I, I].
   Also define e>, e<, e<=, etc. to mean comparison according to the
     e-order.
   For any range R, define R(0) to be the starting index of the range
     and R(1) to be the ending index of the range.
   For any extent E, define E(next) to be the extent directly following
     E, and E(prev) to be the extent directly preceding E.  Assume
     E(next) and E(prev) can be determined from E in constant time.
     (This is because we store the extent list as a doubly linked
     list.)
   Similarly, define E(e-next) and E(e-prev) to be the extents
     directly following and preceding E in the e-order.

   Now:

   Let R be a range.
   Let F be the first extent overlapping R.
   Let L be the last extent overlapping R.

   Theorem 1: R(1) lies between L and L(next), i.e. L <= R(1) < L(next).

   This follows easily from the definition of display order.  The
   basic reason that this theorem applies is that the display order
   sorts by increasing starting index.

   Therefore, we can determine L just by looking at where we would
   insert R(1) into the list, and if we know F and are moving forward
   over extents, we can easily determine when we've hit L by comparing
   the extent we're at to R(1).

   Theorem 2: F(e-prev) e< [1, R(0)] e<= F.

   This is the analog of Theorem 1, and applies because the e-order
   sorts by increasing ending index.

   Therefore, F can be found in the same amount of time as operation (1),
   i.e. the time that it takes to locate where an extent would go if
   inserted into the e-order list.

   If the lists were stored as balanced binary trees, then operation (1)
   would take logarithmic time, which is usually quite fast.  However,
   currently they're stored as simple doubly-linked lists, and instead
   we do some caching to try to speed things up.

   Define a "stack of extents" (or "SOE") as the set of extents
   (ordered in the display order) that overlap an index I, together with
   the SOE's "previous" extent, which is an extent that precedes I in
   the e-order. (Hopefully there will not be very many extents between
   I and the previous extent.)

   Now:

   Let I be an index, let S be the stack of extents on I, let F be
   the first extent in S, and let P be S's previous extent.

   Theorem 3: The first extent in S is the first extent that overlaps
   any range [I, J].

   Proof: Any extent that overlaps [I, J] but does not include I must
   have a start index > I, and thus be greater than any extent in S.

   Therefore, finding the first extent that overlaps a range R is the
   same as finding the first extent that overlaps R(0).

   Theorem 4: Let I2 be an index such that I2 > I, and let F2 be the
   first extent that overlaps I2.  Then, either F2 is in S or F2 is
   greater than any extent in S.

   Proof: If F2 does not include I then its start index is greater
   than I and thus it is greater than any extent in S, including F.
   Otherwise, F2 includes I and thus is in S, and thus F2 >= F.

*/

#include <config.h>
#include "lisp.h"

#include "buffer.h"
#include "debug.h"
#include "device.h"
#include "elhash.h"
#include "extents.h"
#include "faces.h"
#include "frame.h"
#include "glyphs.h"
#include "insdel.h"
#include "keymap.h"
#include "opaque.h"
#include "process.h"
#include "redisplay.h"

/* ------------------------------- */
/*            gap array            */
/* ------------------------------- */

/* Note that this object is not extent-specific and should perhaps be
   moved into another file. */

/* Holds a marker that moves as elements in the array are inserted and
   deleted, similar to standard markers. */

typedef struct gap_array_marker
{
  int pos;
  struct gap_array_marker *next;
} Gap_Array_Marker;

/* Holds a "gap array", which is an array of elements with a gap located
   in it.  Insertions and deletions with a high degree of locality
   are very fast, essentially in constant time.  Array positions as
   used and returned in the gap array functions are independent of
   the gap. */

typedef struct gap_array
{
  char *array;
  int gap;
  int gapsize;
  int numels;
  int elsize;
  Gap_Array_Marker *markers;
} Gap_Array;

static Gap_Array_Marker *gap_array_marker_freelist;

/* Convert a "memory position" (i.e. taking the gap into account) into
   the address of the element at (i.e. after) that position.  "Memory
   positions" are only used internally and are of type Memind.
   "Array positions" are used externally and are of type int. */
#define GAP_ARRAY_MEMEL_ADDR(ga, memel) ((ga)->array + (ga)->elsize*(memel))

/* Number of elements currently in a gap array */
#define GAP_ARRAY_NUM_ELS(ga) ((ga)->numels)

#define GAP_ARRAY_ARRAY_TO_MEMORY_POS(ga, pos) \
  ((pos) <= (ga)->gap ? (pos) : (pos) + (ga)->gapsize)

#define GAP_ARRAY_MEMORY_TO_ARRAY_POS(ga, pos) \
  ((pos) <= (ga)->gap ? (pos) : (pos) - (ga)->gapsize)

/* Convert an array position into the address of the element at
   (i.e. after) that position. */
#define GAP_ARRAY_EL_ADDR(ga, pos) ((pos) < (ga)->gap ? \
  GAP_ARRAY_MEMEL_ADDR(ga, pos) : \
  GAP_ARRAY_MEMEL_ADDR(ga, (pos) + (ga)->gapsize))

/* ------------------------------- */
/*          extent list            */
/* ------------------------------- */

typedef struct extent_list_marker
{
  Gap_Array_Marker *m;
  int endp;
  struct extent_list_marker *next;
} Extent_List_Marker;

typedef struct extent_list
{
  Gap_Array *start;
  Gap_Array *end;
  Extent_List_Marker *markers;
} Extent_List;

static Extent_List_Marker *extent_list_marker_freelist;

#define EXTENT_LESS_VALS(e,st,nd) ((extent_start (e) < (st)) || \
                                   ((extent_start (e) == (st)) && \
                                    (extent_end (e) > (nd))))

#define EXTENT_EQUAL_VALS(e,st,nd) ((extent_start (e) == (st)) && \
                                    (extent_end (e) == (nd)))

#define EXTENT_LESS_EQUAL_VALS(e,st,nd) ((extent_start (e) < (st)) || \
                                         ((extent_start (e) == (st)) && \
                                          (extent_end (e) >= (nd))))

/* Is extent E1 less than extent E2 in the display order? */
#define EXTENT_LESS(e1,e2) \
  EXTENT_LESS_VALS (e1, extent_start (e2), extent_end (e2))

/* Is extent E1 equal to extent E2? */
#define EXTENT_EQUAL(e1,e2) \
  EXTENT_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))

/* Is extent E1 less than or equal to extent E2 in the display order? */
#define EXTENT_LESS_EQUAL(e1,e2) \
  EXTENT_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))

#define EXTENT_E_LESS_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
                                     ((extent_end (e) == (nd)) && \
                                      (extent_start (e) > (st))))

#define EXTENT_E_LESS_EQUAL_VALS(e,st,nd) ((extent_end (e) < (nd)) || \
                                           ((extent_end (e) == (nd)) && \
                                            (extent_start (e) >= (st))))

/* Is extent E1 less than extent E2 in the e-order? */
#define EXTENT_E_LESS(e1,e2) \
        EXTENT_E_LESS_VALS(e1, extent_start (e2), extent_end (e2))

/* Is extent E1 less than or equal to extent E2 in the e-order? */
#define EXTENT_E_LESS_EQUAL(e1,e2) \
  EXTENT_E_LESS_EQUAL_VALS (e1, extent_start (e2), extent_end (e2))

#define EXTENT_GAP_ARRAY_AT(ga, pos) (* (EXTENT *) GAP_ARRAY_EL_ADDR(ga, pos))

/* ------------------------------- */
/*    auxiliary extent structure   */
/* ------------------------------- */

struct extent_auxiliary extent_auxiliary_defaults;

/* ------------------------------- */
/*     buffer-extent primitives    */
/* ------------------------------- */

typedef struct stack_of_extents
{
  Extent_List *extents;
  Memind pos; /* Position of stack of extents.  EXTENTS is the list of
                 all extents that overlap this position.  This position
                 can be -1 if the stack of extents is invalid (this
                 happens when a buffer is first created or a string's
                 stack of extents is created [a string's stack of extents
                 is nuked when a GC occurs, to conserve memory]). */
} Stack_Of_Extents;

/* ------------------------------- */
/*           map-extents           */
/* ------------------------------- */

typedef int Endpoint_Index;

#define memind_to_startind(x, start_open) \
  ((Endpoint_Index) (((x) << 1) + !!(start_open)))
#define memind_to_endind(x, end_open) \
  ((Endpoint_Index) (((x) << 1) - !!(end_open)))

/* Combination macros */
#define bytind_to_startind(buf, x, start_open) \
  memind_to_startind (bytind_to_memind (buf, x), start_open)
#define bytind_to_endind(buf, x, end_open) \
  memind_to_endind (bytind_to_memind (buf, x), end_open)

/* ------------------------------- */
/*    buffer-or-string primitives  */
/* ------------------------------- */

/* Similar for Bytinds and start/end indices. */

#define buffer_or_string_bytind_to_startind(obj, ind, start_open)       \
  memind_to_startind (buffer_or_string_bytind_to_memind (obj, ind),     \
                      start_open)

#define buffer_or_string_bytind_to_endind(obj, ind, end_open)           \
  memind_to_endind (buffer_or_string_bytind_to_memind (obj, ind),       \
                    end_open)

/* ------------------------------- */
/*      Lisp-level functions       */
/* ------------------------------- */

/* flags for decode_extent() */
#define DE_MUST_HAVE_BUFFER 1
#define DE_MUST_BE_ATTACHED 2

Lisp_Object Vlast_highlighted_extent;
int mouse_highlight_priority;

Lisp_Object Qextentp;
Lisp_Object Qextent_live_p;

Lisp_Object Qall_extents_closed;
Lisp_Object Qall_extents_open;
Lisp_Object Qall_extents_closed_open;
Lisp_Object Qall_extents_open_closed;
Lisp_Object Qstart_in_region;
Lisp_Object Qend_in_region;
Lisp_Object Qstart_and_end_in_region;
Lisp_Object Qstart_or_end_in_region;
Lisp_Object Qnegate_in_region;

Lisp_Object Qdetached;
Lisp_Object Qdestroyed;
Lisp_Object Qbegin_glyph;
Lisp_Object Qend_glyph;
Lisp_Object Qstart_open;
Lisp_Object Qend_open;
Lisp_Object Qstart_closed;
Lisp_Object Qend_closed;
Lisp_Object Qread_only;
/* Qhighlight defined in general.c */
Lisp_Object Qunique;
Lisp_Object Qduplicable;
Lisp_Object Qdetachable;
Lisp_Object Qpriority;
Lisp_Object Qmouse_face;
Lisp_Object Qinitial_redisplay_function;

Lisp_Object Qglyph_layout;  /* This exists only for backwards compatibility. */
Lisp_Object Qbegin_glyph_layout, Qend_glyph_layout;
Lisp_Object Qoutside_margin;
Lisp_Object Qinside_margin;
Lisp_Object Qwhitespace;
/* Qtext defined in general.c */

Lisp_Object Qcopy_function;
Lisp_Object Qpaste_function;

/* The idea here is that if we're given a list of faces, we
   need to "memoize" this so that two lists of faces that are `equal'
   turn into the same object.  When `set-extent-face' is called, we
   "memoize" into a list of actual faces; when `extent-face' is called,
   we do a reverse lookup to get the list of symbols. */

static Lisp_Object canonicalize_extent_property (Lisp_Object prop,
                                                 Lisp_Object value);
Lisp_Object Vextent_face_memoize_hash_table;
Lisp_Object Vextent_face_reverse_memoize_hash_table;
Lisp_Object Vextent_face_reusable_list;
/* FSFmacs bogosity */
Lisp_Object Vdefault_text_properties;


EXFUN (Fextent_properties, 1);
EXFUN (Fset_extent_property, 3);

\f
/************************************************************************/
/*                       Generalized gap array                          */
/************************************************************************/

/* This generalizes the "array with a gap" model used to store buffer
   characters.  This is based on the stuff in insdel.c and should
   probably be merged with it.  This is not extent-specific and should
   perhaps be moved into a separate file. */

/* ------------------------------- */
/*        internal functions       */
/* ------------------------------- */

/* Adjust the gap array markers in the range (FROM, TO].  Parallel to
   adjust_markers() in insdel.c. */

static void
gap_array_adjust_markers (Gap_Array *ga, Memind from,
                          Memind to, int amount)
{
  Gap_Array_Marker *m;

  for (m = ga->markers; m; m = m->next)
    m->pos = do_marker_adjustment (m->pos, from, to, amount);
}

/* Move the gap to array position POS.  Parallel to move_gap() in
   insdel.c but somewhat simplified. */

static void
gap_array_move_gap (Gap_Array *ga, int pos)
{
  int gap = ga->gap;
  int gapsize = ga->gapsize;

  assert (ga->array);
  if (pos < gap)
    {
      memmove (GAP_ARRAY_MEMEL_ADDR (ga, pos + gapsize),
               GAP_ARRAY_MEMEL_ADDR (ga, pos),
               (gap - pos)*ga->elsize);
      gap_array_adjust_markers (ga, (Memind) pos, (Memind) gap,
                                gapsize);
    }
  else if (pos > gap)
    {
      memmove (GAP_ARRAY_MEMEL_ADDR (ga, gap),
               GAP_ARRAY_MEMEL_ADDR (ga, gap + gapsize),
               (pos - gap)*ga->elsize);
      gap_array_adjust_markers (ga, (Memind) (gap + gapsize),
                                (Memind) (pos + gapsize), - gapsize);
    }
  ga->gap = pos;
}

/* Make the gap INCREMENT characters longer.  Parallel to make_gap() in
   insdel.c. */

static void
gap_array_make_gap (Gap_Array *ga, int increment)
{
  char *ptr = ga->array;
  int real_gap_loc;
  int old_gap_size;

  /* If we have to get more space, get enough to last a while.  We use
     a geometric progression that saves on realloc space. */
  increment += 100 + ga->numels / 8;

  ptr = (char *) xrealloc (ptr,
                           (ga->numels + ga->gapsize + increment)*ga->elsize);
  if (ptr == 0)
    memory_full ();
  ga->array = ptr;

  real_gap_loc = ga->gap;
  old_gap_size = ga->gapsize;

  /* Call the newly allocated space a gap at the end of the whole space.  */
  ga->gap = ga->numels + ga->gapsize;
  ga->gapsize = increment;

  /* Move the new gap down to be consecutive with the end of the old one.
     This adjusts the markers properly too.  */
  gap_array_move_gap (ga, real_gap_loc + old_gap_size);

  /* Now combine the two into one large gap.  */
  ga->gapsize += old_gap_size;
  ga->gap = real_gap_loc;
}

/* ------------------------------- */
/*        external functions       */
/* ------------------------------- */

/* Insert NUMELS elements (pointed to by ELPTR) into the specified
   gap array at POS. */

static void
gap_array_insert_els (Gap_Array *ga, int pos, void *elptr, int numels)
{
  assert (pos >= 0 && pos <= ga->numels);
  if (ga->gapsize < numels)
    gap_array_make_gap (ga, numels - ga->gapsize);
  if (pos != ga->gap)
    gap_array_move_gap (ga, pos);

  memcpy (GAP_ARRAY_MEMEL_ADDR (ga, ga->gap), (char *) elptr,
          numels*ga->elsize);
  ga->gapsize -= numels;
  ga->gap += numels;
  ga->numels += numels;
  /* This is the equivalent of insert-before-markers.

     #### Should only happen if marker is "moves forward at insert" type.
     */

  gap_array_adjust_markers (ga, pos - 1, pos, numels);
}

/* Delete NUMELS elements from the specified gap array, starting at FROM. */

static void
gap_array_delete_els (Gap_Array *ga, int from, int numdel)
{
  int to = from + numdel;
  int gapsize = ga->gapsize;

  assert (from >= 0);
  assert (numdel >= 0);
  assert (to <= ga->numels);

  /* Make sure the gap is somewhere in or next to what we are deleting.  */
  if (to < ga->gap)
    gap_array_move_gap (ga, to);
  if (from > ga->gap)
    gap_array_move_gap (ga, from);

  /* Relocate all markers pointing into the new, larger gap
     to point at the end of the text before the gap.  */
  gap_array_adjust_markers (ga, to + gapsize, to + gapsize,
                            - numdel - gapsize);

  ga->gapsize += numdel;
  ga->numels -= numdel;
  ga->gap = from;
}

static Gap_Array_Marker *
gap_array_make_marker (Gap_Array *ga, int pos)
{
  Gap_Array_Marker *m;

  assert (pos >= 0 && pos <= ga->numels);
  if (gap_array_marker_freelist)
    {
      m = gap_array_marker_freelist;
      gap_array_marker_freelist = gap_array_marker_freelist->next;
    }
  else
    m = xnew (Gap_Array_Marker);

  m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
  m->next = ga->markers;
  ga->markers = m;
  return m;
}

static void
gap_array_delete_marker (Gap_Array *ga, Gap_Array_Marker *m)
{
  Gap_Array_Marker *p, *prev;

  for (prev = 0, p = ga->markers; p && p != m; prev = p, p = p->next)
    ;
  assert (p);
  if (prev)
    prev->next = p->next;
  else
    ga->markers = p->next;
  m->next = gap_array_marker_freelist;
  m->pos = 0xDEADBEEF; /* -559038737 as an int */
  gap_array_marker_freelist = m;
}

static void
gap_array_delete_all_markers (Gap_Array *ga)
{
  Gap_Array_Marker *p, *next;

  for (p = ga->markers; p; p = next)
    {
      next = p->next;
      p->next = gap_array_marker_freelist;
      p->pos = 0xDEADBEEF; /* -559038737 as an int */
      gap_array_marker_freelist = p;
    }
}

static void
gap_array_move_marker (Gap_Array *ga, Gap_Array_Marker *m, int pos)
{
  assert (pos >= 0 && pos <= ga->numels);
  m->pos = GAP_ARRAY_ARRAY_TO_MEMORY_POS (ga, pos);
}

#define gap_array_marker_pos(ga, m) \
  GAP_ARRAY_MEMORY_TO_ARRAY_POS (ga, (m)->pos)

static Gap_Array *
make_gap_array (int elsize)
{
  Gap_Array *ga = xnew_and_zero (Gap_Array);
  ga->elsize = elsize;
  return ga;
}

static void
free_gap_array (Gap_Array *ga)
{
  if (ga->array)
    xfree (ga->array);
  gap_array_delete_all_markers (ga);
  xfree (ga);
}

\f
/************************************************************************/
/*                       Extent list primitives                         */
/************************************************************************/

/* A list of extents is maintained as a double gap array: one gap array
   is ordered by start index (the "display order") and the other is
   ordered by end index (the "e-order").  Note that positions in an
   extent list should logically be conceived of as referring *to*
   a particular extent (as is the norm in programs) rather than
   sitting between two extents.  Note also that callers of these
   functions should not be aware of the fact that the extent list is
   implemented as an array, except for the fact that positions are
   integers (this should be generalized to handle integers and linked
   list equally well).
*/

/* Number of elements in an extent list */
#define extent_list_num_els(el) GAP_ARRAY_NUM_ELS(el->start)

/* Return the position at which EXTENT is located in the specified extent
   list (in the display order if ENDP is 0, in the e-order otherwise).
   If the extent is not found, the position where the extent would
   be inserted is returned.  If ENDP is 0, the insertion would go after
   all other equal extents.  If ENDP is not 0, the insertion would go
   before all other equal extents.  If FOUNDP is not 0, then whether
   the extent was found will get written into it. */

static int
extent_list_locate (Extent_List *el, EXTENT extent, int endp, int *foundp)
{
  Gap_Array *ga = endp ? el->end : el->start;
  int left = 0, right = GAP_ARRAY_NUM_ELS (ga);
  int oldfoundpos, foundpos;
  int found;

  while (left != right)
    {
      /* RIGHT might not point to a valid extent (i.e. it's at the end
         of the list), so NEWPOS must round down. */
      unsigned int newpos = (left + right) >> 1;
      EXTENT e = EXTENT_GAP_ARRAY_AT (ga, (int) newpos);

      if (endp ? EXTENT_E_LESS (e, extent) : EXTENT_LESS (e, extent))
        left = newpos+1;
      else
        right = newpos;
    }

  /* Now we're at the beginning of all equal extents. */
  found = 0;
  oldfoundpos = foundpos = left;
  while (foundpos < GAP_ARRAY_NUM_ELS (ga))
    {
      EXTENT e = EXTENT_GAP_ARRAY_AT (ga, foundpos);
      if (e == extent)
        {
          found = 1;
          break;
        }
      if (!EXTENT_EQUAL (e, extent))
        break;
      foundpos++;
    }
  if (foundp)
    *foundp = found;
  if (found || !endp)
    return foundpos;
  else
    return oldfoundpos;
}

/* Return the position of the first extent that begins at or after POS
   (or ends at or after POS, if ENDP is not 0).

   An out-of-range value for POS is allowed, and guarantees that the
   position at the beginning or end of the extent list is returned. */

static int
extent_list_locate_from_pos (Extent_List *el, Memind pos, int endp)
{
  struct extent fake_extent;
  /*

   Note that if we search for [POS, POS], then we get the following:

   -- if ENDP is 0, then all extents whose start position is <= POS
      lie before the returned position, and all extents whose start
      position is > POS lie at or after the returned position.

   -- if ENDP is not 0, then all extents whose end position is < POS
      lie before the returned position, and all extents whose end
      position is >= POS lie at or after the returned position.

   */
  set_extent_start (&fake_extent, endp ? pos : pos-1);
  set_extent_end (&fake_extent, endp ? pos : pos-1);
  return extent_list_locate (el, &fake_extent, endp, 0);
}

/* Return the extent at POS. */

static EXTENT
extent_list_at (Extent_List *el, Memind pos, int endp)
{
  Gap_Array *ga = endp ? el->end : el->start;

  assert (pos >= 0 && pos < GAP_ARRAY_NUM_ELS (ga));
  return EXTENT_GAP_ARRAY_AT (ga, pos);
}

/* Insert an extent into an extent list. */

static void
extent_list_insert (Extent_List *el, EXTENT extent)
{
  int pos, foundp;

  pos = extent_list_locate (el, extent, 0, &foundp);
  assert (!foundp);
  gap_array_insert_els (el->start, pos, &extent, 1);
  pos = extent_list_locate (el, extent, 1, &foundp);
  assert (!foundp);
  gap_array_insert_els (el->end, pos, &extent, 1);
}

/* Delete an extent from an extent list. */

static void
extent_list_delete (Extent_List *el, EXTENT extent)
{
  int pos, foundp;

  pos = extent_list_locate (el, extent, 0, &foundp);
  assert (foundp);
  gap_array_delete_els (el->start, pos, 1);
  pos = extent_list_locate (el, extent, 1, &foundp);
  assert (foundp);
  gap_array_delete_els (el->end, pos, 1);
}

static void
extent_list_delete_all (Extent_List *el)
{
  gap_array_delete_els (el->start, 0, GAP_ARRAY_NUM_ELS (el->start));
  gap_array_delete_els (el->end, 0, GAP_ARRAY_NUM_ELS (el->end));
}

static Extent_List_Marker *
extent_list_make_marker (Extent_List *el, int pos, int endp)
{
  Extent_List_Marker *m;

  if (extent_list_marker_freelist)
    {
      m = extent_list_marker_freelist;
      extent_list_marker_freelist = extent_list_marker_freelist->next;
    }
  else
    m = xnew (Extent_List_Marker);

  m->m = gap_array_make_marker (endp ? el->end : el->start, pos);
  m->endp = endp;
  m->next = el->markers;
  el->markers = m;
  return m;
}

#define extent_list_move_marker(el, mkr, pos) \
  gap_array_move_marker((mkr)->endp ? (el)->end : (el)->start, (mkr)->m, pos)

static void
extent_list_delete_marker (Extent_List *el, Extent_List_Marker *m)
{
  Extent_List_Marker *p, *prev;

  for (prev = 0, p = el->markers; p && p != m; prev = p, p = p->next)
    ;
  assert (p);
  if (prev)
    prev->next = p->next;
  else
    el->markers = p->next;
  m->next = extent_list_marker_freelist;
  extent_list_marker_freelist = m;
  gap_array_delete_marker (m->endp ? el->end : el->start, m->m);
}

#define extent_list_marker_pos(el, mkr) \
  gap_array_marker_pos ((mkr)->endp ? (el)->end : (el)->start, (mkr)->m)

static Extent_List *
allocate_extent_list (void)
{
  Extent_List *el = xnew (Extent_List);
  el->start = make_gap_array (sizeof (EXTENT));
  el->end = make_gap_array (sizeof (EXTENT));
  el->markers = 0;
  return el;
}

static void
free_extent_list (Extent_List *el)
{
  free_gap_array (el->start);
  free_gap_array (el->end);
  xfree (el);
}

\f
/************************************************************************/
/*                       Auxiliary extent structure                     */
/************************************************************************/

static Lisp_Object
mark_extent_auxiliary (Lisp_Object obj)
{
  struct extent_auxiliary *data = XEXTENT_AUXILIARY (obj);
  mark_object (data->begin_glyph);
  mark_object (data->end_glyph);
  mark_object (data->invisible);
  mark_object (data->children);
  mark_object (data->read_only);
  mark_object (data->mouse_face);
  mark_object (data->initial_redisplay_function);
  mark_object (data->before_change_functions);
  mark_object (data->after_change_functions);
  return data->parent;
}

DEFINE_LRECORD_IMPLEMENTATION ("extent-auxiliary", extent_auxiliary,
                               mark_extent_auxiliary, internal_object_printer,
                               0, 0, 0, 0, struct extent_auxiliary);

void
allocate_extent_auxiliary (EXTENT ext)
{
  Lisp_Object extent_aux;
  struct extent_auxiliary *data =
    alloc_lcrecord_type (struct extent_auxiliary, &lrecord_extent_auxiliary);

  copy_lcrecord (data, &extent_auxiliary_defaults);
  XSETEXTENT_AUXILIARY (extent_aux, data);
  ext->plist = Fcons (extent_aux, ext->plist);
  ext->flags.has_aux = 1;
}

\f
/************************************************************************/
/*                         Extent info structure                        */
/************************************************************************/

/* An extent-info structure consists of a list of the buffer or string's
   extents and a "stack of extents" that lists all of the extents over
   a particular position.  The stack-of-extents info is used for
   optimization purposes -- it basically caches some info that might
   be expensive to compute.  Certain otherwise hard computations are easy
   given the stack of extents over a particular position, and if the
   stack of extents over a nearby position is known (because it was
   calculated at some prior point in time), it's easy to move the stack
   of extents to the proper position.

   Given that the stack of extents is an optimization, and given that
   it requires memory, a string's stack of extents is wiped out each
   time a garbage collection occurs.  Therefore, any time you retrieve
   the stack of extents, it might not be there.  If you need it to
   be there, use the _force version.

   Similarly, a string may or may not have an extent_info structure.
   (Generally it won't if there haven't been any extents added to the
   string.) So use the _force version if you need the extent_info
   structure to be there. */

static struct stack_of_extents *allocate_soe (void);
static void free_soe (struct stack_of_extents *soe);
static void soe_invalidate (Lisp_Object obj);

static Lisp_Object
mark_extent_info (Lisp_Object obj)
{
  struct extent_info *data = (struct extent_info *) XEXTENT_INFO (obj);
  int i;
  Extent_List *list = data->extents;

  /* Vbuffer_defaults and Vbuffer_local_symbols are buffer-like
     objects that are created specially and never have their extent
     list initialized (or rather, it is set to zero in
     nuke_all_buffer_slots()).  However, these objects get
     garbage-collected so we have to deal.

     (Also the list can be zero when we're dealing with a destroyed
     buffer.) */

  if (list)
    {
      for (i = 0; i < extent_list_num_els (list); i++)
        {
          struct extent *extent = extent_list_at (list, i, 0);
          Lisp_Object exobj;

          XSETEXTENT (exobj, extent);
          mark_object (exobj);
        }
    }

  return Qnil;
}

static void
finalize_extent_info (void *header, int for_disksave)
{
  struct extent_info *data = (struct extent_info *) header;

  if (for_disksave)
    return;

  if (data->soe)
    {
      free_soe (data->soe);
      data->soe = 0;
    }
  if (data->extents)
    {
      free_extent_list (data->extents);
      data->extents = 0;
    }
}

DEFINE_LRECORD_IMPLEMENTATION ("extent-info", extent_info,
                               mark_extent_info, internal_object_printer,
                               finalize_extent_info, 0, 0, 0,
                               struct extent_info);
\f
static Lisp_Object
allocate_extent_info (void)
{
  Lisp_Object extent_info;
  struct extent_info *data =
    alloc_lcrecord_type (struct extent_info, &lrecord_extent_info);

  XSETEXTENT_INFO (extent_info, data);
  data->extents = allocate_extent_list ();
  data->soe = 0;
  return extent_info;
}

void
flush_cached_extent_info (Lisp_Object extent_info)
{
  struct extent_info *data = XEXTENT_INFO (extent_info);

  if (data->soe)
    {
      free_soe (data->soe);
      data->soe = 0;
    }
}

\f
/************************************************************************/
/*                    Buffer/string extent primitives                   */
/************************************************************************/

/* The functions in this section are the ONLY ones that should know
   about the internal implementation of the extent lists.  Other functions
   should only know that there are two orderings on extents, the "display"
   order (sorted by start position, basically) and the e-order (sorted
   by end position, basically), and that certain operations are provided
   to manipulate the list. */

/* ------------------------------- */
/*        basic primitives         */
/* ------------------------------- */

static Lisp_Object
decode_buffer_or_string (Lisp_Object object)
{
  if (NILP (object))
    XSETBUFFER (object, current_buffer);
  else if (BUFFERP (object))
    CHECK_LIVE_BUFFER (object);
  else if (STRINGP (object))
    ;
  else
    dead_wrong_type_argument (Qbuffer_or_string_p, object);

  return object;
}

EXTENT
extent_ancestor_1 (EXTENT e)
{
  while (e->flags.has_parent)
    {
      /* There should be no circularities except in case of a logic
         error somewhere in the extent code */
      e = XEXTENT (XEXTENT_AUXILIARY (XCAR (e->plist))->parent);
    }
  return e;
}

/* Given an extent object (string or buffer or nil), return its extent info.
   This may be 0 for a string. */

static struct extent_info *
buffer_or_string_extent_info (Lisp_Object object)
{
  if (STRINGP (object))
    {
      Lisp_Object plist = XSTRING (object)->plist;
      if (!CONSP (plist) || !EXTENT_INFOP (XCAR (plist)))
        return 0;
      return XEXTENT_INFO (XCAR (plist));
    }
  else if (NILP (object))
    return 0;
  else
    return XEXTENT_INFO (XBUFFER (object)->extent_info);
}

/* Given a string or buffer, return its extent list.  This may be
   0 for a string. */

static Extent_List *
buffer_or_string_extent_list (Lisp_Object object)
{
  struct extent_info *info = buffer_or_string_extent_info (object);

  if (!info)
    return 0;
  return info->extents;
}

/* Given a string or buffer, return its extent info.  If it's not there,
   create it. */

static struct extent_info *
buffer_or_string_extent_info_force (Lisp_Object object)
{
  struct extent_info *info = buffer_or_string_extent_info (object);

  if (!info)
    {
      Lisp_Object extent_info;

      assert (STRINGP (object)); /* should never happen for buffers --
                                    the only buffers without an extent
                                    info are those after finalization,
                                    destroyed buffers, or special
                                    Lisp-inaccessible buffer objects. */
      extent_info = allocate_extent_info ();
      XSTRING (object)->plist = Fcons (extent_info, XSTRING (object)->plist);
      return XEXTENT_INFO (extent_info);
    }

  return info;
}

/* Detach all the extents in OBJECT.  Called from redisplay. */

void
detach_all_extents (Lisp_Object object)
{
  struct extent_info *data = buffer_or_string_extent_info (object);

  if (data)
    {
      if (data->extents)
        {
          int i;

          for (i = 0; i < extent_list_num_els (data->extents); i++)
            {
              EXTENT e = extent_list_at (data->extents, i, 0);
              /* No need to do detach_extent().  Just nuke the damn things,
                 which results in the equivalent but faster. */
              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);
      soe_invalidate (object);
    }
}


void
init_buffer_extents (struct buffer *b)
{
  b->extent_info = allocate_extent_info ();
}

void
uninit_buffer_extents (struct buffer *b)
{
  struct extent_info *data = XEXTENT_INFO (b->extent_info);

  /* Don't destroy the extents here -- there may still be children
     extents pointing to the extents. */
  detach_all_extents (make_buffer (b));
  finalize_extent_info (data, 0);
}

/* Retrieve the extent list that an extent is a member of; the
   return value will never be 0 except in destroyed buffers (in which
   case the only extents that can refer to this buffer are detached
   ones). */

#define extent_extent_list(e) buffer_or_string_extent_list (extent_object (e))

/* ------------------------------- */
/*        stack of extents         */
/* ------------------------------- */

#ifdef ERROR_CHECK_EXTENTS

void
sledgehammer_extent_check (Lisp_Object object)
{
  int i;
  int endp;
  Extent_List *el = buffer_or_string_extent_list (object);
  struct buffer *buf = 0;

  if (!el)
    return;

  if (BUFFERP (object))
    buf = XBUFFER (object);

  for (endp = 0; endp < 2; endp++)
    for (i = 1; i < extent_list_num_els (el); i++)
      {
        EXTENT e1 = extent_list_at (el, i-1, endp);
        EXTENT e2 = extent_list_at (el, i, endp);
        if (buf)
          {
            assert (extent_start (e1) <= buf->text->gpt ||
                    extent_start (e1) > buf->text->gpt + buf->text->gap_size);
            assert (extent_end (e1) <= buf->text->gpt ||
                    extent_end (e1) > buf->text->gpt + buf->text->gap_size);
          }
        assert (extent_start (e1) <= extent_end (e1));
        assert (endp ? (EXTENT_E_LESS_EQUAL (e1, e2)) :
                       (EXTENT_LESS_EQUAL (e1, e2)));
      }
}

#endif

static Stack_Of_Extents *
buffer_or_string_stack_of_extents (Lisp_Object object)
{
  struct extent_info *info = buffer_or_string_extent_info (object);
  if (!info)
    return 0;
  return info->soe;
}

static Stack_Of_Extents *
buffer_or_string_stack_of_extents_force (Lisp_Object object)
{
  struct extent_info *info = buffer_or_string_extent_info_force (object);
  if (!info->soe)
    info->soe = allocate_soe ();
  return info->soe;
}

/* #define SOE_DEBUG */

#ifdef SOE_DEBUG

static void print_extent_1 (char *buf, Lisp_Object extent);

static void
print_extent_2 (EXTENT e)
{
  Lisp_Object extent;
  char buf[200];

  XSETEXTENT (extent, e);
  print_extent_1 (buf, extent);
  fputs (buf, stdout);
}

static void
soe_dump (Lisp_Object obj)
{
  int i;
  Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);
  Extent_List *sel;
  int endp;

  if (!soe)
    {
      printf ("No SOE");
      return;
    }
  sel = soe->extents;
  printf ("SOE pos is %d (memind %d)\n",
          soe->pos < 0 ? soe->pos :
          buffer_or_string_memind_to_bytind (obj, soe->pos),
          soe->pos);
  for (endp = 0; endp < 2; endp++)
    {
      printf (endp ? "SOE end:" : "SOE start:");
      for (i = 0; i < extent_list_num_els (sel); i++)
        {
          EXTENT e = extent_list_at (sel, i, endp);
          putchar ('\t');
          print_extent_2 (e);
        }
      putchar ('\n');
    }
  putchar ('\n');
}

#endif

/* Insert EXTENT into OBJ's stack of extents, if necessary. */

static void
soe_insert (Lisp_Object obj, EXTENT extent)
{
  Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);

#ifdef SOE_DEBUG
  printf ("Inserting into SOE: ");
  print_extent_2 (extent);
  putchar ('\n');
#endif
  if (!soe || soe->pos < extent_start (extent) ||
      soe->pos > extent_end (extent))
    {
#ifdef SOE_DEBUG
      printf ("(not needed)\n\n");
#endif
      return;
    }
  extent_list_insert (soe->extents, extent);
#ifdef SOE_DEBUG
  puts ("SOE afterwards is:");
  soe_dump (obj);
#endif
}

/* Delete EXTENT from OBJ's stack of extents, if necessary. */

static void
soe_delete (Lisp_Object obj, EXTENT extent)
{
  Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);

#ifdef SOE_DEBUG
  printf ("Deleting from SOE: ");
  print_extent_2 (extent);
  putchar ('\n');
#endif
  if (!soe || soe->pos < extent_start (extent) ||
      soe->pos > extent_end (extent))
    {
#ifdef SOE_DEBUG
      puts ("(not needed)\n");
#endif
      return;
    }
  extent_list_delete (soe->extents, extent);
#ifdef SOE_DEBUG
  puts ("SOE afterwards is:");
  soe_dump (obj);
#endif
}

/* Move OBJ's stack of extents to lie over the specified position. */

static void
soe_move (Lisp_Object obj, Memind pos)
{
  Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
  Extent_List *sel = soe->extents;
  int numsoe = extent_list_num_els (sel);
  Extent_List *bel = buffer_or_string_extent_list (obj);
  int direction;
  int endp;

#ifdef ERROR_CHECK_EXTENTS
  assert (bel);
#endif

#ifdef SOE_DEBUG
  printf ("Moving SOE from %d (memind %d) to %d (memind %d)\n",
          soe->pos < 0 ? soe->pos :
          buffer_or_string_memind_to_bytind (obj, soe->pos), soe->pos,
          buffer_or_string_memind_to_bytind (obj, pos), pos);
#endif
  if (soe->pos < pos)
    {
      direction = 1;
      endp = 0;
    }
  else if (soe->pos > pos)
    {
      direction = -1;
      endp = 1;
    }
  else
    {
#ifdef SOE_DEBUG
      puts ("(not needed)\n");
#endif
      return;
    }

  /* For DIRECTION = 1: Any extent that overlaps POS is either in the
     SOE (if the extent starts at or before SOE->POS) or is greater
     (in the display order) than any extent in the SOE (if it starts
     after SOE->POS).

     For DIRECTION = -1: Any extent that overlaps POS is either in the
     SOE (if the extent ends at or after SOE->POS) or is less (in the
     e-order) than any extent in the SOE (if it ends before SOE->POS).

     We proceed in two stages:

     1) delete all extents in the SOE that don't overlap POS.
     2) insert all extents into the SOE that start (or end, when
        DIRECTION = -1) in (SOE->POS, POS] and that overlap
        POS. (Don't include SOE->POS in the range because those
        extents would already be in the SOE.)
   */

  /* STAGE 1. */

  if (numsoe > 0)
    {
      /* Delete all extents in the SOE that don't overlap POS.
         This is all extents that end before (or start after,
         if DIRECTION = -1) POS.
       */

      /* Deleting extents from the SOE is tricky because it changes
         the positions of extents.  If we are deleting in the forward
         direction we have to call extent_list_at() on the same position
         over and over again because positions after the deleted element
         get shifted back by 1.  To make life simplest, we delete forward
         irrespective of DIRECTION.
       */
      int start, end;
      int i;

      if (direction > 0)
        {
          start = 0;
          end = extent_list_locate_from_pos (sel, pos, 1);
        }
      else
        {
          start = extent_list_locate_from_pos (sel, pos+1, 0);
          end = numsoe;
        }

      for (i = start; i < end; i++)
        extent_list_delete (sel, extent_list_at (sel, start /* see above */,
                                                 !endp));
    }

  /* STAGE 2. */

  {
    int start_pos;

    if (direction < 0)
      start_pos = extent_list_locate_from_pos (bel, soe->pos, endp) - 1;
    else
      start_pos = extent_list_locate_from_pos (bel, soe->pos + 1, endp);

    for (; start_pos >= 0 && start_pos < extent_list_num_els (bel);
         start_pos += direction)
      {
        EXTENT e = extent_list_at (bel, start_pos, endp);
        if ((direction > 0) ?
            (extent_start (e) > pos) :
            (extent_end (e) < pos))
          break; /* All further extents lie on the far side of POS
                    and thus can't overlap. */
        if ((direction > 0) ?
            (extent_end (e) >= pos) :
            (extent_start (e) <= pos))
          extent_list_insert (sel, e);
      }
  }

  soe->pos = pos;
#ifdef SOE_DEBUG
  puts ("SOE afterwards is:");
  soe_dump (obj);
#endif
}

static void
soe_invalidate (Lisp_Object obj)
{
  Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (obj);

  if (soe)
    {
      extent_list_delete_all (soe->extents);
      soe->pos = -1;
    }
}

static struct stack_of_extents *
allocate_soe (void)
{
  struct stack_of_extents *soe = xnew_and_zero (struct stack_of_extents);
  soe->extents = allocate_extent_list ();
  soe->pos = -1;
  return soe;
}

static void
free_soe (struct stack_of_extents *soe)
{
  free_extent_list (soe->extents);
  xfree (soe);
}

/* ------------------------------- */
/*        other primitives         */
/* ------------------------------- */

/* Return the start (endp == 0) or end (endp == 1) of an extent as
   a byte index.  If you want the value as a memory index, use
   extent_endpoint().  If you want the value as a buffer position,
   use extent_endpoint_bufpos(). */

static Bytind
extent_endpoint_bytind (EXTENT extent, int endp)
{
  assert (EXTENT_LIVE_P (extent));
  assert (!extent_detached_p (extent));
  {
    Memind i = endp ? extent_end (extent) : extent_start (extent);
    Lisp_Object obj = extent_object (extent);
    return buffer_or_string_memind_to_bytind (obj, i);
  }
}

static Bufpos
extent_endpoint_bufpos (EXTENT extent, int endp)
{
  assert (EXTENT_LIVE_P (extent));
  assert (!extent_detached_p (extent));
  {
    Memind i = endp ? extent_end (extent) : extent_start (extent);
    Lisp_Object obj = extent_object (extent);
    return buffer_or_string_memind_to_bufpos (obj, i);
  }
}

/* A change to an extent occurred that will change the display, so
   notify redisplay.  Maybe also recurse over all the extent's
   descendants. */

static void
extent_changed_for_redisplay (EXTENT extent, int descendants_too,
                              int invisibility_change)
{
  Lisp_Object object;
  Lisp_Object rest;

  /* we could easily encounter a detached extent while traversing the
     children, but we should never be able to encounter a dead extent. */
  assert (EXTENT_LIVE_P (extent));

  if (descendants_too)
    {
      Lisp_Object children = extent_children (extent);

      if (!NILP (children))
        {
          /* first mark all of the extent's children.  We will lose big-time
             if there are any circularities here, so we sure as hell better
             ensure that there aren't. */
          LIST_LOOP (rest, XWEAK_LIST_LIST (children))
            extent_changed_for_redisplay (XEXTENT (XCAR (rest)), 1,
                                          invisibility_change);
        }
    }

  /* now mark the extent itself. */

  object = extent_object (extent);

  if (!BUFFERP (object) || extent_detached_p (extent))
    /* #### Can changes to string extents affect redisplay?
       I will have to think about this.  What about string glyphs?
       Things in the modeline? etc. */
    /* #### changes to string extents can certainly affect redisplay
       if the extent is in some generated-modeline-string: when
       we change an extent in generated-modeline-string, this changes
       its parent, which is in `modeline-format', so we should
       force the modeline to be updated.  But how to determine whether
       a string is a `generated-modeline-string'?  Looping through
       all buffers is not very efficient.  Should we add all
       `generated-modeline-string' strings to a hash table?
       Maybe efficiency is not the greatest concern here and there's
       no big loss in looping over the buffers. */
    return;

  {
    struct buffer *b;
    b = XBUFFER (object);
    BUF_FACECHANGE (b)++;
    MARK_EXTENTS_CHANGED;
    if (invisibility_change)
      MARK_CLIP_CHANGED;
    buffer_extent_signal_changed_region (b,
                                         extent_endpoint_bufpos (extent, 0),
                                         extent_endpoint_bufpos (extent, 1));
  }
}

/* A change to an extent occurred that might affect redisplay.
   This is called when properties such as the endpoints, the layout,
   or the priority changes.  Redisplay will be affected only if
   the extent has any displayable attributes. */

static void
extent_maybe_changed_for_redisplay (EXTENT extent, int descendants_too,
                                    int invisibility_change)
{
  /* Retrieve the ancestor for efficiency */
  EXTENT anc = extent_ancestor (extent);
  if (!NILP (extent_face        (anc)) ||
      !NILP (extent_begin_glyph (anc)) ||
      !NILP (extent_end_glyph   (anc)) ||
      !NILP (extent_mouse_face  (anc)) ||
      !NILP (extent_invisible   (anc)) ||
      !NILP (extent_initial_redisplay_function (anc)) ||
      invisibility_change)
    extent_changed_for_redisplay (extent, descendants_too,
                                  invisibility_change);
}

static EXTENT
make_extent_detached (Lisp_Object object)
{
  EXTENT extent = allocate_extent ();

  assert (NILP (object) || STRINGP (object) ||
          (BUFFERP (object) && BUFFER_LIVE_P (XBUFFER (object))));
  extent_object (extent) = object;
  /* Now make sure the extent info exists. */
  if (!NILP (object))
    buffer_or_string_extent_info_force (object);
  return extent;
}

/* A "real" extent is any extent other than the internal (not-user-visible)
   extents used by `map-extents'. */

static EXTENT
real_extent_at_forward (Extent_List *el, int pos, int endp)
{
  for (; pos < extent_list_num_els (el); pos++)
    {
      EXTENT e = extent_list_at (el, pos, endp);
      if (!extent_internal_p (e))
        return e;
    }
  return 0;
}

static EXTENT
real_extent_at_backward (Extent_List *el, int pos, int endp)
{
  for (; pos >= 0; pos--)
    {
      EXTENT e = extent_list_at (el, pos, endp);
      if (!extent_internal_p (e))
        return e;
    }
  return 0;
}

static EXTENT
extent_first (Lisp_Object obj)
{
  Extent_List *el = buffer_or_string_extent_list (obj);

  if (!el)
    return 0;
  return real_extent_at_forward (el, 0, 0);
}

#ifdef DEBUG_XEMACS
static EXTENT
extent_e_first (Lisp_Object obj)
{
  Extent_List *el = buffer_or_string_extent_list (obj);

  if (!el)
    return 0;
  return real_extent_at_forward (el, 0, 1);
}
#endif

static EXTENT
extent_next (EXTENT e)
{
  Extent_List *el = extent_extent_list (e);
  int foundp;
  int pos = extent_list_locate (el, e, 0, &foundp);
  assert (foundp);
  return real_extent_at_forward (el, pos+1, 0);
}

#ifdef DEBUG_XEMACS
static EXTENT
extent_e_next (EXTENT e)
{
  Extent_List *el = extent_extent_list (e);
  int foundp;
  int pos = extent_list_locate (el, e, 1, &foundp);
  assert (foundp);
  return real_extent_at_forward (el, pos+1, 1);
}
#endif

static EXTENT
extent_last (Lisp_Object obj)
{
  Extent_List *el = buffer_or_string_extent_list (obj);

  if (!el)
    return 0;
  return real_extent_at_backward (el, extent_list_num_els (el) - 1, 0);
}

#ifdef DEBUG_XEMACS
static EXTENT
extent_e_last (Lisp_Object obj)
{
  Extent_List *el = buffer_or_string_extent_list (obj);

  if (!el)
    return 0;
  return real_extent_at_backward (el, extent_list_num_els (el) - 1, 1);
}
#endif

static EXTENT
extent_previous (EXTENT e)
{
  Extent_List *el = extent_extent_list (e);
  int foundp;
  int pos = extent_list_locate (el, e, 0, &foundp);
  assert (foundp);
  return real_extent_at_backward (el, pos-1, 0);
}

#ifdef DEBUG_XEMACS
static EXTENT
extent_e_previous (EXTENT e)
{
  Extent_List *el = extent_extent_list (e);
  int foundp;
  int pos = extent_list_locate (el, e, 1, &foundp);
  assert (foundp);
  return real_extent_at_backward (el, pos-1, 1);
}
#endif

static void
extent_attach (EXTENT extent)
{
  Extent_List *el = extent_extent_list (extent);

  extent_list_insert (el, extent);
  soe_insert (extent_object (extent), extent);
  /* only this extent changed */
  extent_maybe_changed_for_redisplay (extent, 0,
                                      !NILP (extent_invisible (extent)));
}

static void
extent_detach (EXTENT extent)
{
  Extent_List *el;

  if (extent_detached_p (extent))
    return;
  el = extent_extent_list (extent);

  /* call this before messing with the extent. */
  extent_maybe_changed_for_redisplay (extent, 0,
                                      !NILP (extent_invisible (extent)));
  extent_list_delete (el, extent);
  soe_delete (extent_object (extent), extent);
  set_extent_start (extent, -1);
  set_extent_end (extent, -1);
}

/* ------------------------------- */
/*        map-extents et al.       */
/* ------------------------------- */

/* Returns true iff map_extents() would visit the given extent.
   See the comments at map_extents() for info on the overlap rule.
   Assumes that all validation on the extent and buffer positions has
   already been performed (see Fextent_in_region_p ()).
 */
static int
extent_in_region_p (EXTENT extent, Bytind from, Bytind to,
                    unsigned int flags)
{
  Lisp_Object obj = extent_object (extent);
  Endpoint_Index start, end, exs, exe;
  int start_open, end_open;
  unsigned int all_extents_flags = flags & ME_ALL_EXTENTS_MASK;
  unsigned int in_region_flags   = flags & ME_IN_REGION_MASK;
  int retval;

  /* A zero-length region is treated as closed-closed. */
  if (from == to)
    {
      flags |= ME_END_CLOSED;
      flags &= ~ME_START_OPEN;
    }

  /* So is a zero-length extent. */
  if (extent_start (extent) == extent_end (extent))
    start_open = 0, end_open = 0;
  /* `all_extents_flags' will almost always be zero. */
  else if (all_extents_flags == 0)
    {
      start_open = extent_start_open_p (extent);
      end_open   = extent_end_open_p   (extent);
    }
  else
    switch (all_extents_flags)
      {
      case ME_ALL_EXTENTS_CLOSED:      start_open = 0, 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(); break;
      }

  start = buffer_or_string_bytind_to_startind (obj, from,
                                               flags & ME_START_OPEN);
  end = buffer_or_string_bytind_to_endind (obj, to, ! (flags & ME_END_CLOSED));
  exs = memind_to_startind (extent_start (extent), start_open);
  exe = memind_to_endind   (extent_end   (extent), end_open);

  /* It's easy to determine whether an extent lies *outside* the
     region -- just determine whether it's completely before
     or completely after the region.  Reject all such extents, so
     we're now left with only the extents that overlap the region.
   */

  if (exs > end || exe < start)
    return 0;

  /* See if any further restrictions are called for. */
  /* in_region_flags will almost always be zero. */
  if (in_region_flags == 0)
    retval = 1;
  else
    switch (in_region_flags)
      {
      case ME_START_IN_REGION:
        retval = start <= exs && exs <= end; break;
      case ME_END_IN_REGION:
        retval = start <= exe && exe <= end; break;
      case ME_START_AND_END_IN_REGION:
        retval = start <= exs && exe <= end; break;
      case ME_START_OR_END_IN_REGION:
        retval = (start <= exs && exs <= end) || (start <= exe && exe <= end);
        break;
      default:
        abort(); break;
      }
  return flags & ME_NEGATE_IN_REGION ? !retval : retval;
}

struct map_extents_struct
{
  Extent_List *el;
  Extent_List_Marker *mkr;
  EXTENT range;
};

static Lisp_Object
map_extents_unwind (Lisp_Object obj)
{
  struct map_extents_struct *closure =
    (struct map_extents_struct *) get_opaque_ptr (obj);
  free_opaque_ptr (obj);
  if (closure->range)
    extent_detach (closure->range);
  if (closure->mkr)
    extent_list_delete_marker (closure->el, closure->mkr);
  return Qnil;
}

/* This is the guts of `map-extents' and the other functions that
   map over extents.  In theory the operation of this function is
   simple: just figure out what extents we're mapping over, and
   call the function on each one of them in the range.  Unfortunately
   there are a wide variety of things that the mapping function
   might do, and we have to be very tricky to avoid getting messed
   up.  Furthermore, this function needs to be very fast (it is
   called multiple times every time text is inserted or deleted
   from a buffer), and so we can't always afford the overhead of
   dealing with all the possible things that the mapping function
   might do; thus, there are many flags that can be specified
   indicating what the mapping function might or might not do.

   The result of all this is that this is the most complicated
   function in this file.  Change it at your own risk!

   A potential simplification to the logic below is to determine
   all the extents that the mapping function should be called on
   before any calls are actually made and save them in an array.
   That introduces its own complications, however (the array
   needs to be marked for garbage-collection, and a static array
   cannot be used because map_extents() needs to be reentrant).
   Furthermore, the results might be a little less sensible than
   the logic below. */


static void
map_extents_bytind (Bytind from, Bytind to, map_extents_fun fn, void *arg,
                    Lisp_Object obj, EXTENT after, unsigned int flags)
{
  Memind st, en; /* range we're mapping over */
  EXTENT range = 0; /* extent for this, if ME_MIGHT_MODIFY_TEXT */
  Extent_List *el = 0; /* extent list we're iterating over */
  Extent_List_Marker *posm = 0; /* marker for extent list,
                                   if ME_MIGHT_MODIFY_EXTENTS */
  /* count and struct for unwind-protect, if ME_MIGHT_THROW */
  int count = 0;
  struct map_extents_struct closure;

#ifdef ERROR_CHECK_EXTENTS
  assert (from <= to);
  assert (from >= buffer_or_string_absolute_begin_byte (obj) &&
          from <= buffer_or_string_absolute_end_byte (obj) &&
          to >= buffer_or_string_absolute_begin_byte (obj) &&
          to <= buffer_or_string_absolute_end_byte (obj));
#endif

  if (after)
    {
      assert (EQ (obj, extent_object (after)));
      assert (!extent_detached_p (after));
    }

  el = buffer_or_string_extent_list (obj);
  if (!el || !extent_list_num_els(el))
    return;
  el = 0;

  st = buffer_or_string_bytind_to_memind (obj, from);
  en = buffer_or_string_bytind_to_memind (obj, to);

  if (flags & ME_MIGHT_MODIFY_TEXT)
    {
      /* The mapping function might change the text in the buffer,
         so make an internal extent to hold the range we're mapping
         over. */
      range = make_extent_detached (obj);
      set_extent_start (range, st);
      set_extent_end (range, en);
      range->flags.start_open = flags & ME_START_OPEN;
      range->flags.end_open = !(flags & ME_END_CLOSED);
      range->flags.internal = 1;
      range->flags.detachable = 0;
      extent_attach (range);
    }

  if (flags & ME_MIGHT_THROW)
    {
      /* The mapping function might throw past us so we need to use an
         unwind_protect() to eliminate the internal extent and range
         that we use. */
      count = specpdl_depth ();
      closure.range = range;
      closure.mkr = 0;
      record_unwind_protect (map_extents_unwind,
                             make_opaque_ptr (&closure));
    }

  /* ---------- Figure out where we start and what direction
                we move in.  This is the trickiest part of this
                function. ---------- */

  /* If ME_START_IN_REGION, ME_END_IN_REGION or ME_START_AND_END_IN_REGION
     was specified and ME_NEGATE_IN_REGION was not specified, our job
     is simple because of the presence of the display order and e-order.
     (Note that theoretically do something similar for
     ME_START_OR_END_IN_REGION, but that would require more trickiness
     than it's worth to avoid hitting the same extent twice.)

     In the general case, all the extents that overlap a range can be
     divided into two classes: those whose start position lies within
     the range (including the range's end but not including the
     range's start), and those that overlap the start position,
     i.e. those in the SOE for the start position.  Or equivalently,
     the extents can be divided into those whose end position lies
     within the range and those in the SOE for the end position.  Note
     that for this purpose we treat both the range and all extents in
     the buffer as closed on both ends.  If this is not what the ME_
     flags specified, then we've mapped over a few too many extents,
     but no big deal because extent_in_region_p() will filter them
     out.   Ideally, we could move the SOE to the closer of the range's
     two ends and work forwards or backwards from there.  However, in
     order to make the semantics of the AFTER argument work out, we
     have to always go in the same direction; so we choose to always
     move the SOE to the start position.

     When it comes time to do the SOE stage, we first call soe_move()
     so that the SOE gets set up.  Note that the SOE might get
     changed while we are mapping over its contents.  If we can
     guarantee that the SOE won't get moved to a new position, we
     simply need to put a marker in the SOE and we will track deletions
     and insertions of extents in the SOE.  If the SOE might get moved,
     however (this would happen as a result of a recursive invocation
     of map-extents or a call to a redisplay-type function), then
     trying to track its changes is hopeless, so we just keep a
     marker to the first (or last) extent in the SOE and use that as
     our bound.

     Finally, if DONT_USE_SOE is defined, we don't use the SOE at all
     and instead just map from the beginning of the buffer.  This is
     used for testing purposes and allows the SOE to be calculated
     using map_extents() instead of the other way around. */

  {
    int range_flag; /* ME_*_IN_REGION subset of flags */
    int do_soe_stage = 0; /* Are we mapping over the SOE? */
    /* Does the range stage map over start or end positions? */
    int range_endp;
    /* If type == 0, we include the start position in the range stage mapping.
       If type == 1, we exclude the start position in the range stage mapping.
       If type == 2, we begin at range_start_pos, an extent-list position.
     */
    int range_start_type = 0;
    int range_start_pos = 0;
    int stage;

    range_flag = flags & ME_IN_REGION_MASK;
    if ((range_flag == ME_START_IN_REGION ||
         range_flag == ME_START_AND_END_IN_REGION) &&
        !(flags & ME_NEGATE_IN_REGION))
      {
        /* map over start position in [range-start, range-end].  No SOE
           stage. */
        range_endp = 0;
      }
    else if (range_flag == ME_END_IN_REGION && !(flags & ME_NEGATE_IN_REGION))
      {
        /* map over end position in [range-start, range-end].  No SOE
           stage. */
        range_endp = 1;
      }
    else
      {
        /* Need to include the SOE extents. */
#ifdef DONT_USE_SOE
        /* Just brute-force it: start from the beginning. */
        range_endp = 0;
        range_start_type = 2;
        range_start_pos = 0;
#else
        Stack_Of_Extents *soe = buffer_or_string_stack_of_extents_force (obj);
        int numsoe;

        /* Move the SOE to the closer end of the range.  This dictates
           whether we map over start positions or end positions. */
        range_endp = 0;
        soe_move (obj, st);
        numsoe = extent_list_num_els (soe->extents);
        if (numsoe)
          {
            if (flags & ME_MIGHT_MOVE_SOE)
              {
                int foundp;
                /* Can't map over SOE, so just extend range to cover the
                   SOE. */
                EXTENT e = extent_list_at (soe->extents, 0, 0);
                range_start_pos =
                  extent_list_locate (buffer_or_string_extent_list (obj), e, 0,
                                      &foundp);
                assert (foundp);
                range_start_type = 2;
              }
            else
              {
                /* We can map over the SOE. */
                do_soe_stage = 1;
                range_start_type = 1;
              }
          }
        else
          {
            /* No extents in the SOE to map over, so we act just as if
               ME_START_IN_REGION or ME_END_IN_REGION was specified.
               RANGE_ENDP already specified so no need to do anything else. */
          }
      }
#endif

  /* ---------- Now loop over the extents. ---------- */

    /* We combine the code for the two stages because much of it
       overlaps. */
    for (stage = 0; stage < 2; stage++)
      {
        int pos = 0; /* Position in extent list */

        /* First set up start conditions */
        if (stage == 0)
          { /* The SOE stage */
            if (!do_soe_stage)
              continue;
            el = buffer_or_string_stack_of_extents_force (obj)->extents;
            /* We will always be looping over start extents here. */
            assert (!range_endp);
            pos = 0;
          }
        else
          { /* The range stage */
            el = buffer_or_string_extent_list (obj);
            switch (range_start_type)
              {
              case 0:
                pos = extent_list_locate_from_pos (el, st, range_endp);
                break;
              case 1:
                pos = extent_list_locate_from_pos (el, st + 1, range_endp);
                break;
              case 2:
                pos = range_start_pos;
                break;
              }
          }

        if (flags & ME_MIGHT_MODIFY_EXTENTS)
          {
            /* Create a marker to track changes to the extent list */
            if (posm)
              /* Delete the marker used in the SOE stage. */
              extent_list_delete_marker
                (buffer_or_string_stack_of_extents_force (obj)->extents, posm);
            posm = extent_list_make_marker (el, pos, range_endp);
            /* tell the unwind function about the marker. */
            closure.el = el;
            closure.mkr = posm;
          }

        /* Now loop! */
        for (;;)
          {
            EXTENT e;
            Lisp_Object obj2;

            /* ----- update position in extent list
                     and fetch next extent ----- */

            if (posm)
              /* fetch POS again to track extent insertions or deletions */
              pos = extent_list_marker_pos (el, posm);
            if (pos >= extent_list_num_els (el))
              break;
            e = extent_list_at (el, pos, range_endp);
            pos++;
            if (posm)
              /* now point the marker to the next one we're going to process.
                 This ensures graceful behavior if this extent is deleted. */
              extent_list_move_marker (el, posm, pos);

            /* ----- deal with internal extents ----- */

            if (extent_internal_p (e))
              {
                if (!(flags & ME_INCLUDE_INTERNAL))
                  continue;
                else if (e == range)
                  {
                    /* We're processing internal extents and we've
                       come across our own special range extent.
                       (This happens only in adjust_extents*() and
                       process_extents*(), which handle text
                       insertion and deletion.) We need to omit
                       processing of this extent; otherwise
                       we will probably end up prematurely
                       terminating this loop. */
                    continue;
                  }
              }

            /* ----- deal with AFTER condition ----- */

            if (after)
              {
                /* if e > after, then we can stop skipping extents. */
                if (EXTENT_LESS (after, e))
                  after = 0;
                else /* otherwise, skip this extent. */
                  continue;
              }

            /* ----- stop if we're completely outside the range ----- */

            /* fetch ST and EN again to track text insertions or deletions */
            if (range)
              {
                st = extent_start (range);
                en = extent_end (range);
              }
            if (extent_endpoint (e, range_endp) > en)
              {
                /* Can't be mapping over SOE because all extents in
                   there should overlap ST */
                assert (stage == 1);
                break;
              }

            /* ----- Now actually call the function ----- */

            obj2 = extent_object (e);
            if (extent_in_region_p (e,
                                    buffer_or_string_memind_to_bytind (obj2,
                                                                       st),
                                    buffer_or_string_memind_to_bytind (obj2,
                                                                       en),
                                    flags))
              {
                if ((*fn)(e, arg))
                  {
                    /* Function wants us to stop mapping. */
                    stage = 1; /* so outer for loop will terminate */
                    break;
                  }
              }
          }
      }
  /* ---------- Finished looping. ---------- */
  }

  if (flags & ME_MIGHT_THROW)
    /* This deletes the range extent and frees the marker. */
    unbind_to (count, Qnil);
  else
    {
      /* Delete them ourselves */
      if (range)
        extent_detach (range);
      if (posm)
        extent_list_delete_marker (el, posm);
    }
}

void
map_extents (Bufpos from, Bufpos to, map_extents_fun fn,
             void *arg, Lisp_Object obj, EXTENT after, unsigned int flags)
{
  map_extents_bytind (buffer_or_string_bufpos_to_bytind (obj, from),
                      buffer_or_string_bufpos_to_bytind (obj, to), fn, arg,
                      obj, after, flags);
}

/* ------------------------------- */
/*         adjust_extents()        */
/* ------------------------------- */

/* Add AMOUNT to all extent endpoints in the range (FROM, TO].  This
   happens whenever the gap is moved or (under Mule) a character in a
   string is substituted for a different-length one.  The reason for
   this is that extent endpoints behave just like markers (all memory
   indices do) and this adjustment correct for markers -- see
   adjust_markers().  Note that it is important that we visit all
   extent endpoints in the range, irrespective of whether the
   endpoints are open or closed.

   We could use map_extents() for this (and in fact the function
   was originally written that way), but the gap is in an incoherent
   state when this function is called and this function plays
   around with extent endpoints without detaching and reattaching
   the extents (this is provably correct and saves lots of time),
   so for safety we make it just look at the extent lists directly. */

void
adjust_extents (Lisp_Object obj, Memind from, Memind to, int amount)
{
  int endp;
  int pos;
  int startpos[2];
  Extent_List *el;
  Stack_Of_Extents *soe;

#ifdef ERROR_CHECK_EXTENTS
  sledgehammer_extent_check (obj);
#endif
  el = buffer_or_string_extent_list (obj);

  if (!el || !extent_list_num_els(el))
    return;

  /* IMPORTANT! Compute the starting positions of the extents to
     modify BEFORE doing any modification!  Otherwise the starting
     position for the second time through the loop might get
     incorrectly calculated (I got bit by this bug real bad). */
  startpos[0] = extent_list_locate_from_pos (el, from+1, 0);
  startpos[1] = extent_list_locate_from_pos (el, from+1, 1);
  for (endp = 0; endp < 2; endp++)
    {
      for (pos = startpos[endp]; pos < extent_list_num_els (el);
           pos++)
        {
          EXTENT e = extent_list_at (el, pos, endp);
          if (extent_endpoint (e, endp) > to)
            break;
          set_extent_endpoint (e,
                               do_marker_adjustment (extent_endpoint (e, endp),
                                                     from, to, amount),
                               endp);
        }
    }

  /* The index for the buffer's SOE is a memory index and thus
     needs to be adjusted like a marker. */
  soe = buffer_or_string_stack_of_extents (obj);
  if (soe && soe->pos >= 0)
    soe->pos = do_marker_adjustment (soe->pos, from, to, amount);
}

/* ------------------------------- */
/*  adjust_extents_for_deletion()  */
/* ------------------------------- */

struct adjust_extents_for_deletion_arg
{
  EXTENT_dynarr *list;
};

static int
adjust_extents_for_deletion_mapper (EXTENT extent, void *arg)
{
  struct adjust_extents_for_deletion_arg *closure =
    (struct adjust_extents_for_deletion_arg *) arg;

  Dynarr_add (closure->list, extent);
  return 0; /* continue mapping */
}

/* For all extent endpoints in the range (FROM, TO], move them to the beginning
   of the new gap.   Note that it is important that we visit all extent
   endpoints in the range, irrespective of whether the endpoints are open or
   closed.

   This function deals with weird stuff such as the fact that extents
   may get reordered.

   There is no string correspondent for this because you can't
   delete characters from a string.
 */

void
adjust_extents_for_deletion (Lisp_Object object, Bytind from,
                             Bytind to, int gapsize, int numdel,
                             int movegapsize)
{
  struct adjust_extents_for_deletion_arg closure;
  int i;
  Memind adjust_to = (Memind) (to + gapsize);
  Bytecount amount = - numdel - movegapsize;
  Memind oldsoe = 0, newsoe = 0;
  Stack_Of_Extents *soe = buffer_or_string_stack_of_extents (object);

#ifdef ERROR_CHECK_EXTENTS
  sledgehammer_extent_check (object);
#endif
  closure.list = Dynarr_new (EXTENT);

  /* We're going to be playing weird games below with extents and the SOE
     and such, so compute the list now of all the extents that we're going
     to muck with.  If we do the mapping and adjusting together, things can
     get all screwed up. */

  map_extents_bytind (from, to, adjust_extents_for_deletion_mapper,
                      (void *) &closure, object, 0,
                      /* extent endpoints move like markers regardless
                         of their open/closeness. */
                      ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
                      ME_START_OR_END_IN_REGION | ME_INCLUDE_INTERNAL);

  /*
    Old and new values for the SOE's position. (It gets adjusted
    like a marker, just like extent endpoints.)
  */

  if (soe)
    {
      oldsoe = soe->pos;
      if (soe->pos >= 0)
        newsoe = do_marker_adjustment (soe->pos,
                                                adjust_to, adjust_to,
                                                amount);
      else
        newsoe = soe->pos;
    }

  for (i = 0; i < Dynarr_length (closure.list); i++)
    {
      EXTENT extent = Dynarr_at (closure.list, i);
      Memind new_start = extent_start (extent);
      Memind new_end = extent_end (extent);

      /* do_marker_adjustment() will not adjust values that should not be
         adjusted.  We're passing the same funky arguments to
         do_marker_adjustment() as buffer_delete_range() does. */
      new_start =
        do_marker_adjustment (new_start,
                                       adjust_to, adjust_to,
                                       amount);
      new_end =
        do_marker_adjustment (new_end,
                                       adjust_to, adjust_to,
                                       amount);

      /* We need to be very careful here so that the SOE doesn't get
         corrupted.  We are shrinking extents out of the deleted region
         and simultaneously moving the SOE's pos out of the deleted
         region, so the SOE should contain the same extents at the end
         as at the beginning.  However, extents may get reordered
         by this process, so we have to operate by pulling the extents
         out of the buffer and SOE, changing their bounds, and then
         reinserting them.  In order for the SOE not to get screwed up,
         we have to make sure that the SOE's pos points to its old
         location whenever we pull an extent out, and points to its
         new location whenever we put the extent back in.
       */

      if (new_start != extent_start (extent) ||
          new_end != extent_end (extent))
        {
          extent_detach (extent);
          set_extent_start (extent, new_start);
          set_extent_end (extent, new_end);
          if (soe)
            soe->pos = newsoe;
          extent_attach (extent);
          if (soe)
            soe->pos = oldsoe;
        }
    }

  if (soe)
    soe->pos = newsoe;

#ifdef ERROR_CHECK_EXTENTS
  sledgehammer_extent_check (object);
#endif
  Dynarr_free (closure.list);
}

/* ------------------------------- */
/*         extent fragments        */
/* ------------------------------- */

/* Imagine that the buffer is divided up into contiguous,
   nonoverlapping "runs" of text such that no extent
   starts or ends within a run (extents that abut the
   run don't count).

   An extent fragment is a structure that holds data about
   the run that contains a particular buffer position (if
   the buffer position is at the junction of two runs, the
   run after the position is used) -- the beginning and
   end of the run, a list of all of the extents in that
   run, the "merged face" that results from merging all of
   the faces corresponding to those extents, the begin and
   end glyphs at the beginning of the run, etc.  This is
   the information that redisplay needs in order to
   display this run.

   Extent fragments have to be very quick to update to
   a new buffer position when moving linearly through
   the buffer.  They rely on the stack-of-extents code,
   which does the heavy-duty algorithmic work of determining
   which extents overly a particular position. */

/* This function returns the position of the beginning of
   the first run that begins after POS, or returns POS if
   there are no such runs. */

static Bytind
extent_find_end_of_run (Lisp_Object obj, Bytind pos, int outside_accessible)
{
  Extent_List *sel;
  Extent_List *bel = buffer_or_string_extent_list (obj);
  Bytind pos1, pos2;
  int elind1, elind2;
  Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
  Bytind limit = outside_accessible ?
    buffer_or_string_absolute_end_byte (obj) :
      buffer_or_string_accessible_end_byte (obj);

  if (!bel || !extent_list_num_els(bel))
    return limit;

  sel = buffer_or_string_stack_of_extents_force (obj)->extents;
  soe_move (obj, mempos);

  /* Find the first start position after POS. */
  elind1 = extent_list_locate_from_pos (bel, mempos+1, 0);
  if (elind1 < extent_list_num_els (bel))
    pos1 = buffer_or_string_memind_to_bytind
      (obj, extent_start (extent_list_at (bel, elind1, 0)));
  else
    pos1 = limit;

  /* Find the first end position after POS.  The extent corresponding
     to this position is either in the SOE or is greater than or
     equal to POS1, so we just have to look in the SOE. */
  elind2 = extent_list_locate_from_pos (sel, mempos+1, 1);
  if (elind2 < extent_list_num_els (sel))
    pos2 = buffer_or_string_memind_to_bytind
      (obj, extent_end (extent_list_at (sel, elind2, 1)));
  else
    pos2 = limit;

  return min (min (pos1, pos2), limit);
}

static Bytind
extent_find_beginning_of_run (Lisp_Object obj, Bytind pos,
                              int outside_accessible)
{
  Extent_List *sel;
  Extent_List *bel = buffer_or_string_extent_list (obj);
  Bytind pos1, pos2;
  int elind1, elind2;
  Memind mempos = buffer_or_string_bytind_to_memind (obj, pos);
  Bytind limit = outside_accessible ?
    buffer_or_string_absolute_begin_byte (obj) :
      buffer_or_string_accessible_begin_byte (obj);

  if (!bel || !extent_list_num_els(bel))
    return limit;

  sel = buffer_or_string_stack_of_extents_force (obj)->extents;
  soe_move (obj, mempos);

  /* Find the first end position before POS. */
  elind1 = extent_list_locate_from_pos (bel, mempos, 1);
  if (elind1 > 0)
    pos1 = buffer_or_string_memind_to_bytind
      (obj, extent_end (extent_list_at (bel, elind1 - 1, 1)));
  else
    pos1 = limit;

  /* Find the first start position before POS.  The extent corresponding
     to this position is either in the SOE or is less than or
     equal to POS1, so we just have to look in the SOE. */
  elind2 = extent_list_locate_from_pos (sel, mempos, 0);
  if (elind2 > 0)
    pos2 = buffer_or_string_memind_to_bytind
      (obj, extent_start (extent_list_at (sel, elind2 - 1, 0)));
  else
    pos2 = limit;

  return max (max (pos1, pos2), limit);
}

struct extent_fragment *
extent_fragment_new (Lisp_Object buffer_or_string, struct frame *frm)
{
  struct extent_fragment *ef = xnew_and_zero (struct extent_fragment);

  ef->object = buffer_or_string;
  ef->frm = frm;
  ef->extents = Dynarr_new (EXTENT);
  ef->begin_glyphs = Dynarr_new (glyph_block);
  ef->end_glyphs   = Dynarr_new (glyph_block);

  return ef;
}

void
extent_fragment_delete (struct extent_fragment *ef)
{
  Dynarr_free (ef->extents);
  Dynarr_free (ef->begin_glyphs);
  Dynarr_free (ef->end_glyphs);
  xfree (ef);
}

static int
extent_priority_sort_function (const void *humpty, const void *dumpty)
{
  const EXTENT foo = * (const EXTENT *) humpty;
  const EXTENT bar = * (const EXTENT *) dumpty;
  if (extent_priority (foo) < extent_priority (bar))
    return -1;
  return extent_priority (foo) > extent_priority (bar);
}

static void
extent_fragment_sort_by_priority (EXTENT_dynarr *extarr)
{
  int i;

  /* Sort our copy of the stack by extent_priority.  We use a bubble
     sort here because it's going to be faster than qsort() for small
     numbers of extents (less than 10 or so), and 99.999% of the time
     there won't ever be more extents than this in the stack. */
  if (Dynarr_length (extarr) < 10)
    {
      for (i = 1; i < Dynarr_length (extarr); i++)
        {
          int j = i - 1;
          while (j >= 0 &&
                 (extent_priority (Dynarr_at (extarr, j)) >
                  extent_priority (Dynarr_at (extarr, j+1))))
            {
              EXTENT tmp = Dynarr_at (extarr, j);
              Dynarr_at (extarr, j) = Dynarr_at (extarr, j+1);
              Dynarr_at (extarr, j+1) = tmp;
              j--;
            }
        }
    }
  else
    /* But some loser programs mess up and may create a large number
       of extents overlapping the same spot.  This will result in
       catastrophic behavior if we use the bubble sort above. */
    qsort (Dynarr_atp (extarr, 0), Dynarr_length (extarr),
           sizeof (EXTENT), extent_priority_sort_function);
}

/* If PROP is the `invisible' property of an extent,
   this is 1 if the extent should be treated as invisible.  */

#define EXTENT_PROP_MEANS_INVISIBLE(buf, prop)                  \
  (EQ (buf->invisibility_spec, Qt)                              \
   ? ! NILP (prop)                                              \
   : invisible_p (prop, buf->invisibility_spec))

/* If PROP is the `invisible' property of a extent,
   this is 1 if the extent should be treated as invisible
   and should have an ellipsis.  */

#define EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS(buf, prop)    \
  (EQ (buf->invisibility_spec, Qt)                              \
   ? 0                                                          \
   : invisible_ellipsis_p (prop, buf->invisibility_spec))

/* This is like a combination of memq and assq.
   Return 1 if PROPVAL appears as an element of LIST
   or as the car of an element of LIST.
   If PROPVAL is a list, compare each element against LIST
   in that way, and return 1 if any element of PROPVAL is found in LIST.
   Otherwise return 0.
   This function cannot quit.  */

static int
invisible_p (REGISTER Lisp_Object propval, Lisp_Object list)
{
  REGISTER Lisp_Object tail, proptail;
  for (tail = list; CONSP (tail); tail = XCDR (tail))
    {
      REGISTER Lisp_Object tem;
      tem = XCAR (tail);
      if (EQ (propval, tem))
        return 1;
      if (CONSP (tem) && EQ (propval, XCAR (tem)))
        return 1;
    }
  if (CONSP (propval))
    for (proptail = propval; CONSP (proptail);
         proptail = XCDR (proptail))
      {
        Lisp_Object propelt;
        propelt = XCAR (proptail);
        for (tail = list; CONSP (tail); tail = XCDR (tail))
          {
            REGISTER Lisp_Object tem;
            tem = XCAR (tail);
            if (EQ (propelt, tem))
              return 1;
            if (CONSP (tem) && EQ (propelt, XCAR (tem)))
              return 1;
          }
      }
  return 0;
}

/* Return 1 if PROPVAL appears as the car of an element of LIST
   and the cdr of that element is non-nil.
   If PROPVAL is a list, check each element of PROPVAL in that way,
   and the first time some element is found,
   return 1 if the cdr of that element is non-nil.
   Otherwise return 0.
   This function cannot quit.  */

static int
invisible_ellipsis_p (REGISTER Lisp_Object propval, Lisp_Object list)
{
  REGISTER Lisp_Object tail, proptail;
  for (tail = list; CONSP (tail); tail = XCDR (tail))
    {
      REGISTER Lisp_Object tem;
      tem = XCAR (tail);
      if (CONSP (tem) && EQ (propval, XCAR (tem)))
        return ! NILP (XCDR (tem));
    }
  if (CONSP (propval))
    for (proptail = propval; CONSP (proptail);
         proptail = XCDR (proptail))
      {
        Lisp_Object propelt;
        propelt = XCAR (proptail);
        for (tail = list; CONSP (tail); tail = XCDR (tail))
          {
            REGISTER Lisp_Object tem;
            tem = XCAR (tail);
            if (CONSP (tem) && EQ (propelt, XCAR (tem)))
              return ! NILP (XCDR (tem));
          }
      }
  return 0;
}

face_index
extent_fragment_update (struct window *w, struct extent_fragment *ef,
                        Bytind pos)
{
  int i;
  Extent_List *sel =
    buffer_or_string_stack_of_extents_force (ef->object)->extents;
  EXTENT lhe = 0;
  struct extent dummy_lhe_extent;
  Memind mempos = buffer_or_string_bytind_to_memind (ef->object, pos);

#ifdef ERROR_CHECK_EXTENTS
  assert (pos >= buffer_or_string_accessible_begin_byte (ef->object)
          && pos <= buffer_or_string_accessible_end_byte (ef->object));
#endif

  Dynarr_reset (ef->extents);
  Dynarr_reset (ef->begin_glyphs);
  Dynarr_reset (ef->end_glyphs);

  ef->previously_invisible = ef->invisible;
  if (ef->invisible)
    {
      if (ef->invisible_ellipses)
        ef->invisible_ellipses_already_displayed = 1;
    }
  else
    ef->invisible_ellipses_already_displayed = 0;
  ef->invisible = 0;
  ef->invisible_ellipses = 0;

  /* Set up the begin and end positions. */
  ef->pos = pos;
  ef->end = extent_find_end_of_run (ef->object, pos, 0);

  /* Note that extent_find_end_of_run() already moved the SOE for us. */
  /* soe_move (ef->object, mempos); */

  /* Determine the begin glyphs at POS. */
  for (i = 0; i < extent_list_num_els (sel); i++)
    {
      EXTENT e = extent_list_at (sel, i, 0);
      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);
        }
    }

  /* Determine the end glyphs at POS. */
  for (i = 0; i < extent_list_num_els (sel); i++)
    {
      EXTENT e = extent_list_at (sel, i, 1);
      if (extent_end (e) == mempos && !NILP (extent_end_glyph (e)))
        {
          Lisp_Object glyph = extent_end_glyph (e);
          struct glyph_block gb;

          gb.glyph = glyph;
          XSETEXTENT (gb.extent, e);
          Dynarr_add (ef->end_glyphs, gb);
        }
    }

  /* We tried determining all the charsets used in the run here,
     but that fails even if we only do the current line -- display
     tables or non-printable characters might cause other charsets
     to be used. */

  /* Determine whether the last-highlighted-extent is present. */
  if (EXTENTP (Vlast_highlighted_extent))
    lhe = XEXTENT (Vlast_highlighted_extent);

  /* Now add all extents that overlap the character after POS and
     have a non-nil face.  Also check if the character is invisible. */
  for (i = 0; i < extent_list_num_els (sel); i++)
    {
      EXTENT e = extent_list_at (sel, i, 0);
      if (extent_end (e) > mempos)
        {
          Lisp_Object invis_prop = extent_invisible (e);

          if (!NILP (invis_prop))
            {
              if (!BUFFERP (ef->object))
                /* #### no `string-invisibility-spec' */
                ef->invisible = 1;
              else
                {
                  if (!ef->invisible_ellipses_already_displayed &&
                      EXTENT_PROP_MEANS_INVISIBLE_WITH_ELLIPSIS
                      (XBUFFER (ef->object), invis_prop))
                    {
                      ef->invisible = 1;
                      ef->invisible_ellipses = 1;
                    }
                  else if (EXTENT_PROP_MEANS_INVISIBLE
                           (XBUFFER (ef->object), invis_prop))
                    ef->invisible = 1;
                }
            }

          /* Remember that one of the extents in the list might be our
             dummy extent representing the highlighting that is
             attached to some other extent that is currently
             mouse-highlighted.  When an extent is mouse-highlighted,
             it is as if there are two extents there, of potentially
             different priorities: the extent being highlighted, with
             whatever face and priority it has; and an ephemeral
             extent in the `mouse-face' face with
             `mouse-highlight-priority'.
             */

          if (!NILP (extent_face (e)))
            Dynarr_add (ef->extents, e);
          if (e == lhe)
            {
              Lisp_Object f;
              /* zeroing isn't really necessary; we only deref `priority'
                 and `face' */
              xzero (dummy_lhe_extent);
              set_extent_priority (&dummy_lhe_extent,
                                   mouse_highlight_priority);
              /* Need to break up the following expression, due to an */
              /* error in the Digital UNIX 3.2g C compiler (Digital */
              /* UNIX Compiler Driver 3.11). */
              f = extent_mouse_face (lhe);
              extent_face (&dummy_lhe_extent) = f;
              Dynarr_add (ef->extents, &dummy_lhe_extent);
            }
          /* since we are looping anyway, we might as well do this here */
          if ((!NILP(extent_initial_redisplay_function (e))) &&
              !extent_in_red_event_p(e))
            {
              Lisp_Object function = extent_initial_redisplay_function (e);
              Lisp_Object obj;

              /* printf ("initial redisplay function called!\n "); */

              /* print_extent_2 (e);
                 printf ("\n"); */

              /* FIXME: One should probably inhibit the displaying of
                 this extent to reduce flicker */
              extent_in_red_event_p(e) = 1;

              /* call the function */
              XSETEXTENT(obj,e);
              if(!NILP(function))
                 Fenqueue_eval_event(function,obj);
            }
        }
    }

  extent_fragment_sort_by_priority (ef->extents);

  /* Now merge the faces together into a single face.  The code to
     do this is in faces.c because it involves manipulating faces. */
  return get_extent_fragment_face_cache_index (w, ef);
}

\f
/************************************************************************/
/*                      extent-object methods                           */
/************************************************************************/

/* These are the basic helper functions for handling the allocation of
   extent objects.  They are similar to the functions for other
   lrecord objects.  allocate_extent() is in alloc.c, not here. */

static Lisp_Object
mark_extent (Lisp_Object obj)
{
  struct extent *extent = XEXTENT (obj);

  mark_object (extent_object (extent));
  mark_object (extent_no_chase_normal_field (extent, face));
  return extent->plist;
}

static void
print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
  EXTENT ext = XEXTENT (obj);
  EXTENT anc = extent_ancestor (ext);
  Lisp_Object tail;
  char buf[64], *bp = buf;

  /* Retrieve the ancestor and use it, for faster retrieval of properties */

  if (!NILP (extent_begin_glyph (anc))) *bp++ = '*';
  *bp++ = (extent_start_open_p (anc) ? '(': '[');
  if (extent_detached_p (ext))
    strcpy (bp, "detached");
  else
    sprintf (bp, "%ld, %ld",
             (long) XINT (Fextent_start_position (obj)),
             (long) XINT (Fextent_end_position (obj)));
  bp += strlen (bp);
  *bp++ = (extent_end_open_p (anc) ? ')': ']');
  if (!NILP (extent_end_glyph (anc))) *bp++ = '*';
  *bp++ = ' ';

  if (!NILP (extent_read_only (anc))) *bp++ = '%';
  if (!NILP (extent_mouse_face (anc))) *bp++ = 'H';
  if (extent_unique_p (anc)) *bp++ = 'U';
  else if (extent_duplicable_p (anc)) *bp++ = 'D';
  if (!NILP (extent_invisible (anc))) *bp++ = 'I';

  if (!NILP (extent_read_only (anc)) || !NILP (extent_mouse_face (anc)) ||
      extent_unique_p (anc) ||
      extent_duplicable_p (anc) || !NILP (extent_invisible (anc)))
    *bp++ = ' ';
  *bp = '\0';
  write_c_string (buf, printcharfun);

  tail = extent_plist_slot (anc);

  for (; !NILP (tail); tail = Fcdr (Fcdr (tail)))
    {
      Lisp_Object v = XCAR (XCDR (tail));
      if (NILP (v)) continue;
      print_internal (XCAR (tail), printcharfun, escapeflag);
      write_c_string (" ", printcharfun);
    }

  sprintf (buf, "0x%lx", (long) ext);
  write_c_string (buf, printcharfun);
}

static void
print_extent (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
{
  if (escapeflag)
    {
      const char *title = "";
      const char *name = "";
      const char *posttitle = "";
      Lisp_Object obj2 = Qnil;

      /* Destroyed extents have 't' in the object field, causing
         extent_object() to abort (maybe). */
      if (EXTENT_LIVE_P (XEXTENT (obj)))
        obj2 = extent_object (XEXTENT (obj));

      if (NILP (obj2))
        title = "no buffer";
      else if (BUFFERP (obj2))
        {
          if (BUFFER_LIVE_P (XBUFFER (obj2)))
            {
              title = "buffer ";
              name = (char *) XSTRING_DATA (XBUFFER (obj2)->name);
            }
          else
            {
              title = "Killed Buffer";
              name = "";
            }
        }
      else
        {
          assert (STRINGP (obj2));
          title = "string \"";
          posttitle = "\"";
          name = (char *) XSTRING_DATA (obj2);
        }

      if (print_readably)
        {
          if (!EXTENT_LIVE_P (XEXTENT (obj)))
            error ("printing unreadable object #<destroyed extent>");
          else
            error ("printing unreadable object #<extent 0x%lx>",
                   (long) XEXTENT (obj));
        }

      if (!EXTENT_LIVE_P (XEXTENT (obj)))
        write_c_string ("#<destroyed extent", printcharfun);
      else
        {
          char *buf = (char *)
            alloca (strlen (title) + strlen (name) + strlen (posttitle) + 1);
          write_c_string ("#<extent ", printcharfun);
          print_extent_1 (obj, printcharfun, escapeflag);
          write_c_string (extent_detached_p (XEXTENT (obj))
                          ? " from " : " in ", printcharfun);
          sprintf (buf, "%s%s%s", title, name, posttitle);
          write_c_string (buf, printcharfun);
        }
    }
  else
    {
      if (print_readably)
        error ("printing unreadable object #<extent>");
      write_c_string ("#<extent", printcharfun);
    }
  write_c_string (">", printcharfun);
}

static int
properties_equal (EXTENT e1, EXTENT e2, int depth)
{
  /* When this function is called, all indirections have been followed.
     Thus, the indirection checks in the various macros below will not
     amount to anything, and could be removed.  However, the time
     savings would probably not be significant. */
  if (!(EQ (extent_face (e1), extent_face (e2)) &&
        extent_priority (e1) == extent_priority (e2) &&
        internal_equal (extent_begin_glyph (e1), extent_begin_glyph (e2),
                        depth + 1) &&
        internal_equal (extent_end_glyph (e1), extent_end_glyph (e2),
                        depth + 1)))
    return 0;

  /* compare the bit flags. */
  {
    /* The has_aux field should not be relevant. */
    int e1_has_aux = e1->flags.has_aux;
    int e2_has_aux = e2->flags.has_aux;
    int value;

    e1->flags.has_aux = e2->flags.has_aux = 0;
    value = memcmp (&e1->flags, &e2->flags, sizeof (e1->flags));
    e1->flags.has_aux = e1_has_aux;
    e2->flags.has_aux = e2_has_aux;
    if (value)
      return 0;
  }

  /* compare the random elements of the plists. */
  return !plists_differ (extent_no_chase_plist (e1),
                         extent_no_chase_plist (e2),
                         0, 0, depth + 1);
}

static int
extent_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
{
  struct extent *e1 = XEXTENT (obj1);
  struct extent *e2 = XEXTENT (obj2);
  return
    (extent_start (e1) == extent_start (e2) &&
     extent_end   (e1) == extent_end   (e2) &&
     internal_equal (extent_object (e1), extent_object (e2), depth + 1) &&
     properties_equal (extent_ancestor (e1), extent_ancestor (e2),
                       depth));
}

static unsigned long
extent_hash (Lisp_Object obj, int depth)
{
  struct extent *e = XEXTENT (obj);
  /* No need to hash all of the elements; that would take too long.
     Just hash the most common ones. */
  return HASH3 (extent_start (e), extent_end (e),
                internal_hash (extent_object (e), depth + 1));
}

static const struct lrecord_description extent_description[] = {
  { XD_LISP_OBJECT, offsetof (struct extent, object) },
  { XD_LISP_OBJECT, offsetof (struct extent, flags.face) },
  { XD_LISP_OBJECT, offsetof (struct extent, plist) },
  { XD_END }
};

static Lisp_Object
extent_getprop (Lisp_Object obj, Lisp_Object prop)
{
  return Fextent_property (obj, prop, Qunbound);
}

static int
extent_putprop (Lisp_Object obj, Lisp_Object prop, Lisp_Object value)
{
  Fset_extent_property (obj, prop, value);
  return 1;
}

static int
extent_remprop (Lisp_Object obj, Lisp_Object prop)
{
  EXTENT ext = XEXTENT (obj);

  /* This list is taken from Fset_extent_property, and should be kept
     in synch.  */
  if (EQ (prop, Qread_only)
      || EQ (prop, Qunique)
      || EQ (prop, Qduplicable)
      || EQ (prop, Qinvisible)
      || EQ (prop, Qdetachable)
      || EQ (prop, Qdetached)
      || EQ (prop, Qdestroyed)
      || EQ (prop, Qpriority)
      || EQ (prop, Qface)
      || EQ (prop, Qinitial_redisplay_function)
      || EQ (prop, Qafter_change_functions)
      || EQ (prop, Qbefore_change_functions)
      || EQ (prop, Qmouse_face)
      || EQ (prop, Qhighlight)
      || EQ (prop, Qbegin_glyph_layout)
      || EQ (prop, Qend_glyph_layout)
      || EQ (prop, Qglyph_layout)
      || EQ (prop, Qbegin_glyph)
      || EQ (prop, Qend_glyph)
      || EQ (prop, Qstart_open)
      || EQ (prop, Qend_open)
      || EQ (prop, Qstart_closed)
      || EQ (prop, Qend_closed)
      || EQ (prop, Qkeymap))
    {
      /* #### Is this correct, anyway?  */
      return -1;
    }

  return external_remprop (extent_plist_addr (ext), prop, 0, ERROR_ME);
}

static Lisp_Object
extent_plist (Lisp_Object obj)
{
  return Fextent_properties (obj);
}

DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("extent", extent,
                                                mark_extent,
                                                print_extent,
                                                /* NOTE: If you declare a
                                                   finalization method here,
                                                   it will NOT be called.
                                                   Shaft city. */
                                                0,
                                                extent_equal, extent_hash,
                                                extent_description,
                                                extent_getprop, extent_putprop,
                                                extent_remprop, extent_plist,
                                                struct extent);

\f
/************************************************************************/
/*                      basic extent accessors                          */
/************************************************************************/

/* These functions are for checking externally-passed extent objects
   and returning an extent's basic properties, which include the
   buffer the extent is associated with, the endpoints of the extent's
   range, the open/closed-ness of those endpoints, and whether the
   extent is detached.  Manipulating these properties requires
   manipulating the ordered lists that hold extents; thus, functions
   to do that are in a later section. */

/* Given a Lisp_Object that is supposed to be an extent, make sure it
   is OK and return an extent pointer.  Extents can be in one of four
   states:

   1) destroyed
   2) detached and not associated with a buffer
   3) detached and associated with a buffer
   4) attached to a buffer

   If FLAGS is 0, types 2-4 are allowed.  If FLAGS is DE_MUST_HAVE_BUFFER,
   types 3-4 are allowed.  If FLAGS is DE_MUST_BE_ATTACHED, only type 4
   is allowed.
   */

static EXTENT
decode_extent (Lisp_Object extent_obj, unsigned int flags)
{
  EXTENT extent;
  Lisp_Object obj;

  CHECK_LIVE_EXTENT (extent_obj);
  extent = XEXTENT (extent_obj);
  obj = extent_object (extent);

  /* the following condition will fail if we're dealing with a freed extent */
  assert (NILP (obj) || BUFFERP (obj) || STRINGP (obj));

  if (flags & DE_MUST_BE_ATTACHED)
    flags |= DE_MUST_HAVE_BUFFER;

  /* if buffer is dead, then convert extent to have no buffer. */
  if (BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj)))
    obj = extent_object (extent) = Qnil;

  assert (!NILP (obj) || extent_detached_p (extent));

  if ((NILP (obj) && (flags & DE_MUST_HAVE_BUFFER))
      || (extent_detached_p (extent) && (flags & DE_MUST_BE_ATTACHED)))
    {
      signal_simple_error ("extent doesn't belong to a buffer or string",
                           extent_obj);
    }

  return extent;
}

/* Note that the returned value is a buffer position, not a byte index. */

static Lisp_Object
extent_endpoint_external (Lisp_Object extent_obj, int endp)
{
  EXTENT extent = decode_extent (extent_obj, 0);

  if (extent_detached_p (extent))
    return Qnil;
  else
    return make_int (extent_endpoint_bufpos (extent, endp));
}

DEFUN ("extentp", Fextentp, 1, 1, 0, /*
Return t if OBJECT is an extent.
*/
       (object))
{
  return EXTENTP (object) ? Qt : Qnil;
}

DEFUN ("extent-live-p", Fextent_live_p, 1, 1, 0, /*
Return t if OBJECT is an extent that has not been destroyed.
*/
       (object))
{
  return EXTENTP (object) && EXTENT_LIVE_P (XEXTENT (object)) ? Qt : Qnil;
}

DEFUN ("extent-detached-p", Fextent_detached_p, 1, 1, 0, /*
Return t if EXTENT is detached.
*/
       (extent))
{
  return extent_detached_p (decode_extent (extent, 0)) ? Qt : Qnil;
}

DEFUN ("extent-object", Fextent_object, 1, 1, 0, /*
Return object (buffer or string) that EXTENT refers to.
*/
       (extent))
{
  return extent_object (decode_extent (extent, 0));
}

DEFUN ("extent-start-position", Fextent_start_position, 1, 1, 0, /*
Return start position of EXTENT, or nil if EXTENT is detached.
*/
       (extent))
{
  return extent_endpoint_external (extent, 0);
}

DEFUN ("extent-end-position", Fextent_end_position, 1, 1, 0, /*
Return end position of EXTENT, or nil if EXTENT is detached.
*/
       (extent))
{
  return extent_endpoint_external (extent, 1);
}

DEFUN ("extent-length", Fextent_length, 1, 1, 0, /*
Return length of EXTENT in characters.
*/
       (extent))
{
  EXTENT e = decode_extent (extent, DE_MUST_BE_ATTACHED);
  return make_int (extent_endpoint_bufpos (e, 1)
                   - extent_endpoint_bufpos (e, 0));
}

DEFUN ("next-extent", Fnext_extent, 1, 1, 0, /*
Find next extent after EXTENT.
If EXTENT is a buffer return the first extent in the buffer; likewise
 for strings.
Extents in a buffer are ordered in what is called the "display"
 order, which sorts by increasing start positions and then by *decreasing*
 end positions.
If you want to perform an operation on a series of extents, use
 `map-extents' instead of this function; it is much more efficient.
 The primary use of this function should be to enumerate all the
 extents in a buffer.
Note: The display order is not necessarily the order that `map-extents'
 processes extents in!
*/
       (extent))
{
  Lisp_Object val;
  EXTENT next;

  if (EXTENTP (extent))
    next = extent_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
  else
    next = extent_first (decode_buffer_or_string (extent));

  if (!next)
    return Qnil;
  XSETEXTENT (val, next);
  return val;
}

DEFUN ("previous-extent", Fprevious_extent, 1, 1, 0, /*
Find last extent before EXTENT.
If EXTENT is a buffer return the last extent in the buffer; likewise
 for strings.
This function is analogous to `next-extent'.
*/
       (extent))
{
  Lisp_Object val;
  EXTENT prev;

  if (EXTENTP (extent))
    prev = extent_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
  else
    prev = extent_last (decode_buffer_or_string (extent));

  if (!prev)
    return Qnil;
  XSETEXTENT (val, prev);
  return val;
}

#ifdef DEBUG_XEMACS

DEFUN ("next-e-extent", Fnext_e_extent, 1, 1, 0, /*
Find next extent after EXTENT using the "e" order.
If EXTENT is a buffer return the first extent in the buffer; likewise
 for strings.
*/
       (extent))
{
  Lisp_Object val;
  EXTENT next;

  if (EXTENTP (extent))
    next = extent_e_next (decode_extent (extent, DE_MUST_BE_ATTACHED));
  else
    next = extent_e_first (decode_buffer_or_string (extent));

  if (!next)
    return Qnil;
  XSETEXTENT (val, next);
  return val;
}

DEFUN ("previous-e-extent", Fprevious_e_extent, 1, 1, 0, /*
Find last extent before EXTENT using the "e" order.
If EXTENT is a buffer return the last extent in the buffer; likewise
 for strings.
This function is analogous to `next-e-extent'.
*/
       (extent))
{
  Lisp_Object val;
  EXTENT prev;

  if (EXTENTP (extent))
    prev = extent_e_previous (decode_extent (extent, DE_MUST_BE_ATTACHED));
  else
    prev = extent_e_last (decode_buffer_or_string (extent));

  if (!prev)
    return Qnil;
  XSETEXTENT (val, prev);
  return val;
}

#endif

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.
If BUFFER is nil, the current buffer is assumed.
*/
       (pos, object))
{
  Lisp_Object obj = decode_buffer_or_string (object);
  Bytind bpos;

  bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
  bpos = extent_find_end_of_run (obj, bpos, 1);
  return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
}

DEFUN ("previous-extent-change", Fprevious_extent_change, 1, 2, 0, /*
Return the last position before POS where an extent begins or ends.
If POS is at the beginning of the buffer or string, POS will be returned;
 otherwise a position less than POS will always be returned.
If OBJECT is nil, the current buffer is assumed.
*/
       (pos, object))
{
  Lisp_Object obj = decode_buffer_or_string (object);
  Bytind bpos;

  bpos = get_buffer_or_string_pos_byte (obj, pos, GB_ALLOW_PAST_ACCESSIBLE);
  bpos = extent_find_beginning_of_run (obj, bpos, 1);
  return make_int (buffer_or_string_bytind_to_bufpos (obj, bpos));
}

\f
/************************************************************************/
/*                      parent and children stuff                       */
/************************************************************************/

DEFUN ("extent-parent", Fextent_parent, 1, 1, 0, /*
Return the parent (if any) of EXTENT.
If an extent has a parent, it derives all its properties from that extent
and has no properties of its own. (The only "properties" that the
extent keeps are the buffer/string it refers to and the start and end
points.) It is possible for an extent's parent to itself have a parent.
*/
       (extent))
/* do I win the prize for the strangest split infinitive? */
{
  EXTENT e = decode_extent (extent, 0);
  return extent_parent (e);
}

DEFUN ("extent-children", Fextent_children, 1, 1, 0, /*
Return a list of the children (if any) of EXTENT.
The children of an extent are all those extents whose parent is that extent.
This function does not recursively trace children of children.
\(To do that, use `extent-descendants'.)
*/
       (extent))
{
  EXTENT e = decode_extent (extent, 0);
  Lisp_Object children = extent_children (e);

  if (!NILP (children))
    return Fcopy_sequence (XWEAK_LIST_LIST (children));
  else
    return Qnil;
}

static void
remove_extent_from_children_list (EXTENT e, Lisp_Object child)
{
  Lisp_Object children = extent_children (e);

#ifdef ERROR_CHECK_EXTENTS
  assert (!NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
#endif
  XWEAK_LIST_LIST (children) =
    delq_no_quit (child, XWEAK_LIST_LIST (children));
}

static void
add_extent_to_children_list (EXTENT e, Lisp_Object child)
{
  Lisp_Object children = extent_children (e);

  if (NILP (children))
    {
      children = make_weak_list (WEAK_LIST_SIMPLE);
      set_extent_no_chase_aux_field (e, children, children);
    }

#ifdef ERROR_CHECK_EXTENTS
  assert (NILP (memq_no_quit (child, XWEAK_LIST_LIST (children))));
#endif
  XWEAK_LIST_LIST (children) = Fcons (child, XWEAK_LIST_LIST (children));
}

DEFUN ("set-extent-parent", Fset_extent_parent, 2, 2, 0, /*
Set the parent of EXTENT to PARENT (may be nil).
See `extent-parent'.
*/
       (extent, parent))
{
  EXTENT e = decode_extent (extent, 0);
  Lisp_Object cur_parent = extent_parent (e);
  Lisp_Object rest;

  XSETEXTENT (extent, e);
  if (!NILP (parent))
    CHECK_LIVE_EXTENT (parent);
  if (EQ (parent, cur_parent))
    return Qnil;
  for (rest = parent; !NILP (rest); rest = extent_parent (XEXTENT (rest)))
    if (EQ (rest, extent))
      signal_simple_error ("Circular parent chain would result", extent);
  if (NILP (parent))
    {
      remove_extent_from_children_list (XEXTENT (cur_parent), extent);
      set_extent_no_chase_aux_field (e, parent, Qnil);
      e->flags.has_parent = 0;
    }
  else
    {
      add_extent_to_children_list (XEXTENT (parent), extent);
      set_extent_no_chase_aux_field (e, parent, parent);
      e->flags.has_parent = 1;
    }
  /* changing the parent also changes the properties of all children. */
  {
    int old_invis = (!NILP (cur_parent) &&
                     !NILP (extent_invisible (XEXTENT (cur_parent))));
    int new_invis = (!NILP (parent) &&
                     !NILP (extent_invisible (XEXTENT (parent))));

    extent_maybe_changed_for_redisplay (e, 1, new_invis != old_invis);
  }

  return Qnil;
}

\f
/************************************************************************/
/*                      basic extent mutators                           */
/************************************************************************/

/* Note:  If you track non-duplicable extents by undo, you'll get bogus
   undo records for transient extents via update-extent.
   For example, query-replace will do this.
 */

static void
set_extent_endpoints_1 (EXTENT extent, Memind start, Memind end)
{
#ifdef ERROR_CHECK_EXTENTS
  Lisp_Object obj = extent_object (extent);

  assert (start <= end);
  if (BUFFERP (obj))
    {
      assert (valid_memind_p (XBUFFER (obj), start));
      assert (valid_memind_p (XBUFFER (obj), end));
    }
#endif

  /* Optimization: if the extent is already where we want it to be,
     do nothing. */
  if (!extent_detached_p (extent) && extent_start (extent) == start &&
      extent_end (extent) == end)
    return;

  if (extent_detached_p (extent))
    {
      if (extent_duplicable_p (extent))
        {
          Lisp_Object extent_obj;
          XSETEXTENT (extent_obj, extent);
          record_extent (extent_obj, 1);
        }
    }
  else
    extent_detach (extent);

  set_extent_start (extent, start);
  set_extent_end (extent, end);
  extent_attach (extent);
}

/* Set extent's endpoints to S and E, and put extent in buffer or string
   OBJECT. (If OBJECT is nil, do not change the extent's object.) */

void
set_extent_endpoints (EXTENT extent, Bytind s, Bytind e, Lisp_Object object)
{
  Memind start, end;

  if (NILP (object))
    {
      object = extent_object (extent);
      assert (!NILP (object));
    }
  else if (!EQ (object, extent_object (extent)))
    {
      extent_detach (extent);
      extent_object (extent) = object;
    }

  start = s < 0 ? extent_start (extent) :
    buffer_or_string_bytind_to_memind (object, s);
  end = e < 0 ? extent_end (extent) :
    buffer_or_string_bytind_to_memind (object, e);
  set_extent_endpoints_1 (extent, start, end);
}

static void
set_extent_openness (EXTENT extent, int start_open, int end_open)
{
  if (start_open != -1)
    extent_start_open_p (extent) = start_open;
  if (end_open != -1)
    extent_end_open_p (extent) = end_open;
  /* changing the open/closedness of an extent does not affect
     redisplay. */
}

static EXTENT
make_extent_internal (Lisp_Object object, Bytind from, Bytind to)
{
  EXTENT extent;

  extent = make_extent_detached (object);
  set_extent_endpoints (extent, from, to, Qnil);
  return extent;
}

static EXTENT
copy_extent (EXTENT original, Bytind from, Bytind to, Lisp_Object object)
{
  EXTENT e;

  e = make_extent_detached (object);
  if (from >= 0)
    set_extent_endpoints (e, from, to, Qnil);

  e->plist = Fcopy_sequence (original->plist);
  memcpy (&e->flags, &original->flags, sizeof (e->flags));
  if (e->flags.has_aux)
    {
      /* also need to copy the aux struct.  It won't work for
         this extent to share the same aux struct as the original
         one. */
      struct extent_auxiliary *data =
        alloc_lcrecord_type (struct extent_auxiliary,
                             &lrecord_extent_auxiliary);

      copy_lcrecord (data, XEXTENT_AUXILIARY (XCAR (original->plist)));
      XSETEXTENT_AUXILIARY (XCAR (e->plist), data);
    }

  {
    /* we may have just added another child to the parent extent. */
    Lisp_Object parent = extent_parent (e);
    if (!NILP (parent))
      {
        Lisp_Object extent;
        XSETEXTENT (extent, e);
        add_extent_to_children_list (XEXTENT (parent), extent);
      }
  }

  return e;
}

static void
destroy_extent (EXTENT extent)
{
  Lisp_Object rest, nextrest, children;
  Lisp_Object extent_obj;

  if (!extent_detached_p (extent))
    extent_detach (extent);
  /* disassociate the extent from its children and parent */
  children = extent_children (extent);
  if (!NILP (children))
    {
      LIST_LOOP_DELETING (rest, nextrest, XWEAK_LIST_LIST (children))
        Fset_extent_parent (XCAR (rest), Qnil);
    }
  XSETEXTENT (extent_obj, extent);
  Fset_extent_parent (extent_obj, Qnil);
  /* mark the extent as destroyed */
  extent_object (extent) = Qt;
}

DEFUN ("make-extent", Fmake_extent, 2, 3, 0, /*
Make an extent for the range [FROM, TO) in BUFFER-OR-STRING.
BUFFER-OR-STRING defaults to the current buffer.  Insertions at point
TO will be outside of the extent; insertions at FROM will be inside the
extent, causing the extent to grow. (This is the same way that markers
behave.) You can change the behavior of insertions at the endpoints
using `set-extent-property'.  The extent is initially detached if both
FROM and TO are nil, and in this case BUFFER-OR-STRING defaults to nil,
meaning the extent is in no buffer and no string.
*/
       (from, to, buffer_or_string))
{
  Lisp_Object extent_obj;
  Lisp_Object obj;

  obj = decode_buffer_or_string (buffer_or_string);
  if (NILP (from) && NILP (to))
    {
      if (NILP (buffer_or_string))
        obj = Qnil;
      XSETEXTENT (extent_obj, make_extent_detached (obj));
    }
  else
    {
      Bytind start, end;

      get_buffer_or_string_range_byte (obj, from, to, &start, &end,
                                       GB_ALLOW_PAST_ACCESSIBLE);
      XSETEXTENT (extent_obj, make_extent_internal (obj, start, end));
    }
  return extent_obj;
}

DEFUN ("copy-extent", Fcopy_extent, 1, 2, 0, /*
Make a copy of EXTENT.  It is initially detached.
Optional argument BUFFER-OR-STRING defaults to EXTENT's buffer or string.
*/
       (extent, buffer_or_string))
{
  EXTENT ext = decode_extent (extent, 0);

  if (NILP (buffer_or_string))
    buffer_or_string = extent_object (ext);
  else
    buffer_or_string = decode_buffer_or_string (buffer_or_string);

  XSETEXTENT (extent, copy_extent (ext, -1, -1, buffer_or_string));
  return extent;
}

DEFUN ("delete-extent", Fdelete_extent, 1, 1, 0, /*
Remove EXTENT from its buffer and destroy it.
This does not modify the buffer's text, only its display properties.
The extent cannot be used thereafter.
*/
       (extent))
{
  EXTENT ext;

  /* We do not call decode_extent() here because already-destroyed
     extents are OK. */
  CHECK_EXTENT (extent);
  ext = XEXTENT (extent);

  if (!EXTENT_LIVE_P (ext))
    return Qnil;
  destroy_extent (ext);
  return Qnil;
}

DEFUN ("detach-extent", Fdetach_extent, 1, 1, 0, /*
Remove EXTENT from its buffer in such a way that it can be re-inserted.
An extent is also detached when all of its characters are all killed by a
deletion, unless its `detachable' property has been unset.

Extents which have the `duplicable' attribute are tracked by the undo
mechanism.  Detachment via `detach-extent' and string deletion is recorded,
as is attachment via `insert-extent' and string insertion.  Extent motion,
face changes, and attachment via `make-extent' and `set-extent-endpoints'
are not recorded.  This means that extent changes which are to be undo-able
must be performed by character editing, or by insertion and detachment of
duplicable extents.
*/
       (extent))
{
  EXTENT ext = decode_extent (extent, 0);

  if (extent_detached_p (ext))
    return extent;
  if (extent_duplicable_p (ext))
    record_extent (extent, 0);
  extent_detach (ext);

  return extent;
}

DEFUN ("set-extent-endpoints", Fset_extent_endpoints, 3, 4, 0, /*
Set the endpoints of EXTENT to START, END.
If START and END are null, call detach-extent on EXTENT.
BUFFER-OR-STRING specifies the new buffer or string that the extent should
be in, and defaults to EXTENT's buffer or string. (If nil, and EXTENT
is in no buffer and no string, it defaults to the current buffer.)
See documentation on `detach-extent' for a discussion of undo recording.
*/
       (extent, start, end, buffer_or_string))
{
  EXTENT ext;
  Bytind s, e;

  ext = decode_extent (extent, 0);

  if (NILP (buffer_or_string))
    {
      buffer_or_string = extent_object (ext);
      if (NILP (buffer_or_string))
        buffer_or_string = Fcurrent_buffer ();
    }
  else
    buffer_or_string = decode_buffer_or_string (buffer_or_string);

  if (NILP (start) && NILP (end))
    return Fdetach_extent (extent);

  get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
                                   GB_ALLOW_PAST_ACCESSIBLE);

  set_extent_endpoints (ext, s, e, buffer_or_string);
  return extent;
}

\f
/************************************************************************/
/*                         mapping over extents                         */
/************************************************************************/

static unsigned int
decode_map_extents_flags (Lisp_Object flags)
{
  unsigned int retval = 0;
  unsigned int all_extents_specified = 0;
  unsigned int in_region_specified = 0;

  if (EQ (flags, Qt)) /* obsoleteness compatibility */
    return ME_END_CLOSED;
  if (NILP (flags))
    return 0;
  if (SYMBOLP (flags))
    flags = Fcons (flags, Qnil);
  while (!NILP (flags))
    {
      Lisp_Object sym;
      CHECK_CONS (flags);
      sym = XCAR (flags);
      CHECK_SYMBOL (sym);
      if (EQ (sym, Qall_extents_closed) || EQ (sym, Qall_extents_open) ||
          EQ (sym, Qall_extents_closed_open) ||
          EQ (sym, Qall_extents_open_closed))
        {
          if (all_extents_specified)
            error ("Only one `all-extents-*' flag may be specified");
          all_extents_specified = 1;
        }
      if (EQ (sym, Qstart_in_region) || EQ (sym, Qend_in_region) ||
          EQ (sym, Qstart_and_end_in_region) ||
          EQ (sym, Qstart_or_end_in_region))
        {
          if (in_region_specified)
            error ("Only one `*-in-region' flag may be specified");
          in_region_specified = 1;
        }

      /* I do so love that conditional operator ... */
      retval |=
        EQ (sym, Qend_closed)              ? ME_END_CLOSED :
        EQ (sym, Qstart_open)              ? ME_START_OPEN :
        EQ (sym, Qall_extents_closed)      ? ME_ALL_EXTENTS_CLOSED :
        EQ (sym, Qall_extents_open)        ? ME_ALL_EXTENTS_OPEN :
        EQ (sym, Qall_extents_closed_open) ? ME_ALL_EXTENTS_CLOSED_OPEN :
        EQ (sym, Qall_extents_open_closed) ? ME_ALL_EXTENTS_OPEN_CLOSED :
        EQ (sym, Qstart_in_region)         ? ME_START_IN_REGION :
        EQ (sym, Qend_in_region)           ? ME_END_IN_REGION :
        EQ (sym, Qstart_and_end_in_region) ? ME_START_AND_END_IN_REGION :
        EQ (sym, Qstart_or_end_in_region)  ? ME_START_OR_END_IN_REGION :
        EQ (sym, Qnegate_in_region)        ? ME_NEGATE_IN_REGION :
        (signal_simple_error ("Invalid `map-extents' flag", sym), 0);

      flags = XCDR (flags);
    }
  return retval;
}

DEFUN ("extent-in-region-p", Fextent_in_region_p, 1, 4, 0, /*
Return whether EXTENT overlaps a specified region.
This is equivalent to whether `map-extents' would visit EXTENT when called
with these args.
*/
       (extent, from, to, flags))
{
  Bytind start, end;
  EXTENT ext = decode_extent (extent, DE_MUST_BE_ATTACHED);
  Lisp_Object obj = extent_object (ext);

  get_buffer_or_string_range_byte (obj, from, to, &start, &end, GB_ALLOW_NIL |
                                   GB_ALLOW_PAST_ACCESSIBLE);

  return extent_in_region_p (ext, start, end, decode_map_extents_flags (flags)) ?
    Qt : Qnil;
}

struct slow_map_extents_arg
{
  Lisp_Object map_arg;
  Lisp_Object map_routine;
  Lisp_Object result;
  Lisp_Object property;
  Lisp_Object value;
};

static int
slow_map_extents_function (EXTENT extent, void *arg)
{
  /* This function can GC */
  struct slow_map_extents_arg *closure = (struct slow_map_extents_arg *) arg;
  Lisp_Object extent_obj;

  XSETEXTENT (extent_obj, extent);

  /* make sure this extent qualifies according to the PROPERTY
     and VALUE args */

  if (!NILP (closure->property))
    {
      Lisp_Object value = Fextent_property (extent_obj, closure->property,
                                            Qnil);
      if ((NILP (closure->value) && NILP (value)) ||
          (!NILP (closure->value) && !EQ (value, closure->value)))
        return 0;
    }

  closure->result = call2 (closure->map_routine, extent_obj,
                           closure->map_arg);
  return !NILP (closure->result);
}

DEFUN ("map-extents", Fmap_extents, 1, 8, 0, /*
Map FUNCTION over the extents which overlap a region in OBJECT.
OBJECT is normally a buffer or string but could be an extent (see below).
The region is normally bounded by [FROM, TO) (i.e. the beginning of the
region is closed and the end of the region is open), but this can be
changed with the FLAGS argument (see below for a complete discussion).

FUNCTION is called with the arguments (extent, MAPARG).  The arguments
OBJECT, FROM, TO, MAPARG, and FLAGS are all optional and default to
the current buffer, the beginning of OBJECT, the end of OBJECT, nil,
and nil, respectively.  `map-extents' returns the first non-nil result
produced by FUNCTION, and no more calls to FUNCTION are made after it
returns non-nil.

If OBJECT is an extent, FROM and TO default to the extent's endpoints,
and the mapping omits that extent and its predecessors.  This feature
supports restarting a loop based on `map-extents'.  Note: OBJECT must
be attached to a buffer or string, and the mapping is done over that
buffer or string.

An extent overlaps the region if there is any point in the extent that is
also in the region. (For the purpose of overlap, zero-length extents and
regions are treated as closed on both ends regardless of their endpoints'
specified open/closedness.) Note that the endpoints of an extent or region
are considered to be in that extent or region if and only if the
corresponding end is closed.  For example, the extent [5,7] overlaps the
region [2,5] because 5 is in both the extent and the region.  However, (5,7]
does not overlap [2,5] because 5 is not in the extent, and neither [5,7] nor
\(5,7] overlaps the region [2,5) because 5 is not in the region.

The optional FLAGS can be a symbol or a list of one or more symbols,
modifying the behavior of `map-extents'.  Allowed symbols are:

end-closed              The region's end is closed.

start-open              The region's start is open.

all-extents-closed      Treat all extents as closed on both ends for the
                        purpose of determining whether they overlap the
                        region, irrespective of their actual open- or
                        closedness.
all-extents-open        Treat all extents as open on both ends.
all-extents-closed-open Treat all extents as start-closed, end-open.
all-extents-open-closed Treat all extents as start-open, end-closed.

start-in-region         In addition to the above conditions for extent
                        overlap, the extent's start position must lie within
                        the specified region.  Note that, for this
                        condition, open start positions are treated as if
                        0.5 was added to the endpoint's value, and open
                        end positions are treated as if 0.5 was subtracted
                        from the endpoint's value.
end-in-region           The extent's end position must lie within the
                        region.
start-and-end-in-region Both the extent's start and end positions must lie
                        within the region.
start-or-end-in-region  Either the extent's start or end position must lie
                        within the region.

negate-in-region        The condition specified by a `*-in-region' flag
                        must NOT hold for the extent to be considered.


At most one of `all-extents-closed', `all-extents-open',
`all-extents-closed-open', and `all-extents-open-closed' may be specified.

At most one of `start-in-region', `end-in-region',
`start-and-end-in-region', and `start-or-end-in-region' may be specified.

If optional arg PROPERTY is non-nil, only extents with that property set
on them will be visited.  If optional arg VALUE is non-nil, only extents
whose value for that property is `eq' to VALUE will be visited.
*/
  (function, object, from, to, maparg, flags, property, value))
{
  /* This function can GC */
  struct slow_map_extents_arg closure;
  unsigned int me_flags;
  Bytind start, end;
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
  EXTENT after = 0;

  if (EXTENTP (object))
    {
      after = decode_extent (object, DE_MUST_BE_ATTACHED);
      if (NILP (from))
        from = Fextent_start_position (object);
      if (NILP (to))
        to = Fextent_end_position (object);
      object = extent_object (after);
    }
  else
    object = decode_buffer_or_string (object);

  get_buffer_or_string_range_byte (object, from, to, &start, &end,
                                   GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);

  me_flags = decode_map_extents_flags (flags);

  if (!NILP (property))
    {
      if (!NILP (value))
        value = canonicalize_extent_property (property, value);
    }

  GCPRO5 (function, maparg, object, property, value);

  closure.map_arg = maparg;
  closure.map_routine = function;
  closure.result = Qnil;
  closure.property = property;
  closure.value = value;

  map_extents_bytind (start, end, slow_map_extents_function,
                      (void *) &closure, object, after,
                      /* You never know what the user might do ... */
                      me_flags | ME_MIGHT_CALL_ELISP);

  UNGCPRO;
  return closure.result;
}

\f
/************************************************************************/
/*              mapping over extents -- other functions                 */
/************************************************************************/

/* ------------------------------- */
/*      map-extent-children        */
/* ------------------------------- */

struct slow_map_extent_children_arg
{
  Lisp_Object map_arg;
  Lisp_Object map_routine;
  Lisp_Object result;
  Lisp_Object property;
  Lisp_Object value;
  Bytind start_min;
  Bytind prev_start;
  Bytind prev_end;
};

static int
slow_map_extent_children_function (EXTENT extent, void *arg)
{
  /* This function can GC */
  struct slow_map_extent_children_arg *closure =
    (struct slow_map_extent_children_arg *) arg;
  Lisp_Object extent_obj;
  Bytind start = extent_endpoint_bytind (extent, 0);
  Bytind end = extent_endpoint_bytind (extent, 1);
  /* Make sure the extent starts inside the region of interest,
     rather than just overlaps it.
     */
  if (start < closure->start_min)
    return 0;
  /* Make sure the extent is not a child of a previous visited one.
     We know already, because of extent ordering,
     that start >= prev_start, and that if
     start == prev_start, then end <= prev_end.
     */
  if (start == closure->prev_start)
    {
      if (end < closure->prev_end)
        return 0;
    }
  else /* start > prev_start */
    {
      if (start < closure->prev_end)
        return 0;
      /* corner case:  prev_end can be -1 if there is no prev */
    }
  XSETEXTENT (extent_obj, extent);

  /* make sure this extent qualifies according to the PROPERTY
     and VALUE args */

  if (!NILP (closure->property))
    {
      Lisp_Object value = Fextent_property (extent_obj, closure->property,
                                            Qnil);
      if ((NILP (closure->value) && NILP (value)) ||
          (!NILP (closure->value) && !EQ (value, closure->value)))
        return 0;
    }

  closure->result = call2 (closure->map_routine, extent_obj,
                           closure->map_arg);

  /* Since the callback may change the buffer, compute all stored
     buffer positions here.
     */
  closure->start_min = -1;      /* no need for this any more */
  closure->prev_start = extent_endpoint_bytind (extent, 0);
  closure->prev_end = extent_endpoint_bytind (extent, 1);

  return !NILP (closure->result);
}

DEFUN ("map-extent-children", Fmap_extent_children, 1, 8, 0, /*
Map FUNCTION over the extents in the region from FROM to TO.
FUNCTION is called with arguments (extent, MAPARG).  See `map-extents'
for a full discussion of the arguments FROM, TO, and FLAGS.

The arguments are the same as for `map-extents', but this function differs
in that it only visits extents which start in the given region, and also
in that, after visiting an extent E, it skips all other extents which start
inside E but end before E's end.

Thus, this function may be used to walk a tree of extents in a buffer:
        (defun walk-extents (buffer &optional ignore)
         (map-extent-children 'walk-extents buffer))
*/
       (function, object, from, to, maparg, flags, property, value))
{
  /* This function can GC */
  struct slow_map_extent_children_arg closure;
  unsigned int me_flags;
  Bytind start, end;
  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
  EXTENT after = 0;

  if (EXTENTP (object))
    {
      after = decode_extent (object, DE_MUST_BE_ATTACHED);
      if (NILP (from))
        from = Fextent_start_position (object);
      if (NILP (to))
        to = Fextent_end_position (object);
      object = extent_object (after);
    }
  else
    object = decode_buffer_or_string (object);

  get_buffer_or_string_range_byte (object, from, to, &start, &end,
                                   GB_ALLOW_NIL | GB_ALLOW_PAST_ACCESSIBLE);

  me_flags = decode_map_extents_flags (flags);

  if (!NILP (property))
    {
      if (!NILP (value))
        value = canonicalize_extent_property (property, value);
    }

  GCPRO5 (function, maparg, object, property, value);

  closure.map_arg = maparg;
  closure.map_routine = function;
  closure.result = Qnil;
  closure.property = property;
  closure.value = value;
  closure.start_min = start;
  closure.prev_start = -1;
  closure.prev_end = -1;
  map_extents_bytind (start, end, slow_map_extent_children_function,
                      (void *) &closure, object, after,
                      /* You never know what the user might do ... */
                      me_flags | ME_MIGHT_CALL_ELISP);

  UNGCPRO;
  return closure.result;
}

/* ------------------------------- */
/*             extent-at           */
/* ------------------------------- */

/* find "smallest" matching extent containing pos -- (flag == 0) means
   all extents match, else (EXTENT_FLAGS (extent) & flag) must be true;
   for more than one matching extent with precisely the same endpoints,
   we choose the last extent in the extents_list.
   The search stops just before "before", if that is non-null.
   */

struct extent_at_arg
{
  EXTENT best_match;
  Memind best_start;
  Memind best_end;
  Lisp_Object prop;
  EXTENT before;
};

enum extent_at_flag
{
  EXTENT_AT_AFTER,
  EXTENT_AT_BEFORE,
  EXTENT_AT_AT
};

static enum extent_at_flag
decode_extent_at_flag (Lisp_Object at_flag)
{
  if (NILP (at_flag))
    return EXTENT_AT_AFTER;

  CHECK_SYMBOL (at_flag);
  if (EQ (at_flag, Qafter))  return EXTENT_AT_AFTER;
  if (EQ (at_flag, Qbefore)) return EXTENT_AT_BEFORE;
  if (EQ (at_flag, Qat))     return EXTENT_AT_AT;

  signal_simple_error ("Invalid AT-FLAG in `extent-at'", at_flag);
  return EXTENT_AT_AFTER; /* unreached */
}

static int
extent_at_mapper (EXTENT e, void *arg)
{
  struct extent_at_arg *closure = (struct extent_at_arg *) arg;

  if (e == closure->before)
    return 1;

  /* If closure->prop is non-nil, then the extent is only acceptable
     if it has a non-nil value for that property. */
  if (!NILP (closure->prop))
    {
      Lisp_Object extent;
      XSETEXTENT (extent, e);
      if (NILP (Fextent_property (extent, closure->prop, Qnil)))
        return 0;
    }

    {
      EXTENT current = closure->best_match;

      if (!current)
        goto accept;
      /* redundant but quick test */
      else if (extent_start (current) > extent_start (e))
        return 0;

      /* we return the "last" best fit, instead of the first --
         this is because then the glyph closest to two equivalent
         extents corresponds to the "extent-at" the text just past
         that same glyph */
      else if (!EXTENT_LESS_VALS (e, closure->best_start,
                                  closure->best_end))
        goto accept;
      else
        return 0;
    accept:
      closure->best_match = e;
      closure->best_start = extent_start (e);
      closure->best_end = extent_end (e);
    }

  return 0;
}

static Lisp_Object
extent_at_bytind (Bytind position, Lisp_Object object, Lisp_Object property,
                  EXTENT before, enum extent_at_flag at_flag)
{
  struct extent_at_arg closure;
  Lisp_Object extent_obj;

  /* it might be argued that invalid positions should cause
     errors, but the principle of least surprise dictates that
     nil should be returned (extent-at is often used in
     response to a mouse event, and in many cases previous events
     have changed the buffer contents).

     Also, the openness stuff in the text-property code currently
     does not check its limits and might go off the end. */
  if ((at_flag == EXTENT_AT_BEFORE
       ? position <= buffer_or_string_absolute_begin_byte (object)
       : position < buffer_or_string_absolute_begin_byte (object))
      || (at_flag == EXTENT_AT_AFTER
          ? position >= buffer_or_string_absolute_end_byte (object)
          : position > buffer_or_string_absolute_end_byte (object)))
    return Qnil;

  closure.best_match = 0;
  closure.prop = property;
  closure.before = before;

  map_extents_bytind (at_flag == EXTENT_AT_BEFORE ? position - 1 : position,
                      at_flag == EXTENT_AT_AFTER ? position + 1 : position,
                      extent_at_mapper, (void *) &closure, object, 0,
                      ME_START_OPEN | ME_ALL_EXTENTS_CLOSED);

  if (!closure.best_match)
    return Qnil;

  XSETEXTENT (extent_obj, closure.best_match);
  return extent_obj;
}

DEFUN ("extent-at", Fextent_at, 1, 5, 0, /*
Find "smallest" extent at POS in OBJECT having PROPERTY set.
Normally, an extent is "at" POS if it overlaps the region (POS, POS+1);
 i.e. if it covers the character after POS. (However, see the definition
 of AT-FLAG.) "Smallest" means the extent that comes last in the display
 order; this normally means the extent whose start position is closest to
 POS.  See `next-extent' for more information.
OBJECT specifies a buffer or string and defaults to the current buffer.
PROPERTY defaults to nil, meaning that any extent will do.
Properties are attached to extents with `set-extent-property', which see.
Returns nil if POS is invalid or there is no matching extent at POS.
If the fourth argument BEFORE is not nil, it must be an extent; any returned
 extent will precede that extent.  This feature allows `extent-at' to be
 used by a loop over extents.
AT-FLAG controls how end cases are handled, and should be one of:

nil or `after'          An extent is at POS if it covers the character
                        after POS.  This is consistent with the way
                        that text properties work.
`before'                An extent is at POS if it covers the character
                        before POS.
`at'                    An extent is at POS if it overlaps or abuts POS.
                        This includes all zero-length extents at POS.

Note that in all cases, the start-openness and end-openness of the extents
considered is ignored.  If you want to pay attention to those properties,
you should use `map-extents', which gives you more control.
*/
     (pos, object, property, before, at_flag))
{
  Bytind position;
  EXTENT before_extent;
  enum extent_at_flag fl;

  object = decode_buffer_or_string (object);
  position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);
  if (NILP (before))
    before_extent = 0;
  else
    before_extent = decode_extent (before, DE_MUST_BE_ATTACHED);
  if (before_extent && !EQ (object, extent_object (before_extent)))
    signal_simple_error ("extent not in specified buffer or string", object);
  fl = decode_extent_at_flag (at_flag);

  return extent_at_bytind (position, object, property, before_extent, fl);
}

/* ------------------------------- */
/*   verify_extent_modification()  */
/* ------------------------------- */

/* verify_extent_modification() is called when a buffer or string is
   modified to check whether the modification is occuring inside a
   read-only extent.
 */

struct verify_extents_arg
{
  Lisp_Object object;
  Memind start;
  Memind end;
  Lisp_Object iro; /* value of inhibit-read-only */
};

static int
verify_extent_mapper (EXTENT extent, void *arg)
{
  struct verify_extents_arg *closure = (struct verify_extents_arg *) arg;
  Lisp_Object prop = extent_read_only (extent);

  if (NILP (prop))
    return 0;

  if (CONSP (closure->iro) && !NILP (Fmemq (prop, closure->iro)))
    return 0;

#if 0 /* Nobody seems to care for this any more -sb */
  /* Allow deletion if the extent is completely contained in
     the region being deleted.
     This is important for supporting tokens which are internally
     write-protected, but which can be killed and yanked as a whole.
     Ignore open/closed distinctions at this point.
     -- Rose
     */
  if (closure->start != closure->end &&
      extent_start (extent) >= closure->start &&
      extent_end (extent) <= closure->end)
    return 0;
#endif

  while (1)
    Fsignal (Qbuffer_read_only, (list1 (closure->object)));

  RETURN_NOT_REACHED(0)
}

/* Value of Vinhibit_read_only is precomputed and passed in for
   efficiency */

void
verify_extent_modification (Lisp_Object object, Bytind from, Bytind to,
                            Lisp_Object inhibit_read_only_value)
{
  int closed;
  struct verify_extents_arg closure;

  /* If insertion, visit closed-endpoint extents touching the insertion
     point because the text would go inside those extents.  If deletion,
     treat the range as open on both ends so that touching extents are not
     visited.  Note that we assume that an insertion is occurring if the
     changed range has zero length, and a deletion otherwise.  This
     fails if a change (i.e. non-insertion, non-deletion) is happening.
     As far as I know, this doesn't currently occur in XEmacs. --ben */
  closed = (from==to);
  closure.object = object;
  closure.start = buffer_or_string_bytind_to_memind (object, from);
  closure.end = buffer_or_string_bytind_to_memind (object, to);
  closure.iro = inhibit_read_only_value;

  map_extents_bytind (from, to, verify_extent_mapper, (void *) &closure,
                      object, 0, closed ? ME_END_CLOSED : ME_START_OPEN);
}

/* ------------------------------------ */
/*    process_extents_for_insertion()   */
/* ------------------------------------ */

struct process_extents_for_insertion_arg
{
  Bytind opoint;
  int length;
  Lisp_Object object;
};

/*   A region of length LENGTH was just inserted at OPOINT.  Modify all
     of the extents as required for the insertion, based on their
     start-open/end-open properties.
 */

static int
process_extents_for_insertion_mapper (EXTENT extent, void *arg)
{
  struct process_extents_for_insertion_arg *closure =
    (struct process_extents_for_insertion_arg *) arg;
  Memind indice = buffer_or_string_bytind_to_memind (closure->object,
                                                      closure->opoint);

  /* When this function is called, one end of the newly-inserted text should
     be adjacent to some endpoint of the extent, or disjoint from it.  If
     the insertion overlaps any existing extent, something is wrong.
   */
#ifdef ERROR_CHECK_EXTENTS
  if (extent_start (extent) > indice &&
      extent_start (extent) < indice + closure->length)
    abort ();
  if (extent_end (extent) > indice &&
      extent_end (extent) < indice + closure->length)
    abort ();
#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.

     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. */

  {
    Memind new_start, new_end;

    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)
      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);
  }

  return 0;
}

void
process_extents_for_insertion (Lisp_Object object, Bytind opoint,
                               Bytecount length)
{
  struct process_extents_for_insertion_arg closure;

  closure.opoint = opoint;
  closure.length = length;
  closure.object = object;

  map_extents_bytind (opoint, opoint + length,
                      process_extents_for_insertion_mapper,
                      (void *) &closure, object, 0,
                      ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS |
                      ME_INCLUDE_INTERNAL);
}

/* ------------------------------------ */
/*    process_extents_for_deletion()    */
/* ------------------------------------ */

struct process_extents_for_deletion_arg
{
  Memind start, end;
  int destroy_included_extents;
};

/* This function is called when we're about to delete the range [from, to].
   Detach all of the extents that are completely inside the range [from, to],
   if they're detachable or open-open. */

static int
process_extents_for_deletion_mapper (EXTENT extent, void *arg)
{
  struct process_extents_for_deletion_arg *closure =
    (struct process_extents_for_deletion_arg *) arg;

  /* If the extent lies completely within the range that
     is being deleted, then nuke the extent if it's detachable
     (otherwise, it will become a zero-length extent). */

  if (closure->start <= extent_start (extent) &&
      extent_end (extent) <= closure->end)
    {
      if (extent_detachable_p (extent))
        {
          if (closure->destroy_included_extents)
            destroy_extent (extent);
          else
            extent_detach (extent);
        }
    }

  return 0;
}

/* DESTROY_THEM means destroy the extents instead of just deleting them.
   It is unused currently, but perhaps might be used (there used to
   be a function process_extents_for_destruction(), #if 0'd out,
   that did the equivalent). */
void
process_extents_for_deletion (Lisp_Object object, Bytind from,
                              Bytind to, int destroy_them)
{
  struct process_extents_for_deletion_arg closure;

  closure.start = buffer_or_string_bytind_to_memind (object, from);
  closure.end = buffer_or_string_bytind_to_memind (object, to);
  closure.destroy_included_extents = destroy_them;

  map_extents_bytind (from, to, process_extents_for_deletion_mapper,
                      (void *) &closure, object, 0,
                      ME_END_CLOSED | ME_MIGHT_MODIFY_EXTENTS);
}

/* ------------------------------- */
/*   report_extent_modification()  */
/* ------------------------------- */
struct report_extent_modification_closure {
  Lisp_Object buffer;
  Bufpos start, end;
  int afterp;
  int speccount;
};

static Lisp_Object
report_extent_modification_restore (Lisp_Object buffer)
{
  if (current_buffer != XBUFFER (buffer))
    Fset_buffer (buffer);
  return Qnil;
}

static int
report_extent_modification_mapper (EXTENT extent, void *arg)
{
  struct report_extent_modification_closure *closure =
    (struct report_extent_modification_closure *)arg;
  Lisp_Object exobj, startobj, endobj;
  Lisp_Object hook = (closure->afterp
                      ? extent_after_change_functions (extent)
                      : extent_before_change_functions (extent));
  if (NILP (hook))
    return 0;

  XSETEXTENT (exobj, extent);
  XSETINT (startobj, closure->start);
  XSETINT (endobj, closure->end);

  /* Now that we are sure to call elisp, set up an unwind-protect so
     inside_change_hook gets restored in case we throw.  Also record
     the current buffer, in case we change it.  Do the recording only
     once.

     One confusing thing here is that our caller never actually calls
     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.  */
  if (closure->speccount == -1)
    {
      closure->speccount = specpdl_depth ();
      record_unwind_protect (report_extent_modification_restore,
                             Fcurrent_buffer ());
    }

  /* The functions will expect closure->buffer to be the current
     buffer, so change it if it isn't.  */
  if (current_buffer != XBUFFER (closure->buffer))
    Fset_buffer (closure->buffer);

  /* #### It's a shame that we can't use any of the existing run_hook*
     functions here.  This is so because all of them work with
     symbols, to be able to retrieve default values of local hooks.
     <sigh>

     #### Idea: we could set up a dummy symbol, and call the hook
     functions on *that*.  */

  if (!CONSP (hook) || EQ (XCAR (hook), Qlambda))
    call3 (hook, exobj, startobj, endobj);
  else
    {
      Lisp_Object tail;
      EXTERNAL_LIST_LOOP (tail, hook)
        /* #### Shouldn't this perform the same Fset_buffer() check as
           above?  */
        call3 (XCAR (tail), exobj, startobj, endobj);
    }
  return 0;
}

void
report_extent_modification (Lisp_Object buffer, Bufpos start, Bufpos end,
                            int afterp)
{
  struct report_extent_modification_closure closure;

  closure.buffer = buffer;
  closure.start = start;
  closure.end = end;
  closure.afterp = afterp;
  closure.speccount = -1;

  map_extents (start, end, report_extent_modification_mapper, (void *)&closure,
               buffer, NULL, ME_MIGHT_CALL_ELISP);
}

\f
/************************************************************************/
/*                      extent properties                               */
/************************************************************************/

static void
set_extent_invisible (EXTENT extent, Lisp_Object value)
{
  if (!EQ (extent_invisible (extent), value))
    {
      set_extent_invisible_1 (extent, value);
      extent_changed_for_redisplay (extent, 1, 1);
    }
}

/* This function does "memoization" -- similar to the interning
   that happens with symbols.  Given a list of faces, an equivalent
   list is returned such that if this function is called twice with
   input that is `equal', the resulting outputs will be `eq'.

   Note that the inputs and outputs are in general *not* `equal' --
   faces in symbol form become actual face objects in the output.
   This is necessary so that temporary faces stay around. */

static Lisp_Object
memoize_extent_face_internal (Lisp_Object list)
{
  int len;
  int thelen;
  Lisp_Object cons, thecons;
  Lisp_Object oldtail, tail;
  struct gcpro gcpro1;

  if (NILP (list))
    return Qnil;
  if (!CONSP (list))
    return Fget_face (list);

  /* To do the memoization, we use a hash table mapping from
     external lists to internal lists.  We do `equal' comparisons
     on the keys so the memoization works correctly.

     Note that we canonicalize things so that the keys in the
     hash table (the external lists) always contain symbols and
     the values (the internal lists) always contain face objects.

     We also maintain a "reverse" table that maps from the internal
     lists to the external equivalents.  The idea here is twofold:

     1) `extent-face' wants to return a list containing face symbols
        rather than face objects.
     2) We don't want things to get quite so messed up if the user
        maliciously side-effects the returned lists.
     */

  len = XINT (Flength (list));
  thelen = XINT (Flength (Vextent_face_reusable_list));
  oldtail = Qnil;
  tail = Qnil;
  GCPRO1 (oldtail);

  /* We canonicalize the given list into another list.
     We try to avoid consing except when necessary, so we have
     a reusable list.
  */

  if (thelen < len)
    {
      cons = Vextent_face_reusable_list;
      while (!NILP (XCDR (cons)))
        cons = XCDR (cons);
      XCDR (cons) = Fmake_list (make_int (len - thelen), Qnil);
    }
  else if (thelen > len)
    {
      int i;

      /* Truncate the list temporarily so it's the right length;
         remember the old tail. */
      cons = Vextent_face_reusable_list;
      for (i = 0; i < len - 1; i++)
        cons = XCDR (cons);
      tail = cons;
      oldtail = XCDR (cons);
      XCDR (cons) = Qnil;
    }

  thecons = Vextent_face_reusable_list;
  EXTERNAL_LIST_LOOP (cons, list)
    {
      Lisp_Object face = Fget_face (XCAR (cons));

      XCAR (thecons) = Fface_name (face);
      thecons = XCDR (thecons);
    }

  list = Fgethash (Vextent_face_reusable_list, Vextent_face_memoize_hash_table,
                   Qnil);
  if (NILP (list))
    {
      Lisp_Object symlist = Fcopy_sequence (Vextent_face_reusable_list);
      Lisp_Object facelist = Fcopy_sequence (Vextent_face_reusable_list);

      LIST_LOOP (cons, facelist)
        {
          XCAR (cons) = Fget_face (XCAR (cons));
        }
      Fputhash (symlist, facelist, Vextent_face_memoize_hash_table);
      Fputhash (facelist, symlist, Vextent_face_reverse_memoize_hash_table);
      list = facelist;
    }

  /* Now restore the truncated tail of the reusable list, if necessary. */
  if (!NILP (tail))
    XCDR (tail) = oldtail;

  UNGCPRO;
  return list;
}

static Lisp_Object
external_of_internal_memoized_face (Lisp_Object face)
{
  if (NILP (face))
    return Qnil;
  else if (!CONSP (face))
    return XFACE (face)->name;
  else
    {
      face = Fgethash (face, Vextent_face_reverse_memoize_hash_table,
                       Qunbound);
      assert (!UNBOUNDP (face));
      return face;
    }
}

static Lisp_Object
canonicalize_extent_property (Lisp_Object prop, Lisp_Object value)
{
  if (EQ (prop, Qface) || EQ (prop, Qmouse_face))
    value = (external_of_internal_memoized_face
             (memoize_extent_face_internal (value)));
  return value;
}

/* Do we need a lisp-level function ? */
DEFUN ("set-extent-initial-redisplay-function", Fset_extent_initial_redisplay_function,
       2,2,0,/*
Note: This feature is experimental!

Set initial-redisplay-function of EXTENT to the function
FUNCTION.

The first time the EXTENT is (re)displayed, an eval event will be
dispatched calling FUNCTION with EXTENT as its only argument.
*/
       (extent, function))
{
  EXTENT e = decode_extent(extent, DE_MUST_BE_ATTACHED);

  e = extent_ancestor (e);  /* Is this needed? Macro also does chasing!*/
  set_extent_initial_redisplay_function(e,function);
  extent_in_red_event_p(e) = 0;  /* If the function changed we can spawn
                                    new events */
  extent_changed_for_redisplay(e,1,0); /* Do we need to mark children too ?*/

  return function;
}

DEFUN ("extent-face", Fextent_face, 1, 1, 0, /*
Return the name of the face in which EXTENT is displayed, or nil
if the extent's face is unspecified.  This might also return a list
of face names.
*/
       (extent))
{
  Lisp_Object face;

  CHECK_EXTENT (extent);
  face = extent_face (XEXTENT (extent));

  return external_of_internal_memoized_face (face);
}

DEFUN ("set-extent-face", Fset_extent_face, 2, 2, 0, /*
Make the given EXTENT have the graphic attributes specified by FACE.
FACE can also be a list of faces, and all faces listed will apply,
with faces earlier in the list taking priority over those later in the
list.
*/
       (extent, face))
{
  EXTENT e = decode_extent(extent, 0);
  Lisp_Object orig_face = face;

  /* retrieve the ancestor for efficiency and proper redisplay noting. */
  e = extent_ancestor (e);

  face = memoize_extent_face_internal (face);

  extent_face (e) = face;
  extent_changed_for_redisplay (e, 1, 0);

  return orig_face;
}


DEFUN ("extent-mouse-face", Fextent_mouse_face, 1, 1, 0, /*
Return the face used to highlight EXTENT when the mouse passes over it.
The return value will be a face name, a list of face names, or nil
if the extent's mouse face is unspecified.
*/
       (extent))
{
  Lisp_Object face;

  CHECK_EXTENT (extent);
  face = extent_mouse_face (XEXTENT (extent));

  return external_of_internal_memoized_face (face);
}

DEFUN ("set-extent-mouse-face", Fset_extent_mouse_face, 2, 2, 0, /*
Set the face used to highlight EXTENT when the mouse passes over it.
FACE can also be a list of faces, and all faces listed will apply,
with faces earlier in the list taking priority over those later in the
list.
*/
       (extent, face))
{
  EXTENT e;
  Lisp_Object orig_face = face;

  CHECK_EXTENT (extent);
  e = XEXTENT (extent);
  /* retrieve the ancestor for efficiency and proper redisplay noting. */
  e = extent_ancestor (e);

  face = memoize_extent_face_internal (face);

  set_extent_mouse_face (e, face);
  extent_changed_for_redisplay (e, 1, 0);

  return orig_face;
}

void
set_extent_glyph (EXTENT extent, Lisp_Object glyph, int endp,
                  glyph_layout layout)
{
  extent = extent_ancestor (extent);

  if (!endp)
    {
      set_extent_begin_glyph (extent, glyph);
      extent_begin_glyph_layout (extent) = layout;
    }
  else
    {
      set_extent_end_glyph (extent, glyph);
      extent_end_glyph_layout (extent) = layout;
    }

  extent_changed_for_redisplay (extent, 1, 0);
}

static Lisp_Object
glyph_layout_to_symbol (glyph_layout layout)
{
  switch (layout)
    {
    case GL_TEXT:           return Qtext;
    case GL_OUTSIDE_MARGIN: return Qoutside_margin;
    case GL_INSIDE_MARGIN:  return Qinside_margin;
    case GL_WHITESPACE:     return Qwhitespace;
    default:
      abort ();
      return Qnil; /* unreached */
    }
}

static glyph_layout
symbol_to_glyph_layout (Lisp_Object layout_obj)
{
  if (NILP (layout_obj))
    return GL_TEXT;

  CHECK_SYMBOL (layout_obj);
  if (EQ (layout_obj, Qoutside_margin)) return GL_OUTSIDE_MARGIN;
  if (EQ (layout_obj, Qinside_margin))  return GL_INSIDE_MARGIN;
  if (EQ (layout_obj, Qwhitespace))     return GL_WHITESPACE;
  if (EQ (layout_obj, Qtext))           return GL_TEXT;

  signal_simple_error ("Unknown glyph layout type", layout_obj);
  return GL_TEXT; /* unreached */
}

static Lisp_Object
set_extent_glyph_1 (Lisp_Object extent_obj, Lisp_Object glyph, int endp,
                    Lisp_Object layout_obj)
{
  EXTENT extent = decode_extent (extent_obj, DE_MUST_HAVE_BUFFER);
  glyph_layout layout = symbol_to_glyph_layout (layout_obj);

  /* Make sure we've actually been given a valid glyph or it's nil
     (meaning we're deleting a glyph from an extent). */
  if (!NILP (glyph))
    CHECK_BUFFER_GLYPH (glyph);

  set_extent_glyph (extent, glyph, endp, layout);
  return glyph;
}

DEFUN ("set-extent-begin-glyph", Fset_extent_begin_glyph, 2, 3, 0, /*
Display a bitmap, subwindow or string at the beginning of EXTENT.
BEGIN-GLYPH must be a glyph object.  The layout policy defaults to `text'.
*/
       (extent, begin_glyph, layout))
{
  return set_extent_glyph_1 (extent, begin_glyph, 0, layout);
}

DEFUN ("set-extent-end-glyph", Fset_extent_end_glyph, 2, 3, 0, /*
Display a bitmap, subwindow or string at the end of EXTENT.
END-GLYPH must be a glyph object.  The layout policy defaults to `text'.
*/
       (extent, end_glyph, layout))
{
  return set_extent_glyph_1 (extent, end_glyph, 1, layout);
}

DEFUN ("extent-begin-glyph", Fextent_begin_glyph, 1, 1, 0, /*
Return the glyph object displayed at the beginning of EXTENT.
If there is none, nil is returned.
*/
       (extent))
{
  return extent_begin_glyph (decode_extent (extent, 0));
}

DEFUN ("extent-end-glyph", Fextent_end_glyph, 1, 1, 0, /*
Return the glyph object displayed at the end of EXTENT.
If there is none, nil is returned.
*/
       (extent))
{
  return extent_end_glyph (decode_extent (extent, 0));
}

DEFUN ("set-extent-begin-glyph-layout", Fset_extent_begin_glyph_layout, 2, 2, 0, /*
Set the layout policy of EXTENT's begin glyph.
Access this using the `extent-begin-glyph-layout' function.
*/
       (extent, layout))
{
  EXTENT e = decode_extent (extent, 0);
  e = extent_ancestor (e);
  extent_begin_glyph_layout (e) = symbol_to_glyph_layout (layout);
  extent_maybe_changed_for_redisplay (e, 1, 0);
  return layout;
}

DEFUN ("set-extent-end-glyph-layout", Fset_extent_end_glyph_layout, 2, 2, 0, /*
Set the layout policy of EXTENT's end glyph.
Access this using the `extent-end-glyph-layout' function.
*/
       (extent, layout))
{
  EXTENT e = decode_extent (extent, 0);
  e = extent_ancestor (e);
  extent_end_glyph_layout (e) = symbol_to_glyph_layout (layout);
  extent_maybe_changed_for_redisplay (e, 1, 0);
  return layout;
}

DEFUN ("extent-begin-glyph-layout", Fextent_begin_glyph_layout, 1, 1, 0, /*
Return the layout policy associated with EXTENT's begin glyph.
Set this using the `set-extent-begin-glyph-layout' function.
*/
       (extent))
{
  EXTENT e = decode_extent (extent, 0);
  return glyph_layout_to_symbol ((glyph_layout) extent_begin_glyph_layout (e));
}

DEFUN ("extent-end-glyph-layout", Fextent_end_glyph_layout, 1, 1, 0, /*
Return the layout policy associated with EXTENT's end glyph.
Set this using the `set-extent-end-glyph-layout' function.
*/
       (extent))
{
  EXTENT e = decode_extent (extent, 0);
  return glyph_layout_to_symbol ((glyph_layout) extent_end_glyph_layout (e));
}

DEFUN ("set-extent-priority", Fset_extent_priority, 2, 2, 0, /*
Set the display priority of EXTENT to PRIORITY (an integer).
When the extent attributes are being merged for display, the priority
is used to determine which extent takes precedence in the event of a
conflict (two extents whose faces both specify font, for example: the
font of the extent with the higher priority will be used).
Extents are created with priority 0; priorities may be negative.
*/
       (extent, priority))
{
  EXTENT e = decode_extent (extent, 0);

  CHECK_INT (priority);
  e = extent_ancestor (e);
  set_extent_priority (e, XINT (priority));
  extent_maybe_changed_for_redisplay (e, 1, 0);
  return priority;
}

DEFUN ("extent-priority", Fextent_priority, 1, 1, 0, /*
Return the display priority of EXTENT; see `set-extent-priority'.
*/
       (extent))
{
  EXTENT e = decode_extent (extent, 0);
  return make_int (extent_priority (e));
}

DEFUN ("set-extent-property", Fset_extent_property, 3, 3, 0, /*
Change a property of an extent.
PROPERTY may be any symbol; the value stored may be accessed with
 the `extent-property' function.
The following symbols have predefined meanings:

 detached           Removes the extent from its buffer; setting this is
                    the same as calling `detach-extent'.

 destroyed          Removes the extent from its buffer, and makes it
                    unusable in the future; this is the same calling
                    `delete-extent'.

 priority           Change redisplay priority; same as `set-extent-priority'.

 start-open         Whether the set of characters within the extent is
                    treated being open on the left, that is, whether
                    the start position is an exclusive, rather than
                    inclusive, boundary.  If true, then characters
                    inserted exactly at the beginning of the extent
                    will remain outside of the extent; otherwise they
                    will go into the extent, extending it.

 end-open           Whether the set of characters within the extent is
                    treated being open on the right, that is, whether
                    the end position is an exclusive, rather than
                    inclusive, boundary.  If true, then characters
                    inserted exactly at the end of the extent will
                    remain outside of the extent; otherwise they will
                    go into the extent, extending it.

                    By default, extents have the `end-open' but not the
                    `start-open' property set.

 read-only          Text within this extent will be unmodifiable.

 initial-redisplay-function (EXPERIMENTAL)
                    function to be called the first time (part of) the extent
                    is redisplayed. It will be called with the extent as its
                    first argument.
                    Note: The function will not be called immediately
                    during redisplay, an eval event will be dispatched.

 detachable         Whether the extent gets detached (as with
                    `detach-extent') when all the text within the
                    extent is deleted.  This is true by default.  If
                    this property is not set, the extent becomes a
                    zero-length extent when its text is deleted. (In
                    such a case, the `start-open' property is
                    automatically removed if both the `start-open' and
                    `end-open' properties are set, since zero-length
                    extents open on both ends are not allowed.)

 face               The face in which to display the text.  Setting
                    this is the same as calling `set-extent-face'.

 mouse-face         If non-nil, the extent will be highlighted in this
                    face when the mouse moves over it.

 pointer            If non-nil, and a valid pointer glyph, this specifies
                    the shape of the mouse pointer while over the extent.

 highlight          Obsolete: Setting this property is equivalent to
                    setting a `mouse-face' property of `highlight'.
                    Reading this property returns non-nil if
                    the extent has a non-nil `mouse-face' property.

 duplicable         Whether this extent should be copied into strings,
                    so that kill, yank, and undo commands will restore
                    or copy it.  `duplicable' extents are copied from
                    an extent into a string when `buffer-substring' or
                    a similar function creates a string.  The extents
                    in a string are copied into other strings created
                    from the string using `concat' or `substring'.
                    When `insert' or a similar function inserts the
                    string into a buffer, the extents are copied back
                    into the buffer.

 unique             Meaningful only in conjunction with `duplicable'.
                    When this is set, there may be only one instance
                    of this extent attached at a time: if it is copied
                    to the kill ring and then yanked, the extent is
                    not copied.  If, however, it is killed (removed
                    from the buffer) and then yanked, it will be
                    re-attached at the new position.

 invisible          If the value is non-nil, text under this extent
                    may be treated as not present for the purpose of
                    redisplay, or may be displayed using an ellipsis
                    or other marker; see `buffer-invisibility-spec'
                    and `invisible-text-glyph'.  In all cases,
                    however, the text is still visible to other
                    functions that examine a buffer's text.

 keymap             This keymap is consulted for mouse clicks on this
                    extent, or keypresses made while point is within the
                    extent.

 copy-function      This is a hook that is run when a duplicable extent
                    is about to be copied from a buffer to a string (or
                    the kill ring).  It is called with three arguments,
                    the extent, and the buffer-positions within it
                    which are being copied.  If this function returns
                    nil, then the extent will not be copied; otherwise
                    it will.

 paste-function     This is a hook that is run when a duplicable extent is
                    about to be copied from a string (or the kill ring)
                    into a buffer.  It is called with three arguments,
                    the original extent, and the buffer positions which
                    the copied extent will occupy.  (This hook is run
                    after the corresponding text has already been
                    inserted into the buffer.)  Note that the extent
                    argument may be detached when this function is run.
                    If this function returns nil, no extent will be
                    inserted.  Otherwise, there will be an extent
                    covering the range in question.

                    If the original extent is not attached to a buffer,
                    then it will be re-attached at this range.
                    Otherwise, a copy will be made, and that copy
                    attached here.

                    The copy-function and paste-function are meaningful
                    only for extents with the `duplicable' flag set,
                    and if they are not specified, behave as if `t' was
                    the returned value.  When these hooks are invoked,
                    the current buffer is the buffer which the extent
                    is being copied from/to, respectively.

 begin-glyph        A glyph to be displayed at the beginning of the extent,
                    or nil.

 end-glyph          A glyph to be displayed at the end of the extent,
                    or nil.

 begin-glyph-layout The layout policy (one of `text', `whitespace',
                    `inside-margin', or `outside-margin') of the extent's
                    begin glyph.

 end-glyph-layout The layout policy of the extent's end glyph.
*/
       (extent, property, value))
{
  /* This function can GC if property is `keymap' */
  EXTENT e = decode_extent (extent, 0);

  if (EQ (property, Qread_only))
    set_extent_read_only (e, value);
  else if (EQ (property, Qunique))
    extent_unique_p (e) = !NILP (value);
  else if (EQ (property, Qduplicable))
    extent_duplicable_p (e) = !NILP (value);
  else if (EQ (property, Qinvisible))
    set_extent_invisible (e, value);
  else if (EQ (property, Qdetachable))
    extent_detachable_p (e) = !NILP (value);

  else if (EQ (property, Qdetached))
    {
      if (NILP (value))
        error ("can only set `detached' to t");
      Fdetach_extent (extent);
    }
  else if (EQ (property, Qdestroyed))
    {
      if (NILP (value))
        error ("can only set `destroyed' to t");
      Fdelete_extent (extent);
    }
  else if (EQ (property, Qpriority))
    Fset_extent_priority (extent, value);
  else if (EQ (property, Qface))
    Fset_extent_face (extent, value);
  else if (EQ (property, Qinitial_redisplay_function))
    Fset_extent_initial_redisplay_function (extent, value);
  else if (EQ (property, Qbefore_change_functions))
    set_extent_before_change_functions (e, value);
  else if (EQ (property, Qafter_change_functions))
    set_extent_after_change_functions (e, value);
  else if (EQ (property, Qmouse_face))
    Fset_extent_mouse_face (extent, value);
  /* Obsolete: */
  else if (EQ (property, Qhighlight))
    Fset_extent_mouse_face (extent, Qhighlight);
  else if (EQ (property, Qbegin_glyph_layout))
    Fset_extent_begin_glyph_layout (extent, value);
  else if (EQ (property, Qend_glyph_layout))
    Fset_extent_end_glyph_layout (extent, value);
  /* For backwards compatibility.  We use begin glyph because it is by
     far the more used of the two. */
  else if (EQ (property, Qglyph_layout))
    Fset_extent_begin_glyph_layout (extent, value);
  else if (EQ (property, Qbegin_glyph))
    Fset_extent_begin_glyph (extent, value, Qnil);
  else if (EQ (property, Qend_glyph))
    Fset_extent_end_glyph (extent, value, Qnil);
  else if (EQ (property, Qstart_open))
    set_extent_openness (e, !NILP (value), -1);
  else if (EQ (property, Qend_open))
    set_extent_openness (e, -1, !NILP (value));
  /* Support (but don't document...) the obvious *_closed antonyms. */
  else if (EQ (property, Qstart_closed))
    set_extent_openness (e, NILP (value), -1);
  else if (EQ (property, Qend_closed))
    set_extent_openness (e, -1, NILP (value));
  else
    {
      if (EQ (property, Qkeymap))
        while (!NILP (value) && NILP (Fkeymapp (value)))
          value = wrong_type_argument (Qkeymapp, value);

      external_plist_put (extent_plist_addr (e), property, value, 0, ERROR_ME);
    }

  return value;
}

DEFUN ("set-extent-properties", Fset_extent_properties, 2, 2, 0, /*
Change some properties of EXTENT.
PLIST is a property list.
For a list of built-in properties, see `set-extent-property'.
*/
       (extent, plist))
{
  /* This function can GC, if one of the properties is `keymap' */
  Lisp_Object property, value;
  struct gcpro gcpro1;
  GCPRO1 (plist);

  plist = Fcopy_sequence (plist);
  Fcanonicalize_plist (plist, Qnil);

  while (!NILP (plist))
    {
      property = Fcar (plist); plist = Fcdr (plist);
      value    = Fcar (plist); plist = Fcdr (plist);
      Fset_extent_property (extent, property, value);
    }
  UNGCPRO;
  return Qnil;
}

DEFUN ("extent-property", Fextent_property, 2, 3, 0, /*
Return EXTENT's value for property PROPERTY.
See `set-extent-property' for the built-in property names.
*/
       (extent, property, default_))
{
  EXTENT e = decode_extent (extent, 0);

  if (EQ (property, Qdetached))
    return extent_detached_p (e) ? Qt : Qnil;
  else if (EQ (property, Qdestroyed))
    return !EXTENT_LIVE_P (e) ? Qt : Qnil;
  else if (EQ (property, Qstart_open))
    return extent_normal_field (e, start_open) ? Qt : Qnil;
  else if (EQ (property, Qend_open))
    return extent_normal_field (e, end_open) ? Qt : Qnil;
  else if (EQ (property, Qunique))
    return extent_normal_field (e, unique) ? Qt : Qnil;
  else if (EQ (property, Qduplicable))
    return extent_normal_field (e, duplicable) ? Qt : Qnil;
  else if (EQ (property, Qdetachable))
    return extent_normal_field (e, detachable) ? Qt : Qnil;
  /* Support (but don't document...) the obvious *_closed antonyms. */
  else if (EQ (property, Qstart_closed))
    return extent_start_open_p (e) ? Qnil : Qt;
  else if (EQ (property, Qend_closed))
    return extent_end_open_p (e) ? Qnil : Qt;
  else if (EQ (property, Qpriority))
    return make_int (extent_priority (e));
  else if (EQ (property, Qread_only))
    return extent_read_only (e);
  else if (EQ (property, Qinvisible))
    return extent_invisible (e);
  else if (EQ (property, Qface))
    return Fextent_face (extent);
  else if (EQ (property, Qinitial_redisplay_function))
    return extent_initial_redisplay_function (e);
  else if (EQ (property, Qbefore_change_functions))
    return extent_before_change_functions (e);
  else if (EQ (property, Qafter_change_functions))
    return extent_after_change_functions (e);
  else if (EQ (property, Qmouse_face))
    return Fextent_mouse_face (extent);
  /* Obsolete: */
  else if (EQ (property, Qhighlight))
    return !NILP (Fextent_mouse_face (extent)) ? Qt : Qnil;
  else if (EQ (property, Qbegin_glyph_layout))
    return Fextent_begin_glyph_layout (extent);
  else if (EQ (property, Qend_glyph_layout))
    return Fextent_end_glyph_layout (extent);
  /* For backwards compatibility.  We use begin glyph because it is by
     far the more used of the two. */
  else if (EQ (property, Qglyph_layout))
    return Fextent_begin_glyph_layout (extent);
  else if (EQ (property, Qbegin_glyph))
    return extent_begin_glyph (e);
  else if (EQ (property, Qend_glyph))
    return extent_end_glyph (e);
  else
    {
      Lisp_Object value = external_plist_get (extent_plist_addr (e),
                                              property, 0, ERROR_ME);
      return UNBOUNDP (value) ? default_ : value;
    }
}

DEFUN ("extent-properties", Fextent_properties, 1, 1, 0, /*
Return a property list of the attributes of EXTENT.
Do not modify this list; use `set-extent-property' instead.
*/
       (extent))
{
  EXTENT e, anc;
  Lisp_Object result, face, anc_obj;
  glyph_layout layout;

  CHECK_EXTENT (extent);
  e = XEXTENT (extent);
  if (!EXTENT_LIVE_P (e))
    return cons3 (Qdestroyed, Qt, Qnil);

  anc = extent_ancestor (e);
  XSETEXTENT (anc_obj, anc);

  /* For efficiency, use the ancestor for all properties except detached */

  result = extent_plist_slot (anc);

  if (!NILP (face = Fextent_face (anc_obj)))
    result = cons3 (Qface, face, result);

  if (!NILP (face = Fextent_mouse_face (anc_obj)))
    result = cons3 (Qmouse_face, face, result);

  if ((layout = (glyph_layout) extent_begin_glyph_layout (anc)) != GL_TEXT)
    {
      Lisp_Object sym = glyph_layout_to_symbol (layout);
      result = cons3 (Qglyph_layout,       sym, result); /* compatibility */
      result = cons3 (Qbegin_glyph_layout, sym, result);
    }

  if ((layout = (glyph_layout) extent_end_glyph_layout (anc)) != GL_TEXT)
    result = cons3 (Qend_glyph_layout, glyph_layout_to_symbol (layout), result);

  if (!NILP (extent_end_glyph (anc)))
    result = cons3 (Qend_glyph, extent_end_glyph (anc), result);

  if (!NILP (extent_begin_glyph (anc)))
    result = cons3 (Qbegin_glyph, extent_begin_glyph (anc), result);

  if (extent_priority (anc) != 0)
    result = cons3 (Qpriority, make_int (extent_priority (anc)), result);

  if (!NILP (extent_initial_redisplay_function (anc)))
    result = cons3 (Qinitial_redisplay_function,
                    extent_initial_redisplay_function (anc), result);

  if (!NILP (extent_before_change_functions (anc)))
    result = cons3 (Qbefore_change_functions,
                    extent_before_change_functions (anc), result);

  if (!NILP (extent_after_change_functions (anc)))
    result = cons3 (Qafter_change_functions,
                    extent_after_change_functions (anc), result);

  if (!NILP (extent_invisible (anc)))
    result = cons3 (Qinvisible, extent_invisible (anc), result);

  if (!NILP (extent_read_only (anc)))
    result = cons3 (Qread_only, extent_read_only (anc), result);

  if  (extent_normal_field (anc, end_open))
    result = cons3 (Qend_open, Qt, result);

  if  (extent_normal_field (anc, start_open))
    result = cons3 (Qstart_open, Qt, result);

  if  (extent_normal_field (anc, detachable))
    result = cons3 (Qdetachable, Qt, result);

  if  (extent_normal_field (anc, duplicable))
    result = cons3 (Qduplicable, Qt, result);

  if  (extent_normal_field (anc, unique))
    result = cons3 (Qunique, Qt, result);

  /* detached is not an inherited property */
  if (extent_detached_p (e))
    result = cons3 (Qdetached, Qt, result);

  return result;
}

\f
/************************************************************************/
/*                           highlighting                               */
/************************************************************************/

/* The display code looks into the Vlast_highlighted_extent variable to
   correctly display highlighted extents.  This updates that variable,
   and marks the appropriate buffers as needing some redisplay.
 */
static void
do_highlight (Lisp_Object extent_obj, int highlight_p)
{
  if (( highlight_p && (EQ (Vlast_highlighted_extent, extent_obj))) ||
      (!highlight_p && (EQ (Vlast_highlighted_extent, Qnil))))
    return;
  if (EXTENTP (Vlast_highlighted_extent) &&
      EXTENT_LIVE_P (XEXTENT (Vlast_highlighted_extent)))
    {
      /* do not recurse on descendants.  Only one extent is highlighted
         at a time. */
      extent_changed_for_redisplay (XEXTENT (Vlast_highlighted_extent), 0, 0);
    }
  Vlast_highlighted_extent = Qnil;
  if (!NILP (extent_obj)
      && BUFFERP (extent_object (XEXTENT (extent_obj)))
      && highlight_p)
    {
      extent_changed_for_redisplay (XEXTENT (extent_obj), 0, 0);
      Vlast_highlighted_extent = extent_obj;
    }
}

DEFUN ("force-highlight-extent", Fforce_highlight_extent, 1, 2, 0, /*
Highlight or unhighlight the given extent.
If the second arg is non-nil, it will be highlighted, else dehighlighted.
This is the same as `highlight-extent', except that it will work even
on extents without the `mouse-face' property.
*/
       (extent, highlight_p))
{
  if (NILP (extent))
    highlight_p = Qnil;
  else
    XSETEXTENT (extent, decode_extent (extent, DE_MUST_BE_ATTACHED));
  do_highlight (extent, !NILP (highlight_p));
  return Qnil;
}

DEFUN ("highlight-extent", Fhighlight_extent, 1, 2, 0, /*
Highlight EXTENT, if it is highlightable.
\(that is, if it has the `mouse-face' property).
If the second arg is non-nil, it will be highlighted, else dehighlighted.
Highlighted extents are displayed as if they were merged with the face
or faces specified by the `mouse-face' property.
*/
       (extent, highlight_p))
{
  if (EXTENTP (extent) && NILP (extent_mouse_face (XEXTENT (extent))))
    return Qnil;
  else
    return Fforce_highlight_extent (extent, highlight_p);
}

\f
/************************************************************************/
/*                         strings and extents                          */
/************************************************************************/

/* copy/paste hooks */

static int
run_extent_copy_paste_internal (EXTENT e, Bufpos from, Bufpos to,
                                Lisp_Object object,
                                Lisp_Object prop)
{
  /* This function can GC */
  Lisp_Object extent;
  Lisp_Object copy_fn;
  XSETEXTENT (extent, e);
  copy_fn = Fextent_property (extent, prop, Qnil);
  if (!NILP (copy_fn))
    {
      Lisp_Object flag;
      struct gcpro gcpro1, gcpro2, gcpro3;
      GCPRO3 (extent, copy_fn, object);
      if (BUFFERP (object))
        flag = call3_in_buffer (XBUFFER (object), copy_fn, extent,
                                make_int (from), make_int (to));
      else
        flag = call3 (copy_fn, extent, make_int (from), make_int (to));
      UNGCPRO;
      if (NILP (flag) || !EXTENT_LIVE_P (XEXTENT (extent)))
        return 0;
    }
  return 1;
}

static int
run_extent_copy_function (EXTENT e, Bytind from, Bytind to)
{
  Lisp_Object object = extent_object (e);
  /* This function can GC */
  return run_extent_copy_paste_internal
    (e, buffer_or_string_bytind_to_bufpos (object, from),
     buffer_or_string_bytind_to_bufpos (object, to), object,
     Qcopy_function);
}

static int
run_extent_paste_function (EXTENT e, Bytind from, Bytind to,
                           Lisp_Object object)
{
  /* This function can GC */
  return run_extent_copy_paste_internal
    (e, buffer_or_string_bytind_to_bufpos (object, from),
     buffer_or_string_bytind_to_bufpos (object, to), object,
     Qpaste_function);
}

static void
update_extent (EXTENT extent, Bytind from, Bytind to)
{
  set_extent_endpoints (extent, from, to, Qnil);
}

/* Insert an extent, usually from the dup_list of a string which
   has just been inserted.
   This code does not handle the case of undo.
   */
static Lisp_Object
insert_extent (EXTENT extent, Bytind new_start, Bytind new_end,
               Lisp_Object object, int run_hooks)
{
  /* This function can GC */
  Lisp_Object tmp;

  if (!EQ (extent_object (extent), object))
    goto copy_it;

  if (extent_detached_p (extent))
    {
      if (run_hooks &&
          !run_extent_paste_function (extent, new_start, new_end, object))
        /* The paste-function said don't re-attach this extent here. */
        return Qnil;
      else
        update_extent (extent, new_start, new_end);
    }
  else
    {
      Bytind exstart = extent_endpoint_bytind (extent, 0);
      Bytind exend = extent_endpoint_bytind (extent, 1);

      if (exend < new_start || exstart > new_end)
        goto copy_it;
      else
        {
          new_start = min (exstart, new_start);
          new_end = max (exend, new_end);
          if (exstart != new_start || exend != new_end)
            update_extent (extent, new_start, new_end);
        }
    }

  XSETEXTENT (tmp, extent);
  return tmp;

 copy_it:
  if (run_hooks &&
      !run_extent_paste_function (extent, new_start, new_end, object))
    /* The paste-function said don't attach a copy of the extent here. */
    return Qnil;
  else
    {
      XSETEXTENT (tmp, copy_extent (extent, new_start, new_end, object));
      return tmp;
    }
}

DEFUN ("insert-extent", Finsert_extent, 1, 5, 0, /*
Insert EXTENT from START to END in BUFFER-OR-STRING.
BUFFER-OR-STRING defaults to the current buffer if omitted.
This operation does not insert any characters,
but otherwise acts as if there were a replicating extent whose
parent is EXTENT in some string that was just inserted.
Returns the newly-inserted extent.
The fourth arg, NO-HOOKS, can be used to inhibit the running of the
 extent's `paste-function' property if it has one.
See documentation on `detach-extent' for a discussion of undo recording.
*/
       (extent, start, end, no_hooks, buffer_or_string))
{
  EXTENT ext = decode_extent (extent, 0);
  Lisp_Object copy;
  Bytind s, e;

  buffer_or_string = decode_buffer_or_string (buffer_or_string);
  get_buffer_or_string_range_byte (buffer_or_string, start, end, &s, &e,
                                   GB_ALLOW_PAST_ACCESSIBLE);

  copy = insert_extent (ext, s, e, buffer_or_string, NILP (no_hooks));
  if (EXTENTP (copy))
    {
      if (extent_duplicable_p (XEXTENT (copy)))
        record_extent (copy, 1);
    }
  return copy;
}

\f
/* adding buffer extents to a string */

struct add_string_extents_arg
{
  Bytind from;
  Bytecount length;
  Lisp_Object string;
};

static int
add_string_extents_mapper (EXTENT extent, void *arg)
{
  /* This function can GC */
  struct add_string_extents_arg *closure =
    (struct add_string_extents_arg *) arg;
  Bytecount start = extent_endpoint_bytind (extent, 0) - closure->from;
  Bytecount end   = extent_endpoint_bytind (extent, 1) - closure->from;

  if (extent_duplicable_p (extent))
    {
      start = max (start, 0);
      end = min (end, closure->length);

      /* Run the copy-function to give an extent the option of
         not being copied into the string (or kill ring).
         */
      if (extent_duplicable_p (extent) &&
          !run_extent_copy_function (extent, start + closure->from,
                                     end + closure->from))
        return 0;
      copy_extent (extent, start, end, closure->string);
    }

  return 0;
}

/* Add the extents in buffer BUF from OPOINT to OPOINT+LENGTH to
   the string STRING. */
void
add_string_extents (Lisp_Object string, struct buffer *buf, Bytind opoint,
                    Bytecount length)
{
  /* This function can GC */
  struct add_string_extents_arg closure;
  struct gcpro gcpro1, gcpro2;
  Lisp_Object buffer;

  closure.from = opoint;
  closure.length = length;
  closure.string = string;
  buffer = make_buffer (buf);
  GCPRO2 (buffer, string);
  map_extents_bytind (opoint, opoint + length, add_string_extents_mapper,
                      (void *) &closure, buffer, 0,
                      /* ignore extents that just abut the region */
                      ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
                      /* we are calling E-Lisp (the extent's copy function)
                         so anything might happen */
                      ME_MIGHT_CALL_ELISP);
  UNGCPRO;
}

struct splice_in_string_extents_arg
{
  Bytecount pos;
  Bytecount length;
  Bytind opoint;
  Lisp_Object buffer;
};

static int
splice_in_string_extents_mapper (EXTENT extent, void *arg)
{
  /* This function can GC */
  struct splice_in_string_extents_arg *closure =
    (struct splice_in_string_extents_arg *) arg;
  /* BASE_START and BASE_END are the limits in the buffer of the string
     that was just inserted.

     NEW_START and NEW_END are the prospective buffer positions of the
     extent that is going into the buffer. */
  Bytind base_start = closure->opoint;
  Bytind base_end = base_start + closure->length;
  Bytind new_start = (base_start + extent_endpoint_bytind (extent, 0) -
                      closure->pos);
  Bytind new_end = (base_start + extent_endpoint_bytind (extent, 1) -
                    closure->pos);

  if (new_start < base_start)
    new_start = base_start;
  if (new_end > base_end)
    new_end = base_end;
  if (new_end <= new_start)
    return 0;

  if (!extent_duplicable_p (extent))
    return 0;

  if (!inside_undo &&
      !run_extent_paste_function (extent, new_start, new_end,
                                  closure->buffer))
    return 0;
  copy_extent (extent, new_start, new_end, closure->buffer);

  return 0;
}

/* We have just inserted a section of STRING (starting at POS, of
   length LENGTH) into buffer BUF at OPOINT.  Do whatever is necessary
   to get the string's extents into the buffer. */

void
splice_in_string_extents (Lisp_Object string, struct buffer *buf,
                          Bytind opoint, Bytecount length, Bytecount pos)
{
  struct splice_in_string_extents_arg closure;
  struct gcpro gcpro1, gcpro2;
  Lisp_Object buffer;

  buffer = make_buffer (buf);
  closure.opoint = opoint;
  closure.pos = pos;
  closure.length = length;
  closure.buffer = buffer;
  GCPRO2 (buffer, string);
  map_extents_bytind (pos, pos + length,
                      splice_in_string_extents_mapper,
                      (void *) &closure, string, 0,
                      /* ignore extents that just abut the region */
                      ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
                      /* we are calling E-Lisp (the extent's copy function)
                         so anything might happen */
                      ME_MIGHT_CALL_ELISP);
  UNGCPRO;
}

struct copy_string_extents_arg
{
  Bytecount new_pos;
  Bytecount old_pos;
  Bytecount length;
  Lisp_Object new_string;
};

struct copy_string_extents_1_arg
{
  Lisp_Object parent_in_question;
  EXTENT found_extent;
};

static int
copy_string_extents_mapper (EXTENT extent, void *arg)
{
  struct copy_string_extents_arg *closure =
    (struct copy_string_extents_arg *) arg;
  Bytecount old_start, old_end, new_start, new_end;

  old_start = extent_endpoint_bytind (extent, 0);
  old_end   = extent_endpoint_bytind (extent, 1);

  old_start = max (closure->old_pos, old_start);
  old_end   = min (closure->old_pos + closure->length, old_end);

  if (old_start >= old_end)
    return 0;

  new_start = old_start + closure->new_pos - closure->old_pos;
  new_end   = old_end   + closure->new_pos - closure->old_pos;

  copy_extent (extent, new_start, new_end, closure->new_string);
  return 0;
}

/* The string NEW_STRING was partially constructed from OLD_STRING.
   In particular, the section of length LEN starting at NEW_POS in
   NEW_STRING came from the section of the same length starting at
   OLD_POS in OLD_STRING.  Copy the extents as appropriate. */

void
copy_string_extents (Lisp_Object new_string, Lisp_Object old_string,
                     Bytecount new_pos, Bytecount old_pos,
                     Bytecount length)
{
  struct copy_string_extents_arg closure;
  struct gcpro gcpro1, gcpro2;

  closure.new_pos = new_pos;
  closure.old_pos = old_pos;
  closure.new_string = new_string;
  closure.length = length;
  GCPRO2 (new_string, old_string);
  map_extents_bytind (old_pos, old_pos + length,
                      copy_string_extents_mapper,
                      (void *) &closure, old_string, 0,
                      /* ignore extents that just abut the region */
                      ME_END_CLOSED | ME_ALL_EXTENTS_OPEN |
                      /* we are calling E-Lisp (the extent's copy function)
                         so anything might happen */
                      ME_MIGHT_CALL_ELISP);
  UNGCPRO;
}

/* Checklist for sanity checking:
   - {kill, yank, copy} at {open, closed} {start, end} of {writable, read-only} extent
   - {kill, copy} & yank {once, repeatedly} duplicable extent in {same, different} buffer
 */

\f
/************************************************************************/
/*                              text properties                         */
/************************************************************************/

/* Text properties
   Originally this stuff was implemented in lisp (all of the functionality
   exists to make that possible) but speed was a problem.
 */

Lisp_Object Qtext_prop;
Lisp_Object Qtext_prop_extent_paste_function;

static Lisp_Object
get_text_property_bytind (Bytind position, Lisp_Object prop,
                          Lisp_Object object, enum extent_at_flag fl,
                          int text_props_only)
{
  Lisp_Object extent;

  /* text_props_only specifies whether we only consider text-property
     extents (those with the 'text-prop property set) or all extents. */
  if (!text_props_only)
    extent = extent_at_bytind (position, object, prop, 0, fl);
  else
    {
      EXTENT prior = 0;
      while (1)
        {
          extent = extent_at_bytind (position, object, Qtext_prop, prior,
                                     fl);
          if (NILP (extent))
            return Qnil;
          if (EQ (prop, Fextent_property (extent, Qtext_prop, Qnil)))
            break;
          prior = XEXTENT (extent);
        }
    }

  if (!NILP (extent))
    return Fextent_property (extent, prop, Qnil);
  if (!NILP (Vdefault_text_properties))
    return Fplist_get (Vdefault_text_properties, prop, Qnil);
  return Qnil;
}

static Lisp_Object
get_text_property_1 (Lisp_Object pos, Lisp_Object prop, Lisp_Object object,
                     Lisp_Object at_flag, int text_props_only)
{
  Bytind position;
  int invert = 0;

  object = decode_buffer_or_string (object);
  position = get_buffer_or_string_pos_byte (object, pos, GB_NO_ERROR_IF_BAD);

  /* We canonicalize the start/end-open/closed properties to the
     non-default version -- "adding" the default property really
     needs to remove the non-default one.  See below for more
     on this. */
  if (EQ (prop, Qstart_closed))
    {
      prop = Qstart_open;
      invert = 1;
    }

  if (EQ (prop, Qend_open))
    {
      prop = Qend_closed;
      invert = 1;
    }

  {
    Lisp_Object val =
      get_text_property_bytind (position, prop, object,
                                decode_extent_at_flag (at_flag),
                                text_props_only);
    if (invert)
      val = NILP (val) ? Qt : Qnil;
    return val;
  }
}

DEFUN ("get-text-property", Fget_text_property, 2, 4, 0, /*
Return the value of the PROP property at the given position.
Optional arg OBJECT specifies the buffer or string to look in, and
 defaults to the current buffer.
Optional arg AT-FLAG controls what it means for a property to be "at"
 a position, and has the same meaning as in `extent-at'.
This examines only those properties added with `put-text-property'.
See also `get-char-property'.
*/
       (pos, prop, object, at_flag))
{
  return get_text_property_1 (pos, prop, object, at_flag, 1);
}

DEFUN ("get-char-property", Fget_char_property, 2, 4, 0, /*
Return the value of the PROP property at the given position.
Optional arg OBJECT specifies the buffer or string to look in, and
 defaults to the current buffer.
Optional arg AT-FLAG controls what it means for a property to be "at"
 a position, and has the same meaning as in `extent-at'.
This examines properties on all extents.
See also `get-text-property'.
*/
       (pos, prop, object, at_flag))
{
  return get_text_property_1 (pos, prop, object, at_flag, 0);
}

/* About start/end-open/closed:

   These properties have to be handled specially because of their
   strange behavior.  If I put the "start-open" property on a region,
   then *all* text-property extents in the region have to have their
   start be open.  This is unlike all other properties, which don't
   affect the extents of text properties other than their own.

   So:

   1) We have to map start-closed to (not start-open) and end-open
      to (not end-closed) -- i.e. adding the default is really the
      same as remove the non-default property.  It won't work, for
      example, to have both "start-open" and "start-closed" on
      the same region.
   2) Whenever we add one of these properties, we go through all
      text-property extents in the region and set the appropriate
      open/closedness on them.
   3) Whenever we change a text-property extent for a property,
      we have to make sure we set the open/closedness properly.

      (2) and (3) together rely on, and maintain, the invariant
      that the open/closedness of text-property extents is correct
      at the beginning and end of each operation.
   */

struct put_text_prop_arg
{
  Lisp_Object prop, value;      /* The property and value we are storing */
  Bytind start, end;    /* The region into which we are storing it */
  Lisp_Object object;
  Lisp_Object the_extent;       /* Our chosen extent; this is used for
                                   communication between subsequent passes. */
  int changed_p;                /* Output: whether we have modified anything */
};

static int
put_text_prop_mapper (EXTENT e, void *arg)
{
  struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;

  Lisp_Object object = closure->object;
  Lisp_Object value = closure->value;
  Bytind e_start, e_end;
  Bytind start = closure->start;
  Bytind end   = closure->end;
  Lisp_Object extent, e_val;
  int is_eq;

  XSETEXTENT (extent, e);

  /* Note: in some cases when the property itself is 'start-open
     or 'end-closed, the checks to set the openness may do a bit
     of extra work; but it won't hurt because we then fix up the
     openness later on in put_text_prop_openness_mapper(). */
  if (!EQ (Fextent_property (extent, Qtext_prop, Qnil), closure->prop))
    /* It's not for this property; do nothing. */
    return 0;

  e_start = extent_endpoint_bytind (e, 0);
  e_end   = extent_endpoint_bytind (e, 1);
  e_val = Fextent_property (extent, closure->prop, Qnil);
  is_eq = EQ (value, e_val);

  if (!NILP (value) && NILP (closure->the_extent) && is_eq)
    {
      /* We want there to be an extent here at the end, and we haven't picked
         one yet, so use this one.  Extend it as necessary.  We only reuse an
         extent which has an EQ value for the prop in question to avoid
         side-effecting the kill ring (that is, we never change the property
         on an extent after it has been created.)
       */
      if (e_start != start || e_end != end)
        {
          Bytind new_start = min (e_start, start);
          Bytind new_end = max (e_end, end);
          set_extent_endpoints (e, new_start, new_end, Qnil);
          /* If we changed the endpoint, then we need to set its
             openness. */
          set_extent_openness (e, new_start != e_start
                               ? !NILP (get_text_property_bytind
                                        (start, Qstart_open, object,
                                         EXTENT_AT_AFTER, 1)) : -1,
                               new_end != e_end
                               ? NILP (get_text_property_bytind
                                       (end - 1, Qend_closed, object,
                                        EXTENT_AT_AFTER, 1))
                               : -1);
          closure->changed_p = 1;
        }
      closure->the_extent = extent;
    }

  /* Even if we're adding a prop, at this point, we want all other extents of
     this prop to go away (as now they overlap).  So the theory here is that,
     when we are adding a prop to a region that has multiple (disjoint)
     occurrences of that prop in it already, we pick one of those and extend
     it, and remove the others.
   */

  else if (EQ (extent, closure->the_extent))
    {
      /* just in case map-extents hits it again (does that happen?) */
      ;
    }
  else if (e_start >= start && e_end <= end)
    {
      /* Extent is contained in region; remove it.  Don't destroy or modify
         it, because we don't want to change the attributes pointed to by the
         duplicates in the kill ring.
       */
      extent_detach (e);
      closure->changed_p = 1;
    }
  else if (!NILP (closure->the_extent) &&
           is_eq &&
           e_start <= end &&
           e_end >= start)
    {
      EXTENT te = XEXTENT (closure->the_extent);
      /* This extent overlaps, and has the same prop/value as the extent we've
         decided to reuse, so we can remove this existing extent as well (the
         whole thing, even the part outside of the region) and extend
         the-extent to cover it, resulting in the minimum number of extents in
         the buffer.
       */
      Bytind the_start = extent_endpoint_bytind (te, 0);
      Bytind the_end = extent_endpoint_bytind (te, 1);
      if (e_start != the_start &&  /* note AND not OR -- hmm, why is this
                                      the case? I think it's because the
                                      assumption that the text-property
                                      extents don't overlap makes it
                                      OK; changing it to an OR would
                                      result in changed_p sometimes getting
                                      falsely marked.  Is this bad? */
          e_end   != the_end)
        {
          Bytind new_start = min (e_start, the_start);
          Bytind new_end = max (e_end, the_end);
          set_extent_endpoints (te, new_start, new_end, Qnil);
          /* If we changed the endpoint, then we need to set its
             openness.  We are setting the endpoint to be the same as
             that of the extent we're about to remove, and we assume
             (the invariant mentioned above) that extent has the
             proper endpoint setting, so we just use it. */
          set_extent_openness (te, new_start != e_start ?
                               (int) extent_start_open_p (e) : -1,
                               new_end != e_end ?
                               (int) extent_end_open_p (e) : -1);
          closure->changed_p = 1;
        }
      extent_detach (e);
    }
  else if (e_end <= end)
    {
      /* Extent begins before start but ends before end, so we can just
         decrease its end position.
       */
      if (e_end != start)
        {
          set_extent_endpoints (e, e_start, start, Qnil);
          set_extent_openness (e, -1, NILP (get_text_property_bytind
                                       (start - 1, Qend_closed, object,
                                        EXTENT_AT_AFTER, 1)));
          closure->changed_p = 1;
        }
    }
  else if (e_start >= start)
    {
      /* Extent ends after end but begins after start, so we can just
         increase its start position.
       */
      if (e_start != end)
        {
          set_extent_endpoints (e, end, e_end, Qnil);
          set_extent_openness (e, !NILP (get_text_property_bytind
                                        (end, Qstart_open, object,
                                         EXTENT_AT_AFTER, 1)), -1);
          closure->changed_p = 1;
        }
    }
  else
    {
      /* Otherwise, `extent' straddles the region.  We need to split it.
       */
      set_extent_endpoints (e, e_start, start, Qnil);
      set_extent_openness (e, -1, NILP (get_text_property_bytind
                                        (start - 1, Qend_closed, object,
                                         EXTENT_AT_AFTER, 1)));
      set_extent_openness (copy_extent (e, end, e_end, extent_object (e)),
                           !NILP (get_text_property_bytind
                                  (end, Qstart_open, object,
                                   EXTENT_AT_AFTER, 1)), -1);
      closure->changed_p = 1;
    }

  return 0;  /* to continue mapping. */
}

static int
put_text_prop_openness_mapper (EXTENT e, void *arg)
{
  struct put_text_prop_arg *closure = (struct put_text_prop_arg *) arg;
  Bytind e_start, e_end;
  Bytind start = closure->start;
  Bytind end   = closure->end;
  Lisp_Object extent;
  XSETEXTENT (extent, e);
  e_start = extent_endpoint_bytind (e, 0);
  e_end   = extent_endpoint_bytind (e, 1);

  if (NILP (Fextent_property (extent, Qtext_prop, Qnil)))
    {
      /* It's not a text-property extent; do nothing. */
      ;
    }
  /* Note end conditions and NILP/!NILP's carefully. */
  else if (EQ (closure->prop, Qstart_open)
           && e_start >= start && e_start < end)
    set_extent_openness (e, !NILP (closure->value), -1);
  else if (EQ (closure->prop, Qend_closed)
           && e_end > start && e_end <= end)
    set_extent_openness (e, -1, NILP (closure->value));

  return 0;  /* to continue mapping. */
}

static int
put_text_prop (Bytind start, Bytind end, Lisp_Object object,
               Lisp_Object prop, Lisp_Object value,
               int duplicable_p)
{
  /* This function can GC */
  struct put_text_prop_arg closure;

  if (start == end)   /* There are no characters in the region. */
    return 0;

  /* convert to the non-default versions, since a nil property is
     the same as it not being present. */
  if (EQ (prop, Qstart_closed))
    {
      prop = Qstart_open;
      value = NILP (value) ? Qt : Qnil;
    }
  else if (EQ (prop, Qend_open))
    {
      prop = Qend_closed;
      value = NILP (value) ? Qt : Qnil;
    }

  value = canonicalize_extent_property (prop, value);

  closure.prop = prop;
  closure.value = value;
  closure.start = start;
  closure.end = end;
  closure.object = object;
  closure.changed_p = 0;
  closure.the_extent = Qnil;

  map_extents_bytind (start, end,
                      put_text_prop_mapper,
                      (void *) &closure, object, 0,
                      /* get all extents that abut the region */
                      ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
                      /* it might QUIT or error if the user has
                         fucked with the extent plist. */
                      /* #### dmoore - I think this should include
                         ME_MIGHT_MOVE_SOE, since the callback function
                         might recurse back into map_extents_bytind. */
                      ME_MIGHT_THROW |
                      ME_MIGHT_MODIFY_EXTENTS);

  /* If we made it through the loop without reusing an extent
     (and we want there to be one) make it now.
   */
  if (!NILP (value) && NILP (closure.the_extent))
    {
      Lisp_Object extent;

      XSETEXTENT (extent, make_extent_internal (object, start, end));
      closure.changed_p = 1;
      Fset_extent_property (extent, Qtext_prop, prop);
      Fset_extent_property (extent, prop, value);
      if (duplicable_p)
        {
          extent_duplicable_p (XEXTENT (extent)) = 1;
          Fset_extent_property (extent, Qpaste_function,
                                Qtext_prop_extent_paste_function);
        }
      set_extent_openness (XEXTENT (extent),
                           !NILP (get_text_property_bytind
                                  (start, Qstart_open, object,
                                   EXTENT_AT_AFTER, 1)),
                           NILP (get_text_property_bytind
                                 (end - 1, Qend_closed, object,
                                  EXTENT_AT_AFTER, 1)));
    }

  if (EQ (prop, Qstart_open) || EQ (prop, Qend_closed))
    {
      map_extents_bytind (start, end,
                          put_text_prop_openness_mapper,
                          (void *) &closure, object, 0,
                          /* get all extents that abut the region */
                          ME_ALL_EXTENTS_CLOSED | ME_END_CLOSED |
                          ME_MIGHT_MODIFY_EXTENTS);
    }

  return closure.changed_p;
}

DEFUN ("put-text-property", Fput_text_property, 4, 5, 0, /*
Adds the given property/value to all characters in the specified region.
The property is conceptually attached to the characters rather than the
region.  The properties are copied when the characters are copied/pasted.
Fifth argument OBJECT is the buffer or string containing the text, and
defaults to the current buffer.
*/
       (start, end, prop, value, object))
{
  /* This function can GC */
  Bytind s, e;

  object = decode_buffer_or_string (object);
  get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
  put_text_prop (s, e, object, prop, value, 1);
  return prop;
}

DEFUN ("put-nonduplicable-text-property", Fput_nonduplicable_text_property,
       4, 5, 0, /*
Adds the given property/value to all characters in the specified region.
The property is conceptually attached to the characters rather than the
region, however the properties will not be copied when the characters
are copied.
Fifth argument OBJECT is the buffer or string containing the text, and
defaults to the current buffer.
*/
       (start, end, prop, value, object))
{
  /* This function can GC */
  Bytind s, e;

  object = decode_buffer_or_string (object);
  get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
  put_text_prop (s, e, object, prop, value, 0);
  return prop;
}

DEFUN ("add-text-properties", Fadd_text_properties, 3, 4, 0, /*
Add properties to the characters from START to END.
The third argument PROPS is a property list specifying the property values
to add.  The optional fourth argument, OBJECT, is the buffer or string
containing the text and defaults to the current buffer.  Returns t if
any property was changed, nil otherwise.
*/
       (start, end, props, object))
{
  /* This function can GC */
  int changed = 0;
  Bytind s, e;

  object = decode_buffer_or_string (object);
  get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
  CHECK_LIST (props);
  for (; !NILP (props); props = Fcdr (Fcdr (props)))
    {
      Lisp_Object prop = XCAR (props);
      Lisp_Object value = Fcar (XCDR (props));
      changed |= put_text_prop (s, e, object, prop, value, 1);
    }
  return changed ? Qt : Qnil;
}


DEFUN ("add-nonduplicable-text-properties", Fadd_nonduplicable_text_properties,
       3, 4, 0, /*
Add nonduplicable properties to the characters from START to END.
\(The properties will not be copied when the characters are copied.)
The third argument PROPS is a property list specifying the property values
to add.  The optional fourth argument, OBJECT, is the buffer or string
containing the text and defaults to the current buffer.  Returns t if
any property was changed, nil otherwise.
*/
       (start, end, props, object))
{
  /* This function can GC */
  int changed = 0;
  Bytind s, e;

  object = decode_buffer_or_string (object);
  get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
  CHECK_LIST (props);
  for (; !NILP (props); props = Fcdr (Fcdr (props)))
    {
      Lisp_Object prop = XCAR (props);
      Lisp_Object value = Fcar (XCDR (props));
      changed |= put_text_prop (s, e, object, prop, value, 0);
    }
  return changed ? Qt : Qnil;
}

DEFUN ("remove-text-properties", Fremove_text_properties, 3, 4, 0, /*
Remove the given properties from all characters in the specified region.
PROPS should be a plist, but the values in that plist are ignored (treated
as nil).  Returns t if any property was changed, nil otherwise.
Fourth argument OBJECT is the buffer or string containing the text, and
defaults to the current buffer.
*/
       (start, end, props, object))
{
  /* This function can GC */
  int changed = 0;
  Bytind s, e;

  object = decode_buffer_or_string (object);
  get_buffer_or_string_range_byte (object, start, end, &s, &e, 0);
  CHECK_LIST (props);
  for (; !NILP (props); props = Fcdr (Fcdr (props)))
    {
      Lisp_Object prop = XCAR (props);
      changed |= put_text_prop (s, e, object, prop, Qnil, 1);
    }
  return changed ? Qt : Qnil;
}

/* Whenever a text-prop extent is pasted into a buffer (via `yank' or `insert'
   or whatever) we attach the properties to the buffer by calling
   `put-text-property' instead of by simply allowing the extent to be copied or
   re-attached.  Then we return nil, telling the extents code not to attach it
   again.  By handing the insertion hackery in this way, we make kill/yank
   behave consistently with put-text-property and not fragment the extents
   (since text-prop extents must partition, not overlap).

   The lisp implementation of this was probably fast enough, but since I moved
   the rest of the put-text-prop code here, I moved this as well for
   completeness.
 */
DEFUN ("text-prop-extent-paste-function", Ftext_prop_extent_paste_function,
       3, 3, 0, /*
Used as the `paste-function' property of `text-prop' extents.
*/
       (extent, from, to))
{
  /* This function can GC */
  Lisp_Object prop, val;

  prop = Fextent_property (extent, Qtext_prop, Qnil);
  if (NILP (prop))
    signal_simple_error ("Internal error: no text-prop", extent);
  val = Fextent_property (extent, prop, Qnil);
#if 0
  /* removed by bill perry, 2/9/97
  ** This little bit of code would not allow you to have a text property
  ** with a value of Qnil.  This is bad bad bad.
  */
  if (NILP (val))
    signal_simple_error_2 ("Internal error: no text-prop",
                           extent, prop);
#endif
  Fput_text_property (from, to, prop, val, Qnil);
  return Qnil; /* important! */
}

/* This function could easily be written in Lisp but the C code wants
   to use it in connection with invisible extents (at least currently).
   If this changes, consider moving this back into Lisp. */

DEFUN ("next-single-property-change", Fnext_single_property_change,
       2, 4, 0, /*
Return the position of next property change for a specific property.
Scans characters forward from POS till it finds a change in the PROP
 property, then returns the position of the change.  The optional third
 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.
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
 past position LIMIT; return LIMIT if nothing is found before LIMIT.
If two or more extents with conflicting non-nil values for PROP overlap
 a particular character, it is undefined which value is considered to be
 the value of PROP. (Note that this situation will not happen if you always
 use the text-property primitives.)
*/
       (pos, prop, object, limit))
{
  Bufpos bpos;
  Bufpos blim;
  Lisp_Object extent, value;
  int limit_was_nil;

  object = decode_buffer_or_string (object);
  bpos = get_buffer_or_string_pos_char (object, pos, 0);
  if (NILP (limit))
    {
      blim = buffer_or_string_accessible_end_char (object);
      limit_was_nil = 1;
    }
  else
    {
      blim = get_buffer_or_string_pos_char (object, limit, 0);
      limit_was_nil = 0;
    }

  extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
  if (!NILP (extent))
    value = Fextent_property (extent, prop, Qnil);
  else
    value = Qnil;

  while (1)
    {
      bpos = XINT (Fnext_extent_change (make_int (bpos), object));
      if (bpos >= blim)
        break; /* property is the same all the way to the end */
      extent = Fextent_at (make_int (bpos), object, prop, Qnil, Qnil);
      if ((NILP (extent) && !NILP (value)) ||
          (!NILP (extent) && !EQ (value,
                                  Fextent_property (extent, prop, Qnil))))
        return make_int (bpos);
    }

  /* I think it's more sensible for this function to return nil always
     in this situation and it used to do it this way, but it's been changed
     for FSF compatibility. */
  if (limit_was_nil)
    return Qnil;
  else
    return make_int (blim);
}

/* See comment on previous function about why this is written in C. */

DEFUN ("previous-single-property-change", Fprevious_single_property_change,
       2, 4, 0, /*
Return the position of next property change for a specific property.
Scans characters backward from POS till it finds a change in the PROP
 property, then returns the position of the change.  The optional third
 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.
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
 past position LIMIT; return LIMIT if nothing is found until LIMIT.
If two or more extents with conflicting non-nil values for PROP overlap
 a particular character, it is undefined which value is considered to be
 the value of PROP. (Note that this situation will not happen if you always
 use the text-property primitives.)
*/
       (pos, prop, object, limit))
{
  Bufpos bpos;
  Bufpos blim;
  Lisp_Object extent, value;
  int limit_was_nil;

  object = decode_buffer_or_string (object);
  bpos = get_buffer_or_string_pos_char (object, pos, 0);
  if (NILP (limit))
    {
      blim = buffer_or_string_accessible_begin_char (object);
      limit_was_nil = 1;
    }
  else
    {
      blim = get_buffer_or_string_pos_char (object, limit, 0);
      limit_was_nil = 0;
    }

  /* extent-at refers to the character AFTER bpos, but we want the
     character before bpos.  Thus the - 1.  extent-at simply
     returns nil on bogus positions, so not to worry. */
  extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
  if (!NILP (extent))
    value = Fextent_property (extent, prop, Qnil);
  else
    value = Qnil;

  while (1)
    {
      bpos = XINT (Fprevious_extent_change (make_int (bpos), object));
      if (bpos <= blim)
        break; /* property is the same all the way to the beginning */
      extent = Fextent_at (make_int (bpos - 1), object, prop, Qnil, Qnil);
      if ((NILP (extent) && !NILP (value)) ||
          (!NILP (extent) && !EQ (value,
                                  Fextent_property (extent, prop, Qnil))))
        return make_int (bpos);
    }

  /* I think it's more sensible for this function to return nil always
     in this situation and it used to do it this way, but it's been changed
     for FSF compatibility. */
  if (limit_was_nil)
    return Qnil;
  else
    return make_int (blim);
}

#ifdef MEMORY_USAGE_STATS

int
compute_buffer_extent_usage (struct buffer *b, struct overhead_stats *ovstats)
{
  /* #### not yet written */
  return 0;
}

#endif /* MEMORY_USAGE_STATS */

\f
/************************************************************************/
/*                              initialization                          */
/************************************************************************/

void
syms_of_extents (void)
{
  INIT_LRECORD_IMPLEMENTATION (extent);
  INIT_LRECORD_IMPLEMENTATION (extent_info);
  INIT_LRECORD_IMPLEMENTATION (extent_auxiliary);

  defsymbol (&Qextentp, "extentp");
  defsymbol (&Qextent_live_p, "extent-live-p");

  defsymbol (&Qall_extents_closed, "all-extents-closed");
  defsymbol (&Qall_extents_open, "all-extents-open");
  defsymbol (&Qall_extents_closed_open, "all-extents-closed-open");
  defsymbol (&Qall_extents_open_closed, "all-extents-open-closed");
  defsymbol (&Qstart_in_region, "start-in-region");
  defsymbol (&Qend_in_region, "end-in-region");
  defsymbol (&Qstart_and_end_in_region, "start-and-end-in-region");
  defsymbol (&Qstart_or_end_in_region, "start-or-end-in-region");
  defsymbol (&Qnegate_in_region, "negate-in-region");

  defsymbol (&Qdetached, "detached");
  defsymbol (&Qdestroyed, "destroyed");
  defsymbol (&Qbegin_glyph, "begin-glyph");
  defsymbol (&Qend_glyph, "end-glyph");
  defsymbol (&Qstart_open, "start-open");
  defsymbol (&Qend_open, "end-open");
  defsymbol (&Qstart_closed, "start-closed");
  defsymbol (&Qend_closed, "end-closed");
  defsymbol (&Qread_only, "read-only");
  /* defsymbol (&Qhighlight, "highlight"); in faces.c */
  defsymbol (&Qunique, "unique");
  defsymbol (&Qduplicable, "duplicable");
  defsymbol (&Qdetachable, "detachable");
  defsymbol (&Qpriority, "priority");
  defsymbol (&Qmouse_face, "mouse-face");
  defsymbol (&Qinitial_redisplay_function,"initial-redisplay-function");


  defsymbol (&Qglyph_layout, "glyph-layout");   /* backwards compatibility */
  defsymbol (&Qbegin_glyph_layout, "begin-glyph-layout");
  defsymbol (&Qend_glyph_layout, "end-glyph-layout");
  defsymbol (&Qoutside_margin, "outside-margin");
  defsymbol (&Qinside_margin, "inside-margin");
  defsymbol (&Qwhitespace, "whitespace");
  /* Qtext defined in general.c */

  defsymbol (&Qpaste_function, "paste-function");
  defsymbol (&Qcopy_function,  "copy-function");

  defsymbol (&Qtext_prop, "text-prop");
  defsymbol (&Qtext_prop_extent_paste_function,
             "text-prop-extent-paste-function");

  DEFSUBR (Fextentp);
  DEFSUBR (Fextent_live_p);
  DEFSUBR (Fextent_detached_p);
  DEFSUBR (Fextent_start_position);
  DEFSUBR (Fextent_end_position);
  DEFSUBR (Fextent_object);
  DEFSUBR (Fextent_length);

  DEFSUBR (Fmake_extent);
  DEFSUBR (Fcopy_extent);
  DEFSUBR (Fdelete_extent);
  DEFSUBR (Fdetach_extent);
  DEFSUBR (Fset_extent_endpoints);
  DEFSUBR (Fnext_extent);
  DEFSUBR (Fprevious_extent);
#if DEBUG_XEMACS
  DEFSUBR (Fnext_e_extent);
  DEFSUBR (Fprevious_e_extent);
#endif
  DEFSUBR (Fnext_extent_change);
  DEFSUBR (Fprevious_extent_change);

  DEFSUBR (Fextent_parent);
  DEFSUBR (Fextent_children);
  DEFSUBR (Fset_extent_parent);

  DEFSUBR (Fextent_in_region_p);
  DEFSUBR (Fmap_extents);
  DEFSUBR (Fmap_extent_children);
  DEFSUBR (Fextent_at);

  DEFSUBR (Fset_extent_initial_redisplay_function);
  DEFSUBR (Fextent_face);
  DEFSUBR (Fset_extent_face);
  DEFSUBR (Fextent_mouse_face);
  DEFSUBR (Fset_extent_mouse_face);
  DEFSUBR (Fset_extent_begin_glyph);
  DEFSUBR (Fset_extent_end_glyph);
  DEFSUBR (Fextent_begin_glyph);
  DEFSUBR (Fextent_end_glyph);
  DEFSUBR (Fset_extent_begin_glyph_layout);
  DEFSUBR (Fset_extent_end_glyph_layout);
  DEFSUBR (Fextent_begin_glyph_layout);
  DEFSUBR (Fextent_end_glyph_layout);
  DEFSUBR (Fset_extent_priority);
  DEFSUBR (Fextent_priority);
  DEFSUBR (Fset_extent_property);
  DEFSUBR (Fset_extent_properties);
  DEFSUBR (Fextent_property);
  DEFSUBR (Fextent_properties);

  DEFSUBR (Fhighlight_extent);
  DEFSUBR (Fforce_highlight_extent);

  DEFSUBR (Finsert_extent);

  DEFSUBR (Fget_text_property);
  DEFSUBR (Fget_char_property);
  DEFSUBR (Fput_text_property);
  DEFSUBR (Fput_nonduplicable_text_property);
  DEFSUBR (Fadd_text_properties);
  DEFSUBR (Fadd_nonduplicable_text_properties);
  DEFSUBR (Fremove_text_properties);
  DEFSUBR (Ftext_prop_extent_paste_function);
  DEFSUBR (Fnext_single_property_change);
  DEFSUBR (Fprevious_single_property_change);
}

void
reinit_vars_of_extents (void)
{
  extent_auxiliary_defaults.begin_glyph = Qnil;
  extent_auxiliary_defaults.end_glyph = Qnil;
  extent_auxiliary_defaults.parent = Qnil;
  extent_auxiliary_defaults.children = Qnil;
  extent_auxiliary_defaults.priority = 0;
  extent_auxiliary_defaults.invisible = Qnil;
  extent_auxiliary_defaults.read_only = Qnil;
  extent_auxiliary_defaults.mouse_face = Qnil;
  extent_auxiliary_defaults.initial_redisplay_function = Qnil;
  extent_auxiliary_defaults.before_change_functions = Qnil;
  extent_auxiliary_defaults.after_change_functions = Qnil;
}

void
vars_of_extents (void)
{
  reinit_vars_of_extents ();

  DEFVAR_INT ("mouse-highlight-priority", &mouse_highlight_priority /*
The priority to use for the mouse-highlighting pseudo-extent
that is used to highlight extents with the `mouse-face' attribute set.
See `set-extent-priority'.
*/ );
  /* Set mouse-highlight-priority (which ends up being used both for the
     mouse-highlighting pseudo-extent and the primary selection extent)
     to a very high value because very few extents should override it.
     1000 gives lots of room below it for different-prioritized extents.
     10 doesn't. ediff, for example, likes to use priorities around 100.
     --ben */
  mouse_highlight_priority = /* 10 */ 1000;

  DEFVAR_LISP ("default-text-properties", &Vdefault_text_properties /*
Property list giving default values for text properties.
Whenever a character does not specify a value for a property, the value
stored in this list is used instead.  This only applies when the
functions `get-text-property' or `get-char-property' are called.
*/ );
  Vdefault_text_properties = Qnil;

  staticpro (&Vlast_highlighted_extent);
  Vlast_highlighted_extent = Qnil;

  Vextent_face_reusable_list = Fcons (Qnil, Qnil);
  staticpro (&Vextent_face_reusable_list);
}

void
complex_vars_of_extents (void)
{
  staticpro (&Vextent_face_memoize_hash_table);
  /* The memoize hash table maps from lists of symbols to lists of
     faces.  It needs to be `equal' to implement the memoization.
     The reverse table maps in the other direction and just needs
     to do `eq' comparison because the lists of faces are already
     memoized. */
  Vextent_face_memoize_hash_table =
    make_lisp_hash_table (100, HASH_TABLE_VALUE_WEAK, HASH_TABLE_EQUAL);
  staticpro (&Vextent_face_reverse_memoize_hash_table);
  Vextent_face_reverse_memoize_hash_table =
    make_lisp_hash_table (100, HASH_TABLE_KEY_WEAK, HASH_TABLE_EQ);
}